[elpa] externals/parser-generator 4d60ed4 328/434: Added validation to context-sensitive attributes

[ELPA Syncer]

branch: externals/parser-generator
commit 4d60ed41d08ef267936ab161d47aff1ffbd0d8ae
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>

    Added validation to context-sensitive attributes
---
 parser-generator.el              | 136 +++++++++++++++++++++++++++++++--------
 test/parser-generator-lr-test.el |   2 +-
 test/parser-generator-test.el    |  17 +++--
 3 files changed, 122 insertions(+), 33 deletions(-)

diff --git a/parser-generator.el b/parser-generator.el
index 16d1e21..fe2f7c8 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -36,6 +36,11 @@
   "List of valid global attributes.")
 
 (defvar
+  parser-generator--global-declaration
+  nil
+  "Global declaration for grammar.")
+
+(defvar
   parser-generator--grammar
   nil
   "Current grammar used in parser.")
@@ -61,6 +66,11 @@
   "Hash-table of context-sensitive-attributes.")
 
 (defvar
+  parser-generator--table-global-attributes-p
+  nil
+  "Hash-table of global-attributes.")
+
+(defvar
   parser-generator--table-firsts
   nil
   "Hash-table of calculated firsts for quicker parser generation.")
@@ -397,6 +407,41 @@
        t
        parser-generator--table-non-terminal-p)))
 
