] unless ;
: epsilon-table ( states nfa -- table )
- [ H{ } clone tuck ] dip
+ [ [ H{ } clone ] dip over ] dip
'[ _ _ t epsilon-loop ] each ;
: find-epsilon-closure ( states nfa -- dfa-state )
: find-transitions ( dfa-state nfa -- next-dfa-state )
transitions>>
'[ _ at keys [ condition-states ] map concat ] gather
- [ tagged-epsilon? not ] filter ;
+ [ tagged-epsilon? ] reject ;
: add-todo-state ( state visited-states new-states -- )
- 3dup drop key? [ 3drop ] [
- [ conjoin ] [ push ] bi-curry* bi
- ] if ;
+ 2over ?adjoin [ nip push ] [ 3drop ] if ;
: add-todo-states ( state/condition visited-states new-states -- )
[ condition-states ] 2dip
'[ _ _ add-todo-state ] each ;
+: ensure-state ( key table -- )
+ 2dup key? [ 2drop ] [ [ H{ } clone ] 2dip set-at ] if ; inline
+
:: new-transitions ( nfa dfa new-states visited-states -- nfa dfa )
new-states [ nfa dfa ] [
pop :> state
- state dfa transitions>> maybe-initialize-key
+ state dfa transitions>> ensure-state
state nfa find-transitions
[| trans |
state trans nfa find-closure :> new-state
: set-final-states ( nfa dfa -- )
[
- [ final-states>> keys ]
+ [ final-states>> members ]
[ transitions>> keys ] bi*
[ intersects? ] with filter
- unique
- ] keep (>>final-states) ;
+ fast-set
+ ] keep final-states<< ;
: initialize-dfa ( nfa -- dfa )
<transition-table>
: construct-dfa ( nfa -- dfa )
dup initialize-dfa
dup start-state>> condition-states >vector
- H{ } clone
+ HS{ } clone
new-transitions
[ set-final-states ] keep ;