[elpa] externals/parser-generator 51cab75 061/434: More debugging

[ELPA Syncer]

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

    More debugging
---
 parser.el           | 134 +++++++++++++++++++++++++++++-----------------------
 test/parser-test.el |  22 +++++----
 2 files changed, 86 insertions(+), 70 deletions(-)

diff --git a/parser.el b/parser.el
index 6544898..f33c556 100644
--- a/parser.el
+++ b/parser.el
@@ -11,7 +11,7 @@
 
 
 (defvar parser--debug
-  nil
+  t
   "Whether to print debug messages or not.")
 
 (defvar parser--table-non-terminal-p
@@ -683,7 +683,7 @@
                           (parser--debug
                            (message "rhs-rest-first: %s" rhs-rest-first))
                           (unless rhs-rest-first
-                            (setq rhs-rest-first (list nil)))
+                            (setq rhs-rest-first '((e))))
                           (let ((sub-production (parser--get-grammar-rhs 
rhs-first)))
 
                             ;; For each production with B as LHS
@@ -703,66 +703,80 @@
 
                                   ;; (c) Repeat (b) until no more items can be 
added to v-set(e)
                                   (setq found-new t))))))))))))))
-        (puthash 'e lr-items-e lr-items))
-
-      ;; 2 Suppose that we have constructed V(X1,X2,...,Xi-1) we construct 
V(X1,X2,...,Xi) as follows:
-      (let ((prefix-acc)
-            (prefix-previous (gethash 'e lr-items)))
-        (dolist (prefix γ)
-          (let ((lr-new-item))
-            (setq prefix-acc (append prefix-acc prefix))
-            (unless (listp prefix-acc)
-              (setq prefix-acc (list prefix-acc)))
-
-            (dolist (lr-item prefix-previous)
-              (let ((lr-item-lhs (nth 0 lr-item))
-                    (lr-item-prefix (nth 1 lr-item))
-                    (lr-item-suffix (nth 2 lr-item))
-                    (lr-item-look-ahead (nth 3 lr-item)))
-                (let ((lr-item-suffix-first (car lr-item-suffix))
-                      (lr-item-suffix-rest (cdr lr-item-suffix)))
-
-                  ;; (a) If [A -> a . XiB, u] is in V(X1,...,Xi-1)
-                  (when (eq lr-item-suffix-first prefix)
-
-                    ;; Add [A -> aXi . B, u] to V(X1,...,Xi)
-                    (let ((combined-prefix (append lr-item-prefix (list 
prefix))))
-                      (push `(,lr-item-lhs ,combined-prefix 
,lr-item-suffix-rest ,lr-item-look-ahead) lr-new-item))))))
-
-            ;; (c) Repeat step (2b) until no more new items can be added to 
V(X1,...,Xi)
-            (let ((added-new t))
-              (while added-new
-                (setq added-new nil)
-                (dolist (lr-item lr-new-item)
-                  (let ((lr-item-suffix (nth 2 lr-item)))
-                    (let ((lr-item-suffix-first (car lr-item-suffix))
-                          (lr-item-suffix-rest (cdr lr-item-suffix)))
-
-                      ;; (b) If [A -> a . Bb, u] has been placed in 
V(X1,...,Xi)
-                      ;; and B -> D is in P
-                      (when (parser--valid-non-terminal-p lr-item-suffix-first)
-
-                        (let ((lr-item-suffix-rest-first (parser--first 
lr-item-suffix-rest)))
-                          (unless lr-item-suffix-rest-first
-                            (setq lr-item-suffix-rest-first (list nil)))
-                          (let ((sub-production (parser--get-grammar-rhs 
lr-item-suffix-first)))
-
-                            ;; For each production with B as LHS
-                            (dolist (sub-rhs sub-production)
-
-                              ;; For each x in FIRST(αu)
-                              (dolist (f lr-item-suffix-rest-first)
-
-                                ;; then add [B -> . D, x] to V(X1,...,Xi) for 
each x in FIRST(bu)
-                                ;; provided it is not already there
-                                (unless (gethash `(,prefix-acc 
,lr-item-suffix-first nil ,sub-rhs ,f) lr-item-exists)
-                                  (setq added-new t)
-                                  (puthash `(,prefix-acc ,lr-item-suffix-first 
nil ,sub-rhs ,f) t lr-item-exists)
-                                  (push `(,lr-item-suffix-first nil ,sub-rhs 
,f) lr-new-item))))))))))))
+        (parser--debug
+         (message "V(e) = %s" lr-items-e))
+        (puthash '(e) lr-items-e lr-items))
+
+      ;; Do step 2 only if prefix is not the e identifier
+      (unless (and
+               (= (length γ) 1)
+               (eq (car γ) 'e))
+        ;; 2 Suppose that we have constructed V(X1,X2,...,Xi-1) we construct 
V(X1,X2,...,Xi) as follows:
+        (let ((prefix-acc)
+              (prefix-previous (gethash '(e) lr-items)))
+          (dolist (prefix γ)
+            (let ((lr-new-item))
+              (setq prefix-acc (append prefix-acc prefix))
+              (unless (listp prefix-acc)
+                (setq prefix-acc (list prefix-acc)))
 
-            (setq prefix-previous prefix-acc)
-            (puthash prefix-acc lr-new-item lr-items))))
+              (parser--debug
+               (message "prefix-acc: %s" prefix-acc)
+               (message "prefix-previous: %s" prefix-previous))
+
+              (dolist (lr-item prefix-previous)
+                (let ((lr-item-lhs (nth 0 lr-item))
+                      (lr-item-prefix (nth 1 lr-item))
+                      (lr-item-suffix (nth 2 lr-item))
+                      (lr-item-look-ahead (nth 3 lr-item)))
+                  (let ((lr-item-suffix-first (car lr-item-suffix))
+                        (lr-item-suffix-rest (cdr lr-item-suffix)))
+
+                    ;; (a) If [A -> a . XiB, u] is in V(X1,...,Xi-1)
+                    (when (eq lr-item-suffix-first prefix)
+
+                      ;; Add [A -> aXi . B, u] to V(X1,...,Xi)
+                      (let ((combined-prefix (append lr-item-prefix (list 
prefix))))
+                        (push `(,lr-item-lhs ,combined-prefix 
,lr-item-suffix-rest ,lr-item-look-ahead) lr-new-item))))))
+
+              ;; (c) Repeat step (2b) until no more new items can be added to 
V(X1,...,Xi)
+              (let ((added-new t))
+                (while added-new
+                  (setq added-new nil)
+                  (dolist (lr-item lr-new-item)
+                    (let ((lr-item-suffix (nth 2 lr-item)))
+                      (let ((lr-item-suffix-first (car lr-item-suffix))
+                            (lr-item-suffix-rest (cdr lr-item-suffix)))
+
+                        ;; (b) If [A -> a . Bb, u] has been placed in 
V(X1,...,Xi)
+                        ;; and B -> D is in P
+                        (when (parser--valid-non-terminal-p 
lr-item-suffix-first)
+
+                          (let ((lr-item-suffix-rest-first (parser--first 
lr-item-suffix-rest)))
+                            (unless lr-item-suffix-rest-first
+                              (setq lr-item-suffix-rest-first (list nil)))
+                            (let ((sub-production (parser--get-grammar-rhs 
lr-item-suffix-first)))
+
+                              ;; For each production with B as LHS
+                              (dolist (sub-rhs sub-production)
+
+                                ;; For each x in FIRST(αu)
+                                (dolist (f lr-item-suffix-rest-first)
+
+                                  ;; then add [B -> . D, x] to V(X1,...,Xi) 
for each x in FIRST(bu)
+                                  ;; provided it is not already there
+                                  (unless (gethash `(,prefix-acc 
,lr-item-suffix-first nil ,sub-rhs ,f) lr-item-exists)
+                                    (setq added-new t)
+                                    (puthash `(,prefix-acc 
,lr-item-suffix-first nil ,sub-rhs ,f) t lr-item-exists)
+                                    (push `(,lr-item-suffix-first nil ,sub-rhs 
,f) lr-new-item))))))))))))
+
+              (setq prefix-previous lr-new-item)
+              (parser--debug
+               (message "V(%s) = %s" prefix-acc lr-new-item))
+              (puthash prefix-acc lr-new-item lr-items)))))
 
