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

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

[elpa] externals/parser-generator 9e8b89b 392/434: More work on exportin


From: ELPA Syncer
Subject: [elpa] externals/parser-generator 9e8b89b 392/434: More work on exporting LR-parser
Date: Mon, 29 Nov 2021 16:00:23 -0500 (EST)

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

    More work on exporting LR-parser
---
 parser-generator-lr-export.el           | 349 +++++++++++++++++++++-----------
 test/parser-generator-lr-export-test.el |  13 +-
 2 files changed, 237 insertions(+), 125 deletions(-)

diff --git a/parser-generator-lr-export.el b/parser-generator-lr-export.el
index a90a392..2862221 100644
--- a/parser-generator-lr-export.el
+++ b/parser-generator-lr-export.el
@@ -52,73 +52,73 @@
        (format
         ";;; %s.el --- Exported Emacs Parser Generator -*- lexical-binding: t 
-*-\n\n\n"
         namespace))
-      (insert ";;; Commentary:\n\n\n;;; Code:\n\n\n")
+      (insert ";;; Commentary:\n\n\n;;; Code:\n\n")
 
-      (insert ";;; Constants:\n\n\n")
+      (insert "\n;;; Constants:\n\n\n")
 
       ;; Action-tables
       (insert
        (format
-        "(defconst\n  %s--action-tables\n  %S\n  \"Generated 
action-tables.\")\n\n"
+        "(defconst\n  %s--action-tables\n  %S\n  \"The generated 
action-tables.\")\n\n"
         namespace
         parser-generator-lr--action-tables))
       (insert
        (format
-        "(defconst\n  %s--distinct-action-tables\n  %S\n  \"Generated distinct 
action-tables.\")\n\n"
+        "(defconst\n  %s--distinct-action-tables\n  %S\n  \"The generated 
distinct action-tables.\")\n\n"
         namespace
         parser-generator-lr--distinct-action-tables))
 
       ;; Goto-tables
       (insert
        (format
-        "(defconst\n  %s--goto-tables\n  %S\n  \"Generated goto-tables.\")\n\n"
+        "(defconst\n  %s--goto-tables\n  %S\n  \"The generated 
goto-tables.\")\n\n"
         namespace
         parser-generator-lr--goto-tables))
       (insert
        (format
-        "(defconst\n  %s--distinct-goto-tables\n  %S\n  \"Generated distinct 
goto-tables.\")\n\n"
+        "(defconst\n  %s--distinct-goto-tables\n  %S\n  \"The generated 
distinct goto-tables.\")\n\n"
         namespace
         parser-generator-lr--distinct-goto-tables))
 
       ;; Table production-number
       (insert
        (format
-        "(defconst\n  %s--table-productions-number-reverse\n  %S\n  
\"Hash-table indexed by production-number and value is production.\")\n\n"
+        "(defconst\n  %s--table-productions-number-reverse\n  %S\n  \"The 
hash-table indexed by production-number and value is production.\")\n\n"
         namespace
         parser-generator--table-productions-number-reverse))
 
       ;; Table look-aheads
       (insert
        (format
-        "(defconst\n  %s--table-look-aheads\n  %S\n  \"Hash-table of valid 
look-aheads.\")\n\n"
+        "(defconst\n  %s--table-look-aheads\n  %S\n  \"The hash-table of valid 
look-aheads.\")\n\n"
         namespace
         parser-generator--table-look-aheads-p))
 
       ;; Table terminals
       (insert
        (format
-        "(defconst\n  %s--table-terminal-p\n  %S\n  \"Hash-table of valid 
terminals.\")\n\n"
+        "(defconst\n  %s--table-terminal-p\n  %S\n  \"The hash-table of valid 
terminals.\")\n\n"
         namespace
         parser-generator--table-terminal-p))
 
       ;; Table non-terminals
       (insert
        (format
-        "(defconst\n  %s--table-non-terminal-p\n  %S\n  \"Hash-table of valid 
non-terminals.\")\n\n"
+        "(defconst\n  %s--table-non-terminal-p\n  %S\n  \"The hash-table of 
valid non-terminals.\")\n\n"
         namespace
         parser-generator--table-non-terminal-p))
 
       ;; Table translations
       (insert
        (format
-        "(defconst\n  %s--table-translations\n  %S\n  \"Hash-table of 
translations.\")\n\n"
+        "(defconst\n  %s--table-translations\n  %S\n  \"The hash-table of 
translations.\")\n\n"
         namespace
         parser-generator--table-translations))
 
       ;; Lex-Analyzer Get Function
       (insert
        (format
-        "(defconst\n  %s-lex-analyzer--get-function\n  (lambda %S %S)\n  
\"Lex-Analyzer Get Function.\")\n\n"
+        "(defconst\n  %s-lex-analyzer--get-function\n  (lambda %S %S)\n  \"The 
lex-analyzer get function.\")\n\n"
         namespace
         (nth 2 parser-generator-lex-analyzer--get-function)
         (nth 3 parser-generator-lex-analyzer--get-function)))
