From b5473d7f142b098c2355aa3002edd09373114fd6 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-103.local>
Date: Sat, 9 Aug 2008 12:40:17 -0400
Subject: [PATCH 1/2] Persistent deques

---
 basis/persistent/deques/authors.txt         |  1 +
 basis/persistent/deques/deques-docs.factor  | 56 +++++++++++++++
 basis/persistent/deques/deques-tests.factor | 35 ++++++++++
 basis/persistent/deques/deques.factor       | 76 +++++++++++++++++++++
 basis/persistent/deques/summary.txt         |  1 +
 basis/persistent/deques/tags.txt            |  1 +
 6 files changed, 170 insertions(+)
 create mode 100644 basis/persistent/deques/authors.txt
 create mode 100644 basis/persistent/deques/deques-docs.factor
 create mode 100644 basis/persistent/deques/deques-tests.factor
 create mode 100644 basis/persistent/deques/deques.factor
 create mode 100644 basis/persistent/deques/summary.txt
 create mode 100644 basis/persistent/deques/tags.txt

diff --git a/basis/persistent/deques/authors.txt b/basis/persistent/deques/authors.txt
new file mode 100644
index 0000000000..f990dd0ed2
--- /dev/null
+++ b/basis/persistent/deques/authors.txt
@@ -0,0 +1 @@
+Daniel Ehrenberg
diff --git a/basis/persistent/deques/deques-docs.factor b/basis/persistent/deques/deques-docs.factor
new file mode 100644
index 0000000000..56ee46a6a9
--- /dev/null
+++ b/basis/persistent/deques/deques-docs.factor
@@ -0,0 +1,56 @@
+USING: help.markup help.syntax kernel sequences ;
+IN: persistent.deques
+
+ARTICLE: "persistent.deques" "Persistent deques"
+"A deque is a data structure that can be used as both a queue and a stack. That is, there are two ends, the left and the right, and values can be pushed onto and popped off of both ends. These operations take O(1) amortized time and space in a normal usage pattern."
+$nl
+"This vocabulary provides a deque implementation which is persistent and purely functional: old versions of deques are not modified by operations. Instead, each push and pop operation creates a new deque based off the old one."
+$nl
+"The class of persistent deques:"
+{ $subsection deque }
+"To create a deque:"
+{ $subsection <deque> }
+{ $subsection sequence>deque }
+"To test if a deque is empty:"
+{ $subsection deque-empty? }
+"To manipulate deques:"
+{ $subsection push-left }
+{ $subsection push-right }
+{ $subsection pop-left }
+{ $subsection pop-right }
+{ $subsection deque>sequence } ;
+
+HELP: deque
+{ $class-description "This is the class of persistent (functional) double-ended queues. All deque operations can be done in O(1) amortized time for single-threaded access while maintaining the old version. For more information, see " { $link "persistent.deques" } "." } ;
+
+HELP: <deque>
+{ $values { "deque" "an empty deque" } }
+{ $description "Creates an empty deque." } ;
+
+HELP: sequence>deque
+{ $values { "sequence" sequence } { "deque" deque } }
+{ $description "Given a sequence, creates a deque containing those elements in the order such that the beginning of the sequence is on the left and the end is on the right." } ;
+
+HELP: deque>sequence
+{ $values { "deque" deque } { "sequence" sequence } }
+{ $description "Given a deque, creates a sequence containing those elements, such that the left side of the deque is the beginning of the sequence." } ;
+
+HELP: deque-empty?
+{ $values { "deque" deque } { "?" "t/f" } }
+{ $description "Returns true if the deque is empty. This takes constant time." } ;
+
+HELP: push-left
+{ $values { "deque" deque } { "item" object } { "newdeque" deque } }
+{ $description "Creates a new deque with the given object pushed onto the left side. This takes constant time." } ;
+
+HELP: push-right
+{ $values { "deque" deque } { "item" object } { "newdeque" deque } }
+{ $description "Creates a new deque with the given object pushed onto the right side. This takes constant time." } ;
+
+HELP: pop-left
+{ $values { "deque" object } { "item" object } { "newdeque" deque } }
+{ $description "Creates a new deque with the leftmost item removed. This takes amortized constant time with single-threaded access." } ;
+
+HELP: pop-right
+{ $values { "deque" object } { "item" object } { "newdeque" deque } }
+{ $description "Creates a new deque with the rightmost item removed. This takes amortized constant time with single-threaded access." } ;
diff --git a/basis/persistent/deques/deques-tests.factor b/basis/persistent/deques/deques-tests.factor
new file mode 100644
index 0000000000..353828cb14
--- /dev/null
+++ b/basis/persistent/deques/deques-tests.factor
@@ -0,0 +1,35 @@
+! Copyright (C) 2008 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test persistent.deques kernel math ;
+IN: persistent.deques.tests
+
+[ 3 2 1 t ]
+[ { 1 2 3 } sequence>deque 3 [ pop-right ] times deque-empty? ] unit-test
+
+[ 1 2 3 t ]
+[ { 1 2 3 } sequence>deque 3 [ pop-left ] times deque-empty? ] unit-test
+
+[ 1 3 2 t ]
+[ { 1 2 3 } sequence>deque pop-left 2 [ pop-right ] times deque-empty? ]
+unit-test
+
+[ { 2 3 4 5 6 1 } ]
+[ { 1 2 3 4 5 6 } sequence>deque pop-left swap push-right deque>sequence ]
+unit-test
+
+[ 1 t ] [ <deque> 1 push-left pop-right deque-empty? ] unit-test
+[ 1 t ] [ <deque> 1 push-left pop-left deque-empty? ] unit-test
+[ 1 t ] [ <deque> 1 push-right pop-left deque-empty? ] unit-test
+[ 1 t ] [ <deque> 1 push-right pop-right deque-empty? ] unit-test
+
+[ 1 f ]
+[ <deque> 1 push-left 2 push-left pop-right deque-empty? ] unit-test
+
+[ 1 f ]
+[ <deque> 1 push-right 2 push-right pop-left deque-empty? ] unit-test
+
+[ 2 f ]
+[ <deque> 1 push-right 2 push-right pop-right deque-empty? ] unit-test
+
+[ 2 f ]
+[ <deque> 1 push-left 2 push-left pop-left deque-empty? ] unit-test
diff --git a/basis/persistent/deques/deques.factor b/basis/persistent/deques/deques.factor
new file mode 100644
index 0000000000..b30153aada
--- /dev/null
+++ b/basis/persistent/deques/deques.factor
@@ -0,0 +1,76 @@
+! Copyright (C) 2008 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors math qualified ;
+QUALIFIED: sequences
+IN: persistent.deques
+
+! Amortized O(1) push/pop on both ends for single-threaded access
+! In a pathological case, if there are m modified versions from the
+!   same source, it could take O(m) amortized time per update.
+
+<PRIVATE
+TUPLE: cons { car read-only } { cdr read-only } ;
+C: <cons> cons
+
+: each ( list quot -- )
+    over
+    [ [ >r car>> r> call ] [ >r cdr>> r> ] 2bi each ]
+    [ 2drop ] if ; inline
+
+: reduce ( list start quot -- end )
+    swapd each ; inline
+
+: reverse ( list -- reversed )
+    f [ swap <cons> ] reduce ;
+
+: length ( list -- length )
+    0 [ drop 1+ ] reduce ;
+
+: cut ( list index -- back front-reversed )
+    f swap [ >r [ cdr>> ] [ car>> ] bi r> <cons> ] times ;
+
+: split-reverse ( list -- back-reversed front )
+    dup length 2/ cut [ reverse ] bi@ ;
+PRIVATE>
+
+TUPLE: deque { lhs read-only } { rhs read-only } ;
+: <deque> ( -- deque ) T{ deque } ;
+
+: deque-empty? ( deque -- ? )
+    [ lhs>> ] [ rhs>> ] bi or not ;
+
+: push-left ( deque item -- newdeque )
+    swap [ lhs>> <cons> ] [ rhs>> ] bi deque boa ;
+
+: push-right ( deque item -- newdeque )
+    swap [ rhs>> <cons> ] [ lhs>> ] bi swap deque boa ;
+
+<PRIVATE
+: (pop-left) ( deque -- item newdeque )
+    [ lhs>> car>> ] [ [ lhs>> cdr>> ] [ rhs>> ] bi deque boa ] bi ;
+
+: transfer-left ( deque -- item newdeque )
+    rhs>> [ split-reverse deque boa (pop-left) ]
+    [ "Popping from an empty deque" throw ] if* ;
+PRIVATE>
+
+: pop-left ( deque -- item newdeque )
+    dup lhs>> [ (pop-left) ] [ transfer-left ] if ;
+
+<PRIVATE
+: (pop-right) ( deque -- item newdeque )
+    [ rhs>> car>> ] [ [ lhs>> ] [ rhs>> cdr>> ] bi deque boa ] bi ;
+
+: transfer-right ( deque -- newdeque item )
+    lhs>> [ split-reverse deque boa (pop-left) ]
+    [ "Popping from an empty deque" throw ] if* ;
+PRIVATE>
+
+: pop-right ( deque -- item newdeque )
+    dup rhs>> [ (pop-right) ] [ transfer-right ] if ;
+
+: sequence>deque ( sequence -- deque )
+    <deque> [ push-right ] sequences:reduce ;
+
+: deque>sequence ( deque -- sequence )
+    [ dup deque-empty? not ] [ pop-left swap ] [ ] sequences:produce nip ;
diff --git a/basis/persistent/deques/summary.txt b/basis/persistent/deques/summary.txt
new file mode 100644
index 0000000000..021a1e3fef
--- /dev/null
+++ b/basis/persistent/deques/summary.txt
@@ -0,0 +1 @@
+Persistent amortized O(1) deques
diff --git a/basis/persistent/deques/tags.txt b/basis/persistent/deques/tags.txt
new file mode 100644
index 0000000000..42d711b32b
--- /dev/null
+++ b/basis/persistent/deques/tags.txt
@@ -0,0 +1 @@
+collections

