[nongnu] elpa/parseclj ff0443c27c 151/185: Add :read-one option

[ELPA Syncer]

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

    Add :read-one option
    
    Adds an option, `:read-one t`, which makes the parser behaves more like a 
LISP
    `read` function: it will read a single form and return it.
    
    In this case there is no extra `:root` node, the parsed node is returned
    directly.
---
 parseclj-parser.el    | 28 +++++++++++++++++++++++-----
 parseclj.el           |  4 +++-
 test/parseclj-test.el | 17 +++++++++++++++++
 3 files changed, 43 insertions(+), 6 deletions(-)

diff --git a/parseclj-parser.el b/parseclj-parser.el
index ef04e16ef7..d0e5d24a21 100644
--- a/parseclj-parser.el
+++ b/parseclj-parser.el
@@ -149,6 +149,18 @@ TOKEN-TYPES are the token types to look for."
          (t
           (push (pop stack) result)))))))
 
+(defun parseclj-single-value-p (stack value-p)
+  "Return t if STACK only has a single node for which VALUE-P is true.
+
+This checks if the stack contains a single, fully reduced value, and no
+dangling unmatched tokens.  When parsing with `:read-one' this indicates a
+form can be returned."
+  (and (not (cl-reduce (lambda (bool node)
+                         (or bool (parseclj-lex-token-p node)))
+                       stack
+                       :initial-value nil))
+       (parseclj--take-value stack value-p)))
+
 (defun parseclj-parser (reduce-leaf reduce-branch &optional options)
   "Clojure/EDN stack-based shift-reduce parser.
 
@@ -186,13 +198,17 @@ functions. Additionally the following options are 
recognized
 - `:tag-readers'
   An association list that describes tag handler functions for any possible
   tag.  This options in only available in `parseedn-read', for more
-  information, please refer to its documentation."
+  information, please refer to its documentation.
+- `:read-one'
+  Return as soon as a single complete value has been read."
   (let ((fail-fast (a-get options :fail-fast t))
+        (read-one (a-get options :read-one))
         (value-p (a-get options :value-p (lambda (e) (not 
(parseclj-lex-token-p e)))))
         (stack nil)
         (token (parseclj-lex-next)))
 
-    (while (not (eq (parseclj-lex-token-type token) :eof))
+    (while (not (or (and read-one (parseclj-single-value-p stack value-p))
+                    (eq (parseclj-lex-token-type token) :eof)))
       ;; (message "STACK: %S" stack)
       ;; (message "TOKEN: %S\n" token)
 
@@ -252,9 +268,11 @@ functions. Additionally the following options are 
recognized
                          (a-get token :pos)
                          (parseclj-lex-token-type token))))
 
-    (car (funcall reduce-branch nil (parseclj-lex-token :root "" 1)
-                  (reverse stack)
-                  options))))
+    (if read-one
+        (car (parseclj--take-value stack value-p))
+      (car (funcall reduce-branch nil (parseclj-lex-token :root "" 1)
+                    (reverse stack)
+                    options)))))
 
 (provide 'parseclj-parser)
 ;;; parseclj-parser.el ends here
diff --git a/parseclj.el b/parseclj.el
index 6a4849dd6c..5a0743141e 100644
--- a/parseclj.el
+++ b/parseclj.el
@@ -45,7 +45,9 @@ key-value pairs to specify parsing options.
 - `:lexical-preservation' Retain whitespace, comments, and
   discards.  Defaults to nil.
 - `:fail-fast' Raise an error when encountering invalid syntax.
-  Defaults to t."
+  Defaults to t.
+- `:read-one'
+  Read a single form.  Defaults to false: parse the complete input."
   (if (stringp (car string-and-options))
       (with-temp-buffer
         (insert (car string-and-options))
diff --git a/test/parseclj-test.el b/test/parseclj-test.el
index a25d2e4e3b..a60ad9407a 100644
--- a/test/parseclj-test.el
+++ b/test/parseclj-test.el
@@ -319,6 +319,23 @@
            (new-stack (nthcdr (+ (length top-value) (length opening-token)) 
stack)))
       top-value)))
 
+(ert-deftest parseclj---read-one-test ()
+  (equal (parseclj-parse-clojure "(+ 1 1) foo bar" :read-one t)
+         '((:node-type . :list)
+           (:position . 1)
+           (:children ((:node-type . :symbol)
+                       (:position . 2)
+                       (:form . "+")
+                       (:value . +))
+                      ((:node-type . :number)
+                       (:position . 4)
+                       (:form . "1")
+                       (:value . 1))
+                      ((:node-type . :number)
+                       (:position . 6)
+                       (:form . "1")
+                       (:value . 1))))))
+
 (provide 'parseclj-test)
 
 ;;; parseclj-test.el ends here