From f67da4f231bb67039568bb30c6eb60861caf60ef Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Sun, 26 Nov 2023 16:20:25 +0100 Subject: [PATCH] update parseclj Signed-off-by: Andreas Gerler --- elpa/parseclj-20190531.711/parseclj-pkg.el | 12 -- elpa/parseclj-20220422.936/parseclj-alist.el | 97 ++++++++++++++++ .../parseclj-ast.el | 94 ++++++++-------- .../parseclj-autoloads.el | 18 ++- .../parseclj-lex.el | 86 ++++++++++---- .../parseclj-parser.el | 105 ++++++++++-------- elpa/parseclj-20220422.936/parseclj-pkg.el | 13 +++ .../parseclj.el | 16 ++- 8 files changed, 301 insertions(+), 140 deletions(-) delete mode 100644 elpa/parseclj-20190531.711/parseclj-pkg.el create mode 100644 elpa/parseclj-20220422.936/parseclj-alist.el rename elpa/{parseclj-20190531.711 => parseclj-20220422.936}/parseclj-ast.el (70%) rename elpa/{parseclj-20190531.711 => parseclj-20220422.936}/parseclj-autoloads.el (61%) rename elpa/{parseclj-20190531.711 => parseclj-20220422.936}/parseclj-lex.el (85%) rename elpa/{parseclj-20190531.711 => parseclj-20220422.936}/parseclj-parser.el (77%) create mode 100644 elpa/parseclj-20220422.936/parseclj-pkg.el rename elpa/{parseclj-20190531.711 => parseclj-20220422.936}/parseclj.el (90%) diff --git a/elpa/parseclj-20190531.711/parseclj-pkg.el b/elpa/parseclj-20190531.711/parseclj-pkg.el deleted file mode 100644 index d3117745..00000000 --- a/elpa/parseclj-20190531.711/parseclj-pkg.el +++ /dev/null @@ -1,12 +0,0 @@ -(define-package "parseclj" "20190531.711" "Clojure/EDN parser" - '((emacs "25") - (a "0.1.0alpha4")) - :keywords - '("lisp" "clojure" "edn" "parser") - :authors - '(("Arne Brasseur" . "arne@arnebrasseur.net")) - :maintainer - '("Arne Brasseur" . "arne@arnebrasseur.net")) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/parseclj-20220422.936/parseclj-alist.el b/elpa/parseclj-20220422.936/parseclj-alist.el new file mode 100644 index 00000000..5bc3719c --- /dev/null +++ b/elpa/parseclj-20220422.936/parseclj-alist.el @@ -0,0 +1,97 @@ +;;; parseclj-alist.el --- Clojure/EDN parser -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2021 Arne Brasseur + +;; Author: Arne Brasseur + +;; This file is not part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; A shift/reduce parser for Clojure source. + +;;; Code: + +(require 'map) + +(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: (parseclj-alist :foo 123 :bar 456)" + ;; Emacs 27: + ;; (map-into kvs 'alist) + (mapcar (lambda (kv) (cons (car kv) (cadr kv))) (seq-partition kvs 2))) + +(defun parseclj-alist-assoc (coll k v) + "Associate a key K with a value V in the association list COLL + +Returns a new alist (does not mutate its argument). If an entry +with the same key is present it will be replaced, otherwise the +new kv-pair is added to the head of the list." + (if (map-contains-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 (map-elt coll key) args))) + +(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: (parseclj-hash-table :foo 123 :bar 456)" + ;; Emacs 27: + ;; (map-into kvs 'hash-table) + (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-merge (l1 l2) + "Merge two association lists." + ;; Emacs 27: (map-merge 'alist l1 l2) + (let ((keys (delete-dups (append (mapcar #'car l1) (mapcar #'car l2)))) + (res '())) + (mapc + (lambda (key) + (push (or (assoc key l2) + (assoc key l1)) + res)) + keys) + (nreverse res))) + +(provide 'parseclj-alist) + +;;; parseclj-alist.el ends here diff --git a/elpa/parseclj-20190531.711/parseclj-ast.el b/elpa/parseclj-20220422.936/parseclj-ast.el similarity index 70% rename from elpa/parseclj-20190531.711/parseclj-ast.el rename to elpa/parseclj-20220422.936/parseclj-ast.el index e7b3cebc..94255c86 100644 --- a/elpa/parseclj-20190531.711/parseclj-ast.el +++ b/elpa/parseclj-20220422.936/parseclj-ast.el @@ -1,6 +1,6 @@ ;;; parseclj-ast.el --- Clojure parser/unparser -*- lexical-binding: t; -*- -;; Copyright (C) 2017-2018 Arne Brasseur +;; Copyright (C) 2017-2021 Arne Brasseur ;; Author: Arne Brasseur @@ -27,17 +27,17 @@ ;;; Code: -(require 'a) (require 'seq) (require 'subr-x) (require 'parseclj-lex) +(require 'parseclj-alist) ;; AST helper functions (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)) + (map-elt node attr)) (defun parseclj-ast-node-type (node) "Return the type of the AST node NODE." - (a-get node :node-type)) + (map-elt node :node-type)) (defun parseclj-ast-children (node) "Return children for the AST NODE." - (a-get node :children)) + (map-elt node :children)) (defun parseclj-ast-value (node) "Return the value of NODE as another AST node." - (a-get node :value)) + (map-elt 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) + (map-elt token :pos) + :form (map-elt 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 (map-elt top :node-type)) + (cons (parseclj-alist-update top :form #'concat (map-elt token :form)) (cdr stack)) (cons (parseclj-ast-node (parseclj-lex-token-type token) - (a-get token :pos) - :form (a-get token :form)) + (map-elt token :pos) + :form (map-elt token :form)) stack)) (parseclj-ast--reduce-leaf stack token options)))) @@ -118,31 +118,31 @@ 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 (map-elt opening-token :pos)) (type (parseclj-lex-token-type opening-token)) - (type (cl-case type - (:lparen :list) - (:lbracket :vector) - (:lbrace :map) - (t type)))) - (cl-case type - (:root (cons (parseclj-ast-node :root pos :children children) stack)) - (:discard stack) - (:tag (cons (parseclj-ast-node :tag - pos - :tag (intern (substring (a-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) - stack)) - (t (cons - (parseclj-ast-node type pos :children children) - stack))))) + (type (cond + ((eq :lparen type) :list) + ((eq :lbracket type) :vector) + ((eq :lbrace type) :map) + (t type)))) + (cond + ((eq :root type) (cons (parseclj-ast-node :root pos :children children) stack)) + ((eq :discard type) stack) + ((eq :tag type) (cons (parseclj-ast-node :tag + pos + :tag (intern (substring (map-elt opening-token :form) 1)) + :children children) + stack)) + ((eq :metadata type) (cons (parseclj-ast-node :with-meta + pos + :children children) + stack)) + ((eq :map-prefix type) (cons (parseclj-alist-assoc (car children) + :map-prefix opening-token) + stack)) + (t (cons + (parseclj-ast-node type pos :children children) + stack))))) (defun parseclj-ast--reduce-branch-with-lexical-preservation (stack opening-token children options) "Reduce STACK with an AST branch node representing a collection of elements. @@ -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 (map-elt 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) @@ -176,18 +176,18 @@ on available options." (defun parseclj-ast--unparse-collection (node) "Insert a string representation of the given AST branch NODE into buffer." (let* ((token-type (parseclj-ast-node-type node)) - (delimiters (cl-case token-type - (:root (cons "" "")) - (:list (cons "(" ")")) - (:vector (cons "[" "]")) - (:set (cons "#{" "}")) - (:map (cons "{" "}"))))) + (delimiters (cond + ((eq :root token-type) (cons "" "")) + ((eq :list token-type) (cons "(" ")")) + ((eq :vector token-type) (cons "[" "]")) + ((eq :set token-type) (cons "#{" "}")) + ((eq :map token-type) (cons "{" "}"))))) (insert (car delimiters)) (let ((nodes (alist-get ':children node))) (when-let (node (car nodes)) (parseclj-unparse-clojure node)) (seq-doseq (child (cdr nodes)) - (when (not (a-get node :lexical-preservation)) + (when (not (map-elt 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 (map-elt node :tag))) (insert " ") - (parseclj-unparse-clojure (car (a-get node :children))))) + (parseclj-unparse-clojure (car (map-elt node :children))))) (provide 'parseclj-ast) diff --git a/elpa/parseclj-20190531.711/parseclj-autoloads.el b/elpa/parseclj-20220422.936/parseclj-autoloads.el similarity index 61% rename from elpa/parseclj-20190531.711/parseclj-autoloads.el rename to elpa/parseclj-20220422.936/parseclj-autoloads.el index a3ce9ffc..1fa82e64 100644 --- a/elpa/parseclj-20190531.711/parseclj-autoloads.el +++ b/elpa/parseclj-20220422.936/parseclj-autoloads.el @@ -1,4 +1,4 @@ -;;; parseclj-autoloads.el --- automatically extracted autoloads +;;; parseclj-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- ;; ;;; Code: @@ -9,21 +9,29 @@ ;;;### (autoloads nil "parseclj" "parseclj.el" (0 0 0 0)) ;;; Generated autoloads from parseclj.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "parseclj" '("parseclj-"))) +(register-definition-prefixes "parseclj" '("parseclj-")) + +;;;*** + +;;;### (autoloads nil "parseclj-alist" "parseclj-alist.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from parseclj-alist.el + +(register-definition-prefixes "parseclj-alist" '("parseclj-")) ;;;*** ;;;### (autoloads nil "parseclj-ast" "parseclj-ast.el" (0 0 0 0)) ;;; Generated autoloads from parseclj-ast.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "parseclj-ast" '("parseclj-ast-"))) +(register-definition-prefixes "parseclj-ast" '("parseclj-ast-")) ;;;*** ;;;### (autoloads nil "parseclj-lex" "parseclj-lex.el" (0 0 0 0)) ;;; Generated autoloads from parseclj-lex.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "parseclj-lex" '("parseclj-lex-"))) +(register-definition-prefixes "parseclj-lex" '("parseclj-lex-")) ;;;*** @@ -31,7 +39,7 @@ ;;;;;; 0 0)) ;;; Generated autoloads from parseclj-parser.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "parseclj-parser" '("parseclj-"))) +(register-definition-prefixes "parseclj-parser" '("parseclj-")) ;;;*** diff --git a/elpa/parseclj-20190531.711/parseclj-lex.el b/elpa/parseclj-20220422.936/parseclj-lex.el similarity index 85% rename from elpa/parseclj-20190531.711/parseclj-lex.el rename to elpa/parseclj-20220422.936/parseclj-lex.el index f3d445f4..0dfab226 100644 --- a/elpa/parseclj-20190531.711/parseclj-lex.el +++ b/elpa/parseclj-20220422.936/parseclj-lex.el @@ -1,6 +1,6 @@ ;;; parseclj-lex.el --- Clojure/EDN Lexer -;; Copyright (C) 2017-2018 Arne Brasseur +;; Copyright (C) 2017-2021 Arne Brasseur ;; Author: Arne Brasseur @@ -27,8 +27,25 @@ ;;; Code: +(require 'parseclj-alist) + +(defcustom parseclj-lex-symbol-special-chars + '(?. ?* ?+ ?! ?- ?_ ?? ?$ ?% ?& ?= ?< ?> ?/ ?') + "The list of characters that can consitute a symbol or keyword's name. + +Please note that Clojure might at runtime accept keywords with +more constituent characters than those found in the default value +of this variable (which is the officially supported list), but +the end result should be treated as undefined. This could be the +case for example when keywordized maps are created from external +sources without keyword validation. Change this value at your +own risk." + :type 'sexp + :group 'parseclj) + (defvar parseclj-lex--leaf-tokens '(:whitespace :comment + :symbolic-value :number :nil :true @@ -73,7 +90,7 @@ Tokens at a mimimum have these attributes - POS: the position in the input, starts from 1 (like point) Other ATTRIBUTES can be given as a flat list of key-value pairs." - (apply 'a-list :token-type type :form form :pos pos attributes)) + (apply #'parseclj-alist :token-type type :form form :pos pos attributes)) (defun parseclj-lex-error-token (pos &optional error-type) "Create a lexer error token starting at POS. @@ -137,14 +154,15 @@ S goes through three transformations: (make-string 1 (string-to-number (substring x 2) 16))) (replace-regexp-in-string "\\\\[tbnrf'\"\\]" (lambda (x) - (cl-case (elt x 1) - (?t "\t") - (?f "\f") - (?\" "\"") - (?r "\r") - (?n "\n") - (?\\ "\\\\") - (t (substring x 1)))) + (let ((ch (elt x 1))) + (cond + ((eq ?t ch) "\t") + ((eq ?f ch) "\f") + ((eq ?\" ch) "\"") + ((eq ?r ch) "\r") + ((eq ?n ch) "\n") + ((eq ?\\ ch) "\\\\") + (t (substring x 1))))) (substring s 1 -1))))) (defun parseclj-lex--character-value (c) @@ -159,18 +177,28 @@ S goes through three transformations: ((eq first-char ?o) (string-to-number (substring c 2) 8)) (t first-char)))) +(defun parseclj-lex--number-value (number-str) + "Parse the NUMBER-STR to an Elisp number." + (let ((ratio (split-string number-str "/"))) + (if (= 2 (length ratio)) + (let ((numerator (string-to-number (car ratio))) + (denominator (string-to-number (cadr ratio)))) + (/ numerator (float denominator))) + (string-to-number number-str)))) + (defun parseclj-lex--leaf-token-value (token) "Parse the given leaf TOKEN to an Emacs Lisp value." - (cl-case (parseclj-lex-token-type token) - (:number (string-to-number (alist-get :form token))) - (:nil nil) - (:true t) - (:false nil) - (:symbol (intern (alist-get :form token))) - (:keyword (intern (alist-get :form token))) - (:string (parseclj-lex--string-value (alist-get :form token))) - (:character (parseclj-lex--character-value (alist-get :form token))))) - + (let ((token-type (parseclj-lex-token-type token))) + (cond + ((eq :number token-type) (parseclj-lex--number-value (alist-get :form token))) + ((eq :nil token-type) nil) + ((eq :true token-type) t) + ((eq :false token-type) nil) + ((eq :symbol token-type) (intern (alist-get :form token))) + ((eq :keyword token-type) (intern (alist-get :form token))) + ((eq :string token-type) (parseclj-lex--string-value (alist-get :form token))) + ((eq :character token-type) (parseclj-lex--character-value (alist-get :form token))) + ((eq :symbolic-value token-type) (intern (substring (alist-get :form token) 2)))))) ;; Stream tokenization @@ -245,6 +273,15 @@ S goes through three transformations: (when (eq (char-after (point)) ?M) (right-char)) + ;; trailing N clojure.lang.BigInt + (when (eq (char-after (point)) ?N) + (right-char)) + + ;; clojure.lang.Ratio + (when (eq (char-after (point)) ?/) + (right-char) + (parseclj-lex-skip-number)) + (let ((char (char-after (point)))) (if (and char (or (and (<= ?a char) (<= char ?z)) (and (<= ?A char) (<= char ?Z)) @@ -280,7 +317,7 @@ alphabetic characters only. ALPHA-ONLY ensures this behavior." (not (not (and char (or (and (<= ?a char) (<= char ?z)) (and (<= ?A char) (<= char ?Z)) - (and (not alpha-only) (member char '(?. ?* ?+ ?! ?- ?_ ?? ?$ ?% ?& ?= ?< ?> ?/ ?')))))))) + (and (not alpha-only) (member char parseclj-lex-symbol-special-chars))))))) (defun parseclj-lex-symbol-rest-p (char) "Return t if CHAR is a valid character in a symbol. @@ -515,6 +552,10 @@ See `parseclj-lex-token'." ((equal char ?=) (right-char) (parseclj-lex-token :eval "#=" pos)) + ((equal char ?#) + (right-char) + (let ((sym (parseclj-lex-get-symbol-at-point (point)))) + (parseclj-lex-token :symbolic-value (concat "##" sym) pos))) ((equal char ?\") (parseclj-lex-regex)) ((equal char ?:) @@ -529,6 +570,9 @@ See `parseclj-lex-token'." ((parseclj-lex-symbol-start-p char t) (right-char) (parseclj-lex-token :tag (concat "#" (parseclj-lex-get-symbol-at-point (1+ pos))) pos)) + ((equal char ?!) ;; shebang + (left-char) + (parseclj-lex-comment)) (t (while (not (or (parseclj-lex-at-whitespace-p) (parseclj-lex-at-eof-p))) diff --git a/elpa/parseclj-20190531.711/parseclj-parser.el b/elpa/parseclj-20220422.936/parseclj-parser.el similarity index 77% rename from elpa/parseclj-20190531.711/parseclj-parser.el rename to elpa/parseclj-20220422.936/parseclj-parser.el index d0e5d24a..4c757d23 100644 --- a/elpa/parseclj-20190531.711/parseclj-parser.el +++ b/elpa/parseclj-20220422.936/parseclj-parser.el @@ -1,11 +1,8 @@ ;;; parseclj-parser.el --- Clojure/EDN parser -*- lexical-binding: t; -*- -;; Copyright (C) 2017-2018 Arne Brasseur +;; Copyright (C) 2017-2021 Arne Brasseur ;; Author: Arne Brasseur -;; Keywords: lisp -;; Package-Requires: ((emacs "25") (a "0.1.0alpha4")) -;; Version: 0.1.0 ;; This file is not part of GNU Emacs. @@ -32,8 +29,9 @@ (require 'cl-lib) (require 'subr-x) -(require 'a) (require 'parseclj-lex) +(require 'parseclj-alist) +(require 'map) (define-error 'parseclj-parser-error "parseclj: Syntax error") @@ -46,18 +44,19 @@ can be handled with `condition-case'." (defun parseclj--find-opening-token (stack closing-token) "Scan STACK for an opening-token matching CLOSING-TOKEN." - (cl-case (parseclj-lex-token-type closing-token) - (:rparen (parseclj-lex-token-type - (seq-find (lambda (token) - (member (parseclj-lex-token-type token) - '(:lparen :lambda))) - stack))) - (:rbracket :lbracket) - (:rbrace (parseclj-lex-token-type - (seq-find (lambda (token) - (member (parseclj-lex-token-type token) - '(:lbrace :set))) - stack))))) + (let ((token-type (parseclj-lex-token-type closing-token))) + (cond + ((eq :rparen token-type) (parseclj-lex-token-type + (seq-find (lambda (token) + (member (parseclj-lex-token-type token) + '(:lparen :lambda))) + stack))) + ((eq :rbracket token-type) :lbracket) + ((eq :rbrace token-type) (parseclj-lex-token-type + (seq-find (lambda (token) + (member (parseclj-lex-token-type token) + '(:lbrace :set))) + stack)))))) (defun parseclj--reduce-coll (stack closing-token reduce-branch options) "Reduce collection based on the top of the STACK and a CLOSING-TOKEN. @@ -71,36 +70,44 @@ 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 (map-elt options :fail-fast t)) (collection nil)) - - ;; unwind the stack until opening-token-type is found, adding to collection - (while (and stack (not (eq (parseclj-lex-token-type (car stack)) opening-token-type))) - (push (pop stack) collection)) - - ;; did we find the right token? - (if (eq (parseclj-lex-token-type (car stack)) opening-token-type) - (progn - (when fail-fast - ;; any unreduced tokens left: bail early - (when-let ((token (seq-find #'parseclj-lex-token-p collection))) + (if (not opening-token-type) + (if fail-fast + (parseclj--error "At position %s, unmatched %S" + (map-elt closing-token :pos) + (parseclj-lex-token-type closing-token)) + + stack) + + (progn + ;; unwind the stack until opening-token-type is found, adding to collection + (while (and stack (not (eq (parseclj-lex-token-type (car stack)) opening-token-type))) + (push (pop stack) collection)) + + ;; did we find the right token? + (if (eq (parseclj-lex-token-type (car stack)) opening-token-type) + (progn + (when fail-fast + ;; any unreduced tokens left: bail early + (when-let ((token (seq-find #'parseclj-lex-token-p collection))) + (parseclj--error "At position %s, unmatched %S" + (map-elt token :pos) + (parseclj-lex-token-type token)))) + + ;; 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 options))) + + ;; Unwound the stack without finding a matching paren: either bail early + ;; or return the original stack and continue parsing + (if fail-fast (parseclj--error "At position %s, unmatched %S" - (a-get token :pos) - (parseclj-lex-token-type token)))) - - ;; 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 options))) - - ;; Unwound the stack without finding a matching paren: either bail early - ;; or return the original stack and continue parsing - (if fail-fast - (parseclj--error "At position %s, unmatched %S" - (a-get closing-token :pos) - (parseclj-lex-token-type closing-token)) + (map-elt closing-token :pos) + (parseclj-lex-token-type closing-token)) - (reverse collection))))) + (reverse collection))))))) (defun parseclj--take-value (stack value-p) "Scan STACK until a value is found. @@ -201,9 +208,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 (map-elt options :fail-fast t)) + (read-one (map-elt options :read-one)) + (value-p (map-elt options :value-p (lambda (e) (not (parseclj-lex-token-p e))))) (stack nil) (token (parseclj-lex-next))) @@ -214,7 +221,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) + (map-elt token :pos) (parseclj-lex-token-form token))) ;; Reduce based on the top item on the stack (collections) @@ -265,7 +272,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) + (map-elt token :pos) (parseclj-lex-token-type token)))) (if read-one diff --git a/elpa/parseclj-20220422.936/parseclj-pkg.el b/elpa/parseclj-20220422.936/parseclj-pkg.el new file mode 100644 index 00000000..07e47022 --- /dev/null +++ b/elpa/parseclj-20220422.936/parseclj-pkg.el @@ -0,0 +1,13 @@ +(define-package "parseclj" "20220422.936" "Clojure/EDN parser" + '((emacs "25")) + :commit "4d0e780e00f1828b00c43099e6eebc6582998f72" :authors + '(("Arne Brasseur" . "arne@arnebrasseur.net")) + :maintainers + '(("Arne Brasseur" . "arne@arnebrasseur.net")) + :maintainer + '("Arne Brasseur" . "arne@arnebrasseur.net") + :keywords + '("lisp" "clojure" "edn" "parser")) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/parseclj-20190531.711/parseclj.el b/elpa/parseclj-20220422.936/parseclj.el similarity index 90% rename from elpa/parseclj-20190531.711/parseclj.el rename to elpa/parseclj-20220422.936/parseclj.el index 7515d5e0..682bc80c 100644 --- a/elpa/parseclj-20190531.711/parseclj.el +++ b/elpa/parseclj-20220422.936/parseclj.el @@ -1,11 +1,11 @@ ;;; parseclj.el --- Clojure/EDN parser -*- lexical-binding: t; -*- -;; Copyright (C) 2017-2018 Arne Brasseur +;; Copyright (C) 2017-2021 Arne Brasseur ;; Author: Arne Brasseur ;; Keywords: lisp clojure edn parser -;; Package-Requires: ((emacs "25") (a "0.1.0alpha4")) -;; Version: 0.1.0 +;; Package-Requires: ((emacs "25")) +;; Version: 1.1.0 ;; This file is not part of GNU Emacs. @@ -30,8 +30,12 @@ ;;; Code: +(require 'map) +(require 'seq) + (require 'parseclj-parser) (require 'parseclj-ast) +(require 'parseclj-alist) (defun parseclj-parse-clojure (&rest string-and-options) "Parse Clojure source to AST. @@ -56,8 +60,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? (map-elt options :lexical-preservation))) (parseclj-parser (if lexical? #'parseclj-ast--reduce-leaf-with-lexical-preservation #'parseclj-ast--reduce-leaf) @@ -73,7 +77,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 (map-elt ast :form)) (if (eql (parseclj-ast-node-type ast) :tag) (parseclj-ast--unparse-tag ast) (parseclj-ast--unparse-collection ast)))) -- 2.47.3