[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/parser-generator 6726c5231e 24/29: Fixed conflict
|
From: |
Christian Johansson |
|
Subject: |
[elpa] externals/parser-generator 6726c5231e 24/29: Fixed conflict |
|
Date: |
Sat, 12 Feb 2022 02:24:45 -0500 (EST) |
branch: externals/parser-generator
commit 6726c5231e1c73ec7d7a49a9a2aeb6b0c6b59e5c
Merge: add9d0072f 98dc561880
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>
Fixed conflict
---
parser-generator-lr.el | 11 +-
parser-generator.el | 1409 +++++++++++++++++++-------------------
test/parser-generator-lr-test.el | 27 +-
test/parser-generator-test.el | 34 +-
4 files changed, 755 insertions(+), 726 deletions(-)
diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 3718857c28..1f72ae7dd9 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -682,6 +682,11 @@
(parser-generator--debug
(message "%s actions %s" goto-index action-table))
(when action-table
+ (setq
+ action-table
+ (sort
+ action-table
+ 'parser-generator--sort-list))
(message
"ACTION-TABLE (%d): %S\n"
goto-index
@@ -689,11 +694,13 @@
(push
(list
goto-index
- (sort action-table 'parser-generator--sort-list))
+ action-table)
action-tables))))
(unless found-accept
(error "Failed to find an accept action in the generated
action-tables!"))
- (setq action-tables (nreverse action-tables))
+ (setq
+ action-tables
+ (nreverse action-tables))
(setq
parser-generator-lr--action-tables
(make-hash-table :test 'equal))
diff --git a/parser-generator.el b/parser-generator.el
index 6a3befc48a..0a2575efae 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -45,7 +45,7 @@
(defvar
parser-generator--debug
- t
+ nil
"Whether to print debug messages or not.")
(defvar
@@ -78,11 +78,6 @@
nil
"Generated F-sets for grammar.")
-(defvar
- parser-generator--f-free-sets
- nil
- "Generated e-free F-sets for grammar.")
-
(defvar
parser-generator--look-ahead-number
nil
@@ -161,9 +156,6 @@
(setq
parser-generator--f-sets
nil)
- (setq
- parser-generator--f-free-sets
- nil)
(setq
parser-generator--table-firsts
(make-hash-table :test 'equal)))
@@ -700,6 +692,7 @@
(parser-generator--valid-look-ahead-number-p
parser-generator--look-ahead-number)
(error "Invalid look-ahead number k!"))
+ (message "k = %d" parser-generator--look-ahead-number)
(unless parser-generator--grammar
(error "No grammar defined!"))
(unless
@@ -1051,220 +1044,183 @@
(defun parser-generator--generate-f-sets ()
"Generate F-sets for grammar."
;; Generate F-sets only once per grammar
- (unless (and
- parser-generator--f-sets
- parser-generator--f-free-sets)
+ (unless parser-generator--f-sets
(parser-generator--debug
(message "(parser-generator--generate-f-sets)"))
(let ((productions
(parser-generator--get-grammar-productions))
- (k
- (max
- 1
- parser-generator--look-ahead-number)))
- (let ((disallow-set '(nil t)))
- (parser-generator--debug
- (message "disallow-set: %s" disallow-set))
- (dolist (disallow-e-first disallow-set)
+ (k (max 1 parser-generator--look-ahead-number)))
+ (let ((f-sets (make-hash-table :test 'equal))
+ (i 0)
+ (max-i 100)
+ (expanded-all))
+
+ (while (not expanded-all)
+ (when (> i max-i)
+ (error "Endless loop!"))
(parser-generator--debug
- (message "disallow-e-first: %s" disallow-e-first))
- (let ((f-sets (make-hash-table :test 'equal))
- (i 0)
- (expanded-all nil)
- (expanded-all-second nil))
-
- (while (or
- (not expanded-all)
- (not expanded-all-second))
- ;; Make one iteration after everything has been expanded
- (when expanded-all
- (setq
- expanded-all-second
- t))
- (when (> i 100)
- (error "Endless loop!"))
- (parser-generator--debug
- (message "i = %s" i))
+ (message "i = %s" i))
+ (let ((f-set
+ (make-hash-table :test 'equal))
+ (distinct-lhs)
+ (distinct-lhs-p
+ (make-hash-table :test 'equal))
+ (previous-f-set))
+ (when (> i 0)
(setq
expanded-all
t)
- (let ((f-set (make-hash-table :test 'equal)))
-
- ;; Iterate all productions, set F_i
- (dolist (p productions)
- (let ((production-lhs (car p))
- (production-rhs (cdr p)))
- (parser-generator--debug
- (message
- "Production: %s -> %s"
- production-lhs
- production-rhs))
-
- ;; Iterate all blocks in RHS
- (let ((f-p-set)
- (rhs-expanded-full t))
- (dolist (rhs-p production-rhs)
- (let ((rhs-string rhs-p))
- (let ((rhs-leading-terminals)
- (f-set-return
- (parser-generator--f-set
- rhs-string
- `(
- ,k
- ,i
- ,f-sets
- ,disallow-e-first
- ,production-lhs)
- '((nil t 0)))))
-
- (parser-generator--debug
- (message
- "f-set-return: %s = %s"
- rhs-string
- f-set-return))
-
- (unless (nth 0 f-set-return)
- (let ((unexpanded-non-terminal
- (nth 1 f-set-return)))
- (cond
- ((equal
- unexpanded-non-terminal
- production-lhs)
- (parser-generator--debug
- (message
- "Production '%S' unexpanded due to
self-reference, ignore flag."
- production-lhs)))
- ((gethash
- unexpanded-non-terminal
- f-set)
- (parser-generator--debug
- (message
- "Production '%S' is un-expanded due to
reference to previously processed production '%S', ignore flag."
- production-lhs
- unexpanded-non-terminal
- )))
- (t
- (parser-generator--debug
- (message
- "Expanded-all negative set because
f-set-return '%s' is not fully expanded because '%s' is unexpanded"
- f-set-return
- (nth 1 f-set-return)))
- (setq
- rhs-expanded-full
- nil)
- (setq
- expanded-all
- nil)))))
-
- (setq
- rhs-leading-terminals
- (nth 2 f-set-return))
+ (setq
+ previous-f-set
+ (gethash
+ (1- i)
+ f-sets)))
- (parser-generator--debug
- (message
- "Leading %d terminals at index %s: %s -> %s = %s"
- k
- i
- production-lhs
- rhs-string
- rhs-leading-terminals))
- (parser-generator--debug
- (message
- "expanded-all: %s"
- expanded-all))
-
- (when rhs-leading-terminals
- (when (and
- (listp rhs-leading-terminals)
- (> (length rhs-leading-terminals) 0))
- (dolist
- (rhs-leading-terminals-element
- rhs-leading-terminals)
- (push
- rhs-leading-terminals-element
- f-p-set)))))))
-
- ;; If we have multiple equal LHS
- ;; merge them
- (when (
- gethash
- production-lhs
- f-set)
- (let ((existing-f-set
- (gethash
- production-lhs
- f-set)))
-
- ;; If another RHS has not been fully expanded
- ;; mark LHS as not fully expanded
- (unless (nth 0 existing-f-set)
- (parser-generator--debug
- (message
- "Expanded-all negative set for LHS '%s' because
a alternative RHS '%s' is not fully expanded"
- production-lhs
- existing-f-set))
- (setq
- expanded-all
- nil)
- (setq
- rhs-expanded-full
- nil))
+ ;; Iterate all productions, set F_i
+ (dolist (p productions)
+ (let ((production-lhs (car p))
+ (production-rhs (cdr p)))
+ (parser-generator--debug
+ (message
+ "Production: %s -> %s"
+ production-lhs
+ production-rhs))
+
+ ;; Iterate all blocks in RHS
+ (dolist (rhs-p production-rhs)
+ (let ((rhs-string rhs-p))
+ (let ((rhs-leading-symbols
+ (parser-generator--f-set
+ rhs-string
+ `(
+ ,k
+ ,i
+ ,f-sets
+ ,production-lhs)
+ '((nil nil 0)))))
- (setq f-p-set
- (append
- f-p-set
- (nth 1 existing-f-set)))))
+ (parser-generator--debug
+ (message
+ "\nrhs-leading-symbols: %S = %S"
+ rhs-string
+ rhs-leading-symbols))
- ;; Make set distinct
- (setq
- f-p-set
- (parser-generator--distinct
- f-p-set))
- (puthash
- production-lhs
- (list
- rhs-expanded-full
- (reverse f-p-set))
- f-set)
(parser-generator--debug
(message
- "F_%s%s = %s"
+ "Leading %d symbols at index %s: %s -> %s = %s"
+ k
i
production-lhs
- (gethash
- production-lhs
- f-set))))))
+ rhs-string
+ rhs-leading-symbols))
- (puthash
- i
- f-set
- f-sets)
- (setq
- i
- (+ i 1))))
+ (when rhs-leading-symbols
+ (if (gethash
+ production-lhs
+ f-set)
+ (puthash
+ production-lhs
+ (append
+ (gethash
+ production-lhs
+ f-set)
+ rhs-leading-symbols)
+ f-set)
+ (puthash
+ production-lhs
+ rhs-leading-symbols
+ f-set))
+
+ (unless (gethash
+ production-lhs
+ distinct-lhs-p)
+ (puthash
+ production-lhs
+ t
+ distinct-lhs-p)
+ (push
+ production-lhs
+ distinct-lhs))))))))
- (if disallow-e-first
- (progn
- (setq
- parser-generator--f-free-sets
+ ;; Iterate productions again
+ ;; make distinct sets and check if we found anything new
+ (dolist (production-lhs distinct-lhs)
+ (when (gethash
+ production-lhs
+ f-set)
+
+ ;; Make set distinct
+ (puthash
+ production-lhs
+ (parser-generator--distinct
+ (gethash
+ production-lhs
+ f-set))
+ f-set)
+
+ ;; Sort it for a more deterministic result
+ (puthash
+ production-lhs
+ (sort
+ (parser-generator--distinct
(gethash
- (1- i)
- f-sets))
+ production-lhs
+ f-set))
+ 'parser-generator--sort-list)
+ f-set)
+
+ ;; If this set differs from the last, keep expanding
+ (when (and
+ expanded-all
+ previous-f-set
+ (not
+ (equal
+ (gethash
+ production-lhs
+ f-set)
+ (gethash
+ production-lhs
+ previous-f-set))))
(parser-generator--debug
(message
- "E-FREE-FIRST max-index: %s, contents: %s"
+ "F_%s%s = %S is new compared to F_%s%s = %S"
+ i
+ production-lhs
+ (gethash
+ production-lhs
+ f-set)
(1- i)
- parser-generator--f-free-sets)))
- (setq
- parser-generator--f-sets
- (gethash
- (1- i)
- f-sets))
- (parser-generator--debug
- (message
- "FIRST max-index: %s, contents: %s"
- (1- i)
- parser-generator--f-sets)))))))
+ production-lhs
+ (gethash
+ production-lhs
+ previous-f-set)))
+ (setq
+ expanded-all
+ nil))))
+
+ (puthash
+ i
+ f-set
+ f-sets)
+ (parser-generator--debug
+ (message
+ "F_%s = %s"
+ i
+ f-set))
+ (setq
+ i
+ (1+ i))))
+
+ (setq
+ parser-generator--f-sets
+ (gethash
+ (1- i)
+ f-sets))
+ (parser-generator--debug
+ (message
+ "FIRST max-index: %s, contents: %s"
+ (1- i)
+ parser-generator--f-sets))))
(parser-generator--debug
(message "Generated F-sets"))))
@@ -1319,54 +1275,59 @@
(unless (listp input-tape)
(setq input-tape (list input-tape)))
(parser-generator--debug
- (message "(parser-generator--f-set)")
+ (message "\n(parser-generator--f-set)")
(message "input-tape: %s" input-tape)
- (message "stack: %s" stack))
+ (message "stack: %s" stack)
+ (message "state: %S" state))
(let ((f-set)
(input-tape-length (length input-tape))
(k (nth 0 state))
(i (nth 1 state))
- (f-sets (nth 2 state))
- (disallow-e-first (nth 3 state))
- (lhs (nth 4 state))
- (expanded-all t)
- (unexpanded-non-terminal nil))
+ (f-sets (nth 2 state)))
(parser-generator--debug
- (message "disallow-3-first: %s" disallow-e-first)
- (message "input-tape-length: %s" input-tape-length)
+ (message
+ "input-tape-length: %s"
+ input-tape-length)
(message "k: %s" k)
(message "i: %s" i))
(while stack
(let ((stack-symbol (pop stack)))
(parser-generator--debug
- (message "Stack-symbol: %s" stack-symbol))
- (let ((leading-terminals (nth 0 stack-symbol))
- (all-leading-terminals-p (nth 1 stack-symbol))
+ (message
+ "Stack-symbol: %s"
+ stack-symbol))
+ (let ((leading-symbols (nth 0 stack-symbol))
+ (leading-terminals (nth 1 stack-symbol))
(input-tape-index (nth 2 stack-symbol)))
(parser-generator--debug
- (message "leading-terminals 0: %s" leading-terminals)
- (message "all-leading-terminals-p: %s" all-leading-terminals-p)
- (message "input-tape-index: %s" input-tape-index))
-
- (when (and
- all-leading-terminals-p
- leading-terminals
- (parser-generator--valid-e-p
- (nth (1- (length leading-terminals)) leading-terminals)))
- (message "Not leading terminals: %s" leading-terminals)
- (setq all-leading-terminals-p nil))
-
- (let ((leading-terminals-count (length leading-terminals)))
+ (message
+ "leading-symbols 0: %s"
+ leading-symbols)
+ (message
+ "leading-terminals 0: %s"
+ leading-terminals)
+ (message
+ "input-tape-index: %s"
+ input-tape-index))
+
+ (let ((leading-terminals-count
+ (length leading-terminals))
+ (leading-symbols-count
+ (length leading-symbols))
+ (keep-iterating t))
(parser-generator--debug
- (message "leading-terminals-count: %s" leading-terminals-count))
+ (message
+ "leading-terminals-count: %s"
+ leading-terminals-count))
(while (and
+ keep-iterating
(< input-tape-index input-tape-length)
- (< leading-terminals-count k)
- all-leading-terminals-p)
- (let ((rhs-element (nth input-tape-index input-tape))
+ (< leading-terminals-count k))
+ (let ((rhs-element
+ (nth input-tape-index input-tape))
(rhs-type))
(parser-generator--debug
(message
@@ -1381,7 +1342,9 @@
(setq rhs-type 'E-IDENTIFIER))
((parser-generator--valid-terminal-p rhs-element)
(setq rhs-type 'TERMINAL))
- (t (error (format "Invalid symbol %s" rhs-element))))
+ ((parser-generator--valid-eof-p rhs-element)
+ (setq rhs-type 'EOF))
+ (t (error (format "Invalid symbol %s!" rhs-element))))
(parser-generator--debug
(message
"rhs-type: %s"
@@ -1391,9 +1354,7 @@
((equal rhs-type 'NON-TERMINAL)
(if (> i 0)
- (let ((sub-terminal-sets)
- (sub-terminal-expanded)
- (sub-terminal-data
+ (let ((sub-terminal-sets
(gethash
(list rhs-element)
(gethash
@@ -1401,36 +1362,9 @@
f-sets))))
(parser-generator--debug
(message
- "sub-terminal-data: %s = %s"
- rhs-element
- sub-terminal-data))
-
- (setq
- sub-terminal-expanded
- (nth 0 sub-terminal-data))
- (setq
- sub-terminal-sets
- (nth 1 sub-terminal-data))
-
- ;; When sub-set has not been fully expanded mark this
set
- ;; as not fully expanded either
- (when (and
- sub-terminal-data
- (not sub-terminal-expanded))
- (parser-generator--debug
- (message
- "Expanded-all negative set for '%s' because
sub-terminals of '%s' has not been fully expanded"
- lhs
- rhs-element))
- (setq
- unexpanded-non-terminal
- (list rhs-element))
- (setq
- all-leading-terminals-p
- nil)
- (setq
- expanded-all
- nil))
+ "sub-terminal-sets: %s = %s"
+ (list rhs-element)
+ sub-terminal-sets))
(if sub-terminal-sets
(progn
@@ -1441,148 +1375,89 @@
rhs-element
sub-terminal-sets
(length sub-terminal-sets)))
- (let ((sub-terminal-set (car sub-terminal-sets)))
-
- (unless (= (length sub-terminal-sets) 1)
-
- ;; Should branch off here, each unique
permutation should be included in set
- ;; Follow the first alternative in this
scope but follow the rest in separate scopes
- (let ((sub-terminal-index 0))
- (dolist (sub-terminal-alternative-set
sub-terminal-sets)
- (unless (= sub-terminal-index 0)
- (let
((alternative-all-leading-terminals-p all-leading-terminals-p))
- (parser-generator--debug
- (message
"Sub-terminal-alternative-set: %s" sub-terminal-alternative-set))
-
- ;; When sub-set only contains the e
identifier
- (if (parser-generator--valid-e-p
- (car
sub-terminal-alternative-set))
- (progn
- (parser-generator--debug
- (message "alternative-set is
the e identifier"))
-
- ;; Branch off here in two
separate tracks, one with the e-identifier appended and one without
- (if disallow-e-first
- (progn
- (when (and
-
all-leading-terminals-p
- (>
leading-terminals-count 0))
- (let ((branch `(
-
,leading-terminals
-
,all-leading-terminals-p
- ,(1+
input-tape-index))))
-
(parser-generator--debug (message "branched off 2: %s" branch))
- ;; Branch off here
with a separate track where this e-identifier is ignored
- (push branch
stack))))
-
- (when all-leading-terminals-p
- (let ((branch
- `(
- ,leading-terminals
-
,all-leading-terminals-p
- ,(1+
input-tape-index))))
- (parser-generator--debug
(message "branched off 1: %s" branch))
- ;; Branch off here with
a separate track where this e-identifier is ignored
- (push branch stack))))
-
- (when all-leading-terminals-p
- (let
((alternative-leading-terminals
- (append
- leading-terminals
- (list
parser-generator--e-identifier)))
-
(alternative-all-leading-terminals-p nil))
- (let ((branch
- `(
-
,alternative-leading-terminals
-
,alternative-all-leading-terminals-p
- ,(1+
input-tape-index))))
- (parser-generator--debug
(message "branched off 0: %s" branch))
- ;; Branch off here with
a separate track where this e-identifier is ignored
- (push branch stack)))))
-
- (let ((sub-terminal-index 0)
- (sub-terminal-length (length
sub-terminal-alternative-set))
- (sub-terminal-leading-p
alternative-all-leading-terminals-p)
- (sub-terminal)
- (sub-terminals (reverse
leading-terminals)))
- (while (and
- sub-terminal-leading-p
- (< sub-terminal-index
sub-terminal-length)
- (< (length
sub-terminals) k))
- (setq sub-terminal (nth
sub-terminal-index sub-terminal-alternative-set))
- (when
(parser-generator--valid-e-p sub-terminal)
- (setq sub-terminal-leading-p
nil))
- (push sub-terminal
sub-terminals)
- (setq sub-terminal-index (1+
sub-terminal-index)))
- (setq sub-terminals (reverse
sub-terminals))
- ;; (message "sub-terminals: %s
from %s (%s) + %s (%s)" sub-terminals leading-terminals (length
leading-terminals) sub-terminal-alternative-set (length
sub-terminal-alternative-set))
- (let ((branch
- `(
- ,sub-terminals
- ,sub-terminal-leading-p
- ,(1+
input-tape-index))))
- (parser-generator--debug
(message "branched off 3: %s" branch))
- (push branch stack))))))
- (setq sub-terminal-index (1+
sub-terminal-index)))))
-
- (parser-generator--debug
- (message "Sub-terminal-set: %s"
sub-terminal-set))
-
- ;; When sub-set only contains the e identifier
- (if (parser-generator--valid-e-p
- (car sub-terminal-set))
- (progn
+
+ ;; Should branch off here, each unique
permutation should be included in set
+ ;; Follow the first alternative in this scope
but follow the rest in separate scopes
+ (let ((sub-symbols-set-index 0)
+ (original-leading-symbols
+ leading-symbols)
+ (original-leading-terminals
+ leading-terminals))
+ (dolist (sub-symbol-alternative-set
sub-terminal-sets)
+ (parser-generator--debug
+ (message
+ "sub-symbol-alternative-set: %s"
+ sub-symbol-alternative-set))
+
+ (let ((sub-symbol-index 0)
+ (sub-symbol-length
+ (length
+ sub-symbol-alternative-set))
+ (sub-symbol)
+ (sub-symbols
+ (reverse original-leading-symbols))
+ (sub-terminals
+ (reverse original-leading-terminals)))
+ (while (and
+ (< sub-symbol-index
sub-symbol-length)
+ (< (length sub-terminals) k))
+ (setq
+ sub-symbol
+ (nth
+ sub-symbol-index
+ sub-symbol-alternative-set))
(parser-generator--debug
- (message "sub-terminal-set is the e
identifier"))
-
- ;; Branch off here in two separate
tracks, one with the e-identifier appended and one without
- (if disallow-e-first
- (progn
- (when (and
- all-leading-terminals-p
- (> leading-terminals-count
0))
- (let ((branch
- `(
- ,leading-terminals
- ,all-leading-terminals-p
- ,(1+
input-tape-index))))
- ;; Branch off here with a
separate track where this e-identifier is ignored
- (parser-generator--debug
(message "branched off 4: %s" branch))
- (push branch stack)))
-
- (setq all-leading-terminals-p nil))
-
- ;; Add e-identifier to leading
terminals when
- ;; we have not found any leading
terminals
- ;; and we are at the last symbol in
input-tape
-
- (when all-leading-terminals-p
- (let ((branch
- `(
- ,leading-terminals
- ,all-leading-terminals-p
- ,(1+ input-tape-index))))
- ;; Branch off here with a separate
track where this e-identifier is ignored
- (parser-generator--debug (message
"branched off 5: %s" branch))
- (push branch stack)))
-
- (parser-generator--debug (message
"leading-terminals-1: %s" leading-terminals))
- (setq leading-terminals
(parser-generator--merge-max-terminals leading-terminals sub-terminal-set k))
- (parser-generator--debug (message
"leading-terminals-2: %s" leading-terminals))
- (setq leading-terminals-count (length
leading-terminals))
- (setq all-leading-terminals-p nil)))
-
- (parser-generator--debug (message
"leading-terminals-3: %s" leading-terminals))
- (setq leading-terminals
(parser-generator--merge-max-terminals leading-terminals sub-terminal-set k))
- (parser-generator--debug (message
"leading-terminals-4: %s" leading-terminals))
- (setq leading-terminals-count (length
leading-terminals))
-
- (when
- (parser-generator--valid-e-p
- (nth (1- (length leading-terminals))
leading-terminals))
- (parser-generator--debug
- (message "after merge leading-terminals
end in e-identifier"))
- (setq all-leading-terminals-p nil)))))
+ (message
+ "sub-symbol: %S"
+ sub-symbol))
+ (push
+ sub-symbol
+ sub-symbols)
+ (unless (parser-generator--valid-e-p
sub-symbol)
+ (push
+ sub-symbol
+ sub-terminals))
+ (setq
+ sub-symbol-index
+ (1+ sub-symbol-index)))
+ (setq
+ sub-symbols
+ (reverse sub-symbols))
+ (setq
+ sub-terminals
+ (reverse sub-terminals))
+
+ ;; The first iteration does not branch off
+ (if (= sub-symbols-set-index 0)
+ (progn
+ (setq
+ leading-symbols
+ sub-symbols)
+ (setq
+ leading-symbols-count
+ (length leading-symbols))
+ (setq
+ leading-terminals
+ sub-terminals)
+ (setq
+ leading-terminals-count
+ (length leading-terminals)))
+ (let (
+ (branch
+ `(
+ ,sub-symbols
+ ,sub-terminals
+ ,(1+ input-tape-index))))
+ (parser-generator--debug
+ (message
+ "branched off 3: %s"
+ branch))
+ (push
+ branch
+ stack))))
+ (setq
+ sub-symbols-set-index
+ (1+ sub-symbols-set-index)))))
(parser-generator--debug
(message
@@ -1590,344 +1465,456 @@
rhs-element
(1- i)))
(setq
- unexpanded-non-terminal
- (list rhs-element))
- (setq
- all-leading-terminals-p
+ keep-iterating
nil)))
-
- (parser-generator--debug
- (message
- "Expanded-all negative set for '%s' because symbol '%s'
is a non-terminal and i is zero"
- lhs
- rhs-element))
- (setq
- expanded-all
- nil)
- (setq
- unexpanded-non-terminal
- (list rhs-element))
(setq
- all-leading-terminals-p
+ keep-iterating
nil)))
((equal rhs-type 'E-IDENTIFIER)
- (if disallow-e-first
- (progn
- (when (and
- all-leading-terminals-p
- (> leading-terminals-count 0))
- ;; Branch off here with a separate track where this
e-identifier is ignored
- (let ((branch
- `(
- ,leading-terminals
- ,all-leading-terminals-p
- ,(1+ input-tape-index))))
- (parser-generator--debug (message "branched off 6:
%s" branch))
- (push branch stack)))
-
- (setq all-leading-terminals-p nil))
- ;; Add e-identifier to leading terminals when
- ;; we have not found any leading terminals
- ;; and we are at the last symbol in input-tape
-
- (when all-leading-terminals-p
- ;; Branch off here with a separate track where this
e-identifier is ignored
- (let ((branch
- `(
- ,leading-terminals
- ,all-leading-terminals-p
- ,(1+ input-tape-index))))
- (parser-generator--debug (message "branched off 7: %s"
branch))
- (push branch stack)))
-
- (setq leading-terminals (append leading-terminals
rhs-element))
- (setq leading-terminals-count (1+ leading-terminals-count))
- (setq all-leading-terminals-p nil)))
-
- ((equal rhs-type 'TERMINAL)
- (setq leading-terminals (append leading-terminals (list
rhs-element)))
- (setq leading-terminals-count (1+ leading-terminals-count)))
-
- ))
- (setq input-tape-index (1+ input-tape-index)))
-
- (when (> leading-terminals-count 0)
- (unless (listp leading-terminals)
- (setq leading-terminals (list leading-terminals)))
+ (setq
+ leading-symbols
+ (append
+ leading-symbols
+ rhs-element))
+ (setq
+ leading-symbols-count
+ (1+ leading-symbols-count)))
+
+ ((or
+ (equal rhs-type 'TERMINAL)
+ (equal rhs-type 'EOF))
+ (setq
+ leading-symbols
+ (append
+ leading-symbols
+ (list rhs-element)))
+ (setq
+ leading-symbols-count
+ (1+ leading-symbols-count))
+ (setq
+ leading-terminals
+ (append
+ leading-terminals
+ (list rhs-element)))
+ (setq
+ leading-terminals-count
+ (1+ leading-terminals-count)))))
+
+ (setq
+ input-tape-index
+ (1+ input-tape-index)))
+
+ (when (> leading-symbols-count 0)
+ (unless (listp leading-symbols)
+ (setq
+ leading-symbols
+ (list leading-symbols)))
(parser-generator--debug
+ (message "leading-symbols 5: %s" leading-symbols)
(message "leading-terminals 5: %s" leading-terminals))
(push
- leading-terminals
+ leading-symbols
f-set))))))
- (list
- expanded-all
- unexpanded-non-terminal
- f-set)))
+ f-set))
;; Algorithm 5.5, p. 357
(defun parser-generator--first
- (
- β
- &optional
- disallow-e-first
- ignore-validation
- skip-sorting)
+ (β &optional disallow-e-first ignore-validation skip-sorting)
"For sentential-form Β, calculate first terminals, optionally
DISALLOW-E-FIRST, IGNORE-VALIDATION and SKIP-SORTING."
- (let ((hash-key
- (format
- "%S-%s"
- β
- disallow-e-first)))
- (unless
- (gethash
- hash-key
- parser-generator--table-firsts)
- (unless (listp β)
- (setq β (list β)))
+
+ ;; Make sure we are dealing with a list of symbols
+ (unless (listp β)
+ (setq β (list β)))
+
+ (parser-generator--debug
+ (if disallow-e-first
+ (message
+ "\nE-FREE-FIRST%S"
+ β)
+ (message
+ "\nFIRST%S"
+ β)))
+
+ ;; Cache first calculation
+ (let ((hash-key (format "%S-%s" β disallow-e-first)))
+ (unless (gethash
+ hash-key
+ parser-generator--table-firsts)
+
+ ;; Perform optional validation of inpuit
(unless (or
ignore-validation
(parser-generator--valid-sentential-form-p β))
(error "Invalid sentential form β! %s" β))
- (let ((k
- (max
- 1
- parser-generator--look-ahead-number)))
-
- ;; Generate F-sets only once per grammar
- (parser-generator--generate-f-sets)
-
- (let ((first-list nil)
- (first-items (make-hash-table :test 'equal)))
- ;; Iterate each symbol in β using a PDA algorithm
- (let ((input-tape β)
- (input-tape-length (length β))
- (stack '((0 0 nil))))
- (while stack
- (let ((stack-topmost (pop stack)))
+
+ ;; Generate F-sets only once per grammar
+ (parser-generator--generate-f-sets)
+
+ ;; Algorithm
+ ;; 1. Iterate each symbol of input and expand into list of lists of
terminals and the e-identifier
+ ;; if input symbol is a terminal, the e-identifier or the
EOF-identifier push it to each expanded list
+ ;; if input symbol is a non-terminal, expand it and push each
possible expansion onto each expanded list
+ ;; 2. Reverse each expanded list and place each list on a stack of
unprocessed lists each with a input-index to zero
+ ;; 3. Process each unprocessed list and expand into a list of lists of
terminals and the e-identifier
+ ;; pop a unprocessed list from the stack of unprocessed lists
+ ;; create a new empty list
+ ;; set skip-flag to false
+ ;; set loop-flag to true
+ ;; loop while index is below length and skip-flag is false
and loop-flag is true
+ ;; if a list starts with the e-identifier and it is
disallowed, set skip-flag to true to stop iterating
+ ;; if a symbol on a list is a terminal push it onto the
new list
+ ;; if a symbol on a the list is the e-identifier
+ ;; push a copy of the new list on the unprocessed
stack but increase it's input-index by one
+ ;; push the e-identifier onto the new list and set
loop-flag to false to stop iterating
+ ;; increase index with one
+ ;; if skip-flag is false place new list onto the list of
processed lists
+ ;; 4. Reverse each processed list
+ ;; 5. Return processed lists
+
+ (let ((expanded-lists nil)
+ (processed-lists))
+
+ ;; 1. Iterate each symbol of input and expand into list of lists of
terminals and the e-identifier
+ (let ((input-tape β)
+ (input-tape-index 0)
+ (input-tape-length (length β))
+ (input-symbol))
+
+ (parser-generator--debug
+ (message
+ "\nExpanding symbols.. %S"
+ input-tape)
+ (message
+ "Length: %S"
+ input-tape-length))
+
+ (while (< input-tape-index input-tape-length)
+ (setq
+ input-symbol
+ (nth input-tape-index input-tape))
+ (parser-generator--debug
+ (message
+ "\ninput-symbol: %S"
+ input-symbol))
+ (cond
+
+ ;; if input symbol is a non-terminal, expand it and push each
possible expansion onto each expanded list
+ ((parser-generator--valid-non-terminal-p input-symbol)
+ (parser-generator--debug
+ (message
+ "input-symbol is non-terminal"))
+ (let ((expanded-non-terminal-lists
+ (gethash
+ (list input-symbol)
+ parser-generator--f-sets)))
+ (let ((expanded-list-index)
+ (expanded-list-count
+ (length expanded-lists)))
+ (parser-generator--debug
+ (message
+ "non-terminal expands into: %S with count: %d"
+ expanded-non-terminal-lists
+ (length expanded-non-terminal-lists)))
+
+ (if (= expanded-list-count 0)
+ (dolist (expanded-non-terminal-list
expanded-non-terminal-lists)
+ (push
+ (reverse expanded-non-terminal-list)
+ expanded-lists))
+
+ (let ((new-expanded-lists))
+ (dolist (expanded-non-terminal-list
expanded-non-terminal-lists)
+ (setq expanded-list-index 0)
+ (let ((reversed-expanded-non-terminal-list
+ (reverse expanded-non-terminal-list)))
+ (while (< expanded-list-index expanded-list-count)
+ (push
+ (append
+ reversed-expanded-non-terminal-list
+ (nth expanded-list-index expanded-lists))
+ new-expanded-lists)
+ (setq
+ expanded-list-index
+ (1+ expanded-list-index)))))
+ (setq
+ expanded-lists
+ new-expanded-lists)))
+ (parser-generator--debug
+ (message
+ "expanded-lists after adding: %S"
+ expanded-lists)))))
+
+ ;; if input symbol is a terminal
+ ;; or the e-identifier
+ ;; or the eof-identifier
+ ;; push it to each expanded list
+ ((or
+ (parser-generator--valid-e-p input-symbol)
+ (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"))
+ (let ((expanded-list-index 0)
+ (expanded-list-count
+ (length expanded-lists)))
+ (if (= expanded-list-count 0)
+ (setq
+ expanded-lists
+ (list (list input-symbol)))
+ (while (< expanded-list-index expanded-list-count)
+ (setf
+ (nth expanded-list-index expanded-lists)
+ (append
+ (list input-symbol)
+ (nth expanded-list-index expanded-lists)))
+ (setq
+ expanded-list-index
+ (1+ expanded-list-index))))
(parser-generator--debug
(message
- "stack-topmost: %s"
- stack-topmost))
- (let ((input-tape-index (car stack-topmost))
- (first-length (car (cdr stack-topmost)))
- (first (car (cdr (cdr stack-topmost))))
- (keep-looking t))
- (while (and
- keep-looking
- (< input-tape-index input-tape-length)
- (< first-length k))
- (let ((symbol (nth input-tape-index input-tape)))
- (parser-generator--debug
- (message
- "symbol index: %s from %s is: %s"
- input-tape-index
- input-tape symbol))
- (cond
-
- ((parser-generator--valid-e-p symbol)
+ "expanded-lists after adding: %S"
+ expanded-lists)))))
+ (setq
+ input-tape-index
+ (1+ input-tape-index))))
- ;; When there a symbols left on stack, make
alternative trail by skipping this symbol
- (unless (or
- disallow-e-first
- (= input-tape-index (1- input-tape-length)))
- (parser-generator--debug
- (message
- "Pushed alternative trail to stack since symbol is
e-identifier: %s"
- `(,(1+ input-tape-index) ,first-length ,first)))
- (push
- `(,(1+ input-tape-index) ,first-length ,first)
- stack))
+ (if expanded-lists
+ (let ((unprocessed-lists)
+ (k (max 1 parser-generator--look-ahead-number))
+ (distinct-processed-lists (make-hash-table :test 'equal)))
+ (parser-generator--debug
+ (message
+ "\nExpanded symbols: %S (in reverse order)"
+ expanded-lists))
+
+ ;; 2. Place each expanded list on a stack of unprocessed lists
+ ;; each with a input-index to zero and an empty processed list
+ (let ((expanded-list-index 0)
+ (expanded-list-count
+ (length expanded-lists)))
+ (while (< expanded-list-index expanded-list-count)
+ (push
+ (list
+ (reverse (nth expanded-list-index expanded-lists))
+ 0
+ nil)
+ unprocessed-lists)
+ (setq
+ expanded-list-index
+ (1+ expanded-list-index))))
+
+ ;; 3. Process each unprocessed list and expand into a list of
lists of terminals and the e-identifier
+ (let ((unprocessed-data)
+ (unprocessed-list)
+ (unprocessed-list-length)
+ (unprocessed-list-index)
+ (processed-list))
+ (while unprocessed-lists
+ (setq
+ unprocessed-data
+ (pop unprocessed-lists))
+ (setq
+ unprocessed-list
+ (nth 0 unprocessed-data))
+ (setq
+ unprocessed-list-index
+ (nth 1 unprocessed-data))
+ (setq
+ unprocessed-list-length
+ (length unprocessed-list))
+ (setq
+ processed-list
+ (nth 2 unprocessed-data))
+ (parser-generator--debug
+ (message
+ "\nunprocessed-list: %S"
+ unprocessed-list)
+ (message
+ "unprocessed-list-index: %S"
+ unprocessed-list-index)
+ (message
+ "unprocessed-list-length: %S"
+ unprocessed-list-length))
+
+ (let ((skip-flag)
+ (loop-flag t))
+ (while (and
+ (not skip-flag)
+ loop-flag
+ (< unprocessed-list-index unprocessed-list-length))
+ (let ((unprocessed-list-symbol
+ (nth unprocessed-list-index unprocessed-list)))
+
+ ;; if a list starts with the e-identifier and it is
disallowed
+ ;; set skip-flag to true to stop iterating
+ (if (and
+ disallow-e-first
+ (= unprocessed-list-index 0)
+ (parser-generator--valid-e-p
+ unprocessed-list-symbol))
+ (progn
+ (setq
+ skip-flag
+ t)
+ (parser-generator--debug
+ (message
+ "Unprocessed list starts with e-identifier,
skipping")))
- (if disallow-e-first
- (when (> first-length 0)
- (setq first (append first (list symbol)))
- (setq first-length (1+ first-length)))
- (setq first (append first (list symbol)))
- (setq first-length (1+ first-length)))
+ (cond
- (setq keep-looking nil))
+ ;; if a symbol on a the list is the e-identifier
+ ((parser-generator--valid-e-p
+ unprocessed-list-symbol)
- ((parser-generator--valid-eof-p symbol)
- (setq first (append first (list symbol)))
- (setq first-length (1+ first-length)))
+ ;; push a copy of the new list on the unprocessed
stack but increase it's input-index by one
+ (let ((unprocessed-branch
+ (list
+ unprocessed-list
+ (1+ unprocessed-list-index)
+ processed-list)))
+ (parser-generator--debug
+ (message
+ "Pushed unprocessed-branch to
unprocessed-lists: %S"
+ unprocessed-branch))
+ (push
+ unprocessed-branch
+ unprocessed-lists))
- ((parser-generator--valid-terminal-p symbol)
- (setq first (append first (list symbol)))
- (setq first-length (1+ first-length)))
+ (parser-generator--debug
+ (message
+ "Added e-identifier to processed list: %S"
+ processed-list))
+ (push
+ unprocessed-list-symbol
+ processed-list)
+ (setq
+ loop-flag
+ nil))
- ((parser-generator--valid-non-terminal-p symbol)
- (parser-generator--debug
- (message "non-terminal symbol: %s" symbol))
- (setq
- symbol
- (list symbol))
- (parser-generator--debug
- (message "non-terminal symbol production: %s" symbol))
- (let ((symbol-f-set))
-
- ;; Load the pre-generated F-set
- ;; if it's the first symbol and we are using
- ;; E-FREE-FIRST then use separate hash-table
- (if (and
- disallow-e-first
- (= first-length 0))
- (progn
- (parser-generator--debug
- (message
- "gethash: %s"
- (gethash
- symbol
- parser-generator--f-free-sets)))
- (setq
- symbol-f-set
- (nth
- 1
- (gethash
- symbol
- parser-generator--f-free-sets))))
+ (t
+ (push
+ unprocessed-list-symbol
+ processed-list)
(parser-generator--debug
(message
- "gethash: %s"
- (gethash
- symbol
- parser-generator--f-sets)))
+ "Added terminal %S to processed list: %S"
+ unprocessed-list-symbol
+ processed-list)))))
+
+ (setq
+ unprocessed-list-index
+ (1+ unprocessed-list-index))))
+
+ ;; if skip-flag is false place reversed new list onto the
list of processed lists
+ (if skip-flag
+ (progn
+ (parser-generator--debug
+ (message
+ "Skip flag is set, ignoring resulted list: %S with
length: %d"
+ processed-list
+ (length processed-list))))
+
+ (parser-generator--debug
+ (message
+ "Skip flag is not set, proceeding with resulted list:
%S with length: %d"
+ processed-list
+ (length processed-list)))
+
+ ;; If length of a set is below K fill it up with
e-identifiers
+ (when (< (length processed-list) k)
+ (let ((missing-symbol-count
+ (- k (length processed-list)))
+ (missing-symbol-index 0))
+ (while (< missing-symbol-index missing-symbol-count)
+ (push
+ parser-generator--e-identifier
+ processed-list)
(setq
- symbol-f-set
- (nth
- 1
- (gethash
- symbol
- parser-generator--f-sets))))
+ missing-symbol-index
+ (1+ missing-symbol-index)))
(parser-generator--debug
(message
- "symbol-f-set: %s"
- symbol-f-set))
-
- (if (and
- (not symbol-f-set)
- disallow-e-first
- (= first-length 0))
- (progn
- (parser-generator--debug
- (message
- "stopped looking since non-terminal starts
with e-identifier: %s"
- symbol-f-set))
- (setq
- keep-looking
- nil))
-
- ;; Handle this scenario here were a non-terminal
can result in different FIRST sets
- (let ((symbol-f-set-index 0)
- (symbol-f-set-length
- (length symbol-f-set))
- (found-e-trail)
- (e-trail-is-viable-p
- (< input-tape-index (1- input-tape-length)))
- (original-first first)
- (original-first-length first-length))
- (while (< symbol-f-set-index symbol-f-set-length)
- (let ((symbol-f-set-element (nth
symbol-f-set-index symbol-f-set)))
- (let ((alternative-first-length
- (+ original-first-length (length
symbol-f-set-element)))
- (alternative-first
- (append original-first
symbol-f-set-element))
- (alternative-tape-index
- (1+ input-tape-index)))
- (parser-generator--debug
- (message
- "alternative-first: %s"
- alternative-first))
-
- ;; When the e-identifier is an alternative
trail
- ;; and there a symbols left on stack
- ;; make alternative trail by skipping this
symbol
- ;; but only if there are more symbols in
the input tape
- (when (and
- e-trail-is-viable-p
- (not found-e-trail)
- (or
- (not disallow-e-first)
- (> original-first-length 0))
- (parser-generator--valid-e-p
- (car alternative-first)))
- (push
- `(,(1+ input-tape-index)
,original-first-length ,original-first)
- stack)
- (parser-generator--debug
- (message
- "Pushed alternative trail from
non-terminal expansion to stack since first symbol is the e-identifier: %s"
- `(,(1+ input-tape-index)
,original-first-length ,original-first)))
- (setq
- found-e-trail
- t))
+ "Added %d trailing e-identifiers to set"
+ missing-symbol-count))))
+
+ (when (> (length processed-list) k)
+ (let ((obsolete-symbol-count
+ (- (length processed-list) k))
+ (obsolete-symbol-index 0))
+ (while (< obsolete-symbol-index
obsolete-symbol-count)
+ (pop
+ processed-list)
+ (setq
+ obsolete-symbol-index
+ (1+ obsolete-symbol-index)))
+ (parser-generator--debug
+ (message
+ "Stripped away %d trailing symbols from set"
+ obsolete-symbol-count))))
- (if (= symbol-f-set-index 0)
- (progn
- (setq
- first-length
- (+ original-first-length (length
alternative-first)))
- (setq
- first
- (append original-first
alternative-first)))
- (push
- `(
- ,alternative-tape-index
- ,alternative-first-length
- ,alternative-first)
- stack))))
- (setq
- symbol-f-set-index
- (1+ symbol-f-set-index)))))))))
- (setq
- input-tape-index
- (1+ input-tape-index)))
- (when (> first-length 0)
-
- ;; If length exceeds k, strip trailing symbols
- (when (> (length first) k)
- (setq first (reverse first))
- (while (> (length first) k)
- (pop first))
- (setq first (reverse first)))
-
- ;; When length of terminals list is below K
- ;; fill up with e-identifiers
- (when (and
- (< (length first) k))
- ;; (message "first-before-fill: %s" first)
- (setq first (reverse first))
- (while (< (length first) k)
- (push parser-generator--e-identifier first))
- (setq first (reverse first))
- ;; (message "first-after-fill: %s" first)
- )
- (unless
- (gethash
- first
- first-items)
(parser-generator--debug
(message
- "push to first-list: %s to %s"
- first
- first-list))
- (puthash
- first
- t
- first-items)
- (push
- first
- first-list)))))))
- (unless skip-sorting
- (setq
- first-list
- (sort
- first-list
- 'parser-generator--sort-list)))
- (puthash
- hash-key
- first-list
- parser-generator--table-firsts))))
+ "processed-list: %S"
+ processed-list))
+
+ ;; Reverse list
+ (setq
+ processed-list
+ (reverse
+ processed-list))
+
+ ;; Make sure only distinct sets are added to list
+ (let ((processed-list-hash-key
+ (format
+ "%S"
+ processed-list)))
+ (if (gethash
+ processed-list-hash-key
+ distinct-processed-lists)
+ (progn
+ (parser-generator--debug
+ (message
+ "Processed list already existed in set,
skipping %S"
+ processed-list)))
+
+ (push
+ processed-list
+ processed-lists)
+ (puthash
+ processed-list-hash-key
+ t
+ distinct-processed-lists)
+ (parser-generator--debug
+ (message
+ "Processed list is new, added to set %S"
+ processed-list)))))))))
+
+ (parser-generator--debug
+ (message
+ "\nFailed to expand symbols!")))
+
+ ;; Optional sorting
+ (when (and
+ processed-lists
+ (not skip-sorting))
+ (setq
+ processed-lists
+ (sort
+ processed-lists
+ 'parser-generator--sort-list)))
+
+ (parser-generator--debug
+ (message
+ "processed-lists: %S"
+ processed-lists))
+
+ ;; Store in memory cache
+ (puthash
+ hash-key
+ processed-lists
+ parser-generator--table-firsts)))
(gethash
hash-key
parser-generator--table-firsts)))
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 316b1b1f93..8fc8fbae76 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -1165,7 +1165,7 @@
(message "Passed test PHP 8.0 match grammar 2")
))
- ;; TODO Test another left-recursive grammar from PHP 8.0 here
+ ;; Test another left-recursive grammar from PHP 8.0 here
(parser-generator-set-look-ahead-number 1)
(parser-generator-set-e-identifier '%empty)
(parser-generator-set-grammar
@@ -1281,7 +1281,6 @@
(message "Passed tests for (parser-generator-lr--parse)"))
-;; TODO Make these pass again
(defun parser-generator-lr-test-parse-k-2 ()
"Test `parser-generator-lr-parse' with k = 2."
(message "Started tests for (parser-generator-lr-parse) k = 2")
@@ -1486,19 +1485,18 @@
lr-items)
(parser-generator--debug
(message
- "Action-tables k = 2: %s"
+ "Action-tables k = 2: %S"
(parser-generator-lr--get-expanded-action-tables)))
-
(should
(equal
'(
(0 (((a b) shift)))
(1 ((($ $) reduce 2) ((a b) shift)))
(2 ((($ $) accept)))
- (3 (((b $) shift) ((b c) shift) ((b a) shift)))
- (4 ((($ $) reduce 6) ((a b) reduce 6) ((a $) shift) ((a c) shift) ((a
a) shift) ((c a) shift) ((c $) shift)))
+ (3 (((b c) shift) ((b a) shift) ((b $) shift)))
+ (4 ((($ $) reduce 6) ((a b) reduce 6) ((a c) shift) ((a a) shift) ((a
$) shift) ((c a) shift) ((c $) shift)))
(5 ((($ $) reduce 3) ((a b) reduce 3)))
- (6 ((($ $) reduce 6) ((a b) reduce 6) ((a $) shift) ((a c) shift) ((a
a) shift) ((c a) shift) ((c $) shift)))
+ (6 ((($ $) reduce 6) ((a b) reduce 6) ((a c) shift) ((a a) shift) ((a
$) shift) ((c a) shift) ((c $) shift)))
(7 ((($ $) reduce 5) ((a b) reduce 5)))
(8 ((($ $) reduce 4) ((a b) reduce 4)))
(9 ((($ $) reduce 1)))
@@ -1624,7 +1622,18 @@
;; (5) B → 1
(parser-generator-set-grammar
- '((S E B) ("*" "+" "0" "1") ((S (E $)) (E (E "*" B) (E "+" B) (B)) (B ("0")
("1"))) S))
+ '(
+ (S E B)
+ ("*" "+" "0" "1")
+ (
+ (S (E $))
+ (E (E "*" B) (E "+" B) (B))
+ (B ("0") ("1"))
+ )
+ S
+ )
+ )
+ (parser-generator-set-e-identifier nil)
(parser-generator-set-look-ahead-number 0)
(parser-generator-process-grammar)
@@ -1736,7 +1745,7 @@
(7 nil)
(8 nil))
(parser-generator-lr--get-expanded-goto-tables)))
- (message "Passed GOTO-tables k = 2")
+ (message "Passed GOTO-tables k = 0")
;; * + 0 1 $
;; 0 s1 s2
diff --git a/test/parser-generator-test.el b/test/parser-generator-test.el
index 437a4aa76e..6a13070990 100644
--- a/test/parser-generator-test.el
+++ b/test/parser-generator-test.el
@@ -191,6 +191,24 @@
(message "Passed tests for (parser-generator--follow)"))
+(defun parser-generator-test--generate-f-sets ()
+ "Test `parser-generator--first'."
+ (message "Starting tests for (parser-generator-test--generate-f-sets)")
+
+ (parser-generator-set-e-identifier 'e)
+ (parser-generator-set-grammar '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e))
Sp))
+ (parser-generator-set-look-ahead-number 1)
+ (parser-generator-process-grammar)
+ (parser-generator--generate-f-sets)
+ (should
+ (equal
+ '((e a) (e))
+ (gethash
+ (list 'S)
+ parser-generator--f-sets)))
+
+ (message "Passed tests for (parser-generator-test--generate-f-sets)"))
+
(defun parser-generator-test--first ()
"Test `parser-generator--first'."
(message "Starting tests for (parser-generator--first)")
@@ -279,6 +297,14 @@
(parser-generator-set-grammar '((S A B) ("c" "d") ((S A) (A B) (B "c" "d"))
S))
(parser-generator-set-look-ahead-number 1)
(parser-generator-process-grammar)
+ (should
+ (equal
+ '(("c") ("d"))
+ (parser-generator--first 'B)))
+ (should
+ (equal
+ '(("c") ("d"))
+ (parser-generator--first 'A)))
(should
(equal
'(("c") ("d"))
@@ -372,7 +398,7 @@
(parser-generator-process-grammar)
(should
(equal
- '((a a b) (a a e) (a b a) (a b e) (a e e) (e e e))
+ '((a a a) (a a b) (a a e) (a b a) (a b e) (a e e) (e e e))
(parser-generator--first 'S)))
(message "Passed first 8 with complex grammar with starting e-identifier
variant 2")
@@ -381,7 +407,7 @@
(parser-generator-process-grammar)
(should
(equal
- '((a a b b) (a a e e) (a b a a) (a b a b) (a b a e) (a b e e) (a e e e) (e
e e e))
+ '((a a a a) (a a a b) (a a a e) (a a b a) (a a b b) (a a e e) (a b a a) (a
b a b) (a b a e) (a b e e) (a e e e) (e e e e))
(parser-generator--first 'S)))
(message "Passed first 9 with complex grammar with starting e-identifier
variant 2")
@@ -541,11 +567,10 @@
(message "Passed empty-free-first 2 with trailing e-identifier 2")
(should
(equal
- '((a a) (a e))
+ '((a a) (a b) (a e))
(parser-generator--e-free-first '(a S b))))
(message "Passed empty-free-first 2 with trailing e-identifier 1")
- ;; TODO Make this pass
(parser-generator-set-grammar
'((Sp S R T) (a b c) ((Sp S) (S (R S) (R)) (R (a b T)) (T (a T) (c) (e)))
Sp))
(parser-generator-set-look-ahead-number 2)
@@ -1048,6 +1073,7 @@
(parser-generator-test--valid-production-p)
(parser-generator-test--valid-sentential-form-p)
(parser-generator-test--valid-terminal-p)
+ (parser-generator-test--generate-f-sets)
;; Algorithms
(parser-generator-test--first)
- [elpa] externals/parser-generator 0e1fbf9cef 07/29: More debugging of edge case, (continued)
- [elpa] externals/parser-generator 0e1fbf9cef 07/29: More debugging of edge case, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator 653b8edece 17/29: Added failing test for generate-f-sets, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator 4c34af706f 29/29: Improved documentation, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator a175c1317a 08/29: Started on refactor of e-free-first function to properly handle a edge case, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator 94fa7c3732 06/29: Cleaning up of e-free-first test, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator d2227ad65e 13/29: More wrestling with FIRST and E-FREE-FIRST calculation, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator d85a3ae246 16/29: Passing more tests, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator e2e464bb17 26/29: Updated version, date and TODO, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator dced2e199f 22/29: Sorting LR-action tables before outputting them in messages, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator 69fc89898e 19/29: Passing all tests for FIRST and E-FREE-FIRST with new algorithm, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator 6726c5231e 24/29: Fixed conflict,
Christian Johansson <=
- [elpa] externals/parser-generator 98dc561880 23/29: FIRST() and E-FREE-FIRST() passing LR-test for k=0, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator 432e3732f2 20/29: Fixed some byte-compilation warnings, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator ba2bda38da 25/29: Added use of default conflict resolution flag in action-table generation, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator 536198eb0a 27/29: Fixed typo in comment, Christian Johansson, 2022/02/12
- [elpa] externals/parser-generator 58548b8e10 21/29: Passing test for LR-parse with k=2 again, Christian Johansson, 2022/02/12