+      (parser--debug
+         (message "γ: %s" γ))
       (gethash γ lr-items))))
 
 
diff --git a/test/parser-test.el b/test/parser-test.el
index 1bd5588..fa0517f 100644
--- a/test/parser-test.el
+++ b/test/parser-test.el
@@ -231,6 +231,18 @@
   (parser--set-grammar '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) Sp))
   (parser--set-look-ahead-number 1)
 
+  '((S (e) nil (e)) (S (e) nil (a)))
+
+  (should
+   (equal
+    '((Sp nil (S) (e))
+      (S nil (S a S b) (e))
+      (S nil (S a S b) (a))
+      (S nil nil (e))
+      (S nil nil (a)))
+    (parser--lr-items 'e)))
+  (message "Passed V(e)")
+
   (should
    (equal
     '((Sp (S) nil (e))
@@ -250,16 +262,6 @@
     (parser--lr-items '(S a))))
   (message "Passed V(Sa)")
 
-  (should
-   (equal
-    '((Sp nil (S) (e))
-      (S nil (S a S b) (e))
-      (S nil (S a S b) (a))
-      (S nil nil (e))
-      (S nil nil (a)))
-    (parser--lr-items 'e)))
-  (message "Passed V(e)")
-
   (message "Passed tests for (parser--lr-items)"))
 
 (defun parser-test--valid-grammar-p ()