branch: externals/parser-generator
commit 1ccc742678f326d30aec02f944585b96142a9598
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
LLk parser passes translation tests
---
parser-generator-ll.el | 180 ++++++++++++++++++++++++---------------
test/parser-generator-ll-test.el | 73 +++++++++++++++-
2 files changed, 184 insertions(+), 69 deletions(-)
diff --git a/parser-generator-ll.el b/parser-generator-ll.el
index 9abda90a66..2012cfce19 100644
--- a/parser-generator-ll.el
+++ b/parser-generator-ll.el
@@ -88,13 +88,16 @@
(message "\n;; Completed generation of LL(k) tables.\n")
(message "\n;; Completed generation of LL(1) tables.\n"))))
-;; TODO Add support for translation via SDT here
-;; When a reduction is being made, push current stack and production-number to
a stack
-;; and record all popped terminals contents. When stack becomes previous state
again
-;; use terminals to call SDT for a translation
-;;
-;; Generally described at .p 339
(defun parser-generator-ll-parse ()
+ (let ((parse (parser-generator-ll--parse)))
+ (car parse)))
+
+(defun parser-generator-ll-translate ()
+ (let ((parse (parser-generator-ll--parse t)))
+ (car (cdr parse))))
+
+;; Generally described at .p 339
+(defun parser-generator-ll--parse (&optional translate-p)
"Parse input via lex-analyzer and return parse trail."
(let ((accept)
(stack
@@ -117,6 +120,7 @@
parser-generator--eof-identifier))
(e-reduction
(list parser-generator--e-identifier))
+ (translation)
(translation-stack)
(translation-symbol-table
(make-hash-table :test 'equal))
@@ -133,6 +137,7 @@
(look-ahead))
(parser-generator--debug
(message "\nstack: %S" stack)
+ (message "translation-stack: %S" translation-stack)
(message "output: %S" output)
(message "state: %S" state)
(message "state-action-table: %S" state-action-table))
@@ -171,10 +176,10 @@
'error
(list
(format
- "Invalid look-ahead '%S' in state: '%S', valid look-aheads: '%S'"
- look-ahead
- state
- possible-look-aheads)
+ "Invalid look-ahead '%S' in state: '%S', valid look-aheads:
'%S'"
+ look-ahead
+ state
+ possible-look-aheads)
look-ahead
state
possible-look-aheads))))
@@ -194,83 +199,111 @@
((equal action-type 'pop)
(parser-generator--debug
- (message "pushed: %S" look-ahead))
+ (message "popped: %S" look-ahead))
(let ((popped-tokens
(parser-generator-lex-analyzer--pop-token)))
+
+ ;; Is it time for SDT?
+ (when (and
+ translate-p
+ translation-stack
+ (string=
+ (car (car translation-stack))
+ (format "%S" stack)))
+ (let* ((translation-item (pop translation-stack))
+ (partial-translation
+ (parser-generator-ll--perform-translation
+ (nth 1 translation-item)
+ translation-symbol-table
+ (reverse (pop terminal-stack)))))
+ (setq
+ translation
+ partial-translation)))
+
(pop stack)
- (let ((token-data)
- (old-terminal-stack (car terminal-stack)))
- (dolist (popped-token popped-tokens)
+ (when translate-p
+ (let ((token-data)
+ (old-terminal-stack (car terminal-stack)))
+ (dolist (popped-token popped-tokens)
+ (push
+ popped-token
+ token-data))
(push
- popped-token
- token-data))
- (push
- token-data
- old-terminal-stack)
- (setf
- (car terminal-stack)
- old-terminal-stack))
-
- (message
- "pop token, translation-stack: %S vs %S"
- translation-stack
- stack
- )
+ token-data
+ old-terminal-stack)
+ (setf
+ (car terminal-stack)
+ old-terminal-stack)))
+
+ ;; Is it time for SDT?
+ (when (and
+ translate-p
+ translation-stack
+ (string=
+ (car (car translation-stack))
+ (format "%S" stack)))
+ (let* ((translation-item (pop translation-stack))
+ (partial-translation
+ (parser-generator-ll--perform-translation
+ (nth 1 translation-item)
+ translation-symbol-table
+ (reverse (pop terminal-stack)))))
+ (setq
+ translation
+ partial-translation)))
+
+ ))
+
+ ((equal action-type 'reduce)
+ (parser-generator--debug
+ (message "reduced: %S -> %S" state (nth 1 action)))
;; Is it time for SDT?
(when (and
+ translate-p
translation-stack
(string=
(car (car translation-stack))
(format "%S" stack)))
(let* ((translation-item (pop translation-stack))
- (translation
+ (partial-translation
(parser-generator-ll--perform-translation
(nth 1 translation-item)
translation-symbol-table
(reverse (pop terminal-stack)))))
- (message
- "Translation: %S"
- translation)
- ;; TODO Do something
- ))
-
- ))
-
- ((equal action-type 'reduce)
- (parser-generator--debug
- (message "reduced: %S -> %S" state (nth 1 action)))
+ (setq
+ translation
+ partial-translation)))
(pop stack)
;; Is it time for SDT?
(when (and
+ translate-p
translation-stack
(string=
(car (car translation-stack))
(format "%S" stack)))
(let* ((translation-item (pop translation-stack))
- (translation
+ (partial-translation
(parser-generator-ll--perform-translation
(nth 1 translation-item)
translation-symbol-table
(reverse (pop terminal-stack)))))
- (message
- "Translation: %S"
- translation)
- ;; TODO Do something
- ))
+ (setq
+ translation
+ partial-translation)))
- (push
- (list
- (format "%S" stack)
- (nth 2 action))
- translation-stack)
- (push
- '()
- terminal-stack)
- (message "translation-stack: %S" translation-stack)
+ (when translate-p
+ (push
+ (list
+ (format "%S" stack)
+ (nth 2 action))
+ translation-stack)
+ (push
+ '()
+ terminal-stack))
(unless (equal (nth 1 action) e-reduction)
(dolist (reduce-item (reverse (nth 1 action)))
@@ -281,7 +314,9 @@
((equal action-type 'accept)
(setq accept t))))))
- (reverse output)))
+ (list
+ (reverse output)
+ translation)))
(defun parser-generator-ll--perform-translation (production-number
symbol-table terminals)
"Perform translation by PRODUCTION-NUMBER, with SYMBOL-TABLE and TERMINALS."
@@ -295,7 +330,13 @@
(translation)
(args-1)
(args-2))
- (message "terminals: %S" terminals)
+ (parser-generator--debug
+ (message
+ "Perform translation %S %S %S = %S"
+ production-number
+ symbol-table
+ terminals
+ production-rhs))
;; Collect arguments for translation
(let ((terminal-index 0))
@@ -338,13 +379,14 @@
args-2
(reverse args-2))
- (message
- "Perform translation %d: %S -> %S via args-1: %S and args-2: %S"
- production-number
- production-lhs
- production-rhs
- args-1
- args-2)
+ (parser-generator--debug
+ (message
+ "Perform translation %d: %S -> %S via args-1: %S and args-2: %S"
+ production-number
+ production-lhs
+ production-rhs
+ args-1
+ args-2))
(if (parser-generator--get-grammar-translation-by-number
production-number)
@@ -354,10 +396,11 @@
production-number)
args-1
args-2)))
- (message
+ (parser-generator--debug
+ (message
"\ntranslation-symbol-table: %S = %S (processed)\n"
production-lhs
- partial-translation)
+ partial-translation))
(let ((symbol-translations
(gethash
production-lhs
@@ -380,10 +423,11 @@
(list
args-1
args-2)))
- (message
+ (parser-generator--debug
+ (message
"\ntranslation-symbol-table: %S = %S (generic)\n"
production-lhs
- partial-translation)
+ partial-translation))
(let ((symbol-translations
(gethash
production-lhs
diff --git a/test/parser-generator-ll-test.el b/test/parser-generator-ll-test.el
index 6f343569fa..d59f9ddbcb 100644
--- a/test/parser-generator-ll-test.el
+++ b/test/parser-generator-ll-test.el
@@ -412,6 +412,76 @@
(message "Passed tests for (parser-generator-ll-parse)"))
+(defun parser-generator-ll-test-translate ()
+ "Test `parser-generator-ll-translate'."
+ (message "Started tests for (parser-generator-ll-translate)")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S
+ (a A a a (lambda(a b) (format "alfa %s laval" (nth 1 a))))
+ (b A b a (lambda(a b) (format "delta %s laval" (nth 1 a))))
+ )
+ (A
+ (b (lambda(a b) "sven"))
+ (e (lambda(a b) "ingrid"))
+ )
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3) (a 3 . 4)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (should
+ (equal
+ "delta ingrid laval"
+ (parser-generator-ll-translate)))
+ (message "Passed translation test 1")
+
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3) (b 3 . 4) (a 4 . 5)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (should
+ (equal
+ "delta sven laval"
+ (parser-generator-ll-translate)))
+ (message "Passed translation test 2")
+
+ (message "Passed tests for (parser-generator-ll-translate)"))
+
(defun parser-generator-ll-test-generate-table ()
"Test `parser-generator-ll-generate-table'."
(message "Started tests for (parser-generator-ll-generate-table)")
@@ -741,7 +811,8 @@
;; Main stuff
(parser-generator-ll-test-generate-table)
- (parser-generator-ll-test-parse))
+ (parser-generator-ll-test-parse)
+ (parser-generator-ll-test-translate))
(provide 'parser-generator-ll-test)
