branch: externals/parser-generator
commit 778b96facfd3c685182334990418fd725ab7a42e
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
More work on global precedence declaration
---
parser-generator-lr.el | 87 ++++++++++++++++++++++++++++++++++------
test/parser-generator-lr-test.el | 15 +++++--
2 files changed, 87 insertions(+), 15 deletions(-)
diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 8df773c..59ea339 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -35,21 +35,84 @@
"Goto-tables for grammar.")
(defvar
- parser-generator-lr--precedence-attribute
+ parser-generator-lr--context-sensitive-precedence-attribute
nil
- "Attribute used for precedence.")
+ "Attribute used for context-sensitive-precedence.")
(defvar
- parser-generator-lr--precedence-comparison-function
+ parser-generator-lr--context-sensitive-precedence-comparison-function
nil
- "Function used for resolving precedence.")
+ "Function used for resolving context-sensitive precedence.")
+
+(defvar
+ parser-generator-lr--global-precedence-attribute-left
+ nil
+ "Global precedence attribute to left symbol.")
+
+(defvar
+ parser-generator-lr--global-precedence-attribute-right
+ nil
+ "Global precedence attribute to right symbol.")
+
+(defvar
+ parser-generator-lr--global-precedence-attribute-general
+ nil
+ "Global precedence attribute for general precedence.")
+
+(defvar
+ parser-generator-lr--global-precedence-table
+ nil
+ "Hash-table for fast look-up of global precedence symbols.")
;; Main Algorithms
+(defun parser-generator-lr--prepare-global-declaration ()
+ "Prepare global declaration for parsing."
+ (setq
+ parser-generator-lr--global-precedence-table
+ (make-hash-table :test 'equal))
+ (when (or
+ parser-generator-lr--global-precedence-attribute-left
+ parser-generator-lr--global-precedence-attribute-right
+ parser-generator-lr--global-precedence-attribute-general)
+ (let ((line-index 0))
+ (dolist (line parser-generator--global-declaration)
+ (let ((attribute (car line))
+ (items (cdr line)))
+ (cond
+ ((eq
+ attribute
+ parser-generator-lr--global-precedence-attribute-left)
+ (dolist (item items)
+ (puthash
+ item
+ `(left ,line-index)
+ parser-generator-lr--global-precedence-table)))
+ ((eq
+ attribute
+ parser-generator-lr--global-precedence-attribute-right)
+ (dolist (item items)
+ (puthash
+ item
+ `(right ,line-index)
+ parser-generator-lr--global-precedence-table)))
+ ((eq
+ attribute
+ parser-generator-lr--global-precedence-attribute-general)
+ (dolist (item items)
+ (puthash
+ item
+ `(general ,line-index)
+ parser-generator-lr--global-precedence-table)))))
+ (setq
+ line-index
+ (1+ line-index))))))
+
(defun parser-generator-lr-generate-parser-tables ()
"Generate parsing tables for grammar."
(message "\nStarting generation of parser-tables..\n")
+ (parser-generator-lr--prepare-global-declaration)
(let ((table-lr-items
(parser-generator-lr--generate-goto-tables)))
(parser-generator-lr--generate-action-tables
@@ -945,16 +1008,16 @@
(let ((a-value
(plist-get
(car (cdr a))
- parser-generator-lr--precedence-attribute))
+ parser-generator-lr--context-sensitive-precedence-attribute))
(b-value
(plist-get
(car (cdr b))
- parser-generator-lr--precedence-attribute)))
+ parser-generator-lr--context-sensitive-precedence-attribute)))
(condition-case
errors
(let ((comparison
(funcall
- parser-generator-lr--precedence-comparison-function
+
parser-generator-lr--context-sensitive-precedence-comparison-function
a-value
b-value)))
(setq
@@ -970,7 +1033,7 @@
(when
(plist-get
(car (cdr a))
- parser-generator-lr--precedence-attribute)
+ parser-generator-lr--context-sensitive-precedence-attribute)
(setq
takes-precedence
t)))
@@ -978,7 +1041,7 @@
(when
(plist-get
(car (cdr b))
- parser-generator-lr--precedence-attribute)
+ parser-generator-lr--context-sensitive-precedence-attribute)
(setq
takes-precedence
nil))))
@@ -989,10 +1052,10 @@
(let ((can-be-resolved))
(when
(and
- parser-generator-lr--precedence-attribute
- parser-generator-lr--precedence-comparison-function
+ parser-generator-lr--context-sensitive-precedence-attribute
+ parser-generator-lr--context-sensitive-precedence-comparison-function
(functionp
- parser-generator-lr--precedence-comparison-function)
+
parser-generator-lr--context-sensitive-precedence-comparison-function)
(or (listp a)
(listp b)))
(if
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index b5d1513..7bcd8f4 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -143,10 +143,10 @@
(message "Conflicted grammar caused expected exception 2")
(setq
- parser-generator-lr--precedence-attribute
+ parser-generator-lr--context-sensitive-precedence-attribute
'%prec)
(setq
- parser-generator-lr--precedence-comparison-function
+ parser-generator-lr--context-sensitive-precedence-comparison-function
#'>)
(parser-generator-lr-generate-parser-tables)
(message "Grammar not conflicting anymore")
@@ -545,6 +545,15 @@
;; 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
@@ -1346,7 +1355,7 @@
(defun parser-generator-lr-test ()
"Run test."
- ;; (setq debug-on-error t)
+ ;; (setq debug-on-error nil)
(parser-generator-lr-test--items-for-prefix)
(parser-generator-lr-test--items-valid-p)
