branch: externals/parser-generator
commit 51cab751ca521570754ca2a8548cb734c0bb5cd2
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
More debugging
---
parser.el | 134 +++++++++++++++++++++++++++++-----------------------
test/parser-test.el | 22 +++++----
2 files changed, 86 insertions(+), 70 deletions(-)
diff --git a/parser.el b/parser.el
index 6544898..f33c556 100644
--- a/parser.el
+++ b/parser.el
@@ -11,7 +11,7 @@
(defvar parser--debug
- nil
+ t
"Whether to print debug messages or not.")
(defvar parser--table-non-terminal-p
@@ -683,7 +683,7 @@
(parser--debug
(message "rhs-rest-first: %s" rhs-rest-first))
(unless rhs-rest-first
- (setq rhs-rest-first (list nil)))
+ (setq rhs-rest-first '((e))))
(let ((sub-production (parser--get-grammar-rhs
rhs-first)))
;; For each production with B as LHS
@@ -703,66 +703,80 @@
;; (c) Repeat (b) until no more items can be
added to v-set(e)
(setq found-new t))))))))))))))
- (puthash 'e lr-items-e lr-items))
-
- ;; 2 Suppose that we have constructed V(X1,X2,...,Xi-1) we construct
V(X1,X2,...,Xi) as follows:
- (let ((prefix-acc)
- (prefix-previous (gethash 'e lr-items)))
- (dolist (prefix γ)
- (let ((lr-new-item))
- (setq prefix-acc (append prefix-acc prefix))
- (unless (listp prefix-acc)
- (setq prefix-acc (list prefix-acc)))
-
- (dolist (lr-item prefix-previous)
- (let ((lr-item-lhs (nth 0 lr-item))
- (lr-item-prefix (nth 1 lr-item))
- (lr-item-suffix (nth 2 lr-item))
- (lr-item-look-ahead (nth 3 lr-item)))
- (let ((lr-item-suffix-first (car lr-item-suffix))
- (lr-item-suffix-rest (cdr lr-item-suffix)))
-
- ;; (a) If [A -> a . XiB, u] is in V(X1,...,Xi-1)
- (when (eq lr-item-suffix-first prefix)
-
- ;; Add [A -> aXi . B, u] to V(X1,...,Xi)
- (let ((combined-prefix (append lr-item-prefix (list
prefix))))
- (push `(,lr-item-lhs ,combined-prefix
,lr-item-suffix-rest ,lr-item-look-ahead) lr-new-item))))))
-
- ;; (c) Repeat step (2b) until no more new items can be added to
V(X1,...,Xi)
- (let ((added-new t))
- (while added-new
- (setq added-new nil)
- (dolist (lr-item lr-new-item)
- (let ((lr-item-suffix (nth 2 lr-item)))
- (let ((lr-item-suffix-first (car lr-item-suffix))
- (lr-item-suffix-rest (cdr lr-item-suffix)))
-
- ;; (b) If [A -> a . Bb, u] has been placed in
V(X1,...,Xi)
- ;; and B -> D is in P
- (when (parser--valid-non-terminal-p lr-item-suffix-first)
-
- (let ((lr-item-suffix-rest-first (parser--first
lr-item-suffix-rest)))
- (unless lr-item-suffix-rest-first
- (setq lr-item-suffix-rest-first (list nil)))
- (let ((sub-production (parser--get-grammar-rhs
lr-item-suffix-first)))
-
- ;; For each production with B as LHS
- (dolist (sub-rhs sub-production)
-
- ;; For each x in FIRST(αu)
- (dolist (f lr-item-suffix-rest-first)
-
- ;; then add [B -> . D, x] to V(X1,...,Xi) for
each x in FIRST(bu)
- ;; provided it is not already there
- (unless (gethash `(,prefix-acc
,lr-item-suffix-first nil ,sub-rhs ,f) lr-item-exists)
- (setq added-new t)
- (puthash `(,prefix-acc ,lr-item-suffix-first
nil ,sub-rhs ,f) t lr-item-exists)
- (push `(,lr-item-suffix-first nil ,sub-rhs
,f) lr-new-item))))))))))))
+ (parser--debug
+ (message "V(e) = %s" lr-items-e))
+ (puthash '(e) lr-items-e lr-items))
+
+ ;; Do step 2 only if prefix is not the e identifier
+ (unless (and
+ (= (length γ) 1)
+ (eq (car γ) 'e))
+ ;; 2 Suppose that we have constructed V(X1,X2,...,Xi-1) we construct
V(X1,X2,...,Xi) as follows:
+ (let ((prefix-acc)
+ (prefix-previous (gethash '(e) lr-items)))
+ (dolist (prefix γ)
+ (let ((lr-new-item))
+ (setq prefix-acc (append prefix-acc prefix))
+ (unless (listp prefix-acc)
+ (setq prefix-acc (list prefix-acc)))
- (setq prefix-previous prefix-acc)
- (puthash prefix-acc lr-new-item lr-items))))
+ (parser--debug
+ (message "prefix-acc: %s" prefix-acc)
+ (message "prefix-previous: %s" prefix-previous))
+
+ (dolist (lr-item prefix-previous)
+ (let ((lr-item-lhs (nth 0 lr-item))
+ (lr-item-prefix (nth 1 lr-item))
+ (lr-item-suffix (nth 2 lr-item))
+ (lr-item-look-ahead (nth 3 lr-item)))
+ (let ((lr-item-suffix-first (car lr-item-suffix))
+ (lr-item-suffix-rest (cdr lr-item-suffix)))
+
+ ;; (a) If [A -> a . XiB, u] is in V(X1,...,Xi-1)
+ (when (eq lr-item-suffix-first prefix)
+
+ ;; Add [A -> aXi . B, u] to V(X1,...,Xi)
+ (let ((combined-prefix (append lr-item-prefix (list
prefix))))
+ (push `(,lr-item-lhs ,combined-prefix
,lr-item-suffix-rest ,lr-item-look-ahead) lr-new-item))))))
+
+ ;; (c) Repeat step (2b) until no more new items can be added to
V(X1,...,Xi)
+ (let ((added-new t))
+ (while added-new
+ (setq added-new nil)
+ (dolist (lr-item lr-new-item)
+ (let ((lr-item-suffix (nth 2 lr-item)))
+ (let ((lr-item-suffix-first (car lr-item-suffix))
+ (lr-item-suffix-rest (cdr lr-item-suffix)))
+
+ ;; (b) If [A -> a . Bb, u] has been placed in
V(X1,...,Xi)
+ ;; and B -> D is in P
+ (when (parser--valid-non-terminal-p
lr-item-suffix-first)
+
+ (let ((lr-item-suffix-rest-first (parser--first
lr-item-suffix-rest)))
+ (unless lr-item-suffix-rest-first
+ (setq lr-item-suffix-rest-first (list nil)))
+ (let ((sub-production (parser--get-grammar-rhs
lr-item-suffix-first)))
+
+ ;; For each production with B as LHS
+ (dolist (sub-rhs sub-production)
+
+ ;; For each x in FIRST(αu)
+ (dolist (f lr-item-suffix-rest-first)
+
+ ;; then add [B -> . D, x] to V(X1,...,Xi)
for each x in FIRST(bu)
+ ;; provided it is not already there
+ (unless (gethash `(,prefix-acc
,lr-item-suffix-first nil ,sub-rhs ,f) lr-item-exists)
+ (setq added-new t)
+ (puthash `(,prefix-acc
,lr-item-suffix-first nil ,sub-rhs ,f) t lr-item-exists)
+ (push `(,lr-item-suffix-first nil ,sub-rhs
,f) lr-new-item))))))))))))
+
+ (setq prefix-previous lr-new-item)
+ (parser--debug
+ (message "V(%s) = %s" prefix-acc lr-new-item))
+ (puthash prefix-acc lr-new-item lr-items)))))
+ (parser--debug
+ (message "γ: %s" γ))
(gethash γ lr-items))))
diff --git a/test/parser-test.el b/test/parser-test.el
index 1bd5588..fa0517f 100644
--- a/test/parser-test.el
+++ b/test/parser-test.el
@@ -231,6 +231,18 @@
(parser--set-grammar '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) Sp))
(parser--set-look-ahead-number 1)
+ '((S (e) nil (e)) (S (e) nil (a)))
+
+ (should
+ (equal
+ '((Sp nil (S) (e))
+ (S nil (S a S b) (e))
+ (S nil (S a S b) (a))
+ (S nil nil (e))
+ (S nil nil (a)))
+ (parser--lr-items 'e)))
+ (message "Passed V(e)")
+
(should
(equal
'((Sp (S) nil (e))
@@ -250,16 +262,6 @@
(parser--lr-items '(S a))))
(message "Passed V(Sa)")
- (should
- (equal
- '((Sp nil (S) (e))
- (S nil (S a S b) (e))
- (S nil (S a S b) (a))
- (S nil nil (e))
- (S nil nil (a)))
- (parser--lr-items 'e)))
- (message "Passed V(e)")
-
(message "Passed tests for (parser--lr-items)"))
(defun parser-test--valid-grammar-p ()
