branch: externals/phps-mode
commit f4c9f8bc649957904996bff819e44321b24d527d
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@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