@@ -126,7 +126,7 @@
       ;; Lex-Analyzer Function
       (insert
        (format
-        "(defconst\n  %s-lex-analyzer--function\n  (lambda %S %S)\n  
\"Lex-Analyzer Function.\")\n\n"
+        "(defconst\n  %s-lex-analyzer--function\n  (lambda %S %S)\n  \"The 
lex-analyzer function.\")\n\n"
         namespace
         (nth 2 parser-generator-lex-analyzer--function)
         (nth 3 parser-generator-lex-analyzer--function)))
@@ -143,40 +143,40 @@
             (nth 2 parser-generator-lex-analyzer--reset-function)
             (nth 3 parser-generator-lex-analyzer--reset-function)))
         (insert "nil\n"))
-      (insert "  \"Lex-Analyzer Reset Function.\")\n\n")
+      (insert "  \"The lex-analyzer reset function.\")\n\n")
 
       ;; E-identifier
       (insert
        (format
-        "(defconst\n  %s--e-identifier\n  '%S\n  \"e-identifier\")\n\n"
+        "(defconst\n  %s--e-identifier\n  '%S\n  \"The e-identifier.\")\n\n"
         namespace
         parser-generator--e-identifier))
 
       ;; EOF-identifier
       (insert
        (format
-        "(defconst\n  %s--eof-identifier\n  '%S\n  \"EOF-identifier.\")\n\n"
+        "(defconst\n  %s--eof-identifier\n  '%S\n  \"The 
end-of-file-identifier.\")\n\n"
         namespace
         parser-generator--eof-identifier))
 
       ;; Look-ahead number
       (insert
        (format
-        "(defconst\n  %s--look-ahead-number\n  %S\n  \"Look-ahead 
number.\")\n\n"
+        "(defconst\n  %s--look-ahead-number\n  %S\n  \"The look-ahead 
number.\")\n\n"
         namespace
         parser-generator--look-ahead-number))
 
-      (insert "\n;;; Variables:\n\n\n")
+      (insert "\n;;; Variables:\n\n")
 
       ;; Lex-analyzer index
       (insert
        (format
-        "(defvar-local\n  %s-lex-analyzer--index\n  0\n  \"Current index of 
lex-analyzer.\")\n\n"
+        "(defvar-local\n  %s-lex-analyzer--index\n  0\n  \"The current index 
of the lex-analyzer.\")\n\n"
         namespace))
 
-      (insert "\n;;; Functions:\n\n\n")
+      (insert "\n;;; Functions:\n\n")
 
