Fix interval inference of abs, absq when input is a complex number

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index a9b77681fb8139162a91bf42feb14927a0eb43d9..3a20424e18f53cf9dd9a0e0aa39b081dc65a96e9 100644 (file)
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -32,16 +32,20 @@ IN: compiler.tree.propagation.known-words
 
 \ bitnot { integer } "input-classes" set-word-prop
 
-: ?change-interval ( info quot -- quot' )
-    over interval>> [ [ clone ] dip change-interval ] [ 2drop ] if ; inline
+: real-op ( info quot -- quot' )
+    [
+        dup class>> real classes-intersect?
+        [ clone ] [ drop real <class-info> ] if
+    ] dip
+    change-interval ; inline
 
 { bitnot fixnum-bitnot bignum-bitnot } [
-    [ [ interval-bitnot ] ?change-interval ] "outputs" set-word-prop
+    [ [ interval-bitnot ] real-op ] "outputs" set-word-prop
 ] each
 
-\ abs [ [ interval-abs ] ?change-interval ] "outputs" set-word-prop
+\ abs [ [ interval-abs ] real-op ] "outputs" set-word-prop
 
-\ absq [ [ interval-absq ] ?change-interval ] "outputs" set-word-prop
+\ absq [ [ interval-absq ] real-op ] "outputs" set-word-prop
 
 : math-closure ( class -- newclass )
     { fixnum bignum integer rational float real number object }

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 321941741eff964c3b085b9d2c026b94d8fcbfc9..f20afc77f3c538695810faad9683bd7c69504033 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -165,6 +165,10 @@ IN: compiler.tree.propagation.tests
 
 [ t ] [ [ { float } declare absq ] final-info first interval>> [0,inf] = ] unit-test
 
+[ t ] [ [ { complex } declare abs ] final-info first interval>> [0,inf] = ] unit-test
+
+[ t ] [ [ { complex } 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