branch: externals/parser-generator
commit 3170e8d988200b20f600923adaff6e1feb81ab95
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Context-sensitive precedence now avoids conflict-detection
---
parser-generator-lr.el | 92 ++++++++++++++++++++++++++--------------
parser-generator.el | 17 ++++++--
test/parser-generator-lr-test.el | 7 +--
test/parser-generator-test.el | 4 +-
4 files changed, 77 insertions(+), 43 deletions(-)
diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 6727751..82f96f1 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -867,7 +867,6 @@
(b-follow)
(b-suffix-follow)
(b-suffix-follow-eff)
- (b-suffix-follow-eff-item)
(b-index 0)
(b-production)
(b-production-number))
@@ -956,29 +955,23 @@
(parser-generator--e-free-first
b-suffix-follow))
- ;; If b is at a point of reduction,
- ;; calculate production and production-number
- (if (not b-suffix)
- (progn
- (setq
- b-production
- (list
- (nth 0 b)
- (nth 1 b)))
- (setq
- b-production-number
- (parser-generator--get-grammar-production-number
- b-production)))
- (setq
- b-production
- nil)
- (setq
- b-production-number
- nil))
+ (let ((b-lhs)
+ (b-rhs))
+ (if (listp (nth 0 b))
+ (setq b-lhs (nth 0 b))
+ (setq b-lhs (list (nth 0 b))))
+ (if (nth 2 b)
+ (setq b-rhs (append (nth 1 b) (nth 2 b)))
+ (setq b-rhs (nth 1 b)))
+ (setq b-production (list b-lhs b-rhs)))
+ (setq
+ b-production-number
+ (parser-generator--get-grammar-production-number
+ b-production))
(parser-generator--debug
(message "b-production: %S" b-production)
- (message "b-production-number: %S" b-production)
+ (message "b-production-number: %S" b-production-number)
(message "b-suffix: %s" b-suffix)
(message "b-follow: %s" b-follow)
(message "b-suffix-follow: %s" b-suffix-follow)
@@ -1119,16 +1112,53 @@
(let ((can-be-resolved))
(when
;; Precedence comparison function exists?
- ;; (and
- ;; parser-generator-lr--precedence-comparison-function
- ;; (functionp
- ;; parser-generator-lr--precedence-comparison-function)
- ;; parser-generator-lr--global-precedence-attributes
- ;; (or
- ;; (gethash
- ;; symbol
- ;; parser-generator-lr--global-precedence-table)
- can-be-resolved)))
+ (and
+ parser-generator-lr--precedence-comparison-function
+ (functionp
+ parser-generator-lr--precedence-comparison-function)
+ parser-generator-lr--global-precedence-attributes
+ parser-generator-lr--context-sensitive-precedence-attribute)
+
+ ;; Try to find precedence data for A
+ (when a-production-number
+ (let ((a-attributes
+ (gethash
+ a-production-number
+ parser-generator--table-productions-attributes)))
+ (when a-attributes
+ (let ((a-attribute-value
+ (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))))))))
+
+ ;; Try to find precedence data for B
+ (when (and
+ (not can-be-resolved)
+ b-production-number)
+ (let ((b-attributes
+ (gethash
+ b-production-number
+ parser-generator--table-productions-attributes)))
+ (when b-attributes
+ (let ((b-attribute-value
+ (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)))))))))
+ can-be-resolved))
;; Algorithm 5.8, p. 386
(defun parser-generator-lr--items-for-prefix (γ)
diff --git a/parser-generator.el b/parser-generator.el
index e0b8f4f..f92cb19 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -17,7 +17,7 @@
(defvar
parser-generator--debug
- t
+ nil
"Whether to print debug messages or not.")
(defvar
@@ -553,9 +553,18 @@
(nth
(1+ sub-rhs-element-index)
rhs-element)))
- (push
- `(,sub-rhs-element ,attribute-value)
- production-attributes)
+ (if production-attributes
+ (setq
+ production-attributes
+ (append
+ production-attributes
+ sub-rhs-element
+ attribute-value))
+ (setq
+ production-attributes
+ (list
+ sub-rhs-element
+ attribute-value)))
(setq
sub-rhs-element-index
(1+ sub-rhs-element-index))))
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index df403af..b1eb75a 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -164,13 +164,8 @@
t)
(t
nil))))
- ;; TODO Should add tests for
(parser-generator-lr--prepare-global-declaration)
- (parser-generator-lr--prepare-global-declaration)
- (message "parser-generator-lr--global-precedence-attributes-table: %S"
parser-generator-lr--global-precedence-attributes-table)
- (message "parser-generator-lr--global-precedence-attributes: %S"
parser-generator-lr--global-precedence-attributes)
- (message "parser-generator-lr--global-precedence-table: %S"
parser-generator-lr--global-precedence-table)
+
(parser-generator-lr-generate-parser-tables)
-
(message "Grammar not conflicting anymore")
(let ((table-lr-items
diff --git a/test/parser-generator-test.el b/test/parser-generator-test.el
index 7e9a996..6d48d88 100644
--- a/test/parser-generator-test.el
+++ b/test/parser-generator-test.el
@@ -480,7 +480,7 @@
(should
(equal
- '((%prec 1))
+ '(%prec 1)
(parser-generator--get-grammar-context-sensitive-attributes-by-production-number
0)))
(should
(equal
@@ -488,7 +488,7 @@
(parser-generator--get-grammar-production-by-number 0)))
(should
(equal
- '((%prec D))
+ '(%prec D)
(parser-generator--get-grammar-context-sensitive-attributes-by-production-number
1)))
(should
(equal