From ca57e4386cdc39f8ae9cff36c33ce35cab2381b1 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 9 Aug 2008 23:00:27 -0500
Subject: [PATCH 2/2] Various fixes

---
 .../compiler/tree/checker/checker.factor      | 61 +++++++++++++++++++
 .../compiler/tree/cleanup/cleanup.factor      |  5 +-
 .../dataflow-analysis.factor                  |  7 ++-
 .../tree/def-use/def-use-tests.factor         | 22 +++++--
 .../compiler/tree/def-use/def-use.factor      | 20 +++---
 .../escape-analysis/branches/branches.factor  |  6 +-
 .../escape-analysis-tests.factor              |  5 +-
 .../recursive/recursive.factor                |  9 ++-
 .../tree/escape-analysis/simple/simple.factor |  6 +-
 .../normalization/normalization-tests.factor  |  4 +-
 .../tree/normalization/normalization.factor   | 12 +++-
 .../tree/propagation/branches/branches.factor | 16 +++--
 .../tree/propagation/copy/copy.factor         |  3 +-
 .../propagation/recursive/recursive.factor    |  2 +-
 .../tuple-unboxing-tests.factor               | 20 +++---
 .../tree/tuple-unboxing/tuple-unboxing.factor | 18 +++---
 .../stack-checker/branches/branches.factor    | 21 +++++--
 17 files changed, 173 insertions(+), 64 deletions(-)
 create mode 100644 unfinished/compiler/tree/checker/checker.factor

