branch: externals/parser-generator
commit 75323b10e549448f3debbe2a0bbabcaf8f3848de
Merge: bf7229332f 5be162966b
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Merge branch 'feature/llk-parser'
---
Makefile | 12 +-
README.md | 2 +-
TODO.md | 8 +-
docs/Syntax-Analysis.md | 5 +-
docs/Syntax-Analysis/LL1.md | 174 ++++++
docs/Syntax-Analysis/LLk.md | 178 ++++++
parser-generator-ll-export.el | 816 +++++++++++++++++++++++++
parser-generator-ll.el | 1004 +++++++++++++++++++++++++++++++
parser-generator-lr.el | 4 +-
parser-generator.el | 276 ++++++++-
test/parser-generator-ll-export-test.el | 176 ++++++
test/parser-generator-ll-test.el | 943 +++++++++++++++++++++++++++++
test/parser-generator-test.el | 128 +++-
13 files changed, 3676 insertions(+), 50 deletions(-)
diff --git a/Makefile b/Makefile
index 4965a61a20..86a23ae36f 100644
--- a/Makefile
+++ b/Makefile
@@ -4,7 +4,7 @@ ifdef emacs
endif
EMACS_CMD := $(EMACS) -Q -batch -L . -L test/
-EL := parser-generator.el parser-generator-lex-analyzer.el
parser-generator-lr.el parser-generator-lr-export.el
test/parser-generator-test.el test/parser-generator-lex-analyzer-test.el
test/parser-generator-lr-export-test.el test/parser-generator-lr-test.el
+EL := parser-generator.el parser-generator-lex-analyzer.el
parser-generator-ll.el parser-generator-ll-export.el parser-generator-lr.el
parser-generator-lr-export.el test/parser-generator-test.el
test/parser-generator-lex-analyzer-test.el
test/parser-generator-lr-export-test.el test/parser-generator-ll-test.el
test/parser-generator-ll-export-test.el test/parser-generator-lr-test.el
ELC := $(EL:.el=.elc)
.PHONY: clean
@@ -31,5 +31,13 @@ test-lr:
test-lr-export:
$(EMACS_CMD) -l test/parser-generator-lr-export-test.el -f
"parser-generator-lr-export-test"
+.PHONY: test-ll
+test-ll:
+ $(EMACS_CMD) -l test/parser-generator-ll-test.el -f
"parser-generator-ll-test"
+
+.PHONY: test-ll-export
+test-ll-export:
+ $(EMACS_CMD) -l test/parser-generator-ll-export-test.el -f
"parser-generator-ll-export-test"
+
.PHONY: tests
-tests: test test-lex-analyzer test-lr test-lr-export
+tests: test test-lex-analyzer test-lr test-lr-export test-ll test-ll-export
diff --git a/README.md b/README.md
index 5432ef4407..777cb89246 100644
--- a/README.md
+++ b/README.md
@@ -5,7 +5,7 @@
The idea of this plugin is to provide functions for various kinds of
context-free grammar parser generations with support for
syntax-directed-translations (SDT) and semantic actions (SA) and the
possibility of exporting parsers and translators (as generated stand-alone
elisp code) to enable Emacs plugin-agnostic usage. This project is also about
implementing algorithms described in the book `The Theory of Parsing,
Translation and Compiling (Volume 1)` by `Alfred V. Aho and Jeffrey D. Ull [...]
-At the moment it is possible to generate canonical LR(k) parsers using this
library for complex languages like PHP 8.0.
+At the moment it is possible to generate canonical LR(k) parsers using this
library for complex languages like PHP 8.1.
## Lexical Analysis
diff --git a/TODO.md b/TODO.md
index 54a3e26d94..952c7d226e 100644
--- a/TODO.md
+++ b/TODO.md
@@ -2,17 +2,17 @@
## Main
-Functions (with validations) to set global variables
+Functions (with validations) to set global variables:
-* parser-generator--global-attributes
* parser-generator--context-sensitive-attributes
+* parser-generator--global-attributes
* parser-generator--global-declaration
## LR-Parser
-Functions (with validations) to set global variables
+Functions (with validations) to set global variables:
-* parser-generator-lr--global-precedence-attributes
* parser-generator-lr--context-sensitive-precedence-attribute
+* parser-generator-lr--global-precedence-attributes
[Back to start](../../)
diff --git a/docs/Syntax-Analysis.md b/docs/Syntax-Analysis.md
index 6f639d7b1f..c391d346f0 100644
--- a/docs/Syntax-Analysis.md
+++ b/docs/Syntax-Analysis.md
@@ -11,7 +11,8 @@ We use push down transducer (PDT) based algorithms.
## Without Backtracking
-* LL(k) *WIP*
+* [LL(1)](Syntax-Analysis/LL1.md)
+* [LL(k)](Syntax-Analysis/LLk.md)
* [LR(k)](Syntax-Analysis/LRk.md)
* [LR(0)](Syntax-Analysis/LR0.md)
* Formal Shift-Reduce Parsing Algorithms *WIP*
@@ -156,7 +157,7 @@ Calculate the first look-ahead number of terminals of the
sentential-form `S`, e
### E-FREE-FIRST(S)
-Calculate the e-free-first look-ahead number of terminals of sentential-form
`S`, if you have multiple symbols the e-free-first will only affect the first
symbol, the rest will be treated via first-function (above). Example:
+Calculate the e-free-first look-ahead number of terminals of sentential-form
`S`, if you have multiple symbols the e-free-first will only affect the first
symbol, the rest will be treated via the first-function (above). Example:
``` emacs-lisp
(require 'parser-generator)
diff --git a/docs/Syntax-Analysis/LL1.md b/docs/Syntax-Analysis/LL1.md
new file mode 100644
index 0000000000..0d0e5d9db2
--- /dev/null
+++ b/docs/Syntax-Analysis/LL1.md
@@ -0,0 +1,174 @@
+# LL(1) Parser
+
+LL(1) parser is a Left-to-right, Leftmost derivation with look-ahead number k
= 1.
+
+This library contains functions to parse, translate, validate grammars.
+
+## Parse
+
+Perform a left-parse of input-stream.
+
+```emacs-lisp
+(require 'parser-generator-ll)
+(require 'ert)
+
+(parser-generator-set-eof-identifier '$)
+(parser-generator-set-e-identifier 'e)
+(parser-generator-set-look-ahead-number 1)
+(parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S
+ (a A S (lambda(a b) (format "alfa %s %s" (nth 1 a) (nth 2 a))))
+ (b (lambda(a b) "beta"))
+ )
+ (A
+ (a (lambda(a b) "delta"))
+ (b S A (lambda(a b) (format "gamma %s %s" (nth 1 a) (nth 2 a))))
+ )
+ )
+ S
+ )
+ )
+(parser-generator-process-grammar)
+(parser-generator-ll-generate-table)
+(setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((a 1 . 2) (b 2 . 3) (b 3 . 4) (a 4 . 5) (b 5 . 6)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+(setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+(should
+ (equal
+ "beta"
+ (parser-generator-ll-translate)))
+(message "Passed translation test 3")
+```
+
+## Translate
+
+Each production RHS can optionally contain a lambda-expression that will be
called if specified when stack is reduced:
+
+```emacs-lisp
+(require 'parser-generator-ll)
+(require 'ert)
+
+(parser-generator-set-eof-identifier '$)
+(parser-generator-set-e-identifier 'e)
+(parser-generator-set-look-ahead-number 2)
+(parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S
+ (a A a a (lambda(a b) (format "alfa %s laval" (nth 1 a))))
+ (b A b a (lambda(a b) (format "delta %s laval" (nth 1 a))))
+ )
+ (A
+ (b (lambda(a b) "sven"))
+ (e (lambda(a b) "ingrid"))
+ )
+ )
+ S
+ )
+ )
+(parser-generator-process-grammar)
+(parser-generator-ll-generate-table)
+(setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3) (a 3 . 4)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+(setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+(should
+ (equal
+ "delta ingrid laval"
+ (parser-generator-ll-translate)))
+(message "Passed translation test 1")
+```
+
+## Export
+
+```emacs-lisp
+(require 'parser-generator-ll)
+(require 'ert)
+
+(parser-generator-set-eof-identifier '$)
+(parser-generator-set-e-identifier 'e)
+(parser-generator-set-look-ahead-number 1)
+(parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S (a A S) b)
+ (A a (b S A))
+ )
+ S
+ )
+ )
+(parser-generator-process-grammar)
+(parser-generator-ll-generate-table)
+(setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((a 1 . 2) (b 2 . 3) (b 3 . 4) (a 4 . 5) (b 5 . 6)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+(setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+(let ((export (parser-generator-ll-export-to-elisp "ba3")))
+ (with-temp-buffer
+ (insert export)
+ (eval-buffer)
+ (should
+ (equal
+ t
+ (fboundp 'ba3-parse)))
+ (should
+ (equal
+ t
+ (fboundp 'ba3-translate)))
+ (when (fboundp 'ba3-parse)
+ (should
+ (equal
+ '(0 3 1 2 1)
+ (ba3-parse))))))
+(message "Passed exported test for example 5.5 p. 340")
+```
+
+[Back to syntax analysis](../Syntax-Analysis.md)
diff --git a/docs/Syntax-Analysis/LLk.md b/docs/Syntax-Analysis/LLk.md
new file mode 100644
index 0000000000..bf7130b452
--- /dev/null
+++ b/docs/Syntax-Analysis/LLk.md
@@ -0,0 +1,178 @@
+# LL(k) Parser
+
+LL(k) parser is a Left-to-right, Leftmost derivation with look-ahead number k
> 1.
+
+This library contains functions to parse, translate, validate grammars.
+
+## Parse
+
+Perform a left-parse of input-stream.
+
+```emacs-lisp
+(require 'parser-generator-ll)
+(require 'ert)
+
+(parser-generator-set-eof-identifier '$)
+(parser-generator-set-e-identifier 'e)
+(parser-generator-set-look-ahead-number 2)
+(parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S (a A a a) (b A b a))
+ (A b e)
+ )
+ S
+ )
+ )
+(parser-generator-process-grammar)
+(parser-generator-ll-generate-table)
+(setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3) (a 3 . 4)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+(setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+
+(should
+ (equal
+ '(1 3) ;; Example is indexed from 1 so that is why they have '(2 4)
+ (parser-generator-ll-parse)))
+(message "Passed example 5.16 p. 352")
+```
+
+## Translate
+
+Each production RHS can optionally contain a lambda-expression that will be
called if specified when stack is reduced:
+
+```emacs-lisp
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S
+ (a A a a (lambda(a b) (format "alfa %s laval" (nth 1 a))))
+ (b A b a (lambda(a b) (format "delta %s laval" (nth 1 a))))
+ )
+ (A
+ (b (lambda(a b) "sven"))
+ (e (lambda(a b) "ingrid"))
+ )
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3) (a 3 . 4)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (should
+ (equal
+ "delta ingrid laval"
+ (parser-generator-ll-translate)))
+ (message "Passed translation test 1")
+```
+
+## Export
+
+```emacs-lisp
+(require 'parser-generator-ll)
+(require 'ert)
+
+(parser-generator-set-eof-identifier '$)
+(parser-generator-set-e-identifier 'e)
+(parser-generator-set-look-ahead-number 2)
+(parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S
+ (a A a a (lambda(a b) (format "alfa %s laval" (nth 1 a))))
+ (b A b a (lambda(a b) (format "delta %s laval" (nth 1 a))))
+ )
+ (A
+ (b (lambda(a b) "sven"))
+ (e (lambda(a b) "ingrid"))
+ )
+ )
+ S
+ )
+ )
+(parser-generator-process-grammar)
+(parser-generator-ll-generate-table)
+(setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3) (a 3 . 4)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+(setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+(let ((export (parser-generator-ll-export-to-elisp "ba")))
+ (with-temp-buffer
+ (insert export)
+ (eval-buffer)
+ (should
+ (equal
+ t
+ (fboundp 'ba-parse)))
+ (should
+ (equal
+ t
+ (fboundp 'ba-translate)))
+ (when (fboundp 'ba-parse)
+ (should
+ (equal
+ '(1 3)
+ (ba-parse))))
+ (when (fboundp 'ba-translate)
+ (should
+ (equal
+ "delta ingrid laval"
+ (ba-translate))))))
+(message "Passed exported test for example 5.16 p. 352")
+```
+
+
+[Back to syntax analysis](../Syntax-Analysis.md)
diff --git a/parser-generator-ll-export.el b/parser-generator-ll-export.el
new file mode 100644
index 0000000000..80fef9cac2
--- /dev/null
+++ b/parser-generator-ll-export.el
@@ -0,0 +1,816 @@
+;;; parser-generator-ll-export.el --- Export LL(k) Parser -*- lexical-binding:
t -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+
+
+;;; Commentary:
+
+
+;;; Code:
+
+
+(require 'parser-generator-ll)
+
+(defun parser-generator-ll-export-to-elisp (namespace &optional header
copyright)
+ "Export parser with NAMESPACE and a optional HEADER and COPYRIGHT."
+ (message "\n;; Starting generation of elips..\n")
+
+ ;; Make sure all requisites are defined
+ (unless parser-generator-ll--table
+ (error "Missing generated table!"))
+ (unless parser-generator--table-productions-number-reverse
+ (error "Table for reverse production-numbers is undefined!"))
+ (unless parser-generator--table-look-aheads-p
+ (error "Table for valid look-aheads is undefined!"))
+ (unless parser-generator--look-ahead-number
+ (error "Missing a look-ahead number!"))
+ (unless parser-generator--e-identifier
+ (error "Missing definition for e-identifier!"))
+ (unless parser-generator--eof-identifier
+ (error "Missing definition for EOF-identifier!"))
+ (unless parser-generator--table-non-terminal-p
+ (error "Table for non-terminals is undefined!"))
+ (unless parser-generator--table-terminal-p
+ (error "Table for terminals is undefined!"))
+ (unless parser-generator--table-translations
+ (error "Table for translations by production-number is undefined!"))
+ (unless parser-generator-lex-analyzer--get-function
+ (error "Missing lex-analyzer get function!"))
+ (unless parser-generator-lex-analyzer--function
+ (error "Missing lex-analyzer function!"))
+
+ (let ((code))
+ (with-temp-buffer
+ (goto-char (point-min))
+
+ ;; Header
+ (insert
+ (format
+ ";;; %s.el --- Exported Emacs Parser Generator -*- lexical-binding: t
-*-\n\n"
+ namespace))
+
+ ;; Optional copyright
+ (when copyright
+ (insert copyright))
+
+ (insert ";;; Commentary:\n\n\n;;; Code:\n\n")
+
+ ;; Optional header
+ (when header
+ (insert header))
+
+ (insert "\n;;; Variables:\n\n\n")
+
+ ;; Grammar start
+ (insert
+ (format
+ "(defvar\n %s--grammar-start\n %s\n \"The start of grammar.\")\n\n"
+ namespace
+ (if (symbolp (parser-generator--get-grammar-start))
+ (format "'%s" (parser-generator--get-grammar-start))
+ (format "\"%s\"" (parser-generator--get-grammar-start)))))
+
+ ;; Generated table
+ (insert
+ (format
+ "(defvar\n %s--table\n %S\n \"The generated table.\")\n\n"
+ namespace
+ parser-generator-ll--table))
+
+ ;; Table production-number
+ (insert
+ (format
+ "(defvar\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 terminals
+ (insert
+ (format
+ "(defvar\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
+ "(defvar\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
+ "(defvar\n %s--table-translations\n %S\n \"The hash-table of
translations.\")\n\n"
+ namespace
+ parser-generator--table-translations))
+
+ ;; E-identifier
+ (insert
+ (format
+ "(defvar\n %s--e-identifier\n '%S\n \"The e-identifier.\")\n\n"
+ namespace
+ parser-generator--e-identifier))
+
+ ;; EOF-identifier
+ (insert
+ (format
+ "(defvar\n %s--eof-identifier\n '%S\n \"The
end-of-file-identifier.\")\n\n"
+ namespace
+ parser-generator--eof-identifier))
+
+ ;; Look-ahead number
+ (insert
+ (format
+ "(defvar\n %s--look-ahead-number\n %S\n \"The look-ahead
number.\")\n\n"
+ namespace
+ parser-generator--look-ahead-number))
+
+ (insert "\n;;; Local Variables:\n\n")
+
+ ;; Index
+ (insert
+ (format
+ "(defvar-local\n %s-lex-analyzer--index\n 0\n \"The current index
of the lex-analyzer.\")\n\n"
+ namespace))
+
+ ;; Move to index flag
+ (insert
+ (format
+ "(defvar-local\n %s-lex-analyzer--move-to-index-flag\n nil\n
\"Non-nil means move index to value.\")\n\n"
+ namespace))
+
+ (insert "\n;;; Variable Functions:\n\n")
+
+ ;; Lex-Analyzer Get Function
+ (insert
+ (format
+ "(defvar\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)))
+
+ ;; Lex-Analyzer Function
+ (insert
+ (format
+ "(defvar\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)))
+
+ ;; Lex-Analyzer Reset Function
+ (insert
+ (format
+ "(defvar\n %s-lex-analyzer--reset-function\n "
+ namespace))
+ (if parser-generator-lex-analyzer--reset-function
+ (insert
+ (format
+ "(lambda %S %S)\n"
+ (nth 2 parser-generator-lex-analyzer--reset-function)
+ (nth 3 parser-generator-lex-analyzer--reset-function)))
+ (insert "nil\n"))
+ (insert " \"The lex-analyzer reset function.\")\n\n")
+
+ (insert "\n;;; Functions:\n\n")
+
+ (insert "\n;;; Functions for Lex-Analyzer:\n\n")
+
+ ;; Lex-Analyzer Get Function
+ (insert
+ (format
+ "(defun
+ %s-lex-analyzer--get-function (token)
+ \"Get information about TOKEN.\"
+ (let ((meta-information))
+ (condition-case
+ error
+ (progn
+ (setq
+ meta-information
+ (funcall
+ %s-lex-analyzer--get-function
+ token)))"
+ namespace
+ namespace))
+ (insert "
+ (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))\n")
+
+ ;; Lex-Analyzer Reset Function
+ (insert
+ (format "
+(defun
+ %s-lex-analyzer--reset
+ ()
+ \"Reset Lex-Analyzer.\"
+ (setq
+ %s-lex-analyzer--index
+ 1)
+ (when
+ %s-lex-analyzer--reset-function
+ (funcall
+ %s-lex-analyzer--reset-function)))\n"
+ namespace
+ namespace
+ namespace
+ namespace))
+
+ ;; Lex-Analyzer Peek Next Look Ahead
+ (insert
+ (format "
+(defun
+ %s-lex-analyzer--peek-next-look-ahead
+ ()
+ \"Peek next look-ahead number of tokens via lex-analyzer.\"
+ (let ((look-ahead)
+ (look-ahead-length 0)
+ (index %s-lex-analyzer--index)
+ (k (max
+ 1
+ %s--look-ahead-number)))
+ (while (<
+ look-ahead-length
+ k)
+ (condition-case error
+ (progn
+ (setq-local
+ %s-lex-analyzer--move-to-index-flag
+ nil)
+ (let ((next-look-ahead
+ (funcall
+ %s-lex-analyzer--function
+ index)))
+ (if %s-lex-analyzer--move-to-index-flag
+ (setq
+ index
+ %s-lex-analyzer--move-to-index-flag)
+ (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 %s--eof-identifier) look-ahead)
+ (setq look-ahead-length (1+ look-ahead-length))
+ (setq index (1+ index))))))"
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace))
+ (insert "
+ (error
+ (error
+ \"Lex-analyze failed to peek next look-ahead at %s, error: %s\"
+ index
+ error))))
+ (nreverse look-ahead)))\n")
+
+ ;; Lex-Analyzer Pop Token
+ (insert
+ (format "
+(defun
+ %s-lex-analyzer--pop-token ()
+ \"Pop next token via lex-analyzer.\"
+ (let ((continue t)
+ (tokens))
+ (while continue
+ (condition-case error
+ (progn
+ (setq-local
+ %s-lex-analyzer--move-to-index-flag
+ nil)
+ (let ((token
+ (funcall
+ %s-lex-analyzer--function
+ %s-lex-analyzer--index)))
+ (if %s-lex-analyzer--move-to-index-flag
+ (progn
+ (setq-local
+ %s-lex-analyzer--index
+ %s-lex-analyzer--move-to-index-flag))
+ (when token
+ (unless (listp (car token))
+ (setq token (list token)))
+ (let ((first-token (car token)))
+ (setq
+ %s-lex-analyzer--index
+ (cdr (cdr first-token)))
+ (push
+ first-token
+ tokens)))
+ (setq
+ continue
+ nil))))"
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace))
+ (insert "
+ (error (error
+ \"Lex-analyze failed to pop token at %s, error: %s\"")
+ (insert (format "
+ %s-lex-analyzer--index
+ (car (cdr error))))))
+ (nreverse tokens)))\n"
+ namespace))
+
+ (insert "\n\n;;; Functions for Syntax-Analyzer / Parser:\n\n");
+
+ ;; Get grammar production by number
+ (insert
+ (format "
+(defun
+ %s--get-grammar-production-by-number
+ (production-number)
+ \"If PRODUCTION-NUMBER exist, return it's production.\"
+ (gethash
+ production-number
+ %s--table-productions-number-reverse))\n"
+ namespace
+ namespace))
+
+ ;; Valid symbol p
+ (insert
+ (format "
+(defun
+ %s--valid-symbol-p
+ (symbol)
+ \"Return whether SYMBOL is valid or not.\"
+ (let ((is-valid t))
+ (unless (or
+ (%s--valid-e-p symbol)
+ (%s--valid-eof-p symbol)
+ (%s--valid-non-terminal-p symbol)
+ (%s--valid-terminal-p symbol))
+ (setq is-valid nil))
+ is-valid))\n"
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace))
+
+ ;; Valid e-p
+ (insert
+ (format "
+(defun
+ %s--valid-e-p
+ (symbol)
+ \"Return whether SYMBOL is the e identifier or not.\"
+ (eq
+ symbol
+ %s--e-identifier))\n"
+ namespace
+ namespace))
+
+ ;; Valid EOF-p
+ (insert
+ (format "
+(defun
+ %s--valid-eof-p
+ (symbol)
+ \"Return whether SYMBOL is the EOF identifier or not.\"
+ (eq
+ symbol
+ %s--eof-identifier))\n"
+ namespace
+ namespace))
+
+ ;; Valid non-terminal-p
+ (insert
+ (format "
+(defun
+ %s--valid-non-terminal-p (symbol)
+ \"Return whether SYMBOL is a non-terminal in grammar or not.\"
+ (gethash
+ symbol
+ %s--table-non-terminal-p))\n"
+ namespace
+ namespace))
+
+ ;; Valid terminal-p
+ (insert
+ (format "
+(defun
+ %s--valid-terminal-p (symbol)
+ \"Return whether SYMBOL is a terminal in grammar or not.\"
+ (gethash
+ symbol
+ %s--table-terminal-p))\n"
+ namespace
+ namespace))
+
+ ;; Generate list of symbol
+ (insert
+ (format "
+(defun %s--generate-list-of-symbol (k symbol)
+ \"Generate list of K number of SYMBOL.\"
+ (let ((list-index 0)
+ (list))
+ (while (< list-index k)
+ (push symbol list)
+ (setq list-index (1+ list-index)))
+ list))
+"
+ namespace))
+
+ ;; Get grammar translation by number
+ (insert
+ (format "
+(defun
+ %s--get-grammar-translation-by-number
+ (production-number)
+ \"If translation for PRODUCTION-NUMBER exist, return it.\"
+ (gethash
+ production-number
+ %s--table-translations))\n"
+ namespace
+ namespace))
+
+ ;; Parse / translate function
+ (insert
+ (format "
+(defun %s--parse (&optional translate-p)
+ \"Parse input via lex-analyzer and return parse trail.\"
+ (let ((accept)
+ (stack
+ (if (> %s--look-ahead-number 1)
+ (list
+ (list
+ (list
+ %s--grammar-start)
+ (%s--generate-list-of-symbol
+ %s--look-ahead-number
+ %s--eof-identifier))
+ %s--eof-identifier)
+ (list
+ %s--grammar-start
+ %s--eof-identifier)))
+ (output)
+ (eof-look-ahead
+ (%s--generate-list-of-symbol
+ %s--look-ahead-number
+ %s--eof-identifier))
+ (e-reduction
+ (list %s--e-identifier))
+ (translation)
+ (translation-stack)
+ (translation-symbol-table
+ (make-hash-table :test 'equal))
+ (terminal-stack '()))
+ (%s-lex-analyzer--reset)
+ (while (not accept)
+ (let* ((state (car stack))
+ (state-action-table
+ (gethash
+ (format \"%%S\" state)
+ %s--table))
+ (look-ahead-list
+ (%s-lex-analyzer--peek-next-look-ahead))
+ (look-ahead))
+
+ (unless state-action-table
+ (signal
+ 'error
+ (list
+ (format
+ \"State action table lacks actions for state: '%%S'!\"
+ state)
+ state)))
+
+ (if look-ahead-list
+ (progn
+ (dolist (look-ahead-list-item look-ahead-list)
+ (push (car look-ahead-list-item) look-ahead))
+ (setq look-ahead (reverse look-ahead)))
+ (setq
+ look-ahead
+ eof-look-ahead))
+
+ (unless (gethash
+ (format \"%%S\" look-ahead)
+ state-action-table)
+ (let ((possible-look-aheads))
+ (maphash
+ (lambda (k _v) (push k possible-look-aheads))
+ state-action-table)
+ (signal
+ 'error
+ (list
+ (format
+ \"Invalid look-ahead '%%S' in state: '%%S', valid look-aheads:
'%%S'\"
+ look-ahead
+ state
+ possible-look-aheads)
+ look-ahead
+ state
+ possible-look-aheads))))
+
+ (let* ((action
+ (gethash
+ (format \"%%S\" look-ahead)
+ state-action-table))
+ (action-type action))
+ (when (listp action)
+ (setq action-type (car action)))
+ (cond
+
+ ((equal action-type 'pop)
+ (let ((popped-tokens
+ (%s-lex-analyzer--pop-token)))
+
+ ;; Is it time for SDT?
+ (when (and
+ translate-p
+ translation-stack
+ (string=
+ (car (car translation-stack))
+ (format \"%%S\" stack)))
+ (let* ((translation-item (pop translation-stack))
+ (partial-translation
+ (%s--perform-translation
+ (nth 1 translation-item)
+ translation-symbol-table
+ (reverse (pop terminal-stack)))))
+ (setq
+ translation
+ partial-translation)))
+
+ (pop stack)
+
+ (when translate-p
+ (let ((token-data)
+ (old-terminal-stack (car terminal-stack)))
+ (dolist (popped-token popped-tokens)
+ (push
+ popped-token
+ token-data))
+ (push
+ token-data
+ old-terminal-stack)
+ (setf
+ (car terminal-stack)
+ old-terminal-stack)))
+
+ ;; Is it time for SDT?
+ (when (and
+ translate-p
+ translation-stack
+ (string=
+ (car (car translation-stack))
+ (format \"%%S\" stack)))
+ (let* ((translation-item (pop translation-stack))
+ (partial-translation
+ (%s--perform-translation
+ (nth 1 translation-item)
+ translation-symbol-table
+ (reverse (pop terminal-stack)))))
+ (setq
+ translation
+ partial-translation)))
+
+ ))
+
+ ((equal action-type 'reduce)
+
+ ;; Is it time for SDT?
+ (when (and
+ translate-p
+ translation-stack
+ (string=
+ (car (car translation-stack))
+ (format \"%%S\" stack)))
+ (let* ((translation-item (pop translation-stack))
+ (partial-translation
+ (%s--perform-translation
+ (nth 1 translation-item)
+ translation-symbol-table
+ (reverse (pop terminal-stack)))))
+ (setq
+ translation
+ partial-translation)))
+
+ (pop stack)
+
+ ;; Is it time for SDT?
+ (when (and
+ translate-p
+ translation-stack
+ (string=
+ (car (car translation-stack))
+ (format \"%%S\" stack)))
+ (let* ((translation-item (pop translation-stack))
+ (partial-translation
+ (%s--perform-translation
+ (nth 1 translation-item)
+ translation-symbol-table
+ (reverse (pop terminal-stack)))))
+ (setq
+ translation
+ partial-translation)))
+
+ (when translate-p
+ (push
+ (list
+ (format \"%%S\" stack)
+ (nth 2 action))
+ translation-stack)
+ (push
+ '()
+ terminal-stack))
+
+ (unless (equal (nth 1 action) e-reduction)
+ (dolist (reduce-item (reverse (nth 1 action)))
+ (push reduce-item stack)))
+ (push
+ (nth 2 action)
+ output))
+
+ ((equal action-type 'accept)
+ (setq accept t))))))
+ (list
+ (reverse output)
+ translation)))
+
+(defun %s-parse ()
+ (let ((parse (%s--parse)))
+ (car parse)))
+
+(defun %s-translate ()
+ (let ((parse (%s--parse t)))
+ (car (cdr parse))))
+
+(defun %s--perform-translation (production-number symbol-table terminals)
+ \"Perform translation by PRODUCTION-NUMBER, with SYMBOL-TABLE and
TERMINALS.\"
+ (let* ((production
+ (%s--get-grammar-production-by-number
+ production-number))
+ (production-lhs
+ (car (nth 0 production)))
+ (production-rhs
+ (nth 1 production))
+ (translation)
+ (args-1)
+ (args-2))
+
+ ;; Collect arguments for translation
+ (let ((terminal-index 0))
+ (dolist (rhs-item production-rhs)
+ (cond
+
+ ((%s--valid-non-terminal-p
+ rhs-item)
+ (let* ((non-terminal-value-list
+ (gethash rhs-item symbol-table))
+ (non-terminal-value
+ (pop non-terminal-value-list)))
+ (push
+ (car non-terminal-value)
+ args-1)
+ (push
+ (car (cdr non-terminal-value))
+ args-2)
+ (puthash
+ rhs-item
+ non-terminal-value-list
+ symbol-table)))
+
+ ((%s--valid-terminal-p
+ rhs-item)
+ (push
+ (%s-lex-analyzer--get-function
+ (nth terminal-index terminals))
+ args-1)
+ (push
+ (nth terminal-index terminals)
+ args-2)
+ (setq
+ terminal-index
+ (1+ terminal-index))))))
+ (setq
+ args-1
+ (reverse args-1))
+ (setq
+ args-2
+ (reverse args-2))
+
+ (if (%s--get-grammar-translation-by-number
+ production-number)
+ (let ((partial-translation
+ (funcall
+ (%s--get-grammar-translation-by-number
+ production-number)
+ args-1
+ args-2))
+ (old-symbol-value
+ (gethash production-lhs symbol-table)))
+ (push
+ (list
+ partial-translation
+ args-2)
+ old-symbol-value)
+ (puthash
+ production-lhs
+ old-symbol-value
+ symbol-table)
+ (setq
+ translation
+ partial-translation))
+
+ ;; When no translation is specified just use popped contents as
translation
+ (let ((partial-translation
+ (list
+ args-1
+ args-2))
+ (old-symbol-value
+ (gethash production-lhs symbol-table)))
+ (push
+ partial-translation
+ old-symbol-value)
+ (puthash
+ production-lhs
+ old-symbol-value
+ symbol-table)
+ (setq
+ translation
+ (car partial-translation))))
+
+ translation))
+
+"
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ namespace
+ ))
+
+ ;; Footer
+ (insert
+ (format
+ "\n(provide '%s)"
+ namespace))
+
+ (insert
+ (format
+ "\n\n;;; %s.el ends here"
+ namespace))
+
+ (setq
+ code
+ (buffer-substring-no-properties
+ (point-min)
+ (point-max))))
+ (message "\n;; Completed generation of elips.\n")
+ code))
+
+
+(provide 'parser-generator-ll-export)
+
+;;; parser-generator-ll-export.el ends here
diff --git a/parser-generator-ll.el b/parser-generator-ll.el
new file mode 100644
index 0000000000..2696982d35
--- /dev/null
+++ b/parser-generator-ll.el
@@ -0,0 +1,1004 @@
+;;; parser-generator-ll.el --- LL(k) Parser Generator -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+
+
+;;; Commentary:
+
+
+;;; Code:
+
+
+(require 'parser-generator)
+(require 'parser-generator-lex-analyzer)
+
+
+;;; Variables:
+
+
+(defvar
+ parser-generator-ll--table
+ nil
+ "Table for grammar.")
+
+
+;;; Functions
+
+
+(defun parser-generator-ll-generate-table ()
+ "Generate table for grammar."
+ (let ((list-parsing-table)
+ (hash-parsing-table (make-hash-table :test 'equal)))
+
+ (if (> parser-generator--look-ahead-number 1)
+ (progn
+ (message "\n;; Starting generation of LL(k) tables..\n")
+
+ (unless (parser-generator-ll--valid-grammar-k-gt-1-p)
+ (error "Invalid LL(k) grammar specified!"))
+
+ (setq
+ list-parsing-table
+ (parser-generator-ll--generate-action-table-k-gt-1
+ (parser-generator-ll--generate-goto-table))))
+
+ (message "\n;; Starting generation of LL(1) tables..\n")
+
+ (unless (parser-generator-ll--valid-grammar-k-eq-1-p)
+ (error "Invalid LL(1) grammar specified!"))
+
+ (setq
+ list-parsing-table
+ (parser-generator-ll--generate-action-table-k-eq-1
+ (parser-generator-ll--generate-goto-table))))
+
+ ;; Convert list-structure to hash-map
+ (dolist (state-list list-parsing-table)
+ (let ((state-key (nth 0 state-list))
+ (state-look-aheads (nth 1 state-list))
+ (state-hash-table (make-hash-table :test 'equal)))
+ (dolist (state-look-ahead-list state-look-aheads)
+ (let ((state-look-ahead-string (nth 0 state-look-ahead-list))
+ (state-look-ahead-action (nth 1 state-look-ahead-list)))
+ (if (equal state-look-ahead-action 'reduce)
+ (let ((state-look-ahead-reduction
+ (nth 2 state-look-ahead-list))
+ (state-look-ahead-production-number
+ (nth 3 state-look-ahead-list)))
+ (puthash
+ (format "%S" state-look-ahead-string)
+ (list
+ state-look-ahead-action
+ state-look-ahead-reduction
+ state-look-ahead-production-number)
+ state-hash-table))
+ (puthash
+ (format "%S" state-look-ahead-string)
+ state-look-ahead-action
+ state-hash-table))))
+ (puthash
+ (format "%S" state-key)
+ state-hash-table
+ hash-parsing-table)))
+ (setq
+ parser-generator-ll--table
+ hash-parsing-table)
+
+ (if (> parser-generator--look-ahead-number 1)
+ (message "\n;; Completed generation of LL(k) tables.\n")
+ (message "\n;; Completed generation of LL(1) tables.\n"))))
+
+(defun parser-generator-ll-parse ()
+ (let ((parse (parser-generator-ll--parse)))
+ (car parse)))
+
+(defun parser-generator-ll-translate ()
+ (let ((parse (parser-generator-ll--parse t)))
+ (car (cdr parse))))
+
+;; Generally described at .p 339
+(defun parser-generator-ll--parse (&optional translate-p)
+ "Parse input via lex-analyzer and return parse trail."
+ (let ((accept)
+ (stack
+ (if (> parser-generator--look-ahead-number 1)
+ (list
+ (list
+ (list
+ (parser-generator--get-grammar-start))
+ (parser-generator--generate-list-of-symbol
+ parser-generator--look-ahead-number
+ parser-generator--eof-identifier))
+ parser-generator--eof-identifier)
+ (list
+ (parser-generator--get-grammar-start)
+ parser-generator--eof-identifier)))
+ (output)
+ (eof-look-ahead
+ (parser-generator--generate-list-of-symbol
+ parser-generator--look-ahead-number
+ parser-generator--eof-identifier))
+ (e-reduction
+ (list parser-generator--e-identifier))
+ (translation)
+ (translation-stack)
+ (translation-symbol-table
+ (make-hash-table :test 'equal))
+ (terminal-stack '()))
+ (parser-generator-lex-analyzer--reset)
+ (while (not accept)
+ (let* ((state (car stack))
+ (state-action-table
+ (gethash
+ (format "%S" state)
+ parser-generator-ll--table))
+ (look-ahead-list
+ (parser-generator-lex-analyzer--peek-next-look-ahead))
+ (look-ahead))
+ (parser-generator--debug
+ (message "\nstack: %S" stack)
+ (message "translation-stack: %S" translation-stack)
+ (message "output: %S" output)
+ (message "state: %S" state)
+ (message "state-action-table: %S" state-action-table))
+
+ (unless state-action-table
+ (signal
+ 'error
+ (list
+ (format
+ "State action table lacks actions for state: '%S'!"
+ state)
+ state)))
+
+ (if look-ahead-list
+ (progn
+ (parser-generator--debug
+ (message "look-ahead-list: %S" look-ahead-list))
+ (dolist (look-ahead-list-item look-ahead-list)
+ (push (car look-ahead-list-item) look-ahead))
+ (setq look-ahead (reverse look-ahead)))
+ (setq
+ look-ahead
+ eof-look-ahead))
+
+ (parser-generator--debug
+ (message "look-ahead: %S" look-ahead))
+
+ (unless (gethash
+ (format "%S" look-ahead)
+ state-action-table)
+ (let ((possible-look-aheads))
+ (maphash
+ (lambda (k _v) (push k possible-look-aheads))
+ state-action-table)
+ (signal
+ 'error
+ (list
+ (format
+ "Invalid look-ahead '%S' in state: '%S', valid look-aheads:
'%S'"
+ look-ahead
+ state
+ possible-look-aheads)
+ look-ahead
+ state
+ possible-look-aheads))))
+
+ (let* ((action
+ (gethash
+ (format "%S" look-ahead)
+ state-action-table))
+ (action-type action))
+ (parser-generator--debug
+ (message "action: %S" action))
+ (when (listp action)
+ (setq action-type (car action)))
+ (parser-generator--debug
+ (message "action-type: %S" action-type))
+ (cond
+
+ ((equal action-type 'pop)
+ (parser-generator--debug
+ (message "popped: %S" look-ahead))
+ (let ((popped-tokens
+ (parser-generator-lex-analyzer--pop-token)))
+
+ ;; Is it time for SDT?
+ (when (and
+ translate-p
+ translation-stack
+ (string=
+ (car (car translation-stack))
+ (format "%S" stack)))
+ (let* ((translation-item (pop translation-stack))
+ (partial-translation
+ (parser-generator-ll--perform-translation
+ (nth 1 translation-item)
+ translation-symbol-table
+ (reverse (pop terminal-stack)))))
+ (setq
+ translation
+ partial-translation)))
+
+ (pop stack)
+
+ (when translate-p
+ (let ((token-data)
+ (old-terminal-stack (car terminal-stack)))
+ (dolist (popped-token popped-tokens)
+ (push
+ popped-token
+ token-data))
+ (push
+ token-data
+ old-terminal-stack)
+ (setf
+ (car terminal-stack)
+ old-terminal-stack)))
+
+ ;; Is it time for SDT?
+ (when (and
+ translate-p
+ translation-stack
+ (string=
+ (car (car translation-stack))
+ (format "%S" stack)))
+ (let* ((translation-item (pop translation-stack))
+ (partial-translation
+ (parser-generator-ll--perform-translation
+ (nth 1 translation-item)
+ translation-symbol-table
+ (reverse (pop terminal-stack)))))
+ (setq
+ translation
+ partial-translation)))
+
+ ))
+
+ ((equal action-type 'reduce)
+ (parser-generator--debug
+ (message "reduced: %S -> %S" state (nth 1 action)))
+
+ ;; Is it time for SDT?
+ (when (and
+ translate-p
+ translation-stack
+ (string=
+ (car (car translation-stack))
+ (format "%S" stack)))
+ (let* ((translation-item (pop translation-stack))
+ (partial-translation
+ (parser-generator-ll--perform-translation
+ (nth 1 translation-item)
+ translation-symbol-table
+ (reverse (pop terminal-stack)))))
+ (setq
+ translation
+ partial-translation)))
+
+ (pop stack)
+
+ ;; Is it time for SDT?
+ (when (and
+ translate-p
+ translation-stack
+ (string=
+ (car (car translation-stack))
+ (format "%S" stack)))
+ (let* ((translation-item (pop translation-stack))
+ (partial-translation
+ (parser-generator-ll--perform-translation
+ (nth 1 translation-item)
+ translation-symbol-table
+ (reverse (pop terminal-stack)))))
+ (setq
+ translation
+ partial-translation)))
+
+ (when translate-p
+ (push
+ (list
+ (format "%S" stack)
+ (nth 2 action))
+ translation-stack)
+ (push
+ '()
+ terminal-stack))
+
+ (unless (equal (nth 1 action) e-reduction)
+ (dolist (reduce-item (reverse (nth 1 action)))
+ (push reduce-item stack)))
+ (push
+ (nth 2 action)
+ output))
+
+ ((equal action-type 'accept)
+ (setq accept t))))))
+ (list
+ (reverse output)
+ translation)))
+
+(defun parser-generator-ll--perform-translation (production-number
symbol-table terminals)
+ "Perform translation by PRODUCTION-NUMBER, with SYMBOL-TABLE and TERMINALS."
+ (let* ((production
+ (parser-generator--get-grammar-production-by-number
+ production-number))
+ (production-lhs
+ (car (nth 0 production)))
+ (production-rhs
+ (nth 1 production))
+ (translation)
+ (args-1)
+ (args-2))
+ (parser-generator--debug
+ (message
+ "Perform translation %S %S %S = %S"
+ production-number
+ symbol-table
+ terminals
+ production-rhs))
+
+ ;; Collect arguments for translation
+ (let ((terminal-index 0))
+ (dolist (rhs-item production-rhs)
+ (cond
+
+ ((parser-generator--valid-non-terminal-p
+ rhs-item)
+ (let* ((non-terminal-value-list
+ (gethash rhs-item symbol-table))
+ (non-terminal-value
+ (pop non-terminal-value-list)))
+ (push
+ (car non-terminal-value)
+ args-1)
+ (push
+ (car (cdr non-terminal-value))
+ args-2)
+ (puthash
+ rhs-item
+ non-terminal-value-list
+ symbol-table)))
+
+ ((parser-generator--valid-terminal-p
+ rhs-item)
+ (push
+ (parser-generator-lex-analyzer--get-function
+ (nth terminal-index terminals))
+ args-1)
+ (push
+ (nth terminal-index terminals)
+ args-2)
+ (setq
+ terminal-index
+ (1+ terminal-index))))))
+ (setq
+ args-1
+ (reverse args-1))
+ (setq
+ args-2
+ (reverse args-2))
+
+ (parser-generator--debug
+ (message
+ "Perform translation %d: %S -> %S via args-1: %S and args-2: %S"
+ production-number
+ production-lhs
+ production-rhs
+ args-1
+ args-2))
+
+ (if (parser-generator--get-grammar-translation-by-number
+ production-number)
+ (let ((partial-translation
+ (funcall
+ (parser-generator--get-grammar-translation-by-number
+ production-number)
+ args-1
+ args-2))
+ (old-symbol-value
+ (gethash production-lhs symbol-table)))
+ (parser-generator--debug
+ (message
+ "\ntranslation-symbol-table: %S = %S (processed)\n"
+ production-lhs
+ partial-translation))
+ (push
+ (list
+ partial-translation
+ args-2)
+ old-symbol-value)
+ (puthash
+ production-lhs
+ old-symbol-value
+ symbol-table)
+ (setq
+ translation
+ partial-translation))
+
+ ;; When no translation is specified just use popped contents as
translation
+ (let ((partial-translation
+ (list
+ args-1
+ args-2))
+ (old-symbol-value
+ (gethash production-lhs symbol-table)))
+ (parser-generator--debug
+ (message
+ "\ntranslation-symbol-table: %S = %S (generic)\n"
+ production-lhs
+ partial-translation))
+ (push
+ partial-translation
+ old-symbol-value)
+ (puthash
+ production-lhs
+ old-symbol-value
+ symbol-table)
+ (setq
+ translation
+ (car partial-translation))))
+
+ translation))
+
+
+;;; Algorithms
+
+
+(defun parser-generator-ll--generate-action-table-k-eq-1 (goto-table)
+ "Generate action-table for LL(1) grammar using GOTO-TABLE."
+ (let ((parsing-table))
+
+ ;; Iterate all possible look-aheads
+ ;; Add EOF symbol look-ahead
+ (let ((eof-look-ahead
+ (parser-generator--generate-list-of-symbol
+ parser-generator--look-ahead-number
+ parser-generator--eof-identifier))
+ (terminal-mutations
+ (parser-generator--get-grammar-look-aheads))
+ (terminal-buffer)
+ (last-terminal))
+ (dolist (terminal-mutation terminal-mutations)
+ (if (equal terminal-mutation eof-look-ahead)
+ (push
+ (list
+ parser-generator--eof-identifier
+ (list
+ (list
+ eof-look-ahead
+ 'accept)))
+ parsing-table)
+ (let ((stack-item (nth 0 terminal-mutation)))
+ (when (and
+ last-terminal
+ (not (equal last-terminal stack-item)))
+ (push
+ (list
+ last-terminal
+ terminal-buffer)
+ parsing-table)
+ (setq
+ terminal-buffer
+ nil))
+ (push
+ (list terminal-mutation 'pop)
+ terminal-buffer)
+ (setq
+ last-terminal
+ stack-item))))
+ (when (and
+ last-terminal
+ terminal-buffer)
+ (push
+ (list
+ last-terminal
+ terminal-buffer)
+ parsing-table)))
+
+ ;; Add non-terminal -> FIRST(non-terminal) -> reduce RHS, production-number
+ (let ((non-terminal-look-ahead-p (make-hash-table :test 'equal))
+ (non-terminal-look-ahead-list (make-hash-table :test 'equal)))
+ (dolist (goto-row goto-table)
+ (let* ((stack (nth 0 goto-row))
+ (non-terminal (car (nth 0 stack)))
+ (local-follows (nth 1 stack))
+ (look-aheads (nth 1 goto-row)))
+ (parser-generator--debug
+ (message "\nnon-terminal: %S" non-terminal)
+ (message "local-follows: %S" local-follows)
+ (message "look-aheads: %S" look-aheads))
+ (dolist (look-ahead look-aheads)
+ (let* ((rhs
+ (nth 1 look-ahead))
+ (production
+ (list (list non-terminal) rhs))
+ (production-number
+ (parser-generator--get-grammar-production-number
+ production))
+ (look-ahead-terminal
+ (nth 0 look-ahead))
+ (hashmap-key
+ (format "%S-%S" non-terminal look-ahead-terminal)))
+ (parser-generator--debug
+ (message "\nrhs: %S" rhs)
+ (message "production: %S" production)
+ (message "production-number: %S" production-number)
+ (message "hashmap-key: %S" hashmap-key))
+ (unless (gethash hashmap-key non-terminal-look-ahead-p)
+ (let ((old-non-terminal-look-aheads
+ (gethash
+ non-terminal
+ non-terminal-look-ahead-list)))
+ (push
+ (list
+ look-ahead-terminal
+ 'reduce
+ rhs
+ production-number)
+ old-non-terminal-look-aheads)
+ (puthash
+ non-terminal
+ old-non-terminal-look-aheads
+ non-terminal-look-ahead-list)
+ (puthash
+ hashmap-key
+ t
+ non-terminal-look-ahead-p)))))))
+ (maphash
+ (lambda (non-terminal look-ahead)
+ (push
+ (list
+ non-terminal
+ look-ahead)
+ parsing-table))
+ non-terminal-look-ahead-list))
+
+ parsing-table))
+
+;; Algorithm 5.2 p. 350
+(defun parser-generator-ll--generate-goto-table ()
+ "Construction of LL(k) GOTO-table. Output the set of LL(k) tables needed to
construct a action table for the grammar G."
+ (let ((tables (make-hash-table :test 'equal))
+ (distinct-item-p (make-hash-table :test 'equal))
+ (stack)
+ (distinct-stack-item-p (make-hash-table :test 'equal))
+ (stack-item))
+
+ ;; (1) Construct T_0, the LL(k) table associated with S {e}
+ (let* ((start (parser-generator--get-grammar-start))
+ (start-rhss (parser-generator--get-grammar-rhs start)))
+ (dolist (start-rhs start-rhss)
+ (let* ((initial-stack-item
+ (list
+ (list start)
+ start-rhs
+ (parser-generator--generate-list-of-symbol
+ parser-generator--look-ahead-number
+ parser-generator--eof-identifier))))
+ (puthash
+ initial-stack-item
+ t
+ distinct-stack-item-p)
+ (push
+ initial-stack-item
+ stack))))
+
+ (setq stack (nreverse stack))
+ (parser-generator--debug
+ (message "stack: %S" stack))
+
+ (while stack
+ (setq stack-item (pop stack))
+ (let* ((production-lhs
+ (nth 0 stack-item))
+ (production-rhs
+ (nth 1 stack-item))
+ (parent-follow
+ (nth 2 stack-item))
+ (concatenated-follow
+ (append production-rhs parent-follow))
+ (first-concatenated-follow
+ (parser-generator--first concatenated-follow nil t t))
+ (look-aheads
+ (parser-generator--merge-max-terminal-sets
+ first-concatenated-follow))
+ (sets))
+
+ (parser-generator--debug
+ (message "\nproduction-lhs: %S" production-lhs)
+ (message "production-rhs: %S" production-rhs)
+ (message "parent-follow: %S" parent-follow)
+ (message "concatenated-follow: %S" concatenated-follow)
+ (message "first-concatenated-follow: %S" first-concatenated-follow)
+ (message "look-aheads: %S" look-aheads))
+
+ ;; For each non-terminal in the production right-hand side
+ ;; push a new item to stack with a local-follow
+ ;; and a new left-hand-side
+ (let ((sub-symbol-index 0)
+ (sub-symbol-length (length production-rhs)))
+ (while (< sub-symbol-index sub-symbol-length)
+ (let ((sub-symbol (nth sub-symbol-index production-rhs)))
+ (when (parser-generator--valid-non-terminal-p
+ sub-symbol)
+ (let* ((follow-set
+ (nthcdr (1+ sub-symbol-index) production-rhs))
+ (concatenated-follow-set
+ (append follow-set parent-follow))
+ (first-concatenated-follow-set
+ (parser-generator--first concatenated-follow-set nil t
t))
+ (local-follow-set
+ (parser-generator--merge-max-terminal-sets
+ first-concatenated-follow-set
+ nil
+ t))
+ (sub-symbol-rhss
+ (parser-generator--get-grammar-rhs
+ sub-symbol)))
+ (parser-generator--debug
+ (message
+ "\nnon-terminal sub-symbol: %S" sub-symbol)
+ (message
+ "follow-set: %S for %S in %S"
+ follow-set
+ (nth sub-symbol-index production-rhs)
+ production-rhs)
+ (message
+ "concatenated-follow-set: %S"
+ concatenated-follow-set)
+ (message
+ "first-concatenated-follow-set: %S"
+ first-concatenated-follow-set)
+ (message
+ "local-follow-set: %S"
+ local-follow-set)
+ (message
+ "sub-symbol-rhss: %S"
+ sub-symbol-rhss))
+ (unless local-follow-set
+ (setq local-follow-set '(nil)))
+
+ (push
+ local-follow-set
+ sets)
+ (parser-generator--debug
+ (message
+ "pushed local follow set to sets: %S"
+ local-follow-set))
+ (dolist (local-follow local-follow-set)
+ (dolist (sub-symbol-rhs sub-symbol-rhss)
+ (let* ((new-stack-item
+ (list
+ (list sub-symbol)
+ sub-symbol-rhs
+ local-follow)))
+ (unless (gethash
+ new-stack-item
+ distinct-stack-item-p)
+ (parser-generator--debug
+ (message
+ "new-stack-item: %S"
+ new-stack-item))
+ (puthash
+ new-stack-item
+ t
+ distinct-stack-item-p)
+ (push
+ new-stack-item
+ stack))))))))
+ (setq
+ sub-symbol-index
+ (1+ sub-symbol-index))))
+
+ (setq sets (reverse sets))
+ (parser-generator--debug
+ (message
+ "\nsets: %S"
+ sets))
+
+ ;; Add all distinct combinations of left-hand-side,
+ ;; look-aheads and parent-follow to tables list here
+ (when look-aheads
+ (dolist (look-ahead look-aheads)
+ (let ((table
+ (list
+ look-ahead
+ production-rhs
+ sets))
+ (item-hash-key
+ (format
+ "%S-%S-%S"
+ production-lhs
+ parent-follow
+ look-ahead))
+ (table-hash-key
+ (list
+ production-lhs
+ parent-follow)))
+
+ ;; Only add distinct items
+ (unless (gethash item-hash-key distinct-item-p)
+ (puthash
+ item-hash-key
+ t
+ distinct-item-p)
+ (parser-generator--debug
+ (message "\nnew table: %S" table))
+ (if (gethash
+ table-hash-key
+ tables)
+ (puthash
+ table-hash-key
+ (push
+ table
+ (gethash
+ table-hash-key
+ tables))
+ tables)
+ (puthash
+ table-hash-key
+ (list table)
+ tables))))))))
+
+ (let ((sorted-tables))
+ (maphash
+ (lambda (k v)
+ (push
+ (list k (sort v 'parser-generator--sort-list))
+ sorted-tables))
+ tables)
+ sorted-tables)))
+
+;; Algorithm 5.3 p. 351
+(defun parser-generator-ll--generate-action-table-k-gt-1 (tables)
+ "Generate a action table for an LL(k) grammar G and TABLES. Output M, a
valid parsing table for G."
+ (let ((parsing-table))
+
+ ;; (3) M($, e) = accept
+ ;; (2) M(a, av) = pop for all v in E where |E| = k-1
+ (let ((eof-look-ahead
+ (parser-generator--generate-list-of-symbol
+ parser-generator--look-ahead-number
+ parser-generator--eof-identifier))
+ (terminal-mutations
+ (parser-generator--get-grammar-look-aheads))
+ (terminal-buffer)
+ (last-terminal))
+ (dolist (terminal-mutation terminal-mutations)
+ (if (equal terminal-mutation eof-look-ahead)
+ (push
+ (list
+ parser-generator--eof-identifier
+ (list
+ (list
+ eof-look-ahead
+ 'accept)))
+ parsing-table)
+ (let ((stack-item (nth 0 terminal-mutation)))
+ (when (and
+ last-terminal
+ (not (equal last-terminal stack-item)))
+ (push
+ (list
+ last-terminal
+ terminal-buffer)
+ parsing-table)
+ (setq
+ terminal-buffer
+ nil))
+
+ (push
+ (list terminal-mutation 'pop)
+ terminal-buffer)
+ (setq
+ last-terminal
+ stack-item))))
+ (when (and
+ last-terminal
+ terminal-buffer)
+ (push
+ (list
+ last-terminal
+ terminal-buffer)
+ parsing-table)))
+
+ (dolist (table tables)
+ (let* ((key (nth 0 table))
+ (value (nth 1 table))
+ (left-hand-side (nth 0 key))
+ (parse-table))
+ (dolist (look-ahead-row value)
+ (let* ((look-ahead (nth 0 look-ahead-row))
+ (right-hand-side (nth 1 look-ahead-row))
+ (local-follow-sets (nth 2 look-ahead-row))
+ (non-terminal-index 0)
+ (sub-symbol-index 0)
+ (sub-symbol-length (length right-hand-side))
+ (production (list left-hand-side right-hand-side))
+ (production-number
+ (parser-generator--get-grammar-production-number
+ production))
+ (modified-right-hand-side))
+ (while (< sub-symbol-index sub-symbol-length)
+ (let ((sub-symbol (nth sub-symbol-index right-hand-side)))
+ (if (parser-generator--valid-non-terminal-p
+ sub-symbol)
+ (let ((local-follow
+ (car (nth non-terminal-index local-follow-sets))))
+ (push
+ (list
+ (list sub-symbol)
+ local-follow)
+ modified-right-hand-side)
+ (setq
+ non-terminal-index
+ (1+ non-terminal-index)))
+ (push
+ sub-symbol
+ modified-right-hand-side)))
+ (setq
+ sub-symbol-index
+ (1+ sub-symbol-index)))
+ (setq
+ modified-right-hand-side
+ (reverse modified-right-hand-side))
+
+ (push
+ (list
+ look-ahead
+ 'reduce
+ modified-right-hand-side
+ production-number)
+ parse-table)))
+ (push
+ (list
+ key
+ parse-table)
+ parsing-table)))
+
+ parsing-table))
+
+(defun parser-generator-ll--valid-grammar-k-eq-1-p ()
+ "Test for LL(1)-ness. Output t if grammar is LL(1), nil otherwise."
+ (let* ((non-terminals (parser-generator--get-grammar-non-terminals))
+ (non-terminal-length (length non-terminals))
+ (non-terminal-index 0)
+ (non-terminal)
+ (valid t))
+ (while (and
+ valid
+ (< non-terminal-index non-terminal-length))
+ (setq non-terminal (nth non-terminal-index non-terminals))
+ (let* ((rhss (parser-generator--get-grammar-rhs non-terminal))
+ (rhss-length (length rhss))
+ (rhss-index 0)
+ (rhs)
+ (look-aheads (make-hash-table :test 'equal)))
+ (while (and
+ valid
+ (< rhss-index rhss-length))
+ (setq rhs (nth rhss-index rhss))
+ (let* ((firsts-rhs (parser-generator--first rhs))
+ (firsts-rhs-length (length firsts-rhs))
+ (firsts-index 0)
+ (first-rhs))
+ (while (and
+ valid
+ (< firsts-index firsts-rhs-length))
+ (setq first-rhs (nth firsts-index firsts-rhs))
+ (let ((first-rhs-hash (format "%S" first-rhs)))
+ (if (gethash first-rhs-hash look-aheads)
+ (setq valid nil)
+ (puthash first-rhs-hash t look-aheads)))
+ (setq firsts-index (1+ firsts-index))))
+ (setq rhss-index (1+ rhss-index))))
+ (setq non-terminal-index (1+ non-terminal-index)))
+ valid))
+
+;; Algorithm 5.4 p. 357
+(defun parser-generator-ll--valid-grammar-k-gt-1-p ()
+ "Test for LL(k)-ness. Output t if grammar is LL(k), nil otherwise."
+ (let ((stack)
+ (stack-item)
+ (distinct-production-p (make-hash-table :test 'equal))
+ (valid t))
+
+ ;; (1) Construct T_0, the LL(k) table associated with S {e}
+ (let* ((start (parser-generator--get-grammar-start))
+ (start-rhss (parser-generator--get-grammar-rhs start)))
+ (dolist (start-rhs start-rhss)
+ (let* ((production (list (list start) start-rhs)))
+ (push
+ production
+ stack)
+ (puthash
+ production
+ t
+ distinct-production-p))))
+ (setq stack (nreverse stack))
+ (parser-generator--debug
+ (message "stack: %S" stack))
+
+ (while (and
+ stack
+ valid)
+ (setq stack-item (pop stack))
+ (let ((production-rhs
+ (nth 1 stack-item)))
+
+ ;; For each non-terminal in the production right-hand side
+ ;; push a new item to stack with a local-follow
+ ;; and a new left-hand-side
+ (let ((sub-symbol-index 0)
+ (sub-symbol-length (length production-rhs)))
+ (while (< sub-symbol-index sub-symbol-length)
+ (let ((sub-symbol (nth sub-symbol-index production-rhs)))
+ (when (parser-generator--valid-non-terminal-p
+ sub-symbol)
+ (let* ((local-follow
+ (nthcdr (1+ sub-symbol-index) production-rhs))
+ (first-local-follow-sets
+ (parser-generator--first local-follow nil t t))
+ (sub-symbol-rhss
+ (parser-generator--get-grammar-rhs sub-symbol))
+ (distinct-item-p
+ (make-hash-table :test 'equal)))
+ (parser-generator--debug
+ (message "\nsub-symbol: %S" sub-symbol)
+ (message "local-follow: %S" local-follow)
+ (message "first-local-follow-sets: %S"
first-local-follow-sets)
+ (message "sub-symbol-rhss: %S" sub-symbol-rhss))
+
+ ;; Calculate following terminals to see if there is a
conflict
+ (dolist (sub-symbol-rhs sub-symbol-rhss)
+ (let ((first-sub-symbol-rhs
+ (parser-generator--first sub-symbol-rhs nil t t)))
+ (let ((merged-terminal-sets
+ (parser-generator--merge-max-terminal-sets
+ first-sub-symbol-rhs
+ first-local-follow-sets)))
+ (parser-generator--debug
+ (message "sub-symbol-rhs: %S" sub-symbol-rhs)
+ (message "first-sub-symbol-rhs: %S"
first-sub-symbol-rhs)
+ (message "merged-terminal-sets: %S"
merged-terminal-sets))
+ (dolist (merged-terminal-set merged-terminal-sets)
+ (if (gethash
+ merged-terminal-set
+ distinct-item-p)
+ (progn
+ (setq valid nil)
+ (parser-generator--debug
+ (message
+ "merged-terminal-set: %S was not distinct"
+ merged-terminal-set)))
+ (puthash
+ merged-terminal-set
+ t
+ distinct-item-p)))))
+
+ ;; Add production to stack if it has not been added already
+ (let ((production
+ (list
+ (list sub-symbol)
+ sub-symbol-rhs)))
+ (unless
+ (gethash
+ production
+ distinct-production-p)
+ (push
+ production
+ stack)
+ (puthash
+ production
+ t
+ distinct-production-p)))))))
+ (setq
+ sub-symbol-index
+ (1+ sub-symbol-index))))))
+ valid))
+
+
+(provide 'parser-generator-ll)
+
+;;; parser-generator-ll.el ends here
diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index d57f691906..47c0baa3b3 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -254,13 +254,13 @@
(defun parser-generator-lr-generate-parser-tables ()
"Generate parsing tables for grammar."
- (message "\n;; Starting generation of parser-tables..\n")
+ (message "\n;; Starting generation of LR(k) parser-tables..\n")
(parser-generator-lr--generate-precedence-tables)
(let ((table-lr-items
(parser-generator-lr--generate-goto-tables)))
(parser-generator-lr--generate-action-tables
table-lr-items)
- (message "\n;; Completed generation of parser-tables.\n")
+ (message "\n;; Completed generation of LR(k) parser-tables.\n")
table-lr-items))
(defun parser-generator-lr--get-expanded-action-tables ()
diff --git a/parser-generator.el b/parser-generator.el
index 5ee265c407..2690799da0 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -367,7 +367,10 @@
(if (hash-table-p hash-table)
(progn
(maphash
- (lambda (k v) (push (list k v) result))
+ (lambda (k v)
+ (if (hash-table-p v)
+ (push (list k (parser-generator--hash-to-list v un-sorted))
result)
+ (push (list k v) result)))
hash-table)
(if un-sorted
(nreverse result)
@@ -662,6 +665,14 @@
(error "E-identifier must be a symbol or string!"))
(setq parser-generator--e-identifier e-identifier))
+(defun parser-generator-set-eof-identifier (eof-identifier)
+ "Set EOF-IDENTIFIER."
+ (unless (or
+ (stringp eof-identifier)
+ (symbolp eof-identifier))
+ (error "EOF-identifier must be a symbol or string!"))
+ (setq parser-generator--eof-identifier eof-identifier))
+
(defun parser-generator-set-look-ahead-number (k)
"Set look-ahead number K."
(unless (parser-generator--valid-look-ahead-number-p k)
@@ -1230,36 +1241,155 @@
look-ahead)))
(nreverse look-ahead)))
-(defun parser-generator--merge-max-terminals (a b k)
- "Merge terminals from A and B to a maximum length of K."
- (let ((merged)
+(defun parser-generator--merge-max-terminal-sets (a &optional b
allow-any-length)
+ "Calculate list of all lists of L1 (+) L2 which is a merge of all terminals
in lists A combined with all terminals in lists B but with maximum length of
the set look-ahead number."
+ (let ((a-length (length a))
+ (a-index 0)
+ (b-length (length b))
+ (merged-lists))
+ (cond
+ ((and a b)
+ (while (< a-index a-length)
+ (let ((a-element (nth a-index a))
+ (b-index 0))
+ (while (< b-index b-length)
+ (let ((b-element (nth b-index b)))
+ (when-let
+ ((merged-element
+ (parser-generator--merge-max-terminals
+ a-element
+ b-element
+ allow-any-length)))
+ (if merged-lists
+ (setq
+ merged-lists
+ (append
+ merged-lists
+ (list merged-element)))
+ (setq
+ merged-lists
+ (list merged-element)))))
+ (setq b-index (1+ b-index)))
+ (setq a-index (1+ a-index)))))
+ (a
+ (while (< a-index a-length)
+ (let ((a-element (nth a-index a)))
+ (when-let
+ ((merged-element
+ (parser-generator--merge-max-terminals
+ a-element
+ nil
+ allow-any-length)))
+ (if merged-lists
+ (setq
+ merged-lists
+ (append
+ merged-lists
+ (list merged-element)))
+ (setq
+ merged-lists
+ (list merged-element)))))
+ (setq a-index (1+ a-index))))
+
+ (b
+ (let ((b-index 0))
+ (while (< b-index b-length)
+ (let ((b-element (nth b-index b)))
+ (when-let
+ ((merged-element
+ (parser-generator--merge-max-terminals
+ nil
+ b-element
+ allow-any-length)))
+ (if merged-lists
+ (setq
+ merged-lists
+ (append
+ merged-lists
+ (list merged-element)))
+ (setq
+ merged-lists
+ (list merged-element)))))
+ (setq b-index (1+ b-index))))))
+ (setq
+ merged-lists
+ (parser-generator--distinct
+ merged-lists))
+ (setq
+ merged-lists
+ (sort
+ merged-lists
+ 'parser-generator--sort-list))
+ merged-lists))
+
+;; Lemma 5.1 p. 348
+(defun parser-generator--merge-max-terminals (a b &optional allow-any-length)
+ "Calculate L1 (+) L2 which is a merge of all terminals in A and B but with
exactly length of the set look-ahead number. Optionally ALLOW-ANY-LENGTH."
+ (let ((k (max 1 parser-generator--look-ahead-number))
+ (merged)
(merge-count 0)
- (continue t)
(a-element)
(a-index 0)
(a-length (length a))
(b-element)
(b-index 0)
- (b-length (length b)))
+ (b-length (length b))
+ (only-eof))
+
(while (and
(< a-index a-length)
- (< merge-count k)
- continue)
+ (< merge-count k))
(setq a-element (nth a-index a))
- (when (parser-generator--valid-e-p a-element)
- (setq continue nil))
- (push a-element merged)
+
+ (when (parser-generator--valid-eof-p
+ a-element)
+ (setq only-eof t))
+
+ (when (or
+ (and
+ only-eof
+ (parser-generator--valid-eof-p
+ a-element))
+ (and
+ (not only-eof)
+ (parser-generator--valid-terminal-p
+ a-element)))
+ (push a-element merged)
+ (setq merge-count (1+ merge-count)))
+
(setq a-index (1+ a-index)))
+
(while (and
(< b-index b-length)
- (< merge-count k)
- continue)
+ (< merge-count k))
(setq b-element (nth b-index b))
- (when (parser-generator--valid-e-p b-element)
- (setq continue nil))
- (push b-element merged)
+
+ (when (parser-generator--valid-eof-p
+ b-element)
+ (setq only-eof t))
+
+ (when (or
+ (and
+ only-eof
+ (parser-generator--valid-eof-p
+ b-element))
+ (and
+ (not only-eof)
+ (parser-generator--valid-terminal-p
+ b-element)))
+ (push b-element merged)
+ (setq merge-count (1+ merge-count)))
+
(setq b-index (1+ b-index)))
- (nreverse merged)))
+
+ (if (or
+ (and
+ allow-any-length
+ (> merge-count 0))
+ (and (not allow-any-length)
+ (= merge-count k)))
+ (nreverse merged)
+ nil)))
;; p. 357
(defun parser-generator--f-set (input-tape state stack)
@@ -1512,8 +1642,8 @@
;; Algorithm 5.5, p. 357
(defun parser-generator--first
- (β &optional disallow-e-first ignore-validation skip-sorting)
- "For sentential-form Β, calculate first terminals, optionally
DISALLOW-E-FIRST, IGNORE-VALIDATION and SKIP-SORTING."
+ (β &optional disallow-e-first ignore-validation skip-sorting
use-eof-for-trailing-symbols)
+ "For sentential-form Β, calculate first terminals, optionally
DISALLOW-E-FIRST, IGNORE-VALIDATION, SKIP-SORTING and
USE-EOF-FOR-TRAILING-SYMBOLS."
;; Make sure we are dealing with a list of symbols
(unless (listp β)
@@ -1644,8 +1774,13 @@
(parser-generator--valid-eof-p input-symbol)
(parser-generator--valid-terminal-p input-symbol))
(parser-generator--debug
- (message
- "symbol is a terminal, the e-identifier or the EOF-identifier"))
+ (cond
+ ((parser-generator--valid-e-p input-symbol)
+ (message "symbol is the e-identifier"))
+ ((parser-generator--valid-eof-p input-symbol)
+ (message "symbol is the EOF-identifier"))
+ ((parser-generator--valid-terminal-p input-symbol)
+ (message "symbol is a terminal"))))
(let ((expanded-list-index 0)
(expanded-list-count
(length expanded-lists)))
@@ -1706,7 +1841,9 @@
(setq
expanded-lists-index
(1+ expanded-lists-index)))
- (when (>= minimum-terminal-count k)
+ (when (and
+ minimum-terminal-count
+ (>= minimum-terminal-count k))
(setq still-looking nil)
(parser-generator--debug
(message
@@ -1866,14 +2003,18 @@
(missing-symbol-index 0))
(while (< missing-symbol-index missing-symbol-count)
(push
- parser-generator--e-identifier
+ (if use-eof-for-trailing-symbols
+ parser-generator--eof-identifier
+ parser-generator--e-identifier)
processed-list)
(setq
missing-symbol-index
(1+ missing-symbol-index)))
(parser-generator--debug
(message
- "Added %d trailing e-identifiers to set"
+ (if use-eof-for-trailing-symbols
+ "Added %d trailing EOF-identifiers to set"
+ "Added %d trailing e-identifiers to set")
missing-symbol-count))))
(when (> (length processed-list) k)
@@ -1999,6 +2140,93 @@
(parser-generator--distinct follow-set)))
follow-set))
+(defun parser-generator-generate-terminal-saturated-first-set (first-set)
+ "Generated a set from FIRST-SET with items that does not end with the
e-identifier if there is alternative items that continues with terminals."
+ (let ((max-terminal-count
+ (parser-generator-calculate-max-terminal-count
+ first-set))
+ (saturated-list))
+ (when (> max-terminal-count 0)
+ (setq
+ saturated-list
+ (parser-generator-generate-sets-of-terminals
+ first-set
+ max-terminal-count)))
+ saturated-list))
+
+(defun parser-generator-generate-sets-of-terminals (sets count)
+ "Generate set of terminals in sequence from SETS with COUNT."
+ (let ((sets-of-terminals)
+ (terminal-set-exists-p (make-hash-table :test 'equal)))
+ (dolist (set sets)
+ (let ((item-count (length set))
+ (item-index 0)
+ (only-terminals t)
+ (terminal-count 0)
+ (terminals))
+ (while (and
+ only-terminals
+ (< terminal-count count)
+ (< item-index item-count))
+ (let ((item (nth item-index set)))
+ (if (parser-generator--valid-terminal-p item)
+ (progn
+ (push
+ item
+ terminals)
+ (setq
+ terminal-count
+ (1+ terminal-count)))
+ (setq
+ only-terminals
+ nil)))
+ (setq
+ item-index
+ (1+ item-index)))
+ (when (and
+ only-terminals
+ (= terminal-count count)
+ (not
+ (gethash
+ terminals
+ terminal-set-exists-p)))
+ (puthash
+ terminals
+ t
+ terminal-set-exists-p)
+ (push
+ (reverse terminals)
+ sets-of-terminals))))
+ (reverse sets-of-terminals)))
+
+(defun parser-generator-calculate-max-terminal-count (sets)
+ "Calculate maximum number of terminals in sequence in SETS."
+ (let ((max-terminal-count 0))
+ (dolist (set sets)
+ (let ((item-count (length set))
+ (item-index 0)
+ (only-terminals t)
+ (terminal-count 0))
+ (while (and
+ only-terminals
+ (< item-index item-count))
+ (let ((item (nth item-index set)))
+ (if (parser-generator--valid-terminal-p item)
+ (setq
+ terminal-count
+ (1+ terminal-count))
+ (setq
+ only-terminals
+ nil)))
+ (setq
+ item-index
+ (1+ item-index)))
+ (when (> terminal-count max-terminal-count)
+ (setq
+ max-terminal-count
+ terminal-count))))
+ max-terminal-count))
+
(provide 'parser-generator)
diff --git a/test/parser-generator-ll-export-test.el
b/test/parser-generator-ll-export-test.el
new file mode 100644
index 0000000000..17d7ac0468
--- /dev/null
+++ b/test/parser-generator-ll-export-test.el
@@ -0,0 +1,176 @@
+;; parser-generator-ll-export-test.el --- Tests for Exported Generated LL(k)
Parser -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+
+
+;;; Commentary:
+
+
+;;; Code:
+
+
+(require 'parser-generator-ll-export)
+(require 'ert)
+
+(defun parser-generator-ll-export-test-to-elisp ()
+ "Test `parser-generator-ll-export-to-elisp'."
+ (message "Started tests for (parser-generator-ll-export-to-elisp)")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S
+ (a A a a (lambda(a b) (format "alfa %s laval" (nth 1 a))))
+ (b A b a (lambda(a b) (format "delta %s laval" (nth 1 a))))
+ )
+ (A
+ (b (lambda(a b) "sven"))
+ (e (lambda(a b) "ingrid"))
+ )
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3) (a 3 . 4)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (let ((export (parser-generator-ll-export-to-elisp "ba")))
+ (with-temp-buffer
+ (insert export)
+ (eval-buffer)
+ (should
+ (equal
+ t
+ (fboundp 'ba-parse)))
+ (should
+ (equal
+ t
+ (fboundp 'ba-translate)))
+ (when (fboundp 'ba-parse)
+ (should
+ (equal
+ '(1 3)
+ (ba-parse))))
+ (when (fboundp 'ba-translate)
+ (should
+ (equal
+ "delta ingrid laval"
+ (ba-translate))))))
+ (message "Passed exported test for example 5.16 p. 352")
+
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3) (b 3 . 4) (a 4 . 5)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (let ((export (parser-generator-ll-export-to-elisp "ba2")))
+ (with-temp-buffer
+ (insert export)
+ (eval-buffer)
+ (should
+ (equal
+ t
+ (fboundp 'ba2-parse)))
+ (should
+ (equal
+ t
+ (fboundp 'ba2-translate)))
+ (when (fboundp 'ba2-translate)
+ (should
+ (equal
+ "delta sven laval"
+ (ba2-translate))))))
+ (message "Passed exported test failing parse")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S (a A S) b)
+ (A a (b S A))
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((a 1 . 2) (b 2 . 3) (b 3 . 4) (a 4 . 5) (b 5 . 6)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (let ((export (parser-generator-ll-export-to-elisp "ba3")))
+ (with-temp-buffer
+ (insert export)
+ (eval-buffer)
+ (should
+ (equal
+ t
+ (fboundp 'ba3-parse)))
+ (should
+ (equal
+ t
+ (fboundp 'ba3-translate)))
+ (when (fboundp 'ba3-parse)
+ (should
+ (equal
+ '(0 3 1 2 1)
+ (ba3-parse))))))
+ (message "Passed exported test for example 5.5 p. 340")
+
+ (message "Passed tests for (parser-generator-ll-export-to-elisp)"))
+
+
+(defun parser-generator-ll-export-test ()
+ "Run test."
+ (parser-generator-ll-export-test-to-elisp))
+
+
+(provide 'parser-generator-ll-export-test)
+
+;;; parser-generator-ll-export-test.el ends here
diff --git a/test/parser-generator-ll-test.el b/test/parser-generator-ll-test.el
new file mode 100644
index 0000000000..5e927cbf3f
--- /dev/null
+++ b/test/parser-generator-ll-test.el
@@ -0,0 +1,943 @@
+;; parser-generator-ll-test.el --- Tests for LL(k) Parser Generator -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+
+
+;;; Commentary:
+
+
+;;; Code:
+
+
+(require 'parser-generator-ll)
+(require 'ert)
+
+(defun parser-generator-ll-test--generate-goto-table ()
+ "Test `parser-generator-ll--generate-goto-table'."
+ (message "Started tests for (parser-generator-ll--generate-goto-table)")
+
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S (a A a a) (b A b a))
+ (A b e)
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (let ((tables (parser-generator-ll--generate-goto-table)))
+ ;; (message "tables: %S" tables)
+ (should
+ (equal
+ tables
+ '(
+ (
+ ((A) (b a)) ;; T A,{ba}
+ (
+ ((b b) (b) nil)
+ ((b a) (e) nil)
+ )
+ )
+ (
+ ((A) (a a)) ;; T A,{aa}
+ (
+ ((a a) (e) nil)
+ ((b a) (b) nil)
+ )
+ )
+ (
+ ((S) ($ $)) ;; T0
+ (
+ ((a b) (a A a a) (((a a))))
+ ((a a) (a A a a) (((a a))))
+ ((b b) (b A b a) (((b a))))
+ )
+ )
+ )
+ )
+ ))
+ (message "Passed Example 5.14 p. 350 and 5.15 p. 351")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S e (a b A))
+ (A (S a a) b)
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (let* ((tables
+ (parser-generator-ll--generate-goto-table)))
+ ;; (message "tables: %S" tables)
+ (should
+ (equal
+ tables
+ '(
+ (
+ ((A) (a a)) ;; T3
+ (
+ ((a b) (S a a) (((a a))))
+ ((a a) (S a a) (((a a))))
+ ((b a) (b) nil)
+ )
+ )
+ (
+ ((S) (a a)) ;; T2
+ (
+ ((a b) (a b A) (((a a))))
+ ((a a) (e) nil)
+ )
+ )
+ (
+ ((A) ($ $)) ;; T1
+ (
+ ((a b) (S a a) (((a a))))
+ ((a a) (S a a) (((a a))))
+ ((b $) (b) nil)
+ )
+ )
+ (
+ ((S) ($ $)) ;; T0
+ (
+ (($ $) (e) nil)
+ ((a b) (a b A) ((($ $))))
+ )
+ )
+ )
+ ))
+ )
+ (message "Passed Example 5.17 p. 354")
+
+ (message "Passed tests for (parser-generator-ll--generate-goto-table)"))
+
+(defun parser-generator-ll-test--generate-action-table-k-gt-1 ()
+ "Test `parser-generator-ll--generate-action-table-k-gt-1'."
+ (message "Started tests for
(parser-generator-ll--generate-action-table-k-gt-1)")
+
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S (a A a a) (b A b a))
+ (A b e)
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (let* ((goto-table
+ (parser-generator-ll--generate-goto-table))
+ (action-table
+ (parser-generator-ll--generate-action-table-k-gt-1
+ goto-table)))
+ ;; (message "goto-table: %S" goto-table)
+ ;; (message "action-table: %S" action-table)
+ (should
+ (equal
+ '(
+ (
+ ((S) ($ $)) ;; T0
+ (
+ ((b b) reduce (b ((A) (b a)) b a) 1)
+ ((a a) reduce (a ((A) (a a)) a a) 0)
+ ((a b) reduce (a ((A) (a a)) a a) 0)
+ )
+ )
+ (
+ ((A) (a a)) ;; T1
+ (
+ ((b a) reduce (b) 2)
+ ((a a) reduce (e) 3)
+ )
+ )
+ (
+ ((A) (b a)) ;; T2
+ (
+ ((b a) reduce (e) 3)
+ ((b b) reduce (b) 2)
+ )
+ )
+ (b (((b b) pop) ((b a) pop) ((b $) pop)))
+ (a (((a b) pop) ((a a) pop) ((a $) pop)))
+ ($ ((($ $) accept)))
+ )
+ action-table)))
+ (message "Passed Example 5.15 p. 351 and 5.16 p. 352")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S e (a b A))
+ (A (S a a) b)
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (let* ((goto-table
+ (parser-generator-ll--generate-goto-table))
+ (action-table
+ (parser-generator-ll--generate-action-table-k-gt-1
+ goto-table)))
+ ;; (message "goto-tables: %S" goto-table)
+ ;; (message "action-table: %S" action-table)
+ (should
+ (equal
+ '(
+ (
+ ((S) ($ $)) ;; T0
+ (
+ ((a b) reduce (a b ((A) ($ $))) 1)
+ (($ $) reduce (e) 0)
+ )
+ )
+ (
+ ((A) ($ $)) ;; T1
+ (
+ ((b $) reduce (b) 3)
+ ((a a) reduce (((S) (a a)) a a) 2)
+ ((a b) reduce (((S) (a a)) a a) 2)
+ )
+ )
+ (
+ ((S) (a a)) ;; T2
+ (
+ ((a a) reduce (e) 0)
+ ((a b) reduce (a b ((A) (a a))) 1)
+ )
+ )
+ (
+ ((A) (a a)) ;; T3
+ (
+ ((b a) reduce (b) 3)
+ ((a a) reduce (((S) (a a)) a a) 2)
+ ((a b) reduce (((S) (a a)) a a) 2)
+ )
+ )
+ (b (((b b) pop) ((b a) pop) ((b $) pop)))
+ (a (((a b) pop) ((a a) pop) ((a $) pop)))
+ ($ ((($ $) accept)))
+ )
+ action-table)))
+ (message "Passed Example 5.17 p. 356")
+
+ (message "Passed tests for
(parser-generator-ll--generate-action-table-k-gt-1)"))
+
+(defun parser-generator-ll-test-parse ()
+ "Test `parser-generator-ll-parse'."
+ (message "Started tests for (parser-generator-ll-parse)")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S (a A a a) (b A b a))
+ (A b e)
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3) (a 3 . 4)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (should
+ (equal
+ '(1 3) ;; Example is indexed from 1 so that is why they have '(2 4)
+ (parser-generator-ll-parse)))
+ (message "Passed example 5.16 p. 352")
+
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (should-error
+ (parser-generator-ll-parse))
+ (message "Passed failing variant of example 5.16 p. 352")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S e (a b A))
+ (A (S a a) b)
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((a 1 . 2) (b 2 . 3) (a 3 . 4) (a 4 . 5)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (should
+ (equal
+ '(1 2 0) ;; Example is indexed from 1 so that is why they have '(2 3 1)
+ (parser-generator-ll-parse)))
+ (message "Passed example 5.17 p. 355")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S (a A S) b)
+ (A a (b S A))
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((a 1 . 2) (b 2 . 3) (b 3 . 4) (a 4 . 5) (b 5 . 6)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (should
+ (equal
+ '(0 3 1 2 1) ;; Example is indexed from 1 so that is why they have '(1 4 2
3 2)
+ (parser-generator-ll-parse)))
+ (message "Passed example 5.5 p. 340")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar
+ '(
+ (E E2 T T2 F)
+ ("a" "(" ")" "+" "*")
+ (
+ (E (T E2))
+ (E2 ("+" T E2) e)
+ (T (F T2))
+ (T2 ("*" F T2) e)
+ (F ("(" E ")") "a")
+ )
+ E
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '(("(" 1 . 2) ("a" 2 . 3) ("*" 3 . 4) ("a" 4 . 5) (")" 5 .
6)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (should
+ (equal
+ '(0 3 6 0 3 7 4 7 5 2 5 2) ;; Example is 1-indexed '(1 4 7 1 4 8 5 8 6 3 6
3)
+ (parser-generator-ll-parse)))
+ (message "Passed example 5.12 p. 346-347")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar
+ '(
+ (S F)
+ ("(" "a" ")" "+")
+ (
+ (S F)
+ (S ("(" S "+" F ")"))
+ (F "a")
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '(("(" 1 . 2) ("a" 2 . 3) ("+" 3 . 4) ("a" 4 . 5) (")" 5 .
6)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (should
+ (equal
+ '(1 0 2 2) ;; Example is 1 indexed '(2 1 3 3)
+ (parser-generator-ll-parse)))
+ (message "Passed example from Wikipedia")
+
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '(("(" 1 . 2) ("a" 2 . 3) ("+" 3 . 4) ("a" 4 . 5)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (should-error
+ (parser-generator-ll-parse))
+ (message "Passed failing variant of example from Wikipedia")
+
+ (message "Passed tests for (parser-generator-ll-parse)"))
+
+(defun parser-generator-ll-test-translate ()
+ "Test `parser-generator-ll-translate'."
+ (message "Started tests for (parser-generator-ll-translate)")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S
+ (a A a a (lambda(a b) (format "alfa %s laval" (nth 1 a))))
+ (b A b a (lambda(a b) (format "delta %s laval" (nth 1 a))))
+ )
+ (A
+ (b (lambda(a b) "sven"))
+ (e (lambda(a b) "ingrid"))
+ )
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3) (a 3 . 4)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (should
+ (equal
+ "delta ingrid laval"
+ (parser-generator-ll-translate)))
+ (message "Passed translation test 1")
+
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((b 1 . 2) (b 2 . 3) (b 3 . 4) (a 4 . 5)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (should
+ (equal
+ "delta sven laval"
+ (parser-generator-ll-translate)))
+ (message "Passed translation test 2")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S
+ (a A S (lambda(a b) (format "alfa %s %s" (nth 1 a) (nth 2 a))))
+ (b (lambda(a b) "beta"))
+ )
+ (A
+ (a (lambda(a b) "delta"))
+ (b S A (lambda(a b) (format "gamma %s %s" (nth 1 a) (nth 2 a))))
+ )
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ (setq
+ parser-generator-lex-analyzer--function
+ (lambda (index)
+ (let* ((string '((a 1 . 2) (b 2 . 3) (b 3 . 4) (a 4 . 5) (b 5 . 6)))
+ (string-length (length string))
+ (max-index index)
+ (tokens))
+ (while (and
+ (< (1- index) string-length)
+ (< (1- index) max-index))
+ (push (nth (1- index) string) tokens)
+ (setq index (1+ index)))
+ (nreverse tokens))))
+ (setq
+ parser-generator-lex-analyzer--get-function
+ (lambda (token)
+ (car token)))
+ (should
+ (equal
+ "beta"
+ (parser-generator-ll-translate)))
+ (message "Passed translation test 3")
+
+ (message "Passed tests for (parser-generator-ll-translate)"))
+
+(defun parser-generator-ll-test-generate-table ()
+ "Test `parser-generator-ll-generate-table'."
+ (message "Started tests for (parser-generator-ll-generate-table)")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S e (a b A))
+ (A (S a a) b)
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ ;; (message "parsing-table: %S" (parser-generator--hash-to-list
parser-generator-ll--table t))
+ (should
+ (equal
+ '(
+ ("((S) ($ $))"
+ (
+ ("(a b)" (reduce (a b ((A) ($ $))) 1))
+ ("($ $)" (reduce (e) 0))
+ )
+ )
+ ("((A) ($ $))"
+ (
+ ("(b $)" (reduce (b) 3))
+ ("(a a)" (reduce (((S) (a a)) a a) 2))
+ ("(a b)" (reduce (((S) (a a)) a a) 2))
+ )
+ )
+ ("((S) (a a))"
+ (
+ ("(a a)" (reduce (e) 0))
+ ("(a b)" (reduce (a b ((A) (a a))) 1))
+ )
+ )
+ ("((A) (a a))"
+ (
+ ("(b a)" (reduce (b) 3))
+ ("(a a)" (reduce (((S) (a a)) a a) 2))
+ ("(a b)" (reduce (((S) (a a)) a a) 2))
+ )
+ )
+ ("b" (("(b b)" pop) ("(b a)" pop) ("(b $)" pop)))
+ ("a" (("(a b)" pop) ("(a a)" pop) ("(a $)" pop)))
+ ("$" (("($ $)" accept)))
+ )
+ (parser-generator--hash-to-list
+ parser-generator-ll--table
+ t)))
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S (a A S) b)
+ (A a (b S A))
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (parser-generator-ll-generate-table)
+ ;; (message "parsing-table: %S" (parser-generator--hash-to-list
parser-generator-ll--table t))
+ (should
+ (equal
+ '(
+ ("S"
+ (
+ ("(b)" (reduce (b) 1))
+ ("(a)" (reduce (a A S) 0))
+ )
+ )
+ ("A"
+ (
+ ("(b)" (reduce (b S A) 3))
+ ("(a)" (reduce (a) 2))
+ )
+ )
+ ("b" (("(b)" pop)))
+ ("a" (("(a)" pop)))
+ ("$" (("($)" accept)))
+ )
+ (parser-generator--hash-to-list
+ parser-generator-ll--table
+ t)))
+
+ (message "Passed tests for (parser-generator-ll-generate-table)"))
+
+(defun parser-generator-ll-test--valid-grammar-k-gt-1-p ()
+ "Test `parser-generator-ll--valid-grammar-k-gt-1-p'."
+ (message "Started tests for (parser-generator-ll--valid-grammar-k-gt-1-p)")
+
+ ;; Example 5.14 p. 350
+ ;; Example 5.15 p. 351
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S (a A a a) (b A b a))
+ (A b e)
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (should
+ (equal
+ (parser-generator-ll--valid-grammar-k-gt-1-p)
+ t))
+ (message "Passed first valid test")
+
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S (a A a a) (b A b a))
+ (A b e a)
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (should
+ (equal
+ (parser-generator-ll--valid-grammar-k-gt-1-p)
+ nil))
+ (message "Passed second valid test")
+
+ (message "Passed tests for (parser-generator-ll--valid-grammar-k-gt-1-p)"))
+
+(defun parser-generator-ll-test--generate-action-table-k-eq-1 ()
+ "Test `parser-generator-ll--generate-action-table-k-eq-1'."
+ (message "Started tests for
(parser-generator-ll--generate-action-table-k-eq-1)")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar
+ '(
+ (S A)
+ (a b)
+ (
+ (S (a A S) b)
+ (A a (b S A))
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (let* ((tables
+ (parser-generator-ll--generate-action-table-k-eq-1
+ (parser-generator-ll--generate-goto-table))))
+ ;; (message "tables: %S" tables)
+ (should
+ (equal
+ '(
+ (S
+ (
+ ((b) reduce (b) 1)
+ ((a) reduce (a A S) 0)
+ )
+ )
+ (A
+ (
+ ((b) reduce (b S A) 3)
+ ((a) reduce (a) 2)
+ )
+ )
+ (b (((b) pop)))
+ (a (((a) pop)))
+ ($ ((($) accept)))
+ )
+ tables
+ )))
+ (message "Passed Example 5.5 p. 340")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar
+ '(
+ (E E2 T T2 F)
+ ("a" "(" ")" "+" "*")
+ (
+ (E (T E2))
+ (E2 ("+" T E2) e)
+ (T (F T2))
+ (T2 ("*" F T2) e)
+ (F ("(" E ")") "a")
+ )
+ E
+ )
+ )
+ (parser-generator-process-grammar)
+ (let ((tables
+ (parser-generator-ll--generate-action-table-k-eq-1
+ (parser-generator-ll--generate-goto-table))))
+ ;; (message "tables: %S" tables)
+ (should
+ (equal
+ '(
+ (E
+ (
+ (("a") reduce (T E2) 0)
+ (("(") reduce (T E2) 0)
+ )
+ )
+ (E2
+ (
+ (($) reduce (e) 2)
+ (("+") reduce ("+" T E2) 1)
+ ((")") reduce (e) 2)
+ )
+ )
+ (T
+ (
+ (("a") reduce (F T2) 3)
+ (("(") reduce (F T2) 3)
+ )
+ )
+ (T2
+ (
+ (("+") reduce (e) 5)
+ ((")") reduce (e) 5)
+ (("*") reduce ("*" F T2) 4)
+ (($) reduce (e) 5)
+ )
+ )
+ (F
+ (
+ (("a") reduce ("a") 7)
+ (("(") reduce ("(" E ")") 6)
+ )
+ )
+ ("a" ((("a") pop)))
+ ("+" ((("+") pop)))
+ ("*" ((("*") pop)))
+ (")" (((")") pop)))
+ ("(" ((("(") pop)))
+ ($ ((($) accept)))
+ )
+ tables)))
+ (message "Passed Example 5.12 p. 346-347")
+
+ (message "Passed tests for
(parser-generator-ll--generate-action-table-k-eq-1)"))
+
+(defun parser-generator-ll-test--valid-grammar-k-eq-1-p ()
+ "Test `parser-generator-ll--valid-grammar-k-eq-1-p'."
+ (message "Started tests for (parser-generator-ll--valid-grammar-k-eq-1-p)")
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar
+ '(
+ (S A B)
+ (a b)
+ (
+ (S (a A S) b B)
+ (A a (b S A))
+ (B a)
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (should
+ (equal
+ nil
+ (parser-generator-ll--valid-grammar-k-eq-1-p)))
+
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar
+ '(
+ (S A B)
+ (a b c)
+ (
+ (S (a A S) b B)
+ (A a (b S A))
+ (B c)
+ )
+ S
+ )
+ )
+ (parser-generator-process-grammar)
+ (should
+ (equal
+ t
+ (parser-generator-ll--valid-grammar-k-eq-1-p)))
+
+ (message "Passed tests for (parser-generator-ll--valid-grammar-k-eq-1-p)"))
+
+
+(defun parser-generator-ll-test ()
+ "Run test."
+
+ ;; Helpers
+ (parser-generator-ll-test--generate-goto-table)
+
+ ;; k > 1
+ (parser-generator-ll-test--generate-action-table-k-gt-1)
+ (parser-generator-ll-test--valid-grammar-k-gt-1-p)
+
+ ;; k = 1
+ (parser-generator-ll-test--generate-action-table-k-eq-1)
+ (parser-generator-ll-test--valid-grammar-k-eq-1-p)
+
+ ;; Main stuff
+ (parser-generator-ll-test-generate-table)
+ (parser-generator-ll-test-parse)
+ (parser-generator-ll-test-translate))
+
+
+(provide 'parser-generator-ll-test)
+
+;;; parser-generator-ll-test.el ends here
diff --git a/test/parser-generator-test.el b/test/parser-generator-test.el
index 1fab673dc2..45dd865238 100644
--- a/test/parser-generator-test.el
+++ b/test/parser-generator-test.el
@@ -967,27 +967,41 @@
(message "Passed tests for (parser-generator--valid-terminal-p)"))
-(defun parser-generator-test--merge-max-terminals ()
- "Test `parser-generator--merge-max-terminals'."
- (message "Starting tests for (parser-generator--merge-max-terminals)")
+(defun parser-generator-test--merge-max-terminal-sets ()
+ "Test `parser-generator--merge-max-terminal-sets'."
+ (message "Starting tests for (parser-generator--merge-max-terminal-sets)")
+ (parser-generator-set-eof-identifier '$)
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-set-grammar '((S A B) (a b) ((S A) (S (B)) (B a) (A a) (A
(b a))) S))
+ (parser-generator-process-grammar)
+
+ ;; Example 5.13 p. 348
+ (should
+ (equal
+ '((a b) (b) (b a))
+ (parser-generator--merge-max-terminal-sets
+ '((a b b) (e))
+ '((b) (b a b))
+ t)))
+
+ ;; Example 5.14 p. 350
(should
(equal
- '(a b e)
- (parser-generator--merge-max-terminals
- '(a)
- '(b e)
- 3)))
+ '((a a) (a b) (b b))
+ (parser-generator--merge-max-terminal-sets
+ '((a b) (a e a) (b b) (b e b))
+ nil)))
(should
(equal
- '(a e)
- (parser-generator--merge-max-terminals
- '(a e)
- '(b e)
- 3)))
+ '(($ $) (a $) (a a))
+ (parser-generator--merge-max-terminal-sets
+ '((a e) ($))
+ '(($ $) (a $)))))
- (message "Passed tests for (parser-generator--merge-max-terminals)"))
+ (message "Passed tests for (parser-generator--merge-max-terminal-sets)"))
(defun parser-generator-test--get-list-permutations ()
"Test `parser-generator--get-list-permutations'."
@@ -1051,6 +1065,87 @@
(message "Passed tests for
(parser-generator-test--generate-list-of-symbol)"))
+(defun parser-generator-test--calculate-max-terminal-count ()
+ "Test `parser-generator-calculate-max-terminal-count'."
+ (message "Starting tests for
(parser-generator-calculate-max-terminal-count)")
+
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar '((S A B) ("a" "b") ((S A) (S (B)) (B "a") (A
"a") (A ("b" "a"))) S))
+ (parser-generator-process-grammar)
+
+ (should
+ (equal
+ (parser-generator-calculate-max-terminal-count
+ '(("a" "a") ("b") ("a" e "b" "c") (B "a" "b" "c")))
+ 2))
+ (should
+ (equal
+ (parser-generator-calculate-max-terminal-count
+ '(("a") ("b") ("a" e "b" "c") (B "a" "b" "c")))
+ 1))
+
+ (message "Passed tests for (parser-generator-calculate-max-terminal-count)"))
+
+(defun parser-generator-test--generate-sets-of-terminals ()
+ "Test `parser-generator--generate-sets-of-terminals'."
+ (message "Starting tests for (parser-generator--generate-sets-of-terminals)")
+
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar '((S A B) ("a" "b") ((S A) (S (B)) (B "a") (A
"a") (A ("b" "a"))) S))
+ (parser-generator-process-grammar)
+
+ (should
+ (equal
+ (parser-generator-generate-sets-of-terminals
+ '(("a" "a") ("b") ("b" "a") ("a" "b" "a") ("a" e S "b" "a") ("b" "b" A))
+ 2)
+ '(("a" "a") ("b" "a") ("a" "b") ("b" "b"))))
+
+ (should
+ (equal
+ (parser-generator-generate-sets-of-terminals
+ '(("a" "a") ("b") ("b" "a") ("a" "b" "a") ("a" e S "b" "a") ("b" "b" A))
+ 1)
+ '(("a") ("b"))))
+
+ (should
+ (equal
+ (parser-generator-generate-sets-of-terminals
+ '(("a" "a") ("b") ("b" "a") ("a" "b" "a") ("a" e S "b" "a") ("b" "b" A))
+ 3)
+ '(("a" "b" "a"))))
+
+ (should
+ (equal
+ (parser-generator-generate-sets-of-terminals
+ '(("a" e) ("b") ("b" "a") ("a" "b" "a") ("a" e S "b" "a") ("b" "b" A))
+ 1)
+ '(("a") ("b"))))
+
+ (message "Passed tests for (parser-generator--generate-sets-of-terminals)"))
+
+(defun parser-generator-test--generate-terminal-saturated-first-set ()
+ "Test `parser-generator-generate-terminal-saturated-first-set'."
+ (message "Starting tests for
(parser-generator-generate-terminal-saturated-first-set)")
+
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-set-grammar '((S A B) ("a" "b") ((S A) (S (B)) (B "a") (A
"a") (A ("b" "a"))) S))
+ (parser-generator-process-grammar)
+
+ (should
+ (equal
+ (parser-generator-generate-terminal-saturated-first-set
+ '(("a" "b") ("a" "a" e) ("b") ("a" e)))
+ '(("a" "b") ("a" "a"))))
+
+ (should
+ (equal
+ (parser-generator-generate-terminal-saturated-first-set
+ '(("a" "b") ("a" "a" e) ("b" "b") ("a" e)))
+ '(("a" "b") ("a" "a") ("b" "b"))))
+
+ (message "Passed tests for
(parser-generator-generate-terminal-saturated-first-set)"))
+
(defun parser-generator-test ()
"Run test."
;; (setq debug-on-error t)
@@ -1061,7 +1156,7 @@
(parser-generator-test--get-grammar-look-aheads)
(parser-generator-test--get-grammar-rhs)
(parser-generator-test--get-list-permutations)
- (parser-generator-test--merge-max-terminals)
+ (parser-generator-test--merge-max-terminal-sets)
(parser-generator-test--sort-list)
(parser-generator-test--valid-context-sensitive-attribute-p)
(parser-generator-test--valid-context-sensitive-attributes-p)
@@ -1074,6 +1169,9 @@
(parser-generator-test--valid-sentential-form-p)
(parser-generator-test--valid-terminal-p)
(parser-generator-test--generate-f-sets)
+ (parser-generator-test--calculate-max-terminal-count)
+ (parser-generator-test--generate-sets-of-terminals)
+ (parser-generator-test--generate-terminal-saturated-first-set)
;; Algorithms
(parser-generator-test--first)
