[elpa] externals/parser-generator 5f13406 319/434: More work on supporting LR-grammar with precedence attributes

[ELPA Syncer]

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

    More work on supporting LR-grammar with precedence attributes
---
 parser-generator-lr.el           | 52 ++++++++++++++++++++++++++++++----------
 test/parser-generator-lr-test.el | 29 +++++++++++++---------
 2 files changed, 58 insertions(+), 23 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 59b2994..5da6882 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -34,6 +34,16 @@
   nil
   "Goto-tables for grammar.")
 
+(defvar
+  parser-generator-lr--precedence-attribute
+  nil
+  "Attribute used for precedence.")
+
+(defvar
+  parser-generator-lr--precedence-comparison-function
+  nil
+  "Function used for resolving precedence.")
+
 
 ;; Main Algorithms
 
@@ -766,18 +776,36 @@
                 (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-full
-                     b
-                     b-index
-                     b-suffix-follow-eff-item-full
-                     lr-item-sets))
-                  (setq valid-p nil))))
+
+                  ;; If it's the same symbol but we have a precedence
+                  ;; attribute on any of them, or both, pass anyway
+                  (unless
+                      (and
+                       parser-generator-lr--precedence-attribute
+                       parser-generator-lr--precedence-comparison-function
+                       (or
+                        (and
+                         (listp (car a-follow-full))
+                         (plist-get
+                          (car (cdr (car a-follow-full)))
+                          parser-generator-lr--precedence-attribute))
+                        (and
+                         (listp (car b-suffix-follow-eff-item-full))
+                         (plist-get
+                          (car (cdr (car b-suffix-follow-eff-item-full)))
+                          parser-generator-lr--precedence-attribute))))
+                    (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-full
+                       b
+                       b-index
+                       b-suffix-follow-eff-item-full
+                       lr-item-sets))
+                    (setq valid-p nil)))))
             (setq b-index (1+ b-index))))
         (setq a-index (1+ a-index)))
       (setq set-index (1+ set-index)))
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 2834844..fd38794 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -134,24 +134,31 @@
      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))
+  (message "Conflicted grammar caused expected exception 2")
+
+  (setq
+   parser-generator-lr--precedence-attribute
+   '%prec)
+  (setq
+   parser-generator-lr--precedence-comparison-function
+   #'<)
+  (parser-generator-lr-generate-parser-tables)
+  (message "Grammar not conflicting anymore")
 
   (let ((table-lr-items
          (parser-generator-lr--generate-goto-tables)))
-    (message "conflicted lr-items: %s" table-lr-items)
+    (message
+     "conflict-lr-items: %S"
+     table-lr-items)
+    (message
+     "conflict-goto-tables: %S"
+     (parser-generator-lr--get-expanded-goto-tables))
     (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
+     "conflicted action-tables: %s" 
(parser-generator-lr--get-expanded-action-tables)))
 
   (message "Passed tests for (parser-generator-lr--generate-action-tables)"))