[elpa] externals/parser-generator 3170e8d 370/434: Context-sensitive precedence now avoids conflict-detection

[ELPA Syncer]

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

    Context-sensitive precedence now avoids conflict-detection
---
 parser-generator-lr.el           | 92 ++++++++++++++++++++++++++--------------
 parser-generator.el              | 17 ++++++--
 test/parser-generator-lr-test.el |  7 +--
 test/parser-generator-test.el    |  4 +-
 4 files changed, 77 insertions(+), 43 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 6727751..82f96f1 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -867,7 +867,6 @@
         (b-follow)
         (b-suffix-follow)
         (b-suffix-follow-eff)
-        (b-suffix-follow-eff-item)
         (b-index 0)
         (b-production)
         (b-production-number))
@@ -956,29 +955,23 @@
                (parser-generator--e-free-first
                 b-suffix-follow))
 
-              ;; If b is at a point of reduction,
-              ;; calculate production and production-number
-              (if (not b-suffix)
-                  (progn
-                    (setq
-                     b-production
-                     (list
-                      (nth 0 b)
-                      (nth 1 b)))
-                    (setq
-                     b-production-number
-                     (parser-generator--get-grammar-production-number
-                      b-production)))
-                (setq
-                 b-production
-                 nil)
-                (setq
-                 b-production-number
-                 nil))
+              (let ((b-lhs)
+                    (b-rhs))
+                (if (listp (nth 0 b))
+                    (setq b-lhs (nth 0 b))
+                  (setq b-lhs (list (nth 0 b))))
+                (if (nth 2 b)
+                    (setq b-rhs (append (nth 1 b) (nth 2 b)))
+                  (setq b-rhs (nth 1 b)))
+                (setq b-production (list b-lhs b-rhs)))
+              (setq
+               b-production-number
+               (parser-generator--get-grammar-production-number
+                b-production))
 
               (parser-generator--debug
                (message "b-production: %S" b-production)
-               (message "b-production-number: %S" b-production)
+               (message "b-production-number: %S" b-production-number)
                (message "b-suffix: %s" b-suffix)
                (message "b-follow: %s" b-follow)
                (message "b-suffix-follow: %s" b-suffix-follow)
@@ -1119,16 +1112,53 @@
   (let ((can-be-resolved))
     (when
         ;; Precedence comparison function exists?
-        ;; (and
-        ;;  parser-generator-lr--precedence-comparison-function
-        ;;  (functionp
-        ;;   parser-generator-lr--precedence-comparison-function)
-        ;;  parser-generator-lr--global-precedence-attributes
-        ;;  (or
-        ;;   (gethash
-        ;;    symbol
-        ;;    parser-generator-lr--global-precedence-table)
-        can-be-resolved)))
+        (and
+         parser-generator-lr--precedence-comparison-function
+         (functionp
+          parser-generator-lr--precedence-comparison-function)
+         parser-generator-lr--global-precedence-attributes
+         parser-generator-lr--context-sensitive-precedence-attribute)
+
+      ;; Try to find precedence data for A
+      (when a-production-number
+        (let ((a-attributes
+               (gethash
+                a-production-number
+                parser-generator--table-productions-attributes)))
+          (when a-attributes
+            (let ((a-attribute-value
+                   (plist-get
+                    a-attributes
+                    
parser-generator-lr--context-sensitive-precedence-attribute)))
+              (when a-attribute-value
+                (let ((a-precedence
+                       (gethash
+                        a-attribute-value
+                        parser-generator-lr--global-precedence-table)))
+                  (when a-attribute-value
+                    (setq can-be-resolved t))))))))
+
+      ;; Try to find precedence data for B
+      (when (and
+             (not can-be-resolved)
+             b-production-number)
+        (let ((b-attributes
+               (gethash
+                b-production-number
+                parser-generator--table-productions-attributes)))
+          (when b-attributes
+            (let ((b-attribute-value
+                   (plist-get
+                    b-attributes
+                    
parser-generator-lr--context-sensitive-precedence-attribute)))
+              (when b-attribute-value
+                (let ((b-precedence
+                       (gethash
+                        b-attribute-value
+                        parser-generator-lr--global-precedence-table)))
+                  (when b-precedence
+                    (setq can-be-resolved t)))))))))
+    can-be-resolved))
 
 ;; Algorithm 5.8, p. 386
 (defun parser-generator-lr--items-for-prefix (γ)
diff --git a/parser-generator.el b/parser-generator.el
index e0b8f4f..f92cb19 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -17,7 +17,7 @@
 
 (defvar
   parser-generator--debug
-  t
+  nil
   "Whether to print debug messages or not.")
 
 (defvar
@@ -553,9 +553,18 @@
                                    (nth
                                     (1+ sub-rhs-element-index)
                                     rhs-element)))
-                              (push
-                               `(,sub-rhs-element ,attribute-value)
-                               production-attributes)
+                              (if production-attributes
+                                  (setq
+                                   production-attributes
+                                   (append
+                                    production-attributes
+                                    sub-rhs-element
+                                    attribute-value))
+                                (setq
+                                 production-attributes
+                                 (list
+                                  sub-rhs-element
+                                  attribute-value)))
                               (setq
                                sub-rhs-element-index
                                (1+ sub-rhs-element-index))))
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index df403af..b1eb75a 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -164,13 +164,8 @@
        t)
       (t
        nil))))
-  ;; TODO Should add tests for 
(parser-generator-lr--prepare-global-declaration)
-  (parser-generator-lr--prepare-global-declaration)
-  (message "parser-generator-lr--global-precedence-attributes-table: %S" 
parser-generator-lr--global-precedence-attributes-table)
-  (message "parser-generator-lr--global-precedence-attributes: %S" 
parser-generator-lr--global-precedence-attributes)
-  (message "parser-generator-lr--global-precedence-table: %S" 
parser-generator-lr--global-precedence-table)
+
   (parser-generator-lr-generate-parser-tables)
-  
   (message "Grammar not conflicting anymore")
 
   (let ((table-lr-items
diff --git a/test/parser-generator-test.el b/test/parser-generator-test.el
index 7e9a996..6d48d88 100644
--- a/test/parser-generator-test.el
+++ b/test/parser-generator-test.el
@@ -480,7 +480,7 @@
 
   (should
    (equal
-    '((%prec 1))
+    '(%prec 1)
     
(parser-generator--get-grammar-context-sensitive-attributes-by-production-number
 0)))
   (should
    (equal
@@ -488,7 +488,7 @@
     (parser-generator--get-grammar-production-by-number 0)))
   (should
    (equal
-    '((%prec D))
+    '(%prec D)
     
(parser-generator--get-grammar-context-sensitive-attributes-by-production-number
 1)))
   (should
    (equal