[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/parseclj 168027fed5 094/185: Merge pull request #7 from la
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/parseclj 168027fed5 094/185: Merge pull request #7 from lambdaisland/reorganize-package |
|
Date: |
Tue, 28 Dec 2021 14:05:22 -0500 (EST) |
branch: elpa/parseclj
commit 168027fed5d4678b715e0968cabdf494e25b0eca
Merge: a8e1de0d62 6e0dc9516c
Author: Daniel Barreto <daniel.barreto.n@gmail.com>
Commit: GitHub <noreply@github.com>
Merge pull request #7 from lambdaisland/reorganize-package
Add a new proposal for how to organize things
---
Cask | 8 +-
DESIGN.md | 231 ++++++++++++--
README.md | 2 +-
benchmark/speed-comparison.el | 2 +-
clj-ast.el | 116 -------
clj-lex.el | 303 ------------------
clj-parse.el | 168 ----------
parseclj-ast.el | 111 +++++++
parseclj-lex.el | 319 +++++++++++++++++++
test/clj-parse-test.el => parseclj-unparse.el | 37 ++-
parseclj.el | 354 +++++++++++++++++++++
clj-edn.el => parseedn.el | 104 +++---
test/clj-ast-unparse-test.el | 166 ----------
test/clj-edn-el-parity-test.el | 286 -----------------
test/clj-lex-test.el | 295 -----------------
test/{clj-ast-test.el => parseclj-ast-test.el} | 32 +-
test/parseclj-lex-test.el | 298 +++++++++++++++++
...lj-parse-test-data.el => parseclj-test-data.el} | 38 +--
test/parseclj-test.el | 269 ++++++++++++++++
test/parseclj-unparse-test.el | 184 +++++++++++
test/parseedn-el-parity-test.el | 286 +++++++++++++++++
test/{clj-edn-test.el => parseedn-test.el} | 48 +--
22 files changed, 2166 insertions(+), 1491 deletions(-)
diff --git a/Cask b/Cask
index 528cd303fd..3238d1f31b 100644
--- a/Cask
+++ b/Cask
@@ -2,11 +2,11 @@
(source melpa)
(source lambdaisland "https://lambdaisland.github.io/elpa/";)
-(package-file "clj-parse.el")
+(package-file "parseclj.el")
-(files "clj-lex.el"
- "clj-edn.el"
- "clj-ast.el")
+(files "parseclj-lex.el"
+ "parseedn.el"
+ "parseclj-ast.el")
(development
(depends-on "a")
diff --git a/DESIGN.md b/DESIGN.md
index 716c998624..8e5b88acef 100644
--- a/DESIGN.md
+++ b/DESIGN.md
@@ -1,10 +1,10 @@
-# clj-parse Design Goals / Roadmap
+# parseclj Design Goals / Roadmap
-clj-parse is an Emacs Lisp library for parsing Clojure code and EDN data. It
+parseclj is an Emacs Lisp library for parsing Clojure code and EDN data. It
supports several input and output formats, all powered by the same shift-reduce
parser function.
-This documents describes the design goals for clj-parse, and as such may
describe features which are not implemented yet.
+This documents describes the design goals for parseclj, and as such may
describe features which are not implemented yet.
## Motivation
@@ -45,11 +45,11 @@ The implementation is implemented in three parts: a lexer,
a parser, and multipl
The *lexer* turns the input text, a buffer, into tokens, data structures
representing a single syntactical unit, such as a symbol, a number, or a
delimiter like "(", ")", "#{", or "#_".
-In clj-parse the lexer is a single function `clj-lex-next` which can be called
repeatedly to get a sequence of tokens. `clj-lex-next` returns the token at
"point" (i.e. the Emacs cursor position), and moves point to after the token.
+In parseclj the lexer is a single function `parseclj-lex-next` which can be
called repeatedly to get a sequence of tokens. `parseclj-lex-next` returns the
token at "point" (i.e. the Emacs cursor position), and moves point to after the
token.
A *token* is a association list (list of cons cells), with keys `:token-type`,
`:form`, `:position`, and optionally `:error-type`.
-Note: we don't add line/column numbers to the token, the consumer can add
these if needed based on the position of point before calling `clj-lex-next`.
+Note: we don't add line/column numbers to the token, the consumer can add
these if needed based on the position of point before calling
`parseclj-lex-next`.
Example:
@@ -121,23 +121,23 @@ Tokens can be recognized by the `:token-type` key, which
must always come first
## Shift-reduce parser
-The parser is again a single function `clj-parse-reduce`. It is a higher order
function, with much of the final result determined by the `reduce-leaf` and
`reduce-node` functions passed in as arguments.
+The parser is again a single function `parseclj-parse`. It is a higher order
function, with much of the final result determined by the `reduce-leaf` and
`reduce-branch` functions passed in as arguments.
-`clj-parse-reduce` internally operates by using a stack. This stack contains
tokens (as returned by `clj-lex-next`), and reduced values.
+`parseclj-parse` internally operates by using a stack. This stack contains
tokens (as returned by `parseclj-lex-next`), and reduced values.
`reduce-leaf` is a two-argument function. It takes the current value of the
stack, and a token, and returns an updated stack, typically by parsing the
token to a value and pushing that value onto the stack.
-`reduce-node` is a three-argument function. It takes the current value of the
stack, a node type, and a list of children, and returns an updated stack.
+`reduce-branch` is a three-argument function. It takes the current value of
the stack, a node type, and a list of children, and returns an updated stack.
The parser reads consecutive input tokens. If the token represents a leaf node
(like a number, symbol, string), then it calls `reduce-leaf`, giving it a
chance to add a value to the stack. If the token is a non-leaf node (a
delimiter) it gets put on the stack as-is. This part is known as the "shift"
phase.
After "shifting" a value on to the stack, the parser tries to "reduce", by
inspecting the top one, two, or three items on the stack.
-If the top item is a closing delimiter token, then the parser scans down the
stack until it finds a matching opening delimiter. It pops both delimiters and
everything in between them off the stack, and passes them to `reduce-node`,
which can "reduce" this sequence to a single value (say, a list), and push that
item onto the stack.
+If the top item is a closing delimiter token, then the parser scans down the
stack until it finds a matching opening delimiter. It pops both delimiters and
everything in between them off the stack, and passes them to `reduce-branch`,
which can "reduce" this sequence to a single value (say, a list), and push that
item onto the stack.
The type of values pushed onto the stack depends on the reducing functions
used. The parser only distinguishes between tokens and non-tokens. It follows
that a reducing functions should not push raw tokens back onto the stack.
-When parsing finishes the stack will contain all parsed forms in reverse
order. It will call `reduce-node` once more with a node type of `:root`, to
give it a chance to finalize.
+When parsing finishes the stack will contain all parsed forms in reverse
order. It will call `reduce-branch` once more with a node type of `:root`, to
give it a chance to finalize.
### Example
@@ -157,7 +157,7 @@ An example, when parsing the following EDN, with parsing
done up to the position
((:token-type . :lparen) (:form . "(") (:pos . 1)))
```
-Now the parser encounters the first closing parenthesis. It pops `3` and
`:lparen` off the stack, and passes `(((:token-type . :lparen) 3 ((:token-type
. :rparen)))` to `reduce-node`, which reduces this a single list, and pushes it
onto the stack.
+Now the parser encounters the first closing parenthesis. It pops `3` and
`:lparen` off the stack, and passes `(((:token-type . :lparen) 3 ((:token-type
. :rparen)))` to `reduce-branch`, which reduces this a single list, and pushes
it onto the stack.
``` clojure
;; input
@@ -172,7 +172,7 @@ Now the parser encounters the first closing parenthesis. It
pops `3` and `:lpare
((:token-type . :lparen) (:form . "(") (:pos . 1)))
```
-Now the parser encounters the second closing parenthesis. It pops everything
until `:lparen` off the stack, and passes it to `reduce-node`, which turns the
result into a list and pushes it onto the stack.
+Now the parser encounters the second closing parenthesis. It pops everything
until `:lparen` off the stack, and passes it to `reduce-branch`, which turns
the result into a list and pushes it onto the stack.
``` clojure
;; input
@@ -186,7 +186,7 @@ Now the parser encounters the second closing parenthesis.
It pops everything unt
### Dealing with parse errors
-`clj-parse-reduce` needs to be able to parse invalid input. Imagine analyzing
a user's buffer while they are editing, to provide contextual help or do
linting. Even when delimiters are unbalanced it should still be possible to get
a "best effort" parse result. It turns out the shift-reduce approach provides
that out of the box. The result of parsing invalid input is a stack which still
has unreduced tokens in it.
+`parseclj-parse` needs to be able to parse invalid input. Imagine analyzing a
user's buffer while they are editing, to provide contextual help or do linting.
Even when delimiters are unbalanced it should still be possible to get a "best
effort" parse result. It turns out the shift-reduce approach provides that out
of the box. The result of parsing invalid input is a stack which still has
unreduced tokens in it.
Unmatched opening delimiter:
@@ -212,7 +212,7 @@ Unmatched closing delimiter:
((1 2 3) ((:token-type . :lparen)))
```
-In many cases it will be desirable to "fail fast", and raise an error as soon
as a syntax error is encountered. A `reduce-node` function can do so if it
wishes by checking its input sequence for raw tokens, and raising an error if
any are present.
+In many cases it will be desirable to "fail fast", and raise an error as soon
as a syntax error is encountered. A `reduce-branch` function can do so if it
wishes by checking its input sequence for raw tokens, and raising an error if
any are present.
## EDN vs Clojure
@@ -248,7 +248,7 @@ These are the choices that the edn.el library has made:
### Differences with EDN.el
-At the moment the `clj-parse-edn-*` copy the parsing behavior of edn.el,
*except* that the character literals `\newline`, `\return`, `\space`, and
`\tab` are parsed to their character code (10, 13, 32, and 9 respectively),
instead of to symbols.
+At the moment the `parseedn-*` copy the parsing behavior of edn.el, *except*
that the character literals `\newline`, `\return`, `\space`, and `\tab` are
parsed to their character code (10, 13, 32, and 9 respectively), instead of to
symbols.
## AST
@@ -274,7 +274,7 @@ Non-leaf nodes contain a list of `:children`.
## Public API
-clj-parse provides three "parse modes"
+parseclj provides three "parse modes"
- `edn` meant for parsing data, it parses EDN to emacs lisp data
- `ast` meant for analyzing source code, parses to a "semantic" AST, does not
preserve whitespace or comments
@@ -282,30 +282,30 @@ clj-parse provides three "parse modes"
For each of these there can be the following functions
-- `clj-parse-{mode}` parse the current buffer starting at `point`, raise an
error when syntax/lexing errors are encountered
-- `clj-parse-{mode}-full` same as above but ignore syntax errors, returning a
partially parsed result
+- `parseclj-{mode}` parse the current buffer starting at `point`, raise an
error when syntax/lexing errors are encountered
+- `parseclj-{mode}-full` same as above but ignore syntax errors, returning a
partially parsed result
- `clj-print-{mode}` turn the result of the corresponding parse function back
into Clojure/EDN, and insert it into the current buffer
Each of these have `-str` variant which instead works on strings. This yields
a total potential API of:
```
-(defun clj-parse-edn (&OPTIONAL tag-handler))
-(defun clj-parse-edn-full (&OPTIONAL tag-handler))
+(defun parseedn (&OPTIONAL tag-handler))
+(defun parseedn-full (&OPTIONAL tag-handler))
(defun clj-print-edn (edn))
-(defun clj-parse-edn-str (string &OPTIONAL tag-handler))
-(defun clj-parse-edn-full-str (string &OPTIONAL tag-handler))
+(defun parseedn-str (string &OPTIONAL tag-handler))
+(defun parseedn-full-str (string &OPTIONAL tag-handler))
(defun clj-print-edn-str (edn))
-(defun clj-parse-ast ())
-(defun clj-parse-ast-full ())
+(defun parseclj-ast ())
+(defun parseclj-ast-full ())
(defun clj-print-ast (node))
-(defun clj-parse-ast-str ())
-(defun clj-parse-ast-full-str ())
+(defun parseclj-ast-str ())
+(defun parseclj-ast-full-str ())
(defun clj-print-ast-str (node))
-(defun clj-parse-source ())
-(defun clj-parse-source-full ())
+(defun parseclj-source ())
+(defun parseclj-source-full ())
(defun clj-print-source (node))
-(defun clj-parse-source-str ())
-(defun clj-parse-source-full-str ())
+(defun parseclj-source-str ())
+(defun parseclj-source-full-str ())
(defun clj-print-source-str (node))
```
@@ -317,3 +317,174 @@ Beyond that we provide two sets of functions for working
with AST nodes.
- functions for reading values out of ASTs, effectively treating them as the
data structure they represent.
This second set of functions is important for applications that need to deal
with EDN data, but for which the lossy nature of EDN->Elisp transformation is
not an option. For instance, unrepl sends EDN messages, but these messages
contain code forms that we need to be able to reproduce. In this case
converting `false` to `nil` or a set to a list is not acceptable. Instead we
can parse the EDN to an AST, and deal with the AST directly.
+
+## Alternative package layout
+
+**Package**: parseclj
+
+Contains the core parser backend, and the Clojure-to-AST parser
+
+- file: parseclj.el
+
+``` emacs-lisp
+(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 false (`nil').
+- `:fail-fast' Raise an error
+ when encountering invalid syntax. Defaults to true (`t'). ")
+
+(defun parseclj-unparse-clojure (ast &rest options)
+ "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.
+
+OPTIONS is a list of key value pairs containing options.
+
+- `:lexical-preservation' If `t', assume the AST contains
+ whitespace. If `nil', insert whitespace between forms. When
+ parsing with `:lexical-preservation', you should unparse the
+ same way. ")
+
+(defun parseclj-unparse-clojure-to-string (ast &rest options)
+ "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
+
+OPTIONS is a list of key value pairs containing options.
+
+- `:lexical-preservation' If `t', assume the AST contains
+ whitespace. If `nil', insert whitespace between forms. When
+ parsing with `:lexical-preservation', you should unparse the
+ same way.")
+```
+
+- file: parseclj-lex.el
+
+``` emacs-lisp
+(defun parseclj-lex-next ()
+ "Move past the token at point, and return the token")
+```
+
+- file: parseclj-ast.el
+
+``` emacs-lisp
+(defun parseclj-ast--reduce-leaf (stack token)
+ "Create a leaf AST node and put it onto the stack.
+
+Given the current parser STACK and a TOKEN coming from the lexer,
+create an AST leaf node and return an updated stack.
+
+Whitespace and comment tokens are ignored (i.e. the stack is
+returned unchanged).
+
+This function is only called for tokens that correspond with AST
+leaf nodes.")
+
+(defun parseclj-ast--reduce-leaf-with-lexical-preservation (stack token)
+ "Create a leaf AST node and put it onto the stack.
+
+Given the current parser STACK and a TOKEN coming from the lexer,
+create an AST leaf node and return an updated stack.
+
+This functions creates nodes for whitespace and comment tokens,
+for other tokens it delegates to `parseclj-ast--reduce-leaf'.")
+
+(defun parseclj-ast--reduce-branch (stack type children)
+ "Create a branch AST node and put it onto the stack.
+
+This function is passed the current parser STACK the node TYPE to
+be created, and a list of AST nodes that will become the CHILDREN
+of the newly created node.
+
+This implementation ignores `:discard' nodes (#_), when called
+with a TYPE of `:discard' it returns the stack unchanged.")
+
+(defun parseclj-ast--reduce-branch-with-lexical-preservation (stack type
children)
+ "Create a branch AST node and put it onto the stack.
+
+This function is passed the current parser STACK the node TYPE to
+be created, and a list of AST nodes that will become the CHILDREN
+of the newly created node.
+
+This implementation handles `:discard' nodes (#_), for other node
+types it delegates to `parseclj-ast--reduce-branch'.")
+
+(defun parseclj-ast-value (node)
+ "Given an AST NODE, returns its value.
+
+Recursively convert the AST node into an Emacs Lisp value. E.g.
+turn a `:list' node into a sexp, a `:number' node into a number.
+
+This operation is lossy because not all Clojure types have a
+corresponding type in Emacs. `nil' and `false' form a
+particularly poignant case, both are converted to `nil'.")
+```
+
+**Package**: parseedn
+
+- file: parseedn.el
+
+``` emacs-lisp
+(defun parseedn-read (&rest string-and-options)
+ "Reads an EDN form and converts it an Emacs Lisp value.
+
+Reads either from the current buffer, starting from point, or
+reads from the optional string argument. Only reads the first
+complete form. When used on a buffer, this moves `(point)' to
+after the form.
+
+By default uses an output format that uses tagged lists to
+preserve type information. This makes the conversion lossless,
+but still easy to process.
+
+ \"#{1 2 3}\" => (set (1 2 3))
+ \"false\" => (false)
+ \"t\" => t
+ \"true\" => (true)
+ \"(1 2 3)\" => (list (1 2 3))
+ \"#uuid \\\"255efd69-dec9-4428-9142-cebd5357fb2a\\\"\"
+ => (uuid \"255efd69-dec9-4428-9142-cebd5357fb2a\")
+
+Alternatively a compatibility mode is available which mimics
+exactly the behavior of `edn-read' as implemented in `edn.el'.
+
+STRING-AND-OPTIONS can be an optional string, followed by
+key-value pairs to specify parsing options.
+
+- `:compat' Mimic edn.el. Defaults to false (`nil').
+- `:tag-readers' An association list mapping symbols to
+ functions, used to parse tagged literals. The function is given
+ the parsed value and given an opportunity to transform it.
+ Defaults for `uuid' and `inst' are provided but can be
+ overridden.
+- `:fail-fast' Raise an error when encountering invalid syntax.
+ Defaults to true (`t'). ")
+
+(defun parseclj-print (value &rest options)
+ "Convert an Emacs Lisp value to EDN.
+
+OPTIONS is a list of key value pairs containing options.
+
+By default assumes that any list is of the form `(type value)'.
+Extra `:tag-writers' can be specified to handle unknown types.
+Alternatively a compatibility mode is available which emulates
+the behavior of `edn.el'
+
+- `:compat' If `t', mimic `edn.el'. Defaults to `false' (`nil').
+ When this is set to `t' then `:tag-writers' is ignored.
+- `:tag-writers' An association list from symbol to function.
+ Each function is given a list including `type' tag, and should
+ return a value that can be handled by `parseclj-print'.")
+```
diff --git a/README.md b/README.md
index 124801fd07..83026d14f6 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-[](https://travis-ci.org/lambdaisland/clj-parse)
+[](https://travis-ci.org/lambdaisland/parseclj)
# EDN reader and Clojure parser for Emacs Lisp
diff --git a/benchmark/speed-comparison.el b/benchmark/speed-comparison.el
index 2529e782eb..12682112d2 100644
--- a/benchmark/speed-comparison.el
+++ b/benchmark/speed-comparison.el
@@ -14,7 +14,7 @@
;;(message fn)
(with-current-buffer buff
(let ((start (time-to-seconds (current-time))))
- (clj-edn-read)
+ (parseedn-read)
(setq clj-time (+ clj-time (- (time-to-seconds (current-time))
start))))
(goto-char 1)
(let ((start (time-to-seconds (current-time))))
diff --git a/clj-ast.el b/clj-ast.el
deleted file mode 100644
index c295d316e6..0000000000
--- a/clj-ast.el
+++ /dev/null
@@ -1,116 +0,0 @@
-;;; clj-ast.el --- Clojure parser/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:
-
-;; Parse Clojure code to an AST, and unparse back to code.
-
-;;; Code:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Parser
-
-(defun clj-parse--make-node (type position &rest kvs)
- (apply 'a-list ':node-type type ':position position kvs))
-
-(defun clj-ast--reduce-leaf (stack token)
- (if (eq (clj-lex-token-type token) :whitespace)
- stack
- (cons
- (clj-parse--make-node (clj-lex-token-type token) (a-get token 'pos)
- ':form (a-get token 'form)
- ':value (clj-parse--leaf-token-value token))
- stack)))
-
-(defun clj-ast--reduce-node (stack opener-token children)
- (let* ((pos (a-get opener-token 'pos))
- (type (clj-lex-token-type opener-token))
- (type (cl-case type
- (:lparen :list)
- (:lbracket :vector)
- (:lbrace :map)
- (t type))))
- (cl-case type
- (:root (clj-parse--make-node :root 0 :children children))
- (:discard stack)
- (:tag (list (clj-parse--make-node :tag
- pos
- :tag (intern (substring (a-get
opener-token 'form) 1))
- :children children)))
- (t (cons
- (clj-parse--make-node type pos :children children)
- stack)))))
-
-(defun clj-ast-parse ()
- "Parse Clojure code in buffer to AST.
-
-Parses code in the current buffer, starting from the current
-position of (point)."
- (clj-parse-reduce #'clj-ast--reduce-leaf #'clj-ast--reduce-node))
-
-(defun clj-ast-parse-str (s)
- "Parse Clojure code in string S to AST."
- (with-temp-buffer
- (insert s)
- (goto-char 1)
- (clj-ast-parse)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Unparser
-
-(defun clj-ast-unparse-collection (nodes ld rd)
- (insert ld)
- (when-let (node (car nodes))
- (clj-ast-unparse node))
- (seq-doseq (node (cdr nodes))
- (insert " ")
- (clj-ast-unparse node))
- (insert rd))
-
-(defun clj-ast-unparse-tag (node)
- (progn
- (insert "#")
- (insert (symbol-name (a-get node :tag)))
- (insert " ")
- (clj-ast-unparse (car (a-get node :children)))))
-
-(defun clj-ast-unparse (node)
- (if (clj-parse--is-leaf? node)
- (insert (alist-get ':form node))
- (let ((subnodes (alist-get ':children node)))
- (cl-case (a-get node ':node-type)
- (:root (clj-ast-unparse-collection subnodes "" ""))
- (:list (clj-ast-unparse-collection subnodes "(" ")"))
- (:vector (clj-ast-unparse-collection subnodes "[" "]"))
- (:set (clj-ast-unparse-collection subnodes "#{" "}"))
- (:map (clj-ast-unparse-collection subnodes "{" "}"))
- (:tag (clj-ast-unparse-tag node))))))
-
-(defun clj-ast-unparse-str (data)
- (with-temp-buffer
- (clj-ast-unparse data)
- (buffer-substring-no-properties (point-min) (point-max))))
-
-(provide 'clj-ast)
-
-;;; clj-ast.el ends here
diff --git a/clj-lex.el b/clj-lex.el
deleted file mode 100644
index f85818ecfb..0000000000
--- a/clj-lex.el
+++ /dev/null
@@ -1,303 +0,0 @@
-;;; clj-lex.el --- Clojure/EDN Lexer
-
-;; 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:
-
-;; A reader for EDN data files and parser for Clojure source files.
-
-(defun clj-lex-token (type form pos &rest args)
- `((type . ,type)
- (form . ,form)
- (pos . ,pos)
- ,@(mapcar (lambda (pair)
- (cons (car pair) (cadr pair)))
- (seq-partition args 2))))
-
-(defun clj-lex-token-type (token)
- (and (listp token)
- (cdr (assq 'type token))))
-
-(defun clj-lex-token? (token)
- (and (listp token)
- (consp (car token))
- (eq 'type (caar token))
- (not (listp (cdar token)))))
-
-(defun clj-lex-at-whitespace? ()
- (let ((char (char-after (point))))
- (or (equal char ?\ )
- (equal char ?\t)
- (equal char ?\n)
- (equal char ?\r)
- (equal char ?,))))
-
-(defun clj-lex-at-eof? ()
- (eq (point) (point-max)))
-
-(defun clj-lex-whitespace ()
- (let ((pos (point)))
- (while (clj-lex-at-whitespace?)
- (right-char))
- (clj-lex-token :whitespace
- (buffer-substring-no-properties pos (point))
- pos)))
-
-(defun clj-lex-skip-digits ()
- (while (and (char-after (point))
- (<= ?0 (char-after (point)))
- (<= (char-after (point)) ?9))
- (right-char)))
-
-(defun clj-lex-skip-number ()
- ;; [\+\-]?\d+\.\d+
- (when (member (char-after (point)) '(?+ ?-))
- (right-char))
-
- (clj-lex-skip-digits)
-
- (when (eq (char-after (point)) ?.)
- (right-char))
-
- (clj-lex-skip-digits))
-
-(defun clj-lex-number ()
- (let ((pos (point)))
- (clj-lex-skip-number)
-
- ;; 10110r2 or 4.3e+22
- (when (member (char-after (point)) '(?E ?e ?r))
- (right-char))
-
- (clj-lex-skip-number)
-
- ;; trailing M
- (when (eq (char-after (point)) ?M)
- (right-char))
-
- (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)
- (clj-lex-token :lex-error
- (buffer-substring-no-properties pos (point))
- pos
- 'error-type :invalid-number-format))
-
- (clj-lex-token :number
- (buffer-substring-no-properties pos (point))
- pos)))))
-
-
-(defun clj-lex-digit? (char)
- (and char (<= ?0 char) (<= char ?9)))
-
-(defun clj-lex-at-number? ()
- (let ((char (char-after (point))))
- (or (clj-lex-digit? char)
- (and (member char '(?- ?+ ?.))
- (clj-lex-digit? (char-after (1+ (point))))))))
-
-(defun clj-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.
-
-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 clj-lex-symbol-rest? (char)
- (or (clj-lex-symbol-start? char)
- (clj-lex-digit? char)
- (eq ?: char)
- (eq ?# char)))
-
-(defun clj-lex-get-symbol-at-point (pos)
- "Return the symbol at point."
- (while (clj-lex-symbol-rest? (char-after (point)))
- (right-char))
- (buffer-substring-no-properties pos (point)))
-
-(defun clj-lex-symbol ()
- (let ((pos (point)))
- (right-char)
- (let ((sym (clj-lex-get-symbol-at-point pos)))
- (cond
- ((equal sym "nil") (clj-lex-token :nil "nil" pos))
- ((equal sym "true") (clj-lex-token :true "true" pos))
- ((equal sym "false") (clj-lex-token :false "false" pos))
- (t (clj-lex-token :symbol sym pos))))))
-
-(defun clj-lex-string ()
- (let ((pos (point)))
- (right-char)
- (while (not (or (equal (char-after (point)) ?\") (clj-lex-at-eof?)))
- (if (equal (char-after (point)) ?\\)
- (right-char 2)
- (right-char)))
- (if (equal (char-after (point)) ?\")
- (progn
- (right-char)
- (clj-lex-token :string (buffer-substring-no-properties pos (point))
pos))
- (clj-lex-token :lex-error (buffer-substring-no-properties pos (point))
pos))))
-
-(defun clj-lex-lookahead (n)
- (buffer-substring-no-properties (point) (min (+ (point) n) (point-max))))
-
-(defun clj-lex-character ()
- (let ((pos (point)))
- (right-char)
- (cond
- ((equal (clj-lex-lookahead 3) "tab")
- (right-char 3)
- (clj-lex-token :character (buffer-substring-no-properties pos (point))
pos))
-
- ((equal (clj-lex-lookahead 5) "space")
- (right-char 5)
- (clj-lex-token :character (buffer-substring-no-properties pos (point))
pos))
-
- ((equal (clj-lex-lookahead 6) "return")
- (right-char 6)
- (clj-lex-token :character (buffer-substring-no-properties pos (point))
pos))
-
- ((equal (clj-lex-lookahead 7) "newline")
- (right-char 7)
- (clj-lex-token :character (buffer-substring-no-properties pos (point))
pos))
-
- ((equal (char-after (point)) ?u)
- (right-char 5)
- (clj-lex-token :character (buffer-substring-no-properties pos (point))
pos))
-
- ((equal (char-after (point)) ?o)
- (right-char 4)
- (clj-lex-token :character (buffer-substring-no-properties pos (point))
pos))
-
- (t
- (right-char)
- (clj-lex-token :character (buffer-substring-no-properties pos (point))
pos)))))
-
-(defun clj-lex-keyword ()
- (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)
- (clj-lex-token :lex-error (buffer-substring-no-properties pos
(point)) pos 'error-type :invalid-keyword))
- (progn
- (while (or (clj-lex-symbol-rest? (char-after (point)))
- (equal (char-after (point)) ?#))
- (right-char))
- (clj-lex-token :keyword (buffer-substring-no-properties pos (point))
pos)))))
-
-(defun clj-lex-comment ()
- (let ((pos (point)))
- (goto-char (line-end-position))
- (when (equal (char-after (point)) ?\n)
- (right-char))
- (clj-lex-token :comment (buffer-substring-no-properties pos (point)) pos)))
-
-(defun clj-lex-next ()
- (if (clj-lex-at-eof?)
- (clj-lex-token :eof nil (point))
- (let ((char (char-after (point)))
- (pos (point)))
- (cond
- ((clj-lex-at-whitespace?)
- (clj-lex-whitespace))
-
- ((equal char ?\()
- (right-char)
- (clj-lex-token :lparen "(" pos))
-
- ((equal char ?\))
- (right-char)
- (clj-lex-token :rparen ")" pos))
-
- ((equal char ?\[)
- (right-char)
- (clj-lex-token :lbracket "[" pos))
-
- ((equal char ?\])
- (right-char)
- (clj-lex-token :rbracket "]" pos))
-
- ((equal char ?{)
- (right-char)
- (clj-lex-token :lbrace "{" pos))
-
- ((equal char ?})
- (right-char)
- (clj-lex-token :rbrace "}" pos))
-
- ((clj-lex-at-number?)
- (clj-lex-number))
-
- ((clj-lex-symbol-start? char)
- (clj-lex-symbol))
-
- ((equal char ?\")
- (clj-lex-string))
-
- ((equal char ?\\)
- (clj-lex-character))
-
- ((equal char ?:)
- (clj-lex-keyword))
-
- ((equal char ?\;)
- (clj-lex-comment))
-
- ((equal char ?#)
- (right-char)
- (let ((char (char-after (point))))
- (cond
- ((equal char ?{)
- (right-char)
- (clj-lex-token :set "#{" pos))
- ((equal char ?_)
- (right-char)
- (clj-lex-token :discard "#_" pos))
- ((clj-lex-symbol-start? char t)
- (right-char)
- (clj-lex-token :tag (concat "#" (clj-lex-get-symbol-at-point (1+
pos))) pos))
- (t
- (while (not (or (clj-lex-at-whitespace?)
- (clj-lex-at-eof?)))
- (right-char))
- (clj-lex-token :lex-error (buffer-substring-no-properties pos
(point)) pos 'error-type :invalid-hashtag-dispatcher)))))
-
- (t
- (concat ":(" (char-to-string char)))))))
-
-(provide 'clj-lex)
-
-;;; clj-lex.el ends here
diff --git a/clj-parse.el b/clj-parse.el
deleted file mode 100644
index cfccdb59f8..0000000000
--- a/clj-parse.el
+++ /dev/null
@@ -1,168 +0,0 @@
-;;; clj-parse.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 reader for EDN data files and parser for Clojure source files.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'a)
-
-(require 'clj-lex)
-(require 'clj-edn)
-(require 'clj-ast)
-
-(defvar clj-parse--leaf-tokens '(:whitespace
- :comment
- :number
- :nil
- :true
- :false
- :symbol
- :keyword
- :string
- :character)
- "Tokens that represent leaf nodes in the AST.")
-
-(defvar clj-parse--closer-tokens '(:rparen
- :rbracket
- :rbrace)
- "Tokens that represent closing of an AST branch.")
-
-(defun clj-parse--is-leaf? (node)
- (member (a-get node ':node-type) clj-parse--leaf-tokens))
-
-(defun clj-parse--is-open-prefix? (el)
- (and (member (clj-lex-token-type el) '(:discard :tag))
- (clj-lex-token? el)))
-
-;; 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 clj-parse--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 clj-parse--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 clj-parse--leaf-token-value (token)
- (cl-case (clj-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 (clj-parse--string (alist-get 'form token)))
- (:character (clj-parse--character (alist-get 'form token)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Shift-Reduce Parser
-
-(defun clj-parse--find-opener (stack closer-token)
- (cl-case (clj-lex-token-type closer-token)
- (:rparen :lparen)
- (:rbracket :lbracket)
- (:rbrace (clj-lex-token-type
- (seq-find (lambda (token) (member (clj-lex-token-type token)
'(:lbrace :set))) stack)))))
-
-(defun clj-parse--reduce-coll (stack closer-token reduceN)
- "Reduce collection based on the top of the stack"
- (let ((opener-type (clj-parse--find-opener stack closer-token))
- (coll nil))
- (while (and stack
- (not (eq (clj-lex-token-type (car stack)) opener-type)))
- (push (pop stack) coll))
-
- (if (eq (clj-lex-token-type (car stack)) opener-type)
- (let ((node (pop stack)))
- (funcall reduceN stack node coll))
- ;; Syntax error
- (progn
- (message "STACK: %S , CLOSER: %S" stack closer-token)
- (error "Syntax Error")))))
-
-(defun clj-parse-reduce (reduce-leaf reduce-node)
- (let ((stack nil))
-
- (while (not (eq (clj-lex-token-type (setq token (clj-lex-next))) :eof))
- ;; (message "STACK: %S" stack)
- ;; (message "TOKEN: %S\n" token)
-
- ;; Reduce based on the top item on the stack (collections)
- (let ((token-type (clj-lex-token-type token)))
- (cond
- ((member token-type clj-parse--leaf-tokens) (setf stack (funcall
reduce-leaf stack token)))
- ((member token-type clj-parse--closer-tokens) (setf stack
(clj-parse--reduce-coll stack token reduce-node)))
- (t (push token stack))))
-
- ;; Reduce based on top two items on the stack (special prefixed elements)
- (seq-let [top lookup] stack
- (when (and (clj-parse--is-open-prefix? lookup)
- (not (clj-lex-token? top))) ;; top is fully reduced
- (setf stack (funcall reduce-node (cddr stack) lookup (list
top))))))
-
- ;; reduce root
- (setf stack (funcall reduce-node stack '((type . :root) (pos . 1)) stack))
- ;; (message "RESULT: %S" stack)
- stack))
-
-
-(provide 'clj-parse)
-
-;;; clj-parse.el ends here
diff --git a/parseclj-ast.el b/parseclj-ast.el
new file mode 100644
index 0000000000..7326471af1
--- /dev/null
+++ b/parseclj-ast.el
@@ -0,0 +1,111 @@
+;;; parseclj-ast.el --- Clojure parser/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:
+
+;; Parse Clojure code to an AST, and unparse back to code.
+
+;;; Code:
+
+;; AST helper functions
+
+(defun parseclj-ast-node (type position &rest attributes)
+ "Create an AST node with given TYPE and POSITION.
+
+Other ATTRIBUTES can be given as a flat list of key-value pairs. "
+ (apply 'a-list :node-type type :position position attributes))
+
+(defun parseclj-ast-node? (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-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))
+
+;; Parse/reduce strategy functions
+
+(defun parseclj-ast--reduce-leaf (stack token 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))
+ stack)))
+
+(defun parseclj-ast--reduce-leaf-with-lexical-preservation (stack token
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 (a-get top :node-type))
+ (cons (a-update top :form #'concat (a-get token :form))
+ (cdr stack))
+ (cons (parseclj-ast-node (parseclj-lex-token-type token)
+ (a-get token :pos)
+ :form (a-get token :form))
+ stack))
+ (parseclj-ast--reduce-leaf stack token options))))
+
+(defun parseclj-ast--reduce-branch (stack opening-token children options)
+ (let* ((pos (a-get opening-token :pos))
+ (type (parseclj-lex-token-type opening-token))
+ (type (cl-case type
+ (:lparen :list)
+ (:lbracket :vector)
+ (:lbrace :map)
+ (t type))))
+ (cl-case type
+ (:root (cons (parseclj-ast-node :root pos :children children) stack))
+ (:discard stack)
+ (:tag (list (parseclj-ast-node :tag
+ pos
+ :tag (intern (substring (a-get
opening-token :form) 1))
+ :children children)))
+ (t (cons
+ (parseclj-ast-node type pos :children children)
+ stack)))))
+
+(defun parseclj-ast--reduce-branch-with-lexical-preservation (stack
opening-token children 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)
+ (cons (cl-list* (car top) ;; make sure :node-type remains the first
element in the list
+ '(:lexical-preservation . t)
+ (cdr top))
+ (cdr stack))
+ stack))))
+
+(provide 'parseclj-ast)
+
+;;; parseclj-ast.el ends here
diff --git a/parseclj-lex.el b/parseclj-lex.el
new file mode 100644
index 0000000000..df59881f67
--- /dev/null
+++ b/parseclj-lex.el
@@ -0,0 +1,319 @@
+;;; parseclj-lex.el --- Clojure/EDN Lexer
+
+;; 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:
+
+;; A reader for EDN data files and parser for Clojure source files.
+
+;;; Code
+
+(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 'a-list :token-type type :form form :pos pos attributes))
+
+(defun parseclj-lex-token? (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-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? ()
+ (let ((char (char-after (point))))
+ (or (equal char ?\ )
+ (equal char ?\t)
+ (equal char ?\n)
+ (equal char ?\r)
+ (equal char ?,))))
+
+(defun parseclj-lex-at-eof? ()
+ (eq (point) (point-max)))
+
+(defun parseclj-lex-whitespace ()
+ (let ((pos (point)))
+ (while (parseclj-lex-at-whitespace?)
+ (right-char))
+ (parseclj-lex-token :whitespace
+ (buffer-substring-no-properties pos (point))
+ pos)))
+
+(defun parseclj-lex-skip-digits ()
+ (while (and (char-after (point))
+ (<= ?0 (char-after (point)))
+ (<= (char-after (point)) ?9))
+ (right-char)))
+
+(defun parseclj-lex-skip-number ()
+ ;; [\+\-]?\d+\.\d+
+ (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 ()
+ (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))
+
+ (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-token :lex-error
+ (buffer-substring-no-properties pos (point))
+ pos
+ :error-type :invalid-number-format))
+
+ (parseclj-lex-token :number
+ (buffer-substring-no-properties pos (point))
+ pos)))))
+
+
+(defun parseclj-lex-digit? (char)
+ (and char (<= ?0 char) (<= char ?9)))
+
+(defun parseclj-lex-at-number? ()
+ (let ((char (char-after (point))))
+ (or (parseclj-lex-digit? char)
+ (and (member char '(?- ?+ ?.))
+ (parseclj-lex-digit? (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.
+
+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)
+ (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)))
+ (right-char))
+ (buffer-substring-no-properties pos (point)))
+
+(defun parseclj-lex-symbol ()
+ (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 ()
+ (let ((pos (point)))
+ (right-char)
+ (while (not (or (equal (char-after (point)) ?\") (parseclj-lex-at-eof?)))
+ (if (equal (char-after (point)) ?\\)
+ (right-char 2)
+ (right-char)))
+ (if (equal (char-after (point)) ?\")
+ (progn
+ (right-char)
+ (parseclj-lex-token :string (buffer-substring-no-properties pos
(point)) pos))
+ (parseclj-lex-token :lex-error (buffer-substring-no-properties pos
(point)) pos))))
+
+(defun parseclj-lex-lookahead (n)
+ (buffer-substring-no-properties (point) (min (+ (point) n) (point-max))))
+
+(defun parseclj-lex-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))
+
+ ((equal (char-after (point)) ?u)
+ (right-char 5)
+ (parseclj-lex-token :character (buffer-substring-no-properties pos
(point)) pos))
+
+ ((equal (char-after (point)) ?o)
+ (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 ()
+ (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-token :lex-error (buffer-substring-no-properties pos
(point)) pos :error-type :invalid-keyword))
+ (progn
+ (while (or (parseclj-lex-symbol-rest? (char-after (point)))
+ (equal (char-after (point)) ?#))
+ (right-char))
+ (parseclj-lex-token :keyword (buffer-substring-no-properties pos
(point)) pos)))))
+
+(defun parseclj-lex-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-next ()
+ (if (parseclj-lex-at-eof?)
+ (parseclj-lex-token :eof nil (point))
+ (let ((char (char-after (point)))
+ (pos (point)))
+ (cond
+ ((parseclj-lex-at-whitespace?)
+ (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))
+
+ ((parseclj-lex-at-number?)
+ (parseclj-lex-number))
+
+ ((parseclj-lex-symbol-start? 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)
+ (let ((char (char-after (point))))
+ (cond
+ ((equal char ?{)
+ (right-char)
+ (parseclj-lex-token :set "#{" pos))
+ ((equal char ?_)
+ (right-char)
+ (parseclj-lex-token :discard "#_" pos))
+ ((parseclj-lex-symbol-start? 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?)))
+ (right-char))
+ (parseclj-lex-token :lex-error (buffer-substring-no-properties pos
(point)) pos :error-type :invalid-hashtag-dispatcher)))))
+
+ (t
+ (concat ":(" (char-to-string char)))))))
+
+(provide 'parseclj-lex)
+
+;;; parseclj-lex.el ends here
diff --git a/test/clj-parse-test.el b/parseclj-unparse.el
similarity index 52%
rename from test/clj-parse-test.el
rename to parseclj-unparse.el
index 172664cfb1..8f2495c2b6 100644
--- a/test/clj-parse-test.el
+++ b/parseclj-unparse.el
@@ -1,4 +1,4 @@
-;;; clj-parse-test.el --- Clojure/EDN parser - tests
+;;; parseclj-unparser.el --- Clojure unparser -*- lexical-binding: t; -*-
;; Copyright (C) 2017 Arne Brasseur
@@ -23,16 +23,31 @@
;;; Commentary:
-;; A reader for EDN data files and parser for Clojure source files - tests
+;; Unparse an AST to Clojure code
;;; Code:
-(require 'ert)
-(require 'clj-parse)
-
-;; needs testing of individual functions. all testing now is at the top level
-;; through parse/unparse
-
-(provide 'clj-parse-test)
-
-;;; clj-parse-test.el ends here
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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
new file mode 100644
index 0000000000..c9e6abc489
--- /dev/null
+++ b/parseclj.el
@@ -0,0 +1,354 @@
+;;; parseclj.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 reader for EDN data files and parser for Clojure source files.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'a)
+
+(require 'parseclj-lex)
+(require 'parseedn)
+(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.
+
+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').
+- `:fail-fast' Raise an error
+ when encountering invalid syntax. Defaults to true (`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)
+ (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))))
+
+(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? 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)))))
+
+(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/clj-edn.el b/parseedn.el
similarity index 51%
rename from clj-edn.el
rename to parseedn.el
index d509c6c4b0..9eaa9fd38e 100644
--- a/clj-edn.el
+++ b/parseedn.el
@@ -1,4 +1,4 @@
-;;; clj-edn.el --- EDN reader/writer -*- lexical-binding: t; -*-
+;;; parseedn.el --- EDN reader/writer -*- lexical-binding: t; -*-
;; Copyright (C) 2017 Arne Brasseur
@@ -30,7 +30,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Reader
-(defvar clj-edn-default-tag-readers
+(defvar parseedn-default-tag-readers
(a-list 'inst (lambda (s)
(cl-list* 'edn-inst (date-to-time s)))
'uuid (lambda (s)
@@ -41,66 +41,68 @@ is not recommended you change this variable, as this
globally
changes the behavior of the EDN reader. Instead pass your own
handlers as an optional argument to the reader functions.")
-(defun clj-edn-reduce-leaf (stack token)
- (if (member (clj-lex-token-type token) (list :whitespace :comment))
+(defun parseedn-reduce-leaf (stack token options)
+ (if (member (parseclj-lex-token-type token) (list :whitespace :comment))
stack
- (cons (clj-parse--leaf-token-value token) stack)))
-
-(defun clj-edn-reduce-node (tag-readers)
- (lambda (stack opener-token children)
- (let ((token-type (clj-lex-token-type opener-token)))
- (if (member token-type '(:root :discard))
- stack
- (cons
- (cl-case token-type
- (:lparen children)
- (:lbracket (apply #'vector children))
- (:set (list 'edn-set children))
- (:lbrace (let* ((kvs (seq-partition children 2))
- (hash-map (make-hash-table :test 'equal :size
(length kvs))))
- (seq-do (lambda (pair)
- (puthash (car pair) (cadr pair) hash-map))
- kvs)
- hash-map))
- (:tag (let* ((tag (intern (substring (a-get opener-token 'form) 1)))
- (reader (a-get tag-readers tag :missing)))
- (when (eq :missing reader)
- (user-error "No reader for tag #%S in %S" tag (a-keys
tag-readers)))
- (funcall reader (car children)))))
- stack)))))
-
-(defun clj-edn-read (&optional tag-readers)
- (clj-parse-reduce #'clj-edn-reduce-leaf
- (clj-edn-reduce-node (a-merge clj-edn-default-tag-readers
tag-readers))))
-
-(defun clj-edn-read-str (s &optional tag-readers)
+ (cons (parseclj--leaf-token-value token) stack)))
+
+(defun parseedn-reduce-branch (stack opening-token children 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)
+ stack
+ (cons
+ (cl-case token-type
+ (:root children)
+ (:lparen children)
+ (:lbracket (apply #'vector children))
+ (:set (list 'edn-set children))
+ (:lbrace (let* ((kvs (seq-partition children 2))
+ (hash-map (make-hash-table :test 'equal :size (length
kvs))))
+ (seq-do (lambda (pair)
+ (puthash (car pair) (cadr pair) hash-map))
+ kvs)
+ hash-map))
+ (:tag (let* ((tag (intern (substring (a-get opening-token :form) 1)))
+ (reader (a-get tag-readers tag :missing)))
+ (when (eq :missing reader)
+ (user-error "No reader for tag #%S in %S" tag (a-keys
tag-readers)))
+ (funcall reader (car children)))))
+ stack))))
+
+(defun parseedn-read (&optional tag-readers)
+ (parseclj-parse #'parseedn-reduce-leaf
+ #'parseedn-reduce-branch
+ (a-list :tag-readers tag-readers)))
+
+(defun parseedn-read-str (s &optional tag-readers)
(with-temp-buffer
(insert s)
(goto-char 1)
- (car (clj-edn-read tag-readers))))
+ (car (parseedn-read tag-readers))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Printer
-(defun clj-edn-print-seq (coll)
- (clj-edn-print (elt coll 0))
+(defun parseedn-print-seq (coll)
+ (parseedn-print (elt coll 0))
(let ((next (seq-drop coll 1)))
(when (not (seq-empty-p next))
(insert " ")
- (clj-edn-print-seq next))))
+ (parseedn-print-seq next))))
-(defun clj-edn-print-kvs (map)
+(defun parseedn-print-kvs (map)
(let ((keys (a-keys map)))
- (clj-edn-print (car keys))
+ (parseedn-print (car keys))
(insert " ")
- (clj-edn-print (a-get map (car keys)))
+ (parseedn-print (a-get map (car keys)))
(let ((next (cdr keys)))
(when (not (seq-empty-p next))
(insert ", ")
- (clj-edn-print-kvs next)))))
+ (parseedn-print-kvs next)))))
-(defun clj-edn-print (datum)
+(defun parseedn-print (datum)
(cond
((or (null datum) (numberp datum))
(prin1 datum (current-buffer)))
@@ -124,22 +126,22 @@ handlers as an optional argument to the reader
functions.")
((symbolp datum)
(insert (symbol-name datum)))
- ((vectorp datum) (insert "[") (clj-edn-print-seq datum) (insert "]"))
+ ((vectorp datum) (insert "[") (parseedn-print-seq datum) (insert "]"))
((consp datum)
(cond
((eq 'edn-set (car datum))
- (insert "#{") (clj-edn-print-seq (cadr datum)) (insert "}"))
- (t (insert "(") (clj-edn-print-seq datum) (insert ")"))))
+ (insert "#{") (parseedn-print-seq (cadr datum)) (insert "}"))
+ (t (insert "(") (parseedn-print-seq datum) (insert ")"))))
((hash-table-p datum)
- (insert "{") (clj-edn-print-kvs datum) (insert "}"))))
+ (insert "{") (parseedn-print-kvs datum) (insert "}"))))
-(defun clj-edn-print-str (datum)
+(defun parseedn-print-str (datum)
(with-temp-buffer
- (clj-edn-print datum)
+ (parseedn-print datum)
(buffer-substring-no-properties (point-min) (point-max))))
-(provide 'clj-edn)
+(provide 'parseedn)
-;;; clj-edn.el ends here
+;;; parseedn.el ends here
diff --git a/test/clj-ast-unparse-test.el b/test/clj-ast-unparse-test.el
deleted file mode 100644
index 798aba4f32..0000000000
--- a/test/clj-ast-unparse-test.el
+++ /dev/null
@@ -1,166 +0,0 @@
-;;; clj-ast-unparse-test.el --- Print Clojure AST back to code - tests
-
-;; 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:
-
-;; Print Clojure AST back to code - tests
-
-;;; Code:
-
-(require 'ert)
-(require 'clj-ast)
-
-;;; Printer modes
-;; ----------------------------------------------------------------------------
-
-(ert-deftest clj-ast-unparse-list ()
- (should (equal "(0 1 2)"
- (clj-ast-unparse-str '((:node-type . :root)
- (:position . 0)
- (:children . (((:node-type . :list)
- (:position . 1)
- (:children .
(((:node-type . :number)
-
(:position . 2)
- (:form .
"0")
- (:value
. 0))
-
((:node-type . :number)
-
(:position . 4)
- (:form .
"1")
- (:value
. 1))
-
((:node-type . :number)
-
(:position . 6)
- (:form .
"2")
- (:value
. 2))))))))))))
-
-(ert-deftest clj-ast-unparse-empty-list ()
- (should (equal "()"
- (clj-ast-unparse-str '((:node-type . :root)
- (:position . 0)
- (:children . (((:node-type . :list)
- (:position . 1)
- (:children .
nil)))))))))
-
-(ert-deftest clj-ast-unparse-nested-list ()
- (should (equal "((.9 abc (true) (hello)))"
- (clj-ast-unparse-str '((:node-type . :root)
- (:position . 0)
- (: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))))))))))))))))
-
-(ert-deftest clj-ast-unparse-string ()
- (should (equal "\"abc hello \\t\\\"x\""
- (clj-ast-unparse-str '((:node-type . :root)
- (:position . 0)
- (:children . (((:node-type . :string)
- (:position . 1)
- (:form . "\"abc hello
\\t\\\"x\"")
- (:value . "abc hello
\t\"x")))))))))
-
-(ert-deftest clj-ast-unparse-chars ()
- (should (equal "(\\newline \\return \\space \\tab \\a \\b \\c \\u0078
\\o171)"
- (clj-ast-unparse-str '((:node-type . :root)
- (:position . 0)
- (: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)))))))))
- )))
-
-(ert-deftest clj-ast-unparse-keyword ()
- (should (equal ":foo-bar"
- (clj-ast-unparse-str '((:node-type . :root)
- (:position . 0)
- (:children . (((:node-type . :keyword)
- (:position . 1)
- (:form . ":foo-bar")
- (:value .
:foo-bar)))))))))
-
-(ert-deftest clj-ast-unparse-vector ()
- (should (equal "[123]"
- (clj-ast-unparse-str '((:node-type . :root)
- (:position . 0)
- (:children . (((:node-type . :vector)
- (:position . 1)
- (:children .
(((:node-type . :number)
-
(:position . 2)
- (:form .
"123")
- (:value
. 123))))))))))))
-
-(ert-deftest clj-ast-unparse-map ()
- (should (equal "{:count 123}"
- (clj-ast-unparse-str '((:node-type . :root)
- (:position . 0)
- (: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))))))))))))
-
-(ert-deftest clj-ast-unparse-set ()
- (should (equal "#{:x}"
- (clj-ast-unparse-str '((:node-type . :root)
- (:position . 0)
- (:children . (((:node-type . :set)
- (:position . 1)
- (:children .
(((:node-type . :keyword)
-
(:position . 3)
- (:form .
":x")
- (:value
. :x))))))))))))
-
-(provide 'clj-unparse-test)
-
-;;; clj-ast-unparse-test.el ends here
diff --git a/test/clj-edn-el-parity-test.el b/test/clj-edn-el-parity-test.el
deleted file mode 100644
index bae4d41609..0000000000
--- a/test/clj-edn-el-parity-test.el
+++ /dev/null
@@ -1,286 +0,0 @@
-;;; edn-el-parity.el --- Tests from edn.el
-
-;; Author: Lars Andersen <expez@expez.com>, Arne Brasseur
<arne@arnebrasseur.net>
-
-;; Copyright (C) 2015 Lars Andersen
-
-;; 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:
-
-;; These tests are copied verbatim from the edn.el source, and adapted to use
-;; our API. This way we assure that clj-parse can act as a drop-in replacement
-;; for edn.el.
-
-;;; Code:
-
-(require 'ert)
-(require 'clj-parse)
-(eval-when-compile (require 'subr-x)) ;; for things like hash-table-keys
-
-(ert-deftest whitespace ()
- (should (null (clj-edn-read-str "")))
- (should (null (clj-edn-read-str " ")))
- (should (null (clj-edn-read-str " ")))
- (should (null (clj-edn-read-str " ")))
- (should (null (clj-edn-read-str " ")))
- (should (null (clj-edn-read-str ",")))
- (should (null (clj-edn-read-str ",,,,")))
- (should (null (clj-edn-read-str " , ,\n")))
- (should (null (clj-edn-read-str "\n ,, ")))
- (should (equal [a b c d] (clj-edn-read-str "[a ,,,,,, b,,,,,c ,d]"))))
-
-(ert-deftest symbols ()
- :tags '(edn symbol)
- (should (equal 'foo (clj-edn-read-str "foo")))
- (should (equal 'foo\. (clj-edn-read-str "foo.")))
- (should (equal '%foo\. (clj-edn-read-str "%foo.")))
- (should (equal 'foo/bar (clj-edn-read-str "foo/bar")))
- (equal 'some\#sort\#of\#symbol (clj-edn-read-str "some#sort#of#symbol"))
- (equal 'truefalse (clj-edn-read-str "truefalse"))
- (equal 'true. (clj-edn-read-str "true."))
- (equal '/ (clj-edn-read-str "/"))
- (should (equal '.true (clj-edn-read-str ".true")))
- (should (equal 'some:sort:of:symbol (clj-edn-read-str
"some:sort:of:symbol")))
- (equal 'foo-bar (clj-edn-read-str "foo-bar"))
- (should (equal '+some-symbol (clj-edn-read-str "+some-symbol")))
- (should (equal '-symbol (clj-edn-read-str "-symbol"))))
-
-(ert-deftest booleans ()
- :tags '(edn boolean)
- (should (equal t (clj-edn-read-str "true")))
- (should (equal nil (clj-edn-read-str "false "))))
-
-(ert-deftest characters ()
- :tags '(edn characters)
- (should (equal 97 (clj-edn-read-str "\\a")))
- (should (equal 960 (clj-edn-read-str "\\u03C0")))
- ;;(should (equal 'newline (clj-edn-read-str "\\newline")))
- )
-
-(ert-deftest elision ()
- :tags '(edn elision)
- (should-not (clj-edn-read-str "#_foo"))
- (should-not (clj-edn-read-str "#_ 123"))
- (should-not (clj-edn-read-str "#_:foo"))
- (should-not (clj-edn-read-str "#_ \\a"))
- (should-not (clj-edn-read-str "#_
-\"foo\""))
- (should-not (clj-edn-read-str "#_ (1 2 3)"))
- (should (equal '(1 3) (clj-edn-read-str "(1 #_ 2 3)")))
- (should (equal '[1 2 3 4] (clj-edn-read-str "[1 2 #_[4 5 6] 3 4]")))
- (should (map-equal (make-seeded-hash-table :foo :bar)
- (clj-edn-read-str "{:foo #_elided :bar}")))
- (should (equal '(edn-set (1 2 3 4))
- (clj-edn-read-str "#{1 2 #_[1 2 3] 3 #_ (1 2) 4}")))
- (should (equal [a d] (clj-edn-read-str "[a #_ ;we are discarding what comes
next
- c d]"))))
-
-(ert-deftest string ()
- :tags '(edn string)
- (should (equal "this is a string" (clj-edn-read-str "\"this is a string\"")))
- (should (equal "this has an escaped \"quote in it"
- (clj-edn-read-str "\"this has an escaped \\\"quote in it\"")))
- (should (equal "foo\tbar" (clj-edn-read-str "\"foo\\tbar\"")))
- (should (equal "foo\nbar" (clj-edn-read-str "\"foo\\nbar\"")))
- (should (equal "this is a string \\ that has an escaped backslash"
- (clj-edn-read-str "\"this is a string \\\\ that has an
escaped backslash\"")))
- (should (equal "[" (clj-edn-read-str "\"[\""))))
-
-(ert-deftest keywords ()
- :tags '(edn keywords)
- (should (equal :namespace\.of\.some\.length/keyword-name
- (clj-edn-read-str ":namespace.of.some.length/keyword-name")))
- (should (equal :\#/\# (clj-edn-read-str ":#/#")))
- (should (equal :\#/:a (clj-edn-read-str ":#/:a")))
- (should (equal :\#foo (clj-edn-read-str ":#foo"))))
-
-(ert-deftest integers ()
- :tags '(edn integers)
- (should (= 0 (clj-edn-read-str "0")))
- (should (= 0 (clj-edn-read-str "+0")))
- (should (= 0 (clj-edn-read-str "-0")))
- (should (= 100 (clj-edn-read-str "100")))
- (should (= -100 (clj-edn-read-str "-100"))))
-
-(ert-deftest floats ()
- :tags '(edn floats)
- (should (= 12.32 (clj-edn-read-str "12.32")))
- (should (= -12.32 (clj-edn-read-str "-12.32")))
- (should (= 9923.23 (clj-edn-read-str "+9923.23")))
- (should (= 4.5e+044 (clj-edn-read-str "45e+43")))
- (should (= -4.5e-042 (clj-edn-read-str "-45e-43")))
- (should (= 4.5e+044 (clj-edn-read-str "45E+43"))))
-
-(ert-deftest lists ()
- :tags '(edn lists)
- (should-not (clj-edn-read-str "()"))
- (should (equal '(1 2 3) (clj-edn-read-str "( 1 2 3)")))
- (should (equal '(12.1 ?a foo :bar) (clj-edn-read-str "(12.1 \\a foo :bar)")))
- (should (equal '((:foo bar :bar 12)) (clj-edn-read-str "( (:foo bar :bar
12))")))
- (should (equal
- '(defproject com\.thortech/data\.edn "0.1.0-SNAPSHOT")
- (clj-edn-read-str "(defproject com.thortech/data.edn
\"0.1.0-SNAPSHOT\")"))))
-
-(ert-deftest vectors ()
- :tags '(edn vectors)
- (should (equal [] (clj-edn-read-str "[]")))
- (should (equal [] (clj-edn-read-str "[ ]")))
- (should (equal '[1 2 3] (clj-edn-read-str "[ 1 2 3 ]")))
- (should (equal '[12.1 ?a foo :bar] (clj-edn-read-str "[ 12.1 \\a foo
:bar]")))
- (should (equal '[[:foo bar :bar 12]] (clj-edn-read-str "[[:foo bar :bar
12]]")))
- (should (equal '[( :foo bar :bar 12 ) "foo"]
- (clj-edn-read-str "[(:foo bar :bar 12) \"foo\"]")))
- (should (equal '[/ \. * ! _ \? $ % & = - +]
- (clj-edn-read-str "[/ . * ! _ ? $ % & = - +]")))
- (should (equal
- ;;[99 newline return space tab]
- [99 10 13 32 9]
- (clj-edn-read-str "[\\c \\newline \\return \\space \\tab]"))))
-
-(defun map-equal (m1 m2)
- (and (and (hash-table-p m1) (hash-table-p m2))
- (eq (hash-table-test m1) (hash-table-test m2))
- (= (hash-table-count m1) (hash-table-count m2))
- (equal (hash-table-keys m1) (hash-table-keys m2))
- (equal (hash-table-values m1) (hash-table-values m2))))
-
-(defun make-seeded-hash-table (&rest keys-and-values)
- (let ((m (make-hash-table :test #'equal)))
- (while keys-and-values
- (puthash (pop keys-and-values) (pop keys-and-values) m))
- m))
-
-(ert-deftest maps ()
- :tags '(edn maps)
- (should (hash-table-p (clj-edn-read-str "{ }")))
- (should (hash-table-p (clj-edn-read-str "{}")))
- (should (map-equal (make-seeded-hash-table :foo :bar :baz :qux)
- (clj-edn-read-str "{ :foo :bar :baz :qux}")))
- (should (map-equal (make-seeded-hash-table 1 "123" 'vector [1 2 3])
- (clj-edn-read-str "{ 1 \"123\" vector [1 2 3]}")))
- (should (map-equal (make-seeded-hash-table [1 2 3] "some numbers")
- (clj-edn-read-str "{[1 2 3] \"some numbers\"}"))))
-
-(ert-deftest sets ()
- :tags '(edn sets)
- (should (eq 'edn-set (car (clj-edn-read-str "#{}"))))
- (should (eq 'edn-set (car (clj-edn-read-str "#{ }"))))
- (should (equal '(edn-set (1 2 3)) (clj-edn-read-str "#{1 2 3}")))
- (should (equal '(edn-set (1 [1 2 3] 3)) (clj-edn-read-str "#{1 [1 2 3]
3}"))))
-
-(ert-deftest comment ()
- :tags '(edn comments)
- (should-not (clj-edn-read-str ";nada"))
- (should (equal 1 (clj-edn-read-str ";; comment
-1")))
- (should (equal [1 2 3] (clj-edn-read-str "[1 2 ;comment to eol
-3]")))
- (should (equal '[valid more items] (clj-edn-read-str "[valid;touching
trailing comment
- more items]")))
- (should (equal [valid vector more vector items] (clj-edn-read-str "[valid
vector
- ;;comment in vector
- more vector items]"))))
-
-(defun test-val-passed-to-handler (val)
- (should (listp val))
- (should (= (length val) 2))
- (should (= 1 (car val)))
- 1)
-
-(setq clj-edn-test-extra-handlers
- (a-list
- 'my/type #'test-val-passed-to-handler
- 'my/other-type (lambda (val) 2)))
-
-(ert-deftest tags ()
- :tags '(edn tags)
- (should-error (clj-edn-read-str "#my/type value"
clj-edn-test-extra-handlers))
- (should (= 1 (clj-edn-read-str "#my/type (1 2)"
clj-edn-test-extra-handlers)))
- (should (= 2 (clj-edn-read-str "#my/other-type {:foo :bar}"
clj-edn-test-extra-handlers)))
- (should-error (clj-edn-read-str "#myapp/Person {:first \"Fred\" :last
\"Mertz\"}")))
-
-(ert-deftest roundtrip ()
- :tags '(edn roundtrip)
- (let ((data [1 2 3 :foo (4 5) qux "quux"]))
- (should (equal data (clj-edn-read-str (clj-edn-print-str data))))
- (should (map-equal (make-seeded-hash-table :foo :bar)
- (clj-edn-read-str (clj-edn-print-str
(make-seeded-hash-table :foo :bar)))))
- (should (equal '(edn-set (1 2 3 [3 1.11]))
- (clj-edn-read-str (clj-edn-print-str '(edn-set (1 2 3 [3
1.11]))))))))
-
-(ert-deftest inst ()
- :tags '(edn inst)
- (let* ((inst-str "#inst \"1985-04-12T23:20:50.52Z\"")
- (inst (clj-edn-read-str inst-str))
- (time (date-to-time "1985-04-12T23:20:50.52Z")))
- (should (eq 'edn-inst (car inst)))
- (should (equal time (cdr inst)))))
-
-(ert-deftest uuid ()
- :tags '(edn uuid)
- (let* ((str "f81d4fae-7dec-11d0-a765-00a0c91e6bf6")
- (uuid (clj-edn-read-str (concat "#uuid \"" str "\""))))
- (should (eq 'edn-uuid (car uuid)))))
-
-;; (ert-deftest invalid-edn ()
-;; (should-error (clj-edn-read-str "///"))
-;; (should-error (clj-edn-read-str "~cat"))
-;; (should-error (clj-edn-read-str "foo/bar/baz/qux/quux"))
-;; (should-error (clj-edn-read-str "#foo/"))
-;; (should-error (clj-edn-read-str "foo/"))
-;; (should-error (clj-edn-read-str ":foo/"))
-;; (should-error (clj-edn-read-str "#/foo"))
-;; (should-error (clj-edn-read-str "/symbol"))
-;; (should-error (clj-edn-read-str ":/foo"))
-;; (should-error (clj-edn-read-str "+5symbol"))
-;; (should-error (clj-edn-read-str ".\\newline"))
-;; (should-error (clj-edn-read-str "0cat"))
-;; (should-error (clj-edn-read-str "-4cats"))
-;; (should-error (clj-edn-read-str ".9"))
-;; (should-error (clj-edn-read-str ":keyword/with/too/many/slashes"))
-;; (should-error (clj-edn-read-str ":a.b.c/"))
-;; (should-error (clj-edn-read-str "\\itstoolong"))
-;; (should-error (clj-edn-read-str ":#/:"))
-;; (should-error (clj-edn-read-str "/foo//"))
-;; (should-error (clj-edn-read-str "///foo"))
-;; (should-error (clj-edn-read-str ":{}"))
-;; (should-error (clj-edn-read-str "//"))
-;; (should-error (clj-edn-read-str "##"))
-;; (should-error (clj-edn-read-str "::"))
-;; (should-error (clj-edn-read-str "::a"))
-;; (should-error (clj-edn-read-str ".5symbol"))
-;; (should-error (clj-edn-read-str "{ \"foo\""))
-;; (should-error (clj-edn-read-str "{ \"foo\" :bar"))
-;; (should-error (clj-edn-read-str "{"))
-;; (should-error (clj-edn-read-str ":{"))
-;; (should-error (clj-edn-read-str "{{"))
-;; (should-error (clj-edn-read-str "}"))
-;; (should-error (clj-edn-read-str ":}"))
-;; (should-error (clj-edn-read-str "}}"))
-;; (should-error (clj-edn-read-str "#:foo"))
-;; (should-error (clj-edn-read-str "\\newline."))
-;; (should-error (clj-edn-read-str "\\newline0.1"))
-;; (should-error (clj-edn-read-str "^"))
-;; (should-error (clj-edn-read-str ":^"))
-;; (should-error (clj-edn-read-str "_:^"))
-;; (should-error (clj-edn-read-str "#{{[}}"))
-;; (should-error (clj-edn-read-str "[}"))
-;; (should-error (clj-edn-read-str "@cat")))
-
-;;; edn-el-parity-test.el ends here
diff --git a/test/clj-lex-test.el b/test/clj-lex-test.el
deleted file mode 100644
index ae8325b741..0000000000
--- a/test/clj-lex-test.el
+++ /dev/null
@@ -1,295 +0,0 @@
-;;; clj-lex-test.el --- Unit tests for the lexer
-
-;; 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
-
-;; Unit tests for the lexer
-
-;;; Code
-
-(require 'ert)
-(require 'clj-lex)
-
-(ert-deftest clj-lex-test-next ()
- (with-temp-buffer
- (insert "()")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :lparen) (form . "(") (pos . 1))))
- (should (equal (clj-lex-next) '((type . :rparen) (form . ")") (pos . 2))))
- (should (equal (clj-lex-next) '((type . :eof) (form . nil) (pos . 3)))))
-
- (with-temp-buffer
- (insert "123")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :number)
- (form . "123")
- (pos . 1)))))
-
- (with-temp-buffer
- (insert "123e34M")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :number)
- (form . "123e34M")
- (pos . 1)))))
-
- (with-temp-buffer
- (insert "123x")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :lex-error "123x" 1
'error-type :invalid-number-format))))
-
- (with-temp-buffer
- (insert " \t \n")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :whitespace) (form . " \t \n")
(pos . 1)))))
-
- (with-temp-buffer
- (insert "nil")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :nil) (form . "nil") (pos . 1)))))
-
- (with-temp-buffer
- (insert "true")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :true) (form . "true") (pos .
1)))))
-
- (with-temp-buffer
- (insert "false")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :false) (form . "false") (pos .
1)))))
-
- (with-temp-buffer
- (insert "hello-world")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :symbol) (form . "hello-world")
(pos . 1)))))
-
- (with-temp-buffer
- (insert "-hello-world")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :symbol) (form . "-hello-world")
(pos . 1)))))
-
- (with-temp-buffer
- (insert "foo#")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :symbol) (form . "foo#") (pos .
1)))))
-
- (with-temp-buffer
- (insert "#inst")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :tag) (form . "#inst") (pos .
1)))))
-
- (with-temp-buffer
- (insert "#qualified/tag")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :tag) (form . "#qualified/tag")
(pos . 1)))))
-
- (with-temp-buffer
- (insert "\\newline\\return\\space\\tab\\a\\b\\c")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :character "\\newline" 1)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\return" 9)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\space" 16)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\tab" 22)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\a" 26)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\b" 28)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\c" 30))))
-
- (with-temp-buffer
- (insert "\\newline\\return\\space\\tab\\a\\b\\c")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :character "\\newline" 1)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\return" 9)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\space" 16)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\tab" 22)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\a" 26)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\b" 28)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\c" 30))))
-
- (with-temp-buffer
- (insert "\\u0078\\o170")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :character "\\u0078" 1)))
- (should (equal (clj-lex-next) (clj-lex-token :character "\\o170" 7))))
-
- (with-temp-buffer
- (insert "\"\\u0078\\o170\"")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :string "\"\\u0078\\o170\""
1))))
-
- (with-temp-buffer
- (insert ":hello-world")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :keyword ":hello-world" 1))))
-
- (with-temp-buffer
- (insert ":hello/world")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :keyword ":hello/world" 1))))
-
- (with-temp-buffer
- (insert "::hello-world")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :keyword "::hello-world" 1))))
-
- (with-temp-buffer
- (insert ":::hello-world")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :lex-error ":::" 1
'error-type :invalid-keyword))))
-
- (with-temp-buffer
- (insert "[123]")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :lbracket "[" 1)))
- (should (equal (clj-lex-next) (clj-lex-token :number "123" 2)))
- (should (equal (clj-lex-next) (clj-lex-token :rbracket "]" 5))))
-
- (with-temp-buffer
- (insert "{:count 123}")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :lbrace "{" 1)))
- (should (equal (clj-lex-next) (clj-lex-token :keyword ":count" 2)))
- (should (equal (clj-lex-next) (clj-lex-token :whitespace " " 8)))
- (should (equal (clj-lex-next) (clj-lex-token :number "123" 9)))
- (should (equal (clj-lex-next) (clj-lex-token :rbrace "}" 12))))
-
- (with-temp-buffer
- (insert "#{:x}")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :set "#{" 1)))
- (should (equal (clj-lex-next) (clj-lex-token :keyword ":x" 3)))
- (should (equal (clj-lex-next) (clj-lex-token :rbrace "}" 5))))
-
- (with-temp-buffer
- (insert "(10 #_11 12 #_#_ 13 14)")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :lparen "(" 1)))
- (should (equal (clj-lex-next) (clj-lex-token :number "10" 2)))
- (should (equal (clj-lex-next) (clj-lex-token :whitespace " " 4)))
- (should (equal (clj-lex-next) (clj-lex-token :discard "#_" 5)))
- (should (equal (clj-lex-next) (clj-lex-token :number "11" 7)))
- (should (equal (clj-lex-next) (clj-lex-token :whitespace " " 9)))
- (should (equal (clj-lex-next) (clj-lex-token :number "12" 10)))
- (should (equal (clj-lex-next) (clj-lex-token :whitespace " " 12)))
- (should (equal (clj-lex-next) (clj-lex-token :discard "#_" 13)))
- (should (equal (clj-lex-next) (clj-lex-token :discard "#_" 15)))
- (should (equal (clj-lex-next) (clj-lex-token :whitespace " " 17)))
- (should (equal (clj-lex-next) (clj-lex-token :number "13" 18)))
- (should (equal (clj-lex-next) (clj-lex-token :whitespace " " 20)))
- (should (equal (clj-lex-next) (clj-lex-token :number "14" 21)))
- (should (equal (clj-lex-next) (clj-lex-token :rparen ")" 23)))))
-
-(ert-deftest clj-lex-test-at-number? ()
- (dolist (str '("123" ".9" "+1" "0" "-456"))
- (with-temp-buffer
- (insert str)
- (goto-char 1)
- (should (equal (clj-lex-at-number?) t))))
-
- (dolist (str '("a123" "$.9" "+/1" "++0" "-"))
- (with-temp-buffer
- (insert str)
- (goto-char 1)
- (should (equal (clj-lex-at-number?) nil)))))
-
-(ert-deftest clj-lex-test-token ()
- (should (equal (clj-lex-token :whitespace ",,," 10)
- '((type . :whitespace)
- (form . ",,,")
- (pos . 10)))))
-
-(ert-deftest clj-lex-test-digit? ()
- (should (equal (clj-lex-digit? ?0) t))
- (should (equal (clj-lex-digit? ?5) t))
- (should (equal (clj-lex-digit? ?9) t))
- (should (equal (clj-lex-digit? ?a) nil))
- (should (equal (clj-lex-digit? ?-) nil)))
-
-(ert-deftest clj-lex-test-symbol-start? ()
- (should (equal (clj-lex-symbol-start? ?0) nil))
- (should (equal (clj-lex-symbol-start? ?a) t))
- (should (equal (clj-lex-symbol-start? ?A) t))
- (should (equal (clj-lex-symbol-start? ?.) t))
- (should (equal (clj-lex-symbol-start? ?. t) nil))
- (should (equal (clj-lex-symbol-start? ?~) nil))
- (should (equal (clj-lex-symbol-start? ? ) nil)))
-
-(ert-deftest clj-lex-test-symbol-rest? ()
- (should (equal (clj-lex-symbol-rest? ?0) t))
- (should (equal (clj-lex-symbol-rest? ?a) t))
- (should (equal (clj-lex-symbol-rest? ?A) t))
- (should (equal (clj-lex-symbol-rest? ?.) t))
- (should (equal (clj-lex-symbol-rest? ?~) nil))
- (should (equal (clj-lex-symbol-rest? ? ) nil)))
-
-(ert-deftest clj-lex-test-get-symbol-at-point ()
- (with-temp-buffer
- (insert "a-symbol")
- (goto-char 1)
- (should (equal (clj-lex-get-symbol-at-point 1) "a-symbol"))
- (should (equal (point) 9))))
-
-(ert-deftest clj-lex-test-invalid-tag ()
- (with-temp-buffer
- (insert "#.not-a-tag")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :lex-error) (form . "#.not-a-tag")
(pos . 1) (error-type . :invalid-hashtag-dispatcher)))))
-
- (with-temp-buffer
- (insert "#-not-a-tag")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :lex-error) (form . "#-not-a-tag")
(pos . 1) (error-type . :invalid-hashtag-dispatcher)))))
-
- (with-temp-buffer
- (insert "#+not-a-tag")
- (goto-char 1)
- (should (equal (clj-lex-next) '((type . :lex-error) (form . "#+not-a-tag")
(pos . 1) (error-type . :invalid-hashtag-dispatcher))))))
-
-(ert-deftest clj-lex-test-string ()
- (with-temp-buffer
- (insert "\"abc\"")
- (goto-char 1)
- (should (equal (clj-lex-string) (clj-lex-token :string "\"abc\"" 1))))
-
- (with-temp-buffer
- (insert "\"abc")
- (goto-char 1)
- (should (equal (clj-lex-string) (clj-lex-token :lex-error "\"abc" 1))))
-
- (with-temp-buffer
- (insert "\"abc\\\"\"")"abc\""
- (goto-char 1)
- (should (equal (clj-lex-string) (clj-lex-token :string "\"abc\\\"\"" 1)))))
-
-(ert-deftest clj-lex-test-tag ()
- (with-temp-buffer
- (insert "#inst")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :tag "#inst" 1))))
-
- (with-temp-buffer
- (insert "#foo/bar")
- (goto-char 1)
- (should (equal (clj-lex-next) (clj-lex-token :tag "#foo/bar" 1)))))
-
-(provide 'clj-lex-test)
-
-;;; clj-lex-test.el ends here
diff --git a/test/clj-ast-test.el b/test/parseclj-ast-test.el
similarity index 62%
rename from test/clj-ast-test.el
rename to test/parseclj-ast-test.el
index 5b383da516..0245dda8cd 100644
--- a/test/clj-ast-test.el
+++ b/test/parseclj-ast-test.el
@@ -1,4 +1,4 @@
-;;; clj-ast-test.el --- Unit tests for AST parsing/unparsing
+;;; parseclj-ast-test.el --- Unit tests for AST parsing/unparsing
;; Copyright (C) 2017 Arne Brasseur
@@ -28,41 +28,41 @@
;;; Code
(require 'ert)
-(require 'clj-ast)
+(require 'parseclj-ast)
-(load "test/clj-parse-test-data.el")
+(load "test/parseclj-test-data.el")
-(defmacro define-clj-ast-parse-tests ()
+(defmacro define-parseclj-parse-clojure-tests ()
`(progn
,@(mapcar
(lambda (pair)
(let ((name (car pair))
(data (cdr pair)))
(if (and (a-get data :source) (a-get data :ast))
- (let ((test-name (intern (concat "clj-ast-parse:" name))))
+ (let ((test-name (intern (concat "parseclj-parse-clojure:"
name))))
`(ert-deftest ,test-name ()
- :tags '(clj-ast)
+ :tags '(parseclj-ast)
(with-temp-buffer
(insert ,(a-get data :source))
(goto-char 1)
- (should (a-equal (clj-ast-parse) ',(a-get data
:ast)))))))))
- clj-parse-test-data)))
+ (should (a-equal (parseclj-parse-clojure) ',(a-get data
:ast)))))))))
+ parseclj-test-data)))
-(defmacro define-clj-ast-roundtrip-tests ()
+(defmacro define-parseclj-ast-roundtrip-tests ()
`(progn
,@(mapcar
(lambda (pair)
(let ((name (car pair))
(data (cdr pair)))
(if (and (a-get data :ast) (a-get data :source))
- (let ((test-name (intern (concat "clj-ast-rountrip:" name))))
+ (let ((test-name (intern (concat "parseclj-ast-rountrip:"
name))))
`(ert-deftest ,test-name ()
- :tags '(clj-ast-rountrip)
- (should (a-equal (clj-ast-parse-str (clj-ast-unparse-str
',(a-get data :ast))) ',(a-get data :ast))))))))
- clj-parse-test-data)))
+ :tags '(parseclj-ast-rountrip)
+ (should (a-equal (parseclj-parse-clojure
(parseclj-unparse-clojure-to-string ',(a-get data :ast))) ',(a-get data
:ast))))))))
+ parseclj-test-data)))
-(define-clj-ast-roundtrip-tests)
-(define-clj-ast-parse-tests)
+(define-parseclj-ast-roundtrip-tests)
+(define-parseclj-parse-clojure-tests)
-;;; clj-ast-test.el ends here
+;;; parseclj-ast-test.el ends here
diff --git a/test/parseclj-lex-test.el b/test/parseclj-lex-test.el
new file mode 100644
index 0000000000..6e96522fbc
--- /dev/null
+++ b/test/parseclj-lex-test.el
@@ -0,0 +1,298 @@
+;;; parseclj-lex-test.el --- Unit tests for the lexer
+
+;; 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
+
+;; Unit tests for the lexer
+
+;;; Code
+
+(require 'ert)
+(require 'parseclj-lex)
+
+(ert-deftest parseclj-lex-test-next ()
+ (with-temp-buffer
+ (insert "()")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :lparen) (:form . "(")
(:pos . 1))))
+ (should (equal (parseclj-lex-next) '((:token-type . :rparen) (:form . ")")
(:pos . 2))))
+ (should (equal (parseclj-lex-next) '((:token-type . :eof) (:form . nil)
(:pos . 3)))))
+
+ (with-temp-buffer
+ (insert "123")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :number)
+ (:form . "123")
+ (:pos . 1)))))
+
+ (with-temp-buffer
+ (insert "123e34M")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :number)
+ (:form . "123e34M")
+ (:pos . 1)))))
+
+ (with-temp-buffer
+ (insert "123x")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :lex-error "123x" 1
:error-type :invalid-number-format))))
+
+ (with-temp-buffer
+ (insert " \t \n")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :whitespace) (:form .
" \t \n") (:pos . 1)))))
+
+ (with-temp-buffer
+ (insert "nil")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :nil) (:form . "nil")
(:pos . 1)))))
+
+ (with-temp-buffer
+ (insert "true")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :true) (:form .
"true") (:pos . 1)))))
+
+ (with-temp-buffer
+ (insert "false")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :false) (:form .
"false") (:pos . 1)))))
+
+ (with-temp-buffer
+ (insert "hello-world")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :symbol) (:form .
"hello-world") (:pos . 1)))))
+
+ (with-temp-buffer
+ (insert "-hello-world")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :symbol) (:form .
"-hello-world") (:pos . 1)))))
+
+ (with-temp-buffer
+ (insert "foo#")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :symbol) (:form .
"foo#") (:pos . 1)))))
+
+ (with-temp-buffer
+ (insert "#inst")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :tag) (:form .
"#inst") (:pos . 1)))))
+
+ (with-temp-buffer
+ (insert "#qualified/tag")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) '((:token-type . :tag) (:form .
"#qualified/tag") (:pos . 1)))))
+
+ (with-temp-buffer
+ (insert "\\newline\\return\\space\\tab\\a\\b\\c")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character
"\\newline" 1)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character
"\\return" 9)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character
"\\space" 16)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character "\\tab"
22)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character "\\a"
26)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character "\\b"
28)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character "\\c"
30))))
+
+ (with-temp-buffer
+ (insert "\\newline\\return\\space\\tab\\a\\b\\c")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character
"\\newline" 1)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character
"\\return" 9)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character
"\\space" 16)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character "\\tab"
22)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character "\\a"
26)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character "\\b"
28)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character "\\c"
30))))
+
+ (with-temp-buffer
+ (insert "\\u0078\\o170")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character
"\\u0078" 1)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :character "\\o170"
7))))
+
+ (with-temp-buffer
+ (insert "\"\\u0078\\o170\"")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :string
"\"\\u0078\\o170\"" 1))))
+
+ (with-temp-buffer
+ (insert ":hello-world")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :keyword
":hello-world" 1))))
+
+ (with-temp-buffer
+ (insert ":hello/world")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :keyword
":hello/world" 1))))
+
+ (with-temp-buffer
+ (insert "::hello-world")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :keyword
"::hello-world" 1))))
+
+ (with-temp-buffer
+ (insert ":::hello-world")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :lex-error ":::" 1
:error-type :invalid-keyword))))
+
+ (with-temp-buffer
+ (insert "[123]")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :lbracket "[" 1)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :number "123" 2)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :rbracket "]" 5))))
+
+ (with-temp-buffer
+ (insert "{:count 123}")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :lbrace "{" 1)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :keyword ":count"
2)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :whitespace " " 8)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :number "123" 9)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :rbrace "}" 12))))
+
+ (with-temp-buffer
+ (insert "#{:x}")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :set "#{" 1)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :keyword ":x" 3)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :rbrace "}" 5))))
+
+ (with-temp-buffer
+ (insert "(10 #_11 12 #_#_ 13 14)")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :lparen "(" 1)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :number "10" 2)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :whitespace " " 4)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :discard "#_" 5)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :number "11" 7)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :whitespace " " 9)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :number "12" 10)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :whitespace " "
12)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :discard "#_" 13)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :discard "#_" 15)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :whitespace " "
17)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :number "13" 18)))
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :whitespace " "
20)))
+ (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? ()
+ (dolist (str '("123" ".9" "+1" "0" "-456"))
+ (with-temp-buffer
+ (insert str)
+ (goto-char 1)
+ (should (equal (parseclj-lex-at-number?) t))))
+
+ (dolist (str '("a123" "$.9" "+/1" "++0" "-"))
+ (with-temp-buffer
+ (insert str)
+ (goto-char 1)
+ (should (equal (parseclj-lex-at-number?) nil)))))
+
+(ert-deftest parseclj-lex-test-token ()
+ (should (equal (parseclj-lex-token :whitespace ",,," 10)
+ '((:token-type . :whitespace)
+ (: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-get-symbol-at-point ()
+ (with-temp-buffer
+ (insert "a-symbol")
+ (goto-char 1)
+ (should (equal (parseclj-lex-get-symbol-at-point 1) "a-symbol"))
+ (should (equal (point) 9))))
+
+(ert-deftest parseclj-lex-test-invalid-tag ()
+ (with-temp-buffer
+ (insert "#.not-a-tag")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next)
+ (parseclj-lex-token :lex-error "#.not-a-tag" 1 :error-type
:invalid-hashtag-dispatcher))))
+
+ (with-temp-buffer
+ (insert "#-not-a-tag")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next)
+ (parseclj-lex-token :lex-error "#-not-a-tag" 1 :error-type
:invalid-hashtag-dispatcher))))
+
+ (with-temp-buffer
+ (insert "#+not-a-tag")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next)
+ (parseclj-lex-token :lex-error "#+not-a-tag" 1 :error-type
:invalid-hashtag-dispatcher)))))
+
+(ert-deftest parseclj-lex-test-string ()
+ (with-temp-buffer
+ (insert "\"abc\"")
+ (goto-char 1)
+ (should (equal (parseclj-lex-string) (parseclj-lex-token :string "\"abc\""
1))))
+
+ (with-temp-buffer
+ (insert "\"abc")
+ (goto-char 1)
+ (should (equal (parseclj-lex-string) (parseclj-lex-token :lex-error
"\"abc" 1))))
+
+ (with-temp-buffer
+ (insert "\"abc\\\"\"")"abc\""
+ (goto-char 1)
+ (should (equal (parseclj-lex-string) (parseclj-lex-token :string
"\"abc\\\"\"" 1)))))
+
+(ert-deftest parseclj-lex-test-tag ()
+ (with-temp-buffer
+ (insert "#inst")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :tag "#inst" 1))))
+
+ (with-temp-buffer
+ (insert "#foo/bar")
+ (goto-char 1)
+ (should (equal (parseclj-lex-next) (parseclj-lex-token :tag "#foo/bar"
1)))))
+
+(provide 'parseclj-lex-test)
+
+;;; parseclj-lex-test.el ends here
diff --git a/test/clj-parse-test-data.el b/test/parseclj-test-data.el
similarity index 95%
rename from test/clj-parse-test-data.el
rename to test/parseclj-test-data.el
index d6f5645d9d..8ec8a000b6 100644
--- a/test/clj-parse-test-data.el
+++ b/test/parseclj-test-data.el
@@ -1,4 +1,4 @@
-;;; clj-parse-test-data.el --- Clojure/EDN parser - test data
+;;; parseclj-test-data.el --- Clojure/EDN parser - test data
;; Copyright (C) 2017 Arne Brasseur
@@ -27,7 +27,7 @@
;;; Code:
-(setq clj-parse-test-data
+(setq parseclj-test-data
(a-list
"simple-list"
@@ -36,7 +36,7 @@
:source "(1 2 3)"
:edn '((1 2 3))
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :list)
(:position . 1)
(:children . (((:node-type . :number)
@@ -58,7 +58,7 @@
:source "()"
:edn '(())
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :list)
(:position . 1)
(:children . nil))))))
@@ -69,7 +69,7 @@
:source "(1)"
:edn '((1))
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :list)
(:position . 1)
(:children . (((:node-type . :number)
@@ -82,7 +82,7 @@
:source "(nil true false hello-world)"
:edn '((nil t nil hello-world))
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :list)
(:position . 1)
(:children . (((:node-type . :nil)
@@ -108,7 +108,7 @@
:source "clojure.string/join"
:edn '(clojure.string/join)
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :symbol)
(:position . 1)
(:form . "clojure.string/join")
@@ -119,7 +119,7 @@
:source "((.9 abc (true) (hello)))"
:edn '(((0.9 abc (t) (hello))))
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :list)
(:position . 1)
(:children . (((:node-type . :list)
@@ -151,7 +151,7 @@
:source "\"abc hello \\t\\\"x\""
:edn '("abc hello \t\"x")
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :string)
(:position . 1)
(:form . "\"abc hello \\t\\\"x\"")
@@ -162,7 +162,7 @@
:source "(\"---\\f---\\\"-'\\'-\\\\-\\r\\n\")"
:edn '(("---\f---\"-''-\\-\r\n"))
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :list)
(:position . 1)
(:children . (((:node-type . :string)
@@ -175,7 +175,7 @@
:source "(\\newline \\return \\space \\tab \\a \\b \\c \\u0078 \\o171)"
:edn '((?\n ?\r ?\ ?\t ?a ?b ?c ?x ?y))
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :list)
(:position . 1)
(:children . (((:node-type . :character) (:position
. 2) (:form . "\\newline") (:value . ?\n))
@@ -193,7 +193,7 @@
:source "\"\\u0078 \\o171\""
:edn '("x y")
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :string)
(:position . 1)
(:form . "\"\\u0078 \\o171\"")
@@ -205,7 +205,7 @@
:source ":foo-bar"
:edn '(:foo-bar)
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :keyword)
(:position . 1)
(:form . ":foo-bar")
@@ -217,7 +217,7 @@
:source "[123]"
:edn '([123])
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :vector)
(:position . 1)
(:children . (((:node-type . :number)
@@ -231,7 +231,7 @@
:source "{:count 123}"
:edn (list (a-hash-table :count 123))
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :map)
(:position . 1)
(:children . (((:node-type . :keyword)
@@ -249,7 +249,7 @@
:source "#{:x}"
:edn '((edn-set (:x)))
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :set)
(:position . 1)
(:children . (((:node-type . :keyword)
@@ -262,7 +262,7 @@
:source "(10 #_11 12 #_#_ 13 14)"
:edn '((10 12))
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :list)
(:position . 1)
(:children . (((:node-type . :number)
@@ -279,7 +279,7 @@
(a-list
:source "#foo/bar [1]"
:ast '((:node-type . :root)
- (:position . 0)
+ (:position . 1)
(:children . (((:node-type . :tag)
(:position . 1)
(:tag . foo/bar)
@@ -295,4 +295,4 @@
:source "[nil true false]"
:edn '([nil t nil]))))
-;;; clj-parse-test-data.el ends here
+;;; parseclj-test-data.el ends here
diff --git a/test/parseclj-test.el b/test/parseclj-test.el
new file mode 100644
index 0000000000..1809464141
--- /dev/null
+++ b/test/parseclj-test.el
@@ -0,0 +1,269 @@
+;;; parseclj-test.el --- Clojure/EDN parser - tests
+
+;; 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:
+
+;; A reader for EDN data files and parser for Clojure source files - tests
+
+;;; Code:
+
+(require 'ert)
+(require 'parseclj)
+
+(ert-deftest parseclj-parse-clojure-with-lexical-preservation-test ()
+ (should (equal
+ (parseclj-parse-clojure ";; foo\nbar")
+ '((:node-type . :root)
+ (:position . 1)
+ (:children ((:node-type . :symbol)
+ (:position . 8)
+ (:form . "bar")
+ (:value . bar))))))
+ (should (equal
+ (parseclj-parse-clojure ";; foo\nbar" :lexical-preservation t)
+ '((:node-type . :root)
+ (:lexical-preservation . t)
+ (:position . 1)
+ (:children ((:node-type . :comment)
+ (:position . 1)
+ (:form . ";; foo\n"))
+ ((:node-type . :symbol)
+ (:position . 8)
+ (:form . "bar")
+ (:value . bar))))))
+ (should (equal
+ (parseclj-parse-clojure ";; foo\n;;baz\nbar" :lexical-preservation
t)
+ '((:node-type . :root)
+ (:lexical-preservation . t)
+ (:position . 1)
+ (:children ((:node-type . :comment)
+ (:position . 1)
+ (:form . ";; foo\n;;baz\n"))
+ ((:node-type . :symbol)
+ (:position . 14)
+ (:form . "bar")
+ (:value . bar)))))))
+
+(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"))
+
+ (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"))
+
+ (should (equal (parseclj-parse-clojure "(1 [2 {3 ( 4}])" :fail-fast nil)
+ '((:node-type . :root)
+ (:position . 1)
+ (:children ((:node-type . :list)
+ (:position . 1)
+ (:children ((:node-type . :number)
+ (:position . 2)
+ (:form . "1")
+ (:value . 1))
+ ((:node-type . :vector)
+ (:position . 4)
+ (:children ((:node-type . :number)
+ (:position . 5)
+ (:form . "2")
+ (:value . 2))
+ ((:node-type . :map)
+ (:position . 7)
+ (:children ((:node-type
. :number) (:position . 8) (:form . "3") (:value . 3))
+
((:token-type . :lparen) (:form . "(") (:pos . 10))
+ ((:node-type
. :number) (:position . 12) (:form . "4") (:value . 4))))))))))))
+
+ ;; TODO: uneven map forms
+ )
+
+(ert-deftest parseclj-parse-clojure-lexical-preservation ()
+ (should (equal
+ (parseclj-parse-clojure "#_ (1 2 3) true")
+ '((:node-type . :root) (:position . 1) (:children ((:node-type .
:true) (:position . 12) (:form . "true") (:value . t))))))
+ (should (equal
+ (parseclj-parse-clojure "#_(1 2 3) true" :lexical-preservation t)
+ '((:node-type . :root)
+ (:lexical-preservation . t)
+ (:position . 1)
+ (:children ((:node-type . :discard)
+ (:position . 1)
+ (:children ((:node-type . :list)
+ (:lexical-preservation . t)
+ (:position . 3)
+ (:children ((:node-type . :number)
(:position . 4) (:form . "1") (:value . 1))
+ ((:node-type . :whitespace)
(:position . 5) (:form . " "))
+ ((:node-type . :number)
(:position . 6) (:form . "2") (:value . 2))
+ ((:node-type . :whitespace)
(:position . 7) (:form . " "))
+ ((:node-type . :number)
(:position . 8) (:form . "3") (:value . 3))))))
+ ((:node-type . :whitespace)
+ (:position . 10)
+ (:form . " "))
+ ((:node-type . :true)
+ (:position . 11)
+ (:form . "true")
+ (:value . t))))))
+
+ (should (equal
+ (parseclj-parse-clojure "#_ (1 2 3) true" :lexical-preservation t)
+ '((:node-type . :root)
+ (:lexical-preservation . t)
+ (:position . 1)
+ (:children ((:node-type . :discard)
+ (:position . 1)
+ (:children
+ ((:node-type . :whitespace) (:position . 3) (:form .
" "))
+ ((:node-type . :list)
+ (:lexical-preservation . t)
+ (:position . 4)
+ (:children ((:node-type . :number) (:position . 5)
(:form . "1") (:value . 1))
+ ((:node-type . :whitespace) (:position .
6) (:form . " "))
+ ((:node-type . :number) (:position . 7)
(:form . "2") (:value . 2))
+ ((:node-type . :whitespace) (:position .
8) (:form . " "))
+ ((:node-type . :number) (:position . 9)
(:form . "3") (:value . 3))))))
+ ((:node-type . :whitespace)
+ (:position . 11)
+ (:form . " "))
+ ((:node-type . :true)
+ (:position . 12)
+ (:form . "true")
+ (:value . t))))))
+
+ (should (equal
+ (parseclj-parse-clojure "#_#_4 5" :lexical-preservation t)
+ '((:node-type . :root)
+ (:lexical-preservation . t)
+ (:position . 1)
+ (:children ((:node-type . :discard)
+ (:position . 1)
+ (:children ((:node-type . :discard)
+ (:position . 3)
+ (:children ((:node-type . :number)
(:position . 5) (:form . "4") (:value . 4))))
+ ((:node-type . :whitespace) (:position .
6) (:form . " "))
+ ((:node-type . :number) (:position . 7)
(:form . "5") (:value . 5)))))))))
+
+(ert-deftest parseclj--take-token-test ()
+ (should (equal
+ (parseclj--take-token
+ (list (parseclj-ast-node :whitespace 10)
+ (parseclj-ast-node :comment 20)
+ (parseclj-lex-token :discard "#_" 30)
+ (parseclj-ast-node :comment 20))
+ (lambda (e)
+ (and (parseclj-ast-node? e)
+ (not (member (parseclj-ast-node-type e) '(:whitespace
:comment :discard)))))
+ '(:discard))
+ '(((:token-type . :discard) (:form . "#_") (:pos . 30))
+ ((:node-type . :comment) (:position . 20))
+ ((:node-type . :whitespace) (:position . 10)))))
+
+ (should (equal
+ (parseclj--take-token
+ (list (parseclj-ast-node :whitespace 10)
+ (parseclj-ast-node :number 20)
+ (parseclj-lex-token :discard "#_" 30)
+ (parseclj-ast-node :comment 20))
+ (lambda (e)
+ (and (parseclj-ast-node? e)
+ (not (member (parseclj-ast-node-type e) '(:whitespace
:comment :discard)))))
+ '(:discard))
+ nil)))
+
+(ert-deftest parseclj--take-value-test ()
+ (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)
+ (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)))))
+
+ (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)))
+
+ (should (equal top-value '(((:node-type . :number) (:position . 3)
(:form . "4") (:value . 4)))))
+ (should (equal opening-token '(((:token-type . :discard) (:form . "#_")
(:pos . 1)))))
+ (should (equal new-stack nil))))
+
+ (let ((stack '(((:node-type . :whitespace) (:position . 3) (:form . " "))
+ ((:token-type . :discard) (:form . "#_") (:pos . 1))))
+ (value-p (lambda (e)
+ (and (parseclj-ast-node? e)
+ (not (member (parseclj-ast-node-type e) '(:whitespace
:comment :discard)))))))
+
+ (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)))
+ top-value)))
+
+(provide 'parseclj-test)
+
+;;; parseclj-test.el ends here
diff --git a/test/parseclj-unparse-test.el b/test/parseclj-unparse-test.el
new file mode 100644
index 0000000000..3572567e8f
--- /dev/null
+++ b/test/parseclj-unparse-test.el
@@ -0,0 +1,184 @@
+;;; parseclj-unparse-test.el --- Print Clojure AST back to code - tests
+
+;; 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:
+
+;; Print Clojure AST back to code - tests
+
+;;; Code:
+
+(require 'ert)
+(require 'parseclj-ast)
+
+;;; Printer modes
+;; ----------------------------------------------------------------------------
+
+(ert-deftest parseclj-unparse-clojure-list ()
+ (should (equal "(0 1 2)"
+ (parseclj-unparse-clojure-to-string
+ '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . (((:node-type . :number)
+ (:position . 2)
+ (:form . "0")
+ (:value . 0))
+ ((:node-type . :number)
+ (:position . 4)
+ (:form . "1")
+ (:value . 1))
+ ((:node-type . :number)
+ (:position . 6)
+ (:form . "2")
+ (:value . 2))))))))))))
+
+(ert-deftest parseclj-unparse-clojure-empty-list ()
+ (should (equal "()"
+ (parseclj-unparse-clojure-to-string
+ '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :list)
+ (:position . 1)
+ (:children . nil)))))))))
+
+(ert-deftest parseclj-unparse-clojure-nested-list ()
+ (should (equal "((.9 abc (true) (hello)))"
+ (parseclj-unparse-clojure-to-string
+ '((: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))))))))))))))))
+
+(ert-deftest parseclj-unparse-clojure-to-stringing ()
+ (should (equal "\"abc hello \\t\\\"x\""
+ (parseclj-unparse-clojure-to-string
+ '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :string)
+ (:position . 1)
+ (:form . "\"abc hello \\t\\\"x\"")
+ (:value . "abc hello \t\"x")))))))))
+
+(ert-deftest parseclj-unparse-clojure-chars ()
+ (should (equal "(\\newline \\return \\space \\tab \\a \\b \\c \\u0078
\\o171)"
+ (parseclj-unparse-clojure-to-string
+ '((: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)))))))))
+ )))
+
+(ert-deftest parseclj-unparse-clojure-keyword ()
+ (should (equal ":foo-bar"
+ (parseclj-unparse-clojure-to-string
+ '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :keyword)
+ (:position . 1)
+ (:form . ":foo-bar")
+ (:value . :foo-bar)))))))))
+
+(ert-deftest parseclj-unparse-clojure-vector ()
+ (should (equal "[123]"
+ (parseclj-unparse-clojure-to-string
+ '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :vector)
+ (:position . 1)
+ (:children . (((:node-type . :number)
+ (:position . 2)
+ (:form . "123")
+ (:value . 123))))))))))))
+
+(ert-deftest parseclj-unparse-clojure-map ()
+ (should (equal "{:count 123}"
+ (parseclj-unparse-clojure-to-string
+ '((: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))))))))))))
+
+(ert-deftest parseclj-unparse-clojure-set ()
+ (should (equal "#{:x}"
+ (parseclj-unparse-clojure-to-string
+ '((:node-type . :root)
+ (:position . 1)
+ (:children . (((:node-type . :set)
+ (:position . 1)
+ (:children . (((:node-type . :keyword)
+ (:position . 3)
+ (:form . ":x")
+ (:value . :x))))))))))))
+
+(ert-deftest parseclj-unparse-clojure-lexical ()
+ (let ((src ";; hello world
+ (+ 1 2
+ ;;good stuff
+ 3)"))
+ (should (equal src (thread-first src
+ (parseclj-parse-clojure :lexical-preservation t)
+ (parseclj-unparse-clojure-to-string))))))
+
+(provide 'parseclj-unparse-test)
+
+;;; parseclj-unparse-test.el ends here
diff --git a/test/parseedn-el-parity-test.el b/test/parseedn-el-parity-test.el
new file mode 100644
index 0000000000..c58641a4f3
--- /dev/null
+++ b/test/parseedn-el-parity-test.el
@@ -0,0 +1,286 @@
+;;; edn-el-parity.el --- Tests from edn.el
+
+;; Author: Lars Andersen <expez@expez.com>, Arne Brasseur
<arne@arnebrasseur.net>
+
+;; Copyright (C) 2015 Lars Andersen
+
+;; 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:
+
+;; These tests are copied verbatim from the edn.el source, and adapted to use
+;; our API. This way we assure that parseclj can act as a drop-in replacement
+;; for edn.el.
+
+;;; Code:
+
+(require 'ert)
+(require 'parseclj)
+(eval-when-compile (require 'subr-x)) ;; for things like hash-table-keys
+
+(ert-deftest whitespace ()
+ (should (null (parseedn-read-str "")))
+ (should (null (parseedn-read-str " ")))
+ (should (null (parseedn-read-str " ")))
+ (should (null (parseedn-read-str " ")))
+ (should (null (parseedn-read-str " ")))
+ (should (null (parseedn-read-str ",")))
+ (should (null (parseedn-read-str ",,,,")))
+ (should (null (parseedn-read-str " , ,\n")))
+ (should (null (parseedn-read-str "\n ,, ")))
+ (should (equal [a b c d] (parseedn-read-str "[a ,,,,,, b,,,,,c ,d]"))))
+
+(ert-deftest symbols ()
+ :tags '(edn symbol)
+ (should (equal 'foo (parseedn-read-str "foo")))
+ (should (equal 'foo\. (parseedn-read-str "foo.")))
+ (should (equal '%foo\. (parseedn-read-str "%foo.")))
+ (should (equal 'foo/bar (parseedn-read-str "foo/bar")))
+ (equal 'some\#sort\#of\#symbol (parseedn-read-str "some#sort#of#symbol"))
+ (equal 'truefalse (parseedn-read-str "truefalse"))
+ (equal 'true. (parseedn-read-str "true."))
+ (equal '/ (parseedn-read-str "/"))
+ (should (equal '.true (parseedn-read-str ".true")))
+ (should (equal 'some:sort:of:symbol (parseedn-read-str
"some:sort:of:symbol")))
+ (equal 'foo-bar (parseedn-read-str "foo-bar"))
+ (should (equal '+some-symbol (parseedn-read-str "+some-symbol")))
+ (should (equal '-symbol (parseedn-read-str "-symbol"))))
+
+(ert-deftest booleans ()
+ :tags '(edn boolean)
+ (should (equal t (parseedn-read-str "true")))
+ (should (equal nil (parseedn-read-str "false "))))
+
+(ert-deftest characters ()
+ :tags '(edn characters)
+ (should (equal 97 (parseedn-read-str "\\a")))
+ (should (equal 960 (parseedn-read-str "\\u03C0")))
+ ;;(should (equal 'newline (parseedn-read-str "\\newline")))
+ )
+
+(ert-deftest elision ()
+ :tags '(edn elision)
+ (should-not (parseedn-read-str "#_foo"))
+ (should-not (parseedn-read-str "#_ 123"))
+ (should-not (parseedn-read-str "#_:foo"))
+ (should-not (parseedn-read-str "#_ \\a"))
+ (should-not (parseedn-read-str "#_
+\"foo\""))
+ (should-not (parseedn-read-str "#_ (1 2 3)"))
+ (should (equal '(1 3) (parseedn-read-str "(1 #_ 2 3)")))
+ (should (equal '[1 2 3 4] (parseedn-read-str "[1 2 #_[4 5 6] 3 4]")))
+ (should (map-equal (make-seeded-hash-table :foo :bar)
+ (parseedn-read-str "{:foo #_elided :bar}")))
+ (should (equal '(edn-set (1 2 3 4))
+ (parseedn-read-str "#{1 2 #_[1 2 3] 3 #_ (1 2) 4}")))
+ (should (equal [a d] (parseedn-read-str "[a #_ ;we are discarding what comes
next
+ c d]"))))
+
+(ert-deftest string ()
+ :tags '(edn string)
+ (should (equal "this is a string" (parseedn-read-str "\"this is a
string\"")))
+ (should (equal "this has an escaped \"quote in it"
+ (parseedn-read-str "\"this has an escaped \\\"quote in
it\"")))
+ (should (equal "foo\tbar" (parseedn-read-str "\"foo\\tbar\"")))
+ (should (equal "foo\nbar" (parseedn-read-str "\"foo\\nbar\"")))
+ (should (equal "this is a string \\ that has an escaped backslash"
+ (parseedn-read-str "\"this is a string \\\\ that has an
escaped backslash\"")))
+ (should (equal "[" (parseedn-read-str "\"[\""))))
+
+(ert-deftest keywords ()
+ :tags '(edn keywords)
+ (should (equal :namespace\.of\.some\.length/keyword-name
+ (parseedn-read-str ":namespace.of.some.length/keyword-name")))
+ (should (equal :\#/\# (parseedn-read-str ":#/#")))
+ (should (equal :\#/:a (parseedn-read-str ":#/:a")))
+ (should (equal :\#foo (parseedn-read-str ":#foo"))))
+
+(ert-deftest integers ()
+ :tags '(edn integers)
+ (should (= 0 (parseedn-read-str "0")))
+ (should (= 0 (parseedn-read-str "+0")))
+ (should (= 0 (parseedn-read-str "-0")))
+ (should (= 100 (parseedn-read-str "100")))
+ (should (= -100 (parseedn-read-str "-100"))))
+
+(ert-deftest floats ()
+ :tags '(edn floats)
+ (should (= 12.32 (parseedn-read-str "12.32")))
+ (should (= -12.32 (parseedn-read-str "-12.32")))
+ (should (= 9923.23 (parseedn-read-str "+9923.23")))
+ (should (= 4.5e+044 (parseedn-read-str "45e+43")))
+ (should (= -4.5e-042 (parseedn-read-str "-45e-43")))
+ (should (= 4.5e+044 (parseedn-read-str "45E+43"))))
+
+(ert-deftest lists ()
+ :tags '(edn lists)
+ (should-not (parseedn-read-str "()"))
+ (should (equal '(1 2 3) (parseedn-read-str "( 1 2 3)")))
+ (should (equal '(12.1 ?a foo :bar) (parseedn-read-str "(12.1 \\a foo
:bar)")))
+ (should (equal '((:foo bar :bar 12)) (parseedn-read-str "( (:foo bar :bar
12))")))
+ (should (equal
+ '(defproject com\.thortech/data\.edn "0.1.0-SNAPSHOT")
+ (parseedn-read-str "(defproject com.thortech/data.edn
\"0.1.0-SNAPSHOT\")"))))
+
+(ert-deftest vectors ()
+ :tags '(edn vectors)
+ (should (equal [] (parseedn-read-str "[]")))
+ (should (equal [] (parseedn-read-str "[ ]")))
+ (should (equal '[1 2 3] (parseedn-read-str "[ 1 2 3 ]")))
+ (should (equal '[12.1 ?a foo :bar] (parseedn-read-str "[ 12.1 \\a foo
:bar]")))
+ (should (equal '[[:foo bar :bar 12]] (parseedn-read-str "[[:foo bar :bar
12]]")))
+ (should (equal '[( :foo bar :bar 12 ) "foo"]
+ (parseedn-read-str "[(:foo bar :bar 12) \"foo\"]")))
+ (should (equal '[/ \. * ! _ \? $ % & = - +]
+ (parseedn-read-str "[/ . * ! _ ? $ % & = - +]")))
+ (should (equal
+ ;;[99 newline return space tab]
+ [99 10 13 32 9]
+ (parseedn-read-str "[\\c \\newline \\return \\space \\tab]"))))
+
+(defun map-equal (m1 m2)
+ (and (and (hash-table-p m1) (hash-table-p m2))
+ (eq (hash-table-test m1) (hash-table-test m2))
+ (= (hash-table-count m1) (hash-table-count m2))
+ (equal (hash-table-keys m1) (hash-table-keys m2))
+ (equal (hash-table-values m1) (hash-table-values m2))))
+
+(defun make-seeded-hash-table (&rest keys-and-values)
+ (let ((m (make-hash-table :test #'equal)))
+ (while keys-and-values
+ (puthash (pop keys-and-values) (pop keys-and-values) m))
+ m))
+
+(ert-deftest maps ()
+ :tags '(edn maps)
+ (should (hash-table-p (parseedn-read-str "{ }")))
+ (should (hash-table-p (parseedn-read-str "{}")))
+ (should (map-equal (make-seeded-hash-table :foo :bar :baz :qux)
+ (parseedn-read-str "{ :foo :bar :baz :qux}")))
+ (should (map-equal (make-seeded-hash-table 1 "123" 'vector [1 2 3])
+ (parseedn-read-str "{ 1 \"123\" vector [1 2 3]}")))
+ (should (map-equal (make-seeded-hash-table [1 2 3] "some numbers")
+ (parseedn-read-str "{[1 2 3] \"some numbers\"}"))))
+
+(ert-deftest sets ()
+ :tags '(edn sets)
+ (should (eq 'edn-set (car (parseedn-read-str "#{}"))))
+ (should (eq 'edn-set (car (parseedn-read-str "#{ }"))))
+ (should (equal '(edn-set (1 2 3)) (parseedn-read-str "#{1 2 3}")))
+ (should (equal '(edn-set (1 [1 2 3] 3)) (parseedn-read-str "#{1 [1 2 3]
3}"))))
+
+(ert-deftest comment ()
+ :tags '(edn comments)
+ (should-not (parseedn-read-str ";nada"))
+ (should (equal 1 (parseedn-read-str ";; comment
+1")))
+ (should (equal [1 2 3] (parseedn-read-str "[1 2 ;comment to eol
+3]")))
+ (should (equal '[valid more items] (parseedn-read-str "[valid;touching
trailing comment
+ more items]")))
+ (should (equal [valid vector more vector items] (parseedn-read-str "[valid
vector
+ ;;comment in vector
+ more vector items]"))))
+
+(defun test-val-passed-to-handler (val)
+ (should (listp val))
+ (should (= (length val) 2))
+ (should (= 1 (car val)))
+ 1)
+
+(setq parseedn-test-extra-handlers
+ (a-list
+ 'my/type #'test-val-passed-to-handler
+ 'my/other-type (lambda (val) 2)))
+
+(ert-deftest tags ()
+ :tags '(edn tags)
+ (should-error (parseedn-read-str "#my/type value"
parseedn-test-extra-handlers))
+ (should (= 1 (parseedn-read-str "#my/type (1 2)"
parseedn-test-extra-handlers)))
+ (should (= 2 (parseedn-read-str "#my/other-type {:foo :bar}"
parseedn-test-extra-handlers)))
+ (should-error (parseedn-read-str "#myapp/Person {:first \"Fred\" :last
\"Mertz\"}")))
+
+(ert-deftest roundtrip ()
+ :tags '(edn roundtrip)
+ (let ((data [1 2 3 :foo (4 5) qux "quux"]))
+ (should (equal data (parseedn-read-str (parseedn-print-str data))))
+ (should (map-equal (make-seeded-hash-table :foo :bar)
+ (parseedn-read-str (parseedn-print-str
(make-seeded-hash-table :foo :bar)))))
+ (should (equal '(edn-set (1 2 3 [3 1.11]))
+ (parseedn-read-str (parseedn-print-str '(edn-set (1 2 3 [3
1.11]))))))))
+
+(ert-deftest inst ()
+ :tags '(edn inst)
+ (let* ((inst-str "#inst \"1985-04-12T23:20:50.52Z\"")
+ (inst (parseedn-read-str inst-str))
+ (time (date-to-time "1985-04-12T23:20:50.52Z")))
+ (should (eq 'edn-inst (car inst)))
+ (should (equal time (cdr inst)))))
+
+(ert-deftest uuid ()
+ :tags '(edn uuid)
+ (let* ((str "f81d4fae-7dec-11d0-a765-00a0c91e6bf6")
+ (uuid (parseedn-read-str (concat "#uuid \"" str "\""))))
+ (should (eq 'edn-uuid (car uuid)))))
+
+;; (ert-deftest invalid-edn ()
+;; (should-error (parseedn-read-str "///"))
+;; (should-error (parseedn-read-str "~cat"))
+;; (should-error (parseedn-read-str "foo/bar/baz/qux/quux"))
+;; (should-error (parseedn-read-str "#foo/"))
+;; (should-error (parseedn-read-str "foo/"))
+;; (should-error (parseedn-read-str ":foo/"))
+;; (should-error (parseedn-read-str "#/foo"))
+;; (should-error (parseedn-read-str "/symbol"))
+;; (should-error (parseedn-read-str ":/foo"))
+;; (should-error (parseedn-read-str "+5symbol"))
+;; (should-error (parseedn-read-str ".\\newline"))
+;; (should-error (parseedn-read-str "0cat"))
+;; (should-error (parseedn-read-str "-4cats"))
+;; (should-error (parseedn-read-str ".9"))
+;; (should-error (parseedn-read-str ":keyword/with/too/many/slashes"))
+;; (should-error (parseedn-read-str ":a.b.c/"))
+;; (should-error (parseedn-read-str "\\itstoolong"))
+;; (should-error (parseedn-read-str ":#/:"))
+;; (should-error (parseedn-read-str "/foo//"))
+;; (should-error (parseedn-read-str "///foo"))
+;; (should-error (parseedn-read-str ":{}"))
+;; (should-error (parseedn-read-str "//"))
+;; (should-error (parseedn-read-str "##"))
+;; (should-error (parseedn-read-str "::"))
+;; (should-error (parseedn-read-str "::a"))
+;; (should-error (parseedn-read-str ".5symbol"))
+;; (should-error (parseedn-read-str "{ \"foo\""))
+;; (should-error (parseedn-read-str "{ \"foo\" :bar"))
+;; (should-error (parseedn-read-str "{"))
+;; (should-error (parseedn-read-str ":{"))
+;; (should-error (parseedn-read-str "{{"))
+;; (should-error (parseedn-read-str "}"))
+;; (should-error (parseedn-read-str ":}"))
+;; (should-error (parseedn-read-str "}}"))
+;; (should-error (parseedn-read-str "#:foo"))
+;; (should-error (parseedn-read-str "\\newline."))
+;; (should-error (parseedn-read-str "\\newline0.1"))
+;; (should-error (parseedn-read-str "^"))
+;; (should-error (parseedn-read-str ":^"))
+;; (should-error (parseedn-read-str "_:^"))
+;; (should-error (parseedn-read-str "#{{[}}"))
+;; (should-error (parseedn-read-str "[}"))
+;; (should-error (parseedn-read-str "@cat")))
+
+;;; edn-el-parity-test.el ends here
diff --git a/test/clj-edn-test.el b/test/parseedn-test.el
similarity index 57%
rename from test/clj-edn-test.el
rename to test/parseedn-test.el
index 310b1324fa..c63d139509 100644
--- a/test/clj-edn-test.el
+++ b/test/parseedn-test.el
@@ -1,4 +1,4 @@
-;;; clj-edn-test.el --- Unit tests for EDN reading/printing
+;;; parseedn-test.el --- Unit tests for EDN reading/printing
;; Copyright (C) 2017 Arne Brasseur
@@ -28,50 +28,50 @@
;;; Code
(require 'ert)
-(require 'clj-parse)
+(require 'parseclj)
-(load "test/clj-parse-test-data.el")
+(load "test/parseclj-test-data.el")
-(ert-deftest clj-edn-print-test ()
- (should (equal (clj-edn-print-str nil) "nil"))
- (should (equal (clj-edn-print-str 100) "100"))
- (should (equal (clj-edn-print-str 1.2) "1.2"))
- (should (equal (clj-edn-print-str [1 2 3]) "[1 2 3]"))
- (should (equal (clj-edn-print-str t) "true")))
+(ert-deftest parseedn-print-test ()
+ (should (equal (parseedn-print-str nil) "nil"))
+ (should (equal (parseedn-print-str 100) "100"))
+ (should (equal (parseedn-print-str 1.2) "1.2"))
+ (should (equal (parseedn-print-str [1 2 3]) "[1 2 3]"))
+ (should (equal (parseedn-print-str t) "true")))
-(ert-deftest clj-edn-read-test ()
- (should (equal (clj-edn-read-str "true") t)))
+(ert-deftest parseedn-read-test ()
+ (should (equal (parseedn-read-str "true") t)))
-(defmacro define-clj-edn-read-tests ()
+(defmacro define-parseedn-read-tests ()
`(progn
,@(mapcar
(lambda (pair)
(let ((name (car pair))
(data (cdr pair)))
(if (and (a-get data :edn) (a-get data :source))
- (let ((test-name (intern (concat "clj-edn-read:" name))))
+ (let ((test-name (intern (concat "parseedn-read:" name))))
`(ert-deftest ,test-name ()
- :tags '(clj-edn)
+ :tags '(parseedn)
(with-temp-buffer
(insert ,(a-get data :source))
(goto-char 1)
- (should (a-equal (clj-edn-read) ',(a-get data
:edn)))))))))
- clj-parse-test-data)))
+ (should (a-equal (parseedn-read) ',(a-get data
:edn)))))))))
+ parseclj-test-data)))
-(defmacro define-clj-edn-roundtrip-tests ()
+(defmacro define-parseedn-roundtrip-tests ()
`(progn
,@(mapcar
(lambda (pair)
(let ((name (car pair))
(data (cdr pair)))
(if (and (a-get data :edn) (a-get data :source) (member
:edn-roundtrip (a-get data :tags)))
- (let ((test-name (intern (concat "clj-edn-rountrip:" name))))
+ (let ((test-name (intern (concat "parseedn-rountrip:" name))))
`(ert-deftest ,test-name ()
- :tags '(clj-edn-rountrip)
- (should (equal (clj-edn-print-str (car ',(a-get data
:edn))) ,(a-get data :source))))))))
- clj-parse-test-data)))
+ :tags '(parseedn-rountrip)
+ (should (equal (parseedn-print-str (car ',(a-get data
:edn))) ,(a-get data :source))))))))
+ parseclj-test-data)))
-(define-clj-edn-read-tests)
-(define-clj-edn-roundtrip-tests)
+(define-parseedn-read-tests)
+(define-parseedn-roundtrip-tests)
-;;; clj-edn-test.el
+;;; parseedn-test.el
- [nongnu] elpa/parseclj e6bce85062 159/185: Update the CHANGELOG, (continued)
- [nongnu] elpa/parseclj e6bce85062 159/185: Update the CHANGELOG, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 1f7fe675ae 172/185: Merge pull request #31 from clojure-emacs/remove-a-el-part-2, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj a8c4cf30fb 185/185: Correctly bump versions, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 7ae887b1de 037/185: Refactor clj-parse.el, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj a83816010e 039/185: Refactor clj-parse-test., ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 9d4c0b7b4b 041/185: Merge pull request #2 from volrath/tag-support, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 879ac980a8 056/185: Treat numbers with trailing symbol characters as lex errors, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 2781f0cd7f 088/185: Vocab chage: closer/opener => closing-token/opening-token, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 4fc37462ab 073/185: Make Travis use Cask, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj a71e57df4d 080/185: Rename clj-lex to parseclj-lex, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 168027fed5 094/185: Merge pull request #7 from lambdaisland/reorganize-package,
ELPA Syncer <=
- [nongnu] elpa/parseclj 45bd6a7431 109/185: Clean up tests, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 1f8e449897 105/185: Simplify error messages, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj f362018ff1 112/185: Silence the byte-compiler about some unused vars., ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 70804992ee 122/185: Merge pull request #14 from lambdaisland/parseclj-lex-symbol-fix, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 19ca5f5bd0 121/185: Stick to the previous Travis Trusty image, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj b2550e6456 133/185: Add docstring for `parseclj-lex--string-value`, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 13059d8529 138/185: Minor checkdoc fixes, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 49c715ed22 148/185: For prefix-2 elements: pass children to reduce in right order, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj dc0d165b0a 152/185: Merge pull request #23 from clojure-emacs/read-one, ELPA Syncer, 2021/12/28
- [nongnu] elpa/parseclj 62c9bf9126 177/185: Remove the last remains of a.el, restructure requires, ELPA Syncer, 2021/12/28