[elpa] externals/parser-generator 2ad866c 371/434: Context-sensitive attribute are now tested through specified comparison function

[ELPA Syncer]

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

    Context-sensitive attribute are now tested through specified comparison 
function
---
 parser-generator-lr.el           | 64 +++++++++++++++++++++++++++-------------
 test/parser-generator-lr-test.el | 41 ++++++++++++++++++++-----
 2 files changed, 77 insertions(+), 28 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 82f96f1..d899425 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -1108,8 +1108,10 @@
     takes-precedence))
 
 (defun parser-generator-lr--conflict-can-be-resolved-by-attributes (symbol 
&optional a-production-number b-production-number)
-  "Return whether a conflict at SYMBOL can be resolved by 
precedence-attributes.  Optionally with A-PRODUCTION-NUMBER and 
B-PRODUCTION-NUMBER."
-  (let ((can-be-resolved))
+  "Return whether a conflict at SYMBOL can be resolved by context-sensitive 
precedence-attributes.  Optionally with A-PRODUCTION-NUMBER and 
B-PRODUCTION-NUMBER."
+  (let ((can-be-resolved)
+        (a-precedence-value)
+        (b-precedence-value))
     (when
         ;; Precedence comparison function exists?
         (and
@@ -1126,38 +1128,58 @@
                 a-production-number
                 parser-generator--table-productions-attributes)))
           (when a-attributes
-            (let ((a-attribute-value
+            (let ((a-precedence-symbol
                    (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))))))))
+              (when a-precedence-symbol
+                (setq
+                 a-precedence-value
+                 (gethash
+                  a-precedence-symbol
+                  parser-generator-lr--global-precedence-table)))))))
 
       ;; Try to find precedence data for B
-      (when (and
-             (not can-be-resolved)
-             b-production-number)
+      (when b-production-number
         (let ((b-attributes
                (gethash
                 b-production-number
                 parser-generator--table-productions-attributes)))
           (when b-attributes
-            (let ((b-attribute-value
+            (let ((b-precedence-symbol
                    (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)))))))))
+              (when b-precedence-symbol
+                (setq
+                 b-precedence-value
+                 (gethash
+                  b-precedence-symbol
+                  parser-generator-lr--global-precedence-table)))))))
+
+      (when (or
+             a-precedence-value
+             b-precedence-value)
+        (let (
+              (comparison-a-b
+               (funcall
+                parser-generator-lr--precedence-comparison-function
+                a-precedence-value
+                b-precedence-value))
+              (comparison-b-a
+               (funcall
+                parser-generator-lr--precedence-comparison-function
+                b-precedence-value
+                a-precedence-value)))
+          (unless
+              (equal
+               comparison-a-b
+               comparison-b-a)
+            (setq
+             can-be-resolved
+             t))))
+
+      )
     can-be-resolved))
 
 ;; Algorithm 5.8, p. 386
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index b1eb75a..4f7e7db 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -157,13 +157,40 @@
   (setq
    parser-generator-lr--precedence-comparison-function
    (lambda(a b)
-     (cond
-      ((and a b)
-       (string> a b))
-      (a
-       t)
-      (t
-       nil))))
+     (if (and
+          (not a)
+          (not b))
+         nil
+       (let ((a-precedence)
+             (b-precedence))
+         (when a
+           (setq
+            a-precedence
+            (plist-get
+             a
+             '%precedence)))
+         (when b
+           (setq
+            b-precedence
+            (plist-get
+             b
+             '%precedence)))
+         (cond
+          ((and
+            a-precedence
+            (not b-precedence))
+           t)
+          ((and
+            b-precedence
+            (not a-precedence))
+           nil)
+          ((and
+            a-precedence
+            b-precedence)
+           (>
+            a-precedence
+            b-precedence))
+          (t nil))))))
 
   (parser-generator-lr-generate-parser-tables)
   (message "Grammar not conflicting anymore")