[nongnu] elpa/parseclj 87953e44ba 092/185: Parse options on to the reducers

[ELPA Syncer]

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

    Parse options on to the reducers
    
    This changes the signature of the reducers to also receive a final `options`
    argument. This is currently only used by parseedn to pass through the
    :tag-readers, but it could also be used by `parseedn` to bail on non-edn
    features when `:fail-fast` is enabled.
---
 parseclj-ast.el | 12 ++++++------
 parseclj.el     |  9 +++++----
 parseedn.el     | 51 ++++++++++++++++++++++++++-------------------------
 3 files changed, 37 insertions(+), 35 deletions(-)

diff --git a/parseclj-ast.el b/parseclj-ast.el
index 2b53cf3ec8..7326471af1 100644
--- a/parseclj-ast.el
+++ b/parseclj-ast.el
@@ -51,7 +51,7 @@ Other ATTRIBUTES can be given as a flat list of key-value 
pairs. "
 
 ;; Parse/reduce strategy functions
 
-(defun parseclj-ast--reduce-leaf (stack token)
+(defun parseclj-ast--reduce-leaf (stack token options)
   (if (member (parseclj-lex-token-type token) '(:whitespace :comment))
       stack
     (cons
@@ -61,7 +61,7 @@ Other ATTRIBUTES can be given as a flat list of key-value 
pairs. "
                         :value (parseclj--leaf-token-value token))
      stack)))
 
-(defun parseclj-ast--reduce-leaf-with-lexical-preservation (stack token)
+(defun parseclj-ast--reduce-leaf-with-lexical-preservation (stack token 
options)
   (let ((token-type (parseclj-lex-token-type token))
         (top (car stack)))
     (if (member token-type '(:whitespace :comment))
@@ -73,9 +73,9 @@ Other ATTRIBUTES can be given as a flat list of key-value 
pairs. "
                                    (a-get token :pos)
                                    :form (a-get token :form))
                 stack))
-      (parseclj-ast--reduce-leaf stack token))))
+      (parseclj-ast--reduce-leaf stack token options))))
 
