branch: externals/parser-generator
commit b072fdd1035db5bc2ec898c31e7d1082bb779e46
Author: Christian Johansson <[email protected]>
Commit: Christian Johansson <[email protected]>
Passed test for trailing e-identifier in EFF function
---
parser-generator.el | 120 ++++++++++++++++++++++++------------------
test/parser-generator-test.el | 19 ++++++-
2 files changed, 86 insertions(+), 53 deletions(-)
diff --git a/parser-generator.el b/parser-generator.el
index 7c24819..020d604 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -580,6 +580,58 @@
"For sentential string Α, Calculate e-free-first k terminals in grammar."
(parser-generator--first α t))
+(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)
+ (let ((productions (parser-generator--get-grammar-productions))
+ (k parser-generator--look-ahead-number))
+ (let ((i-max (length productions))
+ (disallow-set '(nil t)))
+ (dolist (disallow-e-first disallow-set)
+ (let ((f-sets (make-hash-table :test 'equal))
+ (i 0))
+ (while (< i i-max)
+ (parser-generator--debug (message "i = %s" i))
+ (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))
+ (dolist (rhs-p production-rhs)
+ (let ((rhs-string rhs-p))
+ (let ((rhs-leading-terminals
+ (parser-generator--f-set rhs-string `(,k ,i
,f-sets ,disallow-e-first) '(("" t 0)))))
+ (parser-generator--debug
+ (message "Leading %d terminals at index %s (%s)
-> %s = %s" k i production-lhs rhs-string rhs-leading-terminals))
+ (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)))))))
+
+ ;; Make set distinct
+ (setq f-p-set (parser-generator--distinct f-p-set))
+ (parser-generator--debug
+ (message "F_%s_%s(%s) = %s" i k production-lhs f-p-set))
+ (puthash production-lhs (nreverse f-p-set) f-set))))
+ (puthash i f-set f-sets)
+ (setq i (+ i 1))))
+ (if disallow-e-first
+ (setq parser-generator--f-free-sets f-sets)
+ (setq parser-generator--f-sets f-sets)))))
+ (parser-generator--debug
+ (message "Generated F-sets")))))
+
;; p. 358
(defun parser-generator--f-set (input-tape state stack)
"A deterministic push-down transducer (DPDT) for building F-sets from
INPUT-TAPE, STATE and STACK."
@@ -705,8 +757,10 @@
((equal rhs-type 'EMPTY)
(if disallow-e-first
- (when (= leading-terminals-count 0)
- (setq all-leading-terminals-p nil))
+ (if (= leading-terminals-count 0)
+ (setq all-leading-terminals-p nil)
+ (setq leading-terminals (append leading-terminals
rhs-element))
+ (setq leading-terminals-count (1+
leading-terminals-count)))
(when (and
(= leading-terminals-count 0)
(= input-tape-index (1- input-tape-length)))
@@ -736,54 +790,7 @@
(let ((i-max (length productions)))
;; Generate F-sets only once per grammar
- (when (or
- (and
- (not disallow-e-first)
- (not parser-generator--f-sets))
- (and
- disallow-e-first
- (not parser-generator--f-free-sets)))
- (let ((f-sets (make-hash-table :test 'equal))
- (i 0))
- (while (< i i-max)
- (parser-generator--debug (message "i = %s" i))
- (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))
- (dolist (rhs-p production-rhs)
- (let ((rhs-string rhs-p))
- (let ((rhs-leading-terminals
- (parser-generator--f-set rhs-string `(,k ,i
,f-sets ,disallow-e-first) '(("" t 0)))))
- (parser-generator--debug
- (message "Leading %d terminals at index %s (%s) ->
%s = %s" k i production-lhs rhs-string rhs-leading-terminals))
- (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)))))))
-
- ;; Make set distinct
- (setq f-p-set (parser-generator--distinct f-p-set))
- (parser-generator--debug
- (message "F_%s_%s(%s) = %s" i k production-lhs f-p-set))
- (puthash production-lhs (nreverse f-p-set) f-set))))
- (puthash i f-set f-sets)
- (setq i (+ i 1))))
- (if disallow-e-first
- (setq parser-generator--f-free-sets f-sets)
- (setq parser-generator--f-sets f-sets))))
-
- (parser-generator--debug
- (message "Generated F-sets"))
+ (parser-generator--generate-f-sets)
(let ((first-list nil))
;; Iterate each symbol in β using a PDA algorithm
@@ -806,6 +813,15 @@
(parser-generator--debug
(message "symbol index: %s from %s is: %s"
input-tape-index input-tape symbol))
(cond
+ ((parser-generator--valid-e-p symbol)
+ (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)))
+ (setq keep-looking nil))
+
((parser-generator--valid-terminal-p symbol)
(setq first (append first (list symbol)))
(setq first-length (1+ first-length)))
@@ -814,7 +830,9 @@
(parser-generator--debug
(message "non-terminal symbol: %s" symbol))
(let ((symbol-f-set))
- (if disallow-e-first
+ (if (and
+ disallow-e-first
+ (= first-length 0))
(setq symbol-f-set (gethash symbol (gethash (1-
i-max) parser-generator--f-free-sets)))
(setq symbol-f-set (gethash symbol (gethash (1-
i-max) parser-generator--f-sets))))
(parser-generator--debug
diff --git a/test/parser-generator-test.el b/test/parser-generator-test.el
index bb9f33e..a355942 100644
--- a/test/parser-generator-test.el
+++ b/test/parser-generator-test.el
@@ -324,13 +324,28 @@
(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)
- (should
+ (should
(equal
nil
(parser-generator--e-free-first '(S b a))))
(message "Passed empty-free-first 1 with complex grammar 2")
- ;; TODO Test cases with trailing e-identifier here
+ (parser-generator-set-grammar '((Sp S) (a b) ((Sp S) (S (S a S b)) (S e))
Sp))
+ (parser-generator-set-look-ahead-number 2)
+ (parser-generator-process-grammar)
+ (should
+ (equal
+ '((a b))
+ (parser-generator--e-free-first '(a b))))
+ (should
+ (equal
+ '((a e))
+ (parser-generator--e-free-first '(a e))))
+ (should
+ (equal
+ '((a e))
+ (parser-generator--e-free-first '(a S))))
+ (message "Passed empty-free-first 2 with trailing e-identifier")
(message "Passed tests for (parser-generator--empty-free-first)"))
