From 7afea4c0eafe65ff914d5337486e462cc356ff9e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 12 Nov 2009 17:24:11 -0600
Subject: [PATCH] compiler.tree.propagation: implementing missing case in
 branch constraints

---
 .../tree/propagation/branches/branches.factor    | 16 ++++++++++++++++
 .../tree/propagation/propagation-tests.factor    |  9 +++++++++
 2 files changed, 25 insertions(+)

diff --git a/basis/compiler/tree/propagation/branches/branches.factor b/basis/compiler/tree/propagation/branches/branches.factor
index 0d837d82ae..662059ec1b 100755
--- a/basis/compiler/tree/propagation/branches/branches.factor
+++ b/basis/compiler/tree/propagation/branches/branches.factor
@@ -130,6 +130,22 @@ M: #phi propagate-before ( #phi -- )
                 swap t-->
             ]
         }
+        {
+            { { t f } { t } }
+            [
+                first =t
+                condition-value get =t /\
+                swap f-->
+            ]
+        }
+        {
+            { { t } { t f } }
+            [
+                second =t
+                condition-value get =f /\
+                swap f-->
+            ]
+        }
         {
             { { t f } { } }
             [
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 3627757acd..e3f509914b 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -224,6 +224,14 @@ IN: compiler.tree.propagation.tests
 
 [ t ] [ [ over [ drop f ] when [ "A" throw ] unless ] final-classes first false-class? ] unit-test
 
+[ V{ fixnum } ] [
+    [
+        [ { fixnum } declare ] [ drop f ] if
+        dup [ dup 13 eq? [ t ] [ f ] if ] [ t ] if
+        [ "Oops" throw ] when
+    ] final-classes
+] unit-test
+
 [ V{ fixnum } ] [
     [
         >fixnum
@@ -925,3 +933,4 @@ M: tuple-with-read-only-slot clone
 
 ! Could be bignum not integer but who cares
 [ V{ integer } ] [ [ 10 >bignum bitand ] final-classes ] unit-test
+