branch: externals/parser-generator
commit e9697eae86689e45257f2448d9b7c7a817bf90ff
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Added function that tests if a look-ahead is valid or not
---
parser-lr.el | 3 +-
parser.el | 132 +++++++++++++++++++++++-----------------
test/parser-lr-test.el | 15 +++--
test/parser-test.el | 161 +++++++++++++++++++++++++++++++++++++++++++------
4 files changed, 234 insertions(+), 77 deletions(-)
diff --git a/parser-lr.el b/parser-lr.el
index a0ed709..ac85404 100644
--- a/parser-lr.el
+++ b/parser-lr.el
@@ -42,8 +42,7 @@
(defun parser-lr--generate-action-tables ()
"Generate action-tables for lr-grammar."
(unless parser-lr--action-tables
- (let ((action-tables nil)
- (terminals (parser--get-grammar-terminals)))
+ (let ((action-tables nil))
(dolist (goto-table parser-lr--goto-tables)
;; (message "goto-table: %s" goto-table)
(let ((goto-index (car goto-table))
diff --git a/parser.el b/parser.el
index 35c8362..782b328 100644
--- a/parser.el
+++ b/parser.el
@@ -9,6 +9,9 @@
;;; Variables:
+(defvar parser--allow-e-productions
+ nil
+ "Flag whether e-productions is allowed or not.")
(defvar parser--debug
nil
@@ -30,6 +33,10 @@
nil
"Current look-ahead number used.")
+(defvar parser--table-look-aheads-p
+ nil
+ "Hash-table of look-aheads for quick checking.")
+
(defvar parser--table-non-terminal-p
nil
"Hash-table of terminals for quick checking.")
@@ -69,44 +76,10 @@
(push element new-elements)))
(nreverse new-elements)))
-(defun parser--get-grammar-non-terminals (&optional G)
- "Return non-terminals of grammar G."
- (unless G
- (if parser--grammar
- (setq G parser--grammar)
- (error "No grammar G defined!")))
- (nth 0 G))
-
-(defun parser--get-grammar-productions (&optional G)
- "Return productions of grammar G."
- (unless G
- (if parser--grammar
- (setq G parser--grammar)
- (error "No grammar G defined!")))
- (nth 2 G))
-
-(defun parser--get-grammar-rhs (lhs)
- "Return right hand sides of LHS if there is any."
- (gethash lhs parser--table-productions))
-
-(defun parser--get-grammar-start (&optional G)
- "Return start of grammar G."
- (unless G
- (if parser--grammar
- (setq G parser--grammar)
- (error "No grammar G defined!")))
- (nth 3 G))
-
-(defun parser--get-grammar-terminals (&optional G)
- "Return terminals of grammar G."
- (unless G
- (if parser--grammar
- (setq G parser--grammar)
- (error "No grammar G defined!")))
- (nth 1 G))
-
-(defun parser--get-possible-look-aheads (&optional include-e)
- "Return all possible look-ahead set which optionally INCLUDE-E."
+(defun parser--get-grammar-look-aheads ()
+ "Return all possible look-ahead set."
+ (unless parser--look-ahead-number
+ (error "No look-ahead number defined!"))
(let ((terminals (parser--get-grammar-terminals))
(look-aheads)
(k parser--look-ahead-number)
@@ -146,15 +119,11 @@
(when (= look-ahead-length k)
(setq look-ahead-to-add (reverse look-ahead)))
- (when (and
- include-e
- (= look-ahead-length (1- k)))
+ (when (= look-ahead-length (1- k))
(push parser--e-identifier look-ahead)
(setq look-ahead-to-add (reverse look-ahead))))
- (when (and
- include-e
- (= k 1))
+ (when (= k 1)
(setq look-ahead-to-add `(,parser--e-identifier))))
(when (and look-ahead-to-add
@@ -164,6 +133,44 @@
(sort look-aheads 'parser--sort-list)))
+(defun parser--get-grammar-non-terminals (&optional G)
+ "Return non-terminals of grammar G."
+ (unless G
+ (if parser--grammar
+ (setq G parser--grammar)
+ (error "No grammar G defined!")))
+ (nth 0 G))
+
+(defun parser--get-grammar-productions (&optional G)
+ "Return productions of grammar G."
+ (unless G
+ (if parser--grammar
+ (setq G parser--grammar)
+ (error "No grammar G defined!")))
+ (nth 2 G))
+
+(defun parser--get-grammar-rhs (lhs)
+ "Return right hand sides of LHS if there is any."
+ (unless parser--table-productions
+ (error "Table for productions is undefined!"))
+ (gethash lhs parser--table-productions))
+
+(defun parser--get-grammar-start (&optional G)
+ "Return start of grammar G."
+ (unless G
+ (if parser--grammar
+ (setq G parser--grammar)
+ (error "No grammar G defined!")))
+ (nth 3 G))
+
+(defun parser--get-grammar-terminals (&optional G)
+ "Return terminals of grammar G."
+ (unless G
+ (if parser--grammar
+ (setq G parser--grammar)
+ (error "No grammar G defined!")))
+ (nth 1 G))
+
(defun parser--hash-to-list (hash-table &optional un-sorted)
"Return a list that represent the HASH-TABLE. Each element is a list: (list
key value), optionally UN-SORTED."
(let (result)
@@ -196,10 +203,12 @@
(setq parser--table-terminal-p (make-hash-table :test 'equal))
(dolist (terminal terminals)
(puthash terminal t parser--table-terminal-p)))
+
(let ((non-terminals (parser--get-grammar-non-terminals)))
(setq parser--table-non-terminal-p (make-hash-table :test 'equal))
(dolist (non-terminal non-terminals)
(puthash non-terminal t parser--table-non-terminal-p)))
+
(let ((productions (parser--get-grammar-productions)))
(setq parser--table-productions (make-hash-table :test 'equal))
(dolist (p productions)
@@ -210,20 +219,31 @@
(unless (listp rhs-element)
(setq rhs-element (list rhs-element)))
(push rhs-element new-value))
- (puthash lhs (nreverse new-value) parser--table-productions))))))
+ (puthash lhs (nreverse new-value) parser--table-productions)))))
+
+ (let ((look-aheads (parser--get-grammar-look-aheads)))
+ (setq parser--table-look-aheads-p (make-hash-table :test 'equal))
+ (dolist (look-ahead look-aheads)
+ (puthash look-ahead t parser--table-look-aheads-p))))
(defun parser--set-look-ahead-number (k)
"Set look-ahead number K."
(unless (parser--valid-look-ahead-number-p k)
(error "Invalid look-ahead number k!"))
- (setq parser--look-ahead-number k)
- (parser--clear-cache))
+ (setq parser--look-ahead-number k))
+
+(defun parser--set-allow-e-productions (flag)
+ "Set FLAG whether e-productions is allowed or not."
+ (setq parser--allow-e-productions flag))
(defun parser--set-grammar (G)
"Set grammar G.."
(unless (parser--valid-grammar-p G)
(error "Invalid grammar G!"))
- (setq parser--grammar G)
+ (setq parser--grammar G))
+
+(defun parser--process-grammar ()
+ "Process grammar."
(parser--clear-cache)
(parser--load-symbols))
@@ -342,6 +362,14 @@
(setq valid-p nil))))
valid-p))
+(defun parser--valid-look-ahead-p (symbol)
+ "Return whether SYMBOL is a look-ahead in grammar or not."
+ (unless parser--table-look-aheads-p
+ (error "Table for look-aheads is undefined!"))
+ (unless (listp symbol)
+ (setq symbol (list symbol)))
+ (gethash symbol parser--table-look-aheads-p))
+
(defun parser--valid-look-ahead-number-p (k)
"Return if look-ahead number K is valid or not."
(and
@@ -352,9 +380,7 @@
"Return whether SYMBOL is a non-terminal in grammar or not."
(unless parser--table-non-terminal-p
(error "Table for non-terminals is undefined!"))
- (if (gethash symbol parser--table-non-terminal-p)
- t
- nil))
+ (gethash symbol parser--table-non-terminal-p))
(defun parser--valid-production-p (production)
"Return whether PRODUCTION is valid or not."
@@ -444,9 +470,7 @@
"Return whether SYMBOL is a terminal in grammar or not."
(unless parser--table-terminal-p
(error "Table for terminals is undefined!"))
- (if (gethash symbol parser--table-terminal-p)
- t
- nil))
+ (gethash symbol parser--table-terminal-p))
;; Main Algorithms
diff --git a/test/parser-lr-test.el b/test/parser-lr-test.el
index d57acd1..86168b9 100644
--- a/test/parser-lr-test.el
+++ b/test/parser-lr-test.el
@@ -14,9 +14,11 @@
(message "Starting tests for (parser-lr--generate-action-tables)")
;; Example 5.32 p. 393
- (parser-lr--reset)
(parser--set-grammar '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) Sp))
(parser--set-look-ahead-number 1)
+ (parser--process-grammar)
+
+ (parser-lr--reset)
(parser-lr--generate-goto-tables)
(parser-lr--generate-action-tables)
@@ -40,10 +42,11 @@
(message "Starting tests for (parser-lr--generate-goto-tables)")
;; Example 5.30, p. 389
- (parser-lr--reset)
(parser--set-grammar '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) Sp))
(parser--set-look-ahead-number 1)
+ (parser--process-grammar)
+ (parser-lr--reset)
(parser-lr--generate-goto-tables)
;; (message "GOTO-table: %s" parser-lr--goto-tables)
@@ -82,9 +85,11 @@
(message "Starting tests for (parser-lr--items-for-prefix)")
;; Example 5.29 p 387
- (parser-lr--reset)
(parser--set-grammar '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) Sp))
(parser--set-look-ahead-number 1)
+ (parser--process-grammar)
+
+ (parser-lr--reset)
(should
(equal
@@ -167,9 +172,11 @@
"Test `parser-lr--items-valid-p'."
(message "Started tests for (parser-lr--items-valid-p)")
- (parser-lr--reset)
(parser--set-grammar '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e)) Sp))
(parser--set-look-ahead-number 1)
+ (parser--process-grammar)
+
+ (parser-lr--reset)
(parser-lr--generate-goto-tables)
(should
(equal
diff --git a/test/parser-test.el b/test/parser-test.el
index fa76cc1..7cb3ee8 100644
--- a/test/parser-test.el
+++ b/test/parser-test.el
@@ -9,39 +9,59 @@
(require 'parser)
(require 'ert)
-(defun parser-test--get-possible-look-aheads ()
- "Test `parser--get-possible-look-aheads'."
- (message "Starting tests for (parser--get-possible-look-aheads)")
+(defun parser-test--valid-look-ahead-p ()
+ "Test `parser--valid-look-ahead-p'."
+ (message "Starting tests for (parser--valid-look-ahead-p)")
- (parser--set-grammar '((S A) ("a" "b") ((S A) (A ("b" "a"))) S))
(parser--set-look-ahead-number 1)
+ (parser--set-grammar '((S A) ("a" "b") ((S A) (A ("b" "a"))) S))
+ (parser--process-grammar)
(should
(equal
- '(("a") ("b"))
- (parser--get-possible-look-aheads)))
- (message "Passed ((a) (b))")
+ t
+ (parser--valid-look-ahead-p "a")))
+ (should
+ (equal
+ t
+ (parser--valid-look-ahead-p "b")))
+ (should
+ (equal
+ nil
+ (parser--valid-look-ahead-p "c")))
+ (should
+ (equal
+ nil
+ (parser--valid-look-ahead-p "d")))
+ (should
+ (equal
+ t
+ (parser--valid-look-ahead-p 'e)))
+
+ (message "Passed tests for (parser--valid-look-ahead-p)"))
+
+(defun parser-test--get-grammar-look-aheads ()
+ "Test `parser--get-look-aheads'."
+ (message "Starting tests for (parser--get-grammar-look-aheads)")
+
+ (parser--set-look-ahead-number 1)
+ (parser--set-grammar '((S A) ("a" "b") ((S A) (A ("b" "a"))) S))
+ (parser--process-grammar)
(should
(equal
'(("a") ("b") (e))
- (parser--get-possible-look-aheads t)))
+ (parser--get-grammar-look-aheads)))
(message "Passed ((a) (b) (e))")
(parser--set-look-ahead-number 2)
(should
(equal
- '(("a" "a") ("a" "b") ("b" "a") ("b" "b"))
- (parser--get-possible-look-aheads)))
- (message "Passed ((a a) (a b) (b a) (b b))")
-
- (should
- (equal
'(("a" "a") ("a" "b") ("a" e) ("b" "a") ("b" "b") ("b" e))
- (parser--get-possible-look-aheads t)))
+ (parser--get-grammar-look-aheads)))
- (message "Passed tests for (parser--get-possible-look-aheads)"))
+ (message "Passed tests for (parser--get-grammar-look-aheads)"))
(defun parser-test--sort-list ()
"Test `parser--sort-list'."
@@ -90,6 +110,8 @@
(parser--set-grammar '((S A) (b) ((S A) (A b)) S))
(parser--set-look-ahead-number 2)
+ (parser--process-grammar)
+
(should
(equal
'((e))
@@ -98,6 +120,8 @@
(parser--set-grammar '((S A B) (a c d f) ((S (A a)) (A B) (B (c f) d)) S))
(parser--set-look-ahead-number 2)
+ (parser--process-grammar)
+
(should
(equal
'((a))
@@ -106,6 +130,8 @@
(parser--set-grammar '((S A B) (a c d f) ((S (A a)) (A (B c d)) (B (c f) d))
S))
(parser--set-look-ahead-number 2)
+ (parser--process-grammar)
+
(should
(equal
'((c d))
@@ -120,6 +146,8 @@
(parser--set-grammar '((S) (a) ((S a)) S))
(parser--set-look-ahead-number 1)
+ (parser--process-grammar)
+
(should
(equal
'((a))
@@ -128,6 +156,8 @@
(parser--set-grammar '((S) (a) ((S a)) S))
(parser--set-look-ahead-number 1)
+ (parser--process-grammar)
+
(should
(equal
'((a))
@@ -136,6 +166,8 @@
(parser--set-grammar '((S) (a) ((S a)) S))
(parser--set-look-ahead-number 2)
+ (parser--process-grammar)
+
(should
(equal
'((a a))
@@ -144,6 +176,8 @@
(parser--set-grammar '((S) (a) ((S a)) S))
(parser--set-look-ahead-number 2)
+ (parser--process-grammar)
+
(should
(equal
'((a))
@@ -152,6 +186,8 @@
(parser--set-grammar '((S) ("a" "b" "c") ((S ("a" "b" "c"))) S))
(parser--set-look-ahead-number 2)
+ (parser--process-grammar)
+
(should
(equal
'(("a" "b"))
@@ -160,6 +196,8 @@
(parser--set-grammar '((S) ("a" b "c") ((S ("a" b "c"))) S))
(parser--set-look-ahead-number 3)
+ (parser--process-grammar)
+
(should
(equal
'(("a" b "c"))
@@ -168,6 +206,8 @@
(parser--set-grammar '((S A) (b) ((S A) (A b)) S))
(parser--set-look-ahead-number 2)
+ (parser--process-grammar)
+
(should
(equal
'((b))
@@ -176,6 +216,8 @@
(parser--set-grammar '((S A) ("a" "b") ((S A) (A ("b" "a"))) S))
(parser--set-look-ahead-number 2)
+ (parser--process-grammar)
+
(should
(equal
'(("b" "a"))
@@ -184,6 +226,8 @@
(parser--set-grammar '((S A) ("a" "b" "c" "d") ((S A) (A ("b" "a" "c" "d")))
S))
(parser--set-look-ahead-number 3)
+ (parser--process-grammar)
+
(should
(equal
'(("b" "a" "c"))
@@ -192,6 +236,8 @@
(parser--set-grammar '((S A B) ("c" "d") ((S A) (A B) (B "c" "d")) S))
(parser--set-look-ahead-number 1)
+ (parser--process-grammar)
+
(should
(equal
'(("c") ("d"))
@@ -200,6 +246,8 @@
(parser--set-grammar '((S A B) (a c d f) ((S (A a)) (A B) (B (c f) d)) S))
(parser--set-look-ahead-number 2)
+ (parser--process-grammar)
+
(should
(equal
'((c f) (d a))
@@ -208,6 +256,8 @@
(parser--set-grammar '((S A B) ("a" "c" "d" "m") ((S A) (A (B "a" "m")) (B
"c" "d")) S))
(parser--set-look-ahead-number 3)
+ (parser--process-grammar)
+
(should
(equal
'(("c" "a" "m") ("d" "a" "m"))
@@ -216,6 +266,8 @@
(parser--set-grammar '((S A B C) (a b c) ((S A B) (A (B a) e) (B (C b) C) (C
c e)) S))
(parser--set-look-ahead-number 1)
+ (parser--process-grammar)
+
(should
(equal
'((a) (b) (c) (e))
@@ -225,6 +277,8 @@
;; Example 5.28 p 382
(parser--set-grammar '((S A B C) (a b c) ((S (A B)) (A (B a) e) (B (C b) C)
(C c e)) S))
(parser--set-look-ahead-number 2)
+ (parser--process-grammar)
+
(should
(equal
'((a b) (a c) (a) (b a) (b) (c a) (c) (c b) (e))
@@ -233,6 +287,8 @@
(parser--set-grammar '((S A B C) (a b c) ((S (A B)) (A (B a) e) (B (C b) C)
(C c e)) S))
(parser--set-look-ahead-number 3)
+ (parser--process-grammar)
+
(should
(equal
'((a) (a b) (a c) (a c b) (b a) (b a b) (b a c) (b) (c a) (c a b) (c a c)
(c b) (c) (c b a) (e))
@@ -249,6 +305,8 @@
;; Example 5.28 p 402
(parser--set-grammar '((S A B C) (a b c) ((S (A B)) (A (B a) e) (B (C b) C)
(C c e)) S))
(parser--set-look-ahead-number 2)
+ (parser--process-grammar)
+
(should
(equal
'((c a) (c b))
@@ -333,6 +391,8 @@
"Test `parser--valid-sentential-form-p'."
(message "Starting tests for (parser--valid-sentential-form-p)")
+ ;; TODO Add tests for this
+
(message "Passed tests for (parser--valid-sentential-form-p)"))
(defun parser-test--valid-production-p ()
@@ -358,6 +418,8 @@
(message "Started tests for (parser--get-grammar-rhs)")
(parser--set-grammar '((S A) ("a" "b") ((S A) (A ("b" "a"))) S))
+ (parser--process-grammar)
+
(should (equal
'((A))
(parser--get-grammar-rhs 'S)))
@@ -366,6 +428,8 @@
(parser--get-grammar-rhs 'A)))
(parser--set-grammar '((S A B) ("a" "b") ((S A) (S (B)) (B "a") (A "a") (A
("b" "a"))) S))
+ (parser--process-grammar)
+
(should (equal
'((A) (B))
(parser--get-grammar-rhs 'S)))
@@ -375,19 +439,82 @@
(message "Passed tests for (parser--get-grammar-rhs)"))
+(defun parser-test--valid-non-terminal-p ()
+ "Test `parser--valid-non-terminal-p'."
+ (message "Starting tests for (parser--valid-non-terminal-p)")
+
+ (parser--set-grammar '((S A B) ("a" "b") ((S A) (S (B)) (B "a") (A "a") (A
("b" "a"))) S))
+ (parser--process-grammar)
+
+ (should
+ (equal
+ t
+ (parser--valid-non-terminal-p 'S)))
+ (should
+ (equal
+ t
+ (parser--valid-non-terminal-p 'A)))
+ (should
+ (equal
+ t
+ (parser--valid-non-terminal-p 'B)))
+ (should
+ (equal
+ nil
+ (parser--valid-non-terminal-p 'C)))
+ (should
+ (equal
+ nil
+ (parser--valid-non-terminal-p "a")))
+
+ (message "Passed tests for (parser--valid-non-terminal-p)"))
+
+(defun parser-test--valid-terminal-p ()
+ "Test `parser--valid-terminal-p'."
+ (message "Starting tests for (parser--valid-terminal-p)")
+
+ (parser--set-grammar '((S A B) ("a" "b") ((S A) (S (B)) (B "a") (A "a") (A
("b" "a"))) S))
+ (parser--process-grammar)
+
+ (should
+ (equal
+ t
+ (parser--valid-terminal-p "a")))
+ (should
+ (equal
+ t
+ (parser--valid-terminal-p "b")))
+ (should
+ (equal
+ t
+ (parser--valid-terminal-p "a")))
+ (should
+ (equal
+ nil
+ (parser--valid-terminal-p 'S)))
+ (should
+ (equal
+ nil
+ (parser--valid-terminal-p 'A)))
+
+ (message "Passed tests for (parser--valid-terminal-p)"))
+
(defun parser-test ()
"Run test."
;; (setq debug-on-error t)
;; Helpers
+ (parser-test--valid-look-ahead-p)
(parser-test--valid-look-ahead-number-p)
(parser-test--valid-production-p)
(parser-test--valid-grammar-p)
+ (parser-test--valid-non-terminal-p)
(parser-test--valid-sentential-form-p)
+ (parser-test--valid-terminal-p)
(parser-test--distinct)
(parser-test--sort-list)
(parser-test--get-grammar-rhs)
- (parser-test--get-possible-look-aheads)
+ (parser-test--get-grammar-look-aheads)
;; Algorithms
(parser-test--first)
