[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/parseclj 697618dbb1 049/185: Merge pull request #1 from vo
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/parseclj 697618dbb1 049/185: Merge pull request #1 from volrath/master |
|
Date: |
Tue, 28 Dec 2021 14:05:15 -0500 (EST) |
branch: elpa/parseclj
commit 697618dbb185d921ee7eabc730d30192dfcfadd1
Merge: 29411e2103 c906de33a1
Author: Arne Brasseur <arne.brasseur@gmail.com>
Commit: GitHub <noreply@github.com>
Merge pull request #1 from volrath/master
Parse to AST and use printers to go from AST to specific targets
---
clj-parse-test.el | 436 ++++++++++++++++++++++++++++++++++++++++++++----------
clj-parse.el | 248 +++++++++++++++++++++----------
2 files changed, 526 insertions(+), 158 deletions(-)
diff --git a/clj-parse-test.el b/clj-parse-test.el
index 90e385fad7..a9888933ce 100644
--- a/clj-parse-test.el
+++ b/clj-parse-test.el
@@ -22,84 +22,368 @@
;;; Code:
-(require 'clj-parse)
+(require 'a)
(require 'ert)
+(require 'clj-parse)
+
+(defun clj-parse--deftest-mode (mode test-name test-string expected)
+ (let* ((parse-fn (intern (concat "clj-parse-" mode)))
+ (test-name (intern (concat (symbol-name parse-fn) "-" (symbol-name
test-name)))))
+ `(ert-deftest ,test-name ()
+ (with-temp-buffer
+ (insert ,test-string)
+ (goto-char 1)
+ (should (equal (,parse-fn) ,expected))))))
+
+(defmacro clj-parse-deftest (test-name test-string mode-vs-expected-alist)
+ (declare (indent defun))
+ `(progn
+ ,@(mapcar (lambda (vs) (clj-parse--deftest-mode (car vs)
+ test-name
+ test-string
+ (cadr vs)))
+ mode-vs-expected-alist)))
+
+
+;;; Parser modes
+;; ----------------------------------------------------------------------------
+
+(clj-parse-deftest simple-list "(1 2 3)"
+ (("edn" '((1 2 3)))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :number)
+ (:position . 2)
+ (:form . "1")
+ (:value . 1))
+ ((:node-type . :number)
+ (:position . 4)
+ (:form . "2")
+ (:value . 2))
+ ((:node-type . :number)
+ (:position . 6)
+ (:form . "3")
+ (:value . 3)))))))))))
+
+
+(clj-parse-deftest empty-list "()"
+ (("edn" '(()))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . nil))))))))
+
+(clj-parse-deftest size-1 "(1)"
+ (("edn" '((1)))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :number)
+ (:position . 2)
+ (:form . "1")
+ (:value . 1)))))))))))
+
+(clj-parse-deftest leafs "(nil true false hello-world)"
+ (("edn" '((nil t nil hello-world)))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :nil)
+ (:position . 2)
+ (:form . "nil")
+ (:value . nil))
+ ((:node-type . :true)
+ (:position . 6)
+ (:form . "true")
+ (:value . t))
+ ((:node-type . :false)
+ (:position . 11)
+ (:form . "false")
+ (:value . nil))
+ ((:node-type . :symbol)
+ (:position . 17)
+ (:form . "hello-world")
+ (:value . hello-world)))))))))))
+
+(clj-parse-deftest qualified-symbol "clojure.string/join"
+ (("edn" '(clojure.string/join))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :symbol)
+ (:position . 1)
+ (:form . "clojure.string/join")
+ (:value . clojure.string/join))))))))
+
+(clj-parse-deftest nested-lists "((.9 abc (true) (hello)))"
+ (("edn" '(((0.9 abc (t) (hello)))))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 2)
+ (:children ((:node-type . :number)
+ (:position . 3)
+ (:form . ".9")
+ (:value . 0.9))
+ ((:node-type . :symbol)
+ (:position . 6)
+ (:form . "abc")
+ (:value . abc))
+ ((:node-type . :list)
+ (:position . 10)
+ (:children ((:node-type
. :true)
+ (:position .
11)
+ (:form .
"true")
+ (:value .
t))))
+ ((:node-type . :list)
+ (:position . 17)
+ (:children ((:node-type
. :symbol)
+ (:position .
18)
+ (:form .
"hello")
+ (:value .
hello)))))))))))))))
+
+(clj-parse-deftest strings-1 "\"abc hello \\t\\\"x\""
+ (("edn" '("abc hello \t\"x"))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :string)
+ (:position . 1)
+ (:form . "\"abc hello \\t\\\"x\"")
+ (:value . "abc hello \t\"x"))))))))
+
+(clj-parse-deftest strings-2 "(\"---\\f---\\\"-'\\'-\\\\-\\r\\n\")"
+ (("edn" '(("---\f---\"-''-\\-\r\n")))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :string)
+ (:position . 2)
+ (:form .
"\"---\\f---\\\"-'\\'-\\\\-\\r\\n\"")
+ (:value .
"---\f---\"-''-\\-\r\n")))))))))))
+
+(clj-parse-deftest chars-1 "(\\newline \\return \\space \\tab \\a \\b \\c
\\u0078 \\o171)"
+ (("edn" '((?\n ?\r ?\ ?\t ?a ?b ?c ?x ?y)))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :character) (:position
. 2) (:form . "\\newline") (:value . ?\n))
+ ((:node-type . :character) (:position
. 11) (:form . "\\return") (:value . ?\r))
+ ((:node-type . :character) (:position
. 19) (:form . "\\space") (:value . 32))
+ ((:node-type . :character) (:position
. 26) (:form . "\\tab") (:value . ?\t))
+ ((:node-type . :character) (:position
. 31) (:form . "\\a") (:value . ?a))
+ ((:node-type . :character) (:position
. 34) (:form . "\\b") (:value . ?b))
+ ((:node-type . :character) (:position
. 37) (:form . "\\c") (:value . ?c))
+ ((:node-type . :character) (:position
. 40) (:form . "\\u0078") (:value . ?x))
+ ((:node-type . :character) (:position
. 47) (:form . "\\o171") (:value . ?y)))))))))))
+
+(clj-parse-deftest chars-2 "\"\\u0078 \\o171\""
+ (("edn" '("x y"))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :string)
+ (:position . 1)
+ (:form . "\"\\u0078 \\o171\"")
+ (:value . "x y"))))))))
+
+(clj-parse-deftest keywords ":foo-bar"
+ (("edn" '(:foo-bar))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :keyword)
+ (:position . 1)
+ (:form . ":foo-bar")
+ (:value . :foo-bar))))))))
+
+(clj-parse-deftest vector "[123]"
+ (("edn" '([123]))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :vector)
+ (:position . 1)
+ (:children . (((:node-type . :number)
+ (:position . 2)
+ (:form . "123")
+ (:value . 123)))))))))))
+
+(clj-parse-deftest map "{:count 123}"
+ (("edn" '(((:count . 123))))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :map)
+ (:position . 1)
+ (:children . (((:node-type . :keyword)
+ (:position . 2)
+ (:form . ":count")
+ (:value . :count))
+ ((:node-type . :number)
+ (:position . 9)
+ (:form . "123")
+ (:value . 123)))))))))))
+
+(clj-parse-deftest set "#{:x}"
+ (("edn" '((:x)))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :set)
+ (:position . 1)
+ (:children . (((:node-type . :keyword)
+ (:position . 3)
+ (:form . ":x")
+ (:value . :x)))))))))))
+
+(clj-parse-deftest discard "(10 #_11 12 #_#_ 13 14)"
+ (("edn" '((10 12)))
+ ("ast" '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :number)
+ (:position . 2)
+ (:form . "10")
+ (:value . 10))
+ ((:node-type . :number)
+ (:position . 10)
+ (:form . "12")
+ (:value . 12)))))))))))
+
+
+;;; Printer modes
+;; ----------------------------------------------------------------------------
+
+(ert-deftest clj-parse-ast-print-list ()
+ (should (equal "(0 1 2)"
+ (clj-parse-ast-print '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children .
(((:node-type . :number)
+
(:position . 2)
+ (:form .
"0")
+ (:value
. 0))
+
((:node-type . :number)
+
(:position . 4)
+ (:form .
"1")
+ (:value
. 1))
+
((:node-type . :number)
+
(:position . 6)
+ (:form .
"2")
+ (:value
. 2))))))))))))
+
+(ert-deftest clj-parse-ast-print-empty-list ()
+ (should (equal "()"
+ (clj-parse-ast-print '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children .
nil)))))))))
+
+(ert-deftest clj-parse-ast-print-nested-list ()
+ (should (equal "((.9 abc (true) (hello)))"
+ (clj-parse-ast-print '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children .
(((:node-type . :list)
+
(:position . 2)
+
(:children ((:node-type . :number)
+
(:position . 3)
+
(:form . ".9")
+
(:value . 0.9))
+
((:node-type . :symbol)
+
(:position . 6)
+
(:form . "abc")
+
(:value . abc))
+
((:node-type . :list)
+
(:position . 10)
+
(:children ((:node-type . :true)
+
(:position . 11)
+
(:form . "true")
+
(:value . t))))
+
((:node-type . :list)
+
(:position . 17)
+
(:children ((:node-type . :symbol)
+
(:position . 18)
+
(:form . "hello")
+
(:value . hello))))))))))))))))
+
+(ert-deftest clj-parse-ast-print-string ()
+ (should (equal "\"abc hello \\t\\\"x\""
+ (clj-parse-ast-print '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :string)
+ (:position . 1)
+ (:form . "\"abc hello
\\t\\\"x\"")
+ (:value . "abc hello
\t\"x")))))))))
+
+(ert-deftest clj-parse-ast-print-chars ()
+ (should (equal "(\\newline \\return \\space \\tab \\a \\b \\c \\u0078
\\o171)"
+ (clj-parse-ast-print '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :character) (:position
. 2) (:form . "\\newline") (:value . ?\n))
+ ((:node-type . :character) (:position
. 11) (:form . "\\return") (:value . ?\r))
+ ((:node-type . :character) (:position
. 19) (:form . "\\space") (:value . 32))
+ ((:node-type . :character) (:position
. 26) (:form . "\\tab") (:value . ?\t))
+ ((:node-type . :character) (:position
. 31) (:form . "\\a") (:value . ?a))
+ ((:node-type . :character) (:position
. 34) (:form . "\\b") (:value . ?b))
+ ((:node-type . :character) (:position
. 37) (:form . "\\c") (:value . ?c))
+ ((:node-type . :character) (:position
. 40) (:form . "\\u0078") (:value . ?x))
+ ((:node-type . :character) (:position
. 47) (:form . "\\o171") (:value . ?y))))))))))))
+
+(ert-deftest clj-parse-ast-print-keyword ()
+ (should (equal ":foo-bar"
+ (clj-parse-ast-print '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :keyword)
+ (:position . 1)
+ (:form . ":foo-bar")
+ (:value .
:foo-bar)))))))))
+
+(ert-deftest clj-parse-ast-print-vector ()
+ (should (equal "[123]"
+ (clj-parse-ast-print '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :vector)
+ (:position . 1)
+ (:children .
(((:node-type . :number)
+
(:position . 2)
+ (:form .
"123")
+ (:value
. 123))))))))))))
+
+(ert-deftest clj-parse-ast-print-map ()
+ (should (equal "{:count 123}"
+ (clj-parse-ast-print '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :map)
+ (:position . 1)
+ (:children .
(((:node-type . :keyword)
+
(:position . 2)
+ (:form .
":count")
+ (:value
. :count))
+
((:node-type . :number)
+
(:position . 9)
+ (:form .
"123")
+ (:value
. 123))))))))))))
-(ert-deftest clj-parse-test ()
- (with-temp-buffer
- (insert "(1 2 3)")
- (goto-char 1)
- (should (equal (clj-parse) '((1 2 3)))))
-
- (with-temp-buffer
- (insert "()")
- (goto-char 1)
- (should (equal (clj-parse) '(()))))
-
- (with-temp-buffer
- (insert "(1)")
- (goto-char 1)
- (should (equal (clj-parse) '((1)))))
-
- (with-temp-buffer
- (insert "(nil true false hello-world)")
- (goto-char 1)
- (should (equal (clj-parse) '((nil t nil hello-world)))))
-
- (with-temp-buffer
- (insert "clojure.string/join")
- (goto-char 1)
- (should (equal (clj-parse) '(clojure.string/join))))
-
- (with-temp-buffer
- (insert "((.9 abc (true) (hello)))")
- (goto-char 1)
- (should (equal (clj-parse) '(((0.9 abc (t) (hello)))))))
-
- (with-temp-buffer
- (insert "\"abc hello \\t\\\"x\"")
- (goto-char 1)
- (should (equal (clj-parse) '("abc hello \t\"x"))))
-
- (with-temp-buffer
- (insert "(\"---\\f---\\\"-'\\'-\\\\-\\r\\n\")")
- (goto-char 1)
- (should (equal (clj-parse) '(("---\f---\"-''-\\-\r\n")))))
-
- (with-temp-buffer
- (insert "(\\newline \\return \\space \\tab \\a \\b \\c \\u0078 \\o171)")
- (goto-char 1)
- (should (equal (clj-parse) '((?\n ?\r ?\ ?\t ?a ?b ?c ?x ?y)))))
-
- (with-temp-buffer
- (insert "\"\\u0078 \\o171\"")
- (goto-char 1)
- (should (equal (clj-parse) '("x y"))))
-
- (with-temp-buffer
- (insert ":foo-bar")
- (goto-char 1)
- (should (equal (clj-parse) '(:foo-bar))))
-
- (with-temp-buffer
- (insert "[123]")
- (goto-char 1)
- (should (equal (clj-parse) '([123]))))
-
- (with-temp-buffer
- (insert "{:count 123}")
- (goto-char 1)
- (should (equal (clj-parse) '(((:count . 123))))))
-
- (with-temp-buffer
- (insert "#{:x}")
- (goto-char 1)
- (should (equal (clj-parse) '((:x)))))
-
- (with-temp-buffer
- (insert "(10 #_11 12 #_#_ 13 14)")
- (goto-char 1)
- (should (equal (clj-parse) '((10 12))))))
+(ert-deftest clj-parse-ast-print-set ()
+ (should (equal "#{:x}"
+ (clj-parse-ast-print '((:node-type . :root)
+ (:position . 0)
+ (:children . (((:node-type . :set)
+ (:position . 1)
+ (:children .
(((:node-type . :keyword)
+
(:position . 3)
+ (:form .
":x")
+ (:value
. :x))))))))))))
(provide 'clj-parse-test)
diff --git a/clj-parse.el b/clj-parse.el
index bf999470f4..655af83d20 100644
--- a/clj-parse.el
+++ b/clj-parse.el
@@ -1,4 +1,4 @@
-;;; clj-parse.el --- Clojure/EDN parser
+;;; clj-parse.el --- Clojure/EDN parser -*- lexical-binding: t;
-*-
;; Copyright (C) 2017 Arne Brasseur
@@ -25,6 +25,10 @@
;;; Code:
;; Before emacs 25.1 it's an ELPA package
+
+(require 'a)
+(require 's)
+(require 'dash)
(require 'let-alist)
(require 'cl-lib)
(require 'clj-lex)
@@ -40,6 +44,18 @@
:character)
"Tokens that represent leaf nodes in the AST.")
+(defvar clj-parse--closer-tokens '(:rparen
+ :rbracket
+ :rbrace)
+ "Tokens that represent closing of an AST branch.")
+
+(defun clj-parse--is-leaf? (node)
+ (member (a-get node ':node-type) clj-parse--leaf-tokens))
+
+(defun clj-parse--is-open-prefix? (el)
+ (and (member (clj-lex-token-type el) '(:discard :tag))
+ (clj-lex-token? el)))
+
;; The EDN spec is not clear about wether \u0123 and \o012 are supported in
;; strings. They are described as character literals, but not as string escape
;; codes. In practice all implementations support them (mostly with broken
@@ -47,7 +63,7 @@
;;
;; Note that this is kind of broken, we don't correctly detect if \u or \o
forms
;; don't have the right forms.
-(defun clj-parse-string (s)
+(defun clj-parse--string (s)
(replace-regexp-in-string
"\\\\o[0-8]\\{3\\}"
(lambda (x)
@@ -68,98 +84,166 @@
(t (substring x 1))))
(substring s 1 -1)))))
-(defun clj-parse-character (c)
- (let* ((form (cdr (assq 'form token)))
- (first-char (elt form 1)))
+(defun clj-parse--character (c)
+ (let ((first-char (elt c 1)))
(cond
- ((equal form "\\newline") ?\n)
- ((equal form "\\return") ?\r)
- ((equal form "\\space") ?\ )
- ((equal form "\\tab") ?\t)
- ((eq first-char ?u) (string-to-number (substring form 2) 16))
- ((eq first-char ?o) (string-to-number (substring form 2) 8))
+ ((equal c "\\newline") ?\n)
+ ((equal c "\\return") ?\r)
+ ((equal c "\\space") ?\ )
+ ((equal c "\\tab") ?\t)
+ ((eq first-char ?u) (string-to-number (substring c 2) 16))
+ ((eq first-char ?o) (string-to-number (substring c 2) 8))
(t first-char))))
-(defun clj-parse-edn-reduce1 (stack token)
- (cl-case (cdr (assq 'type token))
- (:whitespace stack)
- (:number (cons (string-to-number (cdr (assq 'form token))) stack))
- (:nil (cons nil stack))
- (:true (cons t stack))
- (:false (cons nil stack))
- (:symbol (cons (intern (cdr (assq 'form token))) stack))
- (:keyword (cons (intern (cdr (assq 'form token))) stack))
- (:string (cons (clj-parse-string (cdr (assq 'form token))) stack))
- (:character (cons (clj-parse-character (cdr (assq 'form token))) stack))))
-
-(defun clj-parse-edn-reduceN (stack type coll)
- (if (eq :discard type)
- stack
- (cons
- (cl-case type
- (:whitespace :ws)
- (:number coll)
- (:list (-butlast (cdr coll)))
- (:set (-butlast (cdr coll)))
- (:vector (apply #'vector (-butlast (cdr coll))))
- (:map (mapcar (lambda (pair)
- (cons (car pair) (cadr pair)))
- (-partition 2 (-butlast (cdr coll))))))
- stack)))
-
-(defun clj-parse--reduce-coll (stack open-token coll-type reducN)
- (let ((coll nil))
+(defun clj-parse--leaf-token-value (token)
+ (cl-case (clj-lex-token-type token)
+ (:number (string-to-number (alist-get 'form token)))
+ (:nil nil)
+ (:true t)
+ (:false nil)
+ (:symbol (intern (alist-get 'form token)))
+ (:keyword (intern (alist-get 'form token)))
+ (:string (clj-parse--string (alist-get 'form token)))
+ (:character (clj-parse--character (alist-get 'form token)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Shift-Reduce Parser
+
+(defun clj-parse--find-opener (stack closer-token)
+ (cl-case (clj-lex-token-type closer-token)
+ (:rparen :lparen)
+ (:rbracket :lbracket)
+ (:rbrace (clj-lex-token-type
+ (-find (lambda (token) (member (clj-lex-token-type token)
'(:lbrace :set))) stack)))))
+
+(defun clj-parse--reduce-coll (stack closer-token reduceN)
+ "Reduce collection based on the top of the stack"
+ (let ((opener-type (clj-parse--find-opener stack closer-token))
+ (coll nil))
(while (and stack
- (not (eq (clj-lex-token-type (car stack)) open-token)))
+ (not (eq (clj-lex-token-type (car stack)) opener-type)))
(push (pop stack) coll))
- (if (eq (clj-lex-token-type (car stack)) open-token)
- (progn
- (push (pop stack) coll)
- (funcall reduceN stack coll-type coll))
- ;; Unwound the stack without finding a matching paren: return the
original stack
- (reverse list))))
-
-(defun clj-parse-reduce (reduce1 reduceN)
- (let ((stack nil)
- (token (clj-lex-next)))
-
- (while (not (eq (clj-lex-token-type token) :eof))
+
+ (if (eq (clj-lex-token-type (car stack)) opener-type)
+ (let ((node (pop stack)))
+ (funcall reduceN stack node coll))
+ ;; Syntax error
+ (error "Syntax Error"))))
+
+(defun clj-parse-reduce (reduce-leaf reduce-node)
+ (let ((stack nil))
+
+ (while (not (eq (clj-lex-token-type (setq token (clj-lex-next))) :eof))
(message "STACK: %S" stack)
(message "TOKEN: %S\n" token)
- (setf stack
- (if (member (clj-lex-token-type token)
- clj-parse--leaf-tokens)
- (funcall reduce1 stack token)
- (cons token stack)))
-
;; Reduce based on the top item on the stack (collections)
- (cl-case (clj-lex-token-type (car stack))
- (:rparen (setf stack (clj-parse--reduce-coll stack :lparen :list
reduceN)))
- (:rbracket (setf stack (clj-parse--reduce-coll stack :lbracket :vector
reduceN)))
- (:rbrace
- (let ((open-token (-find (lambda (token)
- (member (clj-lex-token-type token)
'(:lbrace :set)))
- stack)))
-
- (cl-case (clj-lex-token-type open-token)
- (:lbrace
- (setf stack (clj-parse--reduce-coll stack :lbrace :map reduceN)))
- (:set
- (setf stack (clj-parse--reduce-coll stack :set :set
reduceN)))))))
-
- ;; Reduce based on top two items on the stack
- (if (not (clj-lex-token? (car stack))) ;; top is fully reduced
- (cl-case (clj-lex-token-type (cadr stack))
- (:discard (setf stack (funcall reduceN (cddr stack) :discard
(-take 2 stack))))))
-
- (setq token (clj-lex-next)))
-
+ (let ((token-type (clj-lex-token-type token)))
+ (cond
+ ((member token-type clj-parse--leaf-tokens) (setf stack (funcall
reduce-leaf stack token)))
+ ((member token-type clj-parse--closer-tokens) (setf stack
(clj-parse--reduce-coll stack token reduce-node)))
+ (t (push token stack))))
+
+ ;; Reduce based on top two items on the stack (special prefixed elements)
+ (seq-let [top lookup] stack
+ (when (and (clj-parse--is-open-prefix? lookup)
+ (not (clj-lex-token? top))) ;; top is fully reduced
+ (setf stack (funcall reduce-node (cddr stack) lookup (list
top))))))
+
+ ;; reduce root
+ (setf stack (funcall reduce-node stack '((type . :root) (pos . 0)) stack))
(message "RESULT: %S" stack)
stack))
-(defun clj-parse ()
- (clj-parse-reduce 'clj-parse-edn-reduce1 'clj-parse-edn-reduceN))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Reducer implementations
+
+(defun clj-parse--make-node (type position &rest kvs)
+ (apply 'a-list ':node-type type ':position position kvs))
+
+;; AST
+
+(defun clj-parse--ast-reduce-leaf (stack token)
+ (if (eq (clj-lex-token-type token) :whitespace)
+ stack
+ (push
+ (clj-parse--make-node (clj-lex-token-type token) (a-get token 'pos)
+ ':form (a-get token 'form)
+ ':value (clj-parse--leaf-token-value token))
+ stack)))
+
+(defun clj-parse--ast-reduce-node (stack opener-token children)
+ (let* ((pos (a-get opener-token 'pos))
+ (type (cl-case (clj-lex-token-type opener-token)
+ (:root :root)
+ (:lparen :list)
+ (:lbracket :vector)
+ (:set :set)
+ (:lbrace :map)
+ (:discard :discard))))
+ (cl-case type
+ (:root (clj-parse--make-node :root 0 ':children children))
+ (:discard stack)
+ (t (push
+ (clj-parse--make-node type pos
+ ':children children)
+ stack)))))
+
+(defun clj-parse-ast ()
+ (clj-parse-reduce #'clj-parse--ast-reduce-leaf #'clj-parse--ast-reduce-node))
+
+; Elisp
+
+(defun clj-parse--edn-reduce-leaf (stack token)
+ (if (eq (clj-lex-token-type token) :whitespace)
+ stack
+ (push (clj-parse--leaf-token-value token) stack)))
+
+(defun clj-parse--edn-reduce-node (stack opener-token children)
+ (let ((type (clj-lex-token-type opener-token)))
+ (if (member type '(:root :discard))
+ stack
+ (push
+ (cl-case type
+ (:lparen children)
+ (:lbracket (apply #'vector children))
+ (:set children)
+ (:lbrace (mapcar (lambda (pair)
+ (cons (car pair) (cadr pair)))
+ (-partition 2 children))))
+ stack))))
+
+(defun clj-parse-edn ()
+ (clj-parse-reduce #'clj-parse--edn-reduce-leaf #'clj-parse--edn-reduce-node))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Printer implementations
+
+;; AST
+
+(defun clj-parse--reduce-string-leaf (leaf)
+ (alist-get ':form leaf))
+
+(defun clj-parse--string-with-delimiters (nodes ld rd)
+ (concat ld
+ (s-join " " (mapcar #'clj-parse-ast-print nodes))
+ rd))
+
+(defun clj-parse-ast-print (node)
+ (if (clj-parse--is-leaf? node)
+ (clj-parse--reduce-string-leaf node)
+ (let ((subnodes (alist-get ':children node)))
+ (cl-case (a-get node ':node-type)
+ (:root (clj-parse--string-with-delimiters subnodes "" ""))
+ (:list (clj-parse--string-with-delimiters subnodes "(" ")"))
+ (:vector (clj-parse--string-with-delimiters subnodes "[" "]"))
+ (:set (clj-parse--string-with-delimiters subnodes "#{" "}"))
+ (:map (clj-parse--string-with-delimiters subnodes "{" "}"))
+ ;; tagged literals
+ ))))
(provide 'clj-parse)
- [nongnu] elpa/parseclj 22f2eb106f 028/185: Support \uxxxx and \oxxx escape codes in strings, (continued)
- [nongnu] elpa/parseclj 22f2eb106f 028/185: Support \uxxxx and \oxxx escape codes in strings, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 343052c01a 014/185: Add linting to the build, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 07739abe2c 030/185: support keywords, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj ced0b91c08 029/185: "Support" namespaces symbols, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 1eef0b62c8 034/185: Support #_discard forms, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 0974b56833 035/185: Stick to non CL functions, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj f8822bb43c 040/185: Add support for tags in lexer, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 43f59dcb91 043/185: Avoid dropping whitespaces, handling them while reducing, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 7733985037 047/185: DESIGN.md-related adjustments, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj c906de33a1 048/185: Rewrite all tests, and add new tests for the AST "printer", ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 697618dbb1 049/185: Merge pull request #1 from volrath/master,
ELPA Syncer <=
- [nongnu] elpa/parseclj e7686c49ed 052/185: Greater parity with edn.el, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 2da47798d9 057/185: Enable more edn.el tests, document how time/uuid are stored, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj f6de87fbe6 067/185: Split EDN and AST handling in separate files, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj d410a1530e 096/185: Add code-checking defaults to `dir-locals.el`, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 3a92eafce9 079/185: Rename reduce-node to reduce-branch, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 7beff77b15 083/185: Introduce parseclj-parse-clojure, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 3d261f5d3c 072/185: Bump version of a, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 47cf208a91 091/185: Fix parsing of tags/discard with :lexical-preservation, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj da4bacb5f5 078/185: Rename parseclj-reduce to parseclj-parse, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 2a42dcb6fa 066/185: Update License info in README, ELPA Syncer, 2021/12/28