Compiler.cfg.{dce,linearization} use new-sets

basis/bit-sets/bit-sets-tests.factor

@@ -58,3 +58,6 @@ IN: bit-sets.tests
 [ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 1 swap delete ] keep members ] unit-test
 [ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 9 swap delete ] keep members ] unit-test
 [ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ "foo" swap delete ] keep members ] unit-test
+
+[ T{ bit-set f ?{ f } } T{ bit-set f ?{ t } } ]
+[ 1 <bit-set> dup clone 0 over adjoin ] unit-test

basis/bit-sets/bit-sets.factor

@@ -69,3 +69,6 @@ M: bit-set set-like
         [ members ] dip table>> length <bit-set>
         [ [ adjoin ] curry each ] keep
     ] if ;
+
+M: bit-set clone
+    table>> clone bit-set boa ;

basis/compiler/cfg/dce/dce.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs sets kernel namespaces sequences
+USING: accessors assocs kernel namespaces sequences
 compiler.cfg.instructions compiler.cfg.def-use
-compiler.cfg.rpo compiler.cfg.predecessors ;
+compiler.cfg.rpo compiler.cfg.predecessors hash-sets new-sets ;
+FROM: namespaces => set ;
 IN: compiler.cfg.dce
 
 ! Maps vregs to sequences of vregs
@@ -12,18 +13,18 @@ SYMBOL: liveness-graph
 SYMBOL: live-vregs
 
 : live-vreg? ( vreg -- ? )
-    live-vregs get key? ;
+    live-vregs get in? ;
 
 ! vregs which are the result of an allocation
 SYMBOL: allocations
 
 : allocation? ( vreg -- ? )
-    allocations get key? ;
+    allocations get in? ;
 
 : init-dead-code ( -- )
     H{ } clone liveness-graph set
-    H{ } clone live-vregs set
+    HS{ } clone live-vregs set
-    H{ } clone allocations set ;
+    HS{ } clone allocations set ;
 
 GENERIC: build-liveness-graph ( insn -- )
 
@@ -46,7 +47,7 @@ M: ##write-barrier-imm build-liveness-graph
     dup src>> setter-liveness-graph ;
 
 M: ##allot build-liveness-graph
-    [ dst>> allocations get conjoin ] [ call-next-method ] bi ;
+    [ dst>> allocations get adjoin ] [ call-next-method ] bi ;
 
 M: insn build-liveness-graph
     dup defs-vreg dup [ add-edges ] [ 2drop ] if ;
