[elpa] externals/parser-generator 87ded78c28 63/82: LL(1) parser passes test for generating tables and parsing

[Christian Johansson]

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

    LL(1) parser passes test for generating tables and parsing
---
 parser-generator-ll.el           | 167 +++++++++++++++++++++++----------------
 test/parser-generator-ll-test.el | 110 +++++++++++++-------------
 2 files changed, 153 insertions(+), 124 deletions(-)

diff --git a/parser-generator-ll.el b/parser-generator-ll.el
index c65e0b0b4a..fd40b6e8d4 100644
--- a/parser-generator-ll.el
+++ b/parser-generator-ll.el
@@ -40,16 +40,17 @@
           (setq
            list-parsing-table
            (parser-generator-ll--generate-action-table-k-gt-1
-            (parser-generator-ll--generate-goto-table-k-gt-1))))
+            (parser-generator-ll--generate-goto-table))))
 
       (message "\n;; Starting generation of LL(1) tables..\n")
 
-      (unless (parser-generator-ll--valid-grammar-p-k-eq-1)
+      (unless (parser-generator-ll--valid-grammar-k-eq-1-p)
         (error "Invalid LL(1) grammar specified!"))
 
       (setq
        list-parsing-table
-       (parser-generator-ll--generate-table-k-eq-1)))
+       (parser-generator-ll--generate-action-table-k-eq-1
+        (parser-generator-ll--generate-goto-table))))
 
     ;; Convert list-structure to hash-map
     (dolist (state-list list-parsing-table)
@@ -92,14 +93,18 @@
   "Parse input via lex-analyzer and return parse trail."
   (let ((accept)
         (stack
-         (list
-          (list
+         (if (> parser-generator--look-ahead-number 1)
+             (list
+              (list
+               (list
+                (parser-generator--get-grammar-start))
+               (parser-generator--generate-list-of-symbol
+                parser-generator--look-ahead-number
+                parser-generator--eof-identifier))
+              parser-generator--eof-identifier)
            (list
-            (parser-generator--get-grammar-start))
-           (parser-generator--generate-list-of-symbol
-            parser-generator--look-ahead-number
-            parser-generator--eof-identifier))
-          parser-generator--eof-identifier))
+            (parser-generator--get-grammar-start)
+            parser-generator--eof-identifier)))
         (output)
         (eof-look-ahead
          (parser-generator--generate-list-of-symbol
@@ -196,8 +201,8 @@
 ;;; Algorithms
 
 
-(defun parser-generator-ll--generate-table-k-eq-1 ()
-  "Generate table for LL(1) grammar."
+(defun parser-generator-ll--generate-action-table-k-eq-1 (goto-table)
+  "Generate action-table for LL(1) grammar using GOTO-TABLE."
   (let ((parsing-table))
 
     ;; Iterate all possible look-aheads
@@ -248,30 +253,67 @@
          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)
+    (let ((non-terminal-look-ahead-p (make-hash-table :test 'equal))
+          (non-terminal-look-ahead-list (make-hash-table :test 'equal)))
+      (dolist (goto-row goto-table)
+        (let* ((stack (nth 0 goto-row))
+               (non-terminal (car (nth 0 stack)))
+               (local-follows (nth 1 stack))
+               (look-aheads (nth 1 goto-row)))
+          (parser-generator--debug
+           (message "\nnon-terminal: %S" non-terminal)
+           (message "local-follows: %S" local-follows)
+           (message "look-aheads: %S" look-aheads))
+          (dolist (look-ahead look-aheads)
+            (let* ((rhs
+                    (nth 1 look-ahead))
+                   (production
+                    (list (list non-terminal) rhs))
+                   (production-number
+                    (parser-generator--get-grammar-production-number
+                     production))
+                   (look-ahead-terminal
+                    (nth 0 look-ahead))
+                   (hashmap-key
+                    (format "%S-%S" non-terminal look-ahead-terminal)))
+              (parser-generator--debug
+               (message "\nrhs: %S" rhs)
+               (message "production: %S" production)
+               (message "production-number: %S" production-number)
+               (message "hashmap-key: %S" hashmap-key))
+              (unless (gethash hashmap-key non-terminal-look-ahead-p)
+                (let ((old-non-terminal-look-aheads
+                       (gethash
+                        non-terminal
+                        non-terminal-look-ahead-list)))
                   (push
-                   (list first-rhs 'reduce rhs production-number)
-                   non-terminal-buffer)))))
-          (when non-terminal-buffer
-            (push
-             (list
-              non-terminal
-              non-terminal-buffer)
-             parsing-table)))))
+                   (list
+                    look-ahead-terminal
+                    'reduce
+                    rhs
+                    production-number)
+                   old-non-terminal-look-aheads)
+                  (puthash
+                   non-terminal
+                   old-non-terminal-look-aheads
+                   non-terminal-look-ahead-list)
+                  (puthash
+                   hashmap-key
+                   t
+                   non-terminal-look-ahead-p)))))))
+      (maphash
+       (lambda (non-terminal look-ahead)
+         (push
+          (list
+           non-terminal
+           look-ahead)
+          parsing-table))
+       non-terminal-look-ahead-list))
 
     parsing-table))
 
 ;; Algorithm 5.2 p. 350
-(defun parser-generator-ll--generate-goto-table-k-gt-1 ()
+(defun parser-generator-ll--generate-goto-table ()
   "Construction of LL(k) GOTO-table.  Output the set of LL(k) tables needed to 
construct a action table for the grammar G."
   (let ((tables (make-hash-table :test 'equal))
         (distinct-item-p (make-hash-table :test 'equal))
@@ -347,7 +389,6 @@
                          first-concatenated-follow-set
                          nil
                          t))
-                       (local-follow)
                        (sub-symbol-rhss
                         (parser-generator--get-grammar-rhs
                          sub-symbol)))
@@ -374,49 +415,34 @@
                   (unless local-follow-set
                     (setq local-follow-set '(nil)))
 
-                  (when (> (length local-follow-set) 1)
-                    (signal
-                     'error
-                     (list
-                      (format
-                       "There are more than one possible follow set in state! 
%S -> %S + %S"
-                       sub-symbol
-                       production-rhs
-                       local-follow-set)
-                      sub-symbol
-                      production-rhs
-                      local-follow-set)))
-                  (setq
-                   local-follow
-                   (car local-follow-set))
-
                   (push
-                   local-follow
+                   local-follow-set
                    sets)
                   (parser-generator--debug
                    (message
                     "pushed local follow set to sets: %S"
                     local-follow-set))
-                  (dolist (sub-symbol-rhs sub-symbol-rhss)
-                    (let* ((new-stack-item
-                            (list
-                             (list sub-symbol)
-                             sub-symbol-rhs
-                             local-follow)))
-                      (unless (gethash
-                               new-stack-item
-                               distinct-stack-item-p)
-                        (parser-generator--debug
-                         (message
-                          "new-stack-item: %S"
-                          new-stack-item))
-                        (puthash
-                         new-stack-item
-                         t
-                         distinct-stack-item-p)
-                        (push
-                         new-stack-item
-                         stack)))))))
+                  (dolist (local-follow local-follow-set)
+                    (dolist (sub-symbol-rhs sub-symbol-rhss)
+                      (let* ((new-stack-item
+                              (list
+                               (list sub-symbol)
+                               sub-symbol-rhs
+                               local-follow)))
+                        (unless (gethash
+                                 new-stack-item
+                                 distinct-stack-item-p)
+                          (parser-generator--debug
+                           (message
+                            "new-stack-item: %S"
+                            new-stack-item))
+                          (puthash
+                           new-stack-item
+                           t
+                           distinct-stack-item-p)
+                          (push
+                           new-stack-item
+                           stack))))))))
             (setq
              sub-symbol-index
              (1+ sub-symbol-index))))
