From 1df869af6a9bc28f620f8dcd8f72ac6ae6aad9a8 Mon Sep 17 00:00:00 2001
From: Guillaume Nargeot <killy971@gmail.com>
Date: Tue, 15 Sep 2009 19:33:56 +0900
Subject: [PATCH 1/9] Solution to Project Euler problem 124

---
 extra/project-euler/124/124-tests.factor |  4 ++
 extra/project-euler/124/124.factor       | 63 ++++++++++++++++++++++++
 extra/project-euler/project-euler.factor |  8 +--
 3 files changed, 71 insertions(+), 4 deletions(-)
 create mode 100644 extra/project-euler/124/124-tests.factor
 create mode 100644 extra/project-euler/124/124.factor

diff --git a/extra/project-euler/124/124-tests.factor b/extra/project-euler/124/124-tests.factor
new file mode 100644
index 0000000000..cdbb5afc18
--- /dev/null
+++ b/extra/project-euler/124/124-tests.factor
@@ -0,0 +1,4 @@
+USING: project-euler.124 tools.test ;
+IN: project-euler.124.tests
+
+[ 21417 ] [ euler124 ] unit-test
diff --git a/extra/project-euler/124/124.factor b/extra/project-euler/124/124.factor
new file mode 100644
index 0000000000..0f4d1ee28f
--- /dev/null
+++ b/extra/project-euler/124/124.factor
@@ -0,0 +1,63 @@
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel math.primes.factors
+math.ranges project-euler.common sequences sorting ;
+IN: project-euler.124
+
+! http://projecteuler.net/index.php?section=problems&id=124
+
+! DESCRIPTION
+! -----------
+
+! The radical of n, rad(n), is the product of distinct prime factors of n.
+! For example, 504 = 2^3 × 3^2 × 7, so rad(504) = 2 × 3 × 7 = 42.
+
+! If we calculate rad(n) for 1 ≤ n ≤ 10, then sort them on rad(n),
+! and sorting on n if the radical values are equal, we get:
+
+!   Unsorted          Sorted
+!   n  rad(n)       n  rad(n) k
+!   1    1          1    1    1
+!   2    2          2    2    2
+!   3    3          4    2    3
+!   4    2          8    2    4
+!   5    5          3    3    5
+!   6    6          9    3    6
+!   7    7          5    5    7
+!   8    2          6    6    8
+!   9    3          7    7    9
+!  10   10         10   10   10
+
+! Let E(k) be the kth element in the sorted n column; for example,
+! E(4) = 8 and E(6) = 9.
+
+! If rad(n) is sorted for 1 ≤ n ≤ 100000, find E(10000).
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: rad ( n -- n )
+    unique-factors product ; inline
+
+: rads-upto ( n -- seq )
+    [0,b] [ dup rad 2array ] map ;
+
+: (euler124) ( -- seq )
+    100000 rads-upto sort-values ;
+
+PRIVATE>
+
+: euler124 ( -- answer )
+    10000 (euler124) nth first ;
+
+! [ euler124 ] 100 ave-time
+! 373 ms ave run time - 17.61 SD (100 trials)
+
+! TODO: instead of the brute-force method, making the rad
+! array in the way of the sieve of eratosthene would scale
+! better on bigger values.
+
+SOLUTION: euler124
diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor
index f0e40674da..eedf2272ba 100644
--- a/extra/project-euler/project-euler.factor
+++ b/extra/project-euler/project-euler.factor
@@ -20,10 +20,10 @@ USING: definitions io io.files io.pathnames kernel math math.parser
     project-euler.071 project-euler.073 project-euler.075 project-euler.076
     project-euler.079 project-euler.085 project-euler.092 project-euler.097
     project-euler.099 project-euler.100 project-euler.102 project-euler.112
