branch: elpa/parseclj
commit 7beff77b154b4d39672f66632c92d071fe7d6842
Author: Arne Brasseur <[email protected]>
Commit: Arne Brasseur <[email protected]>
Introduce parseclj-parse-clojure
---
parseclj-ast.el | 16 +--------
parseclj.el | 86 ++++++++++++++++++++++++++++++++++++-----------
test/parseclj-ast-test.el | 10 +++---
3 files changed, 72 insertions(+), 40 deletions(-)
diff --git a/parseclj-ast.el b/parseclj-ast.el
index c4b52e1bd9..0632fa35e8 100644
--- a/parseclj-ast.el
+++ b/parseclj-ast.el
@@ -61,20 +61,6 @@
(parseclj--make-node type pos :children children)
stack)))))
-(defun parseclj-ast-parse ()
- "Parse Clojure code in buffer to AST.
-
-Parses code in the current buffer, starting from the current
-position of (point)."
- (parseclj-parse #'parseclj-ast--reduce-leaf #'parseclj-ast--reduce-branch))
-
-(defun parseclj-ast-parse-str (s)
- "Parse Clojure code in string S to AST."
- (with-temp-buffer
- (insert s)
- (goto-char 1)
- (parseclj-ast-parse)))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Unparser
@@ -95,7 +81,7 @@ position of (point)."
(parseclj-ast-unparse (car (a-get node :children)))))
(defun parseclj-ast-unparse (node)
- (if (parseclj--is-leaf? node)
+ (if (parseclj--leaf? node)
(insert (alist-get ':form node))
(let ((subnodes (alist-get ':children node)))
(cl-case (a-get node ':node-type)
diff --git a/parseclj.el b/parseclj.el
index 9b8617c3c5..d4cf1fefa0 100644
--- a/parseclj.el
+++ b/parseclj.el
@@ -38,29 +38,26 @@
(require 'parseclj-ast)
(defvar parseclj--leaf-tokens '(:whitespace
- :comment
- :number
- :nil
- :true
- :false
- :symbol
- :keyword
- :string
- :character)
+ :comment
+ :number
+ :nil
+ :true
+ :false
+ :symbol
+ :keyword
+ :string
+ :character)
"Tokens that represent leaf nodes in the AST.")
(defvar parseclj--closer-tokens '(:rparen
- :rbracket
- :rbrace)
+ :rbracket
+ :rbrace)
"Tokens that represent closing of an AST branch.")
-(defun parseclj--is-leaf? (node)
+(defun parseclj--leaf? (node)
+ "Return `t' if the given ast NODE is a leaf node."
(member (a-get node ':node-type) parseclj--leaf-tokens))
-(defun parseclj--is-open-prefix? (el)
- (and (member (parseclj-lex-token-type el) '(:discard :tag))
- (parseclj-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
@@ -137,7 +134,30 @@
(message "STACK: %S , CLOSER: %S" stack closer-token)
(error "Syntax Error")))))
-(defun parseclj-parse (reduce-leaf reduce-branch)
+(defun parseclj-parse (reduce-leaf reduce-branch &optional options)
+ "Clojure/EDN stack-based shift-reduce parser.
+
+REDUCE-LEAF does reductions for leaf nodes. It is a function that
+takes the current value of the stack and a token, and either
+returns an updated stack, with a new leaf node at the
+top (front), or returns the stack unmodified.
+
+REDUCE-BRANCH does reductions for branch nodes. It is a function
+that takes the current value of the stack, the type of branch
+node to create, and a list of child nodes, and returns an updated
+stack, with the new node at the top (front).
+
+What \"node\" means in this case is up to the reducing functions,
+it could be AST nodes (as in the case of
+`parseclj-parse-clojure'), or plain values/sexps (as in the case
+of `parseedn-read'), or something else. The only requirement is
+that they should not put raw tokens back on the stack, as the
+parser relies on the presence or absence of these to detect parse
+errors.
+
+OPTIONS is an association list which is passed on to the reducing
+functions.
+"
(let ((stack nil))
(while (not (eq (parseclj-lex-token-type (setq token (parseclj-lex-next)))
:eof))
@@ -153,15 +173,41 @@
;; Reduce based on top two items on the stack (special prefixed elements)
(seq-let [top lookup] stack
- (when (and (parseclj--is-open-prefix? lookup)
- (not (parseclj-lex-token? top))) ;; top is fully reduced
- (setf stack (funcall reduce-branch (cddr stack) lookup (list
top))))))
+ (when (and (parseclj-lex-token? lookup)
+ (not (parseclj-lex-token? top)) ;; top is fully reduced
+ (member (parseclj-lex-token-type lookup) '(:discard :tag)))
+ (setf stack (funcall reduce-branch (cddr stack) lookup (list
top))))))
;; reduce root
(setf stack (funcall reduce-branch stack '((type . :root) (pos . 1))
stack))
;; (message "RESULT: %S" stack)
stack))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Top level API
+
+(defun parseclj-parse-clojure (&rest string-and-options)
+ "Parse Clojure source to AST.
+
+Reads either from the current buffer, starting from point, until
+point-max, or reads from the optional string argument.
+
+STRING-AND-OPTIONS can be an optional string, followed by
+key-value pairs to specify parsing options.
+
+- `:lexical-preservation' Retain whitespace, comments, and
+ discards. Defaults to false (`nil').
+- `:fail-fast' Raise an error
+ when encountering invalid syntax. Defaults to true (`t'). "
+ (if (stringp (car string-and-options))
+ (with-temp-buffer
+ (insert (car string-and-options))
+ (goto-char 1)
+ (apply 'parseclj-parse-clojure (cdr string-and-options)))
+ (parseclj-parse #'parseclj-ast--reduce-leaf
+ #'parseclj-ast--reduce-branch
+ (apply 'a-list string-and-options))))
+
(provide 'parseclj)
diff --git a/test/parseclj-ast-test.el b/test/parseclj-ast-test.el
index 59ec572e86..7283b8de68 100644
--- a/test/parseclj-ast-test.el
+++ b/test/parseclj-ast-test.el
@@ -32,20 +32,20 @@
(load "test/parseclj-test-data.el")
-(defmacro define-parseclj-ast-parse-tests ()
+(defmacro define-parseclj-parse-clojure-tests ()
`(progn
,@(mapcar
(lambda (pair)
(let ((name (car pair))
(data (cdr pair)))
(if (and (a-get data :source) (a-get data :ast))
- (let ((test-name (intern (concat "parseclj-ast-parse:" name))))
+ (let ((test-name (intern (concat "parseclj-parse-clojure:"
name))))
`(ert-deftest ,test-name ()
:tags '(parseclj-ast)
(with-temp-buffer
(insert ,(a-get data :source))
(goto-char 1)
- (should (a-equal (parseclj-ast-parse) ',(a-get data
:ast)))))))))
+ (should (a-equal (parseclj-parse-clojure) ',(a-get data
:ast)))))))))
parseclj-test-data)))
(defmacro define-parseclj-ast-roundtrip-tests ()
@@ -58,11 +58,11 @@
(let ((test-name (intern (concat "parseclj-ast-rountrip:"
name))))
`(ert-deftest ,test-name ()
:tags '(parseclj-ast-rountrip)
- (should (a-equal (parseclj-ast-parse-str
(parseclj-ast-unparse-str ',(a-get data :ast))) ',(a-get data :ast))))))))
+ (should (a-equal (parseclj-parse-clojure
(parseclj-ast-unparse-str ',(a-get data :ast))) ',(a-get data :ast))))))))
parseclj-test-data)))
(define-parseclj-ast-roundtrip-tests)
-(define-parseclj-ast-parse-tests)
+(define-parseclj-parse-clojure-tests)
;;; parseclj-ast-test.el ends here
