branch: externals/parser-generator
commit 08e98765e65ee170d3119dc6f2db262f0f9e8778
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Fixed bug with associating a translation to multiple productions
---
parser-generator-lr.el | 70 ++++++++++----------
parser-generator.el | 174 ++++++++++++++++++++++++-------------------------
2 files changed, 122 insertions(+), 122 deletions(-)
diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 8934b3f..6820b99 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -1870,54 +1870,54 @@
popped-items-meta-contents)))
(parser-generator--debug
(message
- "translation-symbol-table: %s = %s"
+ "translation-symbol-table: %S = %S
(processed)"
production-lhs
partial-translation))
+ (let ((temp-hash-key
+ (format
+ "%S"
+ production-lhs)))
+ (let ((symbol-translations
+ (gethash
+ temp-hash-key
+ translation-symbol-table)))
+ (push
+ partial-translation
+ symbol-translations)
+ (puthash
+ temp-hash-key
+ (reverse symbol-translations)
+ translation-symbol-table)
+ (setq
+ translation
+ partial-translation))))
+
+ ;; When no translation is specified just use
popped contents as translation
+ (let ((partial-translation
+ popped-items-meta-contents))
+ (parser-generator--debug
+ (message
+ "translation-symbol-table: %S = %S (generic)"
+ production-lhs
+ partial-translation))
+ (let ((temp-hash-key
+ (format
+ "%S"
+ production-lhs)))
(let ((symbol-translations
(gethash
- (format
- "%S"
- production-lhs)
+ temp-hash-key
translation-symbol-table)))
(push
partial-translation
symbol-translations)
(puthash
- (format
- "%S"
- production-lhs)
+ temp-hash-key
(reverse symbol-translations)
translation-symbol-table)
(setq
translation
- partial-translation)))
-
- ;; When no translation is specified just use
popped contents as translation
- (let ((partial-translation
- popped-items-meta-contents))
- (parser-generator--debug
- (message
- "translation-symbol-table: %s = %s (generic)"
- production-lhs
- partial-translation))
- (let ((symbol-translations
- (gethash
- (format
- "%S"
- production-lhs)
- translation-symbol-table)))
- (push
- partial-translation
- symbol-translations)
- (puthash
- (format
- "%S"
- production-lhs)
- (reverse symbol-translations)
- translation-symbol-table)
- (setq
- translation
- partial-translation)))))
+ partial-translation))))))
(let ((new-table-index (car pushdown-list)))
(let ((goto-table-distinct-index
diff --git a/parser-generator.el b/parser-generator.el
index b3520c8..befa2ca 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -17,7 +17,7 @@
(defvar
parser-generator--debug
- nil
+ t
"Whether to print debug messages or not.")
(defvar
@@ -473,8 +473,7 @@
(dolist (p productions)
(let ((lhs (car p))
(rhs (cdr p))
- (production)
- (translation))
+ (production))
(unless (listp lhs)
(setq lhs (list lhs)))
(let ((new-value
@@ -488,98 +487,99 @@
(<
rhs-element-index
rhs-length)
- (setq
- rhs-element
- (nth
- rhs-element-index
- rhs))
- (when (functionp rhs-element)
- (error
- "Unexpected function element %s in RHS %s of LHS %s"
+ (let ((translation))
+ (setq
rhs-element
- rhs
- lhs))
- (unless (listp rhs-element)
- (setq rhs-element (list rhs-element)))
- (let ((sub-rhs-element-index 0)
- (sub-rhs-element-length (length rhs-element))
- (sub-rhs-element)
- (new-rhs))
- (while
- (<
- sub-rhs-element-index
- sub-rhs-element-length)
- (setq
- sub-rhs-element
- (nth
- sub-rhs-element-index
- rhs-element))
- (if (and
- (listp sub-rhs-element)
- (functionp sub-rhs-element))
- (setq
- translation
- sub-rhs-element)
- (unless
- (or
- (parser-generator--valid-terminal-p sub-rhs-element)
- (parser-generator--valid-non-terminal-p
sub-rhs-element)
- (parser-generator--valid-e-p sub-rhs-element)
- (parser-generator--valid-eof-p sub-rhs-element))
- (error
- "Element %s in RHS %s of production %s is not a valid
terminal, non-terminal, e-identifier or EOF-identifier!"
- sub-rhs-element
- rhs-element
- lhs))
- (push
+ (nth
+ rhs-element-index
+ rhs))
+ (when (functionp rhs-element)
+ (error
+ "Unexpected function element %s in RHS %s of LHS %s"
+ rhs-element
+ rhs
+ lhs))
+ (unless (listp rhs-element)
+ (setq rhs-element (list rhs-element)))
+ (let ((sub-rhs-element-index 0)
+ (sub-rhs-element-length (length rhs-element))
+ (sub-rhs-element)
+ (new-rhs))
+ (while
+ (<
+ sub-rhs-element-index
+ sub-rhs-element-length)
+ (setq
sub-rhs-element
- new-rhs))
+ (nth
+ sub-rhs-element-index
+ rhs-element))
+ (if (and
+ (listp sub-rhs-element)
+ (functionp sub-rhs-element))
+ (setq
+ translation
+ sub-rhs-element)
+ (unless
+ (or
+ (parser-generator--valid-terminal-p sub-rhs-element)
+ (parser-generator--valid-non-terminal-p
sub-rhs-element)
+ (parser-generator--valid-e-p sub-rhs-element)
+ (parser-generator--valid-eof-p sub-rhs-element))
+ (error
+ "Element %s in RHS %s of production %s is not a valid
terminal, non-terminal, e-identifier or EOF-identifier!"
+ sub-rhs-element
+ rhs-element
+ lhs))
+ (push
+ sub-rhs-element
+ new-rhs))
+ (setq
+ sub-rhs-element-index
+ (1+ sub-rhs-element-index)))
(setq
- sub-rhs-element-index
- (1+ sub-rhs-element-index)))
+ production
+ (list
+ lhs
+ (reverse new-rhs)))
+ (message
+ "Production %s: %S"
+ production-index
+ production)
+ (push
+ (reverse new-rhs)
+ new-value)
+ (puthash
+ lhs
+ (reverse new-value)
+ parser-generator--table-productions-rhs))
(setq
+ rhs-element-index
+ (1+ rhs-element-index))
+ (puthash
production
- (list
- lhs
- (reverse new-rhs)))
- (message
- "Production %s: %S"
production-index
- production)
- (push
- (reverse new-rhs)
- new-value)
- (puthash
- lhs
- (reverse new-value)
- parser-generator--table-productions-rhs))
- (setq
- rhs-element-index
- (1+ rhs-element-index))
- (puthash
- production
- production-index
- parser-generator--table-productions-number)
- (puthash
- production-index
- production
- parser-generator--table-productions-number-reverse)
- (push
- production
- new-productions)
- (when translation
- (parser-generator--debug
- (message
- "Translation %s: %s"
- production-index
- translation))
+ parser-generator--table-productions-number)
(puthash
production-index
- translation
- parser-generator--table-translations))
- (setq
- production-index
- (1+ production-index))))))
+ production
+ parser-generator--table-productions-number-reverse)
+ (push
+ production
+ new-productions)
+ (when translation
+ (parser-generator--debug
+ (message
+ "Translation %S: %S"
+ production-index
+ translation))
+ (puthash
+ production-index
+ translation
+ parser-generator--table-translations))
+ (setq
+ production-index
+ (1+ production-index)))))))
(setq
new-productions
(nreverse new-productions))
