Minor compiler tweaks

basis/compiler/tree/checker/checker.factor

@@ -126,7 +126,9 @@ M: #r> check-stack-flow* [ check-in-r ] [ check-out-d ] bi ;
     retainstack get empty? [ "Retain stack not empty" throw ] unless ;
 
 M: #return check-stack-flow*
-    check-in-d assert-datastack-empty assert-retainstack-empty ;
+    check-in-d
+    assert-datastack-empty
+    terminated? get [ assert-retainstack-empty ] unless ;
 
 M: #enter-recursive check-stack-flow*
     check-out-d ;
@@ -157,7 +159,7 @@ SYMBOL: branch-out
         datastack [ clone ] change
         V{ } clone retainstack set
         (check-stack-flow)
-        assert-retainstack-empty
+        terminated? get [ assert-retainstack-empty ] unless
         terminated? get f datastack get ?
     ] with-scope ;
 

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

@@ -456,3 +456,8 @@ cell-bits 32 = [
     [ [ 2array ] [ 0 3array ] if first ]
     { nth-unsafe < <= > >= } inlined?
 ] unit-test
+
+[ ] [
+    [ [ >r "A" throw r> ] [ "B" throw ] if ]
+    cleaned-up-tree drop
+] unit-test

basis/compiler/tree/optimizer/optimizer.factor

@@ -26,7 +26,7 @@ IN: compiler.tree.optimizer
     compute-def-use
     remove-dead-code
     ! strength-reduce
-    USE: kernel
+    ! USE: kernel
-    compute-def-use
+    ! compute-def-use
-    dup check-nodes
+    ! dup check-nodes
     ;

basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor

@@ -134,4 +134,6 @@ M: #alien-indirect unbox-tuples* dup in-d>> assert-not-unboxed ;
 
 M: #alien-callback unbox-tuples* ;
 
-: unbox-tuples ( nodes -- nodes ) [ unbox-tuples* ] map-nodes ;
+: unbox-tuples ( nodes -- nodes )
+    allocations get escaping-allocations get assoc-diff assoc-empty?
+    [ [ unbox-tuples* ] map-nodes ] unless ;