[nongnu] elpa/parseclj 7beff77b15 083/185: Introduce parseclj-parse-clojure

[ELPA Syncer]

branch: elpa/parseclj
commit 7beff77b154b4d39672f66632c92d071fe7d6842
Author: Arne Brasseur <arne@arnebrasseur.net>
Commit: Arne Brasseur <arne@arnebrasseur.net>

    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