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 ] dip over ] 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 )
42 '[ _ at keys [ condition-states ] map concat ] gather
43 [ tagged-epsilon? not ] filter ;
45 : add-todo-state ( state visited-states new-states -- )
46 3dup drop key? [ 3drop ] [
47 [ conjoin ] [ push ] bi-curry* bi
50 : add-todo-states ( state/condition visited-states new-states -- )
51 [ condition-states ] 2dip
52 '[ _ _ add-todo-state ] each ;
54 : ensure-state ( key table -- )
55 2dup key? [ 2drop ] [ [ H{ } clone ] 2dip set-at ] if ; inline
57 :: new-transitions ( nfa dfa new-states visited-states -- nfa dfa )
58 new-states [ nfa dfa ] [
60 state dfa transitions>> ensure-state
61 state nfa find-transitions
63 state trans nfa find-closure :> new-state
64 new-state visited-states new-states add-todo-states
65 state new-state trans dfa set-transition
67 nfa dfa new-states visited-states new-transitions
70 : set-final-states ( nfa dfa -- )
72 [ final-states>> keys ]
73 [ transitions>> keys ] bi*
74 [ intersects? ] with filter
76 ] keep (>>final-states) ;
78 : initialize-dfa ( nfa -- dfa )
80 swap find-start-state >>start-state ;
82 : construct-dfa ( nfa -- dfa )
84 dup start-state>> condition-states >vector
87 [ set-final-states ] keep ;