+  ;; Build hash-tables of attributes
+  (setq
+   parser-generator--table-context-sensitive-attributes-p
+   (make-hash-table :test 'equal))
+  (dolist
+      (attribute
+       parser-generator--context-sensitive-attributes)
+    (puthash
+     attribute
+     t
+     parser-generator--table-context-sensitive-attributes-p))
+  (setq
+   parser-generator--table-global-attributes-p
+   (make-hash-table :test 'equal))
+  (dolist
+      (attribute
+       parser-generator--global-attributes)
+    (puthash
+     attribute
+     t
+     parser-generator--table-global-attributes-p))
+
+  ;; Validate declaration
+  (when
+      parser-generator--global-declaration
+    (dolist
+        (item
+         parser-generator--global-declaration)
+      (unless
+          (parser-generator--valid-global-attribute-p
+           (car item))
+        (error
+         "Invalid declaration '%S' in grammar!"
+         item))))
+
   (let ((productions
          (parser-generator--get-grammar-productions)))
 
@@ -423,9 +468,6 @@
      parser-generator--table-translations
      (make-hash-table :test 'equal))
 
-    ;; TODO Should produce hash-tables of valid attributes here
-    ;; TODO and valid global and context-sensitive attributes
-
     (let ((production-index 0)
           (new-productions))
       (dolist (p productions)
@@ -545,17 +587,6 @@
         parser-generator--grammar)
        new-productions)))
 
-  (setq
-   parser-generator--table-context-sensitive-attributes-p
-   (make-hash-table :test 'equal))
-  (dolist
-      (attribute
-       parser-generator--context-sensitive-attributes)
-    (puthash
-     attribute
-     t
-     parser-generator--table-context-sensitive-attributes-p))
-
   (let ((look-aheads
          (parser-generator--get-grammar-look-aheads)))
     (setq
@@ -667,6 +698,33 @@
       (setq index (+ index 2)))
     is-valid))
 
+(defun parser-generator--valid-global-attribute-p (attribute)
+  "Check if ATTRIBUTE is a valid global attribute."
+  (gethash
+   attribute
+   parser-generator--table-global-attributes-p))
+
+(defun parser-generator--valid-global-attributes-p (attributes)
+  "Check if all ATTRIBUTES are valid global attributes."
+  (let ((is-valid t)
+        (length (length attributes))
+        (index 0))
+    (unless (listp attributes)
+      (setq is-valid nil))
+    (while (and
+            is-valid
+            (< index length))
+      (let ((element
+             (nth index attributes)))
+        (unless
+            (parser-generator--valid-global-attribute-p
+             element)
+          (setq
+           is-valid
+           nil)))
+      (setq index (+ index 2)))
+    is-valid))
+
 (defun parser-generator--valid-e-p (symbol)
   "Return whether SYMBOL is the e identifier or not."
   (eq symbol parser-generator--e-identifier))
@@ -777,13 +835,24 @@
 
 (defun parser-generator--valid-non-terminal-p (symbol)
   "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!"))
-  (when (listp symbol)
-    (setq symbol (car symbol)))
-  (gethash
-   symbol
-   parser-generator--table-non-terminal-p))
+  (let ((valid-attribute t))
+    (unless parser-generator--table-non-terminal-p
+      (error "Table for non-terminals is undefined!"))
+    (when (listp symbol)
+      (unless
+          (or
+           (functionp symbol)
+           (parser-generator--valid-context-sensitive-attribute-p
+            (car (car (cdr symbol)))))
+        (setq
+         valid-attribute
+         nil))
+      (setq symbol (car symbol)))
+    (and
+     valid-attribute
+     (gethash
+      symbol
+      parser-generator--table-non-terminal-p))))
 
 (defun parser-generator--valid-production-p (production)
   "Return whether PRODUCTION is valid or not."
@@ -940,13 +1009,24 @@
 
 (defun parser-generator--valid-terminal-p (symbol)
   "Return whether SYMBOL is a terminal in grammar or not."
-  (unless parser-generator--table-terminal-p
-    (error "Table for terminals is undefined!"))
-  (when (listp symbol)
-    (setq symbol (car symbol)))
-  (gethash
-   symbol
-   parser-generator--table-terminal-p))
+  (let ((valid-attribute t))
+    (unless parser-generator--table-terminal-p
+      (error "Table for terminals is undefined!"))
+    (when (listp symbol)
+      (unless
+          (or
+           (functionp symbol)
+           (parser-generator--valid-context-sensitive-attribute-p
+            (car (car (cdr symbol)))))
+        (setq
+         valid-attribute
+         nil))
+      (setq symbol (car symbol)))
+    (and
+     valid-attribute
+     (gethash
+      symbol
+      parser-generator--table-terminal-p))))
 
 
 ;; Main Algorithms
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index ee24d8d..2b7ed8b 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -124,7 +124,7 @@
 
   (setq
    parser-generator--context-sensitive-attributes
-   nil)
+   '(%prec))
   (parser-generator-set-grammar
    '(
      (Sp S A B)
diff --git a/test/parser-generator-test.el b/test/parser-generator-test.el
index 476dc38..4a648c0 100644
--- a/test/parser-generator-test.el
+++ b/test/parser-generator-test.el
@@ -472,6 +472,10 @@
 (defun parser-generator-test--valid-grammar-p ()
   "Test function `parser-generator--valid-grammar-p'."
   (message "Starting tests for (parser-generator--valid-grammar-p)")
+  (setq
+   parser-generator--context-sensitive-attributes
+   '(%prec))
+  (parser-generator-process-grammar)
 
   (should
    (equal
@@ -690,6 +694,10 @@
     (parser-generator--valid-non-terminal-p 'S)))
   (should
    (equal
+    nil
+    (parser-generator--valid-non-terminal-p '(S (%proc 1)))))
+  (should
+   (equal
     t
     (parser-generator--valid-non-terminal-p '(S (%prec 1)))))
   (should
@@ -784,7 +792,11 @@
   (should
    (equal
     t
-    (parser-generator--valid-terminal-p '("a" (%prec 1)))))
+    (parser-generator--valid-terminal-p '("a" (%prec 3)))))
+  (should
+   (equal
+    nil
+    (parser-generator--valid-terminal-p '("a" (%proc 3)))))
   (should
    (equal
     t
@@ -910,9 +922,6 @@
   (parser-generator-test--valid-sentential-form-p)
   (parser-generator-test--valid-terminal-p)
 
-  ;; TODO Add tests for process-grammar that validates
-  ;; signals thrown with invalid symbols or attributes
-
   ;; Algorithms
   (parser-generator-test--first)
   (parser-generator-test--e-free-first)