[elpa] externals/parser-generator e9697ea 100/434: Added function that tests if a look-ahead is valid or not

[ELPA Syncer]

branch: externals/parser-generator
commit e9697eae86689e45257f2448d9b7c7a817bf90ff
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@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)