Cleaning up DCE

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -144,7 +144,7 @@ M: object xyz ;
 
 [ f ] [ [ dup 0 < [ neg ] when ] \ - inlined? ] unit-test
 
-[ f ] [
+[ t ] [
     [
         [ no-cond ] 1
         [ 1array dup quotation? [ >quotation ] unless ] times
@@ -433,7 +433,7 @@ cell-bits 32 = [
     ] { >= fixnum>= } inlined?
 ] unit-test
 
-[ t ] [
+[ ] [
     [
         4 pick array-capacity?
         [ set-slot ] [ \ array-capacity 2nip bad-slot-value ] if

basis/compiler/tree/dead-code/branches/branches.factor

@@ -35,7 +35,7 @@ M: #branch remove-dead-code*
     [ length ] keep live-values get
     '[ , nth , key? ] filter ; inline
 
-: drop-values ( values indices -- node )
+: drop-indexed-values ( values indices -- node )
     [ drop filter-live ] [ nths ] 2bi
     [ make-values ] keep
     [ drop ] [ zip ] 2bi
@@ -44,7 +44,7 @@ M: #branch remove-dead-code*
 : insert-drops ( nodes values indices -- nodes' )
     '[
         over ends-with-terminate?
-        [ drop ] [ , drop-values suffix ] if
+        [ drop ] [ , drop-indexed-values suffix ] if
     ] 2map ;
 
 : hoist-drops ( #phi -- )

basis/compiler/tree/dead-code/recursive/recursive.factor

@@ -25,14 +25,13 @@ M: #call-recursive compute-live-values*
     [ out-d>> ] [ label>> return>> in-d>> ] bi look-at-mapping ;
 
 :: drop-dead-inputs ( inputs outputs -- #shuffle )
-    [let* | new-inputs [ inputs make-values ]
-            live-inputs [ outputs inputs filter-corresponding ]
-            new-live-inputs [ outputs new-inputs filter-corresponding ]
-            mapping [ new-live-inputs live-inputs zip ] |
-        inputs filter-live
+    [let* | live-inputs [ inputs filter-live ]
+            new-live-inputs [ outputs inputs filter-corresponding make-values ] |
+        live-inputs
         new-live-inputs
-        mapping
-        #shuffle
+        outputs
+        inputs
+        drop-values
     ] ;
 
 M: #recursive remove-dead-code* ( node -- nodes )
@@ -53,18 +52,21 @@ M: #enter-recursive remove-dead-code*
     [ nip ]
     2bi ;
 
-:: drop-call-recursive-outputs ( node -- #shuffle )
-    [let* | node-out [ node out-d>> ]
-            return-in [ node label>> return>> in-d>> ]
-            node-out-live [ return-in node-out filter-corresponding ]
-            new-node-out-live [ node-out-live make-values ]
-            node-out-dropped [ node-out filter-live ]
-            new-node-out-dropped [ node-out-dropped new-node-out-live filter-corresponding ]
-            mapping [ node-out-dropped new-node-out-dropped zip ] |
-        node new-node-out-live >>out-d drop
-        new-node-out-live node-out-dropped mapping #shuffle
+:: (drop-call-recursive-outputs) ( inputs outputs -- #shuffle )
+    [let* | new-live-outputs [ inputs outputs filter-corresponding make-values ]
+            live-outputs [ outputs filter-live ] |
+        new-live-outputs
+        live-outputs
+        live-outputs
+        new-live-outputs
+        drop-values
     ] ;
 
+: drop-call-recursive-outputs ( node -- #shuffle )
+    dup [ label>> return>> in-d>> ] [ out-d>> ] bi
+    (drop-call-recursive-outputs)
+    [ in-d>> >>out-d drop ] keep ;
+
 M: #call-recursive remove-dead-code*
     [ drop-call-recursive-inputs ]
     [ ]

basis/compiler/tree/dead-code/simple/simple.factor

@@ -61,20 +61,28 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
 : filter-live ( values -- values' )
     [ live-value? ] filter ;
 
-: drop-dead-values ( in out -- #shuffle )
-    [ make-values dup ] keep zip #shuffle ;
+:: drop-values ( inputs outputs mapping-keys mapping-values -- #shuffle )
+    inputs
+    outputs
+    outputs
+    mapping-keys
+    mapping-values
+    filter-corresponding zip #shuffle ; inline
 
-:: drop-dead-outputs ( node -- nodes )
-    [let* | old-outputs [ node out-d>> ]
-            new-outputs [ old-outputs make-values ]
-            old-live-outputs [ old-outputs filter-live ]
-            new-live-outputs [ old-outputs new-outputs filter-corresponding ]
-            mapping [ old-live-outputs new-live-outputs zip ] |
-        node new-outputs >>out-d
-        new-outputs old-live-outputs mapping #shuffle
-        2array
+:: drop-dead-values ( outputs -- #shuffle )
+    [let* | new-outputs [ outputs make-values ]
+            live-outputs [ outputs filter-live ] |
+        new-outputs
+        live-outputs
+        outputs
+        new-outputs
+        drop-values
     ] ;
 
+: drop-dead-outputs ( node -- nodes )
+    dup out-d>> drop-dead-values
+    [ in-d>> >>out-d drop ] [ 2array ] 2bi ;
+
 M: #introduce remove-dead-code* ( #introduce -- nodes )
     drop-dead-outputs ;
 

basis/compiler/tree/debugger/debugger.factor

@@ -3,7 +3,7 @@
 USING: kernel assocs fry match accessors namespaces effects
 sequences sequences.private quotations generic macros arrays
 prettyprint prettyprint.backend prettyprint.sections math words
-combinators io sorting
+combinators io sorting hints
 compiler.tree
 compiler.tree.builder
 compiler.tree.optimizer