Regexps use new sets rather than assocs for final states

db4
Daniel Ehrenberg 2010-03-02 18:05:37 -05:00
parent 7364608417
commit 3ad5ca4636
8 changed files with 19 additions and 19 deletions

View File

@ -1,7 +1,7 @@
! 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 ;
@ -106,7 +106,7 @@ C: <box> box
: word>quot ( word dfa -- quot )
[ transitions>> at ]
[ final-states>> key? ] 2bi
[ final-states>> in? ] 2bi
transitions>quot ;
: states>code ( words dfa -- )

View File

@ -69,10 +69,10 @@ IN: regexp.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 )

View File

@ -34,7 +34,7 @@ IN: regexp.minimize.tests
{ 3 H{ } }
} }
{ start-state 0 }
{ final-states H{ { 3 3 } } }
{ final-states HS{ 3 } }
}
] [
T{ transition-table
@ -48,7 +48,7 @@ IN: regexp.minimize.tests
{ 6 H{ } }
} }
{ start-state 0 }
{ final-states H{ { 3 3 } { 6 6 } } }
{ final-states HS{ 3 6 } }
} combine-states
] unit-test

View File

@ -18,7 +18,7 @@ IN: regexp.minimize
{
[ drop <= ]
[ transitions>> '[ _ at keys ] bi@ set= ]
[ final-states>> '[ _ key? ] bi@ = ]
[ final-states>> '[ _ in? ] bi@ = ]
} 3&& ;
:: initialize-partitions ( transition-table -- partitions )

View File

@ -12,7 +12,7 @@ IN: regexp.negation.tests
{ -1 H{ { t -1 } } }
} }
{ start-state 0 }
{ final-states H{ { 0 0 } { -1 -1 } } }
{ final-states HS{ 0 -1 } }
}
] [
! R/ a/
@ -22,6 +22,6 @@ IN: regexp.negation.tests
{ 1 H{ } }
} }
{ start-state 0 }
{ final-states H{ { 1 1 } } }
{ final-states HS{ 1 } }
} negate-table
] unit-test

View File

@ -3,7 +3,7 @@
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
@ -21,7 +21,7 @@ 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
@ -36,14 +36,14 @@ CONSTANT: fail-state -1
[ [ [ 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 )

View File

@ -163,6 +163,6 @@ M: with-options nfa-node ( node -- start end )
<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 ;

View File

@ -1,7 +1,7 @@
! 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 ;
@ -9,7 +9,7 @@ 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
@ -27,8 +27,8 @@ TUPLE: transition-table transitions start-state final-states ;
: 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 '[