From 2dc99ea05fb5e88876757fdbd53014314913685a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 19 Aug 2009 16:06:37 -0500 Subject: [PATCH] Fix interval inference of abs, absq when input is a complex number --- .../propagation/known-words/known-words.factor | 14 +++++++++----- .../tree/propagation/propagation-tests.factor | 4 ++++ 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index a9b77681fb..3a20424e18 100644 --- 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 ] 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 321941741e..f20afc77f3 100644 --- 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