[elpa] externals/parser-generator ec0711fa84 53/82: Tweaks on internal functions of LLk parsing

[Christian Johansson]

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

    Tweaks on internal functions of LLk parsing
---
 parser-generator-ll.el           |  91 ++++++++------------------
 parser-generator.el              |  22 +++++--
 test/parser-generator-ll-test.el | 135 ++++++++++++++++++++++++++-------------
 3 files changed, 132 insertions(+), 116 deletions(-)

diff --git a/parser-generator-ll.el b/parser-generator-ll.el
index 4046699a19..63c3088f28 100644
--- a/parser-generator-ll.el
+++ b/parser-generator-ll.el
@@ -187,7 +187,9 @@
                 (list
                  (list start)
                  start-rhs
-                 (list parser-generator--eof-identifier))))
+                 (parser-generator--generate-list-of-symbol
+                  parser-generator--look-ahead-number
+                  parser-generator--eof-identifier))))
           (puthash
            initial-stack-item
            t
@@ -208,51 +210,21 @@
               (nth 1 stack-item))
              (parent-follow
               (nth 2 stack-item))
-             (first-rhs
-              (parser-generator--first production-rhs nil t t))
-             (satured-first-rhs
-              (parser-generator-generate-terminal-saturated-first-set
-               first-rhs))
-             (first-parent-follow
-              (parser-generator--first parent-follow nil t t t))
-             (look-aheads)
+             (concatenated-follow
+              (append production-rhs parent-follow))
+             (first-concatenated-follow
+              (parser-generator--first concatenated-follow nil t t))
+             (look-aheads
+              (parser-generator--merge-max-terminal-sets
+               first-concatenated-follow))
              (sets))
+
         (parser-generator--debug
          (message "\nproduction-lhs: %S" production-lhs)
          (message "production-rhs: %S" production-rhs)
          (message "parent-follow: %S" parent-follow)
-         (message "first-rhs: %S" first-rhs)
-         (message "satured-first-rhs: %S" satured-first-rhs))
-
-        ;; Calculate look-aheads
-        (cond
-         ((and satured-first-rhs
-               (not first-parent-follow))
-          (setq
-           look-aheads
-           (parser-generator--merge-max-terminal-sets
-            satured-first-rhs
-            nil)))
-         ((and first-parent-follow
-               (not satured-first-rhs))
-          (setq
-           look-aheads
-           (parser-generator--merge-max-terminal-sets
-            nil
-            first-parent-follow)))
-         ((and satured-first-rhs
-               first-parent-follow)
-          (setq
-           look-aheads
-           (parser-generator--merge-max-terminal-sets
-            satured-first-rhs
-            first-parent-follow)))
-         (t (error
-             "Unexpected empty FIRST for production: %S and parent-follow: %S"
-             (list production-lhs production-rhs)
-             parent-follow)))
-
-        (parser-generator--debug
+         (message "concatenated-follow: %S" concatenated-follow)
+         (message "first-concatenated-follow: %S" first-concatenated-follow)
          (message "look-aheads: %S" look-aheads))
 
         ;; For each non-terminal in the production right-hand side
@@ -266,15 +238,15 @@
                      sub-symbol)
                 (let* ((follow-set
                         (nthcdr (1+ sub-symbol-index) production-rhs))
-                       (first-follow-set
-                        (parser-generator--first follow-set nil t t))
-                       (saturated-first-follow-set
-                        (parser-generator-generate-terminal-saturated-first-set
-                         first-follow-set))
+                       (concatenated-follow-set
+                        (append follow-set parent-follow))
+                       (first-concatenated-follow-set
+                        (parser-generator--first concatenated-follow-set nil t 
t))
                        (local-follow-set
                         (parser-generator--merge-max-terminal-sets
-                         saturated-first-follow-set
-                         (list parent-follow)))
+                         first-concatenated-follow-set
+                         nil
+                         t))
                        (sub-symbol-rhss
                         (parser-generator--get-grammar-rhs
                          sub-symbol)))
