Moving new-sets to sets

[factor.git] / core / sets / sets.factor

diff --git a/core/sets/sets.factor b/core/sets/sets.factor
index 38c1f73bb372eca032898c05a90349bbfea3d00e..550b906b55397c52cf1319ec866a21c65fcfff30 100644 (file)
--- a/core/sets/sets.factor
+++ b/core/sets/sets.factor
@@ -1,59 +1,112 @@
-! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
+! Copyright (C) 2010 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs hashtables kernel sequences vectors ;
+USING: accessors assocs hashtables kernel vectors
+math sequences ;
 IN: sets
 
-: adjoin ( elt seq -- ) [ remove! drop ] [ push ] 2bi ;
+! Set protocol
+MIXIN: set
+GENERIC: adjoin ( elt set -- )
+GENERIC: in? ( elt set -- ? )
+GENERIC: delete ( elt set -- )
+GENERIC: set-like ( set exemplar -- set' )
+GENERIC: fast-set ( set -- set' )
+GENERIC: members ( set -- sequence )
+GENERIC: union ( set1 set2 -- set )
+GENERIC: intersect ( set1 set2 -- set )
+GENERIC: intersects? ( set1 set2 -- ? )
+GENERIC: diff ( set1 set2 -- set )
+GENERIC: subset? ( set1 set2 -- ? )
+GENERIC: set= ( set1 set2 -- ? )
+GENERIC: duplicates ( set -- sequence )
+GENERIC: all-unique? ( set -- ? )
+
+! Defaults for some methods.
+! Override them for efficiency
+
+M: set union
+    [ [ members ] bi@ append ] keep set-like ;
 
-: conjoin ( elt assoc -- ) dupd set-at ;
+<PRIVATE
 
-: conjoin-at ( value key assoc -- )
-    [ dupd ?set-at ] change-at ;
+: tester ( set -- quot )
+    fast-set [ in? ] curry ; inline
 
-: (prune) ( elt hash vec -- )
-    3dup drop key? [ 3drop ] [
-        [ drop conjoin ] [ nip push ] 3bi
-    ] if ; inline
+: sequence/tester ( set1 set2 -- set1' quot )
+    [ members ] [ tester ] bi* ; inline
 
-: prune ( seq -- newseq )
-    [ ] [ length <hashtable> ] [ length <vector> ] tri
-    [ [ (prune) ] 2curry each ] keep ;
+PRIVATE>
 
-: duplicates ( seq -- newseq )
-    H{ } clone [ [ key? ] [ conjoin ] 2bi ] curry filter ;
+M: set intersect
+    [ sequence/tester filter ] keep set-like ;
 
-: gather ( seq quot -- newseq )
-    map concat prune ; inline
+M: set diff
+    [ sequence/tester [ not ] compose filter ] keep set-like ;
 
-: unique ( seq -- assoc )
-    [ dup ] H{ } map>assoc ;
+M: set intersects?
+    sequence/tester any? ;
+
+M: set subset?
+    sequence/tester all? ;
+    
+M: set set=
+    2dup subset? [ swap subset? ] [ 2drop f ] if ;
 
-: (all-unique?) ( elt hash -- ? )
-    2dup key? [ 2drop f ] [ conjoin t ] if ;
+M: set fast-set ;
 
-: all-unique? ( seq -- ? )
-    dup length <hashtable> [ (all-unique?) ] curry all? ;
+M: set duplicates drop f ;
+
+M: set all-unique? drop t ;
 
 <PRIVATE
 
-: tester ( seq -- quot ) unique [ key? ] curry ; inline
+: (pruned) ( elt hash vec -- )
+    3dup drop in? [ 3drop ] [
+        [ drop adjoin ] [ nip push ] 3bi
+    ] if ; inline
+
+: pruned ( seq -- newseq )
+    [ f fast-set ] [ length <vector> ] bi
+    [ [ (pruned) ] 2curry each ] keep ;
 
 PRIVATE>
 
-: intersect ( seq1 seq2 -- newseq )
-    tester filter ;
+! Sequences are sets
+INSTANCE: sequence set
 
-: intersects? ( seq1 seq2 -- ? )
-    tester any? ;
+M: sequence in?
+    member? ; inline
 
-: diff ( seq1 seq2 -- newseq )
-    tester [ not ] compose filter ;
+M: sequence adjoin
+    [ delete ] [ push ] 2bi ;
 
-: union ( seq1 seq2 -- newseq )
-    append prune ;
+M: sequence delete
+    remove! drop ; inline
 
-: subset? ( seq1 seq2 -- ? )
-    tester all? ;
+M: sequence set-like
+    [ members ] dip like ;
 
-: set= ( seq1 seq2 -- ? )
-    [ unique ] bi@ = ;
+M: sequence members
+    [ pruned ] keep like ;
+
+M: sequence all-unique?
+    dup pruned sequence= ;
+
+: combine ( sets -- set )
+    f [ union ] reduce ;
+
+: gather ( seq quot -- newseq )
+    map concat members ; inline
+
+: adjoin-at ( value key assoc -- )
+    [ [ f fast-set ] unless* [ adjoin ] keep ] change-at ;
+
+! Temporarily for compatibility
+
+ALIAS: prune members
+: unique ( seq -- assoc )
+    [ dup ] H{ } map>assoc ;
+: conjoin ( elt assoc -- )
+    dupd set-at ;
+: conjoin-at ( value key assoc -- )
+    [ dupd ?set-at ] change-at ;