branch: elpa/parseclj
commit 185ce6367b8bb37d73b6d24103da318f88de8367
Author: Arne Brasseur <[email protected]>
Commit: Arne Brasseur <[email protected]>
Add :discard support for :lexical-preservation t, and show that it's broken
Discard nodes were currently not being preserved, this changes handles
reductions of type :discard, but also adds a test case that demonstrates
this
breaks down in the face of whitespace (or other discard nodes).
The reason is that the parser only considers the top two elements on the
stack,
but in the case of :lexical-preservation, there could be several
:whitespace and
:comment nodes that need to be taken into account as well.
We'll have the same problem when dealing with metadata.
---
parseclj-ast.el | 20 +++++++++++---------
test/parseclj-test.el | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 63 insertions(+), 9 deletions(-)
diff --git a/parseclj-ast.el b/parseclj-ast.el
index 88d6654820..2b53cf3ec8 100644
--- a/parseclj-ast.el
+++ b/parseclj-ast.el
@@ -94,15 +94,17 @@ Other ATTRIBUTES can be given as a flat list of key-value
pairs. "
(parseclj-ast-node type pos :children children)
stack)))))
-(defun parseclj-ast--reduce-branch-with-lexical-preservation (&rest args)
- (let* ((stack (apply #'parseclj-ast--reduce-branch args))
- (top (car stack)))
- (if (parseclj-ast-node? top)
- (cons (cl-list* (car top) ;; make sure :node-type remains the first
element in the list
- '(:lexical-preservation . t)
- (cdr top))
- (cdr stack))
- stack)))
+(defun parseclj-ast--reduce-branch-with-lexical-preservation (stack
opening-token children)
+ (if (eq :discard (parseclj-lex-token-type opening-token))
+ (cons (parseclj-ast-node :discard (a-get opening-token :pos) :children
children) stack)
+ (let* ((stack (funcall #'parseclj-ast--reduce-branch stack opening-token
children))
+ (top (car stack)))
+ (if (parseclj-ast-node? top)
+ (cons (cl-list* (car top) ;; make sure :node-type remains the first
element in the list
+ '(:lexical-preservation . t)
+ (cdr top))
+ (cdr stack))
+ stack))))
(provide 'parseclj-ast)
diff --git a/test/parseclj-test.el b/test/parseclj-test.el
index ee9eb51b66..a2773157df 100644
--- a/test/parseclj-test.el
+++ b/test/parseclj-test.el
@@ -144,6 +144,58 @@
;; TODO: uneven map forms
)
+(ert-deftest parseclj-parse-clojure-lexical-preservation ()
+ (should (equal
+ (parseclj-parse-clojure "#_ (1 2 3) true")
+ '((:node-type . :root) (:position . 1) (:children ((:node-type .
:true) (:position . 12) (:form . "true") (:value . t))))))
+ (should (equal
+ (parseclj-parse-clojure "#_(1 2 3) true" :lexical-preservation t)
+ '((:node-type . :root)
+ (:lexical-preservation . t)
+ (:position . 1)
+ (:children ((:node-type . :discard)
+ (:position . 1)
+ (:children ((:node-type . :list)
+ (:lexical-preservation . t)
+ (:position . 3)
+ (:children ((:node-type . :number)
(:position . 4) (:form . "1") (:value . 1))
+ ((:node-type . :whitespace)
(:position . 5) (:form . " "))
+ ((:node-type . :number)
(:position . 6) (:form . "2") (:value . 2))
+ ((:node-type . :whitespace)
(:position . 7) (:form . " "))
+ ((:node-type . :number)
(:position . 8) (:form . "3") (:value . 3))))))
+ ((:node-type . :whitespace)
+ (:position . 10)
+ (:form . " "))
+ ((:node-type . :true)
+ (:position . 11)
+ (:form . "true")
+ (:value . t))))))
+
+ (should (equal
+ (parseclj-parse-clojure "#_ (1 2 3) true" :lexical-preservation t)
+ '((:node-type . :root)
+ (:lexical-preservation . t)
+ (:position . 1)
+ (:children ((:node-type . :discard)
+ (:position . 1)
+ (:children
+ ((:node-type . :whitespace) (:position . 3) (:form .
" "))
+ ((:node-type . :list)
+ (:lexical-preservation . t)
+ (:position . 4)
+ (:children ((:node-type . :number) (:position . 5)
(:form . "1") (:value . 1))
+ ((:node-type . :whitespace) (:position .
6) (:form . " "))
+ ((:node-type . :number) (:position . 7)
(:form . "2") (:value . 2))
+ ((:node-type . :whitespace) (:position .
8) (:form . " "))
+ ((:node-type . :number) (:position . 9)
(:form . "3") (:value . 3))))))
+ ((:node-type . :whitespace)
+ (:position . 11)
+ (:form . " "))
+ ((:node-type . :true)
+ (:position . 12)
+ (:form . "true")
+ (:value . t)))))))
+
(provide 'parseclj-test)
;;; parseclj-test.el ends here
