[elpa] externals/parser-generator e3d3007 109/434: Tweaking of action-table generation for canonical LR-parser

[ELPA Syncer]

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

    Tweaking of action-table generation for canonical LR-parser
---
 parser-lr.el           | 13 +++++++++----
 parser.el              |  2 +-
 test/parser-lr-test.el | 24 ++++++++++++++++++++++++
 3 files changed, 34 insertions(+), 5 deletions(-)

diff --git a/parser-lr.el b/parser-lr.el
index ed1f8dd..c234817 100644
--- a/parser-lr.el
+++ b/parser-lr.el
@@ -76,7 +76,8 @@
                             ;; (message "Cv: %s" Cv)
                             (when Cv
                               (let ((eff (parser--e-free-first Cv)))
-                                ;; (message "eff: %s" eff)
+                                ;; TODO This does not return correct
+                                (message "EFF%s: %s" Cv eff)
                                 (when eff
                                   ;; Go through eff-items and see if any item 
is a valid look-ahead of grammar
                                   ;; in that case save in action table a shift 
action here
@@ -106,14 +107,18 @@
                       ;; (b) f(u) = reduce i if [A -> B ., u] is in a and A -> 
B is production i in P, i > 1
                       (when (and
                              (nth 0 lr-item)
-                             (nth 1 lr-item)
                              (not (nth 2 lr-item)))
-                        (let ((u (nth 3 lr-item)))
+                        (let ((A (nth 0 lr-item))
+                              (B (nth 1 lr-item))
+                              (u (nth 3 lr-item)))
+                          (unless B
+                            (setq B (list parser--e-identifier)))
                           (when (parser--valid-look-ahead-p u)
                             (let ((hash-key (format "%s-%s-%s" goto-index 
state u)))
                               (unless (gethash hash-key added-actions)
                                 (puthash hash-key t added-actions)
-                                (let ((production (list (nth 0 lr-item) 
(append (nth 1 lr-item) (nth 2 lr-item)))))
+                                (let ((production (list A B)))
+                                  ;; (message "production: %s" production)
                                   (let ((production-number 
(parser--get-grammar-production-number production)))
                                     (unless production-number
                                       (error "Expecting production number for 
%s from LR-item %s!" production lr-item))
diff --git a/parser.el b/parser.el
index d4a110b..f025db9 100644
--- a/parser.el
+++ b/parser.el
@@ -237,7 +237,7 @@
           (puthash lhs (nreverse new-value) parser--table-productions-rhs))))
 
     (setq parser--table-productions-number (make-hash-table :test 'equal))
-    (let ((production-index 1))
+    (let ((production-index 0))
       (dolist (p productions)
         (let ((lhs (car p))
               (rhs (cdr p))
diff --git a/test/parser-lr-test.el b/test/parser-lr-test.el
index 5ab16e0..1c7105f 100644
--- a/test/parser-lr-test.el
+++ b/test/parser-lr-test.el
@@ -22,6 +22,30 @@
   (parser-lr--generate-goto-tables)
   (parser-lr--generate-action-tables)
 
+  (should
+   (equal
+    '((0 ((S 1)))
+      (1 ((a 2)))
+      (2 ((S 3)))
+      (3 ((a 4) (b 5)))
+      (4 ((S 6)))
+      (5 nil)
+      (6 ((a 4) (b 7)))
+      (7 nil))
+    parser-lr--goto-tables))
+
+  (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)))))
+    (parser--hash-to-list parser-lr--items)))
+
   ;; Fig. 5.9 p. 374
   (should
    (equal