@@ -287,20 +259,19 @@
                     (nth sub-symbol-index production-rhs)
                     production-rhs)
                    (message
-                    "first-follow-set: %S"
-                    first-follow-set)
+                    "concatenated-follow-set: %S"
+                    concatenated-follow-set)
                    (message
-                    "saturated-first-follow-set: %S"
-                    saturated-first-follow-set)
-                   (message
-                    "parent-follow: %S"
-                    parent-follow)
+                    "first-concatenated-follow-set: %S"
+                    first-concatenated-follow-set)
                    (message
                     "local-follow-set: %S"
                     local-follow-set)
                    (message
                     "sub-symbol-rhss: %S"
                     sub-symbol-rhss))
+                  (unless local-follow-set
+                    (setq local-follow-set '(nil)))
                   (push
                    local-follow-set
                    sets)
@@ -381,15 +352,7 @@
                   (puthash
                    table-hash-key
                    (list table)
-                   tables))))))
-
-        (parser-generator--debug
-         (message "\nproduction-lhs: %S" production-lhs)
-         (message "production-rhs: %S" production-rhs)
-         (message "parent-follow: %S" parent-follow)
-         (message "first-rhs: %S" first-rhs)
-         (message "first-parent-follow: %S" first-parent-follow)
-         (message "look-aheads: %S" look-aheads))))
+                   tables))))))))
 
     (let ((sorted-tables))
       (maphash
diff --git a/parser-generator.el b/parser-generator.el
index e0b8500766..dfd698663e 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -1241,7 +1241,7 @@
          look-ahead)))
     (nreverse look-ahead)))
 
-(defun parser-generator--merge-max-terminal-sets (a b)
+(defun parser-generator--merge-max-terminal-sets (a &optional b 
allow-any-length)
   "Calculate list of all lists of L1 (+) L2 which is a merge of all terminals 
in lists A combined with all terminals in lists B but with maximum length of 
the set look-ahead number."
   (let ((a-length (length a))
         (a-index 0)
@@ -1258,7 +1258,8 @@
                   ((merged-element
                     (parser-generator--merge-max-terminals
                      a-element
-                     b-element)))
+                     b-element
+                     allow-any-length)))
                 (if merged-lists
                     (setq
                      merged-lists
@@ -1277,7 +1278,8 @@
               ((merged-element
                 (parser-generator--merge-max-terminals
                  a-element
-                 nil)))
+                 nil
+                 allow-any-length)))
             (if merged-lists
                 (setq
                  merged-lists
@@ -1297,7 +1299,8 @@
                 ((merged-element
                   (parser-generator--merge-max-terminals
                    nil
-                   b-element)))
+                   b-element
+                   allow-any-length)))
               (if merged-lists
                   (setq
                    merged-lists
@@ -1320,8 +1323,8 @@
     merged-lists))
 
 ;; 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 
exactly length of the set look-ahead number."
+(defun parser-generator--merge-max-terminals (a b &optional allow-any-length)
+  "Calculate L1 (+) L2 which is a merge of all terminals in A and B but with 
exactly length of the set look-ahead number. Optionally ALLOW-ANY-LENGTH."
   (let ((k (max 1 parser-generator--look-ahead-number))
         (merged)
         (merge-count 0)
@@ -1379,7 +1382,12 @@
 
       (setq b-index (1+ b-index)))
 
-    (if (> merge-count 0)
+    (if (or
+         (and
+          allow-any-length
+          (> merge-count 0))
+         (and (not allow-any-length)
+              (= merge-count k)))
         (nreverse merged)
       nil)))
 
diff --git a/test/parser-generator-ll-test.el b/test/parser-generator-ll-test.el
index 2c566be67b..78c8e80ff8 100644
--- a/test/parser-generator-ll-test.el
+++ b/test/parser-generator-ll-test.el
@@ -51,7 +51,7 @@
           )
          )
         (
-         ((S) ($)) ;; T0
+         ((S) ($ $)) ;; T0
          (
           ((a b) (a A a a) (((a a))))
           ((a a) (a A a a) (((a a))))
@@ -101,7 +101,7 @@
           )
          )
         (
-         ((A) ($)) ;; T1
+         ((A) ($ $)) ;; T1
          (
           ((a b) (S a a) (((a a))))
           ((a a) (S a a) (((a a))))
@@ -109,10 +109,10 @@
           )
          )
         (
-         ((S) ($)) ;; T0
+         ((S) ($ $)) ;; T0
          (
           (($ $) (e) nil)
-          ((a b) (a b A) ((($))))
+          ((a b) (a b A) ((($ $))))
           )
          )
         )
