diff --git a/collects/parser-tools/private-yacc/input-file-parser.ss b/collects/parser-tools/private-yacc/input-file-parser.ss index 2615e41..20d40f1 100644 --- a/collects/parser-tools/private-yacc/input-file-parser.ss +++ b/collects/parser-tools/private-yacc/input-file-parser.ss @@ -384,18 +384,18 @@ start-sym) start)) - (printf "nullable: {~a}~n~n" - (apply string-append - (let loop ((i 0)) - (cond - ((>= i (vector-length nulls)) null) - ((vector-ref nulls i) - (cons - (format "~a " - (gram-sym-symbol - (list-ref (cons start (cons end-non-term non-terms)) i))) - (loop (add1 i)))) - (else (loop (add1 i))))))) +;; (printf "nullable: {~a}~n~n" +;; (apply string-append +;; (let loop ((i 0)) +;; (cond +;; ((>= i (vector-length nulls)) null) +;; ((vector-ref nulls i) +;; (cons +;; (format "~a " +;; (gram-sym-symbol +;; (list-ref (cons start (cons end-non-term non-terms)) i))) +;; (loop (add1 i)))) +;; (else (loop (add1 i))))))) (make-grammar (list->vector prods) (apply append prods) diff --git a/collects/parser-tools/private-yacc/lalr.ss b/collects/parser-tools/private-yacc/lalr.ss index 0f11d06..62d9d65 100644 --- a/collects/parser-tools/private-yacc/lalr.ss +++ b/collects/parser-tools/private-yacc/lalr.ss @@ -117,8 +117,6 @@ (define (compute-LA a g) (let-values (((includes lookback) (compute-includes-and-lookback a g))) (let ((follow (compute-follow a g includes))) - (print-lookback lookback a g) - (print-follow follow a g) (lambda (k p) (let* ((l (lookback k p)) (f (map follow l))) diff --git a/collects/parser-tools/private-yacc/lr0.ss b/collects/parser-tools/private-yacc/lr0.ss index 634ddca..2ca949b 100644 --- a/collects/parser-tools/private-yacc/lr0.ss +++ b/collects/parser-tools/private-yacc/lr0.ss @@ -8,7 +8,8 @@ (lib "list.ss")) (provide union build-lr0-automaton run-automaton (struct trans-key (st gs)) - lr0-transitions lr0-states kernel-items kernel-index for-each-state) + lr0-transitions lr0-states lr0-epsilon-trans + kernel-items kernel-index for-each-state) (define (union comp (eq? a b) (define (kernel->string k) @@ -71,7 +70,7 @@ (non-terms (list->vector (grammar-non-terms grammar))) (num-non-terms (vector-length non-terms)) (num-gram-syms (+ num-non-terms (vector-length terms))) - + (epsilons (make-hash-table 'equal)) ;; first-non-term: non-term -> non-term list ;; given a non-terminal symbol C, return those non-terminal @@ -136,6 +135,7 @@ ;; maps each gram-syms to a list of items (table (make-vector num-gram-syms null)) + (epsilons (make-hash-table 'equal)) ;; add-item!: ;; (item list) vector * item -> @@ -144,18 +144,26 @@ (add-item! (lambda (table i) (let ((gs (sym-at-dot i))) - (if gs - (let* ((add (if (term? gs) - num-non-terms - 0)) - (already - (vector-ref table - (+ add - (gram-sym-index gs))))) - (if (not (member i already)) - (vector-set! table - (+ add (gram-sym-index gs)) - (cons i already))))))))) + (cond + (gs + (let* ((add (if (term? gs) + num-non-terms + 0)) + (already + (vector-ref table + (+ add + (gram-sym-index gs))))) + (if (not (member i already)) + (vector-set! table + (+ add (gram-sym-index gs)) + (cons i already))))) + ((= 0 (vector-length (prod-rhs (item-prod i)))) + (let ((current (hash-table-get epsilons + kernel + (lambda () null)))) + (hash-table-put! epsilons + kernel + (cons i current))))))))) ;; Group the items of the LR0 closure of the kernel ;; by the character after the dot @@ -231,7 +239,7 @@ (seen-kernels null)) (cond ((and (empty-queue? new-kernels) (null? old-kernels)) - (make-lr0 automaton (list->vector (reverse! seen-kernels)))) + (make-lr0 automaton (list->vector (reverse! seen-kernels)) epsilons)) ((null? old-kernels) (loop (deq! new-kernels) seen-kernels)) (else diff --git a/collects/parser-tools/private-yacc/table.ss b/collects/parser-tools/private-yacc/table.ss index 5eaf57e..ae855d4 100644 --- a/collects/parser-tools/private-yacc/table.ss +++ b/collects/parser-tools/private-yacc/table.ss @@ -204,13 +204,11 @@ ;; buile-table: grammar * string -> action2d-array (define (build-table g file) (let* ((a (build-lr0-automaton g)) - (get-state (lr0-states a)) (terms (grammar-terms g)) (non-terms (grammar-non-terms g)) (get-term (list->vector terms)) (get-non-term (list->vector non-terms)) (get-prod (list->vector (grammar-prods g))) - (num-states (vector-length get-state)) (num-terms (vector-length get-term)) (num-non-terms (vector-length get-non-term)) (end-term-indexes @@ -219,7 +217,7 @@ (+ num-non-terms (gram-sym-index term))) (grammar-end-terms g))) (num-gram-syms (+ num-terms num-non-terms)) - (table (make-array2d num-states num-gram-syms #f)) + (table (make-array2d (vector-length (lr0-states a)) num-gram-syms #f)) (array2d-add! (lambda (v i1 i2 a) (let ((old (array2d-ref v i1 i2))) @@ -240,9 +238,7 @@ (vector-ref get-non-term i) (vector-ref get-term (- i num-non-terms)))) (goto - (run-automaton (vector-ref get-state (kernel-index state)) - s - a))) + (run-automaton state s a))) (if goto (array2d-set! table (kernel-index state) @@ -256,6 +252,7 @@ (make-shift (kernel-index goto))))))) (loop (add1 i))))) + (for-each (lambda (item) (for-each @@ -269,12 +266,12 @@ (item-prod-index item) (gram-sym-index (prod-lhs (item-prod item))) (vector-length (prod-rhs (item-prod item)))))))) - (get-lookahead (vector-ref get-state (kernel-index state)) - (item-prod item)))) - (filter (lambda (item) - (not (move-dot-right item))) - (kernel-items - (vector-ref get-state (kernel-index state)))))) + (get-lookahead state (item-prod item)))) + + (append (hash-table-get (lr0-epsilon-trans a) state (lambda () null)) + (filter (lambda (item) + (not (move-dot-right item))) + (kernel-items state))))) a) (resolve-prec-conflicts a table get-term get-prod num-terms num-non-terms) @@ -294,3 +291,4 @@ table)) ) +