mbutterick
/
br-parser-tools
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

*** empty log message ***

Browse Source 
original commit: 38301a75406f2f13453ccfc0a2e3b6d6314ed822
tokens
Scott Owens 23 years ago
parent 8525a6ab43
commit 9854444866
4 changed files with 59 additions and 55 deletions
Show Stats Download Patch File Download Diff File

24
collects/parser-tools/private-yacc/input-file-parser.ss
Unescape Escape View File

@ -384,18 +384,18 @@
start-sym) start-sym)
start)) start))
(printf "nullable: {~a}~n~n" ;; (printf "nullable: {~a}~n~n"
(apply string-append ;; (apply string-append
(let loop ((i 0)) ;; (let loop ((i 0))
(cond ;; (cond
((>= i (vector-length nulls)) null) ;; ((>= i (vector-length nulls)) null)
((vector-ref nulls i) ;; ((vector-ref nulls i)
(cons ;; (cons
(format "~a " ;; (format "~a "
(gram-sym-symbol ;; (gram-sym-symbol
(list-ref (cons start (cons end-non-term non-terms)) i))) ;; (list-ref (cons start (cons end-non-term non-terms)) i)))
(loop (add1 i)))) ;; (loop (add1 i))))
(else (loop (add1 i))))))) ;; (else (loop (add1 i)))))))
(make-grammar (make-grammar
(list->vector prods) (list->vector prods)
(apply append prods) (apply append prods)

2
collects/parser-tools/private-yacc/lalr.ss
Unescape Escape View File

@ -117,8 +117,6 @@
(define (compute-LA a g) (define (compute-LA a g)
(let-values (((includes lookback) (compute-includes-and-lookback a g))) (let-values (((includes lookback) (compute-includes-and-lookback a g)))
(let ((follow (compute-follow a g includes))) (let ((follow (compute-follow a g includes)))
(print-lookback lookback a g)
(print-follow follow a g)
(lambda (k p) (lambda (k p)
(let* ((l (lookback k p)) (let* ((l (lookback k p))
(f (map follow l))) (f (map follow l)))

64
collects/parser-tools/private-yacc/lr0.ss
Unescape Escape View File

@ -8,7 +8,8 @@
(lib "list.ss")) (lib "list.ss"))
(provide union build-lr0-automaton run-automaton (struct trans-key (st gs)) (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<?) (define (union comp<?)
(letrec ((union (letrec ((union
@ -29,23 +30,21 @@
;; kernel = (make-kernel (LR1-item list) index) ;; kernel = (make-kernel (LR1-item list) index)
;; the list must be kept sorted according to item<? so that equal? can ;; the list must be kept sorted according to item<? so that equal? can
;; be used to compare kernels ;; be used to compare kernels
;; LR0-automaton = (make-lr0 (trans-key kernel hash-table) (kernel vector)) ;; LR0-automaton = (make-lr0 (trans-key kernel hash-table) (kernel vector) (kernel item hashtable))
;; trans-key = (make-trans-key kernel gram-sym) ;; trans-key = (make-trans-key kernel gram-sym)
(define-struct kernel (items index) (make-inspector)) (define-struct kernel (items index) (make-inspector))
(define-struct trans-key (st gs) (make-inspector)) (define-struct trans-key (st gs) (make-inspector))
(define-struct lr0 (transitions states) (make-inspector)) (define-struct lr0 (transitions states epsilon-trans) (make-inspector))
;; A macro to allow easy iteration over the states in an automaton ;; Iteration over the states in an automaton
(define-syntax for-each-state (define (for-each-state f a)
(syntax-rules () (let* ((states (lr0-states a))
((_ function automaton) (num-states (vector-length states)))
(let* ((states (lr0-states automaton)) (let loop ((i 0))
(num-states (vector-length states))) (if (< i num-states)
(let loop ((i 0)) (begin
(if (< i num-states) (f (vector-ref states i))
(begin (loop (add1 i)))))))
(function (vector-ref states i))
(loop (add1 i)))))))))
;; The kernels in the automaton are represented cannonically. ;; The kernels in the automaton are represented cannonically.
;; That is (equal? a b) <=> (eq? a b) ;; That is (equal? a b) <=> (eq? a b)
@ -71,7 +70,7 @@
(non-terms (list->vector (grammar-non-terms grammar))) (non-terms (list->vector (grammar-non-terms grammar)))
(num-non-terms (vector-length non-terms)) (num-non-terms (vector-length non-terms))
(num-gram-syms (+ num-non-terms (vector-length terms))) (num-gram-syms (+ num-non-terms (vector-length terms)))
(epsilons (make-hash-table 'equal))
;; first-non-term: non-term -> non-term list ;; first-non-term: non-term -> non-term list
;; given a non-terminal symbol C, return those non-terminal ;; given a non-terminal symbol C, return those non-terminal
@ -136,6 +135,7 @@
;; maps each gram-syms to a list of items ;; maps each gram-syms to a list of items
(table (make-vector num-gram-syms null)) (table (make-vector num-gram-syms null))
(epsilons (make-hash-table 'equal))
;; add-item!: ;; add-item!:
;; (item list) vector * item -> ;; (item list) vector * item ->
@ -144,18 +144,26 @@
(add-item! (add-item!
(lambda (table i) (lambda (table i)
(let ((gs (sym-at-dot i))) (let ((gs (sym-at-dot i)))
(if gs (cond
(let* ((add (if (term? gs) (gs
num-non-terms (let* ((add (if (term? gs)
0)) num-non-terms
(already 0))
(vector-ref table (already
(+ add (vector-ref table
(gram-sym-index gs))))) (+ add
(if (not (member i already)) (gram-sym-index gs)))))
(vector-set! table (if (not (member i already))
(+ add (gram-sym-index gs)) (vector-set! table
(cons i already))))))))) (+ 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 ;; Group the items of the LR0 closure of the kernel
;; by the character after the dot ;; by the character after the dot
@ -231,7 +239,7 @@
(seen-kernels null)) (seen-kernels null))
(cond (cond
((and (empty-queue? new-kernels) (null? old-kernels)) ((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) ((null? old-kernels)
(loop (deq! new-kernels) seen-kernels)) (loop (deq! new-kernels) seen-kernels))
(else (else

22
collects/parser-tools/private-yacc/table.ss
Unescape Escape View File

@ -204,13 +204,11 @@
;; buile-table: grammar * string -> action2d-array ;; buile-table: grammar * string -> action2d-array
(define (build-table g file) (define (build-table g file)
(let* ((a (build-lr0-automaton g)) (let* ((a (build-lr0-automaton g))
(get-state (lr0-states a))
(terms (grammar-terms g)) (terms (grammar-terms g))
(non-terms (grammar-non-terms g)) (non-terms (grammar-non-terms g))
(get-term (list->vector terms)) (get-term (list->vector terms))
(get-non-term (list->vector non-terms)) (get-non-term (list->vector non-terms))
(get-prod (list->vector (grammar-prods g))) (get-prod (list->vector (grammar-prods g)))
(num-states (vector-length get-state))
(num-terms (vector-length get-term)) (num-terms (vector-length get-term))
(num-non-terms (vector-length get-non-term)) (num-non-terms (vector-length get-non-term))
(end-term-indexes (end-term-indexes
@ -219,7 +217,7 @@
(+ num-non-terms (gram-sym-index term))) (+ num-non-terms (gram-sym-index term)))
(grammar-end-terms g))) (grammar-end-terms g)))
(num-gram-syms (+ num-terms num-non-terms)) (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! (array2d-add!
(lambda (v i1 i2 a) (lambda (v i1 i2 a)
(let ((old (array2d-ref v i1 i2))) (let ((old (array2d-ref v i1 i2)))
@ -240,9 +238,7 @@
(vector-ref get-non-term i) (vector-ref get-non-term i)
(vector-ref get-term (- i num-non-terms)))) (vector-ref get-term (- i num-non-terms))))
(goto (goto
(run-automaton (vector-ref get-state (kernel-index state)) (run-automaton state s a)))
s
a)))
(if goto (if goto
(array2d-set! table (array2d-set! table
(kernel-index state) (kernel-index state)
@ -256,6 +252,7 @@
(make-shift (make-shift
(kernel-index goto))))))) (kernel-index goto)))))))
(loop (add1 i))))) (loop (add1 i)))))
(for-each (for-each
(lambda (item) (lambda (item)
(for-each (for-each
@ -269,12 +266,12 @@
(item-prod-index item) (item-prod-index item)
(gram-sym-index (prod-lhs (item-prod item))) (gram-sym-index (prod-lhs (item-prod item)))
(vector-length (prod-rhs (item-prod item)))))))) (vector-length (prod-rhs (item-prod item))))))))
(get-lookahead (vector-ref get-state (kernel-index state)) (get-lookahead state (item-prod item))))
(item-prod item))))
(filter (lambda (item) (append (hash-table-get (lr0-epsilon-trans a) state (lambda () null))
(not (move-dot-right item))) (filter (lambda (item)
(kernel-items (not (move-dot-right item)))
(vector-ref get-state (kernel-index state)))))) (kernel-items state)))))
a) a)
(resolve-prec-conflicts a table get-term get-prod num-terms (resolve-prec-conflicts a table get-term get-prod num-terms
num-non-terms) num-non-terms)
@ -294,3 +291,4 @@
table)) table))
) )

Write Preview
Loading…
Cancel
Save