-      (insert ";;; Lex-Analyzer:\n\n\n")
+      (insert "\n;;; Lex-Analyzer:\n\n")
 
       ;; Lex-Analyzer Get Function
       (insert
@@ -196,10 +196,10 @@
         namespace
         namespace))
       (insert "
-      (error
+      (error (error
         \"Lex-analyze failed to get token meta-data of %s, error: %s\"
         token
-        (car (cdr error))))
+        (car (cdr error)))))
     (unless meta-information
       (error \"Could not find any token meta-information for: %s\" token))
     meta-information))\n")
@@ -309,7 +309,7 @@
     (nreverse tokens)))\n"
                       namespace))
 
-      (insert "\n;;; Syntax-Analyzer / Parser:\n\n\n");
+      (insert "\n\n;;; Syntax-Analyzer / Parser:\n\n");
 
       ;; Get grammar production by number
       (insert
@@ -443,6 +443,16 @@
          input-tape-index)
       (%s-lex-analyzer--reset))
 
+    ;; Make sure tables exists
+    (unless %s--action-tables
+      (error \"Missing action-tables for grammar!\"))
+    (unless %s--distinct-action-tables
+      (error \"Missing distinct GOTO-tables for grammar!\"))
+    (unless %s--goto-tables
+      (error \"Missing GOTO-tables for grammar!\"))
+    (unless %s--distinct-goto-tables
+      (error \"Missing distinct GOTO-tables for grammar!\"))
+
     (let ((accept)
           (pre-index 0))
       (while (not accept)
@@ -506,7 +516,14 @@
                namespace
                namespace
                namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
                namespace))
+
       (insert "
               (unless action-table
                 (error
@@ -626,7 +643,6 @@
                            %s-lex-analyzer--index
                            possible-look-aheads))
 
-                        ;; Maybe push both tokens here?
                         (push (car a-full) pushdown-list)
                         (push next-index pushdown-list)
                         (%s-lex-analyzer--pop-token))))))
@@ -667,8 +683,10 @@
                               (setq popped-items (1+ popped-items)))))
                         (push production-number output)
 
-                        (let ((popped-items-meta-contents)
-                              (all-expanded t))
+                        (let ((popped-items-meta-contents))
+                          (setq
+                           popped-items-contents
+                           (reverse popped-items-contents))
                           ;; Collect arguments for translation
                           (dolist (popped-item popped-items-contents)
                             (if (and
@@ -678,55 +696,145 @@
                                 (push
                                  (%s-lex-analyzer--get-function
                                   popped-item)
-                                 popped-items-meta-contents)
+                                 popped-items-meta-contents)"
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace))
+
+      (insert "
+
+                              ;; If item is a non-terminal
+                              (let ((temp-hash-key
+                                     (format
+                                      \"%S\"
+                                       popped-item)))
+")
+
+      (insert (format "
+                                  ;; If we have a translation for symbol, pop 
one
+                                  ;; otherwise push nil on translation 
argument stack
                               (if (gethash
-                                   popped-item
+                                   temp-hash-key
                                    translation-symbol-table)
-                                  (push
-                                   (gethash
-                                    popped-item
-                                    translation-symbol-table)
-                                   popped-items-meta-contents)
-                                (setq
-                                 all-expanded
-                                 nil)
-                                (push
-                                 nil
-                                 popped-items-meta-contents))))
-                          (setq
-                           popped-items-meta-contents
-                           (nreverse popped-items-meta-contents))
+                                  (let ((symbol-translations
+                                         (gethash
+                                          temp-hash-key
+                                          translation-symbol-table)))
+                                    (push
+                                     partial-translation
+                                     symbol-translations)
+                                    (puthash
+                                     temp-hash-key
+                                     symbol-translations
+                                     translation-symbol-table)
+                                    (setq
+                                     translation
+                                     partial-translation))))))
+
+                          ;; If we have a translation for symbol, pop one
+                                  ;; otherwise push nil on translation 
argument stack
+                                  (if (gethash
+                                       temp-hash-key
+                                       translation-symbol-table)
+                                      (let ((symbol-translations
+                                             (gethash
+                                              temp-hash-key
+                                              translation-symbol-table)))
+                                        (let ((symbol-translation
+                                               (pop symbol-translations)))
+                                          (push
+                                           symbol-translation
+                                           popped-items-meta-contents)
+                                          (puthash
+                                           temp-hash-key
+                                           symbol-translations
+                                           translation-symbol-table)))
+                                    (push
+                                     nil
+                                     popped-items-meta-contents)))))
+
+                            ;; If we just have one argument, pass it as a 
instead of a list
+                            (when (= (length popped-items-meta-contents) 1)
+                              (setq
+                               popped-items-meta-contents
+                               (car popped-items-meta-contents)))
+
+                            ;; Perform translation at reduction if specified
+                            (if
+                                
(parser-generator--get-grammar-translation-by-number
+                                 production-number)
+                                (let ((partial-translation
+                                       (funcall
+                                        
(parser-generator--get-grammar-translation-by-number
+                                         production-number)
+                                        popped-items-meta-contents)))"
+                      namespace
+                      namespace
+                      namespace
+                      namespace
+                      namespace
+                      namespace))
 
