[elpa] externals/parser-generator 020969094c 61/82: More refactoring

[Christian Johansson]

branch: externals/parser-generator
commit 020969094c94614601ee353b1ba06cb931ec9e58
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>

    More refactoring
---
 parser-generator-ll.el           | 201 +++++++++++++++++++++++-----------
 parser-generator.el              |   2 +-
 test/parser-generator-ll-test.el | 231 ++++++++++++++++++++-------------------
 3 files changed, 253 insertions(+), 181 deletions(-)

diff --git a/parser-generator-ll.el b/parser-generator-ll.el
index 05d4fcbd1d..c33f8082f1 100644
--- a/parser-generator-ll.el
+++ b/parser-generator-ll.el
@@ -25,16 +25,67 @@
 ;;; Functions
 
 
-(defun parser-generator-ll-generate-tables ()
-  "Generate tables for grammar."
-  (if (> parser-generator--look-ahead-number 1)
-      (progn
-        (message "\n;; Starting generation of LL(k) tables..\n")
-        (parser-generator-ll--generate-tables-k-gt-1)
-        (message "\n;; Completed generation of LL(k) tables.\n"))
-    (message "\n;; Starting generation of LL(1) tables..\n")
-    (parser-generator-ll--generate-tables-k-eq-1)
-    (message "\n;; Completed generation of LL(1) tables.\n")))
+(defun parser-generator-ll-generate-table ()
+  "Generate table for grammar."
+  (let ((list-parsing-table)
+        (hash-parsing-table (make-hash-table :test 'equal)))
+
+    (if (> parser-generator--look-ahead-number 1)
+        (progn
+          (message "\n;; Starting generation of LL(k) tables..\n")
+
+          (unless (parser-generator-ll--valid-grammar-k-gt-1-p)
+            (error "Invalid LL(k) grammar specified!"))
+
+          (setq
+           list-parsing-table
+           (parser-generator-ll--generate-action-table-k-gt-1
+            (parser-generator-ll--generate-goto-table-k-gt-1))))
+
+      (message "\n;; Starting generation of LL(1) tables..\n")
+
+      (unless (parser-generator-ll--valid-grammar-p-k-eq-1)
+        (error "Invalid LL(1) grammar specified!"))
+
+      (setq
+       list-parsing-table
+       (parser-generator-ll--generate-table-k-eq-1)))
+
+    ;; Convert list-structure to hash-map
+    (dolist (state-list list-parsing-table)
+      (let ((state-key (nth 0 state-list))
+            (state-look-aheads (nth 1 state-list))
+            (state-hash-table (make-hash-table :test 'equal)))
+        (dolist (state-look-ahead-list state-look-aheads)
+          (let ((state-look-ahead-string (nth 0 state-look-ahead-list))
+                (state-look-ahead-action (nth 1 state-look-ahead-list)))
+            (if (equal state-look-ahead-action 'reduce)
+                (let ((state-look-ahead-reduction
+                       (nth 2 state-look-ahead-list))
+                      (state-look-ahead-production-number
+                       (nth 3 state-look-ahead-list)))
+                  (puthash
+                   (format "%S" state-look-ahead-string)
+                   (list
+                    state-look-ahead-action
+                    state-look-ahead-reduction
+                    state-look-ahead-production-number)
+                   state-hash-table))
+              (puthash
+               (format "%S" state-look-ahead-string)
+               state-look-ahead-action
+               state-hash-table))))
+        (puthash
+         (format "%S" state-key)
+         state-hash-table
+         hash-parsing-table)))
+    (setq
+     parser-generator-ll--table
+     hash-parsing-table)
+
+    (if (> parser-generator--look-ahead-number 1)
+        (message "\n;; Completed generation of LL(k) tables.\n")
+      (message "\n;; Completed generation of LL(1) tables.\n"))))
 
 ;; Generally described at .p 339
 (defun parser-generator-ll-parse ()
@@ -147,57 +198,77 @@
 
 (defun parser-generator-ll--generate-table-k-eq-1 ()
   "Generate table for LL(1) grammar."
-  (message "\n;; Starting generation of LL(1) table..\n")
-  (unless (parser-generator-ll--valid-grammar-p-k-eq-1)
-    (error "Invalid LL(1) grammar specified!"))
-  (let (hash-parsing-table (make-hash-table :test 'equal))
-    ;; TODO Iterate all non-terminals here
-    ;; TODO Add non-terminal -> FIRST(non-terminal) -> reduce RHS, 
production-number
-    ;; TODO Iterate all possible look-aheds
-    ;; TODO Added EOF symbol
-    (setq
-     parser-generator-ll--table
-     hash-parsing-table)))
-
-(defun parser-generator-ll--generate-table-k-gt-1 ()
-  "Generate table for LL(k) grammar."
-  (message "\n;; Starting generation of LL(k) table..\n")
-  (unless (parser-generator-ll--valid-grammar-k-gt-1-p)
-    (error "Invalid LL(k) grammar specified!"))
-  (let ((list-parsing-table
-         (parser-generator-ll--generate-action-table-k-gt-1
-          (parser-generator-ll--generate-goto-table-k-gt-1)))
-        (hash-parsing-table (make-hash-table :test 'equal)))
-    (dolist (state-list list-parsing-table)
-      (let ((state-key (nth 0 state-list))
-            (state-look-aheads (nth 1 state-list))
-            (state-hash-table (make-hash-table :test 'equal)))
-        (dolist (state-look-ahead-list state-look-aheads)
-          (let ((state-look-ahead-string (nth 0 state-look-ahead-list))
-                (state-look-ahead-action (nth 1 state-look-ahead-list)))
-            (if (equal state-look-ahead-action 'reduce)
-                (let ((state-look-ahead-reduction
-                       (nth 2 state-look-ahead-list))
-                      (state-look-ahead-production-number
-                       (nth 3 state-look-ahead-list)))
-                  (puthash
-                   (format "%S" state-look-ahead-string)
-                   (list
-                    state-look-ahead-action
-                    state-look-ahead-reduction
-                    state-look-ahead-production-number)
-                   state-hash-table))
-              (puthash
-               (format "%S" state-look-ahead-string)
-               state-look-ahead-action
-               state-hash-table))))
-        (puthash
-         (format "%S" state-key)
-         state-hash-table
-         hash-parsing-table)))
-    (setq
-     parser-generator-ll--table
-     hash-parsing-table)))
+  (let ((parsing-table))
+
+    ;; Iterate all possible look-aheads
+    ;; Add EOF symbol look-ahead
+    (let ((eof-look-ahead
+           (parser-generator--generate-list-of-symbol
+            parser-generator--look-ahead-number
+            parser-generator--eof-identifier))
+          (terminal-mutations
+           (parser-generator--get-grammar-look-aheads))
+          (terminal-buffer)
+          (last-terminal))
+      (dolist (terminal-mutation terminal-mutations)
+        (if (equal terminal-mutation eof-look-ahead)
+            (push
+             (list
+              parser-generator--eof-identifier
+              (list
+               (list
+                eof-look-ahead
+                'accept)))
+             parsing-table)
+          (let ((stack-item (nth 0 terminal-mutation)))
+            (when (and
+                   last-terminal
+                   (not (equal last-terminal stack-item)))
+              (push
+               (list
+                last-terminal
+                terminal-buffer)
+               parsing-table)
+              (setq
+               terminal-buffer
+               nil))
+            (push
+             (list terminal-mutation 'pop)
+             terminal-buffer)
+            (setq
+             last-terminal
+             stack-item))))
+      (when (and
+             last-terminal
+             terminal-buffer)
+        (push
+         (list
+          last-terminal
+          terminal-buffer)
+         parsing-table)))
+
+    ;; Add non-terminal -> FIRST(non-terminal) -> reduce RHS, production-number
+    (let ((non-terminals (parser-generator--get-grammar-non-terminals)))
+      (dolist (non-terminal non-terminals)
+        (let ((non-terminal-buffer))
+          (let ((rhss (parser-generator--get-grammar-rhs non-terminal)))
+            (dolist (rhs rhss)
+              (let ((firsts-rhs (parser-generator--first rhs))
+                    (production-number
+                     (parser-generator--get-grammar-production-number
+                      (list (list non-terminal) rhs))))
+                (dolist (first-rhs firsts-rhs)
+                  (push
+                   (list first-rhs 'reduce rhs production-number)
+                   non-terminal-buffer)))))
+          (when non-terminal-buffer
+            (push
+             (list
+              non-terminal
+              non-terminal-buffer)
+             parsing-table)))))
+
+    parsing-table))
 
 ;; Algorithm 5.2 p. 350
 (defun parser-generator-ll--generate-goto-table-k-gt-1 ()
@@ -308,13 +379,13 @@
                      'error
                      (list
                       (format
-                       "There are more than one follow set in state! %S -> %S 
+ %S"
+                       "There are more than one possible follow set in state! 
%S -> %S + %S"
                        sub-symbol
                        production-rhs
-                       follow-set)
+                       local-follow-set)
                       sub-symbol
                       production-rhs
-                      follow-set)))
+                      local-follow-set)))
                   (setq
                    local-follow
                    (car local-follow-set))
@@ -529,7 +600,7 @@
             valid
             (< non-terminal-index non-terminal-length))
       (setq non-terminal (nth non-terminal-index non-terminals))
-      (let* ((rhss (parser-generator--get-grammar-rhs non-terminals))
+      (let* ((rhss (parser-generator--get-grammar-rhs non-terminal))
              (rhss-length (length rhss))
              (rhss-index 0)
              (rhs)
diff --git a/parser-generator.el b/parser-generator.el
index dfd698663e..4b749f7f31 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -45,7 +45,7 @@
 
 (defvar
   parser-generator--debug
-  t
+  nil
   "Whether to print debug messages or not.")
 
 (defvar
diff --git a/test/parser-generator-ll-test.el b/test/parser-generator-ll-test.el
index 785362e46f..a03fc43558 100644
--- a/test/parser-generator-ll-test.el
+++ b/test/parser-generator-ll-test.el
@@ -120,111 +120,6 @@
     )
   (message "Passed Example 5.17 p. 354")
 
-  ;; Move below to separate test
-
-  (parser-generator-set-eof-identifier '$)
-  (parser-generator-set-e-identifier 'e)
-  (parser-generator-set-look-ahead-number 1)
-  (parser-generator-set-grammar
-   '(
-     (S A)
-     (a b)
-     (
-      (S (a A S) b)
-      (A a (b S A))
-      )
-     S
-     )
-   )
-  (parser-generator-process-grammar)
-  (let* ((tables
-          (parser-generator-ll--generate-goto-table-k-gt-1)))
-    ;; (message "tables: %S" tables)
-    (should
-     (equal
-      tables
-      '(
-        (
-         (A)
-         (
-          ((a) (a))
-          ((b) (b S A))
-          )
-         )
-        (
-         (S)
-         (
-          ((a) (a A S))
-          ((b) (b))
-          )
-         )
-        )
-     )
-    ))
-  (message "Passed Example 5.5 p. 340")
-
-  (parser-generator-set-eof-identifier '$)
-  (parser-generator-set-e-identifier 'e)
-  (parser-generator-set-look-ahead-number 1)
-  (parser-generator-set-grammar
-   '(
-     (E E2 T T2 F)
-     ("a" "(" ")" "+" "*")
-     (
-      (E (T E2))
-      (E2 ("+" T E2) e)
-      (T (F T2))
-      (T2 ("*" F T2) e)
-      (F ("(" E ")") "a")
-      )
-     E
-     )
-   )
-  (parser-generator-process-grammar)
-  (let ((tables (parser-generator-ll--generate-goto-table-k-gt-1)))
-    ;; (message "tables: %S" tables)
-    (should
-     (equal
-      '(
-        (
-         (F)
-         (
-          (("(") ("(" E ")"))
-          (("a") ("a"))
-          )
-         )
-        (
-         (T2)
-         (
-          (($) (e))
-          (("*") ("*" F T2))
-          )
-         )
-        (
-         (T)
-         (
-          (("(") (F T2))
-          (("a") (F T2))
-          )
-         )
-        (
-         (E2)
-         (
-          ((")") (e))
-          (("+") ("+" T E2))
-          )
-         )
-        (
-         (E)
-         (
-          (("(") (T E2))
-          (("a") (T E2))
-          )
-         )
-        )
-      tables)))
-  (message "Passed Example 5.12 p. 346-347")
-
   (message "Passed tests for 
(parser-generator-ll--generate-goto-table-k-gt-1)"))
 
 (defun parser-generator-ll-test--generate-action-table-k-gt-1 ()
@@ -248,7 +143,7 @@
   (let ((parser-tables
          (parser-generator-ll--generate-action-table-k-gt-1
           (parser-generator-ll--generate-goto-table-k-gt-1))))
-    ;; (message "parser-tables: %S" parser-tables)
+    (message "parser-tables: %S" parser-tables)
     (should
      (equal
       '(
@@ -383,7 +278,7 @@
    (lambda (token)
      (car token)))
   (message "parsing-table: %S" (parser-generator--hash-to-list
-     parser-generator-ll--parsing-table
+     parser-generator-ll--table
      t))
   (should
    (equal
@@ -516,9 +411,9 @@
 
   (message "Passed tests for (parser-generator-ll-parse)"))
 
-(defun parser-generator-ll-test-generate-tables ()
-  "Test `parser-generator-ll-generate-tables'."
-  (message "Started tests for (parser-generator-ll-generate-tables)")
+(defun parser-generator-ll-test-generate-table ()
+  "Test `parser-generator-ll-generate-table'."
+  (message "Started tests for (parser-generator-ll-generate-table)")
 
   (parser-generator-set-eof-identifier '$)
   (parser-generator-set-e-identifier 'e)
@@ -535,8 +430,8 @@
      )
    )
   (parser-generator-process-grammar)
-  (parser-generator-ll-generate-tables)
-  ;; (message "parsing-table: %S" (parser-generator--hash-to-list 
parser-generator-ll--parsing-table t))
+  (parser-generator-ll-generate-table)
+  ;; (message "parsing-table: %S" (parser-generator--hash-to-list 
parser-generator-ll--table t))
   (should
    (equal
     '(
@@ -571,12 +466,12 @@
       ("$" (("($ $)" accept)))
       )
     (parser-generator--hash-to-list
-     parser-generator-ll--parsing-table
+     parser-generator-ll--table
      t)))
 
   ;; TODO Should test k = 1 here as well
 
-  (message "Passed tests for (parser-generator-ll-generate-tables)"))
+  (message "Passed tests for (parser-generator-ll-generate-table)"))
 
 (defun parser-generator-ll-test--valid-grammar-k-gt-1-p ()
   "Test `parser-generator-ll--valid-grammar-k-gt-1-p'."
@@ -632,6 +527,112 @@
 
   ;; TODO Implement this
 
+  ;; Move below to separate test
+
+  (parser-generator-set-eof-identifier '$)
+  (parser-generator-set-e-identifier 'e)
+  (parser-generator-set-look-ahead-number 1)
+  (parser-generator-set-grammar
+   '(
+     (S A)
+     (a b)
+     (
+      (S (a A S) b)
+      (A a (b S A))
+      )
+     S
+     )
+   )
+  (parser-generator-process-grammar)
+  (let* ((tables
+          (parser-generator-ll--generate-table-k-eq-1)))
+    (message "tables: %S" tables)
+    (should
+     (equal
+      tables
+      '(
+        (
+         (A)
+         (
+          ((a) (a))
+          ((b) (b S A))
+          )
+         )
+        (
+         (S)
+         (
+          ((a) (a A S))
+          ((b) (b))
+          )
+         )
+        )
+      )
+     ))
+  (message "Passed Example 5.5 p. 340")
+
+  (parser-generator-set-eof-identifier '$)
+  (parser-generator-set-e-identifier 'e)
+  (parser-generator-set-look-ahead-number 1)
+  (parser-generator-set-grammar
+   '(
+     (E E2 T T2 F)
+     ("a" "(" ")" "+" "*")
+     (
+      (E (T E2))
+      (E2 ("+" T E2) e)
+      (T (F T2))
+      (T2 ("*" F T2) e)
+      (F ("(" E ")") "a")
+      )
+     E
+     )
+   )
+  (parser-generator-process-grammar)
+  (let ((tables (parser-generator-ll--generate-table-k-eq-1)))
+    (message "tables: %S" tables)
+    (should
+     (equal
+      '(
+        (
+         (F)
+         (
+          (("(") ("(" E ")"))
+          (("a") ("a"))
+          )
+         )
+        (
+         (T2)
+         (
+          (($) (e))
+          (("*") ("*" F T2))
+          )
+         )
+        (
+         (T)
+         (
+          (("(") (F T2))
+          (("a") (F T2))
+          )
+         )
+        (
+         (E2)
+         (
+          ((")") (e))
+          (("+") ("+" T E2))
+          )
+         )
+        (
+         (E)
+         (
+          (("(") (T E2))
+          (("a") (T E2))
+          )
+         )
+        )
+      tables)))
+  (message "Passed Example 5.12 p. 346-347")
+
+
   (parser-generator-set-eof-identifier '$)
   (parser-generator-set-e-identifier 'e)
   (parser-generator-set-look-ahead-number 1)
@@ -749,7 +750,7 @@
   (parser-generator-ll-test--valid-grammar-k-eq-1-p)
 
   ;; Main stuff
-  (parser-generator-ll-test-generate-tables)
+  (parser-generator-ll-test-generate-table)
   (parser-generator-ll-test-parse))