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

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

[elpa] externals/phps-mode f4c9f8b 04/96: Added generated parser


From: Christian Johansson
Subject: [elpa] externals/phps-mode f4c9f8b 04/96: Added generated parser
Date: Fri, 29 Oct 2021 11:14:26 -0400 (EDT)

branch: externals/phps-mode
commit f4c9f8bc649957904996bff819e44321b24d527d
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>

    Added generated parser
---
 phps-mode-parser.el | 704 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 704 insertions(+)

diff --git a/phps-mode-parser.el b/phps-mode-parser.el
new file mode 100644
index 0000000..bc5befb
--- /dev/null
+++ b/phps-mode-parser.el
@@ -0,0 +1,704 @@
+;;; phps-mode-parser.el --- Exported Emacs Parser Generator -*- 
lexical-binding: t -*-
+
+
+;;; Commentary:
+
+
+;;; Code:
+
+
+;;; Constants:
+
+
+(defconst
+  phps-mode-parser--action-tables
+  #s(hash-table size 42072 test equal rehash-size 1.5 rehash-threshold 0.8125 
data (0 0 1 1 2 2 3 3 4 4 5 2 6 2 7 2 8 2 9 9 10 10 11 2 12 12 13 2 14 14 15 15 
16 16 17 2 18 18 19 19 20 14 21 21 22 10 23 23 24 24 25 25 26 2 27 2 28 10 29 
10 30 30 31 31 32 32 33 33 34 10 35 10 36 36 37 37 38 38 39 18 40 10 41 10 42 
21 43 2 44 2 45 45 46 46 47 2 48 10 49 49 50 10 51 51 52 10 53 53 54 54 55 55 
56 56 57 57 58 58 59 59 60 2 61 2 62 2 63 2 64 14 65 65 66 66 67 67 68 2 69 10 
70 2 71 71 72 72 73 7 [...]
+  "The generated action-tables.")
+
+(defconst
+  phps-mode-parser--distinct-action-tables
+  #s(hash-table size 18699 test equal rehash-size 1.5 rehash-threshold 0.8125 
data (0 ((("!") reduce 80) (("\"") reduce 80) (($) reduce 80) (("$") reduce 80) 
(("(") reduce 80) (("+") reduce 80) (("-") reduce 80) (("@") reduce 80) 
((T_ABSTRACT) reduce 80) ((T_ARRAY) reduce 80) ((T_ARRAY_CAST) reduce 80) 
((T_ATTRIBUTE) reduce 80) ((T_BOOL_CAST) reduce 80) ((T_BREAK) reduce 80) 
((T_CLASS) reduce 80) ((T_CLASS_C) reduce 80) ((T_CLONE) reduce 80) ((T_CONST) 
reduce 80) ((T_CONSTANT_ENCAPSED_ST [...]
+  "The generated distinct action-tables.")
+
+(defconst
+  phps-mode-parser--goto-tables
+  #s(hash-table size 42072 test equal rehash-size 1.5 rehash-threshold 0.8125 
data (0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10 11 11 12 12 13 13 14 14 15 
9 16 9 17 15 18 16 19 9 20 17 21 18 22 19 23 9 24 9 25 20 26 21 27 22 28 23 29 
24 30 25 31 9 32 9 33 9 34 26 35 27 36 9 37 9 38 28 39 29 40 30 41 31 42 32 43 
33 44 34 45 9 46 9 47 35 48 36 49 9 50 37 51 9 52 38 53 9 54 39 55 9 56 9 57 9 
58 40 59 9 60 41 61 42 62 43 63 44 64 45 65 46 66 47 67 48 68 49 69 50 70 51 71 
9 72 9 73 52 74 53 [...]
+  "The generated goto-tables.")
+
+(defconst
+  phps-mode-parser--distinct-goto-tables
+  #s(hash-table size 18699 test equal rehash-size 1.5 rehash-threshold 0.8125 
data (0 ((top_statement_list 1)) 1 (("!" 2) ("\"" 3) ("$" 4) ("(" 5) ("+" 6) 
("-" 7) ("@" 8) (T_ABSTRACT 9) (T_ARRAY 10) (T_ARRAY_CAST 11) (T_ATTRIBUTE 12) 
(T_BOOL_CAST 13) (T_BREAK 14) (T_CLASS 15) (T_CLASS_C 16) (T_CLONE 17) (T_CONST 
18) (T_CONSTANT_ENCAPSED_STRING 19) (T_CONTINUE 20) (T_DEC 21) (T_DECLARE 22) 
(T_DIR 23) (T_DNUMBER 24) (T_DO 25) (T_DOUBLE_CAST 26) (T_ECHO 27) (T_EMPTY 28) 
(T_EVAL 29) (T_EXIT  [...]
+  "The generated distinct goto-tables.")
+
+(defconst
+  phps-mode-parser--table-productions-number-reverse
+  #s(hash-table size 730 test equal rehash-size 1.5 rehash-threshold 0.8125 
data (0 ((start) (top_statement_list)) 1 ((reserved_non_modifiers) (T_INCLUDE)) 
2 ((reserved_non_modifiers) (T_INCLUDE_ONCE)) 3 ((reserved_non_modifiers) 
(T_EVAL)) 4 ((reserved_non_modifiers) (T_REQUIRE)) 5 ((reserved_non_modifiers) 
(T_REQUIRE_ONCE)) 6 ((reserved_non_modifiers) (T_LOGICAL_OR)) 7 
((reserved_non_modifiers) (T_LOGICAL_XOR)) 8 ((reserved_non_modifiers) 
(T_LOGICAL_AND)) 9 ((reserved_non_modifiers) (T_ [...]
+  "The hash-table indexed by production-number and value is production.")
+
+(defconst
+  phps-mode-parser--table-look-aheads
+  #s(hash-table size 217 test equal rehash-size 1.5 rehash-threshold 0.8125 
data (("!") t ("\"") t ($) t ("$") t ("%") t ("&") t ("'") t ("(") t (")") t 
("*") t ("+") t (",") t ("-") t (".") t ("/") t (":") t (";") t ("<") t ("=") t 
(">") t ("?") t ("@") t (PREC_ARROW_FUNCTION) t (T_ABSTRACT) t (T_AND_EQUAL) t 
(T_ARG) t (T_ARRAY) t (T_ARRAY_CAST) t (T_ARROW) t (T_AS) t (T_ASSIGN) t 
(T_ATTRIBUTE) t (T_BAD) t (T_BOOLEAN_AND) t (T_BOOLEAN_OR) t (T_BOOL_CAST) t 
(T_BREAK) t (T_CALL) t (T_CALL [...]
+  "The hash-table of valid look-aheads.")
+
+(defconst
+  phps-mode-parser--table-terminal-p
+  #s(hash-table size 217 test equal rehash-size 1.5 rehash-threshold 0.8125 
data ("!" t "%" t "&" t "(" t ")" t "*" t "+" t "." t "," t "-" t "/" t ":" t 
";" t "<" t "=" t ">" t "?" t "@" t "[" t "]" t "}" t "{" t "^" t "|" t "~" t 
"`" t "'" t "\"" t "$" t PREC_ARROW_FUNCTION t T_ABSTRACT t T_AND_EQUAL t T_ARG 
t T_ARRAY t T_ARRAY_CAST t T_ARROW t T_AS t T_ASSIGN t T_ATTRIBUTE t T_BAD t 
T_BOOL_CAST t T_BOOLEAN_AND t T_BOOLEAN_OR t T_BREAK t T_CALL t T_CALLABLE t 
T_CASE t T_CATCH t T_CLASS [...]
+  "The hash-table of valid terminals.")
+
+(defconst
+  phps-mode-parser--table-non-terminal-p
+  #s(hash-table size 217 test equal rehash-size 1.5 rehash-threshold 0.8125 
data (absolute_trait_method_reference t alt_if_stmt t alt_if_stmt_without_else 
t anonymous_class t argument t argument_list t array_object_dereferencable t 
array_pair t array_pair_list t attribute t attribute_decl t attribute_group t 
attributed_class_statement t attributed_parameter t attributed_statement t 
attributes t backticks_expr t backup_doc_comment t backup_fn_flags t 
backup_lex_pos t callable_expr t calla [...]
+  "The hash-table of valid non-terminals.")
+
+(defconst
+  phps-mode-parser--table-translations
+  #s(hash-table size 65 test equal rehash-size 1.5 rehash-threshold 0.8125 
data ())
+  "The hash-table of translations.")
+
+(defconst
+  phps-mode-parser-lex-analyzer--get-function
+  (lambda (token) (save-current-buffer (set-buffer "*phps-mode-lex-analyzer*") 
(let ((start (car (cdr token))) (end (cdr (cdr token)))) (if (<= end 
(point-max)) (progn (buffer-substring-no-properties start end))))))
+  "The lex-analyzer get function.")
+
+(defconst
+  phps-mode-parser-lex-analyzer--function
+  (lambda (index) (save-current-buffer (set-buffer "*phps-mode-lex-analyzer*") 
(if (= (point) index) nil (goto-char index)) (phps-mode-lexer--re2c) (if 
(boundp 'phps-mode-lexer--generated-new-tokens) (progn (car (nreverse 
phps-mode-lexer--generated-new-tokens))))))
+  "The lex-analyzer function.")
+
+(defconst
+  phps-mode-parser-lex-analyzer--reset-function
+  nil
+  "The lex-analyzer reset function.")
+
+(defconst
+  phps-mode-parser--e-identifier
+  '%empty
+  "The e-identifier.")
+
+(defconst
+  phps-mode-parser--eof-identifier
+  '$
+  "The end-of-file-identifier.")
+
+(defconst
+  phps-mode-parser--look-ahead-number
+  1
+  "The look-ahead number.")
+
+
+;;; Variables:
+
+(defvar-local
+  phps-mode-parser-lex-analyzer--index
+  0
+  "The current index of the lex-analyzer.")
+
+
+;;; Functions:
+
+
+;;; Lex-Analyzer:
+
+(defun
+  phps-mode-parser-lex-analyzer--get-function (token)
+  "Get information about TOKEN."
+  (let ((meta-information))
+    (condition-case
+      error
+      (progn
+        (setq
+          meta-information
+          (funcall
+            phps-mode-parser-lex-analyzer--get-function
+            token)))
+      (error (error
+        "Lex-analyze failed to get token meta-data of %s, error: %s"
+        token
+        (car (cdr error)))))
+    (unless meta-information
+      (error "Could not find any token meta-information for: %s" token))
+    meta-information))
+
+(defun
+  phps-mode-parser-lex-analyzer--reset
+  ()
+  "Reset Lex-Analyzer."
+  (setq
+    phps-mode-parser-lex-analyzer--index
+    1)
+  (when
+    phps-mode-parser-lex-analyzer--reset-function
+    (funcall
+      phps-mode-parser-lex-analyzer--reset-function)))
+
+(defun
+  phps-mode-parser-lex-analyzer--peek-next-look-ahead
+  ()
+  "Peek next look-ahead number of tokens via lex-analyzer."
+  (let ((look-ahead)
+        (look-ahead-length 0)
+        (index phps-mode-parser-lex-analyzer--index)
+        (k (max
+            1
+            phps-mode-parser--look-ahead-number)))
+    (while (<
+            look-ahead-length
+            k)
+      (condition-case error
+          (progn
+            (let ((next-look-ahead
+                   (funcall
+                    phps-mode-parser-lex-analyzer--function
+                    index)))
+              (if next-look-ahead
+                  (progn
+                    (unless (listp (car next-look-ahead))
+                      (setq next-look-ahead (list next-look-ahead)))
+                    (dolist (next-look-ahead-item next-look-ahead)
+                      (when (<
+                             look-ahead-length
+                             k)
+                        (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 phps-mode-parser--eof-identifier) look-ahead)
+                (setq look-ahead-length (1+ look-ahead-length))
+                (setq index (1+ index)))))
+        (error
+         (error
+          "Lex-analyze failed to peek next look-ahead at %s, error: %s"
+          index
+          error))))
+    (nreverse look-ahead)))
+
+(defun
+  phps-mode-parser-lex-analyzer--pop-token ()
+  "Pop next token via lex-analyzer."
+  (let ((iteration 0)
+        (tokens))
+    (while (< iteration 1)
+      (condition-case error
+          (progn
+            (let ((token
+                   (funcall
+                    phps-mode-parser-lex-analyzer--function
+                    phps-mode-parser-lex-analyzer--index)))
+              (when token
+                (unless (listp (car token))
+                  (setq token (list token)))
+                (let ((first-token (car token)))
+                  (setq
+                   phps-mode-parser-lex-analyzer--index
+                   (cdr (cdr first-token)))
+                  (push first-token tokens)))))
+        (error (error
+                "Lex-analyze failed to pop token at %s, error: %s"
+                phps-mode-parser-lex-analyzer--index
+                (car (cdr error)))))
+      (setq iteration (1+ iteration)))
+    (nreverse tokens)))
+
+
+;;; Syntax-Analyzer / Parser:
+
+
+(defun
+  phps-mode-parser--get-grammar-production-by-number
+  (production-number)
+  "If PRODUCTION-NUMBER exist, return it's production."
+  (gethash
+   production-number
+   phps-mode-parser--table-productions-number-reverse))
+
+(defun
+  phps-mode-parser--valid-symbol-p
+  (symbol)
+  "Return whether SYMBOL is valid or not."
+  (let ((is-valid t))
+    (unless (or
+             (phps-mode-parser--valid-e-p symbol)
+             (phps-mode-parser--valid-eof-p symbol)
+             (phps-mode-parser--valid-non-terminal-p symbol)
+             (phps-mode-parser--valid-terminal-p symbol))
+      (setq is-valid nil))
+    is-valid))
+
+(defun
+  phps-mode-parser--valid-e-p
+  (symbol)
+  "Return whether SYMBOL is the e identifier or not."
+  (eq
+   symbol
+   phps-mode-parser--e-identifier))
+
+(defun
+  phps-mode-parser--valid-eof-p
+  (symbol)
+  "Return whether SYMBOL is the EOF identifier or not."
+  (eq
+    symbol
+    phps-mode-parser--eof-identifier))
+
+(defun
+  phps-mode-parser--valid-non-terminal-p (symbol)
+  "Return whether SYMBOL is a non-terminal in grammar or not."
+  (gethash
+   symbol
+   phps-mode-parser--table-non-terminal-p))
+
+(defun
+  phps-mode-parser--valid-terminal-p (symbol)
+  "Return whether SYMBOL is a terminal in grammar or not."
+  (gethash
+   symbol
+   phps-mode-parser--table-terminal-p))
+
+(defun
+  phps-mode-parser--get-grammar-translation-by-number
+  (production-number)
+  "If translation for PRODUCTION-NUMBER exist, return it."
+  (gethash
+    production-number
+    phps-mode-parser--table-translations))
+
+(defun
+  phps-mode-parser--parse
+  (&optional
+    input-tape-index
+    pushdown-list
+    output
+    translation
+    translation-symbol-table-list
+    history)
+  "Perform a LR-parse via lex-analyzer, optionally at INPUT-TAPE-INDEX with 
PUSHDOWN-LIST, OUTPUT, TRANSLATION, TRANSLATION-SYMBOL-TABLE-LIST and HISTORY."
+  (unless input-tape-index
+    (setq input-tape-index 1))
+  (unless pushdown-list
+    (push 0 pushdown-list))
+  (let ((translation-symbol-table
+         (make-hash-table :test 'equal)))
+    (when translation-symbol-table-list
+      (dolist
+          (item translation-symbol-table-list)
+        (puthash
+         (nth 0 item)
+         (nth 1 item)
+         translation-symbol-table)))
+
+    (if (and
+         input-tape-index
+         (> input-tape-index 1))
+        (setq
+         phps-mode-parser-lex-analyzer--index
+         input-tape-index)
+      (phps-mode-parser-lex-analyzer--reset))
+
+    ;; Make sure tables exists
+    (unless phps-mode-parser--action-tables
+      (error "Missing action-tables for grammar!"))
+    (unless phps-mode-parser--distinct-action-tables
+      (error "Missing distinct GOTO-tables for grammar!"))
+    (unless phps-mode-parser--goto-tables
+      (error "Missing GOTO-tables for grammar!"))
+    (unless phps-mode-parser--distinct-goto-tables
+      (error "Missing distinct GOTO-tables for grammar!"))
+
+    (let ((accept)
+          (pre-index 0))
+      (while (not accept)
+
+        ;; Save history when index has changed to enable incremental parsing / 
translating
+        (when
+            (>
+             phps-mode-parser-lex-analyzer--index
+             pre-index)
+          ;; We make a copy of the hash-table here to avoid passing same
+          ;; hash-table every-time with pointer
+          (let ((translation-symbol-table-list))
+            (maphash
+             (lambda (key value)
+               (push
+                `(,key ,value)
+                translation-symbol-table-list))
+             translation-symbol-table)
+            (push
+             `(,phps-mode-parser-lex-analyzer--index
+               ,pushdown-list
+               ,output
+               ,translation
+               ,translation-symbol-table-list)
+             history)
+            (setq
+             pre-index
+             phps-mode-parser-lex-analyzer--index)))
+
+        ;; (1) The look-ahead string u, consisting of the next k input 
symbols, is determined.
+        (let ((look-ahead
+               (phps-mode-parser-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-distinct-index
+                   (gethash
+                    table-index
+                    phps-mode-parser--action-tables)))
+              (let ((action-table
+                     (gethash
+                      action-table-distinct-index
+                      phps-mode-parser--distinct-action-tables)))
+              (unless action-table
+                (error
+                 "Action-table with index %s is empty! Push-down-list: %s"
+                 table-index
+                 pushdown-list))
+              (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
+                           (=
+                            phps-mode-parser--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).
+                  (error
+                   (format
+                    "Invalid syntax! Expected one of %s found %s at %s"
+                    possible-look-aheads
+                    look-ahead
+                    phps-mode-parser-lex-analyzer--index)
+                   possible-look-aheads
+                   look-ahead
+                   phps-mode-parser-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-distinct-index
+                             (gethash
+                              table-index
+                              phps-mode-parser--goto-tables)))
+                        (let ((goto-table
+                               (gethash
+                                goto-table-distinct-index
+                                phps-mode-parser--distinct-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)))
+                        (unless next-index
+                          (error
+                           "In shift, found no GOTO-item for %s at %s, 
expected one of %s"
+                           a
+                           phps-mode-parser-lex-analyzer--index
+                           possible-look-aheads))
+
+                        (push (car a-full) pushdown-list)
+                        (push next-index pushdown-list)
+                        (phps-mode-parser-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
+                           (phps-mode-parser--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 phps-mode-parser--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)
+                                     (phps-mode-parser--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))
+                          (setq
+                           popped-items-contents
+                           (reverse popped-items-contents))
+                          ;; 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
+                                 (phps-mode-parser-lex-analyzer--get-function
+                                  popped-item)
+                                 popped-items-meta-contents)
+
+                              ;; If item is a non-terminal
+                              (let ((temp-hash-key
+                                     (format
+                                      "%S"
+                                       popped-item)))
+
+                              ;; 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
+                                
(phps-mode-parser--get-grammar-translation-by-number
+                                 production-number)
+                                (let ((partial-translation
+                                       (funcall
+                                        
(phps-mode-parser--get-grammar-translation-by-number
+                                         production-number)
+                                        popped-items-meta-contents)))
+                                  (let ((temp-hash-key
+                                         (format
+                                          "%S"
+                                          production-lhs)))
+                                    (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))
+                                (let ((temp-hash-key
+                                       (format
+                                        "%S"
+                                        production-lhs)))
+                                  (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
+                                    phps-mode-parser--goto-tables)))
+                              (let ((goto-table
+                                     (gethash
+                                      goto-table-distinct-index
+                                      phps-mode-parser--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))
+                   (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)))
+      (let ((translation-symbol-table-list))
+        (when translation-symbol-table
+          (maphash
+           (lambda (key value)
+             (push
+              `(,key ,value)
+              translation-symbol-table-list))
+           translation-symbol-table))
+        (list
+         output
+         translation
+         translation-symbol-table-list
+         history)))))
+(defun phps-mode-parser-parse
+    (&optional
+     input-tape-index
+     pushdown-list
+     output
+     translation
+     history)
+  "Perform a LR-parse via lex-analyzer, optionally at INPUT-TAPE-INDEX with 
PUSHDOWN-LIST, OUTPUT, TRANSLATION and HISTORY."
+  (let ((result
+         (phps-mode-parser--parse
+          input-tape-index
+          pushdown-list
+          output
+          translation
+          history)))
+    (nth 0 result)))
+
+(defun phps-mode-parser-translate
+    (&optional
+     input-tape-index
+     pushdown-list
+     output
+     translation
+     history)
+  "Perform a LR-parse via lex-analyzer, optionally at INPUT-TAPE-INDEX with 
PUSHDOWN-LIST, OUTPUT, TRANSLATION and HISTORY."
+  (let ((result
+         (phps-mode-parser--parse
+          input-tape-index
+          pushdown-list
+          output
+          translation
+          history)))
+    (nth 1 result)))
+
+(provide 'phps-mode-parser)
+
+;;; phps-mode-parser.el ends here



reply via email to

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