-                          ;; Perform translation at reduction if specified
-                          (if
-                              (%s--get-grammar-translation-by-number
-                               production-number)
-                              (let ((partial-translation
-                                     (funcall
-                                      (%s--get-grammar-translation-by-number
-                                       production-number)
-                                      popped-items-meta-contents)))
-                                (puthash
-                                 production-lhs
-                                 partial-translation
-                                 translation-symbol-table)
-                                (setq
-                                 translation
-                                 partial-translation))
-
-                            ;; When no translation is specified just use 
arguments as translation
-                            (when all-expanded
+      (insert "
+                                  (let ((temp-hash-key
+                                         (format
+                                          \"%S\"
+                                          production-lhs)))")
+
+      (insert (format "
+                                    (let ((symbol-translations
+                                           (gethash
+                                            temp-hash-key
+                                            translation-symbol-table)))
+                                      (push
+                                       partial-translation
+                                       symbol-translations)
+                                      (puthash
+                                       temp-hash-key
+                                       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))
-                                (puthash
-                                 production-lhs
-                                 partial-translation
-                                 translation-symbol-table)
-                                (setq
-                                 translation
-                                 partial-translation)))))
-
-                        (let ((new-table-index (car pushdown-list)))
+                                     popped-items-meta-contents))"
+                                          namespace
+                                          namespace
+                                          namespace
+                                          namespace
+                                          namespace
+                                          namespace
+                                          namespace))
+               (insert "
+                                (let ((temp-hash-key
+                                       (format
+                                        \"%S\"
+                                        production-lhs)))")
+
+               (insert (format "
+                                  (let ((symbol-translations
+                                         (gethash
+                                          temp-hash-key
+                                          translation-symbol-table)))
+                                    (push
+                                     partial-translation
+                                     symbol-translations)
+                                    (puthash
+                                     temp-hash-key
+                                     symbol-translations
+                                     translation-symbol-table)
+                                    (setq
+                                     translation
+                                     partial-translation))))))
+
+                          (let ((new-table-index (car pushdown-list)))
                             (let ((goto-table-distinct-index
                                    (gethash
                                     new-table-index
@@ -735,52 +843,41 @@
                                      (gethash
                                       goto-table-distinct-index
                                       %s--distinct-goto-tables)))
-                            (let ((goto-table-length
-                                   (length goto-table))
-                                  (goto-index 0)
-                                  (searching-match t)
-                                  (next-index))
-
-                              (while (and
-                                      searching-match
-                                      (< goto-index goto-table-length))
-                                (let ((goto-item (nth goto-index goto-table)))
-                                  (let ((goto-item-symbol (list (car 
goto-item)))
-                                        (goto-item-next-index (car (cdr 
goto-item))))
-
-                                    (when (equal
-                                           goto-item-symbol
-                                           production-lhs)
-                                      (setq next-index goto-item-next-index)
-                                      (setq searching-match nil))))
-
-                                (setq goto-index (1+ goto-index)))
-
-                              (when next-index
-                                (push production-lhs pushdown-list)
-                                (push next-index pushdown-list))))))))))
-
-                 ((equal action-match '(accept))
-                  ;;    (d) If f(u) = accept, we halt and declare the string
-                  ;;    in the output buffer to be the right parse of the 
original
-                  ;;    input string.
-
-                  (setq accept t))"
-               namespace
-               namespace
-               namespace
-               namespace
-               namespace
-               namespace
-               namespace
-               namespace
-               namespace
-               namespace))
-
-      (insert "
-                 (t (error
-                     \"Invalid action-match: %s!\"
-                     action-match)))))))))
+                                (let ((goto-table-length
+                                       (length goto-table))
+                                      (goto-index 0)
+                                      (searching-match t)
+                                      (next-index))
+
+                                  (while (and
+                                          searching-match
+                                          (< goto-index goto-table-length))
+                                    (let ((goto-item (nth goto-index 
goto-table)))
+                                      (let ((goto-item-symbol (list (car 
goto-item)))
+                                            (goto-item-next-index (car (cdr 
goto-item))))
+
+                                        (when (equal
+                                               goto-item-symbol
+                                               production-lhs)
+                                          (setq next-index 
goto-item-next-index)
+                                          (setq searching-match nil))))
+
+                                    (setq goto-index (1+ goto-index)))
+
+                                  (when next-index
+                                    (push production-lhs pushdown-list)
+                                    (push next-index pushdown-list))))))))))
+
+                   ((equal action-match '(accept))
+                    ;;    (d) If f(u) = accept, we halt and declare the string
+                    ;;    in the output buffer to be the right parse of the 
original
+                    ;;    input string.
+
+                    (setq accept t))
+
+                   (t (error
+                       \"Invalid action-match: %s!\"
+                       action-match)))))))))
       (unless accept
         (error
          \"Parsed entire string without getting accepting! Output: %s\"
@@ -801,7 +898,19 @@
          output
          translation
          translation-symbol-table-list
-         history)))))\n")
+         history)))))"
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               ))
 
       ;; Parse
       (insert
@@ -823,6 +932,8 @@
           history)))
     (nth 0 result)))\n"
                namespace
