[elpa] externals/parser-generator 172d530 214/434: Improved handling of production LHS to enable multiple symbols

[ELPA Syncer]

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

    Improved handling of production LHS to enable multiple symbols
---
 parser-generator-lr.el           |  65 ++++++++++++++------
 parser-generator.el              |  10 +++-
 test/parser-generator-lr-test.el | 124 +++++++++++++++++++++------------------
 3 files changed, 122 insertions(+), 77 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 72e0bca..5f29073 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -373,7 +373,8 @@
 
       ;; Iterate all productions in grammar
       (let ((lr-items-e)
-            (start-productions (parser-generator--get-grammar-rhs start))
+            (start-productions
+             (parser-generator--get-grammar-rhs start))
             (e-list (parser-generator--generate-list-of-symbol
                      parser-generator--look-ahead-number
                      parser-generator--e-identifier)))
@@ -381,8 +382,8 @@
         ;; (a)
         (dolist (rhs start-productions)
           ;; Add [S -> . α] to V(e)
-          (push `(,start nil ,rhs ,e-list) lr-items-e)
-          (puthash `(,e-list ,start nil ,rhs ,e-list) t lr-item-exists))
+          (push `(,(list start) nil ,rhs ,e-list) lr-items-e)
+          (puthash `(,e-list ,(list start) nil ,rhs ,e-list) t lr-item-exists))
 
         ;; (b) Iterate every item in v-set(e), if [A -> . Bα, u] is an item 
and B -> β is in P
         ;; then for each x in FIRST(αu) add [B -> . β, x] to v-set(e), 
