use reject instead of [ ... not ] filter.

[factor.git] / basis / regexp / dfa / dfa.factor

diff --git a/basis/regexp/dfa/dfa.factor b/basis/regexp/dfa/dfa.factor
index 01e3e01119ddb377d23eb9f299ea68cf27a85ea8..5c77741032499c70d8967074a5ba88f96cf00c8e 100644 (file)
--- a/basis/regexp/dfa/dfa.factor
+++ b/basis/regexp/dfa/dfa.factor
@@ -2,70 +2,76 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators fry kernel locals
 math math.order regexp.nfa regexp.transition-tables sequences
-sets sorting vectors regexp.ast ;
+sets sorting vectors regexp.ast regexp.classes ;
 IN: regexp.dfa
 
-:: (while-changes) ( obj quot: ( obj -- obj' ) comp: ( obj -- key ) old-key -- obj )
-    obj quot call :> new-obj
-    new-obj comp call :> new-key
-    new-key old-key =
-    [ new-obj ]
-    [ new-obj quot comp new-key (while-changes) ]
-    if ; inline recursive
-
-: while-changes ( obj quot pred -- obj' )
-    3dup nip call (while-changes) ; inline
-
 : find-delta ( states transition nfa -- new-states )
     transitions>> '[ _ swap _ at at ] gather sift ;
 
-: (find-epsilon-closure) ( states nfa -- new-states )
-    epsilon swap find-delta ;
+:: epsilon-loop ( state table nfa question -- )
+    state table at :> old-value
+    old-value question 2array <or-class> :> new-question
+    new-question old-value = [
+        new-question state table set-at
+        state nfa transitions>> at
+        [ drop tagged-epsilon? ] assoc-filter
+        [| trans to |
+            to [
+                table nfa
+                trans tag>> new-question 2array <and-class>
+                epsilon-loop
+            ] each
+        ] assoc-each
+    ] unless ;
+
+: epsilon-table ( states nfa -- table )
+    [ [ H{ } clone ] dip over ] dip
+    '[ _ _ t epsilon-loop ] each ;
 
-: find-epsilon-closure ( states nfa -- new-states )
-    '[ dup _ (find-epsilon-closure) union ] [ length ] while-changes
-    natural-sort ;
+: find-epsilon-closure ( states nfa -- dfa-state )
+    epsilon-table table>condition ;
 
 : find-closure ( states transition nfa -- new-states )
     [ find-delta ] keep find-epsilon-closure ;
 
 : find-start-state ( nfa -- state )
-    [ start-state>> 1vector ] keep find-epsilon-closure ;
+    [ start-state>> 1array ] keep find-epsilon-closure ;
 
 : find-transitions ( dfa-state nfa -- next-dfa-state )
     transitions>>
-    '[ _ at keys ] gather
-    epsilon swap remove ;
+    '[ _ at keys [ condition-states ] map concat ] gather
+    [ 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>> ensure-state
         state nfa find-transitions
         [| trans |
             state trans nfa find-closure :> new-state
-            new-state visited-states new-states add-todo-state
-            state new-state trans dfa add-transition
+            new-state visited-states new-states add-todo-states
+            state new-state trans dfa set-transition
         ] each
         nfa dfa new-states visited-states new-transitions
     ] if-empty ;
 
-: states ( hashtable -- array )
-    [ keys ]
-    [ values [ values concat ] map concat ] bi
-    append ;
-
 : set-final-states ( nfa dfa -- )
     [
-        [ final-states>> keys ]
-        [ transitions>> states ] bi*
+        [ final-states>> members ]
+        [ transitions>> keys ] bi*
         [ intersects? ] with filter
-    ] [ final-states>> ] bi
-    [ conjoin ] curry each ;
+        fast-set
+    ] keep final-states<< ;
 
 : initialize-dfa ( nfa -- dfa )
     <transition-table>
@@ -73,7 +79,7 @@ IN: regexp.dfa
 
 : construct-dfa ( nfa -- dfa )
     dup initialize-dfa
-    dup start-state>> 1vector
-    H{ } clone
+    dup start-state>> condition-states >vector
+    HS{ } clone
     new-transitions
     [ set-final-states ] keep ;