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

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

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

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

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

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

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

Write Preview
Loading…
Cancel
Save