Work on class algebra for regexp

diff --git a/basis/regexp/classes/classes.factor b/basis/regexp/classes/classes.factor
index c7106c915416c9b1c63154d05990b2a659ffe949..8d235daf07e4c64fd8a1098621e408ea142d3eef 100644 (file)
--- a/basis/regexp/classes/classes.factor
+++ b/basis/regexp/classes/classes.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math math.order words combinators
+USING: accessors kernel math math.order words combinators locals
 ascii unicode.categories combinators.short-circuit sequences ;
+QUALIFIED-WITH: multi-methods m
 IN: regexp.classes
 
 SINGLETONS: any-char any-char-no-nl
@@ -106,37 +107,74 @@ M: beginning-of-line class-member? ( obj class -- ? )
 M: end-of-line class-member? ( obj class -- ? )
     2drop f ;
 
+M: f class-member? 2drop f ;
+
+TUPLE: primitive-class class ;
+C: <primitive-class> primitive-class
+
 TUPLE: or-class seq ;
 
 TUPLE: not-class class ;
 
 TUPLE: and-class seq ;
 
-TUPLE: primitive-class class ;
-C: <primitive-class> primitive-class
+m:GENERIC: combine-and ( class1 class2 -- combined ? )
+
+m:METHOD: combine-and { object object } 2drop f f ;
+
+m:METHOD: combine-and { integer integer }
+    2dup = [ drop t ] [ 2drop f t ] if ;
+
+m:METHOD: combine-and { t object }
+    nip t ;
+
+m:METHOD: combine-and { f object }
+    drop t ;
+
+m:METHOD: combine-and { integer object }
+    2dup class-member? [ drop t ] [ 2drop f t ] if ;
+
+m:GENERIC: combine-or ( class1 class2 -- combined ? )
+
+m:METHOD: combine-or { object object } 2drop f f ;
+
+m:METHOD: combine-or { integer integer }
+    2dup = [ drop t ] [ 2drop f f ] if ;
+
+m:METHOD: combine-or { t object }
+    drop t ;
+
+m:METHOD: combine-or { f object }
+    nip t ;
+
+m:METHOD: combine-or { integer object }
+    2dup class-member? [ nip t ] [ 2drop f f ] if ;
+
+: try-combine ( elt1 elt2 quot -- combined/f ? )
+    3dup call [ [ 3drop ] dip t ] [ drop swapd call ] if ; inline
+
+:: prefix-combining ( seq elt quot: ( elt1 elt2 -- combined/f ? ) -- newseq )
+    f :> combined!
+    seq [ elt quot try-combine swap combined! ] find drop
+    [ seq remove-nth combined prefix ]
+    [ seq elt prefix ] if* ; inline
+
+:: combine ( seq quot: ( elt1 elt2 -- combined/f ? ) empty class -- newseq )
+    seq { } [ quot prefix-combining ] reduce
+    dup length {
+        { 0 [ drop empty ] }
+        { 1 [ first ] }
+        [ drop class new swap >>seq ]
+    } case ; inline
 
 : <and-class> ( seq -- class )
-    t swap remove
-    f over member? [ drop f ] [
-        dup length {
-            { 0 [ drop t ] }
-            { 1 [ first ] }
-            [ drop and-class boa ]
-        } case
-    ] if ;
+    [ combine-and ] t and-class combine ;
 
 M: and-class class-member?
     seq>> [ class-member? ] with all? ;
 
 : <or-class> ( seq -- class )
-    f swap remove
-    t over member? [ drop t ] [
-        dup length {
-            { 0 [ drop f ] }
-            { 1 [ first ] }
-            [ drop or-class boa ]
-        } case
-    ] if ;
+    [ combine-or ] t or-class combine ;
 
 M: or-class class-member?
     seq>> [ class-member? ] with any? ;

diff --git a/basis/regexp/disambiguate/disambiguate.factor b/basis/regexp/disambiguate/disambiguate.factor
index 2e26e43625ff572e943d18c2752d9e3894f1a605..1243ab7cc1672851dd43df2520162563bbd68a6a 100644 (file)
--- a/basis/regexp/disambiguate/disambiguate.factor
+++ b/basis/regexp/disambiguate/disambiguate.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
+! Copyright (C) 2009 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors regexp.classes math.bits assocs sequences
 arrays sets regexp.dfa math fry regexp.minimize ;