1 ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs combinators fry kernel locals
4 math math.order regexp.nfa regexp.transition-tables sequences
5 sets sorting vectors regexp.ast regexp.classes ;
8 : find-delta ( states transition nfa -- new-states )
9 transitions>> '[ _ swap _ at at ] gather sift ;
11 :: epsilon-loop ( state table nfa question -- )
12 state table at :> old-value
13 old-value question 2array <or-class> :> new-question
14 new-question old-value = [
15 new-question state table set-at
16 state nfa transitions>> at
17 [ drop tagged-epsilon? ] assoc-filter
21 trans tag>> new-question 2array <and-class>
27 : epsilon-table ( states nfa -- table )
28 [ H{ } clone tuck ] dip
29 '[ _ _ t epsilon-loop ] each ;
31 : find-epsilon-closure ( states nfa -- dfa-state )
32 epsilon-table table>condition ;
34 : find-closure ( states transition nfa -- new-states )
35 [ find-delta ] keep find-epsilon-closure ;
37 : find-start-state ( nfa -- state )
38 [ start-state>> 1array ] keep find-epsilon-closure ;
40 : find-transitions ( dfa-state nfa -- next-dfa-state )
45 : add-todo-state ( state visited-states new-states -- )
46 3dup drop key? [ 3drop ] [
47 [ conjoin ] [ push ] bi-curry* bi
50 :: new-transitions ( nfa dfa new-states visited-states -- nfa dfa )
51 new-states [ nfa dfa ] [
53 state nfa find-transitions
55 state trans nfa find-closure :> new-state
56 new-state visited-states new-states add-todo-state
57 state new-state trans dfa set-transition
59 nfa dfa new-states visited-states new-transitions
62 : set-final-states ( nfa dfa -- )
64 [ final-states>> keys ]
65 [ transitions>> keys ] bi*
66 [ intersects? ] with filter
68 ] keep (>>final-states) ;
70 : initialize-dfa ( nfa -- dfa )
72 swap find-start-state >>start-state ;
74 : construct-dfa ( nfa -- dfa )
76 dup start-state>> 1vector
79 [ set-final-states ] keep ;