diff --git a/unfinished/compiler/tree/checker/checker.factor b/unfinished/compiler/tree/checker/checker.factor
new file mode 100644
index 0000000000..08beec8b8f
--- /dev/null
+++ b/unfinished/compiler/tree/checker/checker.factor
@@ -0,0 +1,61 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences kernel sets namespaces accessors assocs
+arrays combinators continuations
+compiler.tree
+compiler.tree.def-use
+compiler.tree.combinators ;
+IN: compiler.tree.checker
+
+! Check some invariants.
+ERROR: check-use-error value message ;
+
+: check-use ( value uses -- )
+    [ empty? [ "No use" check-use-error ] [ drop ] if ]
+    [ all-unique? [ drop ] [ "Uses not all unique" check-use-error ] if ] 2bi ;
+
+: check-def-use ( -- )
+    def-use get [ uses>> check-use ] assoc-each ;
+
+GENERIC: check-node ( node -- )
+
+M: #shuffle check-node
+    [ [ mapping>> values ] [ in-d>> ] bi subset? [ "Bad mapping inputs" throw ] unless ]
+    [ [ mapping>> keys ] [ out-d>> ] bi set= [ "Bad mapping outputs" throw ] unless ]
+    bi ;
+
+: check-lengths ( seq -- )
+    [ length ] map all-equal? [ "Bad lengths" throw ] unless ;
+
+M: #copy check-node inputs/outputs 2array check-lengths ;
+
+M: #>r check-node inputs/outputs 2array check-lengths ;
+
+M: #r> check-node inputs/outputs 2array check-lengths ;
+
+M: #return-recursive check-node inputs/outputs 2array check-lengths ;
+
+M: #phi check-node
+    {
+        [ [ phi-in-d>> ] [ out-d>> ] bi 2array check-lengths ]
+        [ [ phi-in-r>> ] [ out-r>> ] bi 2array check-lengths ]
+        [ phi-in-d>> check-lengths ]
+        [ phi-in-r>> check-lengths ]
+    } cleave ;
+
+M: #enter-recursive check-node
+    [ [ in-d>> ] [ out-d>> ] bi 2array check-lengths ]
+    [ [ label>> calls>> [ in-d>> ] map ] [ in-d>> ] bi suffix check-lengths ]
+    bi ;
+
+M: #push check-node
+    out-d>> length 1 = [ "Bad #push" throw ] unless ;
+
+M: node check-node drop ;
+
+ERROR: check-node-error node error ;
+
+: check-nodes ( nodes -- )
+    compute-def-use
+    check-def-use
+    [ [ check-node ] [ check-node-error ] recover ] each-node ;
diff --git a/unfinished/compiler/tree/cleanup/cleanup.factor b/unfinished/compiler/tree/cleanup/cleanup.factor
index 45a916b984..1ea31fe815 100644
--- a/unfinished/compiler/tree/cleanup/cleanup.factor
+++ b/unfinished/compiler/tree/cleanup/cleanup.factor
@@ -105,10 +105,10 @@ SYMBOL: live-branches
 
 M: #branch cleanup*
     {
-        [ live-branches>> live-branches set ]
         [ delete-unreachable-branches ]
         [ cleanup-children ]
         [ fold-only-branch ]
+        [ live-branches>> live-branches set ]
     } cleave ;
 
 : cleanup-phi-in ( phi-in live-branches -- phi-in' )
@@ -122,7 +122,8 @@ M: #phi cleanup*
         [ '[ , cleanup-phi-in ] change-phi-in-r ]
         [ '[ , cleanup-phi-in ] change-phi-info-d ]
         [ '[ , cleanup-phi-in ] change-phi-info-r ]
-    } cleave ;
+    } cleave
+    live-branches off ;
 
 : >copy ( node -- #copy ) [ in-d>> ] [ out-d>> ] bi #copy ;
 
diff --git a/unfinished/compiler/tree/dataflow-analysis/dataflow-analysis.factor b/unfinished/compiler/tree/dataflow-analysis/dataflow-analysis.factor
index c7d558f4bf..54b10e9612 100644
--- a/unfinished/compiler/tree/dataflow-analysis/dataflow-analysis.factor
+++ b/unfinished/compiler/tree/dataflow-analysis/dataflow-analysis.factor
@@ -1,8 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry accessors namespaces assocs dequeues search-dequeues
-kernel sequences words sets stack-checker.inlining compiler.tree
-compiler.tree.def-use compiler.tree.combinators ;
+kernel sequences words sets
+stack-checker.branches stack-checker.inlining
+compiler.tree compiler.tree.def-use compiler.tree.combinators ;
 IN: compiler.tree.dataflow-analysis
 
 ! Dataflow analysis
@@ -34,5 +35,5 @@ SYMBOL: work-list
 : dfa ( node mark-quot iterate-quot -- assoc )
     init-dfa
     [ each-node ] dip
-    work-list get H{ { f f } } clone
+    work-list get H{ { +bottom+ f } } clone
     [ rot '[ , , iterate-dfa ] slurp-dequeue ] keep ; inline
diff --git a/unfinished/compiler/tree/def-use/def-use-tests.factor b/unfinished/compiler/tree/def-use/def-use-tests.factor
index 34e28761ac..88172443ad 100755
--- a/unfinished/compiler/tree/def-use/def-use-tests.factor
+++ b/unfinished/compiler/tree/def-use/def-use-tests.factor
@@ -1,7 +1,9 @@
 USING: accessors namespaces assocs kernel sequences math
 tools.test words sets combinators.short-circuit
 stack-checker.state compiler.tree compiler.tree.builder
-compiler.tree.def-use arrays kernel.private ;
+compiler.tree.normalization compiler.tree.propagation
+compiler.tree.cleanup compiler.tree.def-use arrays kernel.private
+sorting math.order binary-search compiler.tree.checker ;
 IN: compiler.tree.def-use.tests
 
 \ compute-def-use must-infer
@@ -14,8 +16,16 @@ IN: compiler.tree.def-use.tests
     } 1&&
 ] unit-test
 
-! compute-def-use checks for SSA violations, so we make sure
-! some common patterns are generated correctly.
+: test-def-use ( quot -- )
+    build-tree
+    normalize
+    propagate
+    cleanup
+    compute-def-use
+    check-nodes ;
+
+! compute-def-use checks for SSA violations, so we use that to
+! ensure we generate some common patterns correctly.
 {
     [ [ drop ] each-integer ]
     [ [ 2drop ] curry each-integer ]
@@ -28,6 +38,10 @@ IN: compiler.tree.def-use.tests
     [ [ 1 ] 2 [ + ] curry compose call + ]
     [ [ 1 ] [ call 2 ] curry call + ]
     [ [ 1 ] [ 2 ] compose swap [ 1 ] [ 2 ] if + * ]
+    [ dup slice? [ dup array? [ ] [ ] if ] [ ] if ]
+    [ dup [ drop f ] [ "A" throw ] if ]
+    [ [ <=> ] sort ]
+    [ [ <=> ] with search ]
 } [
-    [ ] swap [ build-tree compute-def-use drop ] curry unit-test
+    [ ] swap [ test-def-use ] curry unit-test
 ] each
diff --git a/unfinished/compiler/tree/def-use/def-use.factor b/unfinished/compiler/tree/def-use/def-use.factor
index 189dd292a2..c0cc240fd4 100755
--- a/unfinished/compiler/tree/def-use/def-use.factor
+++ b/unfinished/compiler/tree/def-use/def-use.factor
@@ -1,8 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays namespaces assocs sequences kernel generic assocs
-classes vectors accessors combinators sets stack-checker.state
-compiler.tree compiler.tree.combinators ;
+classes vectors accessors combinators sets
+stack-checker.state
+stack-checker.branches
+compiler.tree
+compiler.tree.combinators ;
 IN: compiler.tree.def-use
 
 SYMBOL: def-use
@@ -37,7 +40,8 @@ M: #introduce node-uses-values drop f ;
 M: #push node-uses-values drop f ;
 M: #r> node-uses-values in-r>> ;
 M: #phi node-uses-values
-    [ phi-in-d>> ] [ phi-in-r>> ] bi append concat sift prune ;
+    [ phi-in-d>> ] [ phi-in-r>> ] bi
+    append concat remove-bottom prune ;
 M: #declare node-uses-values declaration>> keys ;
 M: node node-uses-values in-d>> ;
 
@@ -57,14 +61,6 @@ M: node node-defs-values out-d>> ;
     [ dup node-uses-values [ use-value ] with each ]
     [ dup node-defs-values [ def-value ] with each ] bi ;
 
-: check-use ( uses -- )
-    [ empty? [ "No use" throw ] when ]
-    [ all-unique? [ "Uses not all unique" throw ] unless ] bi ;
-
-: check-def-use ( -- )
-    def-use get [ nip uses>> check-use ] assoc-each ;
-
 : compute-def-use ( node -- node )
     H{ } clone def-use set
-    dup [ node-def-use ] each-node
-    check-def-use ;
+    dup [ node-def-use ] each-node ;
diff --git a/unfinished/compiler/tree/escape-analysis/branches/branches.factor b/unfinished/compiler/tree/escape-analysis/branches/branches.factor
index 391649fcb2..910726e069 100644
--- a/unfinished/compiler/tree/escape-analysis/branches/branches.factor
+++ b/unfinished/compiler/tree/escape-analysis/branches/branches.factor
@@ -9,7 +9,9 @@ compiler.tree.escape-analysis.allocations ;
 IN: compiler.tree.escape-analysis.branches
 
 M: #branch escape-analysis*
-    live-children sift [ (escape-analysis) ] each ;
+    [ in-d>> add-escaping-values ]
+    [ live-children sift [ (escape-analysis) ] each ]
+    bi ;
 
 : (merge-allocations) ( values -- allocation )
     [
@@ -25,7 +27,7 @@ M: #branch escape-analysis*
     ] map ;
 
 : merge-allocations ( in-values out-values -- )
-    [ [ sift ] map ] dip
+    [ [ remove-bottom ] map ] dip
     [ [ merge-values ] 2each ]
     [ [ (merge-allocations) ] dip record-allocations ]
     2bi ;
diff --git a/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor b/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor
index a0c27ac069..532c5a9ac3 100644
--- a/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor
+++ b/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor
@@ -5,7 +5,8 @@ compiler.tree.normalization math.functions
 compiler.tree.propagation compiler.tree.cleanup
 compiler.tree.combinators compiler.tree sequences math math.private
 kernel tools.test accessors slots.private quotations.private
-prettyprint classes.tuple.private classes classes.tuple ;
+prettyprint classes.tuple.private classes classes.tuple
+compiler.tree.intrinsics ;
 
 \ escape-analysis must-infer
 
@@ -15,7 +16,7 @@ GENERIC: count-unboxed-allocations* ( m node -- n )
     out-d>> first escaping-allocation? [ 1+ ] unless ;
 
 M: #call count-unboxed-allocations*
-    dup word>> { <tuple-boa> <complex> } memq?
+    dup word>> { <immutable-tuple-boa> <complex> } memq?
     [ (count-unboxed-allocations) ] [ drop ] if ;
 
 M: #push count-unboxed-allocations*
diff --git a/unfinished/compiler/tree/escape-analysis/recursive/recursive.factor b/unfinished/compiler/tree/escape-analysis/recursive/recursive.factor
index 604bed6b6d..1ea89787df 100644
--- a/unfinished/compiler/tree/escape-analysis/recursive/recursive.factor
+++ b/unfinished/compiler/tree/escape-analysis/recursive/recursive.factor
@@ -18,9 +18,7 @@ IN: compiler.tree.escape-analysis.recursive
     } cond ;
 
 : check-fixed-point ( node alloc1 alloc2 -- )
-    [ congruent? ] 2all? [ drop ] [
-        label>> f >>fixed-point drop
-    ] if ;
+    [ congruent? ] 2all? [ drop ] [ label>> f >>fixed-point drop ] if ;
 
 : node-input-allocations ( node -- allocations )
     in-d>> [ allocation ] map ;
@@ -44,13 +42,14 @@ IN: compiler.tree.escape-analysis.recursive
     ] 2bi ;
 
 M: #recursive escape-analysis* ( #recursive -- )
