Renaming an internal word in regexp

basis/regexp/classes/classes-tests.factor

@@ -30,15 +30,15 @@ IN: regexp.classes.tests
 [ T{ or-class { seq { 3 2 } } } ] [ { 2 3 } <or-class> 1 <not-class> 2array <and-class> ] unit-test
 [ f ] [ t <not-class> ] unit-test
 [ t ] [ f <not-class> ] unit-test
-[ f ] [ 1 <not-class> 1 t replace-question ] unit-test
+[ f ] [ 1 <not-class> 1 t answer ] unit-test
 
 ! Making classes into nested conditionals
 
 [ V{ 1 2 3 4 } ] [ T{ and-class f { 1 T{ not-class f 2 } T{ or-class f { 3 4 } } 2 } } class>questions ] unit-test
 [ { 3 } ] [ { { 3 t } } table>condition ] unit-test
 [ { T{ primitive-class } } ] [ { { 1 t } { 2 T{ primitive-class } } } table>questions ] unit-test
-[ { { 1 t } { 2 t } } ] [ { { 1 t } { 2 T{ primitive-class } } } T{ primitive-class } t answer ] unit-test
-[ { { 1 t } } ] [ { { 1 t } { 2 T{ primitive-class } } } T{ primitive-class } f answer ] unit-test
+[ { { 1 t } { 2 t } } ] [ { { 1 t } { 2 T{ primitive-class } } } T{ primitive-class } t assoc-answer ] unit-test
+[ { { 1 t } } ] [ { { 1 t } { 2 T{ primitive-class } } } T{ primitive-class } f assoc-answer ] unit-test
 [ T{ condition f T{ primitive-class } { 1 2 } { 1 } } ] [ { { 1 t } { 2 T{ primitive-class } } } table>condition ] unit-test
 
 SYMBOL: foo
@@ -46,13 +46,13 @@ SYMBOL: bar
 
 [ T{ condition f T{ primitive-class f bar } T{ condition f T{ primitive-class f foo } { 1 3 2 } { 1 3 } } T{ condition f T{ primitive-class f foo } { 1 2 } { 1 } } } ] [ { { 1 t } { 3 T{ primitive-class f bar } } { 2 T{ primitive-class f foo } } } table>condition ] unit-test
 
-[ t ] [ foo <primitive-class> dup t replace-question ] unit-test
-[ f ] [ foo <primitive-class> dup f replace-question ] unit-test
-[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> t replace-question ] unit-test
-[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> f replace-question ] unit-test
-[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> bar <primitive-class> t replace-question ] unit-test
-[ T{ primitive-class f bar } ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> foo <primitive-class> t replace-question ] unit-test
-[ f ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> foo <primitive-class> f replace-question ] unit-test
-[ f ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> bar <primitive-class> f replace-question ] unit-test
-[ t ] [ foo <primitive-class> bar <primitive-class> 2array <or-class> bar <primitive-class> t replace-question ] unit-test
-[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> 2array <or-class> bar <primitive-class> f replace-question ] unit-test
+[ t ] [ foo <primitive-class> dup t answer ] unit-test
+[ f ] [ foo <primitive-class> dup f answer ] unit-test
+[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> t answer ] unit-test
+[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> f answer ] unit-test
+[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> bar <primitive-class> t answer ] unit-test
+[ T{ primitive-class f bar } ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> foo <primitive-class> t answer ] unit-test
+[ f ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> foo <primitive-class> f answer ] unit-test
+[ f ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> bar <primitive-class> f answer ] unit-test
+[ t ] [ foo <primitive-class> bar <primitive-class> 2array <or-class> bar <primitive-class> t answer ] unit-test
+[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> 2array <or-class> bar <primitive-class> f answer ] unit-test

basis/regexp/classes/classes.factor

@@ -163,20 +163,32 @@ M: integer combine-or
 : try-combine ( elt1 elt2 quot -- combined/f ? )
     3dup call [ [ 3drop ] dip t ] [ drop swapd call ] if ; inline
 
+DEFER: answer
+
+:: try-cancel ( elt1 elt2 empty -- combined/f ? )
+    [ elt1 elt2 empty answer dup elt1 = not ] try-combine ;
+
 :: prefix-combining ( seq elt quot: ( elt1 elt2 -- combined/f ? ) -- newseq )
     f :> combined!
