[elpa] externals/parser-generator 221446d647 24/82: Started implementation of LLk validation

[Christian Johansson]

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

    Started implementation of LLk validation
---
 parser-generator-ll.el           | 88 ++++++++++++++++++++++++++++++++++++++--
 parser-generator.el              |  4 +-
 test/parser-generator-ll-test.el | 52 ++++++++++++++++++++----
 3 files changed, 133 insertions(+), 11 deletions(-)

diff --git a/parser-generator-ll.el b/parser-generator-ll.el
index 96d0493ada..035c5d8508 100644
--- a/parser-generator-ll.el
+++ b/parser-generator-ll.el
@@ -334,11 +334,93 @@
     parsing-table))
 
 
-;; TODO
 ;; Algorithm 5.4 p. 357
 (defun parser-generator-ll--valid-grammar-p ()
-  "Test for LL(k)-ness.  Output t if grammar G is LL(k).  nil otherwise."
-  )
+  "Test for LL(k)-ness.  Output t if grammar is LL(k).  nil otherwise."
+  (let ((stack)
+        (stack-item)
+        (k (max 1 parser-generator--look-ahead-number))
+        (distinct-production-p (make-hash-table :test 'equal))
+        (valid t))
+
+    ;; (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)))
+          (push
+           production
+           stack)
+          (puthash
+           production
+           t
+           distinct-production-p))))
+    (setq stack (nreverse stack))
+    (parser-generator--debug
+     (message "stack: %S" stack))
+
+    (while (and
+            stack
+            valid)
+      (setq stack-item (pop stack))
+      (let ((production-lhs
+             (nth 0 stack-item))
+            (production-rhs
+             (nth 1 stack-item)))
+
+        ;; For each non-terminal in the production right-hand side
+        ;; push a new item to stack with a local-follow
+        ;; and a new left-hand-side
+        (let ((sub-symbol-index 0)
+              (sub-symbol-length (length production-rhs)))
+          (while (< sub-symbol-index sub-symbol-length)
+            (let ((sub-symbol (nth sub-symbol-index production-rhs)))
+              (when (parser-generator--valid-non-terminal-p
+                     sub-symbol)
+                (let* ((local-follow
+                        (nthcdr (1+ sub-symbol-index) production-rhs))
+                       (first-local-follow-sets
+                        (parser-generator--first local-follow nil t t))
+                       (sub-symbol-rhss
+                        (parser-generator--get-grammar-rhs sub-symbol))
+                       (first-sub-symbol-rhss-sets
+                        (parser-generator--first sub-symbol-rhss nil t t))
+                       (merged-terminal-sets
+                        (parser-generator--merge-max-terminal-sets
+                         first-local-follow-sets
+                         first-sub-symbol-rhss-sets))
+                       (distinct-item-p
+                        (make-hash-table :test 'equal)))
+                  (dolist (merged-terminal-set merged-terminal-sets)
+                    (if (gethash
+                         merged-terminal-set
+                         distinct-item-p)
+                        (progn
+                          (setq valid nil)
+                          (message "merged-terminal-set: %S was not distinct" 
merged-terminal-set))
+                      (puthash
+                       merged-terminal-set
+                       t
+                       distinct-item-p)))
+                  (let ((production
+                         (list
+                          (list sub-symbol)
+                          sub-symbol-rhss)))
+                    (unless
+                        (gethash
+                         production
+                         distinct-production-p)
+                      (push
+                       production
+                       stack)
+                      (puthash
+                       production
+                       t
+                       distinct-production-p))))))
+            (setq
+             sub-symbol-index
+             (1+ sub-symbol-index))))))
+    valid))
 
 
 (provide 'parser-generator-ll)
diff --git a/parser-generator.el b/parser-generator.el
index 76847aca49..d995fcbf7d 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -1793,7 +1793,9 @@
             (setq
              expanded-lists-index
              (1+ expanded-lists-index)))
-          (when (>= minimum-terminal-count k)
+          (when (and
+                 minimum-terminal-count
+                 (>= minimum-terminal-count k))
             (setq still-looking nil)
             (parser-generator--debug
              (message
diff --git a/test/parser-generator-ll-test.el b/test/parser-generator-ll-test.el
index 37c84fa6cb..5648fc0104 100644
--- a/test/parser-generator-ll-test.el
+++ b/test/parser-generator-ll-test.el
@@ -158,22 +158,60 @@
   "Test `parser-generator-ll--valid-grammar-p'."
   (message "Started tests for (parser-generator-ll--valid-grammar-p)")
 
+  ;; Example 5.14 p. 350
+  ;; Example 5.15 p. 351
+  (parser-generator-set-e-identifier 'e)
+  (parser-generator-set-look-ahead-number 2)
+  (parser-generator-set-grammar
+   '(
+     (S A)
+     (a b)
+     (
+      (S (a A a a) (b A b a))
+      (A b e)
+      )
+     S
+     )
+   )
+  (parser-generator-process-grammar)
+  (parser-generator-ll--valid-grammar-p)
+  (should
+   (equal
+    (parser-generator-ll--valid-grammar-p)
+    t))
+  (message "Passed first valid test")
 
-  (message "Passed tests for (parser-generator-ll--valid-grammar-p)"))
+  ;; Example 5.14 p. 350
+  ;; Example 5.15 p. 351
+  (parser-generator-set-e-identifier 'e)
+  (parser-generator-set-look-ahead-number 2)
+  (parser-generator-set-grammar
+   '(
+     (S A)
+     (a b)
+     (
+      (S (a A a a) (b A b a))
+      (A b e a)
+      )
+     S
+     )
+   )
+  (parser-generator-process-grammar)
+  (should
+   (equal
+    (parser-generator-ll--valid-grammar-p)
+    nil))
+  (message "Passed second valid test")
 
-(defun parser-generator-ll-test-generate-parser-tables ()
-  "Test `parser-generator-ll-generate-parser-tables'."
-  (message "Started tests for (parser-generator-ll-generate-parser-tables)")
 
+  (message "Passed tests for (parser-generator-ll--valid-grammar-p)"))
 
-  (message "Passed tests for (parser-generator-ll-generate-parser-tables)"))
 
 (defun parser-generator-ll-test ()
   "Run test."
   (parser-generator-ll-test--generate-tables)
   (parser-generator-ll-test--generate-parsing-table)
-  (parser-generator-ll-test--valid-grammar-p)
-  (parser-generator-ll-test-generate-parser-tables))
+  (parser-generator-ll-test--valid-grammar-p))
 
 
 (provide 'parser-generator-ll-test)