branch: externals/parser-generator
commit 96cd5de209ccd66d4b9245adfb04fb821083c7e5
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Improved validation of grammar structure
---
parser-generator.el | 123 +++++++++++++++++++++++++++---------------
test/parser-generator-test.el | 89 +++++++++++++++++-------------
2 files changed, 130 insertions(+), 82 deletions(-)
diff --git a/parser-generator.el b/parser-generator.el
index 8f72da7..fb7a3f5 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -340,10 +340,11 @@
(let ((productions
(parser-generator--get-grammar-productions)))
- ;; TODO Could optimize this two loops into one
+ ;; 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))
@@ -378,6 +379,8 @@
;; and production-number -> production
;; and a new set of productions that excludes translations
;; and always has the left-hand-side as a list
+ ;; and verify each element in RHS belonging to terminals
+ ;; or non-terminals
(setq
parser-generator--table-productions-number
(make-hash-table :test 'equal))
@@ -399,43 +402,66 @@
(let ((rhs-element-index 0)
(rhs-length (length rhs))
(rhs-element))
- (while (< rhs-element-index rhs-length)
+ (while
+ (<
+ rhs-element-index
+ rhs-length)
(setq
rhs-element
- (nth rhs-element-index rhs))
- (unless (listp rhs-element)
- (setq
+ (nth
+ rhs-element-index
+ rhs))
+ (when (functionp rhs-element)
+ (error
+ "Unexpected function element %s in RHS %s of LHS %s"
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)
+ rhs
+ lhs))
+ (unless (listp rhs-element)
(setq
- sub-rhs-element
- (nth sub-rhs-element-index rhs-element))
- (if (functionp sub-rhs-element)
- (setq
- translation
- sub-rhs-element)
- (push
+ 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
- new-rhs))
+ (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
+ new-rhs))
+ (setq
+ sub-rhs-element-index
+ (1+ sub-rhs-element-index)))
(setq
- sub-rhs-element-index
- (1+ sub-rhs-element-index)))
- (setq
- production
- (list lhs (nreverse new-rhs)))
- (parser-generator--debug
- (message
- "Production %s: %s"
- production-index
- production)))
+ production
+ (list lhs (nreverse new-rhs)))
+ (parser-generator--debug
+ (message
+ "Production %s: %s"
+ production-index
+ production)))
(setq
rhs-element-index
(1+ rhs-element-index))
@@ -577,9 +603,10 @@
valid-p
(< non-terminal-index non-terminal-count))
(let ((non-terminal (nth non-terminal-index non-terminals)))
- (unless (or
- (symbolp non-terminal)
- (stringp non-terminal))
+ (unless
+ (or
+ (symbolp non-terminal)
+ (stringp non-terminal))
(setq valid-p nil)))
(setq non-terminal-index (1+ non-terminal-index)))))
@@ -587,13 +614,15 @@
(let ((terminals (nth 1 G)))
(let ((terminal-count (length terminals))
(terminal-index 0))
- (while (and
- valid-p
- (< terminal-index terminal-count))
+ (while
+ (and
+ valid-p
+ (< terminal-index terminal-count))
(let ((terminal (nth terminal-index terminals)))
- (unless (or
- (symbolp terminal)
- (stringp terminal))
+ (unless
+ (or
+ (symbolp terminal)
+ (stringp terminal))
(setq valid-p nil)))
(setq terminal-index (1+ terminal-index)))))
@@ -605,7 +634,9 @@
valid-p
(< production-index production-count))
(let ((production (nth production-index productions)))
- (unless (parser-generator--valid-production-p production)
+ (unless
+ (parser-generator--valid-production-p
+ production)
(setq valid-p nil)))
(setq production-index (1+ production-index)))))
@@ -637,7 +668,9 @@
"Return whether SYMBOL is a non-terminal in grammar or not."
(unless parser-generator--table-non-terminal-p
(error "Table for non-terminals is undefined!"))
- (gethash symbol parser-generator--table-non-terminal-p))
+ (gethash
+ symbol
+ parser-generator--table-non-terminal-p))
(defun parser-generator--valid-production-p (production)
"Return whether PRODUCTION is valid or not."
@@ -748,7 +781,9 @@
"Return whether SYMBOL is a terminal in grammar or not."
(unless parser-generator--table-terminal-p
(error "Table for terminals is undefined!"))
- (gethash symbol parser-generator--table-terminal-p))
+ (gethash
+ symbol
+ parser-generator--table-terminal-p))
;; Main Algorithms
diff --git a/test/parser-generator-test.el b/test/parser-generator-test.el
index 2ab20c9..4ffaa73 100644
--- a/test/parser-generator-test.el
+++ b/test/parser-generator-test.el
@@ -454,53 +454,65 @@
"Test function `parser-generator--valid-grammar-p'."
(message "Starting tests for (parser-generator--valid-grammar-p)")
- (should (equal
- t
- (parser-generator--valid-grammar-p '((A B C) ("a" "b" "c") ((A
"a")) A))))
+ (should
+ (equal
+ t
+ (parser-generator--valid-grammar-p '((A B C) ("a" "b" "c") ((A "a")) A))))
- (should (equal
- nil
- (parser-generator--valid-grammar-p '((A B C) ("a" "b" "c") ((A
"a")) (A)))))
+ (should
+ (equal
+ nil
+ (parser-generator--valid-grammar-p '((A B C) ("a" "b" "c") ((A "a"))
(A)))))
- (should (equal
- nil
- (parser-generator--valid-grammar-p '((A B C) (("a" "b") "c") ((A
"a")) A))))
+ (should
+ (equal
+ nil
+ (parser-generator--valid-grammar-p '((A B C) (("a" "b") "c") ((A "a"))
A))))
- (should (equal
- nil
- (parser-generator--valid-grammar-p '(((A B) C) ("a" "b" "c") ((A
"a")) A))))
+ (should
+ (equal
+ nil
+ (parser-generator--valid-grammar-p '(((A B) C) ("a" "b" "c") ((A "a"))
A))))
- (should (equal
- nil
- (parser-generator--valid-grammar-p '(((A B) C) ("a" "b" "c") ((A))
A))))
+ (should
+ (equal
+ nil
+ (parser-generator--valid-grammar-p '(((A B) C) ("a" "b" "c") ((A)) A))))
- (should (equal
- nil
- (parser-generator--valid-grammar-p "A")))
+ (should
+ (equal
+ nil
+ (parser-generator--valid-grammar-p "A")))
- (should (equal
- nil
- (parser-generator--valid-grammar-p '(A B C))))
+ (should
+ (equal
+ nil
+ (parser-generator--valid-grammar-p '(A B C))))
- (should (equal
- nil
- (parser-generator--valid-grammar-p '((A B)))))
+ (should
+ (equal
+ nil
+ (parser-generator--valid-grammar-p '((A B)))))
- (should (equal
- nil
- (parser-generator--valid-grammar-p '((A B C) (a (b c) "c") (A ("a"
"b") (a b)) (B b) (C "c")))))
+ (should
+ (equal
+ nil
+ (parser-generator--valid-grammar-p '((A B C) (a (b c) "c") (A ("a" "b") (a
b)) (B b) (C "c")))))
- (should (equal
- t
- (parser-generator--valid-grammar-p '((A B C) ("a" "b" "c") ((A "a"
(lambda(a) (message "Was here: %s" a)))) A))))
+ (should
+ (equal
+ t
+ (parser-generator--valid-grammar-p '((A B C) ("a" "b" "c") ((A "a"
(lambda(a) (message "Was here: %s" a)))) A))))
- (should (equal
- nil
- (parser-generator--valid-grammar-p '((A B C) ("a" "b" "c") ((A "a"
(lambda(a) (message "Was here: %s" a)) "b")) A))))
+ (should
+ (equal
+ nil
+ (parser-generator--valid-grammar-p '((A B C) ("a" "b" "c") ((A "a"
(lambda(a) (message "Was here: %s" a)) "b")) A))))
- (should (equal
- t
- (parser-generator--valid-grammar-p '((A B C) ("a" "b" "c") ((A ("a"
(lambda(a) (message "Was here: %s" a))))) A))))
+ (should
+ (equal
+ t
+ (parser-generator--valid-grammar-p '((A B C) ("a" "b" "c") ((A ("a"
(lambda(a) (message "Was here: %s" a))))) A))))
(should
(equal
@@ -544,7 +556,7 @@
"Test `parser-generator--valid-sentential-form-p'."
(message "Starting tests for (parser-generator--valid-sentential-form-p)")
- (parser-generator-set-grammar '((S A B) ("a" "b") ((S A) (A ("b" "a")) (B
"b" (lambda(b) (message "Was here: %s" b)))) S))
+ (parser-generator-set-grammar '((S A B) ("a" "b") ((S A) (A ("b" "a")) (B
("b" (lambda(b) (message "Was here: %s" b))))) S))
(parser-generator-process-grammar)
(should
@@ -600,7 +612,7 @@
(message "Started tests for (parser-generator--get-grammar-rhs)")
(parser-generator-set-grammar
- '((S A B) ("a" "b") ((S A) (A ("b" "a")) (B "b" (lambda(b) (message "Was
here: %s" b)))) S))
+ '((S A B) ("a" "b") ((S A) (A ("b" "a")) (B ("b" (lambda(b) (message "Was
here: %s" b))))) S))
(parser-generator-process-grammar)
(should (equal
'((A))
@@ -611,6 +623,7 @@
(should (equal
'(("b"))
(parser-generator--get-grammar-rhs 'B)))
+ (message "Passed first")
(parser-generator-set-grammar '((S A B) ("a" "b") ((S A) (S (B)) (B "a") (A
"a") (A ("b" "a"))) S))
(parser-generator-process-grammar)
