From 2832bb6f6b7bcdf1e404b0c78a6abb7dfbcedce6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?I=C3=B1aki=20Arenaza?= Date: Fri, 8 Sep 2023 22:14:12 +0200 Subject: [PATCH 1/3] Add support for namespaced maps parseclj already added support for namespaced maps in 2018 (in commit b40670a56147214f0486763529897cb688a09692). As Alex Miller said in https://github.com/edn-format/edn/issues/78 > Clojure introduced namespace map syntax in Clojure 1.9. The Clojure > edn reader was also updated to support the non-autoresolved parts of > namespace map syntax (edn doesn't do anything autoresolved like > ::foo or #::foo{}). > > The edn spec should be updated to a new version that includes the > namespace map syntax such as #:foo{:bar 1} (syntax alternative for > {:foo/bar 1}). So it's pretty clear that the intention is for edn spec to support namespaced maps (the reference implementation in Clojure already does!). In addition to the use case mentioned in issue #16, not supporting this seems to cause trouble in CIDER when integrating with shadow-cljs (https://github.com/clojure-emacs/cider/issues/3437) Fixes: #16 --- parseedn.el | 18 ++++++++++++-- test/parseedn-test-data.el | 50 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 2 deletions(-) diff --git a/parseedn.el b/parseedn.el index 99dd703..0532268 100644 --- a/parseedn.el +++ b/parseedn.el @@ -113,10 +113,24 @@ on available options." ((eq :lbracket token-type) (apply #'vector children)) ((eq :set token-type) (list 'edn-set children)) ((eq :lbrace token-type) (let* ((kvs (seq-partition children 2)) - (hash-map (make-hash-table :test 'equal :size (length kvs)))) + (hash-map (make-hash-table :test 'equal :size (length kvs))) + (prefixed-map? (eq :map-prefix (parseclj-lex-token-type (car stack)))) + (map-prefix (when prefixed-map? + ;; map-prefix forms are always "#:...." + (substring (parseclj-lex-token-form (car stack)) 2)))) (seq-do (lambda (pair) - (puthash (car pair) (cadr pair) hash-map)) + (let* ((k (if (not prefixed-map?) + (car pair) + (let ((key-name (substring (symbol-name (car pair)) 1))) + (if (string-match-p "/" key-name) + ;; keyword is already qualified, we must not add the prefix. + (car pair) + (intern (concat ":" map-prefix "/" key-name)))))) + (v (cadr pair))) + (puthash k v hash-map))) kvs) + (when prefixed-map? + (setq stack (cdr stack))) hash-map)) ((eq :tag token-type) (let* ((tag (intern (substring (alist-get :form opening-token) 1))) (reader (alist-get tag tag-readers)) diff --git a/test/parseedn-test-data.el b/test/parseedn-test-data.el index 7fe31ac..212e8df 100644 --- a/test/parseedn-test-data.el +++ b/test/parseedn-test-data.el @@ -245,6 +245,56 @@ (:form . "123") (:value . 123))))))))) + "prefixed-map-1" + (a-list + :source "#:foo.bar{:baz 1 :other.ns.prefix/qux 2}" + :edn (list (a-hash-table :foo.bar/baz 1 :other.ns.prefix/qux 2)) + :ast '((:node-type . :root) + (:position . 1) + (:children . (((:map-prefix + (:token-type . :map-prefix) + (:form . "#:foo.bar") + (:pos . 1)) + (:node-type . :map) + (:position . 10) + (:children . (((:node-type . :keyword) + (:position . 11) + (:form . ":baz") + (:value . :baz)) + ((:node-type . :number) + (:position . 16) + (:form . "1") + (:value . 1)) + ((:node-type . :keyword) + (:position . 18) + (:form . ":other.ns.prefix/qux") + (:value . :other.ns.prefix/qux)) + ((:node-type . :number) + (:position . 39) + (:form . "2") + (:value . 2))))))))) + + "prefixed-map-2" + (a-list + :source "#:foo.bar {:baz 1}" + :edn (list (a-hash-table :foo.bar/baz 1)) + :ast '((:node-type . :root) + (:position . 1) + (:children . (((:map-prefix + (:token-type . :map-prefix) + (:form . "#:foo.bar") + (:pos . 1)) + (:node-type . :map) + (:position . 10) + (:children . (((:node-type . :keyword) + (:position . 11) + (:form . ":baz") + (:value . :baz)) + ((:node-type . :number) + (:position . 16) + (:form . "1") + (:value . 1))))))))) + "set" (a-list :tags '(:edn-roundtrip) From 6158c39a3f9b786dddc9232a498f14a9a276cb92 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?I=C3=B1aki=20Arenaza?= Date: Tue, 12 Sep 2023 09:02:41 +0200 Subject: [PATCH 2/3] Remove all `:ast` values parseedn-read never sees the full value of the `:ast` keys as defined in `parseedn-test-data.el`. In fact, it doesn't know about it at all. The only functions that see anything related to the `:ast` values are `parseedn-reduce-leaf` and `parseedn-reduce-branch`. But they are called back from `parseclj` when needed, to "reduce" (transform the current AST node definition into the associated Emacs Lisp data type). As commented in https://github.com/clojure-emacs/parseedn/pull/17#discussion_r1321814637, they very likely are remnants of when parseedn and parseclj were the same library. --- test/parseedn-test-data.el | 290 +++---------------------------------- 1 file changed, 20 insertions(+), 270 deletions(-) diff --git a/test/parseedn-test-data.el b/test/parseedn-test-data.el index 212e8df..399405d 100644 --- a/test/parseedn-test-data.el +++ b/test/parseedn-test-data.el @@ -36,295 +36,95 @@ (a-list :tags '(:edn-roundtrip) :source "(1 2 3)" - :edn '((1 2 3)) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :list) - (:position . 1) - (:children . (((:node-type . :number) - (:position . 2) - (:form . "1") - (:value . 1)) - ((:node-type . :number) - (:position . 4) - (:form . "2") - (:value . 2)) - ((:node-type . :number) - (:position . 6) - (:form . "3") - (:value . 3))))))))) + :edn '((1 2 3))) "empty-list" (a-list :source "()" - :edn '(()) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :list) - (:position . 1) - (:children . nil)))))) + :edn '(())) "size-1" (a-list :tags '(:edn-roundtrip) :source "(1)" - :edn '((1)) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :list) - (:position . 1) - (:children . (((:node-type . :number) - (:position . 2) - (:form . "1") - (:value . 1))))))))) + :edn '((1))) "leafs" (a-list :source "(nil true false hello-world)" - :edn '((nil t nil hello-world)) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :list) - (:position . 1) - (:children . (((:node-type . :nil) - (:position . 2) - (:form . "nil") - (:value . nil)) - ((:node-type . :true) - (:position . 6) - (:form . "true") - (:value . t)) - ((:node-type . :false) - (:position . 11) - (:form . "false") - (:value . nil)) - ((:node-type . :symbol) - (:position . 17) - (:form . "hello-world") - (:value . hello-world))))))))) + :edn '((nil t nil hello-world))) "qualified-symbol" (a-list :tags '(:edn-roundtrip) :source "clojure.string/join" - :edn '(clojure.string/join) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :symbol) - (:position . 1) - (:form . "clojure.string/join") - (:value . clojure.string/join)))))) + :edn '(clojure.string/join)) "nested-lists" (a-list :source "((.9 abc (true) (hello)))" - :edn '(((0.9 abc (t) (hello)))) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :list) - (:position . 1) - (:children . (((:node-type . :list) - (:position . 2) - (:children ((:node-type . :number) - (:position . 3) - (:form . ".9") - (:value . 0.9)) - ((:node-type . :symbol) - (:position . 6) - (:form . "abc") - (:value . abc)) - ((:node-type . :list) - (:position . 10) - (:children ((:node-type . :true) - (:position . 11) - (:form . "true") - (:value . t)))) - ((:node-type . :list) - (:position . 17) - (:children ((:node-type . :symbol) - (:position . 18) - (:form . "hello") - (:value . hello))))))))))))) + :edn '(((0.9 abc (t) (hello))))) "strings-1" (a-list :tags '(:edn-roundtrip) :source "\"abc hello \\t\\\"x\"" - :edn '("abc hello \t\"x") - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :string) - (:position . 1) - (:form . "\"abc hello \\t\\\"x\"") - (:value . "abc hello \t\"x")))))) + :edn '("abc hello \t\"x")) "strings-2" (a-list :source "(\"---\\f---\\\"-'\\'-\\\\-\\r\\n\")" - :edn '(("---\f---\"-''-\\-\r\n")) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :list) - (:position . 1) - (:children . (((:node-type . :string) - (:position . 2) - (:form . "\"---\\f---\\\"-'\\'-\\\\-\\r\\n\"") - (:value . "---\f---\"-''-\\-\r\n"))))))))) + :edn '(("---\f---\"-''-\\-\r\n"))) "chars-1" (a-list :source "(\\newline \\return \\space \\tab \\a \\b \\c \\u0078 \\o171)" - :edn '((?\n ?\r ?\ ?\t ?a ?b ?c ?x ?y)) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :list) - (:position . 1) - (:children . (((:node-type . :character) (:position . 2) (:form . "\\newline") (:value . ?\n)) - ((:node-type . :character) (:position . 11) (:form . "\\return") (:value . ?\r)) - ((:node-type . :character) (:position . 19) (:form . "\\space") (:value . 32)) - ((:node-type . :character) (:position . 26) (:form . "\\tab") (:value . ?\t)) - ((:node-type . :character) (:position . 31) (:form . "\\a") (:value . ?a)) - ((:node-type . :character) (:position . 34) (:form . "\\b") (:value . ?b)) - ((:node-type . :character) (:position . 37) (:form . "\\c") (:value . ?c)) - ((:node-type . :character) (:position . 40) (:form . "\\u0078") (:value . ?x)) - ((:node-type . :character) (:position . 47) (:form . "\\o171") (:value . ?y))))))))) + :edn '((?\n ?\r ?\ ?\t ?a ?b ?c ?x ?y))) "chars-2" (a-list :source "\"\\u0078 \\o171\"" - :edn '("x y") - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :string) - (:position . 1) - (:form . "\"\\u0078 \\o171\"") - (:value . "x y")))))) + :edn '("x y")) "keywords" (a-list :tags '(:edn-roundtrip) :source ":foo-bar" - :edn '(:foo-bar) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :keyword) - (:position . 1) - (:form . ":foo-bar") - (:value . :foo-bar)))))) + :edn '(:foo-bar)) "vector" (a-list :tags '(:edn-roundtrip) :source "[123]" - :edn '([123]) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :vector) - (:position . 1) - (:children . (((:node-type . :number) - (:position . 2) - (:form . "123") - (:value . 123))))))))) + :edn '([123])) "map" (a-list :tags '(:edn-roundtrip) :source "{:count 123}" - :edn (list (a-hash-table :count 123)) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :map) - (:position . 1) - (:children . (((:node-type . :keyword) - (:position . 2) - (:form . ":count") - (:value . :count)) - ((:node-type . :number) - (:position . 9) - (:form . "123") - (:value . 123))))))))) + :edn (list (a-hash-table :count 123))) "prefixed-map-1" (a-list :source "#:foo.bar{:baz 1 :other.ns.prefix/qux 2}" - :edn (list (a-hash-table :foo.bar/baz 1 :other.ns.prefix/qux 2)) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:map-prefix - (:token-type . :map-prefix) - (:form . "#:foo.bar") - (:pos . 1)) - (:node-type . :map) - (:position . 10) - (:children . (((:node-type . :keyword) - (:position . 11) - (:form . ":baz") - (:value . :baz)) - ((:node-type . :number) - (:position . 16) - (:form . "1") - (:value . 1)) - ((:node-type . :keyword) - (:position . 18) - (:form . ":other.ns.prefix/qux") - (:value . :other.ns.prefix/qux)) - ((:node-type . :number) - (:position . 39) - (:form . "2") - (:value . 2))))))))) + :edn (list (a-hash-table :foo.bar/baz 1 :other.ns.prefix/qux 2))) "prefixed-map-2" (a-list :source "#:foo.bar {:baz 1}" - :edn (list (a-hash-table :foo.bar/baz 1)) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:map-prefix - (:token-type . :map-prefix) - (:form . "#:foo.bar") - (:pos . 1)) - (:node-type . :map) - (:position . 10) - (:children . (((:node-type . :keyword) - (:position . 11) - (:form . ":baz") - (:value . :baz)) - ((:node-type . :number) - (:position . 16) - (:form . "1") - (:value . 1))))))))) + :edn (list (a-hash-table :foo.bar/baz 1))) "set" (a-list :tags '(:edn-roundtrip) :source "#{:x}" - :edn '((edn-set (:x))) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :set) - (:position . 1) - (:children . (((:node-type . :keyword) - (:position . 3) - (:form . ":x") - (:value . :x))))))))) + :edn '((edn-set (:x)))) "discard" (a-list :source "(10 #_11 12 #_#_ 13 14)" - :edn '((10 12)) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :list) - (:position . 1) - (:children . (((:node-type . :number) - (:position . 2) - (:form . "10") - (:value . 10)) - ((:node-type . :number) - (:position . 10) - (:form . "12") - (:value . 12))))))))) + :edn '((10 12))) "tag-1" @@ -332,71 +132,21 @@ :tags '(:edn-roundtrip) :tag-readers '((:default . parseedn-tagged-literal)) :source "#foo/bar [1]" - :edn '((edn-tagged-literal foo/bar [1])) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :tag) - (:position . 1) - (:tag . foo/bar) - (:children . (((:node-type . :vector) - (:position . 10) - (:children . (((:node-type . :number) - (:position . 11) - (:form . "1") - (:value . 1)))))))))))) + :edn '((edn-tagged-literal foo/bar [1]))) "tag-2" (a-list :tags '(:edn-roundtrip) :tag-readers '((:default . parseedn-tagged-literal)) :source "(fn #param :param-name 1)" - :edn '((fn (edn-tagged-literal param :param-name) 1)) - :ast '((:node-type . :root) - (:position . 1) - (:children . (((:node-type . :list) - (:position . 1) - (:children . (((:node-type . :symbol) - (:position . 2) - (:form . "fn") - (:value . fn)) - ((:node-type . :tag) - (:position . 5) - (:tag . param) - (:children . (((:node-type . :keyword) - (:position . 12) - (:form . ":param-name") - (:value . :param-name))))) - ((:node-type . :number) - (:position . 24) - (:form . "1") - (:value . 1))))))))) + :edn '((fn (edn-tagged-literal param :param-name) 1))) "nested-tags" (a-list :tags '(:edn-roundtrip) :tag-readers '((:default . parseedn-tagged-literal)) :edn (list (vector `(edn-tagged-literal lazy-error (edn-tagged-literal error ,(a-hash-table :cause "Divide by zero"))))) - :source "[#lazy-error #error {:cause \"Divide by zero\"}]" - :ast '((:node-type . :root) - (:position . 1) - (:children ((:node-type . :vector) - (:position . 1) - (:children ((:node-type . :tag) - (:position . 2) - (:tag . lazy-error) - (:children ((:node-type . :tag) - (:position . 14) - (:tag . error) - (:children ((:node-type . :map) - (:position . 21) - (:children ((:node-type . :keyword) - (:position . 22) - (:form . ":cause") - (:value . :cause)) - ((:node-type . :string) - (:position . 29) - (:form . "\"Divide by zero\"") - (:value . "Divide by zero"))))))))))))) + :source "[#lazy-error #error {:cause \"Divide by zero\"}]") "booleans" (a-list From 551762cd3f83c811460346a7404597b4a8250b88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?I=C3=B1aki=20Arenaza?= Date: Fri, 29 Sep 2023 16:25:18 +0200 Subject: [PATCH 3/3] Extract the logic of building the map to separate defuns Before adding the code to support prefixed maps, the branch reduction function looked more concise and higher-level. After adding the support it seemed like it mixed levels of abstraction. Extracting the nitty-gritty details of how to build the maps (especially in the prefixed map case) should help in keeping the levels of abstraction separated. --- parseedn.el | 74 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 43 insertions(+), 31 deletions(-) diff --git a/parseedn.el b/parseedn.el index 0532268..82b2494 100644 --- a/parseedn.el +++ b/parseedn.el @@ -92,6 +92,33 @@ on available options." stack (cons (parseclj-lex--leaf-token-value token) stack))) +(defun parseedn--build-prefixed-map (prefix-token kvs) + "Build a map that has a prefix for non-qualified keywords. +PREFIX-TOKEN is the AST token for the map prefix. +KVS is a list of key, value pairs." + (let* ((hash-map (make-hash-table :test 'equal :size (length kvs))) + ;; map-prefix forms are always "#:...." + (map-prefix (substring (parseclj-lex-token-form prefix-token) 2))) + (seq-do (lambda (pair) + (let* ((key-name (substring (symbol-name (car pair)) 1)) + (k (if (string-match-p "/" key-name) + ;; keyword is already qualified, we must not add the prefix. + (car pair) + (intern (concat ":" map-prefix "/" key-name)))) + (v (cadr pair))) + (puthash k v hash-map))) + kvs) + hash-map)) + +(defun parseedn--build-non-prefixed-map (kvs) + "Build a non-prefixed map out of KVS. +KVS is a list of pairs (key value)" + (let ((hash-map (make-hash-table :test 'equal :size (length kvs)))) + (seq-do (lambda (pair) + (puthash (car pair) (cadr pair) hash-map)) + kvs) + hash-map)) + (defun parseedn-reduce-branch (stack opening-token children options) "Reduce STACK with an sequence containing a collection of other elisp values. Ignores discard tokens. @@ -106,42 +133,27 @@ on available options." (token-type (parseclj-lex-token-type opening-token))) (if (eq token-type :discard) stack - (cons - (cond - ((eq :root token-type) children) - ((eq :lparen token-type) children) - ((eq :lbracket token-type) (apply #'vector children)) - ((eq :set token-type) (list 'edn-set children)) - ((eq :lbrace token-type) (let* ((kvs (seq-partition children 2)) - (hash-map (make-hash-table :test 'equal :size (length kvs))) - (prefixed-map? (eq :map-prefix (parseclj-lex-token-type (car stack)))) - (map-prefix (when prefixed-map? - ;; map-prefix forms are always "#:...." - (substring (parseclj-lex-token-form (car stack)) 2)))) - (seq-do (lambda (pair) - (let* ((k (if (not prefixed-map?) - (car pair) - (let ((key-name (substring (symbol-name (car pair)) 1))) - (if (string-match-p "/" key-name) - ;; keyword is already qualified, we must not add the prefix. - (car pair) - (intern (concat ":" map-prefix "/" key-name)))))) - (v (cadr pair))) - (puthash k v hash-map))) - kvs) - (when prefixed-map? - (setq stack (cdr stack))) - hash-map)) - ((eq :tag token-type) (let* ((tag (intern (substring (alist-get :form opening-token) 1))) - (reader (alist-get tag tag-readers)) - (default-reader (alist-get :default tag-readers parseedn-default-data-reader-fn))) + (cond + ((eq :root token-type) (cons children stack)) + ((eq :lparen token-type) (cons children stack)) + ((eq :lbracket token-type) (cons (apply #'vector children) stack)) + ((eq :set token-type) (cons (list 'edn-set children) stack)) + ((eq :lbrace token-type) (let* ((kvs (seq-partition children 2)) + (prefixed-map? (eq :map-prefix (parseclj-lex-token-type (car stack))))) + (if prefixed-map? + (cons (parseedn--build-prefixed-map (car stack) kvs) (cdr stack)) + (cons (parseedn--build-non-prefixed-map kvs) stack)))) + ((eq :tag token-type) (let* ((tag (intern (substring (alist-get :form opening-token) 1))) + (reader (alist-get tag tag-readers)) + (default-reader (alist-get :default tag-readers parseedn-default-data-reader-fn))) + (cons (cond ((functionp reader) (funcall reader (car children))) ((functionp default-reader) (funcall default-reader tag (car children))) - (t (user-error "No reader for tag #%S in %S" tag (map-keys tag-readers))))))) - stack)))) + (t (user-error "No reader for tag #%S in %S" tag (map-keys tag-readers)))) + stack))))))) (defun parseedn-read (&optional tag-readers) "Read content from current buffer and parse it as EDN source.