[elpa] externals/parser-generator 0aed7b0 339/434: More work on global precedence in LR(k) parser

[ELPA Syncer]

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

    More work on global precedence in LR(k) parser
---
 parser-generator-lr.el           | 28 +++++++--------------
 test/parser-generator-lr-test.el | 53 ++++++++++++++++++++++++++++++++--------
 2 files changed, 52 insertions(+), 29 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index d4603ea..5163b2d 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -1009,24 +1009,24 @@
     (if
         (listp a)
         (setq
-         a-precendence
+         a-precedence
          (gethash
           (car a)
           parser-generator-lr--global-precedence-table))
       (setq
-       a-precendence
+       a-precedence
        (gethash
         a
         parser-generator-lr--global-precedence-table)))
     (if
         (listp b)
         (setq
-         b-precendence
+         b-precedence
          (gethash
           (car b)
           parser-generator-lr--global-precedence-table))
       (setq
-       b-precendence
+       b-precedence
        (gethash
         b
         parser-generator-lr--global-precedence-table)))
@@ -1094,26 +1094,16 @@
           (parser-generator-lr--symbol-takes-precedence-p
            a
            b)
-          (if
-              (parser-generator-lr--symbol-takes-precedence-p
-               b
-               a)
-              (setq
-               can-be-resolved
-               nil)
-            (setq
-             can-be-resolved
-             t))
-        (if
+          (setq
+           can-be-resolved
+           t)
+        (when
             (parser-generator-lr--symbol-takes-precedence-p
              b
              a)
             (setq
              can-be-resolved
-             t)
-          (setq
-           can-be-resolved
-           nil))))
+             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 4ca05a8..7b9d8dd 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -557,25 +557,58 @@
   (parser-generator-process-grammar)
   (should-error
    (parser-generator-lr-generate-parser-tables))
-  (message "Grammar caused expected error")
+  (message "Infix calculator grammar caused expected error")
 
   ;; Add precedence to resolve conflicts
   (setq
-   parser-generator-lr--global-precedence-attribute-left
-   '%left)
-  (setq
-   parser-generator-lr--global-precedence-attribute-right
-   '%right)
-  (setq
-   parser-generator-lr--global-precedence-attribute-general
-   '%precedence)
-  (setq
    parser-generator--context-sensitive-attributes
    '(%prec))
   (setq
    parser-generator--global-attributes
    '(%left %precedence %right))
   (setq
+   parser-generator-lr--global-precedence-attributes
+   '(%left %precedence %right))
+  (setq
+   parser-generator-lr--context-sensitive-precedence-attribute
+   '%prec)
+  (setq
+   parser-generator-lr--precedence-comparison-function
+   (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))))
+         (cond
+          ((>= a-value b-value)
+           (cond
+            ((eq a-op '%left)
+             t)
+            ((eq a-op '%right)
+             nil)
+            ((eq a-op '%precedence)
+             t)))
+          ((> b-value a-value)
+           (cond
+            ((eq b-op '%left)
+             nil)
+            ((eq b-op '%right)
+             t)
+            ((eq b-op '%precedence)
+             nil))))))
+      (a
+       (cond
+        ((eq (car a) '%left)
+         t)
+        ((eq (car a) '%right)
+         nil)
+        ((eq (car a) '%precedence)
+         t)))
+      (t
+       nil))))
+  (setq
    parser-generator--global-declaration
    '(
      (%left "-" "+")