provided it is not already there
@@ -405,14 +406,18 @@
                   (let ((rhs-first (car rhs)))
                     (parser-generator--debug
                      (message "rhs-first: %s" rhs-first))
-                    (when (parser-generator--valid-non-terminal-p rhs-first)
+                    (when
+                        (parser-generator--valid-non-terminal-p
+                         rhs-first)
                       (let ((rhs-rest (append (cdr rhs) suffix)))
                         (let ((rhs-rest-first (parser-generator--first 
rhs-rest)))
                           (parser-generator--debug
                            (message "rhs-rest-first: %s" rhs-rest-first))
                           (unless rhs-rest-first
                             (setq rhs-rest-first `(,e-list)))
-                          (let ((sub-production 
(parser-generator--get-grammar-rhs rhs-first)))
+                          (let ((sub-production
+                                 (parser-generator--get-grammar-rhs
+                                  rhs-first)))
                             (parser-generator--debug
                              (message "sub-production: %s" sub-production))
 
@@ -434,9 +439,17 @@
                                  (message "f: %s" f))
 
                                 ;; Add [B -> . β, x] to V(e), provided it is 
not already there
-                                (unless (gethash `(e ,rhs-first nil ,sub-rhs 
,f) lr-item-exists)
-                                  (puthash `(e ,rhs-first nil ,sub-rhs ,f) t 
lr-item-exists)
-                                  (push `(,rhs-first nil ,sub-rhs ,f) 
lr-items-e)
+                                (unless
+                                    (gethash
+                                     `(e ,(list rhs-first) nil ,sub-rhs ,f)
+                                     lr-item-exists)
+                                  (puthash
+                                   `(e ,(list rhs-first) nil ,sub-rhs ,f)
+                                   t
+                                   lr-item-exists)
+                                  (push
+                                   `(,(list rhs-first) nil ,sub-rhs ,f)
+                                   lr-items-e)
 
                                   ;; (c) Repeat (b) until no more items can be 
added to V(e)
                                   (setq found-new t))))))))))))))
@@ -444,7 +457,9 @@
         (parser-generator--debug
          (message "V(e) = %s" lr-items-e))
 
-        (setq lr-items-e (sort lr-items-e 'parser-generator--sort-list))
+        (setq
+         lr-items-e
+         (sort lr-items-e 'parser-generator--sort-list))
 
         ;; 2 Suppose that we have constructed V(X1,X2,...,Xi-1) we construct 
V(X1,X2,...,Xi) as follows:
         ;; Only do this step if prefix is not the e-identifier
@@ -471,7 +486,9 @@
 
                 ;; Fill up rest of prefix with e-identifier if length is below 
k
                 (while (< (length prefix) k)
-                  (push parser-generator--e-identifier prefix))
+                  (push
+                   parser-generator--e-identifier
+                   prefix))
                 (setq prefix (reverse prefix))
 
                 (let ((lr-new-item))
@@ -509,7 +526,9 @@
             (lr-item-suffix-i 0))
 
         ;; Gather first and rest of suffix dependent on look-ahead number
-        (let ((lr-item-suffix-length (length lr-item-suffix)))
+        (let
+            ((lr-item-suffix-length
+              (length lr-item-suffix)))
           (while
               (< lr-item-suffix-i lr-item-suffix-length)
             (if
@@ -596,17 +615,27 @@
                         ;; then add [B -> . D, x] to V(X1,...,Xi) for each x 
in FIRST(bu)
                         ;; provided it is not already there
                         (let ((lr-item-to-add
-                               `(,lr-item-suffix-first nil ,sub-rhs ,f)))
-                          (unless (gethash lr-item-to-add lr-item-exists)
+                               `(,(list lr-item-suffix-first) nil ,sub-rhs 
,f)))
+                          (unless
+                              (gethash
+                               lr-item-to-add
+                               lr-item-exists)
                             (setq added-new t)
                             (parser-generator--debug
                              (message
                               "lr-item-to-add: %s"
                               lr-item-to-add))
-                            (puthash lr-item-to-add t lr-item-exists)
-                            (push lr-item-to-add lr-new-item)))))))))))))
+                            (puthash
+                             lr-item-to-add
+                             t
+                             lr-item-exists)
+                            (push
+                             lr-item-to-add
+                             lr-new-item)))))))))))))
 
-    (setq lr-new-item (sort lr-new-item 'parser-generator--sort-list))
+    (setq
+     lr-new-item
+     (sort lr-new-item 'parser-generator--sort-list))
     lr-new-item))
 
 (defun parser-generator-lr-parse
@@ -904,9 +933,7 @@
 
                (t (error
                    "Invalid action-match: %s!"
-                   action-match)))
-
-              (error "was here"))))))
+                   action-match))))))))
     (unless accept
       (error
        "Parsed entire string without getting accepting! Output: %s"
diff --git a/parser-generator.el b/parser-generator.el
index 8a285db..c47252c 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -11,7 +11,7 @@
 
 
 (defvar parser-generator--debug
-  t
+  nil
   "Whether to print debug messages or not.")
 
 (defvar parser-generator--e-identifier
@@ -197,7 +197,11 @@
   "Return right hand sides of LHS if there is any."
   (unless parser-generator--table-productions-rhs
     (error "Table for productions RHS indexed by LHS is undefined!"))
-  (gethash lhs parser-generator--table-productions-rhs))
+  (unless (listp lhs)
+    (setq lhs (list lhs)))
+  (gethash
+   lhs
+   parser-generator--table-productions-rhs))
 
 (defun parser-generator--get-grammar-start (&optional G)
   "Return start of grammar G."
@@ -295,6 +299,8 @@
     (dolist (p productions)
       (let ((lhs (car p))
             (rhs (cdr p)))
+        (unless (listp lhs)
+          (setq lhs (list lhs)))
         (let ((new-value
                (gethash
                 lhs
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index c8f5253..4580b89 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -84,26 +84,29 @@
   (message "Starting tests for (parser-generator-lr--generate-goto-tables)")
 
   ;; Example 5.30, p. 389
-  (parser-generator-set-grammar '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) 
Sp))
+  (parser-generator-set-grammar
+   '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) Sp))
   (parser-generator-set-look-ahead-number 1)
   (parser-generator-process-grammar)
   (let ((table-lr-items (parser-generator-lr--generate-goto-tables)))
 
-    (message
-     "GOTO-table: %s"
-     (parser-generator--hash-to-list
-      parser-generator-lr--goto-tables))
-    (message
-     "LR-items: %s"
-     (parser-generator--hash-to-list
-      table-lr-items))
+    (parser-generator--debug
+     (message
+      "GOTO-table: %s"
+      (parser-generator--hash-to-list
+       parser-generator-lr--goto-tables))
+     (message
+      "LR-items: %s"
+      (parser-generator--hash-to-list
+       table-lr-items)))
 
     (parser-generator-lr--generate-action-tables
      table-lr-items)
-    (message
-     "ACTION-tables: %s"
-     (parser-generator--hash-to-list
-      parser-generator-lr--action-tables))
+    (parser-generator--debug
+     (message
+      "ACTION-tables: %s"
+      (parser-generator--hash-to-list
+       parser-generator-lr--action-tables)))
 
     (should
      (equal
@@ -121,14 +124,14 @@
 
     (should
      (equal
-      '((0 ((S nil (S a S b) (a)) (S nil (S a S b) (e)) (S nil nil (a)) (S nil 
nil (e)) (Sp nil (S) (e))))
-        (1 ((S (S) (a S b) (a)) (S (S) (a S b) (e)) (Sp (S) nil (e))))
-        (2 ((S (S a) (S b) (a)) (S (S a) (S b) (e)) (S nil (S a S b) (a)) (S 
nil (S a S b) (b)) (S nil nil (a)) (S nil nil (b))))
-        (3 ((S (S) (a S b) (a)) (S (S) (a S b) (b)) (S (S a S) (b) (a)) (S (S 
a S) (b) (e))))
-        (4 ((S (S a) (S b) (a)) (S (S a) (S b) (b)) (S nil (S a S b) (a)) (S 
nil (S a S b) (b)) (S nil nil (a)) (S nil nil (b))))
-        (5 ((S (S a S b) nil (a)) (S (S a S b) nil (e))))
-        (6 ((S (S) (a S b) (a)) (S (S) (a S b) (b)) (S (S a S) (b) (a)) (S (S 
a S) (b) (b))))
-        (7 ((S (S a S b) nil (a)) (S (S a S b) nil (b)))))
+      '((0 (((S) nil (S a S b) (a)) ((S) nil (S a S b) (e)) ((S) nil nil (a)) 
((S) nil nil (e)) ((Sp) nil (S) (e))))
+        (1 (((S) (S) (a S b) (a)) ((S) (S) (a S b) (e)) ((Sp) (S) nil (e))))
+        (2 (((S) (S a) (S b) (a)) ((S) (S a) (S b) (e)) ((S) nil (S a S b) 
(a)) ((S) nil (S a S b) (b)) ((S) nil nil (a)) ((S) nil nil (b))))
+        (3 (((S) (S) (a S b) (a)) ((S) (S) (a S b) (b)) ((S) (S a S) (b) (a)) 
((S) (S a S) (b) (e))))
+        (4 (((S) (S a) (S b) (a)) ((S) (S a) (S b) (b)) ((S) nil (S a S b) 
(a)) ((S) nil (S a S b) (b)) ((S) nil nil (a)) ((S) nil nil (b))))
+        (5 (((S) (S a S b) nil (a)) ((S) (S a S b) nil (e))))
+        (6 (((S) (S) (a S b) (a)) ((S) (S) (a S b) (b)) ((S) (S a S) (b) (a)) 
((S) (S a S) (b) (b))))
+        (7 (((S) (S a S b) nil (a)) ((S) (S a S b) nil (b)))))
       (parser-generator--hash-to-list
        table-lr-items))))
   (message "Passed LR-items")
@@ -136,7 +139,8 @@
   (message "Passed LR-items for example 5.30")
 
   ;; Example 5.30, p. 389 but with terminals as strings
-  (parser-generator-set-grammar '((Sp S) ("a" "b") ((Sp S) (S (S "a" S "b")) 
(S e)) Sp))
+  (parser-generator-set-grammar
+   '((Sp S) ("a" "b") ((Sp S) (S (S "a" S "b")) (S e)) Sp))
   (parser-generator-set-look-ahead-number 1)
   (parser-generator-process-grammar)
 
@@ -161,14 +165,14 @@
 
     (should
      (equal
-      '((0 ((S nil (S "a" S "b") ("a")) (S nil (S "a" S "b") (e)) (S nil nil 
("a")) (S nil nil (e)) (Sp nil (S) (e))))
-        (1 ((S (S) ("a" S "b") ("a")) (S (S) ("a" S "b") (e)) (Sp (S) nil 
(e))))
-        (2 ((S (S "a") (S "b") ("a")) (S (S "a") (S "b") (e)) (S nil (S "a" S 
"b") ("a")) (S nil (S "a" S "b") ("b")) (S nil nil ("a")) (S nil nil ("b"))))
-        (3 ((S (S) ("a" S "b") ("a")) (S (S) ("a" S "b") ("b")) (S (S "a" S) 
("b") ("a")) (S (S "a" S) ("b") (e))))
-        (4 ((S (S "a") (S "b") ("a")) (S (S "a") (S "b") ("b")) (S nil (S "a" 
S "b") ("a")) (S nil (S "a" S "b") ("b")) (S nil nil ("a")) (S nil nil ("b"))))
-        (5 ((S (S "a" S "b") nil ("a")) (S (S "a" S "b") nil (e))))
-        (6 ((S (S) ("a" S "b") ("a")) (S (S) ("a" S "b") ("b")) (S (S "a" S) 
("b") ("a")) (S (S "a" S) ("b") ("b"))))
-        (7 ((S (S "a" S "b") nil ("a")) (S (S "a" S "b") nil ("b")))))
+      '((0 (((S) nil (S "a" S "b") ("a")) ((S) nil (S "a" S "b") (e)) ((S) nil 
nil ("a")) ((S) nil nil (e)) ((Sp) nil (S) (e))))
+        (1 (((S) (S) ("a" S "b") ("a")) ((S) (S) ("a" S "b") (e)) ((Sp) (S) 
nil (e))))
+        (2 (((S) (S "a") (S "b") ("a")) ((S) (S "a") (S "b") (e)) ((S) nil (S 
"a" S "b") ("a")) ((S) nil (S "a" S "b") ("b")) ((S) nil nil ("a")) ((S) nil 
nil ("b"))))
+        (3 (((S) (S) ("a" S "b") ("a")) ((S) (S) ("a" S "b") ("b")) ((S) (S 
"a" S) ("b") ("a")) ((S) (S "a" S) ("b") (e))))
+        (4 (((S) (S "a") (S "b") ("a")) ((S) (S "a") (S "b") ("b")) ((S) nil 
(S "a" S "b") ("a")) ((S) nil (S "a" S "b") ("b")) ((S) nil nil ("a")) ((S) nil 
nil ("b"))))
+        (5 (((S) (S "a" S "b") nil ("a")) ((S) (S "a" S "b") nil (e))))
+        (6 (((S) (S) ("a" S "b") ("a")) ((S) (S) ("a" S "b") ("b")) ((S) (S 
"a" S) ("b") ("a")) ((S) (S "a" S) ("b") ("b"))))
+        (7 (((S) (S "a" S "b") nil ("a")) ((S) (S "a" S "b") nil ("b")))))
       (parser-generator--hash-to-list table-lr-items)))
     (message "Passed LR-items with tokens as strings"))
 
@@ -181,25 +185,26 @@
   (message "Starting tests for (parser-generator-lr--items-for-prefix)")
 
   ;; Example 5.29 p 387
-  (parser-generator-set-grammar '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) 
Sp))
+  (parser-generator-set-grammar
+   '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) Sp))
   (parser-generator-set-look-ahead-number 1)
   (parser-generator-process-grammar)
 
   (should
    (equal
-    '((S nil (S a S b) (a))
-      (S nil (S a S b) (e))
-      (S nil nil (a))
-      (S nil nil (e))
-      (Sp nil (S) (e)))
+    '(((S) nil (S a S b) (a))
+      ((S) nil (S a S b) (e))
+      ((S) nil nil (a))
+      ((S) nil nil (e))
+      ((Sp) nil (S) (e)))
     (parser-generator-lr--items-for-prefix 'e)))
   (message "Passed V(e)")
 
   (should
    (equal
-    '((S (S) (a S b) (a))
-      (S (S) (a S b) (e))
-      (Sp (S) nil (e)))
+    '(((S) (S) (a S b) (a))
+      ((S) (S) (a S b) (e))
+      ((Sp) (S) nil (e)))
     (parser-generator-lr--items-for-prefix 'S)))
   (message "Passed V(S)")
 
@@ -217,12 +222,12 @@
 
   (should
    (equal
-    '((S (S a) (S b) (a))
-      (S (S a) (S b) (e))
-      (S nil (S a S b) (a))
-      (S nil (S a S b) (b))
-      (S nil nil (a))
-      (S nil nil (b)))
+    '(((S) (S a) (S b) (a))
+      ((S) (S a) (S b) (e))
+      ((S) nil (S a S b) (a))
+      ((S) nil (S a S b) (b))
+      ((S) nil nil (a))
+      ((S) nil nil (b)))
     (parser-generator-lr--items-for-prefix '(S a))))
   (message "Passed V(Sa)")
 
@@ -241,10 +246,10 @@
   ;; a3 p. 390
   (should
    (equal
-    '((S (S) (a S b) (a))
-      (S (S) (a S b) (b))
-      (S (S a S) (b) (a))
-      (S (S a S) (b) (e)))
+    '(((S) (S) (a S b) (a))
+      ((S) (S) (a S b) (b))
+      ((S) (S a S) (b) (a))
+      ((S) (S a S) (b) (e)))
     (parser-generator-lr--items-for-prefix '(S a S))))
   (message "Passed V(SaS)")
 
@@ -336,10 +341,12 @@
   (parser-generator-set-look-ahead-number 1)
   (parser-generator-process-grammar)
   (let ((lr-items (parser-generator-lr-generate-parser-tables)))
-    (message "lr-items: %s" (parser-generator--hash-values-to-list lr-items t))
+    (parser-generator--debug
+     (message "lr-items: %s" (parser-generator--hash-values-to-list lr-items 
t)))
     )
-  (message "goto-tables: %s" (parser-generator--hash-values-to-list 
parser-generator-lr--goto-tables t))
-  (message "action-tables: %s" (parser-generator--hash-values-to-list 
parser-generator-lr--action-tables t))
+  (parser-generator--debug
+   (message "goto-tables: %s" (parser-generator--hash-values-to-list 
parser-generator-lr--goto-tables t))
+   (message "action-tables: %s" (parser-generator--hash-values-to-list 
parser-generator-lr--action-tables t)))
   (setq
    parser-generator-lex-analyzer--function
    (lambda (index)
@@ -393,18 +400,23 @@
   (parser-generator-lr-test--parse-incremental-vs-regular)
   (message "Passed incremental-tests")
 
+  (message "Starting test with look-ahead number = 2")
+
   (parser-generator-set-grammar '((Sp S) ("a" "b") ((Sp S) (S (S "a" S "b")) 
(S e)) Sp))
   (parser-generator-set-look-ahead-number 2)
   (parser-generator-process-grammar)
   (let ((lr-items (parser-generator-lr--generate-goto-tables)))
-    (message "lr-items: %s" (parser-generator--hash-values-to-list lr-items t))
+    (parser-generator--debug
+     (message "lr-items: %s" (parser-generator--hash-values-to-list lr-items 
t)))
 
     ;; TODO Fix so that there is an accept path in look-ahead number 2
-    
-    (message "goto-tables: %s" (parser-generator--hash-values-to-list 
parser-generator-lr--goto-tables t))
+
+    (parser-generator--debug
+     (message "goto-tables: %s" (parser-generator--hash-values-to-list 
parser-generator-lr--goto-tables t)))
     (parser-generator-lr--generate-action-tables lr-items)
     ;; TODO Should generate accept somewhere in this action-table
-    (message "action-tables: %s" (parser-generator--hash-values-to-list 
parser-generator-lr--action-tables t)))
+    (parser-generator--debug
+     (message "action-tables: %s" (parser-generator--hash-values-to-list 
parser-generator-lr--action-tables t))))
   (setq
    parser-generator-lex-analyzer--function
    (lambda (index)