-    project-euler.116 project-euler.117 project-euler.134 project-euler.148
-    project-euler.150 project-euler.151 project-euler.164 project-euler.169
-    project-euler.173 project-euler.175 project-euler.186 project-euler.190
-    project-euler.203 project-euler.215 ;
+    project-euler.116 project-euler.117 project-euler.124 project-euler.134
+    project-euler.148 project-euler.150 project-euler.151 project-euler.164
+    project-euler.169 project-euler.173 project-euler.175 project-euler.186
+    project-euler.190 project-euler.203 project-euler.215 ;
 IN: project-euler
 
 <PRIVATE

From 0081d316a98da99d4448c4af7da216f52e1f28db Mon Sep 17 00:00:00 2001
From: Guillaume Nargeot <killy971@gmail.com>
Date: Tue, 15 Sep 2009 21:01:25 +0900
Subject: [PATCH 2/9] Fixed comments of project-euler.085

---
 extra/project-euler/085/085.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/project-euler/085/085.factor b/extra/project-euler/085/085.factor
index 6c70f65bf7..9c12367cdf 100644
--- a/extra/project-euler/085/085.factor
+++ b/extra/project-euler/085/085.factor
@@ -19,7 +19,7 @@ IN: project-euler.085
 ! SOLUTION
 ! --------
 
-! A grid measuring x by y contains x * (x + 1) * y * (x + 1) rectangles.
+! A grid measuring x by y contains x * (x + 1) * y * (x + 1) / 4 rectangles.
 
 <PRIVATE
 
@@ -56,6 +56,6 @@ PRIVATE>
     area-of-nearest ;
 
 ! [ euler085 ] 100 ave-time
-! 2285 ms ave run time - 4.8 SD (100 trials)
+! 791 ms ave run time - 17.15 SD (100 trials)
 
 SOLUTION: euler085

From 941fc66a43310d5892133b8c054b3e2dbbb6c446 Mon Sep 17 00:00:00 2001
From: Guillaume Nargeot <killy971@gmail.com>
Date: Tue, 22 Sep 2009 11:16:04 +0900
Subject: [PATCH 3/9] Solution to Project Euler problem 72

---
 extra/project-euler/072/072-tests.factor |  4 +++
 extra/project-euler/072/072.factor       | 38 ++++++++++++++++++++++++
 extra/project-euler/project-euler.factor | 14 ++++-----
 3 files changed, 49 insertions(+), 7 deletions(-)
 create mode 100644 extra/project-euler/072/072-tests.factor
 create mode 100644 extra/project-euler/072/072.factor

diff --git a/extra/project-euler/072/072-tests.factor b/extra/project-euler/072/072-tests.factor
new file mode 100644
index 0000000000..80a8949d0d
--- /dev/null
+++ b/extra/project-euler/072/072-tests.factor
@@ -0,0 +1,4 @@
+USING: project-euler.072 tools.test ;
+IN: project-euler.072.tests
+
+[ 303963552391 ] [ euler072 ] unit-test
diff --git a/extra/project-euler/072/072.factor b/extra/project-euler/072/072.factor
new file mode 100644
index 0000000000..de6312f2a7
--- /dev/null
+++ b/extra/project-euler/072/072.factor
@@ -0,0 +1,38 @@
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.primes.factors math.ranges
+project-euler.common sequences ;
+IN: project-euler.072
+
+! http://projecteuler.net/index.php?section=problems&id=072
+
+! DESCRIPTION
+! -----------
+
+! Consider the fraction, n/d, where n and d are positive integers.
+! If n<d and HCF(n,d)=1, it is called a reduced proper fraction.
+
+! If we list the set of reduced proper fractions for d ≤ 8 in ascending order
+! of size, we get:
+
+! 1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7, 1/2, 4/7, 3/5, 5/8, 2/3,
+! 5/7, 3/4, 4/5, 5/6, 6/7, 7/8
+
+! It can be seen that there are 21 elements in this set.
+
+! How many elements would be contained in the set of reduced proper fractions
+! for d ≤ 1,000,000?
+
+
+! SOLUTION
+! --------
+
+! The answer can be found by adding totient(n) for 2 ≤ n ≤ 1e6
+
+: euler072 ( -- answer )
+    2 1000000 [a,b] [ totient ] [ + ] map-reduce ;
+
+! [ euler072 ] 100 ave-time
+! 5274 ms ave run time - 102.7 SD (100 trials)
+
+SOLUTION: euler072
diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor
index eedf2272ba..bc61d884f5 100644
--- a/extra/project-euler/project-euler.factor
+++ b/extra/project-euler/project-euler.factor
@@ -17,13 +17,13 @@ USING: definitions io io.files io.pathnames kernel math math.parser
     project-euler.049 project-euler.052 project-euler.053 project-euler.054
     project-euler.055 project-euler.056 project-euler.057 project-euler.058
     project-euler.059 project-euler.063 project-euler.067 project-euler.069
