branch: externals/parser-generator
commit 172d530871c2a51de6b0c53d1168aa538c87853e
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Improved handling of production LHS to enable multiple symbols
---
parser-generator-lr.el | 65 ++++++++++++++------
parser-generator.el | 10 +++-
test/parser-generator-lr-test.el | 124 +++++++++++++++++++++------------------
3 files changed, 122 insertions(+), 77 deletions(-)
diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 72e0bca..5f29073 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -373,7 +373,8 @@
;; Iterate all productions in grammar
(let ((lr-items-e)
- (start-productions (parser-generator--get-grammar-rhs start))
+ (start-productions
+ (parser-generator--get-grammar-rhs start))
(e-list (parser-generator--generate-list-of-symbol
parser-generator--look-ahead-number
parser-generator--e-identifier)))
@@ -381,8 +382,8 @@
;; (a)
(dolist (rhs start-productions)
;; Add [S -> . α] to V(e)
- (push `(,start nil ,rhs ,e-list) lr-items-e)
- (puthash `(,e-list ,start nil ,rhs ,e-list) t lr-item-exists))
+ (push `(,(list start) nil ,rhs ,e-list) lr-items-e)
+ (puthash `(,e-list ,(list start) nil ,rhs ,e-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
@@ -405,14 +406,18 @@
(let ((rhs-first (car rhs)))
(parser-generator--debug
(message "rhs-first: %s" rhs-first))
- (when (parser-generator--valid-non-terminal-p rhs-first)
+ (when
+ (parser-generator--valid-non-terminal-p
+ rhs-first)
(let ((rhs-rest (append (cdr rhs) suffix)))
(let ((rhs-rest-first (parser-generator--first
rhs-rest)))
(parser-generator--debug
(message "rhs-rest-first: %s" rhs-rest-first))
(unless rhs-rest-first
(setq rhs-rest-first `(,e-list)))
- (let ((sub-production
(parser-generator--get-grammar-rhs rhs-first)))
+ (let ((sub-production
+ (parser-generator--get-grammar-rhs
+ rhs-first)))
(parser-generator--debug
(message "sub-production: %s" sub-production))
@@ -434,9 +439,17 @@
(message "f: %s" f))
;; Add [B -> . β, x] to V(e), provided it is
not already there
- (unless (gethash `(e ,rhs-first nil ,sub-rhs
,f) lr-item-exists)
- (puthash `(e ,rhs-first nil ,sub-rhs ,f) t
lr-item-exists)
- (push `(,rhs-first nil ,sub-rhs ,f)
lr-items-e)
+ (unless
+ (gethash
+ `(e ,(list rhs-first) nil ,sub-rhs ,f)
+ lr-item-exists)
+ (puthash
+ `(e ,(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))))))))))))))
@@ -444,7 +457,9 @@
(parser-generator--debug
(message "V(e) = %s" lr-items-e))
- (setq lr-items-e (sort lr-items-e 'parser-generator--sort-list))
+ (setq
+ lr-items-e
+ (sort lr-items-e 'parser-generator--sort-list))
;; 2 Suppose that we have constructed V(X1,X2,...,Xi-1) we construct
V(X1,X2,...,Xi) as follows:
;; Only do this step if prefix is not the e-identifier
@@ -471,7 +486,9 @@
;; Fill up rest of prefix with e-identifier if length is below
k
(while (< (length prefix) k)
- (push parser-generator--e-identifier prefix))
+ (push
+ parser-generator--e-identifier
+ prefix))
(setq prefix (reverse prefix))
(let ((lr-new-item))
@@ -509,7 +526,9 @@
(lr-item-suffix-i 0))
;; Gather first and rest of suffix dependent on look-ahead number
- (let ((lr-item-suffix-length (length lr-item-suffix)))
+ (let
+ ((lr-item-suffix-length
+ (length lr-item-suffix)))
(while
(< lr-item-suffix-i lr-item-suffix-length)
(if
@@ -596,17 +615,27 @@
;; then add [B -> . D, x] to V(X1,...,Xi) for each x
in FIRST(bu)
;; provided it is not already there
(let ((lr-item-to-add
- `(,lr-item-suffix-first nil ,sub-rhs ,f)))
- (unless (gethash lr-item-to-add lr-item-exists)
+ `(,(list lr-item-suffix-first) nil ,sub-rhs
,f)))
+ (unless
+ (gethash
+ lr-item-to-add
+ lr-item-exists)
(setq added-new t)
(parser-generator--debug
(message
"lr-item-to-add: %s"
lr-item-to-add))
- (puthash lr-item-to-add t lr-item-exists)
- (push lr-item-to-add lr-new-item)))))))))))))
+ (puthash
+ lr-item-to-add
+ t
+ lr-item-exists)
+ (push
+ lr-item-to-add
+ lr-new-item)))))))))))))
- (setq lr-new-item (sort lr-new-item 'parser-generator--sort-list))
+ (setq
+ lr-new-item
+ (sort lr-new-item 'parser-generator--sort-list))
lr-new-item))
(defun parser-generator-lr-parse
@@ -904,9 +933,7 @@
(t (error
"Invalid action-match: %s!"
- action-match)))
-
- (error "was here"))))))
+ action-match))))))))
(unless accept
(error
"Parsed entire string without getting accepting! Output: %s"
diff --git a/parser-generator.el b/parser-generator.el
index 8a285db..c47252c 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -11,7 +11,7 @@
(defvar parser-generator--debug
- t
+ nil
"Whether to print debug messages or not.")
(defvar parser-generator--e-identifier
@@ -197,7 +197,11 @@
"Return right hand sides of LHS if there is any."
(unless parser-generator--table-productions-rhs
(error "Table for productions RHS indexed by LHS is undefined!"))
- (gethash lhs parser-generator--table-productions-rhs))
+ (unless (listp lhs)
+ (setq lhs (list lhs)))
+ (gethash
+ lhs
+ parser-generator--table-productions-rhs))
(defun parser-generator--get-grammar-start (&optional G)
"Return start of grammar G."
@@ -295,6 +299,8 @@
(dolist (p productions)
(let ((lhs (car p))
(rhs (cdr p)))
+ (unless (listp lhs)
+ (setq lhs (list lhs)))
(let ((new-value
(gethash
lhs
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index c8f5253..4580b89 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -84,26 +84,29 @@
(message "Starting tests for (parser-generator-lr--generate-goto-tables)")
;; Example 5.30, p. 389
- (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)
(let ((table-lr-items (parser-generator-lr--generate-goto-tables)))
- (message
- "GOTO-table: %s"
- (parser-generator--hash-to-list
- parser-generator-lr--goto-tables))
- (message
- "LR-items: %s"
- (parser-generator--hash-to-list
- table-lr-items))
+ (parser-generator--debug
+ (message
+ "GOTO-table: %s"
+ (parser-generator--hash-to-list
+ parser-generator-lr--goto-tables))
+ (message
+ "LR-items: %s"
+ (parser-generator--hash-to-list
+ table-lr-items)))
(parser-generator-lr--generate-action-tables
table-lr-items)
- (message
- "ACTION-tables: %s"
- (parser-generator--hash-to-list
- parser-generator-lr--action-tables))
+ (parser-generator--debug
+ (message
+ "ACTION-tables: %s"
+ (parser-generator--hash-to-list
+ parser-generator-lr--action-tables)))
(should
(equal
@@ -121,14 +124,14 @@
(should
(equal
- '((0 ((S nil (S a S b) (a)) (S nil (S a S b) (e)) (S nil nil (a)) (S nil
nil (e)) (Sp nil (S) (e))))
- (1 ((S (S) (a S b) (a)) (S (S) (a S b) (e)) (Sp (S) nil (e))))
- (2 ((S (S a) (S b) (a)) (S (S a) (S b) (e)) (S nil (S a S b) (a)) (S
nil (S a S b) (b)) (S nil nil (a)) (S nil nil (b))))
- (3 ((S (S) (a S b) (a)) (S (S) (a S b) (b)) (S (S a S) (b) (a)) (S (S
a S) (b) (e))))
- (4 ((S (S a) (S b) (a)) (S (S a) (S b) (b)) (S nil (S a S b) (a)) (S
nil (S a S b) (b)) (S nil nil (a)) (S nil nil (b))))
- (5 ((S (S a S b) nil (a)) (S (S a S b) nil (e))))
- (6 ((S (S) (a S b) (a)) (S (S) (a S b) (b)) (S (S a S) (b) (a)) (S (S
a S) (b) (b))))
- (7 ((S (S a S b) nil (a)) (S (S a S b) nil (b)))))
+ '((0 (((S) nil (S a S b) (a)) ((S) nil (S a S b) (e)) ((S) nil nil (a))
((S) nil nil (e)) ((Sp) nil (S) (e))))
+ (1 (((S) (S) (a S b) (a)) ((S) (S) (a S b) (e)) ((Sp) (S) nil (e))))
+ (2 (((S) (S a) (S b) (a)) ((S) (S a) (S b) (e)) ((S) nil (S a S b)
(a)) ((S) nil (S a S b) (b)) ((S) nil nil (a)) ((S) nil nil (b))))
+ (3 (((S) (S) (a S b) (a)) ((S) (S) (a S b) (b)) ((S) (S a S) (b) (a))
((S) (S a S) (b) (e))))
+ (4 (((S) (S a) (S b) (a)) ((S) (S a) (S b) (b)) ((S) nil (S a S b)
(a)) ((S) nil (S a S b) (b)) ((S) nil nil (a)) ((S) nil nil (b))))
+ (5 (((S) (S a S b) nil (a)) ((S) (S a S b) nil (e))))
+ (6 (((S) (S) (a S b) (a)) ((S) (S) (a S b) (b)) ((S) (S a S) (b) (a))
((S) (S a S) (b) (b))))
+ (7 (((S) (S a S b) nil (a)) ((S) (S a S b) nil (b)))))
(parser-generator--hash-to-list
table-lr-items))))
(message "Passed LR-items")
@@ -136,7 +139,8 @@
(message "Passed LR-items for example 5.30")
;; Example 5.30, p. 389 but with terminals as strings
- (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)
@@ -161,14 +165,14 @@
(should
(equal
- '((0 ((S nil (S "a" S "b") ("a")) (S nil (S "a" S "b") (e)) (S nil nil
("a")) (S nil nil (e)) (Sp nil (S) (e))))
- (1 ((S (S) ("a" S "b") ("a")) (S (S) ("a" S "b") (e)) (Sp (S) nil
(e))))
- (2 ((S (S "a") (S "b") ("a")) (S (S "a") (S "b") (e)) (S nil (S "a" S
"b") ("a")) (S nil (S "a" S "b") ("b")) (S nil nil ("a")) (S nil nil ("b"))))
- (3 ((S (S) ("a" S "b") ("a")) (S (S) ("a" S "b") ("b")) (S (S "a" S)
("b") ("a")) (S (S "a" S) ("b") (e))))
- (4 ((S (S "a") (S "b") ("a")) (S (S "a") (S "b") ("b")) (S nil (S "a"
S "b") ("a")) (S nil (S "a" S "b") ("b")) (S nil nil ("a")) (S nil nil ("b"))))
- (5 ((S (S "a" S "b") nil ("a")) (S (S "a" S "b") nil (e))))
- (6 ((S (S) ("a" S "b") ("a")) (S (S) ("a" S "b") ("b")) (S (S "a" S)
("b") ("a")) (S (S "a" S) ("b") ("b"))))
- (7 ((S (S "a" S "b") nil ("a")) (S (S "a" S "b") nil ("b")))))
+ '((0 (((S) nil (S "a" S "b") ("a")) ((S) nil (S "a" S "b") (e)) ((S) nil
nil ("a")) ((S) nil nil (e)) ((Sp) nil (S) (e))))
+ (1 (((S) (S) ("a" S "b") ("a")) ((S) (S) ("a" S "b") (e)) ((Sp) (S)
nil (e))))
+ (2 (((S) (S "a") (S "b") ("a")) ((S) (S "a") (S "b") (e)) ((S) nil (S
"a" S "b") ("a")) ((S) nil (S "a" S "b") ("b")) ((S) nil nil ("a")) ((S) nil
nil ("b"))))
+ (3 (((S) (S) ("a" S "b") ("a")) ((S) (S) ("a" S "b") ("b")) ((S) (S
"a" S) ("b") ("a")) ((S) (S "a" S) ("b") (e))))
+ (4 (((S) (S "a") (S "b") ("a")) ((S) (S "a") (S "b") ("b")) ((S) nil
(S "a" S "b") ("a")) ((S) nil (S "a" S "b") ("b")) ((S) nil nil ("a")) ((S) nil
nil ("b"))))
+ (5 (((S) (S "a" S "b") nil ("a")) ((S) (S "a" S "b") nil (e))))
+ (6 (((S) (S) ("a" S "b") ("a")) ((S) (S) ("a" S "b") ("b")) ((S) (S
"a" S) ("b") ("a")) ((S) (S "a" S) ("b") ("b"))))
+ (7 (((S) (S "a" S "b") nil ("a")) ((S) (S "a" S "b") nil ("b")))))
(parser-generator--hash-to-list table-lr-items)))
(message "Passed LR-items with tokens as strings"))
@@ -181,25 +185,26 @@
(message "Starting tests for (parser-generator-lr--items-for-prefix)")
;; Example 5.29 p 387
- (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)
(should
(equal
- '((S nil (S a S b) (a))
- (S nil (S a S b) (e))
- (S nil nil (a))
- (S nil nil (e))
- (Sp nil (S) (e)))
+ '(((S) nil (S a S b) (a))
+ ((S) nil (S a S b) (e))
+ ((S) nil nil (a))
+ ((S) nil nil (e))
+ ((Sp) nil (S) (e)))
(parser-generator-lr--items-for-prefix 'e)))
(message "Passed V(e)")
(should
(equal
- '((S (S) (a S b) (a))
- (S (S) (a S b) (e))
- (Sp (S) nil (e)))
+ '(((S) (S) (a S b) (a))
+ ((S) (S) (a S b) (e))
+ ((Sp) (S) nil (e)))
(parser-generator-lr--items-for-prefix 'S)))
(message "Passed V(S)")
@@ -217,12 +222,12 @@
(should
(equal
- '((S (S a) (S b) (a))
- (S (S a) (S b) (e))
- (S nil (S a S b) (a))
- (S nil (S a S b) (b))
- (S nil nil (a))
- (S nil nil (b)))
+ '(((S) (S a) (S b) (a))
+ ((S) (S a) (S b) (e))
+ ((S) nil (S a S b) (a))
+ ((S) nil (S a S b) (b))
+ ((S) nil nil (a))
+ ((S) nil nil (b)))
(parser-generator-lr--items-for-prefix '(S a))))
(message "Passed V(Sa)")
@@ -241,10 +246,10 @@
;; a3 p. 390
(should
(equal
- '((S (S) (a S b) (a))
- (S (S) (a S b) (b))
- (S (S a S) (b) (a))
- (S (S a S) (b) (e)))
+ '(((S) (S) (a S b) (a))
+ ((S) (S) (a S b) (b))
+ ((S) (S a S) (b) (a))
+ ((S) (S a S) (b) (e)))
(parser-generator-lr--items-for-prefix '(S a S))))
(message "Passed V(SaS)")
@@ -336,10 +341,12 @@
(parser-generator-set-look-ahead-number 1)
(parser-generator-process-grammar)
(let ((lr-items (parser-generator-lr-generate-parser-tables)))
- (message "lr-items: %s" (parser-generator--hash-values-to-list lr-items t))
+ (parser-generator--debug
+ (message "lr-items: %s" (parser-generator--hash-values-to-list lr-items
t)))
)
- (message "goto-tables: %s" (parser-generator--hash-values-to-list
parser-generator-lr--goto-tables t))
- (message "action-tables: %s" (parser-generator--hash-values-to-list
parser-generator-lr--action-tables t))
+ (parser-generator--debug
+ (message "goto-tables: %s" (parser-generator--hash-values-to-list
parser-generator-lr--goto-tables t))
+ (message "action-tables: %s" (parser-generator--hash-values-to-list
parser-generator-lr--action-tables t)))
(setq
parser-generator-lex-analyzer--function
(lambda (index)
@@ -393,18 +400,23 @@
(parser-generator-lr-test--parse-incremental-vs-regular)
(message "Passed incremental-tests")
+ (message "Starting test with look-ahead number = 2")
+
(parser-generator-set-grammar '((Sp S) ("a" "b") ((Sp S) (S (S "a" S "b"))
(S e)) Sp))
(parser-generator-set-look-ahead-number 2)
(parser-generator-process-grammar)
(let ((lr-items (parser-generator-lr--generate-goto-tables)))
- (message "lr-items: %s" (parser-generator--hash-values-to-list lr-items t))
+ (parser-generator--debug
+ (message "lr-items: %s" (parser-generator--hash-values-to-list lr-items
t)))
;; TODO Fix so that there is an accept path in look-ahead number 2
-
- (message "goto-tables: %s" (parser-generator--hash-values-to-list
parser-generator-lr--goto-tables t))
+
+ (parser-generator--debug
+ (message "goto-tables: %s" (parser-generator--hash-values-to-list
parser-generator-lr--goto-tables t)))
(parser-generator-lr--generate-action-tables lr-items)
;; TODO Should generate accept somewhere in this action-table
- (message "action-tables: %s" (parser-generator--hash-values-to-list
parser-generator-lr--action-tables t)))
+ (parser-generator--debug
+ (message "action-tables: %s" (parser-generator--hash-values-to-list
parser-generator-lr--action-tables t))))
(setq
parser-generator-lex-analyzer--function
(lambda (index)
