[nongnu] elpa/parseclj c62a11884d 165/185: First pass in inlining the necessary bits from a.el

[ELPA Syncer]

branch: elpa/parseclj
commit c62a11884d813ac45c5672fa8943124222e65095
Author: Arne Brasseur <arne@arnebrasseur.net>
Commit: Bozhidar Batsov <bozhidar@batsov.dev>

    First pass in inlining the necessary bits from a.el
---
 parseclj-ast.el            | 38 ++++++++++++++---------------
 parseclj-parser.el         | 18 +++++++-------
 parseclj.el                | 61 +++++++++++++++++++++++++++++++++++++++++++---
 test/parseclj-ast-test.el  | 11 ++++-----
 test/parseclj-test-data.el | 42 +++++++++++++++----------------
 5 files changed, 112 insertions(+), 58 deletions(-)

diff --git a/parseclj-ast.el b/parseclj-ast.el
index e7b3cebc71..3070b74750 100644
--- a/parseclj-ast.el
+++ b/parseclj-ast.el
@@ -37,7 +37,7 @@
 (defun parseclj-ast-node (type position &rest attributes)
   "Create an AST node with given TYPE and POSITION.
 Other ATTRIBUTES can be given as a flat list of key-value pairs."
-  (apply 'a-list :node-type type :position position attributes))
+  (apply 'parseclj-alist :node-type type :position position attributes))
 
 (defun parseclj-ast-node-p (node)
   "Return t if the given NODE is a Clojure AST node."
@@ -47,19 +47,19 @@ Other ATTRIBUTES can be given as a flat list of key-value 
pairs."
 
 (defun parseclj-ast-node-attr (node attr)
   "Return NODE's ATTR, or nil."
-  (a-get node attr))
+  (parseclj-alist-get node attr))
 
 (defun parseclj-ast-node-type (node)
   "Return the type of the AST node NODE."
-  (a-get node :node-type))
+  (parseclj-alist-get node :node-type))
 
 (defun parseclj-ast-children (node)
   "Return children for the AST NODE."
-  (a-get node :children))
+  (parseclj-alist-get node :children))
 
 (defun parseclj-ast-value (node)
   "Return the value of NODE as another AST node."
-  (a-get node :value))
+  (parseclj-alist-get node :value))
 
 (defun parseclj-ast-leaf-node-p (node)
   "Return t if the given ast NODE is a leaf node."
@@ -82,8 +82,8 @@ on available options."
       stack
     (cons
      (parseclj-ast-node (parseclj-lex-token-type token)
-                        (a-get token :pos)
-                        :form (a-get token :form)
+                        (parseclj-alist-get token :pos)
+                        :form (parseclj-alist-get token :form)
                         :value (parseclj-lex--leaf-token-value token))
      stack)))
 
