From: Andreas Gerler Date: Sun, 22 Dec 2024 12:14:17 +0000 (+0100) Subject: update parseclj X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=537ac0cb56f841ce990abfb04d57d63100750772;p=emacsconfig.git update parseclj Signed-off-by: Andreas Gerler --- diff --git a/elpa/parseclj-20220422.936/parseclj-alist.el b/elpa/parseclj-20220422.936/parseclj-alist.el deleted file mode 100644 index 5bc3719c..00000000 --- a/elpa/parseclj-20220422.936/parseclj-alist.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; 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-20220422.936/parseclj-ast.el b/elpa/parseclj-20220422.936/parseclj-ast.el deleted file mode 100644 index 94255c86..00000000 --- a/elpa/parseclj-20220422.936/parseclj-ast.el +++ /dev/null @@ -1,205 +0,0 @@ -;;; parseclj-ast.el --- Clojure parser/unparser -*- 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: - -;; Parse Clojure code to an AST, and unparse back to code. - -;;; Code: - -(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 '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." - (and (consp node) - (consp (car node)) - (eq :node-type (caar node)))) - -(defun parseclj-ast-node-attr (node attr) - "Return NODE's ATTR, or nil." - (map-elt node attr)) - -(defun parseclj-ast-node-type (node) - "Return the type of the AST node NODE." - (map-elt node :node-type)) - -(defun parseclj-ast-children (node) - "Return children for the AST NODE." - (map-elt node :children)) - -(defun parseclj-ast-value (node) - "Return the value of NODE as another AST node." - (map-elt node :value)) - -(defun parseclj-ast-leaf-node-p (node) - "Return t if the given ast NODE is a leaf node." - (member (parseclj-ast-node-type node) parseclj-lex--leaf-tokens)) - -(defun parseclj-ast-branch-node-p (node) - "Return t if the given AST NODE is a branch node." - (not (parseclj-ast-leaf-node-p node))) - - -;; Parse/reduce strategy functions - -(defun parseclj-ast--reduce-leaf (stack token &optional _options) - "Put into the STACK an AST leaf node based on TOKEN. -Ignores white spaces and comments. - -OPTIONS is an association list. See `parseclj-parse' for more information -on available options." - (if (member (parseclj-lex-token-type token) '(:whitespace :comment)) - stack - (cons - (parseclj-ast-node (parseclj-lex-token-type token) - (map-elt token :pos) - :form (map-elt token :form) - :value (parseclj-lex--leaf-token-value token)) - stack))) - -(defun parseclj-ast--reduce-leaf-with-lexical-preservation (stack token options) - "Put into STACK an AST leaf node based on TOKEN. -This function is very similar to `parseclj-ast--reduce-leaf', but unlike -it, takes into account tokens representing white space or comments and -saves them into the STACK. Nodes produced by this function have a -`:lexical-preservation' key set to t. - -OPTIONS is an association list. See `parseclj-parse' for more information -on available options." - (let ((token-type (parseclj-lex-token-type token)) - (top (car stack))) - (if (member token-type '(:whitespace :comment)) - ;; merge consecutive whitespace or comment tokens - (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) - (map-elt token :pos) - :form (map-elt token :form)) - stack)) - (parseclj-ast--reduce-leaf stack token options)))) - -(defun parseclj-ast--reduce-branch (stack opening-token children _options) - "Reduce STACK with an AST branch node representing a collection of elements. -Ignores discard tokens. - -OPENING-TOKEN is a lex token representing an opening paren, bracket or -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 (map-elt opening-token :pos)) - (type (parseclj-lex-token-type opening-token)) - (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. -Similar to `parseclj-ast--reduce-branch', but reduces discard tokens as -well. Nodes produced by this function have a `:lexical-preservation' -key set to t. - -OPENING-TOKEN is a lex token representing an opening paren, bracket or -brace. -CHILDREN is the collection of tokens to be reduced into the AST branch -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 (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) - (cons (cl-list* (car top) ;; make sure :node-type remains the first element in the list - '(:lexical-preservation . t) - (cdr top)) - (cdr stack)) - stack)))) - - - -;; Unparse functions - -(declare-function parseclj-unparse-clojure "parseclj") - -(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 (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 (map-elt node :lexical-preservation)) - (insert " ")) - (parseclj-unparse-clojure child))) - (insert (cdr delimiters)))) - -(defun parseclj-ast--unparse-tag (node) - "Insert a string representation of the given AST tag NODE into buffer." - (progn - (insert "#") - (insert (symbol-name (map-elt node :tag))) - (insert " ") - (parseclj-unparse-clojure (car (map-elt node :children))))) - -(provide 'parseclj-ast) - -;;; parseclj-ast.el ends here diff --git a/elpa/parseclj-20220422.936/parseclj-autoloads.el b/elpa/parseclj-20220422.936/parseclj-autoloads.el deleted file mode 100644 index 1fa82e64..00000000 --- a/elpa/parseclj-20220422.936/parseclj-autoloads.el +++ /dev/null @@ -1,56 +0,0 @@ -;;; parseclj-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "parseclj" "parseclj.el" (0 0 0 0)) -;;; Generated autoloads from parseclj.el - -(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 - -(register-definition-prefixes "parseclj-ast" '("parseclj-ast-")) - -;;;*** - -;;;### (autoloads nil "parseclj-lex" "parseclj-lex.el" (0 0 0 0)) -;;; Generated autoloads from parseclj-lex.el - -(register-definition-prefixes "parseclj-lex" '("parseclj-lex-")) - -;;;*** - -;;;### (autoloads nil "parseclj-parser" "parseclj-parser.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from parseclj-parser.el - -(register-definition-prefixes "parseclj-parser" '("parseclj-")) - -;;;*** - -;;;### (autoloads nil nil ("parseclj-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; parseclj-autoloads.el ends here diff --git a/elpa/parseclj-20220422.936/parseclj-lex.el b/elpa/parseclj-20220422.936/parseclj-lex.el deleted file mode 100644 index 0dfab226..00000000 --- a/elpa/parseclj-20220422.936/parseclj-lex.el +++ /dev/null @@ -1,589 +0,0 @@ -;;; parseclj-lex.el --- Clojure/EDN Lexer - -;; 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 reader for EDN data files and parser for Clojure source files. - -;;; 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 - :false - :symbol - :keyword - :string - :regex - :character) - "Types of tokens that represent leaf nodes in the AST.") - -(defvar parseclj-lex--closing-tokens '(:rparen - :rbracket - :rbrace) - "Types of tokens that mark the end of a non-atomic form.") - -(defvar parseclj-lex--prefix-tokens '(:quote - :backquote - :unquote - :unquote-splice - :discard - :tag - :reader-conditional - :reader-conditional-splice - :var - :deref - :map-prefix - :eval) - "Tokens that modify the form that follows.") - -(defvar parseclj-lex--prefix-2-tokens '(:metadata) - "Tokens that modify the two forms that follow.") - -;; Token interface - -(defun parseclj-lex-token (type form pos &rest attributes) - "Create a lexer token with the specified attributes. - -Tokens at a mimimum have these attributes -- TYPE: the type of token, like :whitespace or :lparen -- FORM: the source form, a string -- 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 #'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. -ERROR-TYPE is an optional keyword to attach to the created token, -as the means for providing more information on the error." - (apply #'parseclj-lex-token - :lex-error - (buffer-substring-no-properties pos (point)) - pos - (when error-type - (list :error-type error-type)))) - -(defun parseclj-lex-token-p (token) - "Is the given TOKEN a parseclj-lex TOKEN. - -A token is an association list with :token-type as its first key." - (and (consp token) - (consp (car token)) - (eq :token-type (caar token)))) - -(defun parseclj-lex-token-type (token) - "Get the type of TOKEN." - (and (consp token) - (cdr (assq :token-type token)))) - -(defun parseclj-lex-token-form (token) - "Get the form of TOKEN." - (and (consp token) - (cdr (assq :form token)))) - -(defun parseclj-lex-leaf-token-p (token) - "Return t if the given AST TOKEN is a leaf node." - (member (parseclj-lex-token-type token) parseclj-lex--leaf-tokens)) - -(defun parseclj-lex-closing-token-p (token) - "Return t if the given ast TOKEN is a closing token." - (member (parseclj-lex-token-type token) parseclj-lex--closing-tokens)) - -(defun parseclj-lex-error-p (token) - "Return t if the TOKEN represents a lexing error token." - (eq (parseclj-lex-token-type token) :lex-error)) - -;; Elisp values from tokens - -(defun parseclj-lex--string-value (s) - "Parse an EDN string S into a regular string. -S goes through three transformations: -- Escaped characters in S are transformed into Elisp escaped - characters. -- Unicode escaped characters are decoded into its corresponding - unicode character counterpart. -- Octal escaped characters are decoded into its corresponding - character counterpart." - (replace-regexp-in-string - "\\\\o[0-8]\\{3\\}" - (lambda (x) - (make-string 1 (string-to-number (substring x 2) 8))) - (replace-regexp-in-string - "\\\\u[0-9a-fA-F]\\{4\\}" - (lambda (x) - (make-string 1 (string-to-number (substring x 2) 16))) - (replace-regexp-in-string "\\\\[tbnrf'\"\\]" - (lambda (x) - (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) - "Parse an EDN character C into an Emacs Lisp character." - (let ((first-char (elt c 1))) - (cond - ((equal c "\\newline") ?\n) - ((equal c "\\return") ?\r) - ((equal c "\\space") ?\ ) - ((equal c "\\tab") ?\t) - ((eq first-char ?u) (string-to-number (substring c 2) 16)) - ((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." - (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 - -(defun parseclj-lex-at-whitespace-p () - "Return t if char at point is white space." - (let ((char (char-after (point)))) - (or (equal char ?\ ) - (equal char ?\t) - (equal char ?\n) - (equal char ?\r) - (equal char ?,)))) - -(defun parseclj-lex-at-eof-p () - "Return t if point is at the end of file." - (eq (point) (point-max))) - -(defun parseclj-lex-whitespace () - "Consume all consecutive white space as possible and return an :whitespace token." - (let ((pos (point))) - (while (parseclj-lex-at-whitespace-p) - (right-char)) - (parseclj-lex-token :whitespace - (buffer-substring-no-properties pos (point)) - pos))) - -(defun parseclj-lex-skip-digits () - "Skip all consecutive digits after point." - (while (and (char-after (point)) - (<= ?0 (char-after (point))) - (<= (char-after (point)) ?9)) - (right-char))) - -(defun parseclj-lex-skip-hex () - "Skip all consecutive hex digits after point." - (while (and (char-after (point)) - (or (<= ?0 (char-after (point)) ?9) - (<= ?a (char-after (point)) ?f) - (<= ?A (char-after (point)) ?F))) - (right-char))) - -(defun parseclj-lex-skip-number () - "Skip a number at point." - ;; [\+\-]?\d+\.\d+ - (if (and (eq ?0 (char-after (point))) - (eq ?x (char-after (1+ (point))))) - (progn - (right-char 2) - (parseclj-lex-skip-hex)) - (progn - (when (member (char-after (point)) '(?+ ?-)) - (right-char)) - - (parseclj-lex-skip-digits) - - (when (eq (char-after (point)) ?.) - (right-char)) - - (parseclj-lex-skip-digits)))) - -(defun parseclj-lex-number () - "Consume a number and return a `:number' token representing it." - (let ((pos (point))) - (parseclj-lex-skip-number) - - ;; 10110r2 or 4.3e+22 - (when (member (char-after (point)) '(?E ?e ?r)) - (right-char)) - - (parseclj-lex-skip-number) - - ;; trailing M - (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)) - (and (member char '(?. ?* ?+ ?! ?- ?_ ?? ?$ ?& ?= ?< ?> ?/))))) - (progn - (right-char) - (parseclj-lex-error-token pos :invalid-number-format)) - (parseclj-lex-token :number - (buffer-substring-no-properties pos (point)) - pos))))) - - -(defun parseclj-lex-digit-p (char) - "Return t if CHAR is a digit." - (and char (<= ?0 char) (<= char ?9))) - -(defun parseclj-lex-at-number-p () - "Return t if point is at a number." - (let ((char (char-after (point)))) - (or (parseclj-lex-digit-p char) - (and (member char '(?- ?+ ?.)) - (parseclj-lex-digit-p (char-after (1+ (point)))))))) - -(defun parseclj-lex-symbol-start-p (char &optional alpha-only) - "Return t if CHAR is a valid start for a symbol. - -Symbols begin with a non-numeric character and can contain alphanumeric -characters and . * + ! - _ ? $ % & = < > '. If - + or . are the first -character, the second character (if any) must be non-numeric. - -In some cases, like in tagged elements, symbols are required to start with -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 parseclj-lex-symbol-special-chars))))))) - -(defun parseclj-lex-symbol-rest-p (char) - "Return t if CHAR is a valid character in a symbol. -For more information on what determines a valid symbol, see -`parseclj-lex-symbol-start-p'" - (or (parseclj-lex-symbol-start-p char) - (parseclj-lex-digit-p char) - (eq ?: char) - (eq ?# char))) - -(defun parseclj-lex-get-symbol-at-point (pos) - "Return the symbol at POS as a string." - (while (parseclj-lex-symbol-rest-p (char-after (point))) - (right-char)) - (buffer-substring-no-properties pos (point))) - -(defun parseclj-lex-symbol () - "Return a lex token representing a symbol. -Because of their special meaning, symbols \"nil\", \"true\", and \"false\" -are returned as their own lex tokens." - (let ((pos (point))) - (right-char) - (let ((sym (parseclj-lex-get-symbol-at-point pos))) - (cond - ((equal sym "nil") (parseclj-lex-token :nil "nil" pos)) - ((equal sym "true") (parseclj-lex-token :true "true" pos)) - ((equal sym "false") (parseclj-lex-token :false "false" pos)) - (t (parseclj-lex-token :symbol sym pos)))))) - -(defun parseclj-lex-string* () - "Helper for string/regex lexing. -Returns either the string, or an error token" - (let ((pos (point))) - (right-char) - (while (not (or (equal (char-after (point)) ?\") (parseclj-lex-at-eof-p))) - (if (equal (char-after (point)) ?\\) - (right-char 2) - (right-char))) - (when (equal (char-after (point)) ?\") - (right-char) - (buffer-substring-no-properties pos (point))))) - -(defun parseclj-lex-string () - "Return a lex token representing a string. -If EOF is reached without finding a closing double quote, a :lex-error -token is returned." - (let ((pos (point)) - (str (parseclj-lex-string*))) - (if str - (parseclj-lex-token :string str pos) - (parseclj-lex-error-token pos :invalid-string)))) - -(defun parseclj-lex-regex () - "Return a lex token representing a regular expression. -If EOF is reached without finding a closing double quote, a :lex-error -token is returned." - (let ((pos (1- (point))) - (str (parseclj-lex-string*))) - (if str - (parseclj-lex-token :regex (concat "#" str) pos) - (parseclj-lex-error-token pos :invalid-regex)))) - -(defun parseclj-lex-lookahead (n) - "Return a lookahead string of N characters after point." - (buffer-substring-no-properties (point) (min (+ (point) n) (point-max)))) - -(defun parseclj-lex-character () - "Return a lex token representing a character." - (let ((pos (point))) - (right-char) - (cond - ((equal (parseclj-lex-lookahead 3) "tab") - (right-char 3) - (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) - - ((equal (parseclj-lex-lookahead 5) "space") - (right-char 5) - (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) - - ((equal (parseclj-lex-lookahead 6) "return") - (right-char 6) - (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) - - ((equal (parseclj-lex-lookahead 7) "newline") - (right-char 7) - (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) - - ((string-match-p "^u[0-9a-fA-F]\\{4\\}" (parseclj-lex-lookahead 5)) - (right-char 5) - (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) - - ((string-match-p "^o[0-8]\\{3\\}" (parseclj-lex-lookahead 4)) - (right-char 4) - (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) - - (t - (right-char) - (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos))))) - -(defun parseclj-lex-keyword () - "Return a lex token representing a keyword. -Keywords follow the same rules as symbols, except they start with one or -two colon characters. - -See `parseclj-lex-symbol', `parseclj-lex-symbol-start-p'." - (let ((pos (point))) - (right-char) - (when (equal (char-after (point)) ?:) ;; same-namespace keyword - (right-char)) - (if (equal (char-after (point)) ?:) ;; three colons in a row => lex-error - (progn - (right-char) - (parseclj-lex-error-token pos :invalid-keyword)) - (progn - (while (or (parseclj-lex-symbol-rest-p (char-after (point))) - (equal (char-after (point)) ?#)) - (right-char)) - (parseclj-lex-token :keyword (buffer-substring-no-properties pos (point)) pos))))) - -(defun parseclj-lex-comment () - "Return a lex token representing a comment." - (let ((pos (point))) - (goto-char (line-end-position)) - (when (equal (char-after (point)) ?\n) - (right-char)) - (parseclj-lex-token :comment (buffer-substring-no-properties pos (point)) pos))) - -(defun parseclj-lex-map-prefix () - "Return a lex token representing a map prefix." - (let ((pos (1- (point)))) - (right-char) - (when (equal (char-after (point)) ?:) - (right-char)) - (while (parseclj-lex-symbol-rest-p (char-after (point))) - (right-char)) - (parseclj-lex-token :map-prefix (buffer-substring-no-properties pos (point)) pos))) - -(defun parseclj-lex-next () - "Consume characters at point and return the next lexical token. - -See `parseclj-lex-token'." - (if (parseclj-lex-at-eof-p) - (parseclj-lex-token :eof nil (point)) - (let ((char (char-after (point))) - (pos (point))) - (cond - ((parseclj-lex-at-whitespace-p) - (parseclj-lex-whitespace)) - - ((equal char ?\() - (right-char) - (parseclj-lex-token :lparen "(" pos)) - - ((equal char ?\)) - (right-char) - (parseclj-lex-token :rparen ")" pos)) - - ((equal char ?\[) - (right-char) - (parseclj-lex-token :lbracket "[" pos)) - - ((equal char ?\]) - (right-char) - (parseclj-lex-token :rbracket "]" pos)) - - ((equal char ?{) - (right-char) - (parseclj-lex-token :lbrace "{" pos)) - - ((equal char ?}) - (right-char) - (parseclj-lex-token :rbrace "}" pos)) - - ((equal char ?') - (right-char) - (parseclj-lex-token :quote "'" pos)) - - ((equal char ?`) - (right-char) - (parseclj-lex-token :backquote "`" pos)) - - ((equal char ?~) - (right-char) - (if (eq ?@ (char-after (point))) - (progn - (right-char) - (parseclj-lex-token :unquote-splice "~@" pos)) - (parseclj-lex-token :unquote "~" pos))) - - ((parseclj-lex-at-number-p) - (parseclj-lex-number)) - - ((parseclj-lex-symbol-start-p char) - (parseclj-lex-symbol)) - - ((equal char ?\") - (parseclj-lex-string)) - - ((equal char ?\\) - (parseclj-lex-character)) - - ((equal char ?:) - (parseclj-lex-keyword)) - - ((equal char ?\;) - (parseclj-lex-comment)) - - ((equal char ?^) - (right-char) - (parseclj-lex-token :metadata "^" pos)) - - ((equal char ?@) - (right-char) - (parseclj-lex-token :deref "@" pos)) - - ((equal char ?#) - (right-char) - (let ((char (char-after (point)))) - (cond - ((equal char ?{) - (right-char) - (parseclj-lex-token :set "#{" pos)) - ((equal char ?_) - (right-char) - (parseclj-lex-token :discard "#_" pos)) - ((equal char ?\() - (right-char) - (parseclj-lex-token :lambda "#(" pos)) - ((equal char ?') - (right-char) - (parseclj-lex-token :var "#'" pos)) - ((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 ?:) - (parseclj-lex-map-prefix)) - ((equal char ?\?) - (right-char) - (if (eq ?@ (char-after (point))) - (progn - (right-char) - (parseclj-lex-token :reader-conditional-splice "#?@" pos)) - (parseclj-lex-token :reader-conditional "#?" pos))) - ((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))) - (right-char)) - (parseclj-lex-error-token pos :invalid-hashtag-dispatcher))))) - - (t - (progn - (right-char) - (parseclj-lex-error-token pos))))))) - -(provide 'parseclj-lex) - -;;; parseclj-lex.el ends here diff --git a/elpa/parseclj-20220422.936/parseclj-parser.el b/elpa/parseclj-20220422.936/parseclj-parser.el deleted file mode 100644 index 4c757d23..00000000 --- a/elpa/parseclj-20220422.936/parseclj-parser.el +++ /dev/null @@ -1,285 +0,0 @@ -;;; parseclj-parser.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 'cl-lib) -(require 'subr-x) -(require 'parseclj-lex) -(require 'parseclj-alist) -(require 'map) - -(define-error 'parseclj-parser-error "parseclj: Syntax error") - -(defun parseclj--error (format &rest args) - "Signal a parse error. -Takes a FORMAT string and optional ARGS to be passed to -`format-message'. Signals a 'parseclj-parser-error signal, which -can be handled with `condition-case'." - (signal 'parseclj-parser-error (list (apply #'format-message format args)))) - -(defun parseclj--find-opening-token (stack closing-token) - "Scan STACK for an opening-token matching CLOSING-TOKEN." - (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. - -REDUCE-BRANCH is a function to be applied to the collection of tokens found -from the top of the stack until an opening token that matches -CLOSING-TOKEN. This function should return an AST token representing such -collection. - -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 (map-elt options :fail-fast t)) - (collection nil)) - (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" - (map-elt closing-token :pos) - (parseclj-lex-token-type closing-token)) - - (reverse collection))))))) - -(defun parseclj--take-value (stack value-p) - "Scan STACK until a value is found. -Return everything up to the value in reversed order (meaning the value -comes first in the result). - -STACK is the current parse stack to scan. - -VALUE-P a predicate to distinguish reduced values from non-values (tokens -and whitespace)." - (let ((result nil)) - (cl-block nil - (while stack - (cond - ((parseclj-lex-token-p (car stack)) - (cl-return nil)) - - ((funcall value-p (car stack)) - (cl-return (cons (car stack) result))) - - (t - (push (pop stack) result))))))) - -(defun parseclj--take-token (stack value-p token-types) - "Scan STACK until a token of a certain type is found. -Returns nil if a value is encountered before a matching token is found. -Return everything up to the token in reversed order (meaning the token -comes first in the result). - -STACK is the current parse stack to scan. - -VALUE-P a predicate to distinguish reduced values from non-values (tokens -and whitespace). - -TOKEN-TYPES are the token types to look for." - (let ((result nil)) - (cl-block nil - (while stack - (cond - ((member (parseclj-lex-token-type (car stack)) token-types) - (cl-return (cons (car stack) result))) - ((funcall value-p (car stack)) - (cl-return nil)) - ((parseclj-lex-token-p (car stack)) - (cl-return nil)) - (t - (push (pop stack) result))))))) - -(defun parseclj-single-value-p (stack value-p) - "Return t if STACK only has a single node for which VALUE-P is true. - -This checks if the stack contains a single, fully reduced value, and no -dangling unmatched tokens. When parsing with `:read-one' this indicates a -form can be returned." - (and (not (cl-reduce (lambda (bool node) - (or bool (parseclj-lex-token-p node))) - stack - :initial-value nil)) - (parseclj--take-value stack value-p))) - -(defun parseclj-parser (reduce-leaf reduce-branch &optional options) - "Clojure/EDN stack-based shift-reduce parser. - -REDUCE-LEAF does reductions for leaf nodes. It is a function that takes -the current value of the stack and a token, and either returns an updated -stack, with a new leaf node at the top (front), or returns the stack -unmodified. - -REDUCE-BRANCH does reductions for branch nodes. It is a function that -takes the current value of the stack, the type of branch node to create, -and a list of child nodes, and returns an updated stack, with the new node -at the top (front). - -What \"node\" means in this case is up to the reducing functions, it could -be AST nodes (as in the case of `parseclj-parser-clojure'), or plain -values/sexps (as in the case of `parseedn-read'), or something else. The -only requirement is that they should not put raw tokens back on the stack, -as the parser relies on the presence or absence of these to detect parse -errors. - -OPTIONS is an association list which is passed on to the reducing -functions. Additionally the following options are recognized - -- `:fail-fast' - Raise an error when a parse error is encountered, rather than continuing - with a partial result. -- `:value-p' - A predicate function to differentiate values from tokens and - whitespace. This is needed when scanning the stack to see if any - reductions can be performed. By default anything that isn't a token is - considered a value. This can be problematic when parsing with - `:lexical-preservation', and which case you should provide an - implementation that also returns falsy for :whitespace, :comment, and - :discard AST nodes. -- `:tag-readers' - An association list that describes tag handler functions for any possible - tag. This options in only available in `parseedn-read', for more - information, please refer to its documentation. -- `:read-one' - Return as soon as a single complete value has been read." - (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))) - - (while (not (or (and read-one (parseclj-single-value-p stack value-p)) - (eq (parseclj-lex-token-type token) :eof))) - ;; (message "STACK: %S" stack) - ;; (message "TOKEN: %S\n" token) - - (when (and fail-fast (parseclj-lex-error-p token)) - (parseclj--error "Invalid token at %s: %S" - (map-elt token :pos) - (parseclj-lex-token-form token))) - - ;; Reduce based on the top item on the stack (collections) - (cond - ((parseclj-lex-leaf-token-p token) - (setf stack (funcall reduce-leaf stack token options))) - - ((parseclj-lex-closing-token-p token) - (setf stack (parseclj--reduce-coll stack token reduce-branch options))) - - (t (push token stack))) - - ;; Reduce based on top two items on the stack (special prefixed elements) - (let* ((top-value (parseclj--take-value stack value-p)) - (opening-token (parseclj--take-token (nthcdr (length top-value) stack) value-p parseclj-lex--prefix-tokens)) - new-stack) - (while (and top-value opening-token) - ;; (message "Reducing...") - ;; (message " - STACK %S" stack) - ;; (message " - OPENING-TOKEN %S" opening-token) - ;; (message " - TOP-VALUE %S" top-value) - (setq new-stack (nthcdr (+ (length top-value) (length opening-token)) stack)) - (setq stack (funcall reduce-branch new-stack (car opening-token) (append (cdr opening-token) top-value) options)) - - ;; recur - (setq top-value (parseclj--take-value stack value-p)) - (setq opening-token (parseclj--take-token (nthcdr (length top-value) stack) value-p parseclj-lex--prefix-tokens)))) - - ;; Reduce based on top three items on the stack (metadata, namespaced maps) - (let* ((top-value-1 (parseclj--take-value stack value-p)) - (top-value-2 (parseclj--take-value (nthcdr (length top-value-1) stack) value-p)) - (opening-token (parseclj--take-token (nthcdr (+ (length top-value-1) - (length top-value-2)) stack) value-p parseclj-lex--prefix-2-tokens)) - new-stack) - (while (and top-value-1 top-value-2 opening-token) - (setq new-stack (nthcdr (apply #'+ (mapcar #'length (list top-value-1 top-value-2 opening-token))) stack)) - (setq stack (funcall reduce-branch new-stack (car opening-token) (append (cdr opening-token) top-value-2 top-value-1) options)) - - ;; recur - (setq top-value-1 (parseclj--take-value stack value-p)) - (setq top-value-2 (parseclj--take-value (nthcdr (length top-value-1) stack) value-p)) - (setq opening-token (parseclj--take-token (nthcdr (+ (length top-value-1) - (length top-value-2)) stack) value-p parseclj-lex--prefix-2-tokens)))) - - (setq token (parseclj-lex-next))) - - ;; reduce root - (when fail-fast - (when-let ((token (seq-find #'parseclj-lex-token-p stack))) - (parseclj--error "At position %s, unmatched %S" - (map-elt token :pos) - (parseclj-lex-token-type token)))) - - (if read-one - (car (parseclj--take-value stack value-p)) - (car (funcall reduce-branch nil (parseclj-lex-token :root "" 1) - (reverse stack) - options))))) - -(provide 'parseclj-parser) -;;; parseclj-parser.el ends here diff --git a/elpa/parseclj-20220422.936/parseclj-pkg.el b/elpa/parseclj-20220422.936/parseclj-pkg.el deleted file mode 100644 index 07e47022..00000000 --- a/elpa/parseclj-20220422.936/parseclj-pkg.el +++ /dev/null @@ -1,13 +0,0 @@ -(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-20220422.936/parseclj.el b/elpa/parseclj-20220422.936/parseclj.el deleted file mode 100644 index 682bc80c..00000000 --- a/elpa/parseclj-20220422.936/parseclj.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; parseclj.el --- Clojure/EDN parser -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2021 Arne Brasseur - -;; Author: Arne Brasseur -;; Keywords: lisp clojure edn parser -;; Package-Requires: ((emacs "25")) -;; Version: 1.1.0 - -;; 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: - -;; Top level API for the Clojure parser. - -;;; 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. - -Reads either from the current buffer, starting from point, until -`point-max', or reads from the optional string argument. - -STRING-AND-OPTIONS can be an optional string, followed by -key-value pairs to specify parsing options. - -- `:lexical-preservation' Retain whitespace, comments, and - discards. Defaults to nil. -- `:fail-fast' Raise an error when encountering invalid syntax. - Defaults to t. -- `:read-one' - Read a single form. Defaults to false: parse the complete input." - (if (stringp (car string-and-options)) - (with-temp-buffer - (insert (car string-and-options)) - (goto-char 1) - (apply 'parseclj-parse-clojure (cdr string-and-options))) - (let* ((value-p (lambda (e) - (and (parseclj-ast-node-p e) - (not (member (parseclj-ast-node-type e) '(:whitespace :comment :discard)))))) - (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) - (if lexical? - #'parseclj-ast--reduce-branch-with-lexical-preservation - #'parseclj-ast--reduce-branch) - options)))) - -(defun parseclj-unparse-clojure (ast) - "Parse Clojure AST to source code. - -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 (map-elt ast :form)) - (if (eql (parseclj-ast-node-type ast) :tag) - (parseclj-ast--unparse-tag ast) - (parseclj-ast--unparse-collection ast)))) - -(defun parseclj-unparse-clojure-to-string (ast) - "Parse Clojure AST to a source code string. - -Given an abstract syntax tree AST (as returned by -`parseclj-parse-clojure'), turn it back into source code, and -return it as a string" - (with-temp-buffer - (parseclj-unparse-clojure ast) - (buffer-substring-no-properties (point-min) (point-max)))) - -(provide 'parseclj) - -;;; parseclj.el ends here diff --git a/elpa/parseclj-20231203.1905/parseclj-alist.el b/elpa/parseclj-20231203.1905/parseclj-alist.el new file mode 100644 index 00000000..2e2228ab --- /dev/null +++ b/elpa/parseclj-20231203.1905/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 the association lists L1 and L2." + ;; 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-20231203.1905/parseclj-ast.el b/elpa/parseclj-20231203.1905/parseclj-ast.el new file mode 100644 index 00000000..94255c86 --- /dev/null +++ b/elpa/parseclj-20231203.1905/parseclj-ast.el @@ -0,0 +1,205 @@ +;;; parseclj-ast.el --- Clojure parser/unparser -*- 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: + +;; Parse Clojure code to an AST, and unparse back to code. + +;;; Code: + +(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 '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." + (and (consp node) + (consp (car node)) + (eq :node-type (caar node)))) + +(defun parseclj-ast-node-attr (node attr) + "Return NODE's ATTR, or nil." + (map-elt node attr)) + +(defun parseclj-ast-node-type (node) + "Return the type of the AST node NODE." + (map-elt node :node-type)) + +(defun parseclj-ast-children (node) + "Return children for the AST NODE." + (map-elt node :children)) + +(defun parseclj-ast-value (node) + "Return the value of NODE as another AST node." + (map-elt node :value)) + +(defun parseclj-ast-leaf-node-p (node) + "Return t if the given ast NODE is a leaf node." + (member (parseclj-ast-node-type node) parseclj-lex--leaf-tokens)) + +(defun parseclj-ast-branch-node-p (node) + "Return t if the given AST NODE is a branch node." + (not (parseclj-ast-leaf-node-p node))) + + +;; Parse/reduce strategy functions + +(defun parseclj-ast--reduce-leaf (stack token &optional _options) + "Put into the STACK an AST leaf node based on TOKEN. +Ignores white spaces and comments. + +OPTIONS is an association list. See `parseclj-parse' for more information +on available options." + (if (member (parseclj-lex-token-type token) '(:whitespace :comment)) + stack + (cons + (parseclj-ast-node (parseclj-lex-token-type token) + (map-elt token :pos) + :form (map-elt token :form) + :value (parseclj-lex--leaf-token-value token)) + stack))) + +(defun parseclj-ast--reduce-leaf-with-lexical-preservation (stack token options) + "Put into STACK an AST leaf node based on TOKEN. +This function is very similar to `parseclj-ast--reduce-leaf', but unlike +it, takes into account tokens representing white space or comments and +saves them into the STACK. Nodes produced by this function have a +`:lexical-preservation' key set to t. + +OPTIONS is an association list. See `parseclj-parse' for more information +on available options." + (let ((token-type (parseclj-lex-token-type token)) + (top (car stack))) + (if (member token-type '(:whitespace :comment)) + ;; merge consecutive whitespace or comment tokens + (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) + (map-elt token :pos) + :form (map-elt token :form)) + stack)) + (parseclj-ast--reduce-leaf stack token options)))) + +(defun parseclj-ast--reduce-branch (stack opening-token children _options) + "Reduce STACK with an AST branch node representing a collection of elements. +Ignores discard tokens. + +OPENING-TOKEN is a lex token representing an opening paren, bracket or +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 (map-elt opening-token :pos)) + (type (parseclj-lex-token-type opening-token)) + (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. +Similar to `parseclj-ast--reduce-branch', but reduces discard tokens as +well. Nodes produced by this function have a `:lexical-preservation' +key set to t. + +OPENING-TOKEN is a lex token representing an opening paren, bracket or +brace. +CHILDREN is the collection of tokens to be reduced into the AST branch +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 (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) + (cons (cl-list* (car top) ;; make sure :node-type remains the first element in the list + '(:lexical-preservation . t) + (cdr top)) + (cdr stack)) + stack)))) + + + +;; Unparse functions + +(declare-function parseclj-unparse-clojure "parseclj") + +(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 (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 (map-elt node :lexical-preservation)) + (insert " ")) + (parseclj-unparse-clojure child))) + (insert (cdr delimiters)))) + +(defun parseclj-ast--unparse-tag (node) + "Insert a string representation of the given AST tag NODE into buffer." + (progn + (insert "#") + (insert (symbol-name (map-elt node :tag))) + (insert " ") + (parseclj-unparse-clojure (car (map-elt node :children))))) + +(provide 'parseclj-ast) + +;;; parseclj-ast.el ends here diff --git a/elpa/parseclj-20231203.1905/parseclj-autoloads.el b/elpa/parseclj-20231203.1905/parseclj-autoloads.el new file mode 100644 index 00000000..fe2ea761 --- /dev/null +++ b/elpa/parseclj-20231203.1905/parseclj-autoloads.el @@ -0,0 +1,48 @@ +;;; parseclj-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from parseclj.el + +(register-definition-prefixes "parseclj" '("parseclj-")) + + +;;; Generated autoloads from parseclj-alist.el + +(register-definition-prefixes "parseclj-alist" '("parseclj-")) + + +;;; Generated autoloads from parseclj-ast.el + +(register-definition-prefixes "parseclj-ast" '("parseclj-ast-")) + + +;;; Generated autoloads from parseclj-lex.el + +(register-definition-prefixes "parseclj-lex" '("parseclj-lex-")) + + +;;; Generated autoloads from parseclj-parser.el + +(register-definition-prefixes "parseclj-parser" '("parseclj-")) + +;;; End of scraped data + +(provide 'parseclj-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; parseclj-autoloads.el ends here diff --git a/elpa/parseclj-20231203.1905/parseclj-lex.el b/elpa/parseclj-20231203.1905/parseclj-lex.el new file mode 100644 index 00000000..aa8a7212 --- /dev/null +++ b/elpa/parseclj-20231203.1905/parseclj-lex.el @@ -0,0 +1,589 @@ +;;; parseclj-lex.el --- Clojure/EDN Lexer -*- lexical-binding: nil; -*- + +;; 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 reader for EDN data files and parser for Clojure source files. + +;;; 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 + :false + :symbol + :keyword + :string + :regex + :character) + "Types of tokens that represent leaf nodes in the AST.") + +(defvar parseclj-lex--closing-tokens '(:rparen + :rbracket + :rbrace) + "Types of tokens that mark the end of a non-atomic form.") + +(defvar parseclj-lex--prefix-tokens '(:quote + :backquote + :unquote + :unquote-splice + :discard + :tag + :reader-conditional + :reader-conditional-splice + :var + :deref + :map-prefix + :eval) + "Tokens that modify the form that follows.") + +(defvar parseclj-lex--prefix-2-tokens '(:metadata) + "Tokens that modify the two forms that follow.") + +;; Token interface + +(defun parseclj-lex-token (type form pos &rest attributes) + "Create a lexer token with the specified attributes. + +Tokens at a mimimum have these attributes +- TYPE: the type of token, like :whitespace or :lparen +- FORM: the source form, a string +- 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 #'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. +ERROR-TYPE is an optional keyword to attach to the created token, +as the means for providing more information on the error." + (apply #'parseclj-lex-token + :lex-error + (buffer-substring-no-properties pos (point)) + pos + (when error-type + (list :error-type error-type)))) + +(defun parseclj-lex-token-p (token) + "Is the given TOKEN a parseclj-lex TOKEN. + +A token is an association list with :token-type as its first key." + (and (consp token) + (consp (car token)) + (eq :token-type (caar token)))) + +(defun parseclj-lex-token-type (token) + "Get the type of TOKEN." + (and (consp token) + (cdr (assq :token-type token)))) + +(defun parseclj-lex-token-form (token) + "Get the form of TOKEN." + (and (consp token) + (cdr (assq :form token)))) + +(defun parseclj-lex-leaf-token-p (token) + "Return t if the given AST TOKEN is a leaf node." + (member (parseclj-lex-token-type token) parseclj-lex--leaf-tokens)) + +(defun parseclj-lex-closing-token-p (token) + "Return t if the given ast TOKEN is a closing token." + (member (parseclj-lex-token-type token) parseclj-lex--closing-tokens)) + +(defun parseclj-lex-error-p (token) + "Return t if the TOKEN represents a lexing error token." + (eq (parseclj-lex-token-type token) :lex-error)) + +;; Elisp values from tokens + +(defun parseclj-lex--string-value (s) + "Parse an EDN string S into a regular string. +S goes through three transformations: +- Escaped characters in S are transformed into Elisp escaped + characters. +- Unicode escaped characters are decoded into its corresponding + unicode character counterpart. +- Octal escaped characters are decoded into its corresponding + character counterpart." + (replace-regexp-in-string + "\\\\o[0-8]\\{3\\}" + (lambda (x) + (make-string 1 (string-to-number (substring x 2) 8))) + (replace-regexp-in-string + "\\\\u[0-9a-fA-F]\\{4\\}" + (lambda (x) + (make-string 1 (string-to-number (substring x 2) 16))) + (replace-regexp-in-string "\\\\[tbnrf'\"\\]" + (lambda (x) + (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) + "Parse an EDN character C into an Emacs Lisp character." + (let ((first-char (elt c 1))) + (cond + ((equal c "\\newline") ?\n) + ((equal c "\\return") ?\r) + ((equal c "\\space") ?\ ) + ((equal c "\\tab") ?\t) + ((eq first-char ?u) (string-to-number (substring c 2) 16)) + ((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." + (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 + +(defun parseclj-lex-at-whitespace-p () + "Return t if char at point is white space." + (let ((char (char-after (point)))) + (or (equal char ?\ ) + (equal char ?\t) + (equal char ?\n) + (equal char ?\r) + (equal char ?,)))) + +(defun parseclj-lex-at-eof-p () + "Return t if point is at the end of file." + (eq (point) (point-max))) + +(defun parseclj-lex-whitespace () + "Consume all consecutive white space as possible and return an :whitespace token." + (let ((pos (point))) + (while (parseclj-lex-at-whitespace-p) + (right-char)) + (parseclj-lex-token :whitespace + (buffer-substring-no-properties pos (point)) + pos))) + +(defun parseclj-lex-skip-digits () + "Skip all consecutive digits after point." + (while (and (char-after (point)) + (<= ?0 (char-after (point))) + (<= (char-after (point)) ?9)) + (right-char))) + +(defun parseclj-lex-skip-hex () + "Skip all consecutive hex digits after point." + (while (and (char-after (point)) + (or (<= ?0 (char-after (point)) ?9) + (<= ?a (char-after (point)) ?f) + (<= ?A (char-after (point)) ?F))) + (right-char))) + +(defun parseclj-lex-skip-number () + "Skip a number at point." + ;; [\+\-]?\d+\.\d+ + (if (and (eq ?0 (char-after (point))) + (eq ?x (char-after (1+ (point))))) + (progn + (right-char 2) + (parseclj-lex-skip-hex)) + (progn + (when (member (char-after (point)) '(?+ ?-)) + (right-char)) + + (parseclj-lex-skip-digits) + + (when (eq (char-after (point)) ?.) + (right-char)) + + (parseclj-lex-skip-digits)))) + +(defun parseclj-lex-number () + "Consume a number and return a `:number' token representing it." + (let ((pos (point))) + (parseclj-lex-skip-number) + + ;; 10110r2 or 4.3e+22 + (when (member (char-after (point)) '(?E ?e ?r)) + (right-char)) + + (parseclj-lex-skip-number) + + ;; trailing M + (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)) + (and (member char '(?. ?* ?+ ?! ?- ?_ ?? ?$ ?& ?= ?< ?> ?/))))) + (progn + (right-char) + (parseclj-lex-error-token pos :invalid-number-format)) + (parseclj-lex-token :number + (buffer-substring-no-properties pos (point)) + pos))))) + + +(defun parseclj-lex-digit-p (char) + "Return t if CHAR is a digit." + (and char (<= ?0 char) (<= char ?9))) + +(defun parseclj-lex-at-number-p () + "Return t if point is at a number." + (let ((char (char-after (point)))) + (or (parseclj-lex-digit-p char) + (and (member char '(?- ?+ ?.)) + (parseclj-lex-digit-p (char-after (1+ (point)))))))) + +(defun parseclj-lex-symbol-start-p (char &optional alpha-only) + "Return t if CHAR is a valid start for a symbol. + +Symbols begin with a non-numeric character and can contain alphanumeric +characters and . * + ! - _ ? $ % & = < > '. If - + or . are the first +character, the second character (if any) must be non-numeric. + +In some cases, like in tagged elements, symbols are required to start with +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 parseclj-lex-symbol-special-chars))))))) + +(defun parseclj-lex-symbol-rest-p (char) + "Return t if CHAR is a valid character in a symbol. +For more information on what determines a valid symbol, see +`parseclj-lex-symbol-start-p'" + (or (parseclj-lex-symbol-start-p char) + (parseclj-lex-digit-p char) + (eq ?: char) + (eq ?# char))) + +(defun parseclj-lex-get-symbol-at-point (pos) + "Return the symbol at POS as a string." + (while (parseclj-lex-symbol-rest-p (char-after (point))) + (right-char)) + (buffer-substring-no-properties pos (point))) + +(defun parseclj-lex-symbol () + "Return a lex token representing a symbol. +Because of their special meaning, symbols \"nil\", \"true\", and \"false\" +are returned as their own lex tokens." + (let ((pos (point))) + (right-char) + (let ((sym (parseclj-lex-get-symbol-at-point pos))) + (cond + ((equal sym "nil") (parseclj-lex-token :nil "nil" pos)) + ((equal sym "true") (parseclj-lex-token :true "true" pos)) + ((equal sym "false") (parseclj-lex-token :false "false" pos)) + (t (parseclj-lex-token :symbol sym pos)))))) + +(defun parseclj-lex-string* () + "Helper for string/regex lexing. +Returns either the string, or an error token" + (let ((pos (point))) + (right-char) + (while (not (or (equal (char-after (point)) ?\") (parseclj-lex-at-eof-p))) + (if (equal (char-after (point)) ?\\) + (right-char 2) + (right-char))) + (when (equal (char-after (point)) ?\") + (right-char) + (buffer-substring-no-properties pos (point))))) + +(defun parseclj-lex-string () + "Return a lex token representing a string. +If EOF is reached without finding a closing double quote, a :lex-error +token is returned." + (let ((pos (point)) + (str (parseclj-lex-string*))) + (if str + (parseclj-lex-token :string str pos) + (parseclj-lex-error-token pos :invalid-string)))) + +(defun parseclj-lex-regex () + "Return a lex token representing a regular expression. +If EOF is reached without finding a closing double quote, a :lex-error +token is returned." + (let ((pos (1- (point))) + (str (parseclj-lex-string*))) + (if str + (parseclj-lex-token :regex (concat "#" str) pos) + (parseclj-lex-error-token pos :invalid-regex)))) + +(defun parseclj-lex-lookahead (n) + "Return a lookahead string of N characters after point." + (buffer-substring-no-properties (point) (min (+ (point) n) (point-max)))) + +(defun parseclj-lex-character () + "Return a lex token representing a character." + (let ((pos (point))) + (right-char) + (cond + ((equal (parseclj-lex-lookahead 3) "tab") + (right-char 3) + (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) + + ((equal (parseclj-lex-lookahead 5) "space") + (right-char 5) + (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) + + ((equal (parseclj-lex-lookahead 6) "return") + (right-char 6) + (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) + + ((equal (parseclj-lex-lookahead 7) "newline") + (right-char 7) + (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) + + ((string-match-p "^u[0-9a-fA-F]\\{4\\}" (parseclj-lex-lookahead 5)) + (right-char 5) + (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) + + ((string-match-p "^o[0-8]\\{3\\}" (parseclj-lex-lookahead 4)) + (right-char 4) + (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos)) + + (t + (right-char) + (parseclj-lex-token :character (buffer-substring-no-properties pos (point)) pos))))) + +(defun parseclj-lex-keyword () + "Return a lex token representing a keyword. +Keywords follow the same rules as symbols, except they start with one or +two colon characters. + +See `parseclj-lex-symbol', `parseclj-lex-symbol-start-p'." + (let ((pos (point))) + (right-char) + (when (equal (char-after (point)) ?:) ;; same-namespace keyword + (right-char)) + (if (equal (char-after (point)) ?:) ;; three colons in a row => lex-error + (progn + (right-char) + (parseclj-lex-error-token pos :invalid-keyword)) + (progn + (while (or (parseclj-lex-symbol-rest-p (char-after (point))) + (equal (char-after (point)) ?#)) + (right-char)) + (parseclj-lex-token :keyword (buffer-substring-no-properties pos (point)) pos))))) + +(defun parseclj-lex-comment () + "Return a lex token representing a comment." + (let ((pos (point))) + (goto-char (line-end-position)) + (when (equal (char-after (point)) ?\n) + (right-char)) + (parseclj-lex-token :comment (buffer-substring-no-properties pos (point)) pos))) + +(defun parseclj-lex-map-prefix () + "Return a lex token representing a map prefix." + (let ((pos (1- (point)))) + (right-char) + (when (equal (char-after (point)) ?:) + (right-char)) + (while (parseclj-lex-symbol-rest-p (char-after (point))) + (right-char)) + (parseclj-lex-token :map-prefix (buffer-substring-no-properties pos (point)) pos))) + +(defun parseclj-lex-next () + "Consume characters at point and return the next lexical token. + +See `parseclj-lex-token'." + (if (parseclj-lex-at-eof-p) + (parseclj-lex-token :eof nil (point)) + (let ((char (char-after (point))) + (pos (point))) + (cond + ((parseclj-lex-at-whitespace-p) + (parseclj-lex-whitespace)) + + ((equal char ?\() + (right-char) + (parseclj-lex-token :lparen "(" pos)) + + ((equal char ?\)) + (right-char) + (parseclj-lex-token :rparen ")" pos)) + + ((equal char ?\[) + (right-char) + (parseclj-lex-token :lbracket "[" pos)) + + ((equal char ?\]) + (right-char) + (parseclj-lex-token :rbracket "]" pos)) + + ((equal char ?{) + (right-char) + (parseclj-lex-token :lbrace "{" pos)) + + ((equal char ?}) + (right-char) + (parseclj-lex-token :rbrace "}" pos)) + + ((equal char ?') + (right-char) + (parseclj-lex-token :quote "'" pos)) + + ((equal char ?`) + (right-char) + (parseclj-lex-token :backquote "`" pos)) + + ((equal char ?~) + (right-char) + (if (eq ?@ (char-after (point))) + (progn + (right-char) + (parseclj-lex-token :unquote-splice "~@" pos)) + (parseclj-lex-token :unquote "~" pos))) + + ((parseclj-lex-at-number-p) + (parseclj-lex-number)) + + ((parseclj-lex-symbol-start-p char) + (parseclj-lex-symbol)) + + ((equal char ?\") + (parseclj-lex-string)) + + ((equal char ?\\) + (parseclj-lex-character)) + + ((equal char ?:) + (parseclj-lex-keyword)) + + ((equal char ?\;) + (parseclj-lex-comment)) + + ((equal char ?^) + (right-char) + (parseclj-lex-token :metadata "^" pos)) + + ((equal char ?@) + (right-char) + (parseclj-lex-token :deref "@" pos)) + + ((equal char ?#) + (right-char) + (let ((char (char-after (point)))) + (cond + ((equal char ?{) + (right-char) + (parseclj-lex-token :set "#{" pos)) + ((equal char ?_) + (right-char) + (parseclj-lex-token :discard "#_" pos)) + ((equal char ?\() + (right-char) + (parseclj-lex-token :lambda "#(" pos)) + ((equal char ?') + (right-char) + (parseclj-lex-token :var "#'" pos)) + ((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 ?:) + (parseclj-lex-map-prefix)) + ((equal char ?\?) + (right-char) + (if (eq ?@ (char-after (point))) + (progn + (right-char) + (parseclj-lex-token :reader-conditional-splice "#?@" pos)) + (parseclj-lex-token :reader-conditional "#?" pos))) + ((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))) + (right-char)) + (parseclj-lex-error-token pos :invalid-hashtag-dispatcher))))) + + (t + (progn + (right-char) + (parseclj-lex-error-token pos))))))) + +(provide 'parseclj-lex) + +;;; parseclj-lex.el ends here diff --git a/elpa/parseclj-20231203.1905/parseclj-parser.el b/elpa/parseclj-20231203.1905/parseclj-parser.el new file mode 100644 index 00000000..4c757d23 --- /dev/null +++ b/elpa/parseclj-20231203.1905/parseclj-parser.el @@ -0,0 +1,285 @@ +;;; parseclj-parser.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 'cl-lib) +(require 'subr-x) +(require 'parseclj-lex) +(require 'parseclj-alist) +(require 'map) + +(define-error 'parseclj-parser-error "parseclj: Syntax error") + +(defun parseclj--error (format &rest args) + "Signal a parse error. +Takes a FORMAT string and optional ARGS to be passed to +`format-message'. Signals a 'parseclj-parser-error signal, which +can be handled with `condition-case'." + (signal 'parseclj-parser-error (list (apply #'format-message format args)))) + +(defun parseclj--find-opening-token (stack closing-token) + "Scan STACK for an opening-token matching CLOSING-TOKEN." + (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. + +REDUCE-BRANCH is a function to be applied to the collection of tokens found +from the top of the stack until an opening token that matches +CLOSING-TOKEN. This function should return an AST token representing such +collection. + +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 (map-elt options :fail-fast t)) + (collection nil)) + (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" + (map-elt closing-token :pos) + (parseclj-lex-token-type closing-token)) + + (reverse collection))))))) + +(defun parseclj--take-value (stack value-p) + "Scan STACK until a value is found. +Return everything up to the value in reversed order (meaning the value +comes first in the result). + +STACK is the current parse stack to scan. + +VALUE-P a predicate to distinguish reduced values from non-values (tokens +and whitespace)." + (let ((result nil)) + (cl-block nil + (while stack + (cond + ((parseclj-lex-token-p (car stack)) + (cl-return nil)) + + ((funcall value-p (car stack)) + (cl-return (cons (car stack) result))) + + (t + (push (pop stack) result))))))) + +(defun parseclj--take-token (stack value-p token-types) + "Scan STACK until a token of a certain type is found. +Returns nil if a value is encountered before a matching token is found. +Return everything up to the token in reversed order (meaning the token +comes first in the result). + +STACK is the current parse stack to scan. + +VALUE-P a predicate to distinguish reduced values from non-values (tokens +and whitespace). + +TOKEN-TYPES are the token types to look for." + (let ((result nil)) + (cl-block nil + (while stack + (cond + ((member (parseclj-lex-token-type (car stack)) token-types) + (cl-return (cons (car stack) result))) + ((funcall value-p (car stack)) + (cl-return nil)) + ((parseclj-lex-token-p (car stack)) + (cl-return nil)) + (t + (push (pop stack) result))))))) + +(defun parseclj-single-value-p (stack value-p) + "Return t if STACK only has a single node for which VALUE-P is true. + +This checks if the stack contains a single, fully reduced value, and no +dangling unmatched tokens. When parsing with `:read-one' this indicates a +form can be returned." + (and (not (cl-reduce (lambda (bool node) + (or bool (parseclj-lex-token-p node))) + stack + :initial-value nil)) + (parseclj--take-value stack value-p))) + +(defun parseclj-parser (reduce-leaf reduce-branch &optional options) + "Clojure/EDN stack-based shift-reduce parser. + +REDUCE-LEAF does reductions for leaf nodes. It is a function that takes +the current value of the stack and a token, and either returns an updated +stack, with a new leaf node at the top (front), or returns the stack +unmodified. + +REDUCE-BRANCH does reductions for branch nodes. It is a function that +takes the current value of the stack, the type of branch node to create, +and a list of child nodes, and returns an updated stack, with the new node +at the top (front). + +What \"node\" means in this case is up to the reducing functions, it could +be AST nodes (as in the case of `parseclj-parser-clojure'), or plain +values/sexps (as in the case of `parseedn-read'), or something else. The +only requirement is that they should not put raw tokens back on the stack, +as the parser relies on the presence or absence of these to detect parse +errors. + +OPTIONS is an association list which is passed on to the reducing +functions. Additionally the following options are recognized + +- `:fail-fast' + Raise an error when a parse error is encountered, rather than continuing + with a partial result. +- `:value-p' + A predicate function to differentiate values from tokens and + whitespace. This is needed when scanning the stack to see if any + reductions can be performed. By default anything that isn't a token is + considered a value. This can be problematic when parsing with + `:lexical-preservation', and which case you should provide an + implementation that also returns falsy for :whitespace, :comment, and + :discard AST nodes. +- `:tag-readers' + An association list that describes tag handler functions for any possible + tag. This options in only available in `parseedn-read', for more + information, please refer to its documentation. +- `:read-one' + Return as soon as a single complete value has been read." + (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))) + + (while (not (or (and read-one (parseclj-single-value-p stack value-p)) + (eq (parseclj-lex-token-type token) :eof))) + ;; (message "STACK: %S" stack) + ;; (message "TOKEN: %S\n" token) + + (when (and fail-fast (parseclj-lex-error-p token)) + (parseclj--error "Invalid token at %s: %S" + (map-elt token :pos) + (parseclj-lex-token-form token))) + + ;; Reduce based on the top item on the stack (collections) + (cond + ((parseclj-lex-leaf-token-p token) + (setf stack (funcall reduce-leaf stack token options))) + + ((parseclj-lex-closing-token-p token) + (setf stack (parseclj--reduce-coll stack token reduce-branch options))) + + (t (push token stack))) + + ;; Reduce based on top two items on the stack (special prefixed elements) + (let* ((top-value (parseclj--take-value stack value-p)) + (opening-token (parseclj--take-token (nthcdr (length top-value) stack) value-p parseclj-lex--prefix-tokens)) + new-stack) + (while (and top-value opening-token) + ;; (message "Reducing...") + ;; (message " - STACK %S" stack) + ;; (message " - OPENING-TOKEN %S" opening-token) + ;; (message " - TOP-VALUE %S" top-value) + (setq new-stack (nthcdr (+ (length top-value) (length opening-token)) stack)) + (setq stack (funcall reduce-branch new-stack (car opening-token) (append (cdr opening-token) top-value) options)) + + ;; recur + (setq top-value (parseclj--take-value stack value-p)) + (setq opening-token (parseclj--take-token (nthcdr (length top-value) stack) value-p parseclj-lex--prefix-tokens)))) + + ;; Reduce based on top three items on the stack (metadata, namespaced maps) + (let* ((top-value-1 (parseclj--take-value stack value-p)) + (top-value-2 (parseclj--take-value (nthcdr (length top-value-1) stack) value-p)) + (opening-token (parseclj--take-token (nthcdr (+ (length top-value-1) + (length top-value-2)) stack) value-p parseclj-lex--prefix-2-tokens)) + new-stack) + (while (and top-value-1 top-value-2 opening-token) + (setq new-stack (nthcdr (apply #'+ (mapcar #'length (list top-value-1 top-value-2 opening-token))) stack)) + (setq stack (funcall reduce-branch new-stack (car opening-token) (append (cdr opening-token) top-value-2 top-value-1) options)) + + ;; recur + (setq top-value-1 (parseclj--take-value stack value-p)) + (setq top-value-2 (parseclj--take-value (nthcdr (length top-value-1) stack) value-p)) + (setq opening-token (parseclj--take-token (nthcdr (+ (length top-value-1) + (length top-value-2)) stack) value-p parseclj-lex--prefix-2-tokens)))) + + (setq token (parseclj-lex-next))) + + ;; reduce root + (when fail-fast + (when-let ((token (seq-find #'parseclj-lex-token-p stack))) + (parseclj--error "At position %s, unmatched %S" + (map-elt token :pos) + (parseclj-lex-token-type token)))) + + (if read-one + (car (parseclj--take-value stack value-p)) + (car (funcall reduce-branch nil (parseclj-lex-token :root "" 1) + (reverse stack) + options))))) + +(provide 'parseclj-parser) +;;; parseclj-parser.el ends here diff --git a/elpa/parseclj-20231203.1905/parseclj-pkg.el b/elpa/parseclj-20231203.1905/parseclj-pkg.el new file mode 100644 index 00000000..bd9e0635 --- /dev/null +++ b/elpa/parseclj-20231203.1905/parseclj-pkg.el @@ -0,0 +1,10 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "parseclj" "20231203.1905" + "Clojure/EDN parser." + '((emacs "25")) + :url "https://github.com/clojure-emacs/parseclj" + :commit "6af22372e0fe14df882dd300b22b12ba2d7e00b0" + :revdesc "6af22372e0fe" + :keywords '("lisp" "clojure" "edn" "parser") + :authors '(("Arne Brasseur" . "arne@arnebrasseur.net")) + :maintainers '(("Arne Brasseur" . "arne@arnebrasseur.net"))) diff --git a/elpa/parseclj-20231203.1905/parseclj.el b/elpa/parseclj-20231203.1905/parseclj.el new file mode 100644 index 00000000..bd746dc4 --- /dev/null +++ b/elpa/parseclj-20231203.1905/parseclj.el @@ -0,0 +1,98 @@ +;;; parseclj.el --- Clojure/EDN parser -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2023 Arne Brasseur + +;; Author: Arne Brasseur +;; Keywords: lisp clojure edn parser +;; Package-Requires: ((emacs "25")) +;; Package-Version: 20231203.1905 +;; Package-Revision: 6af22372e0fe + +;; 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: + +;; Top level API for the Clojure parser. + +;;; 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. + +Reads either from the current buffer, starting from point, until +`point-max', or reads from the optional string argument. + +STRING-AND-OPTIONS can be an optional string, followed by +key-value pairs to specify parsing options. + +- `:lexical-preservation' Retain whitespace, comments, and + discards. Defaults to nil. +- `:fail-fast' Raise an error when encountering invalid syntax. + Defaults to t. +- `:read-one' + Read a single form. Defaults to false: parse the complete input." + (if (stringp (car string-and-options)) + (with-temp-buffer + (insert (car string-and-options)) + (goto-char 1) + (apply 'parseclj-parse-clojure (cdr string-and-options))) + (let* ((value-p (lambda (e) + (and (parseclj-ast-node-p e) + (not (member (parseclj-ast-node-type e) '(:whitespace :comment :discard)))))) + (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) + (if lexical? + #'parseclj-ast--reduce-branch-with-lexical-preservation + #'parseclj-ast--reduce-branch) + options)))) + +(defun parseclj-unparse-clojure (ast) + "Parse Clojure AST to source code. + +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 (map-elt ast :form)) + (if (eql (parseclj-ast-node-type ast) :tag) + (parseclj-ast--unparse-tag ast) + (parseclj-ast--unparse-collection ast)))) + +(defun parseclj-unparse-clojure-to-string (ast) + "Parse Clojure AST to a source code string. + +Given an abstract syntax tree AST (as returned by +`parseclj-parse-clojure'), turn it back into source code, and +return it as a string" + (with-temp-buffer + (parseclj-unparse-clojure ast) + (buffer-substring-no-properties (point-min) (point-max)))) + +(provide 'parseclj) + +;;; parseclj.el ends here