[elpa] externals/parser-generator e644708 018/434: Improved validation of grammar syntax

[ELPA Syncer]

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

    Improved validation of grammar syntax
---
 parser.el           | 69 ++++++++++++++++++++++++++++++++++++++++++++++++-----
 test/parser-test.el |  1 +
 2 files changed, 64 insertions(+), 6 deletions(-)

diff --git a/parser.el b/parser.el
index e959931..987ead7 100644
--- a/parser.el
+++ b/parser.el
@@ -164,7 +164,7 @@
                 (setq valid-p nil)))
             (setq terminal-index (1+ terminal-index)))))
 
-      ;; TODO Check every production
+      ;; Check every production
       (let ((productions (nth 2 G)))
         (let ((production-count (length productions))
               (production-index 0))
@@ -172,9 +172,7 @@
                   valid-p
                   (< production-index production-count))
             (let ((production (nth production-index productions)))
-              (unless (or
-                       (symbolp production)
-                       (stringp production))
+              (unless (parser--valid-production-p production)
                 (setq valid-p nil)))
             (setq production-index (1+ production-index)))))
 
@@ -183,8 +181,7 @@
         (when (and
                valid-p
                (not (or (stringp start) (symbolp start))))
-          (setq valid-p nil)))
-      )
+          (setq valid-p nil))))
     valid-p))
 
 (defun parser--valid-look-ahead-number-p (k)
@@ -201,6 +198,66 @@
       t
     nil))
 
+(defun parser--valid-production-p (production)
+  "Return whether PRODUCTION is valid or not."
+  (let ((is-valid t))
+    (unless (listp production)
+      (setq is-valid nil))
+    (when (and is-valid
+               (not (> (length production) 1)))
+      (setq is-valid nil))
+    (when (and is-valid
+               (not (or
+                     (stringp (car production))
+                     (symbolp (car production))
+                     (listp (car production)))))
+      (setq is-valid nil))
+
+    ;; Validate left-hand-side (LHS) of production
+    (when (and is-valid
+               (listp (car production)))
+      (let ((lhs (car production)))
+        (let ((lhs-index 0)
+              (lhs-length (length lhs)))
+          (while (and is-valid
+                      (< lhs-index lhs-length))
+            (let ((p (nth lhs-index lhs)))
+              (unless (or
+                       (stringp p)
+                       (symbolp p))
+                (setq is-valid nil)))
+            (setq lhs-index (1+ lhs-index))))))
+
+    ;; Validate that RHS is a list or symbol or a string
+    (when (and is-valid
+               (not (or
+                     (listp (car (cdr production)))
+                     (symbolp (car (cdr production)))
+                     (stringp (car (cdr production))))))
+      (setq is-valid nil))
+
+    ;; Validate right-hand-side (RHS) of production
+    (when is-valid
+      (let ((rhs (cdr production)))
+        (let ((rhs-index 0)
+              (rhs-length (length rhs)))
+          (while (and is-valid
+                      (< rhs-index rhs-length))
+            (let ((rhs-element (nth rhs-index rhs)))
+              (cond
+               ((stringp rhs-element))
+               ((symbolp rhs-element))
+               ((listp rhs-element)
+                (dolist (rhs-sub-element rhs-element)
+                  (unless (or
+                           (stringp rhs-sub-element)
+                           (symbolp rhs-sub-element))
+                    (setq is-valid nil))))
+               (t (setq is-valid nil)))
+              (setq rhs-index (1+ rhs-index)))))))
+
+    is-valid))
+
 (defun parser--valid-sentential-form-p (symbols)
   "Return whether SYMBOLS is a valid sentential form in grammar or not."
   (let ((is-valid t))
diff --git a/test/parser-test.el b/test/parser-test.el
index 615c0ea..ed7f1dd 100644
--- a/test/parser-test.el
+++ b/test/parser-test.el
@@ -196,6 +196,7 @@
 
 ;;   (message "Passed tests for (parser-test--v-set)"))
 
+;; TODO Re-implement this function
 (defun parser-test--valid-grammar-p ()
   "Test function `parser--valid-grammar-p'."
   (message "Starting tests for (parser--valid-grammar-p)")