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