@@ -201,65 +201,110 @@
    )
   (parser-generator-process-grammar)
   (let ((tables (parser-generator-ll--generate-tables)))
-    (message "tables: %S" tables)
+    ;; (message "tables: %S" tables)
     (should
      (equal
-      '
-      (
-       (
-        ((E2) (")"))
+      '(
         (
-         ((")") (e) nil)
-         (("+") ("+" T E2) ((("+") (")")) ((")"))))
+         ((F) ($))
+         (
+          (("(") ("(" E ")") (((")"))))
+          (("a") ("a") nil)
+          )
          )
-        )
-       (
-        ((E) (")"))
         (
-         (("(") (T E2) ((("+") (")")) ((")"))))
-         (("a") (T E2) ((("+") (")")) ((")"))))
+         ((T2) ($))
+         (
+          (($) (e) nil)
+          (("*") ("*" F T2) ((($) ("*")) (($))))
+          )
          )
-        )
-       (
-        ((F) ("*"))
         (
-         (("(") ("(" E ")") (((")"))))
-         (("a") ("a") nil)
+         ((T) ($))
+         (
+          (("(") (F T2) ((($) ("*")) (($))))
+          (("a") (F T2) ((($) ("*")) (($))))
+          )
          )
-        )
-       (
-        ((T2) ("+"))
         (
-         (("*") ("*" F T2) ((("*") ("+")) (("+"))))
-         (("+") (e) nil)
+         ((F) ("*"))
+         (
+          (("(") ("(" E ")") (((")"))))
+          (("a") ("a") nil)
+          )
          )
-        )
-       (
-        ((T) ("+"))
         (
-         (("(") (F T2) ((("*") ("+")) (("+"))))
-         (("a") (F T2) ((("*") ("+")) (("+"))))
+         ((F) (")"))
+         (
+          (("(") ("(" E ")") (((")"))))
+          (("a") ("a") nil)
+          )
          )
-        )
-       (
-        ((E2) ($))
         (
-         (($) (e) nil)
-         (("+") ("+" T E2) ((("+") ($)) (($))))
+         ((T2) (")"))
+         (
+          ((")") (e) nil)
+          (("*") ("*" F T2) (((")") ("*")) ((")"))))
+          )
+         )
+        (
+         ((T) (")"))
+         (
+          (("(") (F T2) (((")") ("*")) ((")"))))
+          (("a") (F T2) (((")") ("*")) ((")"))))
+          )
+         )
+        (
+         ((E2) (")"))
+         (
+          ((")") (e) nil)
+          (("+") ("+" T E2) (((")") ("+")) ((")"))))
+          )
+         )
+        (
+         ((E) (")"))
+         (
+          (("(") (T E2) (((")") ("+")) ((")"))))
+          (("a") (T E2) (((")") ("+")) ((")"))))
+          )
+         )
+        (
+         ((F) ("+"))
+         (
+          (("(") ("(" E ")") (((")"))))
+          (("a") ("a") nil)
+          )
+         )
+        (
+         ((T2) ("+"))
+         (
+          (("*") ("*" F T2) ((("*") ("+")) (("+"))))
+          (("+") (e) nil)
+          )
          )
-        )
-       (
-        ((E) ($))
         (
-         (("(") (T E2) ((("+") ($)) (($))))
-         (("a") (T E2) ((("+") ($)) (($))))
+         ((T) ("+"))
+         (
+          (("(") (F T2) ((("*") ("+")) (("+"))))
+          (("a") (F T2) ((("*") ("+")) (("+"))))
+          )
+         )
+        (
+         ((E2) ($))
+         (
+          (($) (e) nil)
+          (("+") ("+" T E2) ((($) ("+")) (($))))
+          )
+         )
+        (
+         ((E) ($))
+         (
+          (("(") (T E2) ((($) ("+")) (($))))
+          (("a") (T E2) ((($) ("+")) (($))))
+          )
          )
         )
-       )
       tables)))
-  ;; TODO Make above pass
-  ;; TODO There are issues calculating Y for a non-terminal
-  ;; were a non-terminal follows that has a alternative e-rule
   (message "Passed Example 5.12 p. 346-347")
 
   (message "Passed tests for (parser-generator-ll--generate-tables)"))