-    [
+    { 0 } clone [ USE: math
+        dup first 10 = [ "OOPS" throw ] [ dup first 1+ swap set-first ] if
         child>>
         [ first out-d>> introduce-values ]
         [ first analyze-recursive-phi ]
         [ (escape-analysis) ]
         tri
-    ] until-fixed-point ;
+    ] curry until-fixed-point ;
 
 M: #enter-recursive escape-analysis* ( #enter-recursive -- )
     #! Handled by #recursive
diff --git a/unfinished/compiler/tree/escape-analysis/simple/simple.factor b/unfinished/compiler/tree/escape-analysis/simple/simple.factor
index d7699cfc73..c6c407b048 100644
--- a/unfinished/compiler/tree/escape-analysis/simple/simple.factor
+++ b/unfinished/compiler/tree/escape-analysis/simple/simple.factor
@@ -33,8 +33,10 @@ DEFER: record-literal-allocation
     } cond ;
 
 : record-literal-allocation ( value object -- )
-    object-slots dup
-    [ make-literal-slots swap record-allocation ] [ 2drop ] if ;
+    object-slots
+    [ make-literal-slots swap record-allocation ]
+    [ unknown-allocation ]
+    if* ;
 
 M: #push escape-analysis*
     #! Delegation.
diff --git a/unfinished/compiler/tree/normalization/normalization-tests.factor b/unfinished/compiler/tree/normalization/normalization-tests.factor
index 91c11f3be6..6986439dcc 100644
--- a/unfinished/compiler/tree/normalization/normalization-tests.factor
+++ b/unfinished/compiler/tree/normalization/normalization-tests.factor
@@ -1,6 +1,6 @@
 IN: compiler.tree.normalization.tests
 USING: compiler.tree.builder compiler.tree.normalization
