[elpa] externals/parser-generator a2a629c16d 18/82: More work on data structure for LL-tables

[Christian Johansson]

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

    More work on data structure for LL-tables
---
 parser-generator-ll.el           | 68 +++++++++++++++++++---------------------
 test/parser-generator-ll-test.el | 32 ++++++++++++++-----
 2 files changed, 58 insertions(+), 42 deletions(-)

diff --git a/parser-generator-ll.el b/parser-generator-ll.el
index 8bf2e6c7fd..4ccc6ca159 100644
--- a/parser-generator-ll.el
+++ b/parser-generator-ll.el
@@ -46,8 +46,6 @@
   "Construction of LL(k)-tables.  Output the set of LL(k) tables needed to 
construct a parsing table for the grammar G."
 
   (let ((tables (make-hash-table :test 'equal))
-        (table-count 0)
-        (distinct-table-number (make-hash-table :test 'equal))
         (distinct-item-p (make-hash-table :test 'equal))
         (stack)
         (stack-item)
@@ -128,10 +126,20 @@
                         (parser-generator--get-grammar-rhs
                          sub-symbol)))
                   (parser-generator--debug
-                   (message "\nfollow-set: %S for %S in %S" follow-set (nth 
sub-symbol-index production-rhs) production-rhs)
-                   (message "merged-follow: %S" follow-set)
-                   (message "local-follow-set: %S" local-follow-set)
-                   (message "sub-symbol-rhss: %S" sub-symbol-rhss))
+                   (message
+                    "\nfollow-set: %S for %S in %S"
+                    follow-set
+                    (nth sub-symbol-index production-rhs)
+                    production-rhs)
+                   (message
+                    "merged-follow: %S"
+                    follow-set)
+                   (message
+                    "local-follow-set: %S"
+                    local-follow-set)
+                   (message
+                    "sub-symbol-rhss: %S"
+                    sub-symbol-rhss))
                   (dolist (local-follow local-follow-set)
                     (dolist (sub-symbol-rhs sub-symbol-rhss)
                       (let* ((sub-symbol-production
@@ -156,8 +164,6 @@
           (dolist (look-ahead look-aheads)
             (let ((table
                    (list
-                    production-lhs
-                    parent-follow
                     look-ahead
                     production-rhs))
                   (item-hash-key
@@ -167,39 +173,32 @@
                     parent-follow
                     look-ahead))
                   (table-hash-key
-                   (format
-                    "%S-%S"
+                   (list
                     production-lhs
                     parent-follow)))
+
+              ;; Only add distinct items
               (unless (gethash item-hash-key distinct-item-p)
                 (puthash
                  item-hash-key
                  t
                  distinct-item-p)
-                (let ((existing-table-number
-                       (gethash
-                        table-hash-key
-                        distinct-table-number)))
-                  (if existing-table-number
-                      (puthash
-                       existing-table-number
-                       (push
-                        table
-                        (gethash
-                         existing-table-number
-                         tables))
-                       tables)
-                    (puthash
+                (if (gethash
                      table-hash-key
-                     table-count
-                     distinct-table-number)
+                     tables)
                     (puthash
-                     table-count
-                     (list table)
+                     table-hash-key
+                     (push
+                      table
+                      (gethash
+                       table-hash-key
+                       tables))
                      tables)
-                    (setq
-                     table-count
-                     (1+ table-count))))))))
+                  (puthash
+                   table-hash-key
+                   (list table)
+                   tables)
+                  )))))
 
         (parser-generator--debug
          (message "\nproduction-lhs: %S" production-lhs)
@@ -209,16 +208,15 @@
          (message "first-parent-follow: %S" first-parent-follow)
          (message "look-aheads: %S" look-aheads))))
 
+    ;; TODO Add deterministic sorting here
     (let ((sorted-tables))
       (maphash
        (lambda (k v)
          (push
-          (list k (sort v 'parser-generator--sort-list))
+          (list k v)
           sorted-tables))
        tables)
-      (sort
-       (reverse sorted-tables)
-       (lambda (a b) (< (car a) (car b)))))))
+      sorted-tables)))
 
 
 ;; TODO
diff --git a/test/parser-generator-ll-test.el b/test/parser-generator-ll-test.el
index d908336717..561b5ad7cc 100644
--- a/test/parser-generator-ll-test.el
+++ b/test/parser-generator-ll-test.el
@@ -33,17 +33,35 @@
    )
   (parser-generator-process-grammar)
   (let ((tables (parser-generator-ll--generate-tables)))
-    ;; (message "tables: %S" tables)
+    (message "tables: %S" tables)
     (should
      (equal
       tables
       '(
-        (0 (((S) nil (a b) (a A a a)) ((S) nil (a a) (a A a a)) ((S) nil (b b) 
(b A b a))))
-        (1 (((A) (a a) (a a) (e)) ((A) (a a) (b a) (b))))
-        (2 (((A) (b a) (b b) (b)) ((A) (b a) (b a) (e))))
+        (
+         ((S) nil)
+         (
+          ((a b) (a A a a))
+          ((a a) (a A a a))
+          ((b b) (b A b a))
+          )
+         )
+        (
+         ((A) (a a))
+         (
+          ((a a) (e))
+          ((b a) (b))
+          )
+         )
+        (
+         ((A) (b a))
+         (
+          ((b b) (b))
+          ((b a) (e))
+          )
+         )
         )))
-    tables
-    )
+    tables)
 
   (message "Passed tests for (parser-generator-ll--generate-tables)"))
 
@@ -64,7 +82,7 @@
            tables)))
     (message "parser-tables: %S" parser-tables)
 
-    ;; TODO Add test here
+    ;; TODO Make this pass
     (should
      (equal
       '(