branch: externals/parser-generator
commit 1be5fdaa6d03f8b5967802d15ad528aa68a118cf
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
More work on support for conflict resolution
---
parser-generator-lr.el | 57 ++++++++++++++++++++++++----------------
test/parser-generator-lr-test.el | 37 ++++++++++++++++++++++++++
2 files changed, 72 insertions(+), 22 deletions(-)
diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 3d45306..52d4c57 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -396,7 +396,9 @@
index-hash-key
index-symbols)
(if
-
parser-generator-lr--precedence-comparison-function
+ (and
+
parser-generator-lr--precedence-comparison-function
+
parser-generator-lr--global-precedence-table)
(let ((a u)
(b
(gethash
@@ -407,9 +409,10 @@
;; and production-number of B
;; if it's a reduction
(if
-
(parser-generator-lr--production-takes-precedence-p
- (car (cdr a))
- (car (cdr b)))
+
(parser-generator-lr--reduce-takes-precedence-p
+ (car u)
+ production-number
+ (nth 2 b))
(progn
(parser-generator--debug
(message
@@ -444,7 +447,7 @@
index-hash-key
index-symbols)))
(error
- "Reduce/%S conflict for %S in state
%S, %S vs %S"
+ "Reduce/%S conflict for %S in state
%S"
(car (cdr conflicted-item))
u
goto-index
@@ -1029,11 +1032,18 @@
(setq set-index (1+ set-index)))
valid-p))
-(defun parser-generator-lr--production-takes-precedence-p (a-production-number
b-production-number)
- "Return t if A-PRODUCTION-NUMBER takes precedence over B-PRODUCTION-NUMBER,
otherwise nil."
- (let ((a-precedence-value)
+(defun parser-generator-lr--reduce-takes-precedence-p (symbol
a-production-number &optional b-production-number)
+ "Return t if reduction of SYMBOL at A-PRODUCTION-NUMBER takes precedence
over other action. If other action is a reduction then it is at
B-PRODUCTION-NUMBER."
+ (let ((a-precedence-value
+ (gethash
+ 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
(let ((a-attributes
(gethash
a-production-number
@@ -1050,21 +1060,24 @@
a-precedence-symbol
parser-generator-lr--global-precedence-table))))))
- (let ((b-attributes
- (gethash
- b-production-number
- parser-generator--table-productions-attributes)))
- (when b-attributes
- (let ((b-precedence-symbol
- (plist-get
- b-attributes
- parser-generator-lr--context-sensitive-precedence-attribute)))
- (when b-precedence-symbol
- (setq
- b-precedence-value
+ (when b-production-number
+ (let ((b-attributes
(gethash
- b-precedence-symbol
- parser-generator-lr--global-precedence-table))))))
+ b-production-number
+ parser-generator--table-productions-attributes)))
+ (when b-attributes
+ (let ((b-precedence-symbol
+ (plist-get
+ b-attributes
+
parser-generator-lr--context-sensitive-precedence-attribute)))
+ (when b-precedence-symbol
+ (setq
+ b-precedence-value
+ (gethash
+ 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
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 9aeb979..d10240c 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -634,6 +634,43 @@
(setq
parser-generator--context-sensitive-attributes
'(%prec))
+ (setq
+ parser-generator-lr--precedence-comparison-function
+ (lambda(a b)
+ (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-set-grammar
'(
(start input line exp)
