branch: externals/parser-generator
commit 5f13406ebaf0d120758d496c5a6b5c993a3e1abc
Author: Christian Johansson <[email protected]>
Commit: Christian Johansson <[email protected]>
More work on supporting LR-grammar with precedence attributes
---
parser-generator-lr.el | 52 ++++++++++++++++++++++++++++++----------
test/parser-generator-lr-test.el | 29 +++++++++++++---------
2 files changed, 58 insertions(+), 23 deletions(-)
diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 59b2994..5da6882 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -34,6 +34,16 @@
nil
"Goto-tables for grammar.")
+(defvar
+ parser-generator-lr--precedence-attribute
+ nil
+ "Attribute used for precedence.")
+
+(defvar
+ parser-generator-lr--precedence-comparison-function
+ nil
+ "Function used for resolving precedence.")
+
;; Main Algorithms
@@ -766,18 +776,36 @@
(when (equal
a-follow
b-suffix-follow-eff-item)
- (when
- signal-on-false
- (error
- "Inconsistent grammar! %S (index: %d) with look-ahead %S
conflicts with %S (index: %d) with look-ahead %S in sets: %S"
- a
- a-index
- a-follow-full
- b
- b-index
- b-suffix-follow-eff-item-full
- lr-item-sets))
- (setq valid-p nil))))
+
+ ;; If it's the same symbol but we have a precedence
+ ;; attribute on any of them, or both, pass anyway
+ (unless
+ (and
+ parser-generator-lr--precedence-attribute
+ parser-generator-lr--precedence-comparison-function
+ (or
+ (and
+ (listp (car a-follow-full))
+ (plist-get
+ (car (cdr (car a-follow-full)))
+ parser-generator-lr--precedence-attribute))
+ (and
+ (listp (car b-suffix-follow-eff-item-full))
+ (plist-get
+ (car (cdr (car b-suffix-follow-eff-item-full)))
+ parser-generator-lr--precedence-attribute))))
+ (when
+ signal-on-false
+ (error
+ "Inconsistent grammar! %S (index: %d) with look-ahead
%S conflicts with %S (index: %d) with look-ahead %S in sets: %S"
+ a
+ a-index
+ a-follow-full
+ b
+ b-index
+ b-suffix-follow-eff-item-full
+ lr-item-sets))
+ (setq valid-p nil)))))
(setq b-index (1+ b-index))))
(setq a-index (1+ a-index)))
(setq set-index (1+ set-index)))
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 2834844..fd38794 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -134,24 +134,31 @@
Sp))
(parser-generator-set-look-ahead-number 1)
(parser-generator-process-grammar)
-
- (let ((table-lr-items
- (parser-generator-lr--generate-goto-tables)))
- (message "conflict-lr-items: %S" table-lr-items)
- (message "conflict-goto-tables: %S"
(parser-generator-lr--get-expanded-goto-tables)))
-
(should-error
(parser-generator-lr-generate-parser-tables))
+ (message "Conflicted grammar caused expected exception 2")
+
+ (setq
+ parser-generator-lr--precedence-attribute
+ '%prec)
+ (setq
+ parser-generator-lr--precedence-comparison-function
+ #'<)
+ (parser-generator-lr-generate-parser-tables)
+ (message "Grammar not conflicting anymore")
(let ((table-lr-items
(parser-generator-lr--generate-goto-tables)))
- (message "conflicted lr-items: %s" table-lr-items)
+ (message
+ "conflict-lr-items: %S"
+ table-lr-items)
+ (message
+ "conflict-goto-tables: %S"
+ (parser-generator-lr--get-expanded-goto-tables))
(parser-generator-lr--generate-action-tables
table-lr-items)
- (message "conflicted goto-tables: %s"
(parser-generator-lr--get-expanded-goto-tables))
- (message "conflicted action-tables: %s"
(parser-generator-lr--get-expanded-action-tables))
- )
- (message "Passed conflicted grammar")
+ (message
+ "conflicted action-tables: %s"
(parser-generator-lr--get-expanded-action-tables)))
(message "Passed tests for (parser-generator-lr--generate-action-tables)"))
