[elpa] externals/parser-generator 04c360b 318/434: LR-items set validation now supports symbols with attributes

[ELPA Syncer]

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

    LR-items set validation now supports symbols with attributes
---
 parser-generator-lr.el           | 45 ++++++++++++++++++++++++++-------
 parser-generator.el              | 16 ++++++++++++
 test/parser-generator-lr-test.el | 54 +++++++++++++++++++++++++++++++++++++++-
 3 files changed, 105 insertions(+), 10 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 262d66e..59b2994 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -103,7 +103,8 @@
                (gethash
                 goto-index
                 table-lr-items)))
-          (let ((lr-items-length (length lr-items)))
+          (let ((lr-items-length
+                 (length lr-items)))
 
             ;; Where u is in (T U e)*k
             (dolist (state states)
@@ -473,6 +474,14 @@
             (when symbols
               (let ((next-symbol
                      (car symbols)))
+
+                ;; Convert symbols with attributes to simple symbols
+                (when
+                    (listp next-symbol)
+                  (setq
+                   next-symbol
+                   (car next-symbol)))
+
                 (let ((temp-hash-key
                        (format
                         "%S"
@@ -673,12 +682,14 @@
         (a)
         (a-look-ahead)
         (a-follow)
+        (a-follow-full)
         (a-index 0)
         (b)
         (b-suffix)
         (b-follow)
         (b-suffix-follow)
         (b-suffix-follow-eff)
+        (b-suffix-follow-eff-item)
         (b-index 0))
 
     ;; Iterate each set
@@ -707,7 +718,13 @@
         (when (and
                (nth 1 a)
                (not a-look-ahead))
-          (setq a-follow (nth 3 a))
+          (setq
+           a-follow-full
+           (nth 3 a))
+          (setq
+           a-follow
+           (parser-generator--get-symbols-without-attributes
+            a-follow-full))
 
           (parser-generator--debug
            (message "a-follow: %s" a-follow))
@@ -721,11 +738,15 @@
               (parser-generator--debug
                (message "b: %s" b))
 
-              (setq b-suffix (nth 2 b))
-              (setq b-follow (nth 3 b))
+              (setq
+               b-suffix (nth 2 b))
+              (setq
+               b-follow (nth 3 b))
               (setq
                b-suffix-follow
-               (append b-suffix b-follow))
+               (append
+                b-suffix
+                b-follow))
               (setq
                b-suffix-follow-eff
                (parser-generator--e-free-first
@@ -737,18 +758,24 @@
                (message "b-suffix-follow: %s" b-suffix-follow)
                (message "b-suffix-follow-eff: %s" b-suffix-follow-eff))
 
-              (dolist (b-suffix-follow-eff-item b-suffix-follow-eff)
-                (when (equal a-follow b-suffix-follow-eff-item)
+              (dolist (b-suffix-follow-eff-item-full b-suffix-follow-eff)
+                (setq
+                 b-suffix-follow-eff-item
+                 (parser-generator--get-symbols-without-attributes
+                  b-suffix-follow-eff-item-full))
+                (when (equal
+                       a-follow
+                       b-suffix-follow-eff-item)
                   (when
                       signal-on-false
                     (error
                      "Inconsistent grammar! %S (index: %d) with look-ahead %S 
conflicts with %S (index: %d) with look-ahead %S in sets: %S"
                      a
                      a-index
-                     a-follow
+                     a-follow-full
                      b
                      b-index
-                     b-suffix-follow-eff-item
+                     b-suffix-follow-eff-item-full
                      lr-item-sets))
                   (setq valid-p nil))))
             (setq b-index (1+ b-index))))
diff --git a/parser-generator.el b/parser-generator.el
index fce76af..bf39c4b 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -323,6 +323,22 @@
         (setq i (1+ i))))
     (sort permutations 'parser-generator--sort-list)))
 
+(defun parser-generator--get-symbol-without-attributes (symbol)
+  "Get SYMBOL without attributes."
+  (if (listp symbol)
+      (car symbol)
+    symbol))
+
+(defun parser-generator--get-symbols-without-attributes (symbols)
+  "Get list of SYMBOLS without attributes."
+  (let ((new-symbols))
+    (dolist (symbol symbols)
+      (push
+       (parser-generator--get-symbol-without-attributes
+        symbol)
+       new-symbols))
+    (reverse new-symbols)))
+
 (defun parser-generator--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)
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 2e6524b..2834844 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -1,4 +1,4 @@
-;;; parser-generator-lr-test.el --- Tests for LR(k) Parser Generator -*- 
lexical-binding: t -*-
+;; parser-generator-lr-test.el --- Tests for LR(k) Parser Generator -*- 
lexical-binding: t -*-
 
 
 ;;; Commentary:
@@ -101,6 +101,58 @@
     )
   (message "Passed cyclical grammar")
 
+  ;; Grammar with conflicts that can be resolved using precedence attributes
+  (parser-generator-set-grammar
+   '(
+     (Sp S A B)
+     (a b c)
+     (
+      (Sp S)
+      (S (A c) B)
+      (A (a b))
+      (B (a b c))
+      )
+     Sp))
+  (parser-generator-set-look-ahead-number 1)
+  (parser-generator-process-grammar)
+  (should-error
+   (parser-generator-lr-generate-parser-tables))
+  (message "Conflicted grammar caused expected exception")
+
+  ;; Inconsistent grammar! ((A) (a b) nil (c)) (index: 0) with look-ahead (c) 
conflicts with ((B) (a b) (c) ($)) (index: 1) with look-ahead (c) in sets: 
((((A) (a b) nil (c)) ((B) (a b) (c) ($))))
+
+  (parser-generator-set-grammar
+   '(
+     (Sp S A B)
+     (a b c)
+     (
+      (Sp S)
+      (S (A c) B)
+      (A (a b))
+      (B (a b (c (%prec 1))))
+      )
+     Sp))
+  (parser-generator-set-look-ahead-number 1)
+  (parser-generator-process-grammar)
+
+  (let ((table-lr-items
+         (parser-generator-lr--generate-goto-tables)))
+    (message "conflict-lr-items: %S" table-lr-items)
+    (message "conflict-goto-tables: %S" 
(parser-generator-lr--get-expanded-goto-tables)))
+
+  (should-error
+   (parser-generator-lr-generate-parser-tables))
+
+  (let ((table-lr-items
+         (parser-generator-lr--generate-goto-tables)))
+    (message "conflicted lr-items: %s" table-lr-items)
+    (parser-generator-lr--generate-action-tables
+     table-lr-items)
+    (message "conflicted goto-tables: %s" 
(parser-generator-lr--get-expanded-goto-tables))
+    (message "conflicted action-tables: %s" 
(parser-generator-lr--get-expanded-action-tables))
+    )
+  (message "Passed conflicted grammar")
+
   (message "Passed tests for (parser-generator-lr--generate-action-tables)"))
 
 (defun parser-generator-lr-test--generate-goto-tables ()