[elpa] externals/parser-generator 98c9d94 213/434: Debugging parse with look-ahead > 1

[ELPA Syncer]

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

    Debugging parse with look-ahead > 1
---
 parser-generator-lr.el           | 119 +++++++++++++++++++++++++++------------
 parser-generator.el              |  61 +++++++++++++++-----
 test/parser-generator-lr-test.el |   8 ++-
 3 files changed, 137 insertions(+), 51 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index e7ebeed..72e0bca 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -42,13 +42,16 @@
   (let ((action-tables)
         (states '(shift reduce error))
         (added-actions (make-hash-table :test 'equal))
-        (goto-tables (parser-generator--hash-to-list 
parser-generator-lr--goto-tables))
+        (goto-tables
+         (parser-generator--hash-to-list
+          parser-generator-lr--goto-tables))
         (found-accept))
     (dolist (goto-table goto-tables)
       (let ((goto-index (car goto-table))
             (found-action nil)
             (action-table))
-        (let ((lr-items (gethash goto-index table-lr-items)))
+        (let ((lr-items
+               (gethash goto-index table-lr-items)))
           (let ((lr-items-length (length lr-items)))
             ;; Where u is in (T U e)*k
             (dolist (state states)
@@ -68,7 +71,9 @@
                             (v (nth 3 lr-item)))
                         (let ((Cv (append C v)))
                           (when Cv
-                            (let ((eff (parser-generator--e-free-first Cv)))
+                            (let
+                                ((eff
+                                  (parser-generator--e-free-first Cv)))
                               (when eff
                                 ;; Go through eff-items and see if any item is 
a valid look-ahead of grammar
                                 ;; in that case save in action table a shift 
action here
@@ -82,7 +87,8 @@
                                           (< eff-index eff-length))
                                     (setq eff-item (nth eff-index eff))
                                     (when 
(parser-generator--valid-look-ahead-p eff-item)
-                                      (let ((hash-key (format "%s-%s-%s" 
goto-index state eff-item)))
+                                      (let ((hash-key
+                                             (format "%s-%s-%s" goto-index 
state eff-item)))
                                         (unless (gethash hash-key 
added-actions)
                                           (puthash hash-key t added-actions)
                                           (setq searching-match nil))))
@@ -103,14 +109,20 @@
                         (unless B
                           (setq B (list parser-generator--e-identifier)))
                         (when (parser-generator--valid-look-ahead-p u)
-                          (let ((hash-key (format "%s-%s-%s" goto-index state 
u)))
+                          (let ((hash-key
+                                 (format "%s-%s-%s" goto-index state u)))
                             (unless (gethash hash-key added-actions)
                               (puthash hash-key t added-actions)
                               (let ((production (list A B)))
-                                (let ((production-number
-                                       
(parser-generator--get-grammar-production-number production)))
+                                (let
+                                    ((production-number
+                                      
(parser-generator--get-grammar-production-number
+                                       production)))
                                   (unless production-number
-                                    (error "Expecting production number for %s 
from LR-item %s!" production lr-item))
+                                    (error
+                                     "Expecting production number for %s from 
LR-item %s!"
+                                     production
+                                     lr-item))
 
                                   (if (and
                                        (= production-number 0)
@@ -130,21 +142,31 @@
 
                    ((eq state 'error)
                     (unless found-action
-                      (error (format "Failed to find any action in set %s" 
lr-items)))
+                      (error
+                       "Failed to find any action in set %s"
+                       lr-items))
                     (setq continue-loop nil)))
                   (setq lr-item-index (1+ lr-item-index)))))))
         (parser-generator--debug
          (message "%s actions %s" goto-index action-table))
         (when action-table
-          (push (list goto-index (sort action-table 
'parser-generator--sort-list)) action-tables))))
+          (push
+           (list
+            goto-index
+            (sort action-table 'parser-generator--sort-list))
+           action-tables))))
     (unless found-accept
       (error "Failed to find an accept action in the generated 
action-tables!"))
     (setq action-tables (nreverse action-tables))
-    (setq parser-generator-lr--action-tables (make-hash-table :test 'equal))
+    (setq parser-generator-lr--action-tables
+          (make-hash-table :test 'equal))
     (let ((table-length (length action-tables))
           (table-index 0))
       (while (< table-index table-length)
-        (puthash table-index (car (cdr (nth table-index action-tables))) 
parser-generator-lr--action-tables)
+        (puthash
+         table-index
+         (car (cdr (nth table-index action-tables)))
+         parser-generator-lr--action-tables)
         (setq table-index (1+ table-index))))))
 
 ;; Algorithm 5.9, p. 389
@@ -595,12 +617,13 @@
      translation
      history)
   "Perform a LR-parse via lex-analyzer, optionally at INPUT-TAPE-INDEX with 
PUSHDOWN-LIST, OUTPUT, TRANSLATION and HISTORY."
-  (let ((result (parser-generator-lr--parse
-                 input-tape-index
-                 pushdown-list
-                 output
-                 translation
-                 history)))
+  (let ((result
+         (parser-generator-lr--parse
+          input-tape-index
+          pushdown-list
+          output
+          translation
+          history)))
     (nth 0 result)))
 
 (defun parser-generator-lr-translate
@@ -636,7 +659,9 @@
   (if (and
        input-tape-index
        (> input-tape-index 1))
-      (setq parser-generator-lex-analyzer--index input-tape-index)
+      (setq
+       parser-generator-lex-analyzer--index
+       input-tape-index)
     (parser-generator-lex-analyzer--reset))
 
   ;; Make sure tables exists
@@ -647,9 +672,12 @@
 
   (let ((accept)
         (pre-index 0)
-        (e-list (parser-generator--generate-list-of-symbol
-                 parser-generator--look-ahead-number
-                 parser-generator--e-identifier)))
+        (e-list
+         (parser-generator--generate-list-of-symbol
+          parser-generator--look-ahead-number
+          parser-generator--e-identifier)))
+    (parser-generator--debug
+     (message "e-list: %s" e-list))
 
     (while (not accept)
 
@@ -666,10 +694,11 @@
            ,output
            ,translation)
          history)
-        (setq pre-index
-              parser-generator-lex-analyzer--index))
+        (setq
+         pre-index
+         parser-generator-lex-analyzer--index))
 
-      ;; (1) The lookahead string u, consisting of the next k input symbols, 
is determined.
+      ;; (1) The look-ahead string u, consisting of the next k input symbols, 
is determined.
       (let ((look-ahead
              (parser-generator-lex-analyzer--peek-next-look-ahead))
             (look-ahead-full))
@@ -683,9 +712,12 @@
               (push (car look-ahead-item) look-ahead)
             (push look-ahead-item look-ahead)))
 
-        (let ((table-index (car pushdown-list)))
+        (let ((table-index
+               (car pushdown-list)))
           (let ((action-table
-                 (gethash table-index parser-generator-lr--action-tables)))
+                 (gethash
+                  table-index
+                  parser-generator-lr--action-tables)))
 
             (let ((action-match nil)
                   (action-table-length (length action-table))
@@ -717,6 +749,10 @@
                  look-ahead
                  parser-generator-lex-analyzer--index))
 
+              (parser-generator--debug
+               (message "action-table: %s" action-table)
+               (message "action-match: %s" action-match))
+
               (cond
 
                ((equal action-match '(shift))
@@ -756,11 +792,10 @@
 
                       (unless next-index
                         (error
-                         (format
-                          "In shift, found no goto-item for %s in index %s, 
expected one of %s"
-                          a
-                          table-index
-                          possible-look-aheads)))
+                         "In shift, found no goto-item for %s in index %s, 
expected one of %s"
+                         a
+                         table-index
+                         possible-look-aheads))
 
                       (push a-full pushdown-list)
                       (push next-index pushdown-list)
@@ -783,9 +818,12 @@
                     (let ((production-lhs (car production))
                           (production-rhs (car (cdr production)))
                           (popped-items-contents))
+                      (parser-generator--debug
+                       (message "production-lhs: %s" production-lhs)
+                       (message "production-rhs: %s" production-rhs))
                       (unless (equal
                                production-rhs
-                               e-list) ;; TODO Verify this
+                               e-list)
                         (let ((pop-items (* 2 (length production-rhs)))
                               (popped-items 0)
                               (popped-item))
@@ -838,13 +876,21 @@
                               (let ((goto-item (nth goto-index goto-table)))
                                 (let ((goto-item-look-ahead (car goto-item))
                                       (goto-item-next-index (car (cdr 
goto-item))))
+                                  (parser-generator--debug
+                                   (message "goto-item: %s" goto-item)
+                                   (message "goto-item-look-ahead: %s" 
goto-item-look-ahead))
 
-                                  (when (equal goto-item-look-ahead 
production-lhs)
+                                  (when (equal
+                                         goto-item-look-ahead
+                                         production-lhs)
                                     (setq next-index goto-item-next-index)
                                     (setq searching-match nil))))
 
                               (setq goto-index (1+ goto-index)))
 
+                            (parser-generator--debug
+                             (message "next-index: %s" next-index))
+
                             (when next-index
                               (push production-lhs pushdown-list)
                               (push next-index pushdown-list)))))))))
@@ -857,7 +903,10 @@
                 (setq accept t))
 
                (t (error
-                   (format "Invalid action-match: %s!" action-match)))))))))
+                   "Invalid action-match: %s!"
+                   action-match)))
+
+              (error "was here"))))))
     (unless accept
       (error
        "Parsed entire string without getting accepting! Output: %s"
diff --git a/parser-generator.el b/parser-generator.el
index 30c5044..8a285db 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -173,13 +173,17 @@
   "If PRODUCTION exist, return it's number."
   (unless parser-generator--table-productions-number
     (error "Table for production-numbers is undefined!"))
-  (gethash production parser-generator--table-productions-number))
+  (gethash
+   production
+   parser-generator--table-productions-number))
 
 (defun parser-generator--get-grammar-production-by-number (production-number)
   "If PRODUCTION-NUMBER exist, return it's production."
   (unless parser-generator--table-productions-number-reverse
     (error "Table for reverse production-numbers is undefined!"))
-  (gethash production-number 
parser-generator--table-productions-number-reverse))
+  (gethash
+   production-number
+   parser-generator--table-productions-number-reverse))
 
 (defun parser-generator--get-grammar-productions (&optional G)
   "Return productions of grammar G."
@@ -291,7 +295,10 @@
     (dolist (p productions)
       (let ((lhs (car p))
             (rhs (cdr p)))
-        (let ((new-value (gethash lhs 
parser-generator--table-productions-rhs)))
+        (let ((new-value
+               (gethash
+                lhs
+                parser-generator--table-productions-rhs)))
           (dolist (rhs-element rhs)
             (unless (listp rhs-element)
               (setq rhs-element (list rhs-element)))
@@ -300,17 +307,28 @@
                 (unless (functionp rhs-sub-element)
                   (push rhs-sub-element new-rhs)))
               (push (nreverse new-rhs) new-value)))
-          (puthash lhs (nreverse new-value) 
parser-generator--table-productions-rhs))))
-
-    (setq parser-generator--table-productions-number (make-hash-table :test 
'equal))
-    (setq parser-generator--table-productions-number-reverse (make-hash-table 
:test 'equal))
-    (setq parser-generator--table-translations (make-hash-table :test 'equal))
+          (puthash
+           lhs
+           (nreverse new-value)
+           parser-generator--table-productions-rhs))))
+
+    (setq
+     parser-generator--table-productions-number
+     (make-hash-table :test 'equal))
+    (setq
+     parser-generator--table-productions-number-reverse
+     (make-hash-table :test 'equal))
+    (setq
+     parser-generator--table-translations
+     (make-hash-table :test 'equal))
     (let ((production-index 0))
       (dolist (p productions)
         (let ((lhs (car p))
               (rhs (cdr p))
               (production)
               (translation))
+          (unless (listp lhs)
+            (setq lhs (list lhs)))
           (let ((rhs-element-index 0)
                 (rhs-length (length rhs))
                 (rhs-element))
@@ -333,18 +351,33 @@
                 (parser-generator--debug
                  (message "Production %s: %s" production-index production)))
               (setq rhs-element-index (1+ rhs-element-index))
-              (puthash production production-index 
parser-generator--table-productions-number)
-              (puthash production-index production 
parser-generator--table-productions-number-reverse)
+              (puthash
+               production
+               production-index
+               parser-generator--table-productions-number)
+              (puthash
+               production-index
+               production
+               parser-generator--table-productions-number-reverse)
               (when translation
                 (parser-generator--debug
                  (message "Translation %s: %s" production-index translation))
-                (puthash production-index translation 
parser-generator--table-translations))
+                (puthash
+                 production-index
+                 translation
+                 parser-generator--table-translations))
               (setq production-index (1+ production-index))))))))
 
-  (let ((look-aheads (parser-generator--get-grammar-look-aheads)))
-    (setq parser-generator--table-look-aheads-p (make-hash-table :test 'equal))
+  (let ((look-aheads
+         (parser-generator--get-grammar-look-aheads)))
+    (setq
+     parser-generator--table-look-aheads-p
+     (make-hash-table :test 'equal))
     (dolist (look-ahead look-aheads)
-      (puthash look-ahead t parser-generator--table-look-aheads-p))))
+      (puthash
+       look-ahead
+       t
+       parser-generator--table-look-aheads-p))))
 
 (defun parser-generator-set-look-ahead-number (k)
   "Set look-ahead number K."
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 0593a50..c8f5253 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -72,7 +72,10 @@
       (5 (((a) reduce 1) ((e) reduce 1)))
       (6 (((a) shift) ((b) shift)))
       (7 (((a) reduce 1) ((b) reduce 1))))
-      (parser-generator--hash-to-list parser-generator-lr--action-tables)))
+    (parser-generator--hash-to-list
+     parser-generator-lr--action-tables)))
+
+  ;; TODO Test with look-ahead number > 1 here
 
   (message "Ended tests for (parser-generator-lr--generate-action-tables)"))
 
@@ -288,7 +291,8 @@
   "Test `parser-generator-lr-parse'."
   (message "Started tests for (parser-generator-lr-parse)")
 
-  (parser-generator-set-grammar '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) 
Sp))
+  (parser-generator-set-grammar
+   '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) Sp))
   (parser-generator-set-look-ahead-number 1)
   (parser-generator-process-grammar)
   (parser-generator-lr-generate-parser-tables)