[nongnu] elpa/parseclj 452fe7cc76 023/185: Implement nil, true, false, symbol

[ELPA Syncer]

branch: elpa/parseclj
commit 452fe7cc7649468a0c3853541995a88f2a051217
Author: Arne Brasseur <arne@arnebrasseur.net>
Commit: Arne Brasseur <arne@arnebrasseur.net>

    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)))