branch: elpa/parseclj
commit 452fe7cc7649468a0c3853541995a88f2a051217
Author: Arne Brasseur <[email protected]>
Commit: Arne Brasseur <[email protected]>
Implement nil, true, false, symbol
---
clj-lex-test.el | 59 +++++++++++++++++++++++++++++++++++++++++-
clj-lex.el | 77 ++++++++++++++++++++++++++++++++++++++++++-------------
clj-parse-test.el | 7 ++++-
clj-parse.el | 10 +++++---
4 files changed, 130 insertions(+), 23 deletions(-)
diff --git a/clj-lex-test.el b/clj-lex-test.el
index ec21887abf..f3763d91c2 100644
--- a/clj-lex-test.el
+++ b/clj-lex-test.el
@@ -41,8 +41,40 @@
(with-temp-buffer
(insert " \t \n")
(goto-char 1)
- (should (equal (clj-lex-next) '((type . :whitespace) (form . " \t \n")
(pos . 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))))))
+
+(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)
@@ -50,6 +82,31 @@
(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? ?~) 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)))
+
+
+
(provide 'clj-lex-test)
;;; clj-lex-test.el ends here
diff --git a/clj-lex.el b/clj-lex.el
index b10c28765c..9973341d60 100644
--- a/clj-lex.el
+++ b/clj-lex.el
@@ -30,42 +30,80 @@
(cons (car pair) (cadr pair)))
(-partition 2 args))))
+(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 (or (equal (char-after (point)) ?\ )
- (equal (char-after (point)) ?\t)
- (equal (char-after (point)) ?\n)
- (equal (char-after (point)) ?\r)
- (equal (char-after (point)) ?,))
+ (let ((pos (point)))
+ (while (clj-lex-at-whitespace?)
(right-char))
(clj-lex-token :whitespace
(buffer-substring-no-properties pos (point))
pos)))
-
(defun clj-lex-number ()
- (let* ((pos (point)))
+ (let ((pos (point)))
(while (and (char-after (point))
(or (and (<= ?0 (char-after (point))) (<= (char-after (point))
?9))
(eq (char-after (point)) ?.)
(eq (char-after (point)) ?M)
(eq (char-after (point)) ?r)))
(right-char))
- (let* ((num-str (buffer-substring-no-properties pos (point))))
- ;; TODO handle radix, bignuM
- (clj-lex-token :number num-str pos))))
+ (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)
+ "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."
+ (not (not (and char
+ (or (and (<= ?a char) (<= char ?z))
+ (and (<= ?A char) (<= char ?Z))
+ (member char '(?. ?* ?+ ?! ?- ?_ ?? ?$ ?% ?& ?= ?<
?>)))))))
+
+(defun clj-lex-symbol-rest? (char)
+ (or (clj-lex-symbol-start? char)
+ (clj-lex-digit? char)))
+
+(defun clj-lex-symbol ()
+ (let ((pos (point)))
+ (right-char)
+ (while (clj-lex-symbol-rest? (char-after (point)))
+ (right-char))
+ (let ((sym (buffer-substring-no-properties pos (point))))
+ (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-next ()
- (if (eq (point) (point-max))
+ (if (clj-lex-at-eof?)
(clj-lex-token :eof nil (point))
(let ((char (char-after (point)))
(pos (point)))
(cond
- ((or (equal char ?\ )
- (equal char ?\t)
- (equal char ?\n)
- (equal char ?\r)
- (equal char ?,))
+ ((clj-lex-at-whitespace?)
(clj-lex-whitespace))
((equal char ?\()
@@ -76,9 +114,12 @@
(right-char)
(clj-lex-token :rparen ")" pos))
- ((and (<= ?0 char) (<= char ?9))
+ ((clj-lex-at-number?)
(clj-lex-number))
+ ((clj-lex-symbol-start? char)
+ (clj-lex-symbol))
+
":("))))
(provide 'clj-lex)
diff --git a/clj-parse-test.el b/clj-parse-test.el
index 6b35f751b9..a6ef69b1e4 100644
--- a/clj-parse-test.el
+++ b/clj-parse-test.el
@@ -39,7 +39,12 @@
(with-temp-buffer
(insert "(1)")
(goto-char 1)
- (should (equal (clj-parse) '((1))))))
+ (should (equal (clj-parse) '((1)))))
+
+ (with-temp-buffer
+ (insert "(nil true false hello-world)")
+ (goto-char 1)
+ (should (equal (clj-parse) '((nil t nil hello-world))))))
;; (ert-deftest clj-parse-test--reduce-list ()
;; (clj-parse-test--reduce-list ))
diff --git a/clj-parse.el b/clj-parse.el
index 1288009fe2..17ec7cdf58 100644
--- a/clj-parse.el
+++ b/clj-parse.el
@@ -34,7 +34,11 @@
(defun clj-parse-edn-reduce1 (stack token)
(cl-case (cdr (assq 'type token))
(:whitespace stack)
- (:number (cons (string-to-number (cdr (assq 'form token))) stack))))
+ (:number (cons (string-to-number (cdr (assq 'form token))) stack))
+ (:nil (cons nil stack))
+ (:true (cons t stack))
+ (:false (cons nil stack))
+ (:symbol (cons (intern (cdr (assq 'form token))) stack))))
(defun clj-parse-edn-reduceN (stack type coll)
(cons
@@ -44,7 +48,7 @@
(:list (-butlast (cdr coll))))
stack))
-(defvar clj-parse--terminal-tokens '(:whitespace :number))
+(defvar clj-parse--leaf-tokens '(:whitespace :number :nil :true :false
:symbol))
(defun clj-parse--token-type (token)
@@ -73,7 +77,7 @@
(message "TOKEN: %S\n" token)
(setf stack
- (if (member (clj-parse--token-type token)
clj-parse--terminal-tokens)
+ (if (member (clj-parse--token-type token) clj-parse--leaf-tokens)
(funcall reduce1 stack token)
(cons token stack)))
