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

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

[elpa] externals/parser-generator 2920af5 286/434: Parser is exported bu


From: ELPA Syncer
Subject: [elpa] externals/parser-generator 2920af5 286/434: Parser is exported but helper-functions are missing still
Date: Mon, 29 Nov 2021 15:59:59 -0500 (EST)

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

    Parser is exported but helper-functions are missing still
---
 parser-generator-lr.el | 389 ++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 372 insertions(+), 17 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 99f5de1..e0368a7 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -38,7 +38,7 @@
 (defun parser-generator-lr--export-parser (namespace)
   "Export parser with NAMESPACE."
 
-  ;; Make sure all requisites are defined 
+  ;; Make sure all requisites are defined
   (unless parser-generator-lr--action-tables
     (error "Missing generated ACTION-tables!"))
   (unless parser-generator-lr--goto-tables
@@ -80,49 +80,49 @@
       ;; 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  \"Generated 
action-tables.\")\n\n"
         namespace
         parser-generator-lr--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  \"Generated goto-tables.\")\n\n"
         namespace
         parser-generator-lr--goto-tables))
 
       ;; Table production-number
       (insert
        (format
-        "(defconst\n  %s-table-productions-number\n  %s\n  \"Hash-table of 
productions indexed by production-number.\")\n\n"
+        "(defconst\n  %s--table-productions-number\n  %s\n  \"Hash-table of 
productions indexed by production-number.\")\n\n"
         namespace
         parser-generator--table-productions-number))
 
       ;; 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  \"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  \"Hash-table of valid 
terminals.\")\n\n"
         namespace
         parser-generator--table-non-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  \"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  \"Hash-table of 
translations.\")\n\n"
         namespace
         parser-generator--table-translations))
 
@@ -159,21 +159,21 @@
       ;; E-identifier
       (insert
        (format
-        "(defconst\n  %s-e-identifier\n  '%s\n  \"e-identifier\")\n\n"
+        "(defconst\n  %s--e-identifier\n  '%s\n  \"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  \"EOF-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  \"Look-ahead 
number.\")\n\n"
         namespace
         parser-generator--look-ahead-number))
 
@@ -224,7 +224,7 @@
       (insert
        (format "
 (defun
-  %s-lex-analyzer-reset
+  %s-lex-analyzer--reset
   ()
   \"Reset Lex-Analyzer.\"
   (setq 
@@ -233,7 +233,7 @@
   (when 
     %s-lex-analyzer--reset-function
     (funcall 
-      %s-lex-analyzer--reset-function)))\n\n"
+      %s-lex-analyzer--reset-function)))\n"
                namespace
                namespace
                namespace
@@ -251,7 +251,7 @@
         (index %s-lex-analyzer--index)
         (k (max
             1
-            %s-look-ahead-number)))
+            %s--look-ahead-number)))
     (while (<
             look-ahead-length
             k)
@@ -272,7 +272,7 @@
                         (push next-look-ahead-item look-ahead)
                         (setq look-ahead-length (1+ look-ahead-length))
                         (setq index (cdr (cdr next-look-ahead-item))))))
-                (push (list %s-eof-identifier) look-ahead)
+                (push (list %s--eof-identifier) look-ahead)
                 (setq look-ahead-length (1+ look-ahead-length))
                 (setq index (1+ index)))))"
                namespace
@@ -322,12 +322,367 @@
                 %s-lex-analyzer--index
                 (car (cdr error)))))
       (setq iteration (1+ iteration)))
-    (nreverse tokens)))\n\n"
+    (nreverse tokens)))\n"
                       namespace))
 
       (insert "\n;;; Syntax-Analyzer / Parser:\n\n\n");
 
