regexp.disambiguate: Make it cleaner imo, but still can't make heads of tails of...

diff --git a/basis/regexp/disambiguate/disambiguate.factor b/basis/regexp/disambiguate/disambiguate.factor
index 84864a2510dce41113f08f375918d74b2beef411..9acdc88be32f9b4204126a92c76991b7db8d7cfb 100644 (file)
--- a/basis/regexp/disambiguate/disambiguate.factor
+++ b/basis/regexp/disambiguate/disambiguate.factor
@@ -15,8 +15,7 @@ TUPLE: parts in out ;
 
 : partition>class ( parts -- class )
     [ out>> [ <not-class> ] map ]
-    [ in>> <and-class> ] bi
-    prefix <and-class> ;
+    [ in>> <and-class> ] bi prefix <and-class> ;
 
 : singleton-partition ( integer non-integers -- {class,partition} )
     dupd
@@ -25,9 +24,9 @@ TUPLE: parts in out ;
     2array ;
 
 : add-out ( seq partition -- partition' )
-    [ out>> append ] [ in>> ] bi swap parts boa ;
+    [ nip in>> ] [ out>> append ] 2bi parts boa ;
 
-: intersection ( seq -- elts )
+: intersection ( seq -- elts/f )
     [ f ] [ unclip [ intersect ] reduce ] if-empty ;
 
 : meaningful-integers ( partition table -- integers )
@@ -39,34 +38,30 @@ TUPLE: parts in out ;
 
 : add-integers ( partitions classes integers -- partitions )
     class-integers '[
-        [ _ meaningful-integers ] keep add-out
+        [ _ meaningful-integers ] [ ] bi add-out
     ] map ;
 
 :: class-partitions ( classes -- assoc )
     classes [ integer? ] partition :> ( integers classes )
 
     classes powerset-partition classes integers add-integers
-    [ [ partition>class ] keep 2array ] map [ first ] filter
+    [ [ partition>class ] [ ] bi 2array ] map sift-keys
     integers [ classes singleton-partition ] map append ;
 
 : new-transitions ( transitions -- assoc ) ! assoc is class, partition
-    values [ keys ] gather
-    [ tagged-epsilon? ] reject
-    class-partitions ;
+    values [ keys ] gather [ tagged-epsilon? ] reject class-partitions ;
 
 : get-transitions ( partition state-transitions -- next-states )
     [ in>> ] dip '[ _ at ] gather sift ;
 
-: preserving-epsilon ( state-transitions quot -- new-state-transitions )
-    [ [ drop tagged-epsilon? ] assoc-filter ] bi
-    assoc-union H{ } assoc-like ; inline
-
 : disambiguate ( nfa -- nfa )
     expand-ors [
         dup new-transitions '[
             [
                 _ swap '[ _ get-transitions ] assoc-map
                 harvest-values
-            ] preserving-epsilon
+            ] [
+                [ drop tagged-epsilon? ] assoc-filter
+            ] bi H{ } assoc-union-as
         ] assoc-map
     ] change-transitions ;