[elpa] externals/parser-generator c667e18 121/434: Work on shift action in parsing algorithm

[ELPA Syncer]

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

    Work on shift action in parsing algorithm
---
 parser-lr.el | 76 ++++++++++++++++++++++++++++++++++++++++--------------------
 1 file changed, 51 insertions(+), 25 deletions(-)

diff --git a/parser-lr.el b/parser-lr.el
index 80c0b06..7a0d2c4 100644
--- a/parser-lr.el
+++ b/parser-lr.el
@@ -495,17 +495,17 @@
               (not accept)
               (< input-tape-index input-tape-length))
 
-
         ;; (1) The lookahead string u, consisting of the next k input symbols, 
is determined.
         (let ((look-ahead)
-              (look-ahead-length 0))
+              (look-ahead-length 0)
+              (look-ahead-input-tape-index input-tape-index))
 
           (while (and
-                  (< input-tape-index input-tape-length)
+                  (< look-ahead-input-tape-index input-tape-length)
                   (< look-ahead-length parser--look-ahead-number))
-            (push (pop input-tape) look-ahead)
+            (push (nth look-ahead-input-tape-index input-tape) look-ahead)
             (setq look-ahead-length (1+ look-ahead-length))
-            (setq input-tape-index (1+ input-tape-index)))
+            (setq look-ahead-input-tape-index (1+ 
look-ahead-input-tape-index)))
 
           ;; If we reached end of input-tape and look-ahead is too small, 
append e-identifiers
           (while (< look-ahead-length parser--look-ahead-number)
@@ -550,7 +550,7 @@
 
                 (cond
 
-                 ((eq action-match '(shift))
+                 ((equal action-match '(shift))
                   ;; TODO (a) If f(u) = shift, then the next input symbol, say 
a
                   ;; is removed from the input and shifted onto the pushdown 
list.
                   ;; The goto function g of the table on top of the pushdown 
list
@@ -559,15 +559,43 @@
                   ;; there is no next input symbol or g(a) is undefined, halt
                   ;; and declare error.
 
-                  ;; TODO Get next look-ahead here
-
-                  (let ((a (car look-ahead)))
-
-                    (push a pushdown-list)
-
-                    ))
-
-                 ((eq (car action-match) 'reduce)
+                  (let ((a (nth input-tape-index input-tape)))
+                    (message "a: %s" a)
+                    (let ((goto-table (car (cdr (nth table-index 
goto-tables)))))
+                      (message "goto-table: %s" goto-table)
+                      (let ((goto-table-length (length goto-table))
+                            (goto-index 0)
+                            (searching-match t)
+                            (next-index))
+
+                        (while (and
+                                searching-match
+                                (< goto-index goto-table-length))
+                          (let ((goto-item (nth goto-index goto-table)))
+                            (let ((goto-item-look-ahead (car goto-item))
+                                  (goto-item-next-index (car (cdr goto-item))))
+                              (message "goto-item-look-ahead: %s" 
goto-item-look-ahead)
+                              (message "goto-item-next-index: %s" 
goto-item-next-index)
+
+                              (when (equal goto-item-look-ahead a)
+                                (setq next-index goto-item-next-index)
+                                (setq searching-match nil))))
+
+                          (setq goto-index (1+ goto-index)))
+
+                        (unless next-index
+                          (error (format
+                                  "In shift, found no goto-item for %s in 
index %s"
+                                  a
+                                  table-index)))
+
+                        (push a pushdown-list)
+                        (push next-index pushdown-list)
+                        (setq input-tape-index (1+ input-tape-index))
+                        (message "Performed shift, new pushdown-list: %s" 
pushdown-list)
+                        (message "new-input-tape-index: %s" 
input-tape-index)))))
+
+                 ((equal (car action-match) 'reduce)
                   ;; (b) If f(u) = reduce i and production i is A -> a,
                   ;; then 2|a| symbols are removed from the top of the pushdown
                   ;; list, and production number i is placed in the output
@@ -591,6 +619,7 @@
                               (setq popped-items (1+ popped-items)))))
                         (message "pushdown-list: %s" pushdown-list)
                         (push production-number output)
+                        (message "new-output: %s" output)
 
                         (let ((new-table-index (car pushdown-list)))
                           (message "new-table-index: %s" new-table-index)
@@ -616,23 +645,20 @@
 
                                 (setq goto-index (1+ goto-index)))
 
-                              (unless next-index
-                                (error (format
-                                        "Found no goto-item for %s in index %s"
-                                        production-lhs
-                                        table-index)))
-
-                              (push production-lhs pushdown-list)
-                              (push next-index pushdown-list)
-                              (message "Performed reduction, new pushdownlist: 
%s" pushdown-list))))))))
+                              (when next-index
+                                (push production-lhs pushdown-list)
+                                (push next-index pushdown-list)
+                                (message "Performed reduction, new 
pushdown-list: %s" pushdown-list)))))))))
 
-                 ((eq action-match '(accept))
+                 ((equal action-match '(accept))
                   ;;    (d) If f(u) = accept, we halt and declare the string
                   ;;    in the output buffer to be the right parse of the 
original
                   ;;    input string.
 
                   (setq accept t))
 
+                 (t (error (format "Invalid action-match: %s!" action-match)))
+
                  )))))))
     (nreverse output)))