@@ -554,7 +580,8 @@
               (let ((sub-symbol (nth sub-symbol-index right-hand-side)))
                 (if (parser-generator--valid-non-terminal-p
                      sub-symbol)
-                    (let ((local-follow (nth non-terminal-index 
local-follow-sets)))
+                    (let ((local-follow
+                           (car (nth non-terminal-index local-follow-sets))))
                       (push
                        (list
                         (list sub-symbol)
diff --git a/test/parser-generator-ll-test.el b/test/parser-generator-ll-test.el
index b0f3318796..299124950e 100644
--- a/test/parser-generator-ll-test.el
+++ b/test/parser-generator-ll-test.el
@@ -12,9 +12,9 @@
 (require 'parser-generator-ll)
 (require 'ert)
 
-(defun parser-generator-ll-test--generate-goto-table-k-gt-1 ()
-  "Test `parser-generator-ll--generate-goto-table-k-gt-1'."
-  (message "Started tests for 
(parser-generator-ll--generate-goto-table-k-gt-1)")
+(defun parser-generator-ll-test--generate-goto-table ()
+  "Test `parser-generator-ll--generate-goto-table'."
+  (message "Started tests for (parser-generator-ll--generate-goto-table)")
 
   (parser-generator-set-e-identifier 'e)
   (parser-generator-set-look-ahead-number 2)
@@ -30,7 +30,7 @@
      )
    )
   (parser-generator-process-grammar)
-  (let ((tables (parser-generator-ll--generate-goto-table-k-gt-1)))
+  (let ((tables (parser-generator-ll--generate-goto-table)))
     ;; (message "tables: %S" tables)
     (should
      (equal
@@ -53,9 +53,9 @@
         (
          ((S) ($ $)) ;; T0
          (
-          ((a b) (a A a a) ((a a)))
-          ((a a) (a A a a) ((a a)))
-          ((b b) (b A b a) ((b a)))
+          ((a b) (a A a a) (((a a))))
+          ((a a) (a A a a) (((a a))))
+          ((b b) (b A b a) (((b a))))
           )
          )
         )
@@ -79,7 +79,7 @@
    )
   (parser-generator-process-grammar)
   (let* ((tables
-          (parser-generator-ll--generate-goto-table-k-gt-1)))
+          (parser-generator-ll--generate-goto-table)))
     ;; (message "tables: %S" tables)
     (should
      (equal
@@ -88,23 +88,23 @@
         (
          ((A) (a a)) ;; T3
          (
-          ((a b) (S a a) ((a a)))
-          ((a a) (S a a) ((a a)))
+          ((a b) (S a a) (((a a))))
+          ((a a) (S a a) (((a a))))
           ((b a) (b) nil)
           )
          )
         (
          ((S) (a a)) ;; T2
          (
-          ((a b) (a b A) ((a a)))
+          ((a b) (a b A) (((a a))))
           ((a a) (e) nil)
           )
          )
         (
          ((A) ($ $)) ;; T1
          (
-          ((a b) (S a a) ((a a)))
-          ((a a) (S a a) ((a a)))
+          ((a b) (S a a) (((a a))))
+          ((a a) (S a a) (((a a))))
           ((b $) (b) nil)
           )
          )
@@ -112,7 +112,7 @@
          ((S) ($ $)) ;; T0
          (
           (($ $) (e) nil)
-          ((a b) (a b A) (($ $)))
+          ((a b) (a b A) ((($ $))))
           )
          )
         )
@@ -120,7 +120,7 @@
     )
   (message "Passed Example 5.17 p. 354")
 
-  (message "Passed tests for 
(parser-generator-ll--generate-goto-table-k-gt-1)"))
+  (message "Passed tests for (parser-generator-ll--generate-goto-table)"))
 
 (defun parser-generator-ll-test--generate-action-table-k-gt-1 ()
   "Test `parser-generator-ll--generate-action-table-k-gt-1'."
@@ -141,7 +141,7 @@
    )
   (parser-generator-process-grammar)
   (let* ((goto-table
-          (parser-generator-ll--generate-goto-table-k-gt-1))
+          (parser-generator-ll--generate-goto-table))
          (action-table
           (parser-generator-ll--generate-action-table-k-gt-1
            goto-table)))
@@ -195,7 +195,7 @@
    )
   (parser-generator-process-grammar)
   (let* ((goto-table
-          (parser-generator-ll--generate-goto-table-k-gt-1))
+          (parser-generator-ll--generate-goto-table))
          (action-table
           (parser-generator-ll--generate-action-table-k-gt-1
            goto-table)))
@@ -243,7 +243,7 @@
 
   (message "Passed tests for 
(parser-generator-ll--generate-action-table-k-gt-1)"))
 
-(defun parser-generator-ll-test--parse ()
+(defun parser-generator-ll-test-parse ()
   "Test `parser-generator-ll-parse'."
   (message "Started tests for (parser-generator-ll-parse)")
 
@@ -262,7 +262,7 @@
      )
    )
   (parser-generator-process-grammar)
-  (parser-generator-ll-generate-parser-tables)
+  (parser-generator-ll-generate-table)
   (setq
    parser-generator-lex-analyzer--function
    (lambda (index)
@@ -304,7 +304,7 @@
      )
    )
   (parser-generator-process-grammar)
-  (parser-generator-ll-generate-parser-tables)
+  (parser-generator-ll-generate-table)
   (setq
    parser-generator-lex-analyzer--function
    (lambda (index)
@@ -344,7 +344,7 @@
      )
    )
   (parser-generator-process-grammar)
-  (parser-generator-ll-generate-parser-tables)
+  (parser-generator-ll-generate-table)
   (setq
    parser-generator-lex-analyzer--function
    (lambda (index)
@@ -387,7 +387,7 @@
      )
    )
   (parser-generator-process-grammar)
-  (parser-generator-ll-generate-parser-tables)
+  (parser-generator-ll-generate-table)
   (setq
    parser-generator-lex-analyzer--function
    (lambda (index)
@@ -407,10 +407,9 @@
      (car token)))
   (should
    (equal
-    '(0 3 6 0 3 7 5 2 5) ;; Example is 1-indexed '(1 4 7 1 4 8 5 8 6 3 6 3)
+    '(0 3 6 0 3 7 4 7 5 2 5 2) ;; Example is 1-indexed '(1 4 7 1 4 8 5 8 6 3 6 
3)
     (parser-generator-ll-parse)))
   (message "Passed example 5.12 p. 346-347")
-  ;; TODO Make this pass
 
   (message "Passed tests for (parser-generator-ll-parse)"))
 
@@ -524,9 +523,9 @@
 
   (message "Passed tests for (parser-generator-ll--valid-grammar-k-gt-1-p)"))
 
-(defun parser-generator-ll-test--generate-table-k-eq-1 ()
-  "Test `parser-generator-ll--generate-table-k-eq-1'."
-  (message "Started tests for (parser-generator-ll--generate-table-k-eq-1)")
+(defun parser-generator-ll-test--generate-action-table-k-eq-1 ()
+  "Test `parser-generator-ll--generate-action-table-k-eq-1'."
+  (message "Started tests for 
(parser-generator-ll--generate-action-table-k-eq-1)")
 
   (parser-generator-set-eof-identifier '$)
   (parser-generator-set-e-identifier 'e)
@@ -544,23 +543,24 @@
    )
   (parser-generator-process-grammar)
   (let* ((tables
-          (parser-generator-ll--generate-table-k-eq-1)))
+          (parser-generator-ll--generate-action-table-k-eq-1
+           (parser-generator-ll--generate-goto-table))))
     ;; (message "tables: %S" tables)
     (should
      (equal
       '(
-        (A
-         (
-          ((b) reduce (b S A) 3)
-          ((a) reduce (a) 2)
-          )
-         )
         (S
          (
           ((b) reduce (b) 1)
           ((a) reduce (a A S) 0)
           )
          )
+        (A
+         (
+          ((b) reduce (b S A) 3)
+          ((a) reduce (a) 2)
+          )
+         )
         (b (((b) pop)))
         (a (((a) pop)))
         ($ ((($) accept)))
@@ -569,7 +569,6 @@
      )))
   (message "Passed Example 5.5 p. 340")
 
-  ;; TODO Make this pass
   (parser-generator-set-eof-identifier '$)
   (parser-generator-set-e-identifier 'e)
   (parser-generator-set-look-ahead-number 1)
@@ -588,22 +587,24 @@
      )
    )
   (parser-generator-process-grammar)
-  (let ((tables (parser-generator-ll--generate-table-k-eq-1)))
-    (message "tables: %S" tables)
+  (let ((tables
+         (parser-generator-ll--generate-action-table-k-eq-1
+          (parser-generator-ll--generate-goto-table))))
+    ;; (message "tables: %S" tables)
     (should
      (equal
       '(
-        (F
+        (E
          (
-          (("a") reduce ("a") 7)
-          (("(") reduce ("(" E ")") 6)
+          (("a") reduce (T E2) 0)
+          (("(") reduce (T E2) 0)
           )
          )
-        (T2
+        (E2
          (
-          ((e) reduce (e) 5)
-          ((")") reduce (e) 5)
-          (("*") reduce ("*" F T2) 4)
+          (($) reduce (e) 2)
+          (("+") reduce ("+" T E2) 1)
+          ((")") reduce (e) 2)
           )
          )
         (T
@@ -612,17 +613,18 @@
           (("(") reduce (F T2) 3)
           )
          )
-        (E2
+        (T2
          (
-          ((e) reduce (e) 2)
-          ((")") reduce (e) 2)
-          (("+") reduce ("+" T E2) 1)
+          (("+") reduce (e) 5)
+          ((")") reduce (e) 5)
+          (("*") reduce ("*" F T2) 4)
+          (($) reduce (e) 5)
           )
          )
-        (E
+        (F
          (
-          (("a") reduce (T E2) 0)
-          (("(") reduce (T E2) 0)
+          (("a") reduce ("a") 7)
+          (("(") reduce ("(" E ")") 6)
           )
          )
         ("a" ((("a") pop)))
@@ -635,7 +637,7 @@
       tables)))
   (message "Passed Example 5.12 p. 346-347")
 
-  (message "Passed tests for (parser-generator-ll--generate-table-k-eq-1)"))
+  (message "Passed tests for 
(parser-generator-ll--generate-action-table-k-eq-1)"))
 
 (defun parser-generator-ll-test--valid-grammar-k-eq-1-p ()
   "Test `parser-generator-ll--valid-grammar-k-eq-1-p'."
@@ -650,14 +652,14 @@
   "Run test."
 
   ;; Helpers
+  (parser-generator-ll-test--generate-goto-table)
 
   ;; k > 1
-  (parser-generator-ll-test--generate-goto-table-k-gt-1)
   (parser-generator-ll-test--generate-action-table-k-gt-1)
   (parser-generator-ll-test--valid-grammar-k-gt-1-p)
 
   ;; k = 1
-  (parser-generator-ll-test--generate-table-k-eq-1)
+  (parser-generator-ll-test--generate-action-table-k-eq-1)
   (parser-generator-ll-test--valid-grammar-k-eq-1-p)
 
   ;; Main stuff