compiler: cleaner use of sets.

diff --git a/basis/compiler/cfg/branch-splitting/branch-splitting.factor b/basis/compiler/cfg/branch-splitting/branch-splitting.factor
index eab1453b3d7626c202ea9b6a4daeef52ed85019e..0222df9ad07f159124b2aa14efdb643f259bb321 100644 (file)
--- a/basis/compiler/cfg/branch-splitting/branch-splitting.factor
+++ b/basis/compiler/cfg/branch-splitting/branch-splitting.factor
@@ -85,10 +85,8 @@ SYMBOL: worklist
 SYMBOL: visited
 
 : add-to-worklist ( bb -- )
-    dup visited get in? [ drop ] [
-        [ visited get adjoin ]
-        [ worklist get push-front ] bi
-    ] if ;
+    dup visited get ?adjoin
+    [ worklist get push-front ] [ drop ] if ;
 
 : init-worklist ( cfg -- )
     <dlist> worklist set

diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index c44b29d27122dcbfb7df9075a9faa7e42d176973..2c083a5a82dffaca6929b5e68c17051ecc2eb0b9 100644 (file)
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@@ -59,12 +59,11 @@ SYMBOLS: work-list loop-heads visited ;
     successors>> <reversed> [ loop-nesting-at ] sort-with ;
 
 : process-block ( bb -- )
-    dup visited? [ drop ] [
+    dup visited get ?adjoin [
         [ , ]
-        [ visited get adjoin ]
         [ sorted-successors [ process-successor ] each ]
-        tri
-    ] if ;
+        bi
+    ] [ drop ] if ;
 
 : (linearization-order) ( cfg -- bbs )
     init-linearization-order

diff --git a/basis/compiler/cfg/loop-detection/loop-detection.factor b/basis/compiler/cfg/loop-detection/loop-detection.factor
index 7c01e4444ad2603d00215e71e9f5119ddc3ff87f..34693046e4d8caca3fc23d9c842d0f48e13338ba 100644 (file)
--- a/basis/compiler/cfg/loop-detection/loop-detection.factor
+++ b/basis/compiler/cfg/loop-detection/loop-detection.factor
@@ -31,25 +31,22 @@ DEFER: find-loop-headers
     if ;
 
 : find-loop-headers ( bb -- )
-    dup visited get in? [ drop ] [
-        {
-            [ visited get adjoin ]
-            [ active get adjoin ]
-            [ dup successors>> active get '[ _ visit-edge ] with each ]
-            [ active get delete ]
-        } cleave
-    ] if ;
+    dup visited get ?adjoin [
+        active get
+        [ adjoin ]
+        [ [ dup successors>> ] dip '[ _ visit-edge ] with each ]
+        [ delete ]
+        2tri
+    ] [ drop ] if ;
 
 SYMBOL: work-list
 
 : process-loop-block ( bb loop -- )
-    2dup blocks>> in? [ 2drop ] [
-        [ blocks>> adjoin ] [
-            2dup header>> eq? [ 2drop ] [
-                drop predecessors>> work-list get push-all-front
-            ] if
-        ] 2bi
-    ] if ;
+    2dup blocks>> ?adjoin [
+        2dup header>> eq? [ 2drop ] [
+            drop predecessors>> work-list get push-all-front
+        ] if
+    ] [ 2drop ] if ;
 
 : process-loop-ends ( loop -- )
     [ ends>> members <dlist> [ push-all-front ] [ work-list set ] [ ] tri ] keep

diff --git a/basis/compiler/tree/def-use/simplified/simplified.factor b/basis/compiler/tree/def-use/simplified/simplified.factor
index b93c013dfa608561f757d6505b305764dd91a490..942e8a53a0205a62b76f0a832da41b428eab01b0 100644 (file)
--- a/basis/compiler/tree/def-use/simplified/simplified.factor
+++ b/basis/compiler/tree/def-use/simplified/simplified.factor
@@ -15,8 +15,7 @@ TUPLE: real-usage value node ;
 SYMBOLS: visited accum ;
 
 : if-not-visited ( value quot -- )
-    over visited get in?
-    [ 2drop ] [ over visited get adjoin call ] if ; inline
+    over visited get ?adjoin [ call ] [ 2drop ] if ; inline
 
 : with-simplified-def-use ( quot -- real-usages )
     [