[elpa] externals/parser-generator 9d5df0e 375/434: More working on trying to get the Infix example working

[ELPA Syncer]

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

    More working on trying to get the Infix example working
---
 parser-generator-lr.el           |  4 ---
 test/parser-generator-lr-test.el | 74 ++++++++++++++++++++++++++--------------
 2 files changed, 49 insertions(+), 29 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 52d4c57..859189d 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -1039,8 +1039,6 @@
           symbol
           parser-generator-lr--global-precedence-table))
         (b-precedence-value))
-    (message "parser-generator-lr--reduce-takes-precedence-p: %S %S %S" symbol 
a-production-number b-production-number)
-    (message "a-precedence-value: %S from %S" a-precedence-value 
parser-generator-lr--global-precedence-table)
 
     ;; Context-sensitive precedence takes precedence over
     ;; global precedence
@@ -1077,8 +1075,6 @@
                 b-precedence-symbol
                 parser-generator-lr--global-precedence-table)))))))
 
-    ;; TODO Need to pass action type of A and B to comparison function
-
     (funcall
      parser-generator-lr--precedence-comparison-function
      a-precedence-value
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index d10240c..7dbaafa 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -856,35 +856,59 @@
    (lambda(a b)
      (cond
       ((and a b)
-       (let ((a-op (car a))
-             (a-value (car (cdr a)))
-             (b-op (car b))
-             (b-value (car (cdr b))))
+       (let ((a-left (plist-get a '%left))
+             (a-precedence (plist-get a '%precedence))
+             (a-right (plist-get a '%right))
+             (b-left (plist-get b '%left))
+             (b-precedence (plist-get b '%precedence))
+             (b-right (plist-get b '%right)))
+         (message "a-left: %S a-precedence: %S a-right: %S" a-left 
a-precedence a-right)
          (cond
-          ((>= a-value b-value)
+          (a-left
            (cond
-            ((eq a-op '%left)
-             t)
-            ((eq a-op '%right)
-             nil)
-            ((eq a-op '%precedence)
-             t)))
-          ((> b-value a-value)
+            ((and
+              b-left
+              (> a-left b-left)
+              t)
+             nil)))
+          (a-right
            (cond
-            ((eq b-op '%left)
-             nil)
-            ((eq b-op '%right)
-             t)
-            ((eq b-op '%precedence)
-             nil))))))
+            ((and
+              a-right
+              (> a-right b-right))
+             nil
+             (t
+              t))))
+          (a-precedence
+           ((cond
+             ((and
+               a-precedence
+               (> a-precedence b-precedence))
+              t)
+             (t
+              nil)))))))
       (a
-       (cond
-        ((eq (car a) '%left)
-         t)
-        ((eq (car a) '%right)
-         nil)
-        ((eq (car a) '%precedence)
-         t)))
+       (let ((a-left (plist-get a '%left))
+             (a-precedence (plist-get a '%precedence))
+             (a-right (plist-get a '%right)))
+         (cond
+          ((or
+            a-left
+            a-precedence)
+           t)
+          (t
+           nil))))
+      (b
+       (let ((b-left (plist-get b '%left))
+             (b-precedence (plist-get b '%precedence))
+             (b-right (plist-get b '%right)))
+         (cond
+          ((or
+            b-left
+            b-precedence)
+           nil)
+          (t
+           t))))
       (t
        nil))))
   (setq