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

*** empty log message ***

Browse Source 
original commit: 96163685dcbea3076547debb0dd5b6ac1d895a22
tokens
Scott Owens 20 years ago
parent 0576acf1c1
commit 3b89f609cc
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File

20
collects/parser-tools/private-lex/deriv.ss
Unescape Escape View File

@ -244,14 +244,15 @@
(cache (cons 'state (get-key rs)) (lambda () start)) (cache (cons 'state (get-key rs)) (lambda () start))
(let loop ((old-states (list start)) (let loop ((old-states (list start))
(new-states null) (new-states null)
(all-states (list start))
(cs (compute-chars (list start)))) (cs (compute-chars (list start))))
(cond (cond
((and (null? old-states) (null? new-states)) ((and (null? old-states) (null? new-states))
(make-dfa (get-state-number) (state-index start) (make-dfa (get-state-number) (state-index start)
(mergesort (filter (lambda (x) (cdr x)) (mergesort (filter (lambda (x) (cdr x))
(hash-table-map transitions (map (lambda (state)
(lambda (state _) (cons (state-index state) (get-final (state-spec state))))
(cons (state-index state) (get-final (state-spec state)))))) all-states))
(lambda (a b) (< (car a) (car b)))) (lambda (a b) (< (car a) (car b))))
(mergesort (hash-table-map transitions (mergesort (hash-table-map transitions
(lambda (state trans) (lambda (state trans)
@ -262,9 +263,9 @@
trans)))) trans))))
(lambda (a b) (< (car a) (car b)))))) (lambda (a b) (< (car a) (car b))))))
((null? old-states) ((null? old-states)
(loop new-states null (compute-chars new-states))) (loop new-states null all-states (compute-chars new-states)))
((null? cs) ((null? cs)
(loop (cdr old-states) new-states (compute-chars (cdr old-states)))) (loop (cdr old-states) new-states all-states (compute-chars (cdr old-states))))
(else (else
(let* ((state (car old-states)) (let* ((state (car old-states))
(c (car cs)) (c (car cs))
@ -275,7 +276,8 @@
(new-state (cache (cons 'state (get-key new-re)) (new-state (cache (cons 'state (get-key new-re))
(lambda () (lambda ()
(set! new-state? #t) (set! new-state? #t)
(make-state new-re (get-state-number)))))) (make-state new-re (get-state-number)))))
(new-all-states (if new-state? (cons new-state all-states) all-states)))
(hash-table-put! transitions (hash-table-put! transitions
state state
(cons (cons c new-state) (cons (cons c new-state)
@ -283,10 +285,10 @@
(lambda () null)))) (lambda () null))))
(cond (cond
(new-state? (new-state?
(loop old-states (cons new-state new-states) (cdr cs))) (loop old-states (cons new-state new-states) new-all-states (cdr cs)))
(else (else
(loop old-states new-states (cdr cs)))))) (loop old-states new-states new-all-states (cdr cs))))))
(else (loop old-states new-states (cdr cs)))))))))) (else (loop old-states new-states all-states (cdr cs))))))))))
(define (print-dfa x) (define (print-dfa x)
(printf "number of states: ~a~n" (dfa-num-states x)) (printf "number of states: ~a~n" (dfa-num-states x))

Write Preview
Loading…
Cancel
Save