@@ -55,8 +56,8 @@ GENERIC: compute-live-vregs ( insn -- )
 
 : (record-live) ( vregs -- )
     [
-        dup live-vregs get key? [ drop ] [
+        dup live-vreg? [ drop ] [
-            [ live-vregs get conjoin ]
+            [ live-vregs get adjoin ]
             [ liveness-graph get at (record-live) ]
             bi
         ] if

basis/compiler/cfg/linearization/order/order.factor

@@ -2,8 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs deques dlists kernel make sorting
 namespaces sequences combinators combinators.short-circuit
-fry math sets compiler.cfg.rpo compiler.cfg.utilities
+fry math compiler.cfg.rpo compiler.cfg.utilities
-compiler.cfg.loop-detection compiler.cfg.predecessors ;
+compiler.cfg.loop-detection compiler.cfg.predecessors
+new-sets hash-sets ;
+FROM: namespaces => set ;
 IN: compiler.cfg.linearization.order
 
 ! This is RPO except loops are rotated. Based on SBCL's src/compiler/control.lisp
@@ -12,16 +14,16 @@ IN: compiler.cfg.linearization.order
 
 SYMBOLS: work-list loop-heads visited ;
 
-: visited? ( bb -- ? ) visited get key? ;
+: visited? ( bb -- ? ) visited get in? ;
 
 : add-to-work-list ( bb -- )
-    dup visited get key? [ drop ] [
+    dup visited? [ drop ] [
         work-list get push-back
     ] if ;
 
 : init-linearization-order ( cfg -- )
     <dlist> work-list set
-    H{ } clone visited set
+    HS{ } clone visited set
     entry>> add-to-work-list ;
 
 : (find-alternate-loop-head) ( bb -- bb' )
@@ -58,7 +60,7 @@ SYMBOLS: work-list loop-heads visited ;
 : process-block ( bb -- )
     dup visited? [ drop ] [
         [ , ]
-        [ visited get conjoin ]
+        [ visited get adjoin ]
         [ sorted-successors [ process-successor ] each ]
         tri
     ] if ;
@@ -76,4 +78,4 @@ PRIVATE>
     dup linear-order>> [ ] [
         dup (linearization-order)
         >>linear-order linear-order>>
-    ] ?if ;
+    ] ?if ;

basis/new-sets/new-sets-tests.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2010 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: new-sets tools.test kernel sorting prettyprint bit-arrays arrays ;
+USING: new-sets tools.test kernel prettyprint hash-sets sorting ;
 IN: new-sets.tests
 
 [ { } ] [ { } { } intersect  ] unit-test
@@ -38,32 +38,3 @@ IN: new-sets.tests
 [ { 1 2 3 } ] [ HS{ 1 2 3 } { } set-like natural-sort ] unit-test
 
 [ HS{ 1 2 3 } ] [ { 1 2 3 } fast-set ] unit-test
-
-[ { 1 2 3 } ] [ HS{ 1 2 3 } members natural-sort ] unit-test
-
-[ "HS{ 1 2 3 4 }" ] [ HS{ 1 2 3 4 } unparse ] unit-test
-
-[ t ] [ 1 HS{ 0 1 2 } in? ] unit-test
-[ f ] [ 3 HS{ 0 1 2 } in? ] unit-test
-[ HS{ 1 2 3 } ] [ 3 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
-[ HS{ 1 2 } ] [ 2 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
-[ HS{ 1 2 3 } ] [ 4 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
-[ HS{ 1 2 } ] [ 3 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
-[ HS{ 1 2 } ] [ HS{ 1 2 } fast-set ] unit-test
-[ { 1 2 } ] [ HS{ 1 2 } members natural-sort ] unit-test
-
-[ HS{ 1 2 3 4 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } union ] unit-test
-[ HS{ 2 3 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } intersect ] unit-test
-[ t ] [ HS{ 1 2 3 } HS{ 2 3 4 } intersects? ] unit-test
-[ f ] [ HS{ 1 } HS{ 2 3 4 } intersects? ] unit-test
-[ f ] [ HS{ 1 } HS{ 2 3 4 } subset? ] unit-test
-[ f ] [ HS{ 1 2 3 } HS{ 2 3 4 } subset? ] unit-test
-[ t ] [ HS{ 2 3 } HS{ 2 3 4 } subset? ] unit-test
-[ t ] [ HS{ } HS{ 2 3 4 } subset? ] unit-test
-[ HS{ 1 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } diff ] unit-test
-[ t ] [ HS{ 1 2 3 } HS{ 2 1 3 } set= ] unit-test
-[ t ] [ HS{ 1 2 3 } HS{ 2 1 3 } = ] unit-test
-[ f ] [ HS{ 2 3 } HS{ 2 1 3 } set= ] unit-test
-[ f ] [ HS{ 1 2 3 } HS{ 2 3 } set= ] unit-test
-
-[ HS{ 1 2 } HS{ 1 2 3 } ] [ HS{ 1 2 } clone dup clone [ 3 swap adjoin ] keep ] unit-test

basis/new-sets/new-sets.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs hashtables kernel
 math sequences parser prettyprint.custom ;
-QUALIFIED: sets
+FROM: sets => prune ;
 IN: new-sets
 ! The vocab is called new-sets for now, but only until it gets into core
 ! All the code here is in the style that could be put in core
@@ -52,37 +52,14 @@ M: set set=
 
 M: set fast-set ;
 
-! Hash sets
-! In a better implementation, less memory would be used
-TUPLE: hash-set { table hashtable read-only } ;
-
-: <hash-set> ( members -- hash-set )
-    sets:unique hash-set boa ;
-
-INSTANCE: hash-set set
-M: hash-set in? table>> key? ; inline
-M: hash-set adjoin table>> dupd set-at ; inline
-M: hash-set delete table>> delete-at ; inline
-M: hash-set members table>> keys ; inline
-M: hash-set set-like
-    drop dup hash-set? [ members <hash-set> ] unless ;
-M: hash-set clone
-    table>> clone hash-set boa ;
-
-SYNTAX: HS{
-    \ } [ <hash-set> ] parse-literal ;
-
-M: hash-set pprint* pprint-object ;
-M: hash-set pprint-delims drop \ HS{ \ } ;
-M: hash-set >pprint-sequence members ;
-
 ! Sequences are sets
 INSTANCE: sequence set
 M: sequence in? member? ; inline
-M: sequence adjoin sets:adjoin ; inline
+M: sequence adjoin [ delete ] [ push ] 2bi ;
 M: sequence delete remove! drop ; inline
 M: sequence set-like
-    [ dup sequence? [ sets:prune ] [ members ] if ] dip
+    [ dup sequence? [ prune ] [ members ] if ] dip like ;
-    like ;
+M: sequence members fast-set members ;
-M: sequence members ;
+
-M: sequence fast-set <hash-set> ;
+USE: vocabs.loader
+"hash-sets" require