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

*** empty log message ***

Browse Source 
original commit: a4ff3b193e6908036453cf5bfcea9a9abc7ef77a
tokens
Scott Owens 23 years ago
parent d315d5a52e
commit a015a446e0
4 changed files with 45 additions and 30 deletions
Show Stats Download Patch File Download Diff File

8
collects/parser-tools/private-yacc/grammar.ss
Unescape Escape View File

@ -14,13 +14,13 @@
(rename make-gram make-grammar)
;; Things that work on items
start-item? item-prod item-prod-index item->string
start-item? item-prod item->string
sym-at-dot move-dot-right item<? nullable-after-dot?
;; Things that operate on grammar symbols
gram-sym-symbol gram-sym-index term-prec gram-sym->string
non-term? term? nullable? non-term<? term<?
term-list->bit-vector
term-list->bit-vector term-index non-term-index
;; Things that work on precs
prec-num prec-assoc
@ -46,9 +46,7 @@
(define (export-make-item a b)
(make-item a b #f))
(define (item-prod-index x)
(prod-index (item-prod x)))
;; item<?: LR-item * LR-item -> bool
;; Lexicographic comparison on two items.

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

@ -78,8 +78,9 @@
(kernel-index p)
(prod-index prod)
(make-trans-key state non-term)))
(loop new-i
(run-automaton p next-sym a))))))
(if next-sym
(loop new-i
(run-automaton p next-sym a)))))))
(get-nt-prods g non-term)))
non-terms))
a)

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

@ -5,9 +5,10 @@
(require "grammar.ss"
"graph.ss"
"array2d.ss"
(lib "list.ss"))
(provide union build-lr0-automaton run-automaton (struct trans-key (st gs))
(provide build-lr0-automaton run-automaton (struct trans-key (st gs))
get-mapped-lr0-non-term-keys lr0-states lr0-epsilon-trans
kernel-items kernel-index for-each-state)
@ -30,11 +31,11 @@
;; 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) (kernel item hashtable))
;; LR0-automaton = (make-lr0 (kernel array2d) (kernel array2d) (trans-key list) (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 (term-transitions non-term-transitions states epsilon-trans) (make-inspector))
(define-struct lr0 (term-transitions non-term-transitions mapped-non-terms states epsilon-trans) (make-inspector))
;; Iteration over the states in an automaton
@ -55,17 +56,15 @@
(kernel-items k))
"}")))
(define (false-thunk) #f)
;; run-automaton: kernel * gram-sym * LR0-automaton -> kernel | #f
;; returns the state that the transition trans-key provides or #f
;; if there is no such state
(define (run-automaton k s a)
(if (term? s)
(hash-table-get (lr0-term-transitions a) (make-trans-key k s) false-thunk)
(hash-table-get (lr0-non-term-transitions a) (make-trans-key k s) false-thunk)))
(array2d-ref (lr0-term-transitions a) (kernel-index k) (term-index s))
(array2d-ref (lr0-non-term-transitions a) (kernel-index k) (non-term-index s))))
(define (get-mapped-lr0-non-term-keys a)
(hash-table-map (lr0-non-term-transitions a) (lambda (k v) k)))
(define get-mapped-lr0-non-term-keys lr0-mapped-non-terms)
(define (add-lr0-transition! ttable nttable key value)
(hash-table-put!
@ -74,6 +73,16 @@
nttable)
key
value))
(define (make-lr0-table auto-hash states syms)
(let ((t (make-array2d states syms #f)))
(hash-table-map auto-hash
(lambda (k v)
(array2d-set! t
(kernel-index (trans-key-st k))
(gram-sym-index (trans-key-gs k))
v)))
t))
;; build-LR0-automaton: grammar -> LR0-automaton
@ -151,7 +160,6 @@
;; 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 ->
@ -255,7 +263,11 @@
(seen-kernels null))
(cond
((and (empty-queue? new-kernels) (null? old-kernels))
(make-lr0 automaton-term automaton-non-term (list->vector (reverse! seen-kernels)) epsilons))
(make-lr0 (make-lr0-table automaton-term (length seen-kernels) (vector-length terms))
(make-lr0-table automaton-non-term (length seen-kernels) (vector-length non-terms))
(hash-table-map automaton-non-term (lambda (k v) k))
(list->vector (reverse! seen-kernels))
epsilons))
((null? old-kernels)
(loop (deq! new-kernels) seen-kernels))
(else

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

@ -242,6 +242,7 @@
(else (if (not (equal? a old))
(array2d-set! v i1 i2 (list a old))))))))
(get-lookahead (compute-LA a g)))
(time
(for-each-state
(lambda (state)
(let loop ((i 0))
@ -268,26 +269,29 @@
(for-each
(lambda (item)
(bit-vector-for-each
(lambda (term-index)
(array2d-add! table
(kernel-index state)
(+ num-non-terms term-index)
(cond
((not (start-item? item))
(make-reduce
(item-prod-index item)
(gram-sym-index (prod-lhs (item-prod item)))
(vector-length (prod-rhs (item-prod item))))))))
(get-lookahead state (item-prod item))))
(let ((item-prod (item-prod item)))
(bit-vector-for-each
(lambda (term-index)
(array2d-add! table
(kernel-index state)
(+ num-non-terms term-index)
(cond
((not (start-item? item))
(make-reduce
(prod-index item-prod)
(gram-sym-index (prod-lhs item-prod))
(vector-length (prod-rhs item-prod)))))))
(get-lookahead state item-prod))))
(append (hash-table-get (lr0-epsilon-trans a) state (lambda () null))
(filter (lambda (item)
(not (move-dot-right item)))
(kernel-items state)))))
a)
a))
(resolve-prec-conflicts a table get-term get-prod num-terms
num-non-terms)
(if (not (string=? file ""))
(with-handlers [(exn:i/o:filesystem?
(lambda (e)

Write Preview
Loading…
Cancel
Save