[elpa] externals/parser-generator 517ed12 212/434: Passing some more unit tests after refactor

[ELPA Syncer]

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

    Passing some more unit tests after refactor
---
 parser-generator-lr.el           | 58 +++++++++++++++++++++++++++-------------
 test/parser-generator-lr-test.el | 39 ++++++++++++++++-----------
 2 files changed, 63 insertions(+), 34 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 4b3b12e..e7ebeed 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -426,23 +426,45 @@
 
         ;; 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
-        (let ((prefix-previous lr-items-e))
-          (unless (and
-                   (>= (length γ) 1)
-                   (parser-generator--valid-e-p (car γ)))
-            (dolist (prefix γ) ;; TODO Make this depend on look-ahead number
-              (let ((lr-new-item))
-                (setq lr-new-item
-                      (parser-generator-lr--items-for-goto
-                       prefix-previous
-                       prefix))
-
-                (parser-generator--debug
-                 (message "prefix: %s" prefix)
-                 (message "prefix-previous: %s" prefix-previous)
-                 (message "lr-new-item: %s" lr-new-item))
-
-                (setq prefix-previous lr-new-item))))
+        (let ((prefix-previous lr-items-e)
+              (γ-length (length γ))
+              (γ-index 0)
+              (k parser-generator--look-ahead-number))
+          (unless
+              (and
+               (>= γ-length 1)
+               (parser-generator--valid-e-p (car γ)))
+
+            (while (< γ-index γ-length)
+              (let ((k-index 0)
+                    (prefix))
+
+                ;; Build prefix of length k
+                (while (and
+                        (< k-index k)
+                        (< γ-index γ-length))
+                  (push (nth γ-index γ) prefix)
+                  (setq γ-index (1+ γ-index))
+                  (setq k-index (1+ k-index)))
+
+                ;; Fill up rest of prefix with e-identifier if length is below 
k
+                (while (< (length prefix) k)
+                  (push parser-generator--e-identifier prefix))
+                (setq prefix (reverse prefix))
+
+                (let ((lr-new-item))
+                  (setq
+                   lr-new-item
+                   (parser-generator-lr--items-for-goto
+                    prefix-previous
+                    prefix))
+
+                  (parser-generator--debug
+                   (message "prefix: %s" prefix)
+                   (message "prefix-previous: %s" prefix-previous)
+                   (message "lr-new-item: %s" lr-new-item))
+
+                  (setq prefix-previous lr-new-item)))))
 
           (parser-generator--debug
            (message "γ: %s" γ))
@@ -495,7 +517,7 @@
         (when (equal lr-item-suffix-first x)
 
           ;; Add [A -> aXi . B, u] to V(X1,...,Xi)
-          (let ((combined-prefix (append lr-item-prefix (list x))))
+          (let ((combined-prefix (append lr-item-prefix x)))
             (parser-generator--debug
              (message
               "lr-new-item-1: %s"
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 78b8d21..0593a50 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -104,15 +104,17 @@
 
     (should
      (equal
-      '((0 ((S 1)))
-        (1 ((a 2)))
-        (2 ((S 3)))
-        (3 ((a 4) (b 5)))
-        (4 ((S 6)))
+      '((0 (((S) 1)))
+        (1 (((a) 2)))
+        (2 (((S) 3)))
+        (3 (((a) 4) ((b) 5)))
+        (4 (((S) 6)))
         (5 nil)
-        (6 ((a 4) (b 7)))
+        (6 (((a) 4) ((b) 7)))
         (7 nil))
-      (parser-generator--hash-to-list parser-generator-lr--goto-tables)))
+      (parser-generator--hash-to-list
+       parser-generator-lr--goto-tables)))
+    (message "Passed GOTO-tables")
 
     (should
      (equal
@@ -124,7 +126,9 @@
         (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))))
+      (parser-generator--hash-to-list
+       table-lr-items))))
+  (message "Passed LR-items")
 
   (message "Passed LR-items for example 5.30")
 
@@ -133,22 +137,24 @@
   (parser-generator-set-look-ahead-number 1)
   (parser-generator-process-grammar)
 
-  (let ((table-lr-items (parser-generator-lr-generate-parser-tables)))
+  (let ((table-lr-items
+         (parser-generator-lr-generate-parser-tables)))
 
     ;; (message "GOTO-table: %s" (parser-generator--hash-to-list 
parser-generator-lr--goto-tables))
     ;; (message "LR-items: %s" (parser-generator--hash-to-list 
parser-generator-lr--items))
 
     (should
      (equal
-      '((0 ((S 1)))
-        (1 (("a" 2)))
-        (2 ((S 3)))
-        (3 (("a" 4) ("b" 5)))
-        (4 ((S 6)))
+      '((0 (((S) 1)))
+        (1 ((("a") 2)))
+        (2 (((S) 3)))
+        (3 ((("a") 4) (("b") 5)))
+        (4 (((S) 6)))
         (5 nil)
-        (6 (("a" 4) ("b" 7)))
+        (6 ((("a") 4) (("b") 7)))
         (7 nil))
       (parser-generator--hash-to-list parser-generator-lr--goto-tables)))
+    (message "Passed GOTO-tables with tokens as strings")
 
     (should
      (equal
@@ -160,7 +166,8 @@
         (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))))
+      (parser-generator--hash-to-list table-lr-items)))
+    (message "Passed LR-items with tokens as strings"))
 
   (message "Passed LR-items for example 5.30 but with tokens as strings")