[elpa] externals/parser-generator 08af836006 69/82: More work on SDT for LL grammar

[Christian Johansson]

branch: externals/parser-generator
commit 08af836006e721a90e322191d8e1b2052279693d
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>

    More work on SDT for LL grammar
---
 parser-generator-ll.el | 78 ++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 63 insertions(+), 15 deletions(-)

diff --git a/parser-generator-ll.el b/parser-generator-ll.el
index cae577329f..f7095513a4 100644
--- a/parser-generator-ll.el
+++ b/parser-generator-ll.el
@@ -118,6 +118,8 @@
         (e-reduction
          (list parser-generator--e-identifier))
         (translation-stack)
+        (translation-symbol-table
+         (make-hash-table :test 'equal))
         (terminal-stack '()))
     (parser-generator-lex-analyzer--reset)
     (while (not accept)
@@ -213,40 +215,56 @@
                  (car terminal-stack)
                  old-terminal-stack))
 
+              (message
+               "pop token, translation-stack: %S vs %S"
+               translation-stack
+               stack
+               )
+
             ;; Is it time for SDT?
             (when (and
                    translation-stack
                    (string=
-                    (format "%S" (car (car translation-stack)))
+                    (car (car translation-stack))
                     (format "%S" stack)))
-              (let ((translation (pop translation-stack))
-                    (sdt-terminal-stack (pop terminal-stack)))
+              (let* ((translation-item (pop translation-stack))
+                     (translation
+                      (parser-generator-ll--perform-translation
+                       (nth 1 translation-item)
+                       translation-symbol-table
+                       (pop terminal-stack))))
                 (message
-                 "Do SDT %S (%S)"
-                 translation
-                 sdt-terminal-stack)
+                 "Translation: %S"
+                 translation)
                 ;; TODO Do something
-              ))))
+                ))
+
+            ))
 
            ((equal action-type 'reduce)
             (parser-generator--debug
              (message "reduced: %S -> %S" state (nth 1 action)))
-            (pop stack)
 
             ;; Is it time for SDT?
             (when (and
                    translation-stack
                    (string=
-                    (format "%S" (car (car translation-stack)))
+                    (car (car translation-stack))
                     (format "%S" stack)))
-              (let ((translation (pop translation-stack))
-                    (sdt-terminal-stack (pop terminal-stack)))
+              (let* ((translation-item (pop translation-stack))
+                     (translation
+                      (parser-generator-ll--perform-translation
+                       (nth 1 translation-item)
+                       translation-symbol-table
+                       (pop terminal-stack))))
                 (message
-                 "Do SDT %S (%S)"
-                 translation
-                 sdt-terminal-stack)
+                 "Translation: %S"
+                 translation)
                 ;; TODO Do something
-              ))
+                ))
+
+            (pop stack)
+
 
             (push
              (list
@@ -256,6 +274,7 @@
             (push
              '()
              terminal-stack)
+            (message "translation-stack: %S" translation-stack)
 
             (unless (equal (nth 1 action) e-reduction)
               (dolist (reduce-item (reverse (nth 1 action)))
@@ -268,6 +287,35 @@
             (setq accept t))))))
     (reverse output)))
 
+(defun parser-generator-ll--perform-translation (production-number 
symbol-table terminals)
+  "Perform translation by PRODUCTION-NUMBER, with SYMBOL-TABLE and TERMINALS."
+  (let* ((production
+         (parser-generator--get-grammar-production-by-number
+          production-number))
+         (production-lhs
+          (car (nth 0 production)))
+         (production-rhs
+          (nth 1 production))
+        (translation))
+    (message
+     "Perform translation %d: %S -> %S via args: %S"
+     production-number
+     production-lhs
+     production-rhs
+     terminals)
+    (let ((old-symbol-value
+           (gethash
+            production-lhs
+            symbol-table)))
+      (push
+       translation
+       old-symbol-value)
+      (puthash
+       production-lhs
+       old-symbol-value
+       symbol-table))
+    translation))
+
 
 ;;; Algorithms