From 75137bafb143d33366a225589b52c3a45b8aba30 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 19 Aug 2009 02:33:41 -0500
Subject: [PATCH] compiler.tree.propagation: improved interval inference for
 absq eliminates a conditional from math.vectors:distance. Type inference for
 rational math also a bit sharper now

---
 .../propagation/known-words/known-words.factor   |  4 +++-
 .../tree/propagation/propagation-tests.factor    | 16 ++++++++++++++--
 .../tree/propagation/simple/simple.factor        |  4 +++-
 3 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index 7c684f5b7f..a9b77681fb 100644
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel effects accessors math math.private
 math.integers.private math.partial-dispatch math.intervals
-math.parser math.order layouts words sequences sequences.private
+math.parser math.order math.functions layouts words sequences sequences.private
 arrays assocs classes classes.algebra combinators generic.math
 splitting fry locals classes.tuple alien.accessors
 classes.tuple.private slots.private definitions strings.private
@@ -41,6 +41,8 @@ IN: compiler.tree.propagation.known-words
 
 \ abs [ [ interval-abs ] ?change-interval ] "outputs" set-word-prop
 
+\ absq [ [ interval-absq ] ?change-interval ] "outputs" set-word-prop
+
 : math-closure ( class -- newclass )
     { fixnum bignum integer rational float real number object }
     [ class<= ] with find nip ;
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 1c9b27dfbc..321941741e 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -56,9 +56,9 @@ IN: compiler.tree.propagation.tests
 
 [ float ] [ [ { float real } declare + ] final-math-class ] unit-test
 
-! [ rational ] [ [ { ratio ratio } declare + ] final-math-class ] unit-test
+[ rational ] [ [ { ratio ratio } declare + ] final-math-class ] unit-test
 
-! [ rational ] [ [ { rational ratio } declare + ] final-math-class ] unit-test
+[ rational ] [ [ { rational ratio } declare + ] final-math-class ] unit-test
 
 [ number ] [ [ { complex complex } declare + ] final-math-class ] unit-test
 
@@ -157,6 +157,18 @@ IN: compiler.tree.propagation.tests
 
 [ V{ t } ] [ [ abs 40 mod 0 >= ] final-literals ] unit-test
 
+[ t ] [ [ abs ] final-info first interval>> [0,inf] = ] unit-test
+
+[ t ] [ [ absq ] final-info first interval>> [0,inf] = ] unit-test
+
+[ t ] [ [ { float } declare abs ] final-info first interval>> [0,inf] = ] unit-test
+
+[ t ] [ [ { float } declare absq ] final-info first interval>> [0,inf] = ] unit-test
+
+[ t ] [ [ [ - absq ] [ + ] 2map-reduce ] final-info first interval>> [0,inf] = ] unit-test
+
+[ t ] [ [ { double-array double-array } declare [ - absq ] [ + ] 2map-reduce ] final-info first interval>> [0,inf] = ] unit-test
+
 [ V{ string } ] [
     [ dup string? not [ "Oops" throw ] [ ] if ] final-classes
 ] unit-test
diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor
index 5837d59ef9..88c9831a24 100644
--- a/basis/compiler/tree/propagation/simple/simple.factor
+++ b/basis/compiler/tree/propagation/simple/simple.factor
@@ -119,7 +119,9 @@ M: #declare propagate-before
 M: #call propagate-before
     dup word>> {
         { [ 2dup foldable-call? ] [ fold-call ] }
-        { [ 2dup do-inlining ] [ 2drop ] }
+        { [ 2dup do-inlining ] [
+            [ output-value-infos ] [ drop out-d>> ] 2bi refine-value-infos 
+        ] }
         [
             [ [ output-value-infos ] [ drop out-d>> ] 2bi set-value-infos ]
             [ compute-constraints ]