branch: externals/parser-generator
commit 3e096f7330b8447cf6c6917f7176c8ba76e26427
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Improved translation handling for each production
---
parser-generator.el | 173 +++++++++++++++++++++++++++++----------
test/parser-generator-lr-test.el | 4 +-
test/parser-generator-test.el | 12 ++-
3 files changed, 142 insertions(+), 47 deletions(-)
diff --git a/parser-generator.el b/parser-generator.el
index 62a9f3b..8f72da7 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -11,7 +11,7 @@
(defvar parser-generator--debug
- t
+ nil
"Whether to print debug messages or not.")
(defvar parser-generator--e-identifier
@@ -827,6 +827,7 @@
(message "rhs-expanded-full flagged negative"))
(setq rhs-expanded-full nil)
(setq expanded-all nil))
+
(setq rhs-leading-terminals
(nth 1 f-set-return))
@@ -847,16 +848,22 @@
(listp rhs-leading-terminals)
(> (length rhs-leading-terminals) 0))
(dolist
- (rhs-leading-terminals-element
rhs-leading-terminals)
+ (rhs-leading-terminals-element
+ rhs-leading-terminals)
(push
rhs-leading-terminals-element
f-p-set)))))))
;; If we have multiple equal LHS
;; merge them
- (when (gethash production-lhs f-set)
+ (when (
+ gethash
+ production-lhs
+ f-set)
(let ((existing-f-set
- (gethash production-lhs f-set)))
+ (gethash
+ production-lhs
+ f-set)))
;; If another set has not been fully expanded
;; mark LHS as not fully expanded
@@ -870,29 +877,54 @@
(nth 1 existing-f-set)))))
;; Make set distinct
- (setq f-p-set (parser-generator--distinct f-p-set))
+ (setq
+ f-p-set
+ (parser-generator--distinct f-p-set))
+ (puthash
+ production-lhs
+ (list
+ rhs-expanded-full
+ (reverse f-p-set))
+ f-set)
(parser-generator--debug
(message
- "F_%s(%s) = %s"
+ "F_%s%s = %s"
i
production-lhs
- (list rhs-expanded-full (reverse f-p-set))))
- (puthash
- production-lhs
- (list rhs-expanded-full (reverse f-p-set))
- f-set))))
+ (gethash
+ production-lhs
+ f-set))))))
- (puthash i f-set f-sets)
- (setq i (+ i 1))))
+ (puthash
+ i
+ f-set
+ f-sets)
+ (setq
+ i
+ (+ i 1))))
(if disallow-e-first
(progn
+ (setq
+ parser-generator--f-free-sets
+ (gethash
+ (1- i)
+ f-sets))
(parser-generator--debug
- (message "Max-index: %s" (1- i)))
- (setq parser-generator--f-free-sets (gethash (1- i) f-sets)))
+ (message
+ "E-FREE-FIRST max-index: %s, contents: %s"
+ (1- i)
+ parser-generator--f-free-sets)))
+ (setq
+ parser-generator--f-sets
+ (gethash
+ (1- i)
+ f-sets))
(parser-generator--debug
- (message "Max-index: %s" (1- i)))
- (setq parser-generator--f-sets (gethash (1- i) f-sets)))))))
+ (message
+ "FIRST max-index: %s, contents: %s"
+ (1- i)
+ parser-generator--f-sets)))))))
(parser-generator--debug
(message "Generated F-sets"))))
@@ -996,7 +1028,9 @@
(let ((rhs-element (nth input-tape-index input-tape))
(rhs-type))
(parser-generator--debug
- (message "rhs-element: %s" rhs-element))
+ (message
+ "rhs-element: %s"
+ rhs-element))
;; Determine symbol type
(cond
@@ -1007,7 +1041,10 @@
((parser-generator--valid-terminal-p rhs-element)
(setq rhs-type 'TERMINAL))
(t (error (format "Invalid symbol %s" rhs-element))))
- (parser-generator--debug (message "rhs-type: %s" rhs-type))
+ (parser-generator--debug
+ (message
+ "rhs-type: %s"
+ rhs-type))
(cond
@@ -1017,7 +1054,7 @@
(sub-terminal-expanded)
(sub-terminal-data
(gethash
- rhs-element
+ (list rhs-element)
(gethash
(1- i)
f-sets))))
@@ -1027,8 +1064,12 @@
rhs-element
sub-terminal-data))
- (setq sub-terminal-expanded (nth 0 sub-terminal-data))
- (setq sub-terminal-sets (nth 1 sub-terminal-data))
+ (setq
+ sub-terminal-expanded
+ (nth 0 sub-terminal-data))
+ (setq
+ sub-terminal-sets
+ (nth 1 sub-terminal-data))
;; When sub-set has not been fully expanded mark this
set
;; as not fully expanded either
@@ -1194,8 +1235,13 @@
(setq all-leading-terminals-p nil)))))
(parser-generator--debug
- (message "Found no subsets for %s %s" rhs-element
(1- i)))
- (setq all-leading-terminals-p nil)))
+ (message
+ "Found no subsets for %s %s"
+ rhs-element
+ (1- i)))
+ (setq
+ all-leading-terminals-p
+ nil)))
(parser-generator--debug
(message
@@ -1311,6 +1357,11 @@
((parser-generator--valid-non-terminal-p symbol)
(parser-generator--debug
(message "non-terminal symbol: %s" symbol))
+ (setq
+ symbol
+ (list symbol))
+ (parser-generator--debug
+ (message "non-terminal symbol production: %s" symbol))
(let ((symbol-f-set))
;; Load the pre-generated F-set
@@ -1319,18 +1370,37 @@
(if (and
disallow-e-first
(= first-length 0))
- (setq
- symbol-f-set
- (nth 1
- (gethash
- symbol
- parser-generator--f-free-sets)))
+ (progn
+ (parser-generator--debug
+ (message
+ "gethash: %s"
+ (gethash
+ symbol
+ parser-generator--f-free-sets)))
+ (setq
+ symbol-f-set
+ (nth
+ 1
+ (gethash
+ symbol
+ parser-generator--f-free-sets))))
+ (parser-generator--debug
+ (message
+ "gethash: %s"
+ (gethash
+ symbol
+ parser-generator--f-sets)))
(setq
symbol-f-set
- (nth 1
- (gethash symbol parser-generator--f-sets))))
+ (nth
+ 1
+ (gethash
+ symbol
+ parser-generator--f-sets))))
(parser-generator--debug
- (message "symbol-f-set: %s" symbol-f-set))
+ (message
+ "symbol-f-set: %s"
+ symbol-f-set))
(if (and
(not symbol-f-set)
@@ -1344,16 +1414,31 @@
(setq keep-looking nil))
;; Handle this scenario here were a non-terminal can
result in different FIRST sets
- (when (> (length symbol-f-set) 1)
- (let ((symbol-f-set-index 1)
- (symbol-f-set-length (length symbol-f-set)))
- (while (< symbol-f-set-index symbol-f-set-length)
- (let ((symbol-f-set-element (nth
symbol-f-set-index symbol-f-set)))
- (let ((alternative-first-length (+
first-length (length symbol-f-set-element)))
- (alternative-first (append first
symbol-f-set-element))
- (alternative-tape-index (1+
input-tape-index)))
+ (when (>
+ (length symbol-f-set)
+ 1)
+ (let ((symbol-f-set-index
+ 1)
+ (symbol-f-set-length
+ (length symbol-f-set)))
+ (while
+ (<
+ symbol-f-set-index
+ symbol-f-set-length)
+ (let ((symbol-f-set-element
+ (nth
+ symbol-f-set-index
+ symbol-f-set)))
+ (let ((alternative-first-length
+ (+ first-length (length
symbol-f-set-element)))
+ (alternative-first
+ (append first symbol-f-set-element))
+ (alternative-tape-index
+ (1+ input-tape-index)))
(parser-generator--debug
- (message "alternative-first: %s"
alternative-first))
+ (message
+ "alternative-first: %s"
+ alternative-first))
(push
`(
,alternative-tape-index
@@ -1365,7 +1450,9 @@
(1+ symbol-f-set-index)))))
(parser-generator--debug
- (message "main-symbol-f-set: %s" (car symbol-f-set)))
+ (message
+ "main-symbol-f-set: %s"
+ (car symbol-f-set)))
(setq
first-length
(+ first-length (length (car symbol-f-set))))
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index f2a3f33..5bf630e 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -686,7 +686,7 @@
(insert "abac")
(parser-generator-set-grammar
- '((Sp S R T) ("a" "b" "c") ((Sp S) (S (R S) (R)) (R ("a" "b" T
(lambda(args) (list "begin" (nth 2 args) "end")))) (T ("a" T (lambda() "test"))
("c") (e))) Sp))
+ '((Sp S R T) ("a" "b" "c") ((Sp S) (S (R S) (R)) (R ("a" "b" T
(lambda(args) (list "begin" (nth 2 args) "end")))) (T ("a" T (lambda(args)
"test")) ("c") (e))) Sp))
(parser-generator-set-look-ahead-number 2)
(parser-generator-process-grammar)
(parser-generator-lr-generate-parser-tables)
@@ -901,7 +901,7 @@
(defun parser-generator-lr-test ()
"Run test."
- ;; (setq debug-on-error t)
+ (setq debug-on-error t)
(parser-generator-lr-test--items-for-prefix)
(parser-generator-lr-test--items-valid-p)
diff --git a/test/parser-generator-test.el b/test/parser-generator-test.el
index 410b39a..2ab20c9 100644
--- a/test/parser-generator-test.el
+++ b/test/parser-generator-test.el
@@ -602,7 +602,6 @@
(parser-generator-set-grammar
'((S A B) ("a" "b") ((S A) (A ("b" "a")) (B "b" (lambda(b) (message "Was
here: %s" b)))) S))
(parser-generator-process-grammar)
-
(should (equal
'((A))
(parser-generator--get-grammar-rhs 'S)))
@@ -615,7 +614,6 @@
(parser-generator-set-grammar '((S A B) ("a" "b") ((S A) (S (B)) (B "a") (A
"a") (A ("b" "a"))) S))
(parser-generator-process-grammar)
-
(should (equal
'((A) (B))
(parser-generator--get-grammar-rhs 'S)))
@@ -623,6 +621,16 @@
'(("a") ("b" "a"))
(parser-generator--get-grammar-rhs 'A)))
+ (parser-generator-set-grammar
+ '((Sp S R T) ("a" "b" "c") ((Sp S) (S (R S) (R)) (R ("a" "b" T
(lambda(args) (list "begin" (nth 2 args) "end")))) (T ("a" T (lambda() "test"))
("c") (e))) Sp))
+ (parser-generator-process-grammar)
+ (should
+ (equal
+ '(("a" T) ("c") (e))
+ (parser-generator--get-grammar-rhs 'T)))
+
+ (parser-generator-process-grammar)
+
(message "Passed tests for (parser-generator--get-grammar-rhs)"))
(defun parser-generator-test--valid-non-terminal-p ()
