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))
(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)

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

@ -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)))

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

@ -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<?)
(letrec ((union
@ -29,24 +30,22 @@
;; kernel = (make-kernel (LR1-item list) index)
;; the list must be kept sorted according to item<? so that equal? can
;; 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)
(define-struct kernel (items index) (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
(define-syntax for-each-state
(syntax-rules ()
((_ function automaton)
(let* ((states (lr0-states automaton))
(num-states (vector-length states)))
(let loop ((i 0))
(if (< i num-states)
(begin
(function (vector-ref states i))
(loop (add1 i)))))))))
;; Iteration over the states in an automaton
(define (for-each-state f a)
(let* ((states (lr0-states a))
(num-states (vector-length states)))
(let loop ((i 0))
(if (< i num-states)
(begin
(f (vector-ref states i))
(loop (add1 i)))))))
;; The kernels in the automaton are represented cannonically.
;; That is (equal? a b) <=> (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

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

@ -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))
)

Write Preview
Loading…
Cancel
Save