-    project-euler.071 project-euler.073 project-euler.075 project-euler.076
-    project-euler.079 project-euler.085 project-euler.092 project-euler.097
-    project-euler.099 project-euler.100 project-euler.102 project-euler.112
-    project-euler.116 project-euler.117 project-euler.124 project-euler.134
-    project-euler.148 project-euler.150 project-euler.151 project-euler.164
-    project-euler.169 project-euler.173 project-euler.175 project-euler.186
-    project-euler.190 project-euler.203 project-euler.215 ;
+    project-euler.071 project-euler.072 project-euler.073 project-euler.075
+    project-euler.076 project-euler.079 project-euler.085 project-euler.092
+    project-euler.097 project-euler.099 project-euler.100 project-euler.102
+    project-euler.112 project-euler.116 project-euler.117 project-euler.124
+    project-euler.134 project-euler.148 project-euler.150 project-euler.151
+    project-euler.164 project-euler.169 project-euler.173 project-euler.175
+    project-euler.186 project-euler.190 project-euler.203 project-euler.215 ;
 IN: project-euler
 
 <PRIVATE

From f6e2e768604e0793114eb49aa6f0ec97b5f89bda Mon Sep 17 00:00:00 2001
From: Guillaume Nargeot <killy971@gmail.com>
Date: Tue, 22 Sep 2009 17:02:22 +0900
Subject: [PATCH 4/9] Solution to Project Euler problem 74

---
 extra/project-euler/074/074-tests.factor |  4 ++
 extra/project-euler/074/074.factor       | 67 ++++++++++++++++++++++++
 extra/project-euler/project-euler.factor | 15 +++---
 3 files changed, 79 insertions(+), 7 deletions(-)
 create mode 100644 extra/project-euler/074/074-tests.factor
 create mode 100644 extra/project-euler/074/074.factor

