! Copyright (C) 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: regexp.classes kernel sequences regexp.negation
-quotations assocs fry math locals combinators
+quotations assocs fry math locals combinators sets
accessors words compiler.units kernel.private strings
sequences.private arrays namespaces unicode.breaks
regexp.transition-tables combinators.short-circuit ;
: word>quot ( word dfa -- quot )
[ transitions>> at ]
- [ final-states>> key? ] 2bi
+ [ final-states>> in? ] 2bi
transitions>quot ;
: states>code ( words dfa -- )
: set-final-states ( nfa dfa -- )
[
- [ final-states>> keys ]
+ [ final-states>> members ]
[ transitions>> keys ] bi*
[ intersects? ] with filter
- unique
+ fast-set
] keep (>>final-states) ;
: initialize-dfa ( nfa -- dfa )
{ 3 H{ } }
} }
{ start-state 0 }
- { final-states H{ { 3 3 } } }
+ { final-states HS{ 3 } }
}
] [
T{ transition-table
{ 6 H{ } }
} }
{ start-state 0 }
- { final-states H{ { 3 3 } { 6 6 } } }
+ { final-states HS{ 3 6 } }
} combine-states
] unit-test
{
[ drop <= ]
[ transitions>> '[ _ at keys ] bi@ set= ]
- [ final-states>> '[ _ key? ] bi@ = ]
+ [ final-states>> '[ _ in? ] bi@ = ]
} 3&& ;
:: initialize-partitions ( transition-table -- partitions )
{ -1 H{ { t -1 } } }
} }
{ start-state 0 }
- { final-states H{ { 0 0 } { -1 -1 } } }
+ { final-states HS{ 0 -1 } }
}
] [
! R/ a/
{ 1 H{ } }
} }
{ start-state 0 }
- { final-states H{ { 1 1 } } }
+ { final-states HS{ 1 } }
} negate-table
] unit-test
USING: regexp.nfa regexp.disambiguate kernel sequences
assocs regexp.classes hashtables accessors fry vectors
regexp.ast regexp.transition-tables regexp.minimize
-regexp.dfa namespaces ;
+regexp.dfa namespaces sets ;
IN: regexp.negation
CONSTANT: fail-state -1
fail-state-recurses ;
: inverse-final-states ( transition-table -- final-states )
- [ transitions>> assoc>set ] [ final-states>> ] bi assoc-diff ;
+ [ transitions>> keys ] [ final-states>> ] bi diff fast-set ;
: negate-table ( transition-table -- transition-table )
clone
[ [ [ 1vector ] assoc-map ] assoc-map ] change-transitions ;
: unify-final-state ( transition-table -- transition-table )
- dup [ final-states>> keys ] keep
+ dup [ final-states>> members ] keep
'[ -2 epsilon _ set-transition ] each
- H{ { -2 -2 } } >>final-states ;
+ HS{ -2 } clone >>final-states ;
: adjoin-dfa ( transition-table -- start end )
unify-final-state renumber-states box-transitions
[ start-state>> ]
- [ final-states>> keys first ]
+ [ final-states>> members first ]
[ nfa-table get [ transitions>> ] bi@ swap assoc-union! drop ] tri ;
: ast>dfa ( parse-tree -- minimal-dfa )
<transition-table> nfa-table set
nfa-node
nfa-table get
- swap dup associate >>final-states
+ swap 1array fast-set >>final-states
swap >>start-state
] with-scope ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs fry hashtables kernel sequences
-vectors locals regexp.classes ;
+vectors locals regexp.classes sets ;
IN: regexp.transition-tables
TUPLE: transition-table transitions start-state final-states ;
: <transition-table> ( -- transition-table )
transition-table new
H{ } clone >>transitions
- H{ } clone >>final-states ;
+ HS{ } clone >>final-states ;
:: (set-transition) ( from to obj hash -- )
from hash at
: add-transition ( from to obj transition-table -- )
transitions>> (add-transition) ;
-: map-set ( assoc quot -- new-assoc )
- '[ drop @ dup ] assoc-map ; inline
+: map-set ( set quot -- new-set )
+ over [ [ members ] dip map ] dip set-like ; inline
: number-transitions ( transitions numbering -- new-transitions )
dup '[