@@ -100,12 +100,12 @@ on available options."
         (top (car stack)))
     (if (member token-type '(:whitespace :comment))
         ;; merge consecutive whitespace or comment tokens
-        (if (eq token-type (a-get top :node-type))
-            (cons (a-update top :form #'concat (a-get token :form))
+        (if (eq token-type (parseclj-alist-get top :node-type))
+            (cons (parseclj-alist-update top :form #'concat 
(parseclj-alist-get token :form))
                   (cdr stack))
           (cons (parseclj-ast-node (parseclj-lex-token-type token)
-                                   (a-get token :pos)
-                                   :form (a-get token :form))
+                                   (parseclj-alist-get token :pos)
+                                   :form (parseclj-alist-get token :form))
                 stack))
       (parseclj-ast--reduce-leaf stack token options))))
 
@@ -118,7 +118,7 @@ brace.
 CHILDREN is the collection of nodes to be reduced into the AST branch node.
 OPTIONS is an association list.  See `parseclj-parse' for more information
 on available options."
-  (let* ((pos (a-get opening-token :pos))
+  (let* ((pos (parseclj-alist-get opening-token :pos))
          (type (parseclj-lex-token-type opening-token))
          (type (cl-case type
                  (:lparen :list)
@@ -130,15 +130,15 @@ on available options."
       (:discard stack)
       (:tag (cons (parseclj-ast-node :tag
                                      pos
-                                     :tag (intern (substring (a-get 
opening-token :form) 1))
+                                     :tag (intern (substring 
(parseclj-alist-get opening-token :form) 1))
                                      :children children)
                   stack))
       (:metadata (cons (parseclj-ast-node :with-meta
                                           pos
                                           :children children)
                        stack))
-      (:map-prefix (cons (a-assoc (car children)
-                                  :map-prefix opening-token)
+      (:map-prefix (cons (parseclj-alist-assoc (car children)
+                                               :map-prefix opening-token)
                          stack))
       (t (cons
           (parseclj-ast-node type pos :children children)
@@ -157,7 +157,7 @@ node.
 OPTIONS is an association list.  See `parseclj-parse' for more information
 on available options."
   (if (eq :discard (parseclj-lex-token-type opening-token))
-      (cons (parseclj-ast-node :discard (a-get opening-token :pos) :children 
children) stack)
+      (cons (parseclj-ast-node :discard (parseclj-alist-get opening-token 
:pos) :children children) stack)
     (let* ((stack (funcall #'parseclj-ast--reduce-branch stack opening-token 
children options))
            (top (car stack)))
       (if (parseclj-ast-node-p top)
@@ -187,7 +187,7 @@ on available options."
       (when-let (node (car nodes))
         (parseclj-unparse-clojure node))
       (seq-doseq (child (cdr nodes))
-        (when (not (a-get node :lexical-preservation))
+        (when (not (parseclj-alist-get node :lexical-preservation))
           (insert " "))
         (parseclj-unparse-clojure child)))
     (insert (cdr delimiters))))
@@ -196,9 +196,9 @@ on available options."
   "Insert a string representation of the given AST tag NODE into buffer."
   (progn
     (insert "#")
-    (insert (symbol-name (a-get node :tag)))
+    (insert (symbol-name (parseclj-alist-get node :tag)))
     (insert " ")
-    (parseclj-unparse-clojure (car (a-get node :children)))))
+    (parseclj-unparse-clojure (car (parseclj-alist-get node :children)))))
 
 (provide 'parseclj-ast)
 
diff --git a/parseclj-parser.el b/parseclj-parser.el
index fe3bb3c818..9f078c6a8f 100644
--- a/parseclj-parser.el
+++ b/parseclj-parser.el
@@ -71,12 +71,12 @@ OPTIONS is an association list.  This list is also passed 
down to the
 REDUCE-BRANCH function.  See `parseclj-parser' for more information on
 available options."
   (let ((opening-token-type (parseclj--find-opening-token stack closing-token))
-        (fail-fast (a-get options :fail-fast t))
+        (fail-fast (parseclj-alist-get options :fail-fast t))
         (collection nil))
     (if (not opening-token-type)
         (if fail-fast
             (parseclj--error "At position %s, unmatched %S"
-                             (a-get closing-token :pos)
+                             (parseclj-alist-get closing-token :pos)
                              (parseclj-lex-token-type closing-token))
 
           stack)
@@ -93,7 +93,7 @@ available options."
                 ;; any unreduced tokens left: bail early
                 (when-let ((token (seq-find #'parseclj-lex-token-p 
collection)))
                   (parseclj--error "At position %s, unmatched %S"
-                                   (a-get token :pos)
+                                   (parseclj-alist-get token :pos)
                                    (parseclj-lex-token-type token))))
 
               ;; all good, call the reducer so it can return an updated stack 
with a
@@ -105,7 +105,7 @@ available options."
           ;; or return the original stack and continue parsing
           (if fail-fast
               (parseclj--error "At position %s, unmatched %S"
-                               (a-get closing-token :pos)
+                               (parseclj-alist-get closing-token :pos)
                                (parseclj-lex-token-type closing-token))
 
             (reverse collection)))))))
@@ -209,9 +209,9 @@ functions. Additionally the following options are recognized
   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)))))
+  (let ((fail-fast (parseclj-alist-get options :fail-fast t))
+        (read-one (parseclj-alist-get options :read-one))
+        (value-p (parseclj-alist-get options :value-p (lambda (e) (not 
(parseclj-lex-token-p e)))))
         (stack nil)
         (token (parseclj-lex-next)))
 
@@ -222,7 +222,7 @@ functions. Additionally the following options are recognized
 
       (when (and fail-fast (parseclj-lex-error-p token))
         (parseclj--error "Invalid token at %s: %S"
-                         (a-get token :pos)
+                         (parseclj-alist-get token :pos)
                          (parseclj-lex-token-form token)))
 
       ;; Reduce based on the top item on the stack (collections)
@@ -273,7 +273,7 @@ functions. Additionally the following options are recognized
     (when fail-fast
       (when-let ((token (seq-find #'parseclj-lex-token-p stack)))
         (parseclj--error "At position %s, unmatched %S"
-                         (a-get token :pos)
+                         (parseclj-alist-get token :pos)
                          (parseclj-lex-token-type token))))
 
     (if read-one
diff --git a/parseclj.el b/parseclj.el
index 7515d5e04c..0cd293f366 100644
--- a/parseclj.el
+++ b/parseclj.el
@@ -33,6 +33,61 @@
 (require 'parseclj-parser)
 (require 'parseclj-ast)
 
+(defun parseclj-alist (&rest kvs)
+  "Create an association list from the given keys and values KVS.
+Arguments are simply provided in sequence, rather than as lists or cons cells.
+For example: (a-alist :foo 123 :bar 456)"
+  (mapcar (lambda (kv) (cons (car kv) (cadr kv))) (seq-partition kvs 2)))
+
+(defun parseclj-hash-table (&rest kvs)
+  "Create a hash table from the given keys and values KVS.
+Arguments are simply provided in sequence, rather than as lists
+or cons cells. As \"test\" for the hash table, equal is used. The
+hash table is created without extra storage space, so with a size
+equal to amount of key-value pairs, since it is assumed to be
+treated as immutable.
+For example: (a-hash-table :foo 123 :bar 456)"
+  (let* ((kv-pairs (seq-partition kvs 2))
+         (hash-map (make-hash-table :test 'equal :size (length kv-pairs))))
+    (seq-do (lambda (pair)
+              (puthash (car pair) (cadr pair) hash-map))
+            kv-pairs)
+    hash-map))
+
+(defun parseclj-alist-get (map key &optional not-found)
+  "Like alist-get, but uses equal instead of eq to look up in map MAP key KEY.
+Returns NOT-FOUND if the key is not present, or `nil' if
+NOT-FOUND is not specified."
+  (cl-block nil
+    (seq-doseq (pair map)
+      (when (equal (car pair) key)
+        (cl-return (cdr pair))))
+    not-found))
+
+(defun parseclj-alist-has-key? (coll k)
+  "Check if the given association list COLL has a certain key K."
+  (not (eq (parseclj-alist-get coll k :not-found) :not-found)))
+
+(defun parseclj-alist-assoc (coll k v)
+  (if (parseclj-alist-has-key? coll k)
+      (mapcar (lambda (entry)
+                (if (equal (car entry) k)
+                    (cons k v)
+                  entry))
+              coll)
+    (cons (cons k v) coll)))
+
+(defun parseclj-alist-update (coll key fn &rest args)
+  "In collection COLL, at location KEY, apply FN with extra args ARGS.
+'Updates' a value in an associative collection COLL, where KEY is
+a key and FN is a function that will take the old value and any
+supplied args and return the new value, and returns a new
+structure. If the key does not exist, nil is passed as the old
+value."
+  (parseclj-alist-assoc coll
+                        key
+                        (apply #'funcall fn (parseclj-alist-get coll key) 
args)))
+
 (defun parseclj-parse-clojure (&rest string-and-options)
   "Parse Clojure source to AST.
 
@@ -56,8 +111,8 @@ key-value pairs to specify parsing options.
     (let* ((value-p (lambda (e)
                       (and (parseclj-ast-node-p e)
                            (not (member (parseclj-ast-node-type e) 
'(:whitespace :comment :discard))))))
-           (options (apply 'a-list :value-p value-p string-and-options))
-           (lexical? (a-get options :lexical-preservation)))
+           (options (apply 'parseclj-alist :value-p value-p 
string-and-options))
+           (lexical? (parseclj-alist-get options :lexical-preservation)))
       (parseclj-parser (if lexical?
                            
#'parseclj-ast--reduce-leaf-with-lexical-preservation
                          #'parseclj-ast--reduce-leaf)
@@ -73,7 +128,7 @@ Given an abstract syntax tree AST (as returned by
 `parseclj-parse-clojure'), turn it back into source code, and
 insert it into the current buffer."
   (if (parseclj-ast-leaf-node-p ast)
-      (insert (a-get ast :form))
+      (insert (parseclj-alist-get ast :form))
     (if (eql (parseclj-ast-node-type ast) :tag)
         (parseclj-ast--unparse-tag ast)
       (parseclj-ast--unparse-collection ast))))
diff --git a/test/parseclj-ast-test.el b/test/parseclj-ast-test.el
index fe99b56186..72d6674b63 100644
--- a/test/parseclj-ast-test.el
+++ b/test/parseclj-ast-test.el
@@ -38,14 +38,14 @@
         (lambda (pair)
           (let ((name (car pair))
                 (data (cdr pair)))
-            (if (and (a-get data :source) (a-get data :ast))
+            (if (and (parseclj-alist-get data :source) (parseclj-alist-get 
data :ast))
                 (let ((test-name (intern (concat "parseclj-parse-clojure:" 
name))))
                   `(ert-deftest ,test-name ()
                      :tags '(parseclj-ast)
                      (with-temp-buffer
-                       (insert ,(a-get data :source))
+                       (insert ,(parseclj-alist-get data :source))
                        (goto-char 1)
-                       (should (a-equal (parseclj-parse-clojure) ',(a-get data 
:ast)))))))))
+                       (should (a-equal (parseclj-parse-clojure) 
',(parseclj-alist-get data :ast)))))))))
         parseclj-test-data)))
 
 (defmacro define-parseclj-ast-roundtrip-tests ()
@@ -54,14 +54,13 @@
         (lambda (pair)
           (let ((name (car pair))
                 (data (cdr pair)))
-            (if (and (a-get data :ast) (a-get data :source))
+            (if (and (parseclj-alist-get data :ast) (parseclj-alist-get data 
:source))
                 (let ((test-name (intern (concat "parseclj-ast-rountrip:" 
name))))
                   `(ert-deftest ,test-name ()
                      :tags '(parseclj-ast-rountrip)
-                     (should (a-equal (parseclj-parse-clojure 
(parseclj-unparse-clojure-to-string ',(a-get data :ast))) ',(a-get data 
:ast))))))))
+                     (should (a-equal (parseclj-parse-clojure 
(parseclj-unparse-clojure-to-string ',(parseclj-alist-get data :ast))) 
',(parseclj-alist-get data :ast))))))))
         parseclj-test-data)))
 
-
 (define-parseclj-ast-roundtrip-tests)
 (define-parseclj-parse-clojure-tests)
 
diff --git a/test/parseclj-test-data.el b/test/parseclj-test-data.el
index 1b739de399..cc7a8ba490 100644
--- a/test/parseclj-test-data.el
+++ b/test/parseclj-test-data.el
@@ -28,10 +28,10 @@
 ;;; Code:
 
 (setq parseclj-test-data
-      (a-list
+      (parseclj-alist
 
        "simple-list"
-       (a-list
+       (parseclj-alist
         :tags '(:edn-roundtrip)
         :source "(1 2 3)"
         :edn '((1 2 3))
@@ -54,7 +54,7 @@
 
 
        "empty-list"
-       (a-list
+       (parseclj-alist
         :source "()"
         :edn '(())
         :ast '((:node-type . :root)
@@ -64,7 +64,7 @@
                               (:children . nil))))))
 
        "size-1"
-       (a-list
+       (parseclj-alist
         :tags '(:edn-roundtrip)
         :source "(1)"
         :edn '((1))
@@ -78,7 +78,7 @@
                                              (:value . 1)))))))))
 
        "leafs"
-       (a-list
+       (parseclj-alist
         :source "(nil true false hello-world)"
         :edn '((nil t nil hello-world))
         :ast '((:node-type . :root)
@@ -103,7 +103,7 @@
                                              (:value . hello-world)))))))))
 
        "qualified-symbol"
-       (a-list
+       (parseclj-alist
         :tags '(:edn-roundtrip)
         :source "clojure.string/join"
         :edn '(clojure.string/join)
@@ -115,7 +115,7 @@
                               (:value . clojure.string/join))))))
 
        "nested-lists"
-       (a-list
+       (parseclj-alist
         :source "((.9 abc (true) (hello)))"
         :edn '(((0.9 abc (t) (hello))))
         :ast '((:node-type . :root)
@@ -146,7 +146,7 @@
                                                                      (:value . 
hello)))))))))))))
 
        "strings-1"
-       (a-list
+       (parseclj-alist
         :tags '(:edn-roundtrip)
         :source "\"abc hello \\t\\\"x\""
         :edn '("abc hello \t\"x")
@@ -158,7 +158,7 @@
                               (:value . "abc hello \t\"x"))))))
 
        "strings-2"
-       (a-list
+       (parseclj-alist
         :source "(\"---\\f---\\\"-'\\'-\\\\-\\r\\n\")"
         :edn '(("---\f---\"-''-\\-\r\n"))
         :ast '((:node-type . :root)
@@ -171,7 +171,7 @@
                                              (:value . 
"---\f---\"-''-\\-\r\n")))))))))
 
        "chars-1"
-       (a-list
+       (parseclj-alist
         :source "(\\newline \\return \\space \\tab \\a \\b \\c \\u0078 \\o171)"
         :edn '((?\n ?\r ?\ ?\t ?a ?b ?c ?x ?y))
         :ast '((:node-type . :root)
@@ -189,7 +189,7 @@
                                             ((:node-type . :character) 
(:position . 47) (:form . "\\o171") (:value . ?y)))))))))
 
        "chars-2"
-       (a-list
+       (parseclj-alist
         :source "\"\\u0078 \\o171\""
         :edn '("x y")
         :ast '((:node-type . :root)
@@ -200,7 +200,7 @@
                               (:value . "x y"))))))
 
        "keywords"
-       (a-list
+       (parseclj-alist
         :tags '(:edn-roundtrip)
         :source ":foo-bar"
         :edn '(:foo-bar)
@@ -212,7 +212,7 @@
                               (:value . :foo-bar))))))
 
        "vector"
-       (a-list
+       (parseclj-alist
         :tags '(:edn-roundtrip)
         :source "[123]"
         :edn '([123])
@@ -226,10 +226,10 @@
                                              (:value . 123)))))))))
 
        "map"
-       (a-list
+       (parseclj-alist
         :tags '(:edn-roundtrip)
         :source "{:count 123}"
-        :edn (list (a-hash-table :count 123))
+        :edn (list (parseclj-hash-table :count 123))
         :ast '((:node-type . :root)
                (:position . 1)
                (:children . (((:node-type . :map)
@@ -244,7 +244,7 @@
                                              (:value . 123)))))))))
 
        "set"
-       (a-list
+       (parseclj-alist
         :tags '(:edn-roundtrip)
         :source "#{:x}"
         :edn '((edn-set (:x)))
@@ -258,7 +258,7 @@
                                              (:value . :x)))))))))
 
        "discard"
-       (a-list
+       (parseclj-alist
         :source "(10 #_11 12 #_#_ 13 14)"
         :edn '((10 12))
         :ast '((:node-type . :root)
@@ -276,7 +276,7 @@
 
 
        "tag-1"
-       (a-list
+       (parseclj-alist
         :source "#foo/bar [1]"
         :ast '((:node-type . :root)
                (:position . 1)
@@ -291,7 +291,7 @@
                                                             (:value . 
1))))))))))))
 
        "tag-2"
-       (a-list
+       (parseclj-alist
         :source "(fn #param :param-name 1)"
         :ast '((:node-type . :root)
                (:position . 1)
@@ -314,7 +314,7 @@
                                              (:value . 1)))))))))
 
        "nested-tags"
-       (a-list
+       (parseclj-alist
         :source "[#lazy-error #error {:cause \"Divide by zero\"}]"
         :ast '((:node-type . :root)
                (:position . 1)
@@ -338,7 +338,7 @@
                                                                            
(:value . "Divide by zero")))))))))))))
 
        "booleans"
-       (a-list
+       (parseclj-alist
         :source "[nil true false]"
         :edn '([nil t nil]))))