[nongnu] elpa/parseclj abe7edb04b 019/185: Bunch of refactoring, but we're green now, supposedly

[ELPA Syncer]

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

    Bunch of refactoring, but we're green now, supposedly
---
 clj-lex-test.el   | 17 +++++++----
 clj-lex.el        | 24 ++++++++++------
 clj-parse-test.el |  8 ++++++
 clj-parse.el      | 85 ++++++++++++++++++++++++++++++++-----------------------
 4 files changed, 84 insertions(+), 50 deletions(-)

diff --git a/clj-lex-test.el b/clj-lex-test.el
index 2eda80a58c..b54a5d0329 100644
--- a/clj-lex-test.el
+++ b/clj-lex-test.el
@@ -27,17 +27,16 @@
   (with-temp-buffer
     (insert "()")
     (goto-char 1)
-    (should (equal (clj-lex-next) '((type . :lparen) (pos . 1))))
-    (should (equal (clj-lex-next) '((type . :rparen) (pos . 2))))
-    (should (equal (clj-lex-next) '((type . :eof) (pos . 3)))))
+    (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)
-                                       (value . 123)
-                                       (form . "123")
-                                       (pos . 1)))))
+                                    (form . "123")
+                                    (pos . 1)))))
 
   (with-temp-buffer
     (insert " \t  \n")
@@ -45,6 +44,12 @@
     (should (equal (clj-lex-next) '((type . :whitespace) (form . " \t  \n") 
(pos . 1))))))
 
 
+(ert-deftest clj-lex-test-token ()
+  (should (equal (clj-lex-token :whitespace ",,," 10)
+                 '((type . :whitespace)
+                   (form . ",,,")
+                   (pos . 10)))))
+
 (provide 'clj-lex-test)
 
 ;;; clj-lext-test.el ends here
diff --git a/clj-lex.el b/clj-lex.el
index 3b8ef7d7c9..b10c28765c 100644
--- a/clj-lex.el
+++ b/clj-lex.el
@@ -20,6 +20,15 @@
 
 ;; A reader for EDN data files and parser for Clojure source files.
 
+(require 'dash)
+
+(defun clj-lex-token (type form pos &rest args)
+  `((type . ,type)
+    (form . ,form)
+    (pos . , pos)
+    ,@(mapcar (lambda (pair)
+                (cons (car pair) (cadr pair)))
+              (-partition 2 args))))
 
 (defun clj-lex-whitespace ()
   (let* ((pos (point)))
@@ -29,7 +38,9 @@
                (equal (char-after (point)) ?\r)
                (equal (char-after (point)) ?,))
       (right-char))
-    `((type . :whitespace) (form . ,(buffer-substring-no-properties pos 
(point))) (pos . ,pos))))
+    (clj-lex-token :whitespace
+                   (buffer-substring-no-properties pos (point))
+                   pos)))
 
 
 (defun clj-lex-number ()
@@ -42,14 +53,11 @@
       (right-char))
     (let* ((num-str (buffer-substring-no-properties pos (point))))
       ;; TODO handle radix, bignuM
-      `((type . :number)
-        (value . ,(string-to-number num-str))
-        (form . ,num-str)
-        (pos . ,pos)))))
+      (clj-lex-token :number num-str pos))))
 
 (defun clj-lex-next ()
   (if (eq (point) (point-max))
-      `((type . :eof) (pos . ,(point)))
+      (clj-lex-token :eof nil (point))
     (let ((char (char-after (point)))
           (pos  (point)))
       (cond
@@ -62,11 +70,11 @@
 
        ((equal char ?\()
         (right-char)
-        `((type . :lparen) (pos . ,pos)))
+        (clj-lex-token :lparen "(" pos))
 
        ((equal char ?\))
         (right-char)
-        `((type . :rparen) (pos . ,pos)))
+        (clj-lex-token :rparen ")" pos))
 
        ((and (<= ?0 char) (<= char ?9))
         (clj-lex-number))
diff --git a/clj-parse-test.el b/clj-parse-test.el
index d40577996c..6b35f751b9 100644
--- a/clj-parse-test.el
+++ b/clj-parse-test.el
@@ -26,6 +26,11 @@
 (require 'ert)
 
 (ert-deftest clj-parse-test ()
+  (with-temp-buffer
+    (insert "(1 2 3)")
+    (goto-char 1)
+    (should (equal (clj-parse) '((1 2 3)))))
+
   (with-temp-buffer
     (insert "()")
     (goto-char 1)
@@ -36,6 +41,9 @@
     (goto-char 1)
     (should (equal (clj-parse) '((1))))))
 
+;; (ert-deftest clj-parse-test--reduce-list ()
+;;   (clj-parse-test--reduce-list ))
+
 (provide 'clj-parse-test)
 
 ;;; clj-parse-test.el ends here
diff --git a/clj-parse.el b/clj-parse.el
index de3828e913..89f0b85191 100644
--- a/clj-parse.el
+++ b/clj-parse.el
@@ -31,49 +31,62 @@
 
 (require 'clj-lex)
 
-(defun clj-parse ()
-  (clj-parse-reduce 'clj-parse-edn-reduce1 'clj-parse-edn-reduceN))
-
 (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))))
 
 (defun clj-parse-edn-reduceN (stack type coll)
-  (cl-case type
-    (:whitespace :ws)
-    (:number coll)
-    (:list coll)))
-
-(defun clj-parse-terminal? (token)
-  (cdr (assq ('type token)))
-  )
-
-(defun clj-parse-reduce (reduce1 reducer)
+  (cons
+   (cl-case type
+     (:whitespace :ws)
+     (:number coll)
+     (:list (-butlast (cdr coll))))
+   stack))
+
+(defvar clj-parse--terminal-tokens '(:whitespace :number))
+
+
+(defun clj-parse--token-type (token)
+  (and (listp token) (cdr (assq 'type token))))
+
+(defun clj-parse--unwind-stack (stack target)
+  (let ((result nil))))
+
+(defun clj-parse--reduce-list (stack reducN)
+  (let ((coll nil))
+    (while (and stack (not (eq (clj-parse--token-type (car stack)) :lparen)))
+      (push (pop stack) coll))
+    (if (eq (clj-parse--token-type (car stack)) :lparen)
+        (progn
+          (push (pop stack) coll)
+          (funcall reduceN stack :list coll))
+      ;; Unwound the stack without finding a matching paren: return the 
original stack
+      (reverse list))))
+
+(defun clj-parse-reduce (reduce1 reduceN)
   (let ((stack nil)
         (token (clj-lex-next)))
-    (while (not (eq (cdr (assq 'type token)) :eof))
-      ;; (prin1 (alist-get 'type token))
-      ;; (print token)
-      ;; (print stack)
-      (let-alist token
-        (setf stack
-              (if (clj-parse-terminal? token)
-                  ))
-        (cl-case .type
-          (:whitespace
-           (push (funcall reducer stack :whitespace .form) stack))
-          (:number
-           (push (funcall reducer stack :number .value) stack))
-          (:lparen
-           (push token stack))
-          (:rparen
-           (let ((list nil))
-             (while (not (and (listp (car stack)) (eq (cdr (assq 'type (car 
stack))) :lparen)))
-               (push (pop stack) list))
-             (pop stack) ;; :lparen
-             ;; (print list)
-             (push (funcall reducer stack :list list) stack)))))
+
+    (while (not (eq (clj-parse--token-type token) :eof))
+      (message "STACK: %S" stack)
+      (message "TOKEN: %S\n" token)
+
+      (setf stack
+            (if (member (clj-parse--token-type token) 
clj-parse--terminal-tokens)
+                (funcall reduce1 stack token)
+              (cons token stack)))
+
+      (cl-case (clj-parse--token-type (car stack))
+        (:rparen (setf stack (clj-parse--reduce-list stack reduceN))))
+
       (setq token (clj-lex-next)))
+
+    (message "RESULT: %S" stack)
     stack))
 
+(defun clj-parse ()
+  (clj-parse-reduce 'clj-parse-edn-reduce1 'clj-parse-edn-reduceN))
+
 (provide 'clj-parse)
 ;;; clj-parse.el ends here