-    seq [ elt quot try-combine swap combined! ] find drop
+    seq [ elt quot call swap combined! ] find drop
     [ seq remove-nth combined prefix ]
     [ seq elt prefix ] if* ; inline
 
+: combine-by ( seq quot -- new-seq )
+    { } swap '[ _ prefix-combining ] reduce ; inline
+
+:: seq>instance ( seq empty class -- instance )
+    seq length {
+        { 0 [ empty ] }
+        { 1 [ seq first ] }
+        [ drop class new seq >>seq ]
+    } case ; inline
+
 :: combine ( seq quot: ( elt1 elt2 -- combined/f ? ) empty class -- newseq )
     seq class flatten
-    { } [ quot prefix-combining ] reduce
-    dup length {
-        { 0 [ drop empty ] }
-        { 1 [ first ] }
-        [ drop class new swap >>seq ]
-    } case ; inline
+    [ quot try-combine ] combine-by
+    ! [ empty try-cancel ] combine-by ! This makes the algorithm O(n^4)
+    empty class seq>instance ; inline
 
 : <and-class> ( seq -- class )
     [ combine-and ] t and-class combine ;
@@ -218,36 +230,36 @@ UNION: class primitive-class not-class or-class and-class range ;
 TUPLE: condition question yes no ;
 C: <condition> condition
 
-GENERIC# replace-question 2 ( class from to -- new-class )
+GENERIC# answer 2 ( class from to -- new-class )
 
-M:: object replace-question ( class from to -- new-class )
+M:: object answer ( class from to -- new-class )
     class from = to class ? ;
 
 : replace-compound ( class from to -- seq )
-    [ seq>> ] 2dip '[ _ _ replace-question ] map ;
+    [ seq>> ] 2dip '[ _ _ answer ] map ;
 
-M: and-class replace-question
+M: and-class answer
     replace-compound <and-class> ;
 
-M: or-class replace-question
+M: or-class answer
     replace-compound <or-class> ;
 
-M: not-class replace-question
-    [ class>> ] 2dip replace-question <not-class> ;
+M: not-class answer
+    [ class>> ] 2dip answer <not-class> ;
 
-: answer ( table question answer -- new-table )
-    '[ _ _ replace-question ] assoc-map
+: assoc-answer ( table question answer -- new-table )
+    '[ _ _ answer ] assoc-map
     [ nip ] assoc-filter ;
 
-: answers ( table questions answer -- new-table )
-    '[ _ answer ] each ;
+: assoc-answers ( table questions answer -- new-table )
+    '[ _ assoc-answer ] each ;
 
 DEFER: make-condition
 
 : (make-condition) ( table questions question -- condition )
     [ 2nip ]
-    [ swap [ t answer ] dip make-condition ]
-    [ swap [ f answer ] dip make-condition ] 3tri
+    [ swap [ t assoc-answer ] dip make-condition ]
+    [ swap [ f assoc-answer ] dip make-condition ] 3tri
     2dup = [ 2nip ] [ <condition> ] if ;
 
 : make-condition ( table questions -- condition )

basis/regexp/combinators/combinators-tests.factor

@@ -16,7 +16,7 @@ USE: multiline
     { R' .*a' R' b.*' } <and> ;
 
 [ t ] [ "bljhasflsda" conj matches? ] unit-test
-[ f ] [ "bsdfdfs" conj matches? ] unit-test ! why does this fail?
+[ f ] [ "bsdfdfs" conj matches? ] unit-test
 [ f ] [ "fsfa" conj matches? ] unit-test
 
 [ f ] [ "bljhasflsda" conj <not> matches? ] unit-test

basis/regexp/compiler/compiler.factor

@@ -64,7 +64,7 @@ C: <box> box
 
 : non-literals>dispatch ( literals non-literals  -- quot )
     [ swap ] assoc-map ! we want state => predicate, and get the opposite as input
-    swap keys f answers
+    swap keys f assoc-answers
     table>condition [ <box> ] condition-map condition>quot ;
 
 : literals>cases ( literal-transitions -- case-body )