-      ;; TODO Functions
+      (insert
+       (format "
+(defun 
+  %s--parse
+  (&optional 
+    input-tape-index
+    pushdown-list
+    output
+    translation
+    translation-symbol-table
+    history)
+  \"Perform a LR-parse via lex-analyzer, optionally at INPUT-TAPE-INDEX with 
PUSHDOWN-LIST, OUTPUT, TRANSLATION, TRANSLATION-SYMBOL-TABLE and HISTORY.\"
+  (unless input-tape-index
+    (setq input-tape-index 1))
+  (unless pushdown-list
+    (push 0 pushdown-list))
+  (unless translation-symbol-table
+    (setq
+     translation-symbol-table
+     (make-hash-table :test 'equal)))
+
+  (if (and
+       input-tape-index
+       (> input-tape-index 1))
+      (setq
+       %s-lex-analyzer--index
+       input-tape-index)
+    (%s-lex-analyzer--reset))
+
+  (let ((accept)
+        (pre-index 0))
+    (while (not accept)
+
+      ;; Save history when index has changed to enable incremental parsing / 
translating
+      (when
+          (>
+           %s-lex-analyzer--index
+           pre-index)
+        (push
+         `(,%s-lex-analyzer--index
+           ,pushdown-list
+           ,output
+           ,translation
+           ,translation-symbol-table)
+         history)
+        (setq
+         pre-index
+         %s-lex-analyzer--index))
+
+      ;; (1) The look-ahead string u, consisting of the next k input symbols, 
is determined.
+      (let ((look-ahead
+             (%s-lex-analyzer--peek-next-look-ahead))
+            (look-ahead-full))
+
+        ;; Save token stream indexes in separate variable if needed later
+        (setq look-ahead-full look-ahead)
+
+        ;; Create simplified look-ahead for logic below
+        (setq look-ahead nil)
+        (dolist (look-ahead-item look-ahead-full)
+          (if (listp look-ahead-item)
+              (push (car look-ahead-item) look-ahead)
+            (push look-ahead-item look-ahead)))
+        (setq look-ahead (nreverse look-ahead))
+
+        (let ((table-index
+               (car pushdown-list)))
+          (let ((action-table
+                 (gethash
+                  table-index
+                  %s--action-tables)))"
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace
+               namespace))
+      (insert "
+            (unless action-table
+              (error
+               \"Action-table with index %s is empty! Push-down-list: %s\"
+               table-index
+               pushdown-list))")
+
+      (insert
+       (format "
+            (let ((action-match nil)
+                  (action-table-length (length action-table))
+                  (action-index 0)
+                  (possible-look-aheads))
+
+              ;; (2) The parsing action f of the table on top of the pushdown 
list is applied to the lookahead string u.
+              (while (and
+                      (not action-match)
+                      (< action-index action-table-length))
+                (let ((action (nth action-index action-table)))
+                  (let ((action-look-ahead (car action)))
+                    (push
+                     action-look-ahead
+                     possible-look-aheads)
+                    (when
+                        (equal
+                         action-look-ahead
+                         look-ahead)
+                      (setq
+                       action-match
+                       (cdr action)))
+                    (when
+                        (and
+                         (=
+                          %s--look-ahead-number
+                          0)
+                         (not
+                          action-look-ahead))
+                      ;; LR(0) reduce actions occupy entire row
+                      ;; and is applied regardless of look-ahead
+                      (setq
+                       action-match
+                       (cdr action))))
+                  (setq
+                   action-index
+                   (1+ action-index))))
+
+              (unless action-match
+                ;; (c) If f(u) = error, we halt parsing (and, in practice
+                ;; transfer to an error recovery routine)."
+               namespace))
+      (insert "
+                (error
+                 (format
+                  \"Invalid syntax! Expected one of %s found %s at %s\"
+                  possible-look-aheads
+                  look-ahead")
+      (insert (format "
+                  %s-lex-analyzer--index)
+                 possible-look-aheads
+                 look-ahead
+                 %s-lex-analyzer--index))
+
+              (cond
+
+               ((equal action-match '(shift))
+                ;; (a) If f(u) = shift, then the next input symbol, say a
+                ;; is removed from the input and shifted onto the pushdown 
list.
+                ;; The goto function g of the table on top of the pushdown list
+                ;; is applied to a to determine the new table to be placed on
+                ;; top of the pushdown list. We then return to step(1). If
+                ;; there is no next input symbol or g(a) is undefined, halt
+                ;; and declare error.
+
+                (let ((a (list (car look-ahead)))
+                      (a-full (list (car look-ahead-full))))
+                  (let ((goto-table
+                         (gethash
+                          table-index
+                          %s--goto-tables)))
+                    (let ((goto-table-length (length goto-table))
+                          (goto-index 0)
+                          (searching-match t)
+                          (next-index)
+                          (possible-look-aheads))
+
+                      (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))))
+                            (push goto-item-symbol possible-look-aheads)
+
+                            (when (equal
+                                   goto-item-symbol
+                                   a)
+                              (setq next-index goto-item-next-index)
+                              (setq searching-match nil))))
+
+                        (setq goto-index (1+ goto-index)))"
+                      namespace
+                      namespace
+                      namespace))
+
+      (insert "
+                      (unless next-index
+                        (error
+                         \"In shift, found no GOTO-item for %s at %s, expected 
one of %s\"
+                         a")
+      (insert
+       (format "
+                         %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)))))
+
+               ((equal (car action-match) 'reduce)
+                ;; (b) If f(u) = reduce i and production i is A -> a,
+                ;; then 2|a| symbols are removed from the top of the pushdown
+                ;; list, and production number i is placed in the output
+                ;; buffer. A new table T' is then exposed as the top table
+                ;; of the pushdown list, and the goto function of T' is applied
+                ;; to A to determine the next table to be placed on top of the
+                ;; pushdown list. We place A and this new table on top of the
+                ;; the pushdown list and return to step (1)
+
+                (let ((production-number (car (cdr action-match))))
+
+                  (let ((production
+                         (%s--get-grammar-production-by-number
+                          production-number)))
+                    (let ((production-lhs (car production))
+                          (production-rhs (car (cdr production)))
+                          (popped-items-contents))
+                      (unless (equal
+                               production-rhs
+                               (list %s--e-identifier))
+                        (let ((pop-items (* 2 (length production-rhs)))
+                              (popped-items 0)
+                              (popped-item))
+                          (while (< popped-items pop-items)
+                            (setq popped-item (pop pushdown-list))
+                            (when (and
+                                   (listp popped-item)
+                                   (%s--valid-symbol-p
+                                    (car popped-item)))
+                              (push
+                               popped-item
+                               popped-items-contents))
+                            (setq popped-items (1+ popped-items)))))
+                      (push production-number output)
+
+                      (let ((popped-items-meta-contents)
+                            (all-expanded t))
+                        ;; Collect arguments for translation
+                        (dolist (popped-item popped-items-contents)
+                          (if (and
+                               (listp popped-item)
+                               (cdr popped-item))
+                              ;; If item is a terminal, use it's literal value
+                              (push
+                               (%s-lex-analyzer--get-function
+                                popped-item)
+                               popped-items-meta-contents)
+                            (if (gethash
+                                 popped-item
+                                 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))
+
+                        ;; 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
+                            (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)))
+                        (let ((goto-table
+                               (gethash
+                                new-table-index
+                                %s--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))
+
+      (insert "
+               (t (error
+                   \"Invalid action-match: %s!\"
+                   action-match))))))))
+    (unless accept
+      (error
+       \"Parsed entire string without getting accepting! Output: %s\"
+       (reverse output)))
+    (when history
+      (setq history (reverse history)))
+    (when output
+      (setq output (reverse output)))
+    (list
+     output
+     translation
+     translation-symbol-table
+     history)))\n\n")
 
 
       ;; Footer



reply via email to

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