[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/parseclj c62a11884d 165/185: First pass in inlining the ne
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/parseclj c62a11884d 165/185: First pass in inlining the necessary bits from a.el |
Date: |
Tue, 28 Dec 2021 14:05:33 -0500 (EST) |
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]))))
- [nongnu] elpa/parseclj f395b9cbcc 097/185: Move `parseclj--leaf-token-value` to `parseedn` module, (continued)
- [nongnu] elpa/parseclj f395b9cbcc 097/185: Move `parseclj--leaf-token-value` to `parseedn` module, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 91dd43667c 110/185: Fix `parseclj-ast--reduce-branch` for tags., ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 9a586f267d 103/185: Remove `parseedn` requirement from `parseclj`, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj e65eb085ad 114/185: Remove duplicated test, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 811f35e05a 117/185: Loops reduction over the first 2 elements of the stack, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 5b4b222b4f 124/185: Return error token when there's invalid input in `parseclj-lex-next`, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj b26fadbc05 128/185: Get rid of `parseclj-lex-error-token` side-effect, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 2ffadc6239 134/185: Mark OPTIONS as unused in `parseedn-reduce-leaf`, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 45cd754c32 140/185: Remove parseedn files, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 3e48aa7b40 141/185: Remove mentions to parseedn in README.md, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj c62a11884d 165/185: First pass in inlining the necessary bits from a.el,
ELPA Syncer <=
- [nongnu] elpa/parseclj 8a361f4c05 175/185: Merge pull request #32 from dawranliou/dawranliou/remove-a-el-part-3, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 6f9ab8f89c 181/185: Replace `cl-case` calls with `cond`, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 1dc147f552 027/185: Support character literals, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj da1929be0b 031/185: Add vector support, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 1c8f833b4c 176/185: Release 1.0.2, ELPA Syncer, 2021/12/28