-compiler.tree sequences accessors tools.test kernel ;
+compiler.tree sequences accessors tools.test kernel math ;
 
 \ count-introductions must-infer
 \ fixup-enter-recursive must-infer
@@ -25,3 +25,5 @@ compiler.tree sequences accessors tools.test kernel ;
     [ recursive-inputs ]
     [ normalize recursive-inputs ] bi
 ] unit-test
+
+[ ] [ [ [ 1 ] [ 2 ] if + * ] build-tree normalize drop ] unit-test
diff --git a/unfinished/compiler/tree/normalization/normalization.factor b/unfinished/compiler/tree/normalization/normalization.factor
index 4eb28be917..285964e393 100644
--- a/unfinished/compiler/tree/normalization/normalization.factor
+++ b/unfinished/compiler/tree/normalization/normalization.factor
@@ -1,7 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry namespaces sequences math accessors kernel arrays
-stack-checker.backend stack-checker.inlining compiler.tree
+stack-checker.backend
+stack-checker.branches
+stack-checker.inlining
+compiler.tree
 compiler.tree.combinators ;
 IN: compiler.tree.normalization
 
@@ -97,7 +100,12 @@ M: #branch eliminate-introductions*
     bi ;
 
 : eliminate-phi-introductions ( introductions seq terminated -- seq' )
-    [ flip ] dip [ [ nip ] [ over length tail append ] if ] 3map flip ;
+    [ flip ] dip [
+        [ nip ] [
+            dup [ +bottom+ eq? ] left-trim
+            [ [ length ] bi@ - tail* ] keep append
+        ] if
+    ] 3map flip ;
 
 M: #phi eliminate-introductions*
     remaining-introductions get swap dup terminated>>
diff --git a/unfinished/compiler/tree/propagation/branches/branches.factor b/unfinished/compiler/tree/propagation/branches/branches.factor
index 00a7833655..25b4775b8e 100644
--- a/unfinished/compiler/tree/propagation/branches/branches.factor
+++ b/unfinished/compiler/tree/propagation/branches/branches.factor
@@ -2,6 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry kernel sequences assocs accessors namespaces
 math.intervals arrays classes.algebra combinators
+stack-checker.branches
 compiler.tree
 compiler.tree.def-use
 compiler.tree.combinators
@@ -59,7 +60,14 @@ SYMBOL: infer-children-data
 
 : compute-phi-input-infos ( phi-in -- phi-info )
     infer-children-data get
-    '[ , [ [ [ value-info ] [ null-info ] if* ] bind ] 2map ] map ;
+    '[
+        , [
+            [
+                dup +bottom+ eq?
+                [ drop null-info ] [ value-info ] if
+            ] bind
+        ] 2map
+    ] map ;
 
 : annotate-phi-inputs ( #phi -- )
     dup phi-in-d>> compute-phi-input-infos >>phi-info-d
@@ -139,10 +147,10 @@ M: #phi propagate-before ( #phi -- )
 M: #phi propagate-after ( #phi -- )
     condition-value get [
         [ out-d>> ] [ phi-in-d>> ] [ phi-info-d>> ] tri
-        3array flip [
-            first3 [ possible-boolean-values ] map
+        [
+            [ possible-boolean-values ] map
             branch-phi-constraints
-        ] each
+        ] 3each
     ] [ drop ] if ;
 
 M: #phi propagate-around ( #phi -- )
diff --git a/unfinished/compiler/tree/propagation/copy/copy.factor b/unfinished/compiler/tree/propagation/copy/copy.factor
index ee2d6e7415..1f4e5c0a86 100644
--- a/unfinished/compiler/tree/propagation/copy/copy.factor
+++ b/unfinished/compiler/tree/propagation/copy/copy.factor
@@ -2,6 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces sequences assocs math kernel accessors fry
 combinators sets locals
+stack-checker.branches
 compiler.tree
 compiler.tree.def-use
 compiler.tree.combinators ;
@@ -42,7 +43,7 @@ M: #renaming compute-copy-equiv* inputs/outputs are-copies-of ;
     #! An output is a copy of every input if all inputs are
     #! copies of the same original value.
     [
-        swap sift [ resolve-copy ] map
+        swap remove-bottom [ resolve-copy ] map
         dup [ all-equal? ] [ empty? not ] bi and
         [ first swap is-copy-of ] [ 2drop ] if
     ] 2each ;
diff --git a/unfinished/compiler/tree/propagation/recursive/recursive.factor b/unfinished/compiler/tree/propagation/recursive/recursive.factor
index 0e3af85b20..6b266c4ea8 100644
--- a/unfinished/compiler/tree/propagation/recursive/recursive.factor
+++ b/unfinished/compiler/tree/propagation/recursive/recursive.factor
@@ -39,7 +39,7 @@ IN: compiler.tree.propagation.recursive
 : unify-recursive-stacks ( stacks initial -- infos )
     over empty? [ nip ] [
         [
-            [ sift value-infos-union ] dip
+            [ value-infos-union ] dip
             [ generalize-counter ] keep
             value-info-union
         ] 2map
diff --git a/unfinished/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor b/unfinished/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
index 5b06b37638..0dd8f3e3de 100644
--- a/unfinished/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
+++ b/unfinished/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
@@ -1,24 +1,22 @@
 IN: compiler.tree.tuple-unboxing.tests
-USING: tools.test compiler.tree.tuple-unboxing
-compiler.tree compiler.tree.builder compiler.tree.normalization
+USING: tools.test compiler.tree.tuple-unboxing compiler.tree
+compiler.tree.builder compiler.tree.normalization
 compiler.tree.propagation compiler.tree.cleanup
 compiler.tree.escape-analysis compiler.tree.tuple-unboxing
-compiler.tree.def-use kernel accessors sequences math
-sorting math.order binary-search ;
+compiler.tree.checker compiler.tree.def-use kernel accessors
+sequences math math.private sorting math.order binary-search
+sequences.private slots.private ;
 
 \ unbox-tuples must-infer
 
 : test-unboxing ( quot -- )
-    #! Just make sure it doesn't throw errors; compute def use
-    #! for kicks.
     build-tree
     normalize
     propagate
     cleanup
     escape-analysis
     unbox-tuples
-    compute-def-use
-    drop ;
+    check-nodes ;
 
 TUPLE: cons { car read-only } { cdr read-only } ;
 
@@ -30,6 +28,12 @@ TUPLE: empty-tuple ;
     [ cons boa [ car>> ] [ cdr>> ] bi ]
     [ [ 1 cons boa ] [ 2 cons boa ] if car>> ]
     [ dup cons boa 10 [ nip dup cons boa ] each-integer car>> ]
+    [ 2 cons boa { [ ] [ ] } dispatch ]
+    [ dup [ drop f ] [ "A" throw ] if ]
+    [ [ ] [ ] curry curry dup 3 slot swap 4 slot dup 3 slot swap 4 slot drop ]
+    [ [ ] [ ] curry curry call ]
+    [ <complex> <complex> dup 1 slot drop 2 slot drop ]
+    [ 1 cons boa over [ "A" throw ] when car>> ]
     [ [ <=> ] sort ]
     [ [ <=> ] with search ]
 } [ [ ] swap [ test-unboxing ] curry unit-test ] each
diff --git a/unfinished/compiler/tree/tuple-unboxing/tuple-unboxing.factor b/unfinished/compiler/tree/tuple-unboxing/tuple-unboxing.factor
index 71ff79d95b..3b832917d8 100644
--- a/unfinished/compiler/tree/tuple-unboxing/tuple-unboxing.factor
+++ b/unfinished/compiler/tree/tuple-unboxing/tuple-unboxing.factor
@@ -3,6 +3,7 @@
 USING: namespaces assocs accessors kernel combinators
 classes.algebra sequences sequences.deep slots.private
 classes.tuple.private math math.private arrays
+stack-checker.branches
 compiler.tree
 compiler.tree.intrinsics
 compiler.tree.combinators
@@ -43,15 +44,13 @@ M: #push unbox-tuples* ( #push -- nodes )
 : flatten-values ( values -- values' )
     (flatten-values) flatten ;
 
-: flatten-value ( values -- values )
-    [ unboxed-allocation ] [ 1array ] bi or ;
-
 : prepare-slot-access ( #call -- tuple-values outputs slot-values )
-    [ in-d>> first flatten-value ]
+    [ in-d>> flatten-values ]
     [ out-d>> flatten-values ]
     [
         out-d>> first slot-accesses get at
-        [ slot#>> ] [ value>> ] bi allocation nth flatten-value
+        [ slot#>> ] [ value>> ] bi allocation nth
+        1array flatten-values
     ] tri ;
 
 : slot-access-shuffle ( tuple-values outputs slot-values -- #shuffle )
@@ -73,7 +72,8 @@ M: #call unbox-tuples*
     } case ;
 
 M: #declare unbox-tuples*
-    [ unzip [ flatten-values ] dip zip ] change-declaration ;
+    #! We don't look at declarations after propagation anyway.
+    f >>declaration ;
 
 M: #copy unbox-tuples*
     [ flatten-values ] change-in-d
@@ -96,9 +96,9 @@ M: #terminate unbox-tuples*
     [ flatten-values ] change-in-d ;
 
 M: #phi unbox-tuples*
-    [ flip [ flatten-values ] map flip ] change-phi-in-d
-    [ flip [ flatten-values ] map flip ] change-phi-in-r
-    [ flatten-values ] change-out-d
+    [ flip [ flatten-values ] map pad-with-bottom flip ] change-phi-in-d
+    [ flip [ flatten-values ] map pad-with-bottom flip ] change-phi-in-r
+    [ flatten-values ] change-out-d 
     [ flatten-values ] change-out-r ;
 
 M: #recursive unbox-tuples*
diff --git a/unfinished/stack-checker/branches/branches.factor b/unfinished/stack-checker/branches/branches.factor
index c4a89deb05..72a32574e1 100644
--- a/unfinished/stack-checker/branches/branches.factor
+++ b/unfinished/stack-checker/branches/branches.factor
@@ -9,21 +9,30 @@ IN: stack-checker.branches
 : balanced? ( pairs -- ? )
     [ second ] filter [ first2 length - ] map all-equal? ;
 
-: unify-inputs ( max-d-in d-in meta-d -- new-meta-d )
-    dup [ [ - f <repetition> ] dip append ] [ 3drop f ] if ;
+SYMBOL: +bottom+
 
-: pad-with-f ( seq -- newseq )
-    dup [ length ] map supremum '[ , f pad-left ] map ;
+: unify-inputs ( max-d-in d-in meta-d -- new-meta-d )
+    dup [ [ - +bottom+ <repetition> ] dip append ] [ 3drop f ] if ;
+
+: pad-with-bottom ( seq -- newseq )
+    dup empty? [
+        dup [ length ] map supremum
+        '[ , +bottom+ pad-left ] map
+    ] unless ;
 
 : phi-inputs ( max-d-in pairs -- newseq )
     dup empty? [ nip ] [
         swap '[ , _ first2 unify-inputs ] map
-        pad-with-f
+        pad-with-bottom
         flip
     ] if ;
 
+: remove-bottom ( seq -- seq' )
+    +bottom+ swap remove ;
+
 : unify-values ( values -- phi-out )
-    sift dup empty? [ drop <value> ] [
+    remove-bottom
+    dup empty? [ drop <value> ] [
         [ known ] map dup all-eq?
         [ first make-known ] [ drop <value> ] if
     ] if ;