[elpa] externals/parser-generator 4cb0a0b941 08/82: More work on LL table generation

[Christian Johansson]

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

    More work on LL table generation
---
 parser-generator-ll.el | 77 +++++++++++++++++++++++++++++++++++++++++---------
 parser-generator.el    | 33 +++++++++++++---------
 2 files changed, 82 insertions(+), 28 deletions(-)

diff --git a/parser-generator-ll.el b/parser-generator-ll.el
index 219a1424ae..365c03f12f 100644
--- a/parser-generator-ll.el
+++ b/parser-generator-ll.el
@@ -48,50 +48,99 @@
 
   (let ((tables)
         (distinct-table-p (make-hash-table :test 'equal))
-        ;; (1) Construct T_0, the LL(k) table associated with S {e}
-        (stack `((,(parser-generator--get-grammar-start) nil)))
+        (stack)
         (stack-item)
         (k (max 1 parser-generator--look-ahead-number)))
+
+    ;; (1) Construct T_0, the LL(k) table associated with S {e}
+    (let* ((start (parser-generator--get-grammar-start))
+           (start-rhss (parser-generator--get-grammar-rhs start)))
+      (dolist (start-rhs start-rhss)
+        (let* ((production (list (list start) start-rhs))
+               (production-number
+                (parser-generator--get-grammar-production-number
+                 production)))
+          (push
+           (list (list start) start-rhs production-number nil)
+           stack))))
+    (setq stack (nreverse stack))
+    (parser-generator--debug
+     (message "stack: %S" stack))
+
     (while stack
       (setq stack-item (pop stack))
-      (let* ((production (nth 0 stack-item))
-             (dot-look-ahead (nth 1 stack-item))
-             (first-production (parser-generator--first production nil t t))
-             (first-dot-look-ahead (parser-generator--first dot-look-ahead nil 
t t))
+      (let* ((production-lhs
+              (nth 0 stack-item))
+             (production-rhs
+              (nth 1 stack-item))
+             (production-number (nth 2 stack-item))
+             (dot-look-ahead (nth 3 stack-item))
+             (first-rhs
+              (parser-generator--first production-rhs nil t t))
+             (first-dot-look-ahead
+              (parser-generator--first dot-look-ahead nil t t))
              (look-aheads))
         (cond
-         ((and first-production
+         ((and first-rhs
                (not first-dot-look-ahead))
           (setq
            look-aheads
            (parser-generator--merge-max-terminal-sets
-            first-production
+            first-rhs
             nil)))
          ((and first-dot-look-ahead
-               (not first-production))
+               (not first-rhs))
           (setq
            look-aheads
            (parser-generator--merge-max-terminal-sets
             nil
             first-dot-look-ahead)))
-         ((and first-production
+         ((and first-rhs
                first-dot-look-ahead)
           (setq
            look-aheads
            (parser-generator--merge-max-terminal-sets
-            first-production
+            first-rhs
             first-dot-look-ahead)))
          (t (error
              "Unexpected empty FIRST for production: %S and dot-look-ahead: %S"
              production
              dot-look-ahead)))
+
+        (when look-aheads
+          (let ((table))
+            (dolist (look-ahead look-aheads)
+              (push
+               (list
+                production-lhs
+                production-rhs
+                production-number
+                look-ahead
+                dot-look-ahead)
+               table))
+            (let ((table-hash-key
+                   (format "%S" table)))
+              (unless
+                  (gethash
+                   table-hash-key
+                   distinct-table-p)
+                (puthash
+                 table-hash-key
+                 table
+                 distinct-table-p)
+                (push
+                 table
+                 tables)))))
+
         (parser-generator--debug
-         (message "production: %S" production)
+         (message "\nproduction-lhs: %S" production-lhs)
+         (message "production-rhs: %S" production-rhs)
+         (message "production-number: %S" production-number)
          (message "dot-look-ahead: %S" dot-look-ahead)
-         (message "first-production: %S" first-production)
+         (message "first-rhs: %S" first-rhs)
          (message "first-dot-look-ahead: %S" first-dot-look-ahead)
          (message "look-aheads: %S" look-aheads))))
-    tables))
+    (nreverse tables)))
 
 
 ;; TODO
diff --git a/parser-generator.el b/parser-generator.el
index c55cdeaceb..acc025ae6e 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -1243,10 +1243,11 @@
               (b-index 0))
           (while (< b-index b-length)
             (let ((b-element (nth b-index b)))
-              (let ((merged-element
-                     (parser-generator--merge-max-terminals
-                      a-element
-                      b-element)))
+              (when-let
+                  ((merged-element
+                    (parser-generator--merge-max-terminals
+                     a-element
+                     b-element)))
                 (if merged-lists
                     (setq
                      merged-lists
@@ -1261,10 +1262,11 @@
      (a
       (while (< a-index a-length)
         (let ((a-element (nth a-index a)))
-          (let ((merged-element
-                 (parser-generator--merge-max-terminals
-                  a-element
-                  nil)))
+          (when-let
+              ((merged-element
+                (parser-generator--merge-max-terminals
+                 a-element
+                 nil)))
             (if merged-lists
                 (setq
                  merged-lists
@@ -1280,10 +1282,11 @@
       (let ((b-index 0))
         (while (< b-index b-length)
           (let ((b-element (nth b-index b)))
-            (let ((merged-element
-                   (parser-generator--merge-max-terminals
-                    nil
-                    b-element)))
+            (when-let
+                ((merged-element
+                  (parser-generator--merge-max-terminals
+                   nil
+                   b-element)))
               (if merged-lists
                   (setq
                    merged-lists
@@ -1307,7 +1310,7 @@
 
 ;; Lemma 5.1 p. 348
 (defun parser-generator--merge-max-terminals (a b)
-  "Calculate L1 (+) L2 which is a merge of all terminals in A and B but with 
maximum length of the set look-ahead number."
+  "Calculate L1 (+) L2 which is a merge of all terminals in A and B but with 
exactly length of the set look-ahead number."
   (let ((k (max 1 parser-generator--look-ahead-number))
         (merged)
         (merge-count 0)
@@ -1333,7 +1336,9 @@
         (push b-element merged)
         (setq merge-count (1+ merge-count)))
       (setq b-index (1+ b-index)))
-    (nreverse merged)))
+    (if (= merge-count k)
+        (nreverse merged)
+      nil)))
 
 ;; p. 357
 (defun parser-generator--f-set (input-tape state stack)