branch: externals/parser-generator
commit c667e186042649d1512d89256f3778c3a8dec221
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@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)))
