branch: externals/parser-generator
commit 8e3084b739e3a2880b4db28f7c192f875f166c5f
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
More work LRk parser k = 0
---
parser-generator-lr.el | 146 +++++++++++++++++++++++++++------------
parser-generator.el | 19 ++++-
test/parser-generator-lr-test.el | 21 +++---
3 files changed, 129 insertions(+), 57 deletions(-)
diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 3bc322f..64ae584 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -221,6 +221,8 @@
;; Algorithm 5.9, p. 389
(defun parser-generator-lr--generate-goto-tables ()
"Calculate set of valid LR(k) items for grammar and a GOTO-table."
+ (parser-generator--debug
+ (message "(parser-generator-lr--generate-goto-tables)"))
(let ((lr-item-set-new-index 0)
(goto-table)
(unmarked-lr-item-sets)
@@ -240,7 +242,12 @@
unmarked-lr-item-sets)
(setq
lr-item-set-new-index
- (1+ lr-item-set-new-index)))
+ (1+ lr-item-set-new-index))
+ ;; Mark the initial set
+ (puthash
+ e-set
+ lr-item-set-new-index
+ marked-lr-item-sets))
;; (2) If a set of items a in S is unmarked
;; (3) Repeat step (2) until all sets of items in S are marked.
@@ -255,15 +262,9 @@
(setq lr-items (car (cdr popped-item)))
(parser-generator--debug
(message "lr-item-set-index: %s" lr-item-set-index)
- (message "lr-items: %s" lr-items)
+ (message "marked lr-items: %s" lr-items)
(message "popped-item: %s" popped-item))
- ;; (2) Mark a
- (puthash
- lr-items
- lr-item-set-index
- marked-lr-item-sets)
-
(puthash
lr-item-set-index
lr-items
@@ -338,13 +339,18 @@
(if goto
(progn
(parser-generator--debug
- (message "Set already exists in: %s" goto))
+ (message
+ "Set already exists in: %s set: %s"
+ goto
+ prefix-lr-items))
(push
`(,symbol ,goto)
goto-table-table))
(parser-generator--debug
- (message "Set is new"))
+ (message
+ "Set is new: %s"
+ prefix-lr-items))
;; Note that GOTO(a, X) will always be empty if all items
in a
;; have the dot at the right end of the production
@@ -356,6 +362,11 @@
(push
`(,lr-item-set-new-index ,prefix-lr-items)
unmarked-lr-item-sets)
+ ;; (2) Mark a
+ (puthash
+ prefix-lr-items
+ lr-item-set-new-index
+ marked-lr-item-sets)
(setq
lr-item-set-new-index
(1+ lr-item-set-new-index))))))))
@@ -366,7 +377,9 @@
goto-table-table
'parser-generator--sort-list))
(push
- `(,lr-item-set-index ,goto-table-table)
+ `(
+ ,lr-item-set-index
+ ,goto-table-table)
goto-table)))
(setq
@@ -507,13 +520,23 @@
;; (a)
(dolist (rhs start-productions)
;; Add [S -> . α] to V(e)
- (push
- `(,(list start) nil ,rhs ,eof-list)
- lr-items-e)
- (puthash
- `(,e-list ,(list start) nil ,rhs ,eof-list)
- t
- lr-item-exists))
+ (if (= parser-generator--look-ahead-number 0)
+ ;; A dot-look-ahead is only used for k >= 1
+ (progn
+ (push
+ `(,(list start) nil ,rhs)
+ lr-items-e)
+ (puthash
+ `(,e-list ,(list start) nil ,rhs)
+ t
+ lr-item-exists))
+ (push
+ `(,(list start) nil ,rhs ,eof-list)
+ lr-items-e)
+ (puthash
+ `(,e-list ,(list start) nil ,rhs ,eof-list)
+ t
+ lr-item-exists)))
;; (b) Iterate every item in v-set(e), if [A -> . Bα, u] is an item
and B -> β is in P
;; then for each x in FIRST(αu) add [B -> . β, x] to v-set(e),
provided it is not already there
@@ -573,20 +596,38 @@
(message "f: %s" f))
;; Add [B -> . β, x] to V(e), provided it is
not already there
- (unless
- (gethash
+ (if (= parser-generator--look-ahead-number 0)
+
+ ;; A dot look-ahead is only used for k
>= 1
+ (unless
+ (gethash
+ `(,e-list ,(list rhs-first) nil
,sub-rhs)
+ lr-item-exists)
+ (puthash
+ `(,e-list ,(list rhs-first) nil
,sub-rhs)
+ t
+ lr-item-exists)
+ (push
+ `(,(list rhs-first) nil ,sub-rhs)
+ lr-items-e)
+
+ ;; (c) Repeat (b) until no more items
can be added to V(e)
+ (setq found-new t))
+
+ (unless
+ (gethash
+ `(,e-list ,(list rhs-first) nil
,sub-rhs ,f)
+ lr-item-exists)
+ (puthash
`(,e-list ,(list rhs-first) nil
,sub-rhs ,f)
+ t
lr-item-exists)
- (puthash
- `(,e-list ,(list rhs-first) nil ,sub-rhs
,f)
- t
- lr-item-exists)
- (push
- `(,(list rhs-first) nil ,sub-rhs ,f)
- lr-items-e)
-
- ;; (c) Repeat (b) until no more items can
be added to V(e)
- (setq found-new t)))))))
+ (push
+ `(,(list rhs-first) nil ,sub-rhs ,f)
+ lr-items-e)
+
+ ;; (c) Repeat (b) until no more items
can be added to V(e)
+ (setq found-new t))))))))
(parser-generator--debug
(message "is not non-terminal")))))))))
@@ -680,19 +721,28 @@
(append
lr-item-prefix
(list x))))
- (parser-generator--debug
- (message
- "lr-new-item-1: %s"
- `(,lr-item-lhs
- ,combined-prefix
- ,lr-item-suffix-rest
- ,lr-item-look-ahead)))
- (push
- `(,lr-item-lhs
- ,combined-prefix
- ,lr-item-suffix-rest
- ,lr-item-look-ahead)
- lr-new-item)))))
+ (let ((lr-new-item-1))
+ (if (= parser-generator--look-ahead-number 0)
+ ;; Only k >= 1 needs dot look-ahead
+ (progn
+ (setq
+ lr-new-item-1
+ `(,lr-item-lhs
+ ,combined-prefix
+ ,lr-item-suffix-rest)))
+ (setq
+ lr-new-item-1
+ `(,lr-item-lhs
+ ,combined-prefix
+ ,lr-item-suffix-rest
+ ,lr-item-look-ahead)))
+ (parser-generator--debug
+ (message
+ "lr-new-item-1: %s"
+ lr-new-item-1))
+ (push
+ lr-new-item-1
+ lr-new-item))))))
;; (c) Repeat step (2b) until no more new items can be added to
V(X1,...,Xi)
(when lr-new-item
@@ -759,6 +809,12 @@
;; provided it is not already there
(let ((lr-item-to-add
`(,(list lr-item-suffix-first) nil ,sub-rhs
,f)))
+ ;; Only k >= 1 needs dot a look-ahead
+ (when
+ (= parser-generator--look-ahead-number 0)
+ (setq
+ lr-item-to-add
+ `(,(list lr-item-suffix-first) nil ,sub-rhs)))
(unless
(gethash
lr-item-to-add
@@ -777,7 +833,9 @@
lr-new-item)))))))))))))
(setq
lr-new-item
- (sort lr-new-item 'parser-generator--sort-list)))
+ (sort
+ lr-new-item
+ 'parser-generator--sort-list)))
lr-new-item))
diff --git a/parser-generator.el b/parser-generator.el
index f0caf27..9cde3a5 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -11,7 +11,7 @@
(defvar parser-generator--debug
- nil
+ t
"Whether to print debug messages or not.")
(defvar parser-generator--e-identifier
@@ -417,9 +417,10 @@
(or
(parser-generator--valid-terminal-p sub-rhs-element)
(parser-generator--valid-non-terminal-p
sub-rhs-element)
- (parser-generator--valid-e-p sub-rhs-element))
+ (parser-generator--valid-e-p sub-rhs-element)
+ (parser-generator--valid-eof-p sub-rhs-element))
(error
- "Element %s in RHS %s of production %s is not a valid
terminal, non-terminal or e-identifier!"
+ "Element %s in RHS %s of production %s is not a valid
terminal, non-terminal, e-identifier or EOF-identifier!"
sub-rhs-element
rhs-element
lhs))
@@ -508,6 +509,18 @@
(defun parser-generator-process-grammar ()
"Process grammar."
(parser-generator--clear-cache)
+ (unless parser-generator--look-ahead-number
+ (error "No look-ahead-number defined!"))
+ (unless
+ (parser-generator--valid-look-ahead-number-p
+ parser-generator--look-ahead-number)
+ (error "Invalid look-ahead number k!"))
+ (unless parser-generator--grammar
+ (error "No grammar defined!"))
+ (unless
+ (parser-generator--valid-grammar-p
+ parser-generator--grammar)
+ (error "Invalid grammar G!"))
(parser-generator--load-symbols))
(defun parser-generator--sort-list (a b)
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 573297c..cb37024 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -731,7 +731,7 @@
;; (5) B → 1
(parser-generator-set-grammar
- '((S E B) ("*" "+" "0" "1") ((S E) (E (E "*" B) (E "+" B) (B)) (B ("0")
("1"))) S))
+ '((S E B) ("*" "+" "0" "1") ((S (E $)) (E (E "*" B) (E "+" B) (B)) (B ("0")
("1"))) S))
(parser-generator-set-look-ahead-number 0)
(parser-generator-process-grammar)
@@ -783,29 +783,30 @@
(should
(equal
'((0 (
- ((S) nil (E $))
- ((E) nil (E "*" B))
- ((E) nil (E "+" B))
- ((E) nil (B))
((B) nil ("0"))
((B) nil ("1"))
+ ((E) nil (B))
+ ((E) nil (E "+" B))
+ ((E) nil (E "*" B))
+ ((S) nil (E $))
))
(1 (((B) ("0") nil)))
(2 (((B) ("1") nil)))
(3 (
- ((S) (E) ($))
- ((E) (E) ("*" B))
((E) (E) ("+" B))
+ ((E) (E) ("*" B))
+ ((S) (E) ($))
))
(4 (((E) (B) nil)))
(5 (
- ((E) (E "*") (B))
+ ((B) nil ("0"))
((B) nil ("1"))
+ ((E) (E "*") (B))
))
(6 (
- ((E) (E "+") (B))
((B) nil ("0"))
((B) nil ("1"))
+ ((E) (E "+") (B))
))
(7 (((E) (E "*" B) nil)))
(8 (((E) (E "+" B) nil))))
@@ -1179,7 +1180,7 @@
(defun parser-generator-lr-test ()
"Run test."
- (setq debug-on-error t)
+ ;; (setq debug-on-error t)
(parser-generator-lr-test--items-for-prefix)
(parser-generator-lr-test--items-valid-p)
