]> gitweb.factorcode.org Git - factor.git/commitdiff
Regexps use new sets rather than assocs for final states
authorDaniel Ehrenberg <littledan@Macintosh-122.local>
Tue, 2 Mar 2010 23:05:37 +0000 (18:05 -0500)
committerDaniel Ehrenberg <littledan@Macintosh-122.local>
Tue, 2 Mar 2010 23:05:37 +0000 (18:05 -0500)
basis/regexp/compiler/compiler.factor
basis/regexp/dfa/dfa.factor
basis/regexp/minimize/minimize-tests.factor
basis/regexp/minimize/minimize.factor
basis/regexp/negation/negation-tests.factor
basis/regexp/negation/negation.factor
basis/regexp/nfa/nfa.factor
basis/regexp/transition-tables/transition-tables.factor

index d8940bb829a3afc70848194901b8a795d36d8999..0682cc4f56dbdafb371b96013e8399d47050f7cf 100644 (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 -- )
index fa75232fd5c0b7472da6c765b6bca3b60a43aa8b..416781bdb3374031d9e01b72f6d5088a7a2ae740 100644 (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 )
index 17a1d51b88e0a3e8142a99e7dc5ffa39b71f5581..7f961f4d98ffffb6efee04473bfe4fe5b851fd15 100644 (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
 
index a6eb4f00a288dbf752ccd8a1d2fd74aa9b441321..832622e6e1388c14549530fe1722a7b1bffd1ed6 100644 (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 )
index 41dfe7f493d390ce65f418c819a5d1e1362c7c15..f367e62ff55507ac8a3d7b7f169646b1753e7284 100644 (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
index 802e2115368d07b0502b230e285a51bfba6a61e4..5f627b645ec438384982eff19debe5d92a63e587 100644 (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 )
index cc430f2de1f5c558e536c0714f0ca76f7742138a..fb210c5ef2040974a4e285ada7ad4242f3593d13 100644 (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 ;
index f452e3d24a4e46c25523a904332647d725c9ea74..b548b883b2a953da98f6263d775c69c3d3cf3f12 100644 (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 '[