branch: externals/parser-generator
commit 0856bb77847c3b5f3a4143e66e77c46350d04769
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Started on refactor were k=1 will be treated with different algorithm
---
parser-generator-ll.el | 164 +++++++++++++++++-------------
parser-generator.el | 2 +-
test/parser-generator-ll-test.el | 211 +++++++++++++--------------------------
3 files changed, 163 insertions(+), 214 deletions(-)
diff --git a/parser-generator-ll.el b/parser-generator-ll.el
index 7afaa48c35..55eaeaecef 100644
--- a/parser-generator-ll.el
+++ b/parser-generator-ll.el
@@ -25,47 +25,13 @@
;;; Functions
-(defun parser-generator-ll-generate-parser-tables ()
- "Generate parsing tables for grammar."
- (message "\n;; Starting generation of LL(k) parser-tables..\n")
- (unless (parser-generator-ll--valid-grammar-p)
- (error "Invalid grammar specified!"))
- (let ((list-parsing-table
- (parser-generator-ll--generate-parsing-table
- (parser-generator-ll--generate-tables)))
- (hash-parsing-table (make-hash-table :test 'equal)))
- (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--parsing-table
- hash-parsing-table))
- (message "\n;; Completed generation of LL(k) parser-tables.\n"))
-
+(defun parser-generator-ll-generate-tables ()
+ "Generate tables for grammar."
+ (message "\n;; Starting generation of LL(k) tables..\n")
+ (if (> parser-generator--look-ahead-number 1)
+ (parser-generator-ll--generate-parser-tables-k-gt-1)
+ (parser-generator-ll--generate-parser-tables-k-eq-1))
+ (message "\n;; Completed generation of LL(k) tables.\n"))
;; Generally described at .p 339
(defun parser-generator-ll-parse ()
@@ -176,9 +142,51 @@
;;; Algorithms
+(defun parser-generator-ll--generate-parser-tables-k-gt-1 ()
+ "Generate parsing tables for grammar k > 1."
+ (message "\n;; Starting generation of LL(k) parser-tables..\n")
+ (unless (parser-generator-ll--valid-grammar-p-k-gt-1)
+ (error "Invalid grammar specified!"))
+ (let ((list-parsing-table
+ (if (> parser-generator--look-ahead-number 1)
+ (parser-generator-ll--generate-parsing-table-k-gt-1
+ (parser-generator-ll--generate-tables-k-gt-1))
+ (parser-generator-ll--generate-parsing-table-k-eq-1)))
+ (hash-parsing-table (make-hash-table :test 'equal)))
+ (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--parsing-table
+ hash-parsing-table)))
+
;; Algorithm 5.2 p. 350
-(defun parser-generator-ll--generate-tables ()
- "Construction of LL(k)-tables. Output the set of LL(k) tables needed to
construct a parsing table for the grammar G."
+(defun parser-generator-ll--generate-tables-k-gt-1 ()
+ "Construction of LL(k)-tables were k > 1. Output the set of LL(k) tables
needed to construct a parsing table for the grammar G."
(let ((tables (make-hash-table :test 'equal))
(distinct-item-p (make-hash-table :test 'equal))
(stack)
@@ -253,6 +261,7 @@
first-concatenated-follow-set
nil
t))
+ (local-follow)
(sub-symbol-rhss
(parser-generator--get-grammar-rhs
sub-symbol)))
@@ -278,34 +287,50 @@
sub-symbol-rhss))
(unless local-follow-set
(setq local-follow-set '(nil)))
+
+ (when (> (length local-follow-set) 1)
+ (signal
+ 'error
+ (list
+ (format
+ "There are more than one follow set in state! %S -> %S
+ %S"
+ sub-symbol
+ production-rhs
+ follow-set)
+ sub-symbol
+ production-rhs
+ follow-set)))
+ (setq
+ local-follow
+ (car local-follow-set))
+
(push
- local-follow-set
+ local-follow
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))))))))
+ (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))))
@@ -369,9 +394,8 @@
tables)
sorted-tables)))
-
;; Algorithm 5.3 p. 351
-(defun parser-generator-ll--generate-parsing-table (tables)
+(defun parser-generator-ll--generate-parsing-table-k-gt-1 (tables)
"Generate a parsing table for an LL(k) grammar G and TABLES. Output M, a
valid parsing table for G."
(let ((parsing-table))
@@ -479,9 +503,8 @@
parsing-table))
-
;; Algorithm 5.4 p. 357
-(defun parser-generator-ll--valid-grammar-p ()
+(defun parser-generator-ll--valid-grammar-p-k-gt-1 ()
"Test for LL(k)-ness. Output t if grammar is LL(k). nil otherwise."
(let ((stack)
(stack-item)
@@ -536,7 +559,8 @@
;; 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 ((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
diff --git a/parser-generator.el b/parser-generator.el
index 4b749f7f31..dfd698663e 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -45,7 +45,7 @@
(defvar
parser-generator--debug
- nil
+ t
"Whether to print debug messages or not.")
(defvar
diff --git a/test/parser-generator-ll-test.el b/test/parser-generator-ll-test.el
index 567e2ee955..e9026532a0 100644
--- a/test/parser-generator-ll-test.el
+++ b/test/parser-generator-ll-test.el
@@ -12,9 +12,9 @@
(require 'parser-generator-ll)
(require 'ert)
-(defun parser-generator-ll-test--generate-tables ()
- "Test `parser-generator-ll--generate-tables'."
- (message "Started tests for (parser-generator-ll--generate-tables)")
+(defun parser-generator-ll-test--generate-tables-k-gt-1 ()
+ "Test `parser-generator-ll--generate-tables-k-gt-1'."
+ (message "Started tests for (parser-generator-ll--generate-tables-k-gt-1)")
(parser-generator-set-e-identifier 'e)
(parser-generator-set-look-ahead-number 2)
@@ -30,7 +30,7 @@
)
)
(parser-generator-process-grammar)
- (let ((tables (parser-generator-ll--generate-tables)))
+ (let ((tables (parser-generator-ll--generate-tables-k-gt-1)))
;; (message "tables: %S" tables)
(should
(equal
@@ -53,9 +53,9 @@
(
((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))))
+ ((a b) (a A a a) ((a a)))
+ ((a a) (a A a a) ((a a)))
+ ((b b) (b A b a) ((b a)))
)
)
)
@@ -79,7 +79,7 @@
)
(parser-generator-process-grammar)
(let* ((tables
- (parser-generator-ll--generate-tables)))
+ (parser-generator-ll--generate-tables-k-gt-1)))
;; (message "tables: %S" tables)
(should
(equal
@@ -88,23 +88,23 @@
(
((A) (a a)) ;; T3
(
- ((a b) (S a a) (((a a))))
- ((a a) (S a a) (((a a))))
+ ((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 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))))
+ ((a b) (S a a) ((a a)))
+ ((a a) (S a a) ((a a)))
((b $) (b) nil)
)
)
@@ -112,7 +112,7 @@
((S) ($ $)) ;; T0
(
(($ $) (e) nil)
- ((a b) (a b A) ((($ $))))
+ ((a b) (a b A) (($ $)))
)
)
)
@@ -120,6 +120,8 @@
)
(message "Passed Example 5.17 p. 354")
+ ;; Move below to separate test
+
(parser-generator-set-eof-identifier '$)
(parser-generator-set-e-identifier 'e)
(parser-generator-set-look-ahead-number 1)
@@ -143,38 +145,17 @@
tables
'(
(
- ((A) (a))
- (
- ((a) (a) nil)
- ((b) (b S A) (((a) (b)) ((a))))
- )
- )
- (
- ((S) (a))
- (
- ((a) (a A S) (((a) (b)) ((a))))
- ((b) (b) nil)
- )
- )
- (
- ((S) (b))
- (
- ((a) (a A S) (((a) (b)) ((b))))
- ((b) (b) nil)
- )
- )
- (
- ((A) (b))
+ (A)
(
- ((a) (a) nil)
- ((b) (b S A) (((a) (b)) ((b))))
+ ((a) (a))
+ ((b) (b S A))
)
)
(
- ((S) ($))
+ (S)
(
- ((a) (a A S) (((a) (b)) (($))))
- ((b) (b) nil)
+ ((a) (a A S))
+ ((b) (b))
)
)
)
@@ -206,112 +187,49 @@
(equal
'(
(
- ((F) ($))
- (
- (("(") ("(" E ")") (((")"))))
- (("a") ("a") nil)
- )
- )
- (
- ((T2) ($))
- (
- (($) (e) nil)
- (("*") ("*" F T2) ((($) ("*")) (($))))
- )
- )
- (
- ((T) ($))
- (
- (("(") (F T2) ((($) ("*")) (($))))
- (("a") (F T2) ((($) ("*")) (($))))
- )
- )
- (
- ((F) ("*"))
- (
- (("(") ("(" E ")") (((")"))))
- (("a") ("a") nil)
- )
- )
- (
- ((F) (")"))
- (
- (("(") ("(" E ")") (((")"))))
- (("a") ("a") nil)
- )
- )
- (
- ((T2) (")"))
- (
- ((")") (e) nil)
- (("*") ("*" F T2) (((")") ("*")) ((")"))))
- )
- )
- (
- ((T) (")"))
- (
- (("(") (F T2) (((")") ("*")) ((")"))))
- (("a") (F T2) (((")") ("*")) ((")"))))
- )
- )
- (
- ((E2) (")"))
- (
- ((")") (e) nil)
- (("+") ("+" T E2) (((")") ("+")) ((")"))))
- )
- )
- (
- ((E) (")"))
- (
- (("(") (T E2) (((")") ("+")) ((")"))))
- (("a") (T E2) (((")") ("+")) ((")"))))
- )
- )
- (
- ((F) ("+"))
+ (F)
(
- (("(") ("(" E ")") (((")"))))
- (("a") ("a") nil)
+ (("(") ("(" E ")"))
+ (("a") ("a"))
)
)
(
- ((T2) ("+"))
+ (T2)
(
- (("*") ("*" F T2) ((("*") ("+")) (("+"))))
- (("+") (e) nil)
+ (($) (e))
+ (("*") ("*" F T2))
)
)
(
- ((T) ("+"))
+ (T)
(
- (("(") (F T2) ((("*") ("+")) (("+"))))
- (("a") (F T2) ((("*") ("+")) (("+"))))
+ (("(") (F T2))
+ (("a") (F T2))
)
)
(
- ((E2) ($))
+ (E2)
(
- (($) (e) nil)
- (("+") ("+" T E2) ((($) ("+")) (($))))
+ ((")") (e))
+ (("+") ("+" T E2))
)
)
(
- ((E) ($))
+ (E)
(
- (("(") (T E2) ((($) ("+")) (($))))
- (("a") (T E2) ((($) ("+")) (($))))
+ (("(") (T E2))
+ (("a") (T E2))
)
)
)
tables)))
(message "Passed Example 5.12 p. 346-347")
- (message "Passed tests for (parser-generator-ll--generate-tables)"))
+ (message "Passed tests for (parser-generator-ll--generate-tables-k-gt-1)"))
-(defun parser-generator-ll-test--generate-parsing-table ()
+(defun parser-generator-ll-test--generate-parsing-table-k-gt-1 ()
"Test `parser-generator-ll--generate-parsing-table'."
- (message "Started tests for (parser-generator-ll--generate-parsing-table)")
+ (message "Started tests for
(parser-generator-ll--generate-parsing-table-k-gt-1)")
;; TODO Need to make this tests pass, RHS after reduction should be single
dimension list
@@ -330,7 +248,7 @@
)
(parser-generator-process-grammar)
(let ((parser-tables
- (parser-generator-ll--generate-parsing-table
+ (parser-generator-ll--generate-parsing-table-k-gt-1
(parser-generator-ll--generate-tables))))
;; (message "parser-tables: %S" parser-tables)
(should
@@ -382,9 +300,9 @@
(parser-generator-process-grammar)
(let* ((tables
(parser-generator-ll--generate-tables))
- (parser-tables
- (parser-generator-ll--generate-parsing-table
- tables)))
+ (parser-tables
+ (parser-generator-ll--generate-parsing-table-k-gt-1
+ tables)))
;; (message "tables: %S" tables)
;; (message "parser-tables: %S" parser-tables)
(should
@@ -427,6 +345,8 @@
parser-tables)))
(message "Passed Example 5.17 p. 356")
+ ;; TODO Move below to separate test
+
(parser-generator-set-eof-identifier '$)
(parser-generator-set-e-identifier 'e)
(parser-generator-set-look-ahead-number 1)
@@ -449,7 +369,7 @@
(let* ((tables
(parser-generator-ll--generate-tables))
(parser-tables
- (parser-generator-ll--generate-parsing-table
+ (parser-generator-ll--generate-parsing-table-k-gt-1
tables)))
;; (message "tables: %S" tables)
;; (message "parser-tables: %S" parser-tables)
@@ -696,9 +616,9 @@
(message "Passed tests for (parser-generator-ll-parse)"))
-(defun parser-generator-ll-test--generate-parser-tables ()
- "Test `parser-generator-ll-generate-parser-tables'."
- (message "Started tests for (parser-generator-ll-generate-parser-tables)")
+(defun parser-generator-ll-test-generate-tables ()
+ "Test `parser-generator-ll-generate-tables'."
+ (message "Started tests for (parser-generator-ll-generate-tables)")
(parser-generator-set-eof-identifier '$)
(parser-generator-set-e-identifier 'e)
@@ -715,7 +635,7 @@
)
)
(parser-generator-process-grammar)
- (parser-generator-ll-generate-parser-tables)
+ (parser-generator-ll-generate-tables)
;; (message "parsing-table: %S" (parser-generator--hash-to-list
parser-generator-ll--parsing-table t))
(should
(equal
@@ -754,11 +674,13 @@
parser-generator-ll--parsing-table
t)))
- (message "Passed tests for (parser-generator-ll-generate-parser-tables)"))
+ ;; TODO Should test k = 1 here as well
-(defun parser-generator-ll-test--valid-grammar-p ()
- "Test `parser-generator-ll--valid-grammar-p'."
- (message "Started tests for (parser-generator-ll--valid-grammar-p)")
+ (message "Passed tests for (parser-generator-ll-generate-tables)"))
+
+(defun parser-generator-ll-test--valid-grammar-p-k-gt-1 ()
+ "Test `parser-generator-ll--valid-grammar-p-k-gt-1'."
+ (message "Started tests for (parser-generator-ll--valid-grammar-p-k-gt-1)")
;; Example 5.14 p. 350
;; Example 5.15 p. 351
@@ -778,7 +700,7 @@
(parser-generator-process-grammar)
(should
(equal
- (parser-generator-ll--valid-grammar-p)
+ (parser-generator-ll--valid-grammar-p-k-gt-1)
t))
(message "Passed first valid test")
@@ -798,25 +720,28 @@
(parser-generator-process-grammar)
(should
(equal
- (parser-generator-ll--valid-grammar-p)
+ (parser-generator-ll--valid-grammar-p-k-gt-1)
nil))
(message "Passed second valid test")
;; TODO Example 5.19
- (message "Passed tests for (parser-generator-ll--valid-grammar-p)"))
+ (message "Passed tests for (parser-generator-ll--valid-grammar-p-k-gt-1)"))
(defun parser-generator-ll-test ()
"Run test."
+
;; Helpers
- (parser-generator-ll-test--generate-tables)
- (parser-generator-ll-test--generate-parsing-table)
- (parser-generator-ll-test--valid-grammar-p)
+ (parser-generator-ll-test--generate-tables-k-gt-1)
+ (parser-generator-ll-test--generate-parsing-table-k-gt-1)
+ ;; TODO Generate tables k eq 1
+ (parser-generator-ll-test--valid-grammar-p-k-gt-1)
+ ;; TODO Validate grammar k eq 1
;; Main stuff
- (parser-generator-ll-test--generate-parser-tables)
- (parser-generator-ll-test--parse))
+ (parser-generator-ll-test-generate-tables)
+ (parser-generator-ll-test-parse))
(provide 'parser-generator-ll-test)
