emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/parser-generator 1ccc742678 72/82: LLk parser passes tr


From: Christian Johansson
Subject: [elpa] externals/parser-generator 1ccc742678 72/82: LLk parser passes translation tests
Date: Thu, 12 May 2022 13:28:19 -0400 (EDT)

branch: externals/parser-generator
commit 1ccc742678f326d30aec02f944585b96142a9598
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]