-(defun parseclj-ast--reduce-branch (stack opening-token children)
+(defun parseclj-ast--reduce-branch (stack opening-token children options)
   (let* ((pos (a-get opening-token :pos))
          (type (parseclj-lex-token-type opening-token))
          (type (cl-case type
@@ -94,10 +94,10 @@ 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 (stack 
opening-token children)
+(defun parseclj-ast--reduce-branch-with-lexical-preservation (stack 
opening-token children options)
   (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))
+    (let* ((stack (funcall #'parseclj-ast--reduce-branch stack opening-token 
children options))
            (top (car stack)))
       (if (parseclj-ast-node? top)
           (cons (cl-list* (car top) ;; make sure :node-type remains the first 
element in the list
diff --git a/parseclj.el b/parseclj.el
index 7f0e662e44..8cd83f8902 100644
--- a/parseclj.el
+++ b/parseclj.el
@@ -149,7 +149,7 @@ can be handled with `condition-case'."
           ;; all good, call the reducer so it can return an updated stack with 
a
           ;; new node at the top.
           (let ((opening-token (pop stack)))
-            (funcall reduce-branch stack opening-token collection)))
+            (funcall reduce-branch stack opening-token collection options)))
 
       ;; Unwound the stack without finding a matching paren: either bail early
       ;; or return the original stack and continue parsing
@@ -257,7 +257,7 @@ functions. Additionally the following options are recognized
       ;; Reduce based on the top item on the stack (collections)
       (cond
        ((parseclj-lex-leaf-token? token)
-        (setf stack (funcall reduce-leaf stack token)))
+        (setf stack (funcall reduce-leaf stack token options)))
 
        ((parseclj-lex-closing-token? token)
         (setf stack (parseclj--reduce-coll stack token reduce-branch options)))
@@ -273,7 +273,7 @@ functions. Additionally the following options are recognized
           ;; (message "  - STACK %S" stack)
           ;; (message "  - OPENING_TOKEN %S" opening-token)
           ;; (message "  - TOP_VALUE %S\n" top-value)
-          (setq stack (funcall reduce-branch new-stack (car opening-token) 
(append (cdr opening-token) top-value)))))
+          (setq stack (funcall reduce-branch new-stack (car opening-token) 
(append (cdr opening-token) top-value) options))))
 
       (setq token (parseclj-lex-next)))
 
@@ -285,7 +285,8 @@ functions. Additionally the following options are recognized
                          (parseclj-lex-token-type token))))
 
     (car (funcall reduce-branch nil (parseclj-lex-token :root "" 1)
-                  (reverse stack)))))
+                  (reverse stack)
+                  options))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Top level API
diff --git a/parseedn.el b/parseedn.el
index 863671d35a..9eaa9fd38e 100644
--- a/parseedn.el
+++ b/parseedn.el
@@ -41,38 +41,39 @@ is not recommended you change this variable, as this 
globally
 changes the behavior of the EDN reader. Instead pass your own
 handlers as an optional argument to the reader functions.")
 
-(defun parseedn-reduce-leaf (stack token)
+(defun parseedn-reduce-leaf (stack token options)
   (if (member (parseclj-lex-token-type token) (list :whitespace :comment))
       stack
     (cons (parseclj--leaf-token-value token) stack)))
 
-(defun parseedn-reduce-branch (tag-readers)
-  (lambda (stack opening-token children)
-    (let ((token-type (parseclj-lex-token-type opening-token)))
-      (if (eq token-type :discard)
-          stack
-        (cons
-         (cl-case token-type
-           (:root children)
-           (:lparen children)
-           (:lbracket (apply #'vector children))
-           (:set (list 'edn-set children))
-           (:lbrace (let* ((kvs (seq-partition children 2))
-                           (hash-map (make-hash-table :test 'equal :size 
(length kvs))))
-                      (seq-do (lambda (pair)
-                                (puthash (car pair) (cadr pair) hash-map))
-                              kvs)
-                      hash-map))
-           (:tag (let* ((tag (intern (substring (a-get opening-token :form) 
1)))
-                        (reader (a-get tag-readers tag :missing)))
-                   (when (eq :missing reader)
-                     (user-error "No reader for tag #%S in %S" tag (a-keys 
tag-readers)))
-                   (funcall reader (car children)))))
-         stack)))))
+(defun parseedn-reduce-branch (stack opening-token children options)
+  (let ((tag-readers (a-merge parseedn-default-tag-readers (a-get options 
:tag-readers)))
+        (token-type (parseclj-lex-token-type opening-token)))
+    (if (eq token-type :discard)
+        stack
+      (cons
+       (cl-case token-type
+         (:root children)
+         (:lparen children)
+         (:lbracket (apply #'vector children))
+         (:set (list 'edn-set children))
+         (:lbrace (let* ((kvs (seq-partition children 2))
+                         (hash-map (make-hash-table :test 'equal :size (length 
kvs))))
+                    (seq-do (lambda (pair)
+                              (puthash (car pair) (cadr pair) hash-map))
+                            kvs)
+                    hash-map))
+         (:tag (let* ((tag (intern (substring (a-get opening-token :form) 1)))
+                      (reader (a-get tag-readers tag :missing)))
+                 (when (eq :missing reader)
+                   (user-error "No reader for tag #%S in %S" tag (a-keys 
tag-readers)))
+                 (funcall reader (car children)))))
+       stack))))
 
 (defun parseedn-read (&optional tag-readers)
   (parseclj-parse #'parseedn-reduce-leaf
-                    (parseedn-reduce-branch (a-merge 
parseedn-default-tag-readers tag-readers))))
+                  #'parseedn-reduce-branch
+                  (a-list :tag-readers tag-readers)))
 
 (defun parseedn-read-str (s &optional tag-readers)
   (with-temp-buffer