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 ;
8 :: (while-changes) ( obj quot: ( obj -- obj' ) comp: ( obj -- key ) old-key -- obj )
9 obj quot call :> new-obj
10 new-obj comp call :> new-key
13 [ new-obj quot comp new-key (while-changes) ]
16 : while-changes ( obj quot pred -- obj' )
17 3dup nip call (while-changes) ; inline
19 : find-delta ( states transition nfa -- new-states )
20 transitions>> '[ _ swap _ at at ] gather sift ;
22 : (find-epsilon-closure) ( states nfa -- new-states )
23 epsilon swap find-delta ;
25 : find-epsilon-closure ( states nfa -- new-states )
26 '[ dup _ (find-epsilon-closure) union ] [ length ] while-changes
29 : find-closure ( states transition nfa -- new-states )
30 [ find-delta ] keep find-epsilon-closure ;
32 : find-start-state ( nfa -- state )
33 [ start-state>> 1vector ] keep find-epsilon-closure ;
35 : find-transitions ( dfa-state nfa -- next-dfa-state )
40 : add-todo-state ( state visited-states new-states -- )
41 3dup drop key? [ 3drop ] [
42 [ conjoin ] [ push ] bi-curry* bi
45 :: new-transitions ( nfa dfa new-states visited-states -- nfa dfa )
46 new-states [ nfa dfa ] [
48 state nfa find-transitions
50 state trans nfa find-closure :> new-state
51 new-state visited-states new-states add-todo-state
52 state new-state trans transition make-transition dfa add-transition
54 nfa dfa new-states visited-states new-transitions
57 : states ( hashtable -- array )
59 [ values [ values concat ] map concat ] bi
62 : set-final-states ( nfa dfa -- )
64 [ final-states>> keys ]
65 [ transitions>> states ] bi*
66 [ intersects? ] with filter
67 ] [ final-states>> ] bi
68 [ conjoin ] curry each ;
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 ;