branch: externals/parser-generator
commit 56363c18144775261c53c43ccf294867f7861f56
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Fixed last TODO items
---
parser-generator-lr.el | 2 -
parser-generator.el | 130 +++++++++++++++++----------------------
test/parser-generator-lr-test.el | 4 --
test/parser-generator-test.el | 4 ++
4 files changed, 62 insertions(+), 78 deletions(-)
diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index afd6f00..3bc322f 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -35,7 +35,6 @@
;; Algorithm 5.11, p. 393
-;; TODO Test this function with above 1 as look-ahead number
(defun parser-generator-lr--generate-action-tables (table-lr-items)
"Generate action-tables for lr-grammar based on TABLE-LR-ITEMS."
(let ((action-tables)
@@ -816,7 +815,6 @@
(nth 1 result)))
;; Algorithm 5.7, p. 375
-;; TODO Test cases with above 1 as look-ahead number
(defun parser-generator-lr--parse
(&optional input-tape-index
pushdown-list
diff --git a/parser-generator.el b/parser-generator.el
index fb7a3f5..f0caf27 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -340,40 +340,12 @@
(let ((productions
(parser-generator--get-grammar-productions)))
- ;; TODO Could optimize these two loops into one
-
;; Build hash-table of all right-hand-sides of
;; a given left-hand-side of a production
;; exclude all functions that are used for translations
(setq
parser-generator--table-productions-rhs
(make-hash-table :test 'equal))
- (dolist (p productions)
- (let ((lhs (car p))
- (rhs (cdr p)))
- (unless (listp lhs)
- (setq lhs (list lhs)))
- (let ((new-value
- (gethash
- lhs
- parser-generator--table-productions-rhs)))
- (dolist (rhs-element rhs)
- (unless (functionp rhs-element)
- (unless (listp rhs-element)
- (setq rhs-element (list rhs-element)))
- (let ((new-rhs))
- (dolist (rhs-sub-element rhs-element)
- (unless (functionp rhs-sub-element)
- (push
- rhs-sub-element
- new-rhs)))
- (push
- (nreverse new-rhs)
- new-value))))
- (puthash
- lhs
- (nreverse new-value)
- parser-generator--table-productions-rhs))))
;; Build hash-table of production -> production number
;; and production-number -> production
@@ -390,6 +362,7 @@
(setq
parser-generator--table-translations
(make-hash-table :test 'equal))
+
(let ((production-index 0)
(new-productions))
(dolist (p productions)
@@ -399,7 +372,11 @@
(translation))
(unless (listp lhs)
(setq lhs (list lhs)))
- (let ((rhs-element-index 0)
+ (let ((new-value
+ (gethash
+ lhs
+ parser-generator--table-productions-rhs))
+ (rhs-element-index 0)
(rhs-length (length rhs))
(rhs-element))
(while
@@ -417,51 +394,58 @@
rhs-element
rhs
lhs))
- (unless (listp rhs-element)
+ (unless (listp rhs-element)
+ (setq rhs-element (list rhs-element)))
+ (let ((sub-rhs-element-index 0)
+ (sub-rhs-element-length (length rhs-element))
+ (sub-rhs-element)
+ (new-rhs))
+ (while
+ (<
+ sub-rhs-element-index
+ sub-rhs-element-length)
(setq
- rhs-element
- (list rhs-element)))
- (let ((sub-rhs-element-index 0)
- (sub-rhs-element-length (length rhs-element))
- (sub-rhs-element)
- (new-rhs))
- (while
- (<
- sub-rhs-element-index
- sub-rhs-element-length)
- (setq
- sub-rhs-element
- (nth
- sub-rhs-element-index
- rhs-element))
- (if (functionp sub-rhs-element)
- (setq
- translation
- sub-rhs-element)
- (unless
- (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))
- (error
- "Element %s in RHS %s of production %s is not a valid
terminal, non-terminal or e-identifier!"
- sub-rhs-element
- rhs-element
- lhs))
- (push
+ sub-rhs-element
+ (nth
+ sub-rhs-element-index
+ rhs-element))
+ (if (functionp sub-rhs-element)
+ (setq
+ translation
+ sub-rhs-element)
+ (unless
+ (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))
+ (error
+ "Element %s in RHS %s of production %s is not a valid
terminal, non-terminal or e-identifier!"
sub-rhs-element
- new-rhs))
- (setq
- sub-rhs-element-index
- (1+ sub-rhs-element-index)))
+ rhs-element
+ lhs))
+ (push
+ sub-rhs-element
+ new-rhs))
(setq
- production
- (list lhs (nreverse new-rhs)))
- (parser-generator--debug
- (message
- "Production %s: %s"
- production-index
- production)))
+ sub-rhs-element-index
+ (1+ sub-rhs-element-index)))
+ (setq
+ production
+ (list
+ lhs
+ (reverse new-rhs)))
+ (parser-generator--debug
+ (message
+ "Production %s: %s"
+ production-index
+ production))
+ (push
+ (reverse new-rhs)
+ new-value)
+ (puthash
+ lhs
+ (reverse new-value)
+ parser-generator--table-productions-rhs))
(setq
rhs-element-index
(1+ rhs-element-index))
@@ -486,7 +470,9 @@
production-index
translation
parser-generator--table-translations))
- (setq production-index (1+ production-index))))))
+ (setq
+ production-index
+ (1+ production-index))))))
(setq
new-productions
(nreverse new-productions))
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 5bf630e..88c4900 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -77,8 +77,6 @@
(parser-generator--hash-to-list
parser-generator-lr--action-tables)))
- ;; TODO Test with look-ahead number > 1 here
-
(message "Ended tests for (parser-generator-lr--generate-action-tables)"))
(defun parser-generator-lr-test--generate-goto-tables ()
@@ -174,8 +172,6 @@
(message "Passed LR-items for example 5.30 but with tokens as strings")
- ;; TODO Test with look-ahead number > 1 he
-
(message "Passed tests for (parser-r--generate-goto-tables)"))
(defun parser-generator-lr-test--items-for-prefix ()
diff --git a/test/parser-generator-test.el b/test/parser-generator-test.el
index 4ffaa73..6d23e5e 100644
--- a/test/parser-generator-test.el
+++ b/test/parser-generator-test.el
@@ -571,6 +571,10 @@
(parser-generator--valid-sentential-form-p
'(B "b"))))
+ (parser-generator-set-grammar '((S A B) ("a" "b") ((S A) (A (b "a")) (B ("b"
(lambda(b) (message "Was here: %s" b))))) S))
+ (should-error
+ (parser-generator-process-grammar))
+
(message "Passed tests for (parser-generator--valid-sentential-form-p)"))
(defun parser-generator-test--valid-production-p ()
