branch: externals/parser-generator
commit 2ad866cb5ef45eea54c2f71382c1b94efb8ae227
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@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")
