[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/parseclj 2588470302 116/185: Merge pull request #9 from la
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/parseclj 2588470302 116/185: Merge pull request #9 from lambdaisland/docstrings-and-conventions |
|
Date: |
Tue, 28 Dec 2021 14:05:27 -0500 (EST) |
branch: elpa/parseclj
commit 2588470302645f09c8f7e4e88cd953a248d58133
Merge: 168027fed5 e1cb9e5514
Author: Arne Brasseur <arne.brasseur@gmail.com>
Commit: GitHub <noreply@github.com>
Merge pull request #9 from lambdaisland/docstrings-and-conventions
Add docstrings and follow up on some conventions
---
.dir-locals.el | 10 +-
parseclj-ast.el | 112 ++++++++--
parseclj-lex.el | 193 ++++++++++++-----
parseclj-parser.el | 230 ++++++++++++++++++++
parseclj-unparse.el | 53 -----
parseclj.el | 297 ++------------------------
parseedn.el | 55 ++++-
test/parseclj-lex-test.el | 52 ++---
test/parseclj-test-data.el | 517 +++++++++++++++++++++++----------------------
test/parseclj-test.el | 54 ++---
10 files changed, 859 insertions(+), 714 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index e793bf010b..ab85ded9a1 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,2 +1,8 @@
-((nil .
- ((buffer-save-without-query . t))))
+((emacs-lisp-mode
+ (buffer-save-without-query . t)
+ (eval . (flycheck-mode))
+ (eval . (checkdoc-minor-mode))
+ (sentence-end-double-space . t)
+ (emacs-lisp-docstring-fill-column . 75)
+ (checkdoc-package-keywords-flag)
+ (checkdoc-arguments-in-order-flag)))
diff --git a/parseclj-ast.el b/parseclj-ast.el
index 7326471af1..26adeced61 100644
--- a/parseclj-ast.el
+++ b/parseclj-ast.el
@@ -27,41 +27,74 @@
;;; Code:
+(require 'subr-x)
+(require 'parseclj-lex)
+(require 'parseedn)
+
;; 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. "
+Other ATTRIBUTES can be given as a flat list of key-value pairs."
(apply 'a-list :node-type type :position position attributes))
-(defun parseclj-ast-node? (node)
- "Return `t' if the given NODE is a Clojure AST node."
+(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."
+ (a-get node attr))
+
(defun parseclj-ast-node-type (node)
"Return the type of the AST node NODE."
(a-get node :node-type))
-(defun parseclj-ast-leaf-node? (node)
- "Return `t' if the given ast NODE is a leaf node."
- (member (parseclj-ast-node-type node) parseclj--leaf-tokens))
+(defun parseclj-ast-children (node)
+ "Return children for the AST NODE."
+ (a-get node :children))
+
+(defun parseclj-ast-value (node)
+ "Return the value of NODE as another AST node."
+ (a-get 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 options)
+(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)
(a-get token :pos)
:form (a-get token :form)
- :value (parseclj--leaf-token-value token))
+ :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))
@@ -75,7 +108,15 @@ Other ATTRIBUTES can be given as a flat list of key-value
pairs. "
stack))
(parseclj-ast--reduce-leaf stack token options))))
-(defun parseclj-ast--reduce-branch (stack opening-token children 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 (a-get opening-token :pos))
(type (parseclj-lex-token-type opening-token))
(type (cl-case type
@@ -86,26 +127,71 @@ Other ATTRIBUTES can be given as a flat list of key-value
pairs. "
(cl-case type
(:root (cons (parseclj-ast-node :root pos :children children) stack))
(:discard stack)
- (:tag (list (parseclj-ast-node :tag
+ (:tag (cons (parseclj-ast-node :tag
pos
:tag (intern (substring (a-get
opening-token :form) 1))
- :children children)))
+ :children children)
+ 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 (a-get opening-token :pos) :children
children) stack)
(let* ((stack (funcall #'parseclj-ast--reduce-branch stack opening-token
children options))
(top (car stack)))
- (if (parseclj-ast-node? top)
+ (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 (cl-case token-type
+ (:root (cons "" ""))
+ (:list (cons "(" ")"))
+ (:vector (cons "[" "]"))
+ (:set (cons "#{" "}"))
+ (:map (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))
+ (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 (a-get node :tag)))
+ (insert " ")
+ (parseclj-unparse-clojure (car (a-get node :children)))))
+
(provide 'parseclj-ast)
;;; parseclj-ast.el ends here
diff --git a/parseclj-lex.el b/parseclj-lex.el
index df59881f67..d835457903 100644
--- a/parseclj-lex.el
+++ b/parseclj-lex.el
@@ -25,7 +25,26 @@
;; A reader for EDN data files and parser for Clojure source files.
-;;; Code
+;;; Code:
+
+(defvar parseclj-lex--leaf-tokens '(:whitespace
+ :comment
+ :number
+ :nil
+ :true
+ :false
+ :symbol
+ :keyword
+ :string
+ :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.")
+
+;; Token interface
(defun parseclj-lex-token (type form pos &rest attributes)
"Create a lexer token with the specified attributes.
@@ -38,10 +57,10 @@ Tokens at a mimimum have these attributes
Other ATTRIBUTES can be given as a flat list of key-value pairs."
(apply 'a-list :token-type type :form form :pos pos attributes))
-(defun parseclj-lex-token? (token)
+(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. "
+A token is an association list with :token-type as its first key."
(and (consp token)
(consp (car token))
(eq :token-type (caar token))))
@@ -51,15 +70,68 @@ A token is an association list with :token-type as its
first key. "
(and (consp token)
(cdr (assq :token-type token))))
-(defun parseclj-lex-leaf-token? (token)
- "Return `t' if the given ast TOKEN is a leaf node."
- (member (parseclj-lex-token-type token) parseclj--leaf-tokens))
-
-(defun parseclj-lex-closing-token? (token)
- "Return `t' if the given ast TOKEN is a closing toking."
- (member (parseclj-lex-token-type token) parseclj--closing-tokens))
-
-(defun parseclj-lex-at-whitespace? ()
+(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))
+
+
+;; Elisp values from tokens
+
+(defun parseclj-lex--string-value (s)
+ ""
+ (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)
+ (cl-case (elt x 1)
+ (?t "\t")
+ (?f "\f")
+ (?\" "\"")
+ (?r "\r")
+ (?n "\n")
+ (?\\ "\\\\")
+ (t (substring x 1))))
+ (substring s 1 -1)))))
+
+(defun parseclj-lex--character-value (c)
+ "Parse a 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--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)))))
+
+
+;; 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)
@@ -67,24 +139,28 @@ A token is an association list with :token-type as its
first key. "
(equal char ?\r)
(equal char ?,))))
-(defun parseclj-lex-at-eof? ()
+(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?)
+ (while (parseclj-lex-at-whitespace-p)
(right-char))
(parseclj-lex-token :whitespace
- (buffer-substring-no-properties pos (point))
- pos)))
+ (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-number ()
+ "Skip a number at point."
;; [\+\-]?\d+\.\d+
(when (member (char-after (point)) '(?+ ?-))
(right-char))
@@ -97,6 +173,7 @@ A token is an association list with :token-type as its first
key. "
(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)
@@ -117,51 +194,59 @@ A token is an association list with :token-type as its
first key. "
(progn
(right-char)
(parseclj-lex-token :lex-error
- (buffer-substring-no-properties pos (point))
- pos
- :error-type :invalid-number-format))
+ (buffer-substring-no-properties pos (point))
+ pos
+ :error-type :invalid-number-format))
(parseclj-lex-token :number
- (buffer-substring-no-properties pos (point))
- pos)))))
+ (buffer-substring-no-properties pos (point))
+ pos)))))
-(defun parseclj-lex-digit? (char)
+(defun parseclj-lex-digit-p (char)
+ "Return t if CHAR is a digit."
(and char (<= ?0 char) (<= char ?9)))
-(defun parseclj-lex-at-number? ()
+(defun parseclj-lex-at-number-p ()
+ "Return t if point is at a number."
(let ((char (char-after (point))))
- (or (parseclj-lex-digit? char)
+ (or (parseclj-lex-digit-p char)
(and (member char '(?- ?+ ?.))
- (parseclj-lex-digit? (char-after (1+ (point))))))))
+ (parseclj-lex-digit-p (char-after (1+ (point))))))))
-(defun parseclj-lex-symbol-start? (char &optional alpha-only)
- "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.
+(defun parseclj-lex-symbol-start-p (char &optional alpha-only)
+ "Return t if CHAR is a valid start for a symbol.
-In some cases, like in tagged elements, symbols are required to
-start with alphabetic characters only. ALPHA-ONLY ensures this
-behavior."
+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 '(?. ?* ?+ ?! ?- ?_ ??
?$ ?% ?& ?= ?< ?> ?/))))))))
-(defun parseclj-lex-symbol-rest? (char)
- (or (parseclj-lex-symbol-start? char)
- (parseclj-lex-digit? char)
+(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 point."
- (while (parseclj-lex-symbol-rest? (char-after (point)))
+ "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)))
@@ -172,9 +257,12 @@ behavior."
(t (parseclj-lex-token :symbol sym pos))))))
(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)))
(right-char)
- (while (not (or (equal (char-after (point)) ?\") (parseclj-lex-at-eof?)))
+ (while (not (or (equal (char-after (point)) ?\") (parseclj-lex-at-eof-p)))
(if (equal (char-after (point)) ?\\)
(right-char 2)
(right-char)))
@@ -185,9 +273,11 @@ behavior."
(parseclj-lex-token :lex-error (buffer-substring-no-properties pos
(point)) pos))))
(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
@@ -220,6 +310,11 @@ behavior."
(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
@@ -229,12 +324,13 @@ behavior."
(right-char)
(parseclj-lex-token :lex-error (buffer-substring-no-properties pos
(point)) pos :error-type :invalid-keyword))
(progn
- (while (or (parseclj-lex-symbol-rest? (char-after (point)))
+ (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)
@@ -242,12 +338,15 @@ behavior."
(parseclj-lex-token :comment (buffer-substring-no-properties pos (point))
pos)))
(defun parseclj-lex-next ()
- (if (parseclj-lex-at-eof?)
+ "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?)
+ ((parseclj-lex-at-whitespace-p)
(parseclj-lex-whitespace))
((equal char ?\()
@@ -274,10 +373,10 @@ behavior."
(right-char)
(parseclj-lex-token :rbrace "}" pos))
- ((parseclj-lex-at-number?)
+ ((parseclj-lex-at-number-p)
(parseclj-lex-number))
- ((parseclj-lex-symbol-start? char)
+ ((parseclj-lex-symbol-start-p char)
(parseclj-lex-symbol))
((equal char ?\")
@@ -302,12 +401,12 @@ behavior."
((equal char ?_)
(right-char)
(parseclj-lex-token :discard "#_" pos))
- ((parseclj-lex-symbol-start? char t)
+ ((parseclj-lex-symbol-start-p char t)
(right-char)
(parseclj-lex-token :tag (concat "#"
(parseclj-lex-get-symbol-at-point (1+ pos))) pos))
(t
- (while (not (or (parseclj-lex-at-whitespace?)
- (parseclj-lex-at-eof?)))
+ (while (not (or (parseclj-lex-at-whitespace-p)
+ (parseclj-lex-at-eof-p)))
(right-char))
(parseclj-lex-token :lex-error (buffer-substring-no-properties pos
(point)) pos :error-type :invalid-hashtag-dispatcher)))))
diff --git a/parseclj-parser.el b/parseclj-parser.el
new file mode 100644
index 0000000000..1e07d2d0a7
--- /dev/null
+++ b/parseclj-parser.el
@@ -0,0 +1,230 @@
+;;; parseclj-parser.el --- Clojure/EDN parser -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Arne Brasseur
+
+;; Author: Arne Brasseur <arne@arnebrasseur.net>
+;; Keywords: lisp
+;; Package-Requires: ((emacs "25") (a "0.1.0alpha4"))
+;; Version: 0.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:
+
+;; A shift/reduce parser for Clojure source.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'subr-x)
+(require 'a)
+(require 'parseclj-lex)
+
+(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."
+ (cl-case (parseclj-lex-token-type closing-token)
+ (:rparen :lparen)
+ (:rbracket :lbracket)
+ (:rbrace (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 (a-get 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)))
+ (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))
+
+ (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-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."
+ (let ((fail-fast (a-get options :fail-fast t))
+ (value-p (a-get options :value-p (lambda (e) (not
(parseclj-lex-token-p e)))))
+ (stack nil)
+ (token (parseclj-lex-next)))
+
+ (while (not (eq (parseclj-lex-token-type token) :eof))
+ ;; (message "STACK: %S" stack)
+ ;; (message "TOKEN: %S\n" 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 '(:discard :tag)))
+ (new-stack (nthcdr (+ (length top-value) (length opening-token))
stack)))
+ (when (and top-value opening-token)
+ ;; (message "Reducing...")
+ ;; (message " - STACK %S" stack)
+ ;; (message " - OPENING_TOKEN %S" opening-token)
+ ;; (message " - TOP_VALUE %S\n" top-value)
+ (setq stack (funcall reduce-branch new-stack (car opening-token)
(append (cdr opening-token) top-value) options))))
+
+ (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"
+ (a-get token :pos)
+ (parseclj-lex-token-type token))))
+
+ (car (funcall reduce-branch nil (parseclj-lex-token :root "" 1)
+ (reverse stack)
+ options))))
+
+(provide 'parseclj-parser)
+;;; parseclj-parser.el ends here
diff --git a/parseclj-unparse.el b/parseclj-unparse.el
deleted file mode 100644
index 8f2495c2b6..0000000000
--- a/parseclj-unparse.el
+++ /dev/null
@@ -1,53 +0,0 @@
-;;; parseclj-unparser.el --- Clojure unparser -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2017 Arne Brasseur
-
-;; Author: Arne Brasseur <arne@arnebrasseur.net>
-
-;; 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:
-
-;; Unparse an AST to Clojure code
-
-;;; Code:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Unparser helpers
-
-(defun parseclj-unparse--collection (node ld rd)
- (insert ld)
- (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))
- (insert " "))
- (parseclj-unparse-clojure child)))
- (insert rd))
-
-(defun parseclj-unparse--tag (node)
- (progn
- (insert "#")
- (insert (symbol-name (a-get node :tag)))
- (insert " ")
- (parseclj-unparse-clojure (car (a-get node :children)))))
-
-(provide 'parseclj-unparse)
-
-;;; parseclj-unparse.el ends here
diff --git a/parseclj.el b/parseclj.el
index c9e6abc489..515a5bbe80 100644
--- a/parseclj.el
+++ b/parseclj.el
@@ -26,302 +26,43 @@
;;; Commentary:
-;; A reader for EDN data files and parser for Clojure source files.
+;; Top level API for the Clojure parser.
;;; Code:
-(require 'cl-lib)
-(require 'a)
-
-(require 'parseclj-lex)
-(require 'parseedn)
+(require 'parseclj-parser)
(require 'parseclj-ast)
-(require 'parseclj-unparse)
-
-(defvar parseclj--leaf-tokens '(:whitespace
- :comment
- :number
- :nil
- :true
- :false
- :symbol
- :keyword
- :string
- :character)
- "Types of tokens that represent leaf nodes in the AST.")
-
-(defvar parseclj--closing-tokens '(:rparen
- :rbracket
- :rbrace)
- "Types of tokens that mark the end of a non-atomic form.")
-
-;; The EDN spec is not clear about wether \u0123 and \o012 are supported in
-;; strings. They are described as character literals, but not as string escape
-;; codes. In practice all implementations support them (mostly with broken
-;; surrogate pair support), so we do the same. Sorry, emoji 🙁.
-;;
-;; Note that this is kind of broken, we don't correctly detect if \u or \o
forms
-;; don't have the right forms.
-(defun parseclj--string (s)
- (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)
- (cl-case (elt x 1)
- (?t "\t")
- (?f "\f")
- (?\" "\"")
- (?r "\r")
- (?n "\n")
- (?\\ "\\\\")
- (t (substring x 1))))
- (substring s 1 -1)))))
-
-(defun parseclj--character (c)
- (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--leaf-token-value (token)
- (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--string (alist-get :form token)))
- (:character (parseclj--character (alist-get :form token)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Shift-Reduce Parser
-
-(define-error 'parseclj-parse-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-parse-error signal, which
-can be handled with `condition-case'."
- (signal 'parseclj-parse-error (list (apply #'format-message format args))))
-
-(defun parseclj--find-opening-token (stack closing-token)
- (cl-case (parseclj-lex-token-type closing-token)
- (:rparen :lparen)
- (:rbracket :lbracket)
- (:rbrace (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"
- (let ((opening-token-type (parseclj--find-opening-token stack closing-token))
- (fail-fast (a-get 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? collection)))
- (parseclj--error "parseclj: Syntax 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 "parseclj: Syntax Error at position %s, unmatched
%S"
- (a-get closing-token :pos)
- (parseclj-lex-token-type closing-token))
-
- (reverse collection)))))
-
-(defun parseclj--take-value (stack value-p)
- "Scan 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? (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 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? (car stack))
- (cl-return nil))
-
- (t
- (push (pop stack) result)))))))
-
-(defun parseclj-parse (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-parse-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. "
- (let ((fail-fast (a-get options :fail-fast t))
- (value-p (a-get options :value-p (lambda (e) (not (parseclj-lex-token?
e)))))
- (stack nil)
- (token (parseclj-lex-next)))
-
- (while (not (eq (parseclj-lex-token-type token) :eof))
- ;; (message "STACK: %S" stack)
- ;; (message "TOKEN: %S\n" token)
-
- ;; Reduce based on the top item on the stack (collections)
- (cond
- ((parseclj-lex-leaf-token? token)
- (setf stack (funcall reduce-leaf stack token options)))
-
- ((parseclj-lex-closing-token? 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 '(:discard :tag)))
- (new-stack (nthcdr (+ (length top-value) (length opening-token))
stack)))
- (when (and top-value opening-token)
- ;; (message "Reducing...")
- ;; (message " - STACK %S" stack)
- ;; (message " - OPENING_TOKEN %S" opening-token)
- ;; (message " - TOP_VALUE %S\n" top-value)
- (setq stack (funcall reduce-branch new-stack (car opening-token)
(append (cdr opening-token) top-value) options))))
-
- (setq token (parseclj-lex-next)))
-
- ;; reduce root
- (when fail-fast
- (when-let ((token (seq-find #'parseclj-lex-token? stack)))
- (parseclj--error "parseclj: Syntax Error at position %s, unmatched %S"
- (a-get token :pos)
- (parseclj-lex-token-type token))))
-
- (car (funcall reduce-branch nil (parseclj-lex-token :root "" 1)
- (reverse stack)
- options))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Top level API
(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.
+`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 false (`nil').
+ discards. Defaults to nil.
- `:fail-fast' Raise an error
- when encountering invalid syntax. Defaults to true (`t'). "
+ when encountering invalid syntax. Defaults to t."
(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? 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)))
- (parseclj-parse (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))))
+ (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.
@@ -329,15 +70,11 @@ key-value pairs to specify parsing options.
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? ast)
+ (if (parseclj-ast-leaf-node-p ast)
(insert (a-get ast :form))
- (cl-case (parseclj-ast-node-type ast)
- (:root (parseclj-unparse--collection ast "" ""))
- (:list (parseclj-unparse--collection ast "(" ")"))
- (:vector (parseclj-unparse--collection ast "[" "]"))
- (:set (parseclj-unparse--collection ast "#{" "}"))
- (:map (parseclj-unparse--collection ast "{" "}"))
- (:tag (parseclj-unparse--tag ast)))))
+ (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.
diff --git a/parseedn.el b/parseedn.el
index 9eaa9fd38e..b1ee4654f7 100644
--- a/parseedn.el
+++ b/parseedn.el
@@ -27,6 +27,17 @@
;;; Code:
+;; The EDN spec is not clear about wether \u0123 and \o012 are supported in
+;; strings. They are described as character literals, but not as string escape
+;; codes. In practice all implementations support them (mostly with broken
+;; surrogate pair support), so we do the same. Sorry, emoji 🙁.
+;;
+;; Note that this is kind of broken, we don't correctly detect if \u or \o
forms
+;; don't have the right forms.
+
+(require 'a)
+(require 'parseclj-parser)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Reader
@@ -36,17 +47,30 @@
'uuid (lambda (s)
(list 'edn-uuid s)))
"Default reader functions for handling tagged literals in EDN.
-These are the ones defined in the EDN spec, #inst and #uuid. It
+These are the ones defined in the EDN spec, #inst and #uuid. It
is not recommended you change this variable, as this globally
-changes the behavior of the EDN reader. Instead pass your own
+changes the behavior of the EDN reader. Instead pass your own
handlers as an optional argument to the reader functions.")
(defun parseedn-reduce-leaf (stack token options)
+ "Put in the STACK an elisp value representing TOKEN.
+
+OPTIONS is an association list. See `parseclj-parse' for more information
+on available options."
(if (member (parseclj-lex-token-type token) (list :whitespace :comment))
stack
- (cons (parseclj--leaf-token-value token) stack)))
+ (cons (parseclj-lex--leaf-token-value token) stack)))
(defun parseedn-reduce-branch (stack opening-token children options)
+ "Reduce STACK with an sequence containing a collection of other elisp values.
+Ignores discard tokens.
+
+OPENING-TOKEN is a lex token representing an opening paren, bracket or
+brace.
+CHILDREN is a collection elisp values to be reduced into an elisp
+sequence.
+OPTIONS is an association list. See `parseclj-parse' for more information
+on available options."
(let ((tag-readers (a-merge parseedn-default-tag-readers (a-get options
:tag-readers)))
(token-type (parseclj-lex-token-type opening-token)))
(if (eq token-type :discard)
@@ -71,21 +95,33 @@ handlers as an optional argument to the reader functions.")
stack))))
(defun parseedn-read (&optional tag-readers)
- (parseclj-parse #'parseedn-reduce-leaf
- #'parseedn-reduce-branch
- (a-list :tag-readers tag-readers)))
+ "Read content from current buffer and parse it as EDN source.
+Returns an Emacs Lisp value.
+
+TAG-READERS is an optional association list where keys are symbols
+identifying *tags*, and values are tag handler functions that receive one
+argument: *the tagged element*, and specify how to interpret it."
+ (parseclj-parser #'parseedn-reduce-leaf
+ #'parseedn-reduce-branch
+ (a-list :tag-readers tag-readers)))
(defun parseedn-read-str (s &optional tag-readers)
+ "Parse string S as EDN.
+Returns an Emacs Lisp value.
+
+TAG-READERS is an optional association list. For more information, see
+`parseedn-read'."
(with-temp-buffer
(insert s)
(goto-char 1)
(car (parseedn-read tag-readers))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Printer
-
(defun parseedn-print-seq (coll)
+ "Insert sequence COLL as EDN into the current buffer."
(parseedn-print (elt coll 0))
(let ((next (seq-drop coll 1)))
(when (not (seq-empty-p next))
@@ -93,6 +129,7 @@ handlers as an optional argument to the reader functions.")
(parseedn-print-seq next))))
(defun parseedn-print-kvs (map)
+ "Insert hash table MAP as an EDN map into the current buffer."
(let ((keys (a-keys map)))
(parseedn-print (car keys))
(insert " ")
@@ -103,6 +140,8 @@ handlers as an optional argument to the reader functions.")
(parseedn-print-kvs next)))))
(defun parseedn-print (datum)
+ "Insert DATUM as EDN into the current buffer.
+DATUM can be any Emacs Lisp value."
(cond
((or (null datum) (numberp datum))
(prin1 datum (current-buffer)))
@@ -138,6 +177,8 @@ handlers as an optional argument to the reader functions.")
(insert "{") (parseedn-print-kvs datum) (insert "}"))))
(defun parseedn-print-str (datum)
+ "Return a string containing DATUM as EDN.
+DATUM can be any Emacs Lisp value."
(with-temp-buffer
(parseedn-print datum)
(buffer-substring-no-properties (point-min) (point-max))))
diff --git a/test/parseclj-lex-test.el b/test/parseclj-lex-test.el
index 6e96522fbc..6589809c48 100644
--- a/test/parseclj-lex-test.el
+++ b/test/parseclj-lex-test.el
@@ -197,18 +197,18 @@
(should (equal (parseclj-lex-next) (parseclj-lex-token :number "14" 21)))
(should (equal (parseclj-lex-next) (parseclj-lex-token :rparen ")" 23)))))
-(ert-deftest parseclj-lex-test-at-number? ()
+(ert-deftest parseclj-lex-test-at-number-p ()
(dolist (str '("123" ".9" "+1" "0" "-456"))
(with-temp-buffer
(insert str)
(goto-char 1)
- (should (equal (parseclj-lex-at-number?) t))))
+ (should (equal (parseclj-lex-at-number-p) t))))
(dolist (str '("a123" "$.9" "+/1" "++0" "-"))
(with-temp-buffer
(insert str)
(goto-char 1)
- (should (equal (parseclj-lex-at-number?) nil)))))
+ (should (equal (parseclj-lex-at-number-p) nil)))))
(ert-deftest parseclj-lex-test-token ()
(should (equal (parseclj-lex-token :whitespace ",,," 10)
@@ -216,29 +216,29 @@
(:form . ",,,")
(:pos . 10)))))
-(ert-deftest parseclj-lex-test-digit? ()
- (should (equal (parseclj-lex-digit? ?0) t))
- (should (equal (parseclj-lex-digit? ?5) t))
- (should (equal (parseclj-lex-digit? ?9) t))
- (should (equal (parseclj-lex-digit? ?a) nil))
- (should (equal (parseclj-lex-digit? ?-) nil)))
-
-(ert-deftest parseclj-lex-test-symbol-start? ()
- (should (equal (parseclj-lex-symbol-start? ?0) nil))
- (should (equal (parseclj-lex-symbol-start? ?a) t))
- (should (equal (parseclj-lex-symbol-start? ?A) t))
- (should (equal (parseclj-lex-symbol-start? ?.) t))
- (should (equal (parseclj-lex-symbol-start? ?. t) nil))
- (should (equal (parseclj-lex-symbol-start? ?~) nil))
- (should (equal (parseclj-lex-symbol-start? ? ) nil)))
-
-(ert-deftest parseclj-lex-test-symbol-rest? ()
- (should (equal (parseclj-lex-symbol-rest? ?0) t))
- (should (equal (parseclj-lex-symbol-rest? ?a) t))
- (should (equal (parseclj-lex-symbol-rest? ?A) t))
- (should (equal (parseclj-lex-symbol-rest? ?.) t))
- (should (equal (parseclj-lex-symbol-rest? ?~) nil))
- (should (equal (parseclj-lex-symbol-rest? ? ) nil)))
+(ert-deftest parseclj-lex-test-digit-p ()
+ (should (equal (parseclj-lex-digit-p ?0) t))
+ (should (equal (parseclj-lex-digit-p ?5) t))
+ (should (equal (parseclj-lex-digit-p ?9) t))
+ (should (equal (parseclj-lex-digit-p ?a) nil))
+ (should (equal (parseclj-lex-digit-p ?-) nil)))
+
+(ert-deftest parseclj-lex-test-symbol-start-p ()
+ (should (equal (parseclj-lex-symbol-start-p ?0) nil))
+ (should (equal (parseclj-lex-symbol-start-p ?a) t))
+ (should (equal (parseclj-lex-symbol-start-p ?A) t))
+ (should (equal (parseclj-lex-symbol-start-p ?.) t))
+ (should (equal (parseclj-lex-symbol-start-p ?. t) nil))
+ (should (equal (parseclj-lex-symbol-start-p ?~) nil))
+ (should (equal (parseclj-lex-symbol-start-p ? ) nil)))
+
+(ert-deftest parseclj-lex-test-symbol-rest-p ()
+ (should (equal (parseclj-lex-symbol-rest-p ?0) t))
+ (should (equal (parseclj-lex-symbol-rest-p ?a) t))
+ (should (equal (parseclj-lex-symbol-rest-p ?A) t))
+ (should (equal (parseclj-lex-symbol-rest-p ?.) t))
+ (should (equal (parseclj-lex-symbol-rest-p ?~) nil))
+ (should (equal (parseclj-lex-symbol-rest-p ? ) nil)))
(ert-deftest parseclj-lex-test-get-symbol-at-point ()
(with-temp-buffer
diff --git a/test/parseclj-test-data.el b/test/parseclj-test-data.el
index 8ec8a000b6..28a03d91dc 100644
--- a/test/parseclj-test-data.el
+++ b/test/parseclj-test-data.el
@@ -28,271 +28,294 @@
;;; Code:
(setq parseclj-test-data
- (a-list
+ (a-list
- "simple-list"
- (a-list
- :tags '(:edn-roundtrip)
- :source "(1 2 3)"
- :edn '((1 2 3))
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :list)
- (:position . 1)
- (:children . (((:node-type . :number)
- (:position . 2)
- (:form . "1")
- (:value . 1))
- ((:node-type . :number)
- (:position . 4)
- (:form . "2")
- (:value . 2))
- ((:node-type . :number)
- (:position . 6)
- (:form . "3")
- (:value . 3)))))))))
+ "simple-list"
+ (a-list
+ :tags '(:edn-roundtrip)
+ :source "(1 2 3)"
+ :edn '((1 2 3))
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :number)
+ (:position . 2)
+ (:form . "1")
+ (:value . 1))
+ ((:node-type . :number)
+ (:position . 4)
+ (:form . "2")
+ (:value . 2))
+ ((:node-type . :number)
+ (:position . 6)
+ (:form . "3")
+ (:value . 3)))))))))
- "empty-list"
- (a-list
- :source "()"
- :edn '(())
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :list)
- (:position . 1)
- (:children . nil))))))
+ "empty-list"
+ (a-list
+ :source "()"
+ :edn '(())
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . nil))))))
- "size-1"
- (a-list
- :tags '(:edn-roundtrip)
- :source "(1)"
- :edn '((1))
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :list)
- (:position . 1)
- (:children . (((:node-type . :number)
- (:position . 2)
- (:form . "1")
- (:value . 1)))))))))
+ "size-1"
+ (a-list
+ :tags '(:edn-roundtrip)
+ :source "(1)"
+ :edn '((1))
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :number)
+ (:position . 2)
+ (:form . "1")
+ (:value . 1)))))))))
- "leafs"
- (a-list
- :source "(nil true false hello-world)"
- :edn '((nil t nil hello-world))
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :list)
- (:position . 1)
- (:children . (((:node-type . :nil)
- (:position . 2)
- (:form . "nil")
- (:value . nil))
- ((:node-type . :true)
- (:position . 6)
- (:form . "true")
- (:value . t))
- ((:node-type . :false)
- (:position . 11)
- (:form . "false")
- (:value . nil))
- ((:node-type . :symbol)
- (:position . 17)
- (:form . "hello-world")
- (:value . hello-world)))))))))
+ "leafs"
+ (a-list
+ :source "(nil true false hello-world)"
+ :edn '((nil t nil hello-world))
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :nil)
+ (:position . 2)
+ (:form . "nil")
+ (:value . nil))
+ ((:node-type . :true)
+ (:position . 6)
+ (:form . "true")
+ (:value . t))
+ ((:node-type . :false)
+ (:position . 11)
+ (:form . "false")
+ (:value . nil))
+ ((:node-type . :symbol)
+ (:position . 17)
+ (:form . "hello-world")
+ (:value . hello-world)))))))))
- "qualified-symbol"
- (a-list
- :tags '(:edn-roundtrip)
- :source "clojure.string/join"
- :edn '(clojure.string/join)
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :symbol)
- (:position . 1)
- (:form . "clojure.string/join")
- (:value . clojure.string/join))))))
+ "qualified-symbol"
+ (a-list
+ :tags '(:edn-roundtrip)
+ :source "clojure.string/join"
+ :edn '(clojure.string/join)
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :symbol)
+ (:position . 1)
+ (:form . "clojure.string/join")
+ (:value . clojure.string/join))))))
- "nested-lists"
- (a-list
- :source "((.9 abc (true) (hello)))"
- :edn '(((0.9 abc (t) (hello))))
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :list)
- (:position . 1)
- (:children . (((:node-type . :list)
- (:position . 2)
- (:children ((:node-type . :number)
- (:position . 3)
- (:form . ".9")
- (:value . 0.9))
- ((:node-type . :symbol)
- (:position . 6)
- (:form . "abc")
- (:value . abc))
- ((:node-type . :list)
- (:position . 10)
- (:children ((:node-type .
:true)
- (:position .
11)
- (:form .
"true")
- (:value .
t))))
- ((:node-type . :list)
- (:position . 17)
- (:children ((:node-type .
:symbol)
- (:position .
18)
- (:form .
"hello")
- (:value .
hello)))))))))))))
+ "nested-lists"
+ (a-list
+ :source "((.9 abc (true) (hello)))"
+ :edn '(((0.9 abc (t) (hello))))
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 2)
+ (:children ((:node-type . :number)
+ (:position . 3)
+ (:form . ".9")
+ (:value . 0.9))
+ ((:node-type . :symbol)
+ (:position . 6)
+ (:form . "abc")
+ (:value . abc))
+ ((:node-type . :list)
+ (:position . 10)
+ (:children
((:node-type . :true)
+
(:position . 11)
+ (:form .
"true")
+ (:value .
t))))
+ ((:node-type . :list)
+ (:position . 17)
+ (:children
((:node-type . :symbol)
+
(:position . 18)
+ (:form .
"hello")
+ (:value .
hello)))))))))))))
- "strings-1"
- (a-list
- :tags '(:edn-roundtrip)
- :source "\"abc hello \\t\\\"x\""
- :edn '("abc hello \t\"x")
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :string)
- (:position . 1)
- (:form . "\"abc hello \\t\\\"x\"")
- (:value . "abc hello \t\"x"))))))
+ "strings-1"
+ (a-list
+ :tags '(:edn-roundtrip)
+ :source "\"abc hello \\t\\\"x\""
+ :edn '("abc hello \t\"x")
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :string)
+ (:position . 1)
+ (:form . "\"abc hello \\t\\\"x\"")
+ (:value . "abc hello \t\"x"))))))
- "strings-2"
- (a-list
- :source "(\"---\\f---\\\"-'\\'-\\\\-\\r\\n\")"
- :edn '(("---\f---\"-''-\\-\r\n"))
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :list)
- (:position . 1)
- (:children . (((:node-type . :string)
- (:position . 2)
- (:form .
"\"---\\f---\\\"-'\\'-\\\\-\\r\\n\"")
- (:value .
"---\f---\"-''-\\-\r\n")))))))))
+ "strings-2"
+ (a-list
+ :source "(\"---\\f---\\\"-'\\'-\\\\-\\r\\n\")"
+ :edn '(("---\f---\"-''-\\-\r\n"))
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :string)
+ (:position . 2)
+ (:form .
"\"---\\f---\\\"-'\\'-\\\\-\\r\\n\"")
+ (:value .
"---\f---\"-''-\\-\r\n")))))))))
- "chars-1"
- (a-list
- :source "(\\newline \\return \\space \\tab \\a \\b \\c \\u0078 \\o171)"
- :edn '((?\n ?\r ?\ ?\t ?a ?b ?c ?x ?y))
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :list)
- (:position . 1)
- (:children . (((:node-type . :character) (:position
. 2) (:form . "\\newline") (:value . ?\n))
- ((:node-type . :character) (:position
. 11) (:form . "\\return") (:value . ?\r))
- ((:node-type . :character) (:position
. 19) (:form . "\\space") (:value . 32))
- ((:node-type . :character) (:position
. 26) (:form . "\\tab") (:value . ?\t))
- ((:node-type . :character) (:position
. 31) (:form . "\\a") (:value . ?a))
- ((:node-type . :character) (:position
. 34) (:form . "\\b") (:value . ?b))
- ((:node-type . :character) (:position
. 37) (:form . "\\c") (:value . ?c))
- ((:node-type . :character) (:position
. 40) (:form . "\\u0078") (:value . ?x))
- ((:node-type . :character) (:position
. 47) (:form . "\\o171") (:value . ?y)))))))))
+ "chars-1"
+ (a-list
+ :source "(\\newline \\return \\space \\tab \\a \\b \\c \\u0078 \\o171)"
+ :edn '((?\n ?\r ?\ ?\t ?a ?b ?c ?x ?y))
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :character)
(:position . 2) (:form . "\\newline") (:value . ?\n))
+ ((:node-type . :character)
(:position . 11) (:form . "\\return") (:value . ?\r))
+ ((:node-type . :character)
(:position . 19) (:form . "\\space") (:value . 32))
+ ((:node-type . :character)
(:position . 26) (:form . "\\tab") (:value . ?\t))
+ ((:node-type . :character)
(:position . 31) (:form . "\\a") (:value . ?a))
+ ((:node-type . :character)
(:position . 34) (:form . "\\b") (:value . ?b))
+ ((:node-type . :character)
(:position . 37) (:form . "\\c") (:value . ?c))
+ ((:node-type . :character)
(:position . 40) (:form . "\\u0078") (:value . ?x))
+ ((:node-type . :character)
(:position . 47) (:form . "\\o171") (:value . ?y)))))))))
- "chars-2"
- (a-list
- :source "\"\\u0078 \\o171\""
- :edn '("x y")
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :string)
- (:position . 1)
- (:form . "\"\\u0078 \\o171\"")
- (:value . "x y"))))))
+ "chars-2"
+ (a-list
+ :source "\"\\u0078 \\o171\""
+ :edn '("x y")
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :string)
+ (:position . 1)
+ (:form . "\"\\u0078 \\o171\"")
+ (:value . "x y"))))))
- "keywords"
- (a-list
- :tags '(:edn-roundtrip)
- :source ":foo-bar"
- :edn '(:foo-bar)
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :keyword)
- (:position . 1)
- (:form . ":foo-bar")
- (:value . :foo-bar))))))
+ "keywords"
+ (a-list
+ :tags '(:edn-roundtrip)
+ :source ":foo-bar"
+ :edn '(:foo-bar)
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :keyword)
+ (:position . 1)
+ (:form . ":foo-bar")
+ (:value . :foo-bar))))))
- "vector"
- (a-list
- :tags '(:edn-roundtrip)
- :source "[123]"
- :edn '([123])
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :vector)
- (:position . 1)
- (:children . (((:node-type . :number)
- (:position . 2)
- (:form . "123")
- (:value . 123)))))))))
+ "vector"
+ (a-list
+ :tags '(:edn-roundtrip)
+ :source "[123]"
+ :edn '([123])
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :vector)
+ (:position . 1)
+ (:children . (((:node-type . :number)
+ (:position . 2)
+ (:form . "123")
+ (:value . 123)))))))))
- "map"
- (a-list
- :tags '(:edn-roundtrip)
- :source "{:count 123}"
- :edn (list (a-hash-table :count 123))
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :map)
- (:position . 1)
- (:children . (((:node-type . :keyword)
- (:position . 2)
- (:form . ":count")
- (:value . :count))
- ((:node-type . :number)
- (:position . 9)
- (:form . "123")
- (:value . 123)))))))))
+ "map"
+ (a-list
+ :tags '(:edn-roundtrip)
+ :source "{:count 123}"
+ :edn (list (a-hash-table :count 123))
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :map)
+ (:position . 1)
+ (:children . (((:node-type . :keyword)
+ (:position . 2)
+ (:form . ":count")
+ (:value . :count))
+ ((:node-type . :number)
+ (:position . 9)
+ (:form . "123")
+ (:value . 123)))))))))
- "set"
- (a-list
- :tags '(:edn-roundtrip)
- :source "#{:x}"
- :edn '((edn-set (:x)))
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :set)
- (:position . 1)
- (:children . (((:node-type . :keyword)
- (:position . 3)
- (:form . ":x")
- (:value . :x)))))))))
+ "set"
+ (a-list
+ :tags '(:edn-roundtrip)
+ :source "#{:x}"
+ :edn '((edn-set (:x)))
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :set)
+ (:position . 1)
+ (:children . (((:node-type . :keyword)
+ (:position . 3)
+ (:form . ":x")
+ (:value . :x)))))))))
- "discard"
- (a-list
- :source "(10 #_11 12 #_#_ 13 14)"
- :edn '((10 12))
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :list)
- (:position . 1)
- (:children . (((:node-type . :number)
- (:position . 2)
- (:form . "10")
- (:value . 10))
- ((:node-type . :number)
- (:position . 10)
- (:form . "12")
- (:value . 12)))))))))
+ "discard"
+ (a-list
+ :source "(10 #_11 12 #_#_ 13 14)"
+ :edn '((10 12))
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :number)
+ (:position . 2)
+ (:form . "10")
+ (:value . 10))
+ ((:node-type . :number)
+ (:position . 10)
+ (:form . "12")
+ (:value . 12)))))))))
- "tag"
- (a-list
- :source "#foo/bar [1]"
- :ast '((:node-type . :root)
- (:position . 1)
- (:children . (((:node-type . :tag)
- (:position . 1)
- (:tag . foo/bar)
- (:children . (((:node-type . :vector)
- (:position . 10)
- (:children . (((:node-type . :number)
- (:position . 11)
- (:form . "1")
- (:value . 1))))))))))))
+ "tag"
+ (a-list
+ :source "#foo/bar [1]"
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :tag)
+ (:position . 1)
+ (:tag . foo/bar)
+ (:children . (((:node-type . :vector)
+ (:position . 10)
+ (:children . (((:node-type .
:number)
+ (:position . 11)
+ (:form . "1")
+ (:value .
1))))))))))))
- "booleans"
- (a-list
- :source "[nil true false]"
- :edn '([nil t nil]))))
+ "nested-tag"
+ (a-list
+ :source "(fn #param :param-name 1)"
+ :ast '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :symbol)
+ (:position . 2)
+ (:form . "fn")
+ (:value . fn))
+ ((:node-type . :tag)
+ (:position . 5)
+ (:tag . param)
+ (:children . (((:node-type .
:keyword)
+ (:position . 12)
+ (:form .
":param-name")
+ (:value .
:param-name)))))
+ ((:node-type . :number)
+ (:position . 24)
+ (:form . "1")
+ (:value . 1)))))))))
+
+ "booleans"
+ (a-list
+ :source "[nil true false]"
+ :edn '([nil t nil]))))
;;; parseclj-test-data.el ends here
diff --git a/test/parseclj-test.el b/test/parseclj-test.el
index 1809464141..1f77eb74b8 100644
--- a/test/parseclj-test.el
+++ b/test/parseclj-test.el
@@ -68,58 +68,34 @@
(should (equal
(condition-case errdata
(parseclj-parse-clojure "foo]")
- (parseclj-parse-error (cadr errdata)))
- "parseclj: Syntax Error at position 4, unmatched :rbracket"))
+ (parseclj-parser-error (cadr errdata)))
+ "At position 4, unmatched :rbracket"))
(should (equal
(condition-case errdata
(parseclj-parse-clojure "[foo")
- (parseclj-parse-error (cadr errdata)))
- "parseclj: Syntax Error at position 1, unmatched :lbracket"))
+ (parseclj-parser-error (cadr errdata)))
+ "At position 1, unmatched :lbracket"))
(should (equal
(condition-case errdata
(parseclj-parse-clojure "(1 2 [ 4)")
- (parseclj-parse-error (cadr errdata)))
- "parseclj: Syntax Error at position 6, unmatched :lbracket"))
+ (parseclj-parser-error (cadr errdata)))
+ "At position 6, unmatched :lbracket"))
(should (equal
(condition-case errdata
(parseclj-parse-clojure "1 2 #_")
- (parseclj-parse-error (cadr errdata)))
- "parseclj: Syntax Error at position 5, unmatched :discard"))
+ (parseclj-parser-error (cadr errdata)))
+ "At position 5, unmatched :discard"))
(should (equal
(condition-case errdata
(parseclj-parse-clojure "(1 [2 {3 ( 4}])")
- (parseclj-parse-error (cadr errdata)))
- "parseclj: Syntax Error at position 10, unmatched :lparen")))
-
-(ert-deftest parseclj-parse-clojure-fail-fast-test ()
- (should (equal
- (condition-case errdata
- (parseclj-parse-clojure "foo]")
- (parseclj-parse-error (cadr errdata)))
- "parseclj: Syntax Error at position 4, unmatched :rbracket"))
-
- (should (equal
- (condition-case errdata
- (parseclj-parse-clojure "[foo")
- (parseclj-parse-error (cadr errdata)))
- "parseclj: Syntax Error at position 1, unmatched :lbracket"))
-
- (should (equal
- (condition-case errdata
- (parseclj-parse-clojure "(1 2 [ 4)")
- (parseclj-parse-error (cadr errdata)))
- "parseclj: Syntax Error at position 6, unmatched :lbracket"))
-
- (should (equal
- (condition-case errdata
- (parseclj-parse-clojure "1 2 #_")
- (parseclj-parse-error (cadr errdata)))
- "parseclj: Syntax Error at position 5, unmatched :discard"))
+ (parseclj-parser-error (cadr errdata)))
+ "At position 10, unmatched :lparen")))
+(ert-deftest parseclj-parse-clojure-not-fail-fast-test ()
(should (equal (parseclj-parse-clojure "(1 [2 {3 ( 4}])" :fail-fast nil)
'((:node-type . :root)
(:position . 1)
@@ -217,7 +193,7 @@
(parseclj-lex-token :discard "#_" 30)
(parseclj-ast-node :comment 20))
(lambda (e)
- (and (parseclj-ast-node? e)
+ (and (parseclj-ast-node-p e)
(not (member (parseclj-ast-node-type e) '(:whitespace
:comment :discard)))))
'(:discard))
'(((:token-type . :discard) (:form . "#_") (:pos . 30))
@@ -231,7 +207,7 @@
(parseclj-lex-token :discard "#_" 30)
(parseclj-ast-node :comment 20))
(lambda (e)
- (and (parseclj-ast-node? e)
+ (and (parseclj-ast-node-p e)
(not (member (parseclj-ast-node-type e) '(:whitespace
:comment :discard)))))
'(:discard))
nil)))
@@ -240,7 +216,7 @@
(let ((stack '(((:node-type . :number) (:position . 3) (:form . "4") (:value
. 4))
((:token-type . :discard) (:form . "#_") (:pos . 1))))
(value-p (lambda (e)
- (and (parseclj-ast-node? e)
+ (and (parseclj-ast-node-p e)
(not (member (parseclj-ast-node-type e) '(:whitespace
:comment :discard)))))))
(should (equal (parseclj--take-value stack value-p)
'(((:node-type . :number) (:position . 3) (:form . "4")
(:value . 4)))))
@@ -256,7 +232,7 @@
(let ((stack '(((:node-type . :whitespace) (:position . 3) (:form . " "))
((:token-type . :discard) (:form . "#_") (:pos . 1))))
(value-p (lambda (e)
- (and (parseclj-ast-node? e)
+ (and (parseclj-ast-node-p e)
(not (member (parseclj-ast-node-type e) '(:whitespace
:comment :discard)))))))
(let* ((top-value (parseclj--take-value stack value-p))
- [nongnu] elpa/parseclj 2a42dcb6fa 066/185: Update License info in README, (continued)
- [nongnu] elpa/parseclj 2a42dcb6fa 066/185: Update License info in README, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj ba9f4d723f 076/185: Document proposal for alternative package organization, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj a8e1de0d62 075/185: Merge pull request #4 from lambdaisland/edn-ast-split, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 6fdf22a553 062/185: Update license, fix dependencies, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 5fbe901cba 071/185: Parse/unparse :tag, rountrip AST, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 6e0dc9516c 093/185: Add missing require, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj b79b3a5438 098/185: Add documentation to `parseclj-ast.el`, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 1b071d7775 104/185: Add documentation to `parseedn` module, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj e1cb9e5514 113/185: Add a few more node accessors., ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 80e92cdf9f 001/185: Move into its own repo, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 2588470302 116/185: Merge pull request #9 from lambdaisland/docstrings-and-conventions,
ELPA Syncer <=
- [nongnu] elpa/parseclj 92396d11cf 127/185: Merge pull request #17 from lambdaisland/travis-evm, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj f87278a70e 135/185: Merge pull request #18 from clojure-emacs/doc-&-style-fixes-part-2, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj eedc0d812e 168/185: Update docstring and metion Emacs 27 alternative, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 815ba87a77 137/185: Merge pull request #19 from clojure-emacs/update-readme, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 9e0b51e39c 160/185: revert tabs to spaces, address minor review comments, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj bdd6489128 003/185: add travis badge, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj f6b8ad665c 004/185: Fix .travis.yml, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 3ec632ed66 008/185: Travis show Emacs version, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 7cf7dc99cd 011/185: Travis: only install the necessary ppa/package for each matrix line, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 710511ff79 013/185: Seems these packages dont actually package the versioned executable names, ELPA Syncer, 2021/12/28