+               namespace
+               namespace
                namespace))
 
       ;; Translate
diff --git a/test/parser-generator-lr-export-test.el 
b/test/parser-generator-lr-export-test.el
index 0d8b30a..b9a7558 100644
--- a/test/parser-generator-lr-export-test.el
+++ b/test/parser-generator-lr-export-test.el
@@ -176,22 +176,22 @@
   (message "Passed parse before export")
 
   ;; Export parser
-  (let ((export (parser-generator-lr-export-to-elisp "e--")))
+  (let ((export (parser-generator-lr-export-to-elisp "e")))
+
+    (message "export:\n%S\n" export)
 
-    (parser-generator--debug
-     (message "export:\n%s\n" export))
     (with-temp-buffer
       (insert export)
       (eval-buffer)
       (should
        (equal
         t
-        (fboundp 'e---parse)))
-      (when (fboundp 'e---parse)
+        (fboundp 'e-parse)))
+      (when (fboundp 'e-parse)
         (should
          (equal
           '(2 2 2 1 1)
-          (e---parse))))
+          (e-parse))))
       (message "Passed parse for exported parser")))
 
   (let ((buffer (generate-new-buffer "*a*")))
@@ -232,6 +232,7 @@
     ;; Export parser
     (let ((export (parser-generator-lr-export-to-elisp "fa")))
       (with-temp-buffer
+        (message "Export:\n%S" export)
         (insert export)
         (eval-buffer)
         (should



reply via email to

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