diff --git a/extra/project-euler/074/074-tests.factor b/extra/project-euler/074/074-tests.factor
new file mode 100644
index 0000000000..9287480a84
--- /dev/null
+++ b/extra/project-euler/074/074-tests.factor
@@ -0,0 +1,4 @@
+USING: project-euler.074 tools.test ;
+IN: project-euler.074.tests
+
+[ 402 ] [ euler074 ] unit-test
diff --git a/extra/project-euler/074/074.factor b/extra/project-euler/074/074.factor
new file mode 100644
index 0000000000..e38d0d51bb
--- /dev/null
+++ b/extra/project-euler/074/074.factor
@@ -0,0 +1,67 @@
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs hashtables kernel math math.ranges
+project-euler.common sequences ;
+IN: project-euler.074
+
+! http://projecteuler.net/index.php?section=problems&id=074
+
+! DESCRIPTION
+! -----------
+
+! The number 145 is well known for the property that the sum of the factorial
+! of its digits is equal to 145:
+
+! 1! + 4! + 5! = 1 + 24 + 120 = 145
+
+! Perhaps less well known is 169, in that it produces the longest chain of
+! numbers that link back to 169; it turns out that there are only three such
+! loops that exist:
+
+! 169 → 363601 → 1454 → 169
+! 871 → 45361 → 871
+! 872 → 45362 → 872
+
+! It is not difficult to prove that EVERY starting number will eventually get
+! stuck in a loop. For example,
+
+! 69 → 363600 → 1454 → 169 → 363601 (→ 1454)
+! 78 → 45360 → 871 → 45361 (→ 871)
+! 540 → 145 (→ 145)
+
+! Starting with 69 produces a chain of five non-repeating terms, but the
+! longest non-repeating chain with a starting number below one million is sixty
+! terms.
+
+! How many chains, with a starting number below one million, contain exactly
+! sixty non-repeating terms?
+
+
+! SOLUTION
+! --------
+
+! Brute force
+
+<PRIVATE
+
+: digit-factorial ( n -- n! )
+    { 1 1 2 6 24 120 720 5040 40320 362880 } nth ;
+
+: digits-factorial-sum ( n -- n )
+    number>digits [ digit-factorial ] sigma ;
+
+: chain-length ( n -- n )
+    61 <hashtable> [ 2dup at* nip f = ] [
+        2dup dupd set-at [ digits-factorial-sum ] dip
+    ] while nip assoc-size ;
+
+PRIVATE>
+
+: euler074 ( -- answer )
+    1000000 [1,b] [ chain-length 60 = ] count ;
+
+! [ euler074 ] 10 ave-time
+! 25134 ms ave run time - 31.96 SD (10 trials)
+
+SOLUTION: euler074
+
diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor
index bc61d884f5..1bba3182d1 100644
--- a/extra/project-euler/project-euler.factor
+++ b/extra/project-euler/project-euler.factor
@@ -17,13 +17,14 @@ USING: definitions io io.files io.pathnames kernel math math.parser
     project-euler.049 project-euler.052 project-euler.053 project-euler.054
     project-euler.055 project-euler.056 project-euler.057 project-euler.058
     project-euler.059 project-euler.063 project-euler.067 project-euler.069
-    project-euler.071 project-euler.072 project-euler.073 project-euler.075
-    project-euler.076 project-euler.079 project-euler.085 project-euler.092
-    project-euler.097 project-euler.099 project-euler.100 project-euler.102
-    project-euler.112 project-euler.116 project-euler.117 project-euler.124
-    project-euler.134 project-euler.148 project-euler.150 project-euler.151
-    project-euler.164 project-euler.169 project-euler.173 project-euler.175
-    project-euler.186 project-euler.190 project-euler.203 project-euler.215 ;
+    project-euler.071 project-euler.072 project-euler.073 project-euler.074
+    project-euler.075 project-euler.076 project-euler.079 project-euler.085
+    project-euler.092 project-euler.097 project-euler.099 project-euler.100
+    project-euler.102 project-euler.112 project-euler.116 project-euler.117
+    project-euler.124 project-euler.134 project-euler.148 project-euler.150
+    project-euler.151 project-euler.164 project-euler.169 project-euler.173
+    project-euler.175 project-euler.186 project-euler.190 project-euler.203
+    project-euler.215 ;
 IN: project-euler
 
 <PRIVATE

From 0e3a261637c9dfe03e854aa143695a0273ce2374 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 22 Sep 2009 05:07:52 -0500
Subject: [PATCH 5/9] Fix test failures in compiler.cfg.linearization.order,
 compiler.tests.low-level-ir and compiler.graphviz

---
 basis/compiler/cfg/linearization/order/order-tests.factor | 2 +-
 basis/compiler/tests/low-level-ir.factor                  | 4 ++--
 extra/compiler/graphviz/graphviz-tests.factor             | 2 +-
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/basis/compiler/cfg/linearization/order/order-tests.factor b/basis/compiler/cfg/linearization/order/order-tests.factor
index 34eaeffd9a..67fb55f507 100644
--- a/basis/compiler/cfg/linearization/order/order-tests.factor
+++ b/basis/compiler/cfg/linearization/order/order-tests.factor
@@ -1,5 +1,5 @@
 USING: compiler.cfg.debugger compiler.cfg compiler.cfg.linearization.order
-kernel accessors sequences sets tools.test ;
+kernel accessors sequences sets tools.test namespaces ;
 IN: compiler.cfg.linearization.order.tests
 
 V{ } 0 test-bb
diff --git a/basis/compiler/tests/low-level-ir.factor b/basis/compiler/tests/low-level-ir.factor
index e2fc26e94b..76d7e6de42 100644
--- a/basis/compiler/tests/low-level-ir.factor
+++ b/basis/compiler/tests/low-level-ir.factor
@@ -18,7 +18,7 @@ IN: compiler.tests.low-level-ir
     compile-cfg ;
 
 : compile-test-bb ( insns -- result )
-    V{ T{ ##prologue } T{ ##branch } } 0 test-bb
+    V{ T{ ##prologue } T{ ##branch } } [ clone ] map 0 test-bb
     V{
         T{ ##inc-d f 1 }
         T{ ##replace f 0 D 0 }
@@ -73,7 +73,7 @@ IN: compiler.tests.low-level-ir
 [ t ] [
     V{
         T{ ##load-reference f 0 { t f t } }
-        T{ ##slot-imm f 0 0 2 $[ array tag-number ] 2 }
+        T{ ##slot-imm f 0 0 2 $[ array tag-number ] }
     } compile-test-bb
 ] unit-test
 
diff --git a/extra/compiler/graphviz/graphviz-tests.factor b/extra/compiler/graphviz/graphviz-tests.factor
index 23f5f6fb60..8f6c0171e7 100644
--- a/extra/compiler/graphviz/graphviz-tests.factor
+++ b/extra/compiler/graphviz/graphviz-tests.factor
@@ -1,5 +1,5 @@
 IN: compiler.graphviz.tests
-USING: compiler.graphviz io.files ;
+USING: compiler.graphviz io.files kernel tools.test ;
 
 [ t ] [ [ [ 1 ] [ 2 ] if ] render-cfg exists? ] unit-test
 [ t ] [ [ [ 1 ] [ 2 ] if ] render-dom exists? ] unit-test

From 81462d14797350924f9af4c76b29f62880f4b131 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 22 Sep 2009 05:19:26 -0500
Subject: [PATCH 6/9] project-euler.074: cleanup

---
 extra/project-euler/074/074.factor | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/extra/project-euler/074/074.factor b/extra/project-euler/074/074.factor
index e38d0d51bb..7f0a54a43c 100644
--- a/extra/project-euler/074/074.factor
+++ b/extra/project-euler/074/074.factor
@@ -1,7 +1,7 @@
 ! Copyright (c) 2009 Guillaume Nargeot.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs hashtables kernel math math.ranges
-project-euler.common sequences ;
+project-euler.common sequences sets ;
 IN: project-euler.074
 
 ! http://projecteuler.net/index.php?section=problems&id=074
@@ -51,9 +51,10 @@ IN: project-euler.074
     number>digits [ digit-factorial ] sigma ;
 
 : chain-length ( n -- n )
-    61 <hashtable> [ 2dup at* nip f = ] [
-        2dup dupd set-at [ digits-factorial-sum ] dip
-    ] while nip assoc-size ;
+    61 <hashtable>
+    [ 2dup key? not ]
+    [ [ conjoin ] [ [ digits-factorial-sum ] dip ] 2bi ]
+    while nip assoc-size ;
 
 PRIVATE>
 

From b0f87fd6a0eea7782137a76b77ad3b515de7eaab Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 22 Sep 2009 05:24:34 -0500
Subject: [PATCH 7/9] cpu.ppc: fix load errors

---
 basis/cpu/ppc/ppc.factor | 1 +
 1 file changed, 1 insertion(+)

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 2a16a8b6df..eb9709a350 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -9,6 +9,7 @@ compiler.codegen.fixup compiler.cfg.intrinsics
 compiler.cfg.stack-frame compiler.cfg.build-stack-frame
 compiler.units compiler.constants compiler.codegen vm ;
 FROM: cpu.ppc.assembler => B ;
+FROM: layouts => cell ;
 FROM: math => float ;
 IN: cpu.ppc
 

From 6e936bdb05e1f506a504d4fa525c5cd156f28fb5 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@pool-224-36.res.carleton.edu>
Date: Tue, 22 Sep 2009 16:01:14 -0500
Subject: [PATCH 8/9] Fixing failing unit tests in compiler.tree.propagation
 due to constraints

---
 .../tree/propagation/branches/branches.factor | 44 ++++++++++++-------
 .../constraints/constraints.factor            | 19 +++++---
 .../tree/propagation/info/info.factor         |  2 +-
 .../tree/propagation/propagation-tests.factor | 14 +++---
 4 files changed, 47 insertions(+), 32 deletions(-)

diff --git a/basis/compiler/tree/propagation/branches/branches.factor b/basis/compiler/tree/propagation/branches/branches.factor
index f2613022fc..5756f78bfd 100755
--- a/basis/compiler/tree/propagation/branches/branches.factor
+++ b/basis/compiler/tree/propagation/branches/branches.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry kernel sequences assocs accessors namespaces
 math.intervals arrays classes.algebra combinators columns
-stack-checker.branches
+stack-checker.branches locals
 compiler.utilities
 compiler.tree
 compiler.tree.combinators
@@ -82,6 +82,13 @@ M: #phi propagate-before ( #phi -- )
     [ [ phi-info-d>> flip ] [ out-d>> ] bi merge-value-infos ]
     bi ;
 
+:: update-constraints ( new old -- )
+    new [| key value | key old [ value append ] change-at ] assoc-each ;
+
+: include-child-constraints ( i -- )
+    infer-children-data get nth constraints swap at last
+    constraints get last update-constraints ;
+
 : branch-phi-constraints ( output values booleans -- )
      {
         {
@@ -116,22 +123,24 @@ M: #phi propagate-before ( #phi -- )
                 swap t-->
             ]
         }
-        ! {
-        !     { { t f } { } }
-        !     [ B
-        !         first
-        !         [ [ =t ] bi@ <--> ]
-        !         [ [ =f ] bi@ <--> ] 2bi /\
-        !     ]
-        ! }
-        ! {
-        !     { { } { t f } }
-        !     [
-        !         second
-        !         [ [ =t ] bi@ <--> ]
-        !         [ [ =f ] bi@ <--> ] 2bi /\
-        !     ]
-        ! }
+        {
+            { { t f } { } }
+            [
+                first
+                [ [ =t ] bi@ <--> ]
+                [ [ =f ] bi@ <--> ] 2bi /\
+                0 include-child-constraints
+            ]
+        }
+        {
+            { { } { t f } }
+            [
+                second
+                [ [ =t ] bi@ <--> ]
+                [ [ =f ] bi@ <--> ] 2bi /\
+                1 include-child-constraints
+            ]
+        }
         [ 3drop f ]
     } case assume ;
 
@@ -147,6 +156,7 @@ M: #phi propagate-after ( #phi -- )
     ] [ drop ] if ;
 
 M: #phi propagate-around ( #phi -- )
+    ! Is this necessary?
     [ propagate-before ] [ propagate-after ] bi ;
 
 M: #branch propagate-around
diff --git a/basis/compiler/tree/propagation/constraints/constraints.factor b/basis/compiler/tree/propagation/constraints/constraints.factor
index 31f6cea148..59c9912e47 100644
--- a/basis/compiler/tree/propagation/constraints/constraints.factor
+++ b/basis/compiler/tree/propagation/constraints/constraints.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs math math.intervals kernel accessors
 sequences namespaces classes classes.algebra
-combinators words
+combinators words combinators.short-circuit
 compiler.tree
 compiler.tree.propagation.info
 compiler.tree.propagation.copy ;
@@ -28,15 +28,19 @@ M: object satisfied? drop f ;
 ! Boolean constraints
 TUPLE: true-constraint value ;
 
-: =t ( value -- constriant ) resolve-copy true-constraint boa ;
+: =t ( value -- constraint ) resolve-copy true-constraint boa ;
+
+: follow-implications ( constraint -- )
+    constraints get assoc-stack [ assume ] when* ;
 
 M: true-constraint assume*
     [ \ f class-not <class-info> swap value>> refine-value-info ]
-    [ constraints get assoc-stack [ assume ] when* ]
+    [ follow-implications ]
     bi ;
 
 M: true-constraint satisfied?
-    value>> value-info class>> true-class? ;
+    value>> value-info class>>
+    { [ true-class? ] [ null-class? not ] } 1&& ;
 
 TUPLE: false-constraint value ;
 
@@ -44,11 +48,12 @@ TUPLE: false-constraint value ;
 
 M: false-constraint assume*
     [ \ f <class-info> swap value>> refine-value-info ]
-    [ constraints get assoc-stack [ assume ] when* ]
+    [ follow-implications ]
     bi ;
 
 M: false-constraint satisfied?
-    value>> value-info class>> false-class? ;
+    value>> value-info class>>
+    { [ false-class? ] [ null-class? not ] } 1&& ;
 
 ! Class constraints
 TUPLE: class-constraint value class ;
@@ -82,7 +87,7 @@ TUPLE: implication p q ;
 
 C: --> implication
 
-: assume-implication ( p q -- )
+: assume-implication ( q p -- )
     [ constraints get [ assoc-stack swap suffix ] 2keep last set-at ]
     [ satisfied? [ assume ] [ drop ] if ] 2bi ;
 
diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor
index 0a04b48160..53b2109bbb 100644
--- a/basis/compiler/tree/propagation/info/info.factor
+++ b/basis/compiler/tree/propagation/info/info.factor
@@ -302,7 +302,7 @@ SYMBOL: value-infos
 
 : refine-value-info ( info value -- )
     resolve-copy value-infos get
-    [ assoc-stack value-info-intersect ] 2keep
+    [ assoc-stack [ value-info-intersect ] when* ] 2keep
     last set-at ;
 
 : value-literal ( value -- obj ? )
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 1b24bc0c8f..e7cb1b270a 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -694,17 +694,17 @@ MIXIN: empty-mixin
     [ { word object } declare equal? ] final-classes
 ] unit-test
 
-! [ V{ string } ] [
-!     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
-! ] unit-test
+[ V{ string } ] [
+    [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
+] unit-test
 
-! [ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test
+[ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test
 
-! [ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test
+[ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test
 
-! [ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test
+[ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test
 
-! [ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test
+[ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test
 
 ! generalize-counter-interval wasn't being called in all the right places.
 ! bug found by littledan

From 7cfc63af51a1a06c01531189e538318742b7164e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 22 Sep 2009 17:56:50 -0500
Subject: [PATCH 9/9] compiler.tree.propagation.branches: M: #phi
 propagate-around was unnecessary

---
 basis/compiler/tree/propagation/branches/branches.factor | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/basis/compiler/tree/propagation/branches/branches.factor b/basis/compiler/tree/propagation/branches/branches.factor
index 5756f78bfd..b8861a6292 100755
--- a/basis/compiler/tree/propagation/branches/branches.factor
+++ b/basis/compiler/tree/propagation/branches/branches.factor
@@ -155,10 +155,6 @@ M: #phi propagate-after ( #phi -- )
         ] 3each
     ] [ drop ] if ;
 
-M: #phi propagate-around ( #phi -- )
-    ! Is this necessary?
-    [ propagate-before ] [ propagate-after ] bi ;
-
 M: #branch propagate-around
     dup live-branches >>live-branches
     [ infer-children ] [ annotate-node ] bi ;