[elpa] externals/parser-generator 0856bb7784 58/82: Started on refactor were k=1 will be treated with different algorithm

[Christian Johansson]

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

    Started on refactor were k=1 will be treated with different algorithm
---
 parser-generator-ll.el           | 164 +++++++++++++++++-------------
 parser-generator.el              |   2 +-
 test/parser-generator-ll-test.el | 211 +++++++++++++--------------------------
 3 files changed, 163 insertions(+), 214 deletions(-)

diff --git a/parser-generator-ll.el b/parser-generator-ll.el
index 7afaa48c35..55eaeaecef 100644
--- a/parser-generator-ll.el
+++ b/parser-generator-ll.el
@@ -25,47 +25,13 @@
 ;;; Functions
 
 
-(defun parser-generator-ll-generate-parser-tables ()
-  "Generate parsing tables for grammar."
-  (message "\n;; Starting generation of LL(k) parser-tables..\n")
-  (unless (parser-generator-ll--valid-grammar-p)
-    (error "Invalid grammar specified!"))
-  (let ((list-parsing-table
-         (parser-generator-ll--generate-parsing-table
-          (parser-generator-ll--generate-tables)))
-        (hash-parsing-table (make-hash-table :test 'equal)))
-    (dolist (state-list list-parsing-table)
-      (let ((state-key (nth 0 state-list))
-            (state-look-aheads (nth 1 state-list))
-            (state-hash-table (make-hash-table :test 'equal)))
-        (dolist (state-look-ahead-list state-look-aheads)
-          (let ((state-look-ahead-string (nth 0 state-look-ahead-list))
-                (state-look-ahead-action (nth 1 state-look-ahead-list)))
-            (if (equal state-look-ahead-action 'reduce)
-                (let ((state-look-ahead-reduction
-                       (nth 2 state-look-ahead-list))
-                      (state-look-ahead-production-number
-                       (nth 3 state-look-ahead-list)))
-                  (puthash
-                   (format "%S" state-look-ahead-string)
-                   (list
-                    state-look-ahead-action
-                    state-look-ahead-reduction
-                    state-look-ahead-production-number)
-                   state-hash-table))
-              (puthash
-               (format "%S" state-look-ahead-string)
-               state-look-ahead-action
-               state-hash-table))))
-        (puthash
-         (format "%S" state-key)
-         state-hash-table
-         hash-parsing-table)))
-    (setq
-     parser-generator-ll--parsing-table
-     hash-parsing-table))
-  (message "\n;; Completed generation of LL(k) parser-tables.\n"))
-
+(defun parser-generator-ll-generate-tables ()
+  "Generate tables for grammar."
+  (message "\n;; Starting generation of LL(k) tables..\n")
+  (if (> parser-generator--look-ahead-number 1)
+      (parser-generator-ll--generate-parser-tables-k-gt-1)
+    (parser-generator-ll--generate-parser-tables-k-eq-1))
+  (message "\n;; Completed generation of LL(k) tables.\n"))
 
 ;; Generally described at .p 339
 (defun parser-generator-ll-parse ()
@@ -176,9 +142,51 @@
 ;;; Algorithms
 
 
+(defun parser-generator-ll--generate-parser-tables-k-gt-1 ()
+  "Generate parsing tables for grammar k > 1."
+  (message "\n;; Starting generation of LL(k) parser-tables..\n")
+  (unless (parser-generator-ll--valid-grammar-p-k-gt-1)
+    (error "Invalid grammar specified!"))
+  (let ((list-parsing-table
+         (if (> parser-generator--look-ahead-number 1)
+             (parser-generator-ll--generate-parsing-table-k-gt-1
+              (parser-generator-ll--generate-tables-k-gt-1))
+           (parser-generator-ll--generate-parsing-table-k-eq-1)))
+        (hash-parsing-table (make-hash-table :test 'equal)))
+    (dolist (state-list list-parsing-table)
+      (let ((state-key (nth 0 state-list))
+            (state-look-aheads (nth 1 state-list))
+            (state-hash-table (make-hash-table :test 'equal)))
+        (dolist (state-look-ahead-list state-look-aheads)
+          (let ((state-look-ahead-string (nth 0 state-look-ahead-list))
+                (state-look-ahead-action (nth 1 state-look-ahead-list)))
+            (if (equal state-look-ahead-action 'reduce)
+                (let ((state-look-ahead-reduction
+                       (nth 2 state-look-ahead-list))
+                      (state-look-ahead-production-number
+                       (nth 3 state-look-ahead-list)))
+                  (puthash
+                   (format "%S" state-look-ahead-string)
+                   (list
+                    state-look-ahead-action
+                    state-look-ahead-reduction
+                    state-look-ahead-production-number)
+                   state-hash-table))
+              (puthash
+               (format "%S" state-look-ahead-string)
+               state-look-ahead-action
+               state-hash-table))))
+        (puthash
+         (format "%S" state-key)
+         state-hash-table
+         hash-parsing-table)))
+    (setq
+     parser-generator-ll--parsing-table
+     hash-parsing-table)))
+
 ;; Algorithm 5.2 p. 350
-(defun parser-generator-ll--generate-tables ()
-  "Construction of LL(k)-tables.  Output the set of LL(k) tables needed to 
construct a parsing table for the grammar G."
+(defun parser-generator-ll--generate-tables-k-gt-1 ()
+  "Construction of LL(k)-tables were k > 1.  Output the set of LL(k) tables 
needed to construct a parsing table for the grammar G."
   (let ((tables (make-hash-table :test 'equal))
         (distinct-item-p (make-hash-table :test 'equal))
         (stack)
@@ -253,6 +261,7 @@
                          first-concatenated-follow-set
                          nil
                          t))
+                       (local-follow)
                        (sub-symbol-rhss
                         (parser-generator--get-grammar-rhs
                          sub-symbol)))
@@ -278,34 +287,50 @@
                     sub-symbol-rhss))
                   (unless local-follow-set
                     (setq local-follow-set '(nil)))
+
+                  (when (> (length local-follow-set) 1)
+                    (signal
+                     'error
+                     (list
+                      (format
+                       "There are more than one follow set in state! %S -> %S 
+ %S"
+                       sub-symbol
+                       production-rhs
+                       follow-set)
+                      sub-symbol
+                      production-rhs
+                      follow-set)))
+                  (setq
+                   local-follow
+                   (car local-follow-set))
+
                   (push
-                   local-follow-set
+                   local-follow
                    sets)
                   (parser-generator--debug
                    (message
                     "pushed local follow set to sets: %S"
                     local-follow-set))
-                  (dolist (local-follow local-follow-set)
-                    (dolist (sub-symbol-rhs sub-symbol-rhss)
-                      (let* ((new-stack-item
-                              (list
-                               (list sub-symbol)
-                               sub-symbol-rhs
-                               local-follow)))
-                        (unless (gethash
-                                 new-stack-item
-                                 distinct-stack-item-p)
-                          (parser-generator--debug
-                           (message
-                            "new-stack-item: %S"
-                            new-stack-item))
-                          (puthash
-                           new-stack-item
-                           t
-                           distinct-stack-item-p)
-                          (push
-                           new-stack-item
-                           stack))))))))
+                  (dolist (sub-symbol-rhs sub-symbol-rhss)
+                    (let* ((new-stack-item
+                            (list
+                             (list sub-symbol)
+                             sub-symbol-rhs
+                             local-follow)))
+                      (unless (gethash
+                               new-stack-item
+                               distinct-stack-item-p)
+                        (parser-generator--debug
+                         (message
+                          "new-stack-item: %S"
+                          new-stack-item))
+                        (puthash
+                         new-stack-item
+                         t
+                         distinct-stack-item-p)
+                        (push
+                         new-stack-item
+                         stack)))))))
             (setq
              sub-symbol-index
              (1+ sub-symbol-index))))
@@ -369,9 +394,8 @@
        tables)
       sorted-tables)))
 
-
 ;; Algorithm 5.3 p. 351
-(defun parser-generator-ll--generate-parsing-table (tables)
+(defun parser-generator-ll--generate-parsing-table-k-gt-1 (tables)
   "Generate a parsing table for an LL(k) grammar G and TABLES.  Output M, a 
valid parsing table for G."
   (let ((parsing-table))
 
@@ -479,9 +503,8 @@
 
     parsing-table))
 
-
 ;; Algorithm 5.4 p. 357
-(defun parser-generator-ll--valid-grammar-p ()
+(defun parser-generator-ll--valid-grammar-p-k-gt-1 ()
   "Test for LL(k)-ness.  Output t if grammar is LL(k).  nil otherwise."
   (let ((stack)
         (stack-item)
@@ -536,7 +559,8 @@
 
                   ;; Calculate following terminals to see if there is a 
conflict
                   (dolist (sub-symbol-rhs sub-symbol-rhss)
-                    (let ((first-sub-symbol-rhs (parser-generator--first 
sub-symbol-rhs nil t t)))
+                    (let ((first-sub-symbol-rhs
+                           (parser-generator--first sub-symbol-rhs nil t t)))
                       (let ((merged-terminal-sets
                              (parser-generator--merge-max-terminal-sets
                               first-sub-symbol-rhs
diff --git a/parser-generator.el b/parser-generator.el
index 4b749f7f31..dfd698663e 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -45,7 +45,7 @@
 
 (defvar
   parser-generator--debug
-  nil
+  t
   "Whether to print debug messages or not.")
 
 (defvar
diff --git a/test/parser-generator-ll-test.el b/test/parser-generator-ll-test.el
index 567e2ee955..e9026532a0 100644
--- a/test/parser-generator-ll-test.el
+++ b/test/parser-generator-ll-test.el
@@ -12,9 +12,9 @@
 (require 'parser-generator-ll)
 (require 'ert)
 
-(defun parser-generator-ll-test--generate-tables ()
-  "Test `parser-generator-ll--generate-tables'."
-  (message "Started tests for (parser-generator-ll--generate-tables)")
+(defun parser-generator-ll-test--generate-tables-k-gt-1 ()
+  "Test `parser-generator-ll--generate-tables-k-gt-1'."
+  (message "Started tests for (parser-generator-ll--generate-tables-k-gt-1)")
 
   (parser-generator-set-e-identifier 'e)
   (parser-generator-set-look-ahead-number 2)
@@ -30,7 +30,7 @@
      )
    )
   (parser-generator-process-grammar)
-  (let ((tables (parser-generator-ll--generate-tables)))
+  (let ((tables (parser-generator-ll--generate-tables-k-gt-1)))
     ;; (message "tables: %S" tables)
     (should
      (equal
@@ -53,9 +53,9 @@
         (
          ((S) ($ $)) ;; T0
          (
-          ((a b) (a A a a) (((a a))))
-          ((a a) (a A a a) (((a a))))
-          ((b b) (b A b a) (((b a))))
+          ((a b) (a A a a) ((a a)))
+          ((a a) (a A a a) ((a a)))
+          ((b b) (b A b a) ((b a)))
           )
          )
         )
@@ -79,7 +79,7 @@
    )
   (parser-generator-process-grammar)
   (let* ((tables
-          (parser-generator-ll--generate-tables)))
+          (parser-generator-ll--generate-tables-k-gt-1)))
     ;; (message "tables: %S" tables)
     (should
      (equal
@@ -88,23 +88,23 @@
         (
          ((A) (a a)) ;; T3
          (
-          ((a b) (S a a) (((a a))))
-          ((a a) (S a a) (((a a))))
+          ((a b) (S a a) ((a a)))
+          ((a a) (S a a) ((a a)))
           ((b a) (b) nil)
           )
          )
         (
          ((S) (a a)) ;; T2
          (
-          ((a b) (a b A) (((a a))))
+          ((a b) (a b A) ((a a)))
           ((a a) (e) nil)
           )
          )
         (
          ((A) ($ $)) ;; T1
          (
-          ((a b) (S a a) (((a a))))
-          ((a a) (S a a) (((a a))))
+          ((a b) (S a a) ((a a)))
+          ((a a) (S a a) ((a a)))
           ((b $) (b) nil)
           )
          )
@@ -112,7 +112,7 @@
          ((S) ($ $)) ;; T0
          (
           (($ $) (e) nil)
-          ((a b) (a b A) ((($ $))))
+          ((a b) (a b A) (($ $)))
           )
          )
         )
@@ -120,6 +120,8 @@
     )
   (message "Passed Example 5.17 p. 354")
 
+  ;; Move below to separate test
+
   (parser-generator-set-eof-identifier '$)
   (parser-generator-set-e-identifier 'e)
   (parser-generator-set-look-ahead-number 1)
@@ -143,38 +145,17 @@
       tables
       '(
         (
-         ((A) (a))
-         (
-          ((a) (a) nil)
-          ((b) (b S A) (((a) (b)) ((a))))
-          )
-         )
-        (
-         ((S) (a))
-         (
-          ((a) (a A S) (((a) (b)) ((a))))
-          ((b) (b) nil)
-          )
-         )
-        (
-         ((S) (b))
-         (
-          ((a) (a A S) (((a) (b)) ((b))))
-          ((b) (b) nil)
-          )
-         )
-        (
-         ((A) (b))
+         (A)
          (
-          ((a) (a) nil)
-          ((b) (b S A) (((a) (b)) ((b))))
+          ((a) (a))
+          ((b) (b S A))
           )
          )
         (
-         ((S) ($))
+         (S)
          (
-          ((a) (a A S) (((a) (b)) (($))))
-          ((b) (b) nil)
+          ((a) (a A S))
+          ((b) (b))
           )
          )
         )
@@ -206,112 +187,49 @@
      (equal
       '(
         (
-         ((F) ($))
-         (
-          (("(") ("(" E ")") (((")"))))
-          (("a") ("a") nil)
-          )
-         )
-        (
-         ((T2) ($))
-         (
-          (($) (e) nil)
-          (("*") ("*" F T2) ((($) ("*")) (($))))
-          )
-         )
-        (
-         ((T) ($))
-         (
-          (("(") (F T2) ((($) ("*")) (($))))
-          (("a") (F T2) ((($) ("*")) (($))))
-          )
-         )
-        (
-         ((F) ("*"))
-         (
-          (("(") ("(" E ")") (((")"))))
-          (("a") ("a") nil)
-          )
-         )
-        (
-         ((F) (")"))
-         (
-          (("(") ("(" E ")") (((")"))))
-          (("a") ("a") nil)
-          )
-         )
-        (
-         ((T2) (")"))
-         (
-          ((")") (e) nil)
-          (("*") ("*" F T2) (((")") ("*")) ((")"))))
-          )
-         )
-        (
-         ((T) (")"))
-         (
-          (("(") (F T2) (((")") ("*")) ((")"))))
-          (("a") (F T2) (((")") ("*")) ((")"))))
-          )
-         )
-        (
-         ((E2) (")"))
-         (
-          ((")") (e) nil)
-          (("+") ("+" T E2) (((")") ("+")) ((")"))))
-          )
-         )
-        (
-         ((E) (")"))
-         (
-          (("(") (T E2) (((")") ("+")) ((")"))))
-          (("a") (T E2) (((")") ("+")) ((")"))))
-          )
-         )
-        (
-         ((F) ("+"))
+         (F)
          (
-          (("(") ("(" E ")") (((")"))))
-          (("a") ("a") nil)
+          (("(") ("(" E ")"))
+          (("a") ("a"))
           )
          )
         (
-         ((T2) ("+"))
+         (T2)
          (
-          (("*") ("*" F T2) ((("*") ("+")) (("+"))))
-          (("+") (e) nil)
+          (($) (e))
+          (("*") ("*" F T2))
           )
          )
         (
-         ((T) ("+"))
+         (T)
          (
-          (("(") (F T2) ((("*") ("+")) (("+"))))
-          (("a") (F T2) ((("*") ("+")) (("+"))))
+          (("(") (F T2))
+          (("a") (F T2))
           )
          )
         (
-         ((E2) ($))
+         (E2)
          (
-          (($) (e) nil)
-          (("+") ("+" T E2) ((($) ("+")) (($))))
+          ((")") (e))
+          (("+") ("+" T E2))
           )
          )
         (
-         ((E) ($))
+         (E)
          (
-          (("(") (T E2) ((($) ("+")) (($))))
-          (("a") (T E2) ((($) ("+")) (($))))
+          (("(") (T E2))
+          (("a") (T E2))
           )
          )
         )
       tables)))
   (message "Passed Example 5.12 p. 346-347")
 
-  (message "Passed tests for (parser-generator-ll--generate-tables)"))
+  (message "Passed tests for (parser-generator-ll--generate-tables-k-gt-1)"))
 
-(defun parser-generator-ll-test--generate-parsing-table ()
+(defun parser-generator-ll-test--generate-parsing-table-k-gt-1 ()
   "Test `parser-generator-ll--generate-parsing-table'."
-  (message "Started tests for (parser-generator-ll--generate-parsing-table)")
+  (message "Started tests for 
(parser-generator-ll--generate-parsing-table-k-gt-1)")
 
   ;; TODO Need to make this tests pass, RHS after reduction should be single 
dimension list
 
@@ -330,7 +248,7 @@
    )
   (parser-generator-process-grammar)
   (let ((parser-tables
-         (parser-generator-ll--generate-parsing-table
+         (parser-generator-ll--generate-parsing-table-k-gt-1
           (parser-generator-ll--generate-tables))))
     ;; (message "parser-tables: %S" parser-tables)
     (should
@@ -382,9 +300,9 @@
   (parser-generator-process-grammar)
   (let* ((tables
           (parser-generator-ll--generate-tables))
-          (parser-tables
-           (parser-generator-ll--generate-parsing-table
-            tables)))
+         (parser-tables
+          (parser-generator-ll--generate-parsing-table-k-gt-1
+           tables)))
     ;; (message "tables: %S" tables)
     ;; (message "parser-tables: %S" parser-tables)
     (should
@@ -427,6 +345,8 @@
       parser-tables)))
   (message "Passed Example 5.17 p. 356")
 
+  ;; TODO Move below to separate test
+
   (parser-generator-set-eof-identifier '$)
   (parser-generator-set-e-identifier 'e)
   (parser-generator-set-look-ahead-number 1)
@@ -449,7 +369,7 @@
   (let* ((tables
           (parser-generator-ll--generate-tables))
           (parser-tables
-           (parser-generator-ll--generate-parsing-table
+           (parser-generator-ll--generate-parsing-table-k-gt-1
             tables)))
     ;; (message "tables: %S" tables)
     ;; (message "parser-tables: %S" parser-tables)
@@ -696,9 +616,9 @@
 
   (message "Passed tests for (parser-generator-ll-parse)"))
 
-(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)")
+(defun parser-generator-ll-test-generate-tables ()
+  "Test `parser-generator-ll-generate-tables'."
+  (message "Started tests for (parser-generator-ll-generate-tables)")
 
   (parser-generator-set-eof-identifier '$)
   (parser-generator-set-e-identifier 'e)
@@ -715,7 +635,7 @@
      )
    )
   (parser-generator-process-grammar)
-  (parser-generator-ll-generate-parser-tables)
+  (parser-generator-ll-generate-tables)
   ;; (message "parsing-table: %S" (parser-generator--hash-to-list 
parser-generator-ll--parsing-table t))
   (should
    (equal
@@ -754,11 +674,13 @@
      parser-generator-ll--parsing-table
      t)))
 
-  (message "Passed tests for (parser-generator-ll-generate-parser-tables)"))
+  ;; TODO Should test k = 1 here as well
 
-(defun parser-generator-ll-test--valid-grammar-p ()
-  "Test `parser-generator-ll--valid-grammar-p'."
-  (message "Started tests for (parser-generator-ll--valid-grammar-p)")
+  (message "Passed tests for (parser-generator-ll-generate-tables)"))
+
+(defun parser-generator-ll-test--valid-grammar-p-k-gt-1 ()
+  "Test `parser-generator-ll--valid-grammar-p-k-gt-1'."
+  (message "Started tests for (parser-generator-ll--valid-grammar-p-k-gt-1)")
 
   ;; Example 5.14 p. 350
   ;; Example 5.15 p. 351
@@ -778,7 +700,7 @@
   (parser-generator-process-grammar)
   (should
    (equal
-    (parser-generator-ll--valid-grammar-p)
+    (parser-generator-ll--valid-grammar-p-k-gt-1)
     t))
   (message "Passed first valid test")
 
@@ -798,25 +720,28 @@
   (parser-generator-process-grammar)
   (should
    (equal
-    (parser-generator-ll--valid-grammar-p)
+    (parser-generator-ll--valid-grammar-p-k-gt-1)
     nil))
   (message "Passed second valid test")
 
   ;; TODO Example 5.19
 
-  (message "Passed tests for (parser-generator-ll--valid-grammar-p)"))
+  (message "Passed tests for (parser-generator-ll--valid-grammar-p-k-gt-1)"))
 
 
 (defun parser-generator-ll-test ()
   "Run test."
+
   ;; Helpers
-  (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-tables-k-gt-1)
+  (parser-generator-ll-test--generate-parsing-table-k-gt-1)
+  ;; TODO Generate tables k eq 1
+  (parser-generator-ll-test--valid-grammar-p-k-gt-1)
+  ;; TODO Validate grammar k eq 1
 
   ;; Main stuff
-  (parser-generator-ll-test--generate-parser-tables)
-  (parser-generator-ll-test--parse))
+  (parser-generator-ll-test-generate-tables)
+  (parser-generator-ll-test-parse))
 
 
 (provide 'parser-generator-ll-test)