From 2dc99ea05fb5e88876757fdbd53014314913685a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 19 Aug 2009 16:06:37 -0500 Subject: [PATCH 1/3] 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 From 770429a629f731073dbe50b83a895bf3da40fd60 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 19 Aug 2009 16:08:52 -0500 Subject: [PATCH 2/3] math.intervals: help lint fix --- basis/math/intervals/intervals-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/math/intervals/intervals-docs.factor b/basis/math/intervals/intervals-docs.factor index 4be8dcc9a7..0c0f95b48c 100644 --- a/basis/math/intervals/intervals-docs.factor +++ b/basis/math/intervals/intervals-docs.factor @@ -253,7 +253,7 @@ HELP: interval-bitnot { $description "Computes the bitwise complement of the interval." } ; HELP: points>interval -{ $values { "seq" "a sequence of " { $snippet "{ point included? }" } " pairs" } { "interval" interval } } +{ $values { "seq" "a sequence of " { $snippet "{ point included? }" } " pairs" } { "interval" interval } { "nan?" "true if the computation produced NaNs" } } { $description "Outputs the smallest interval containing all of the endpoints." } ; From a598cc35a5434921aabc04e1778e2072246e0cd1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 19 Aug 2009 16:56:26 -0500 Subject: [PATCH 3/3] compiler: add unit tests for new bugs --- .../compiler/cfg/builder/builder-tests.factor | 25 ++++++++++++++++++- basis/compiler/tests/optimizer.factor | 4 ++- 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index b2f25fdeb1..2c472bc0ff 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -4,7 +4,7 @@ compiler.tree.optimizer compiler.cfg.builder compiler.cfg.debugger compiler.cfg.optimizer compiler.cfg.predecessors compiler.cfg.checker compiler.cfg arrays locals byte-arrays kernel.private math slots.private vectors sbufs strings math.partial-dispatch -strings.private ; +strings.private accessors compiler.cfg.instructions ; IN: compiler.cfg.builder.tests ! Just ensure that various CFGs build correctly. @@ -157,3 +157,26 @@ IN: compiler.cfg.builder.tests { pinned-c-ptr class } \ set-alien-cell '[ _ declare 10 _ execute ] unit-test-cfg { pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-cfg ] each + +: contains-insn? ( quot insn-check -- ? ) + [ test-mr [ instructions>> ] map ] dip + '[ _ any? ] any? ; inline + +[ t ] [ [ swap ] [ ##replace? ] contains-insn? ] unit-test + +[ f ] [ [ swap swap ] [ ##replace? ] contains-insn? ] unit-test + +[ t ] [ + [ { fixnum byte-array fixnum } declare set-alien-unsigned-1 ] + [ ##set-alien-integer-1? ] contains-insn? +] unit-test + +[ t ] [ + [ { fixnum byte-array fixnum } declare [ dup * dup * ] 2dip set-alien-unsigned-1 ] + [ ##set-alien-integer-1? ] contains-insn? +] unit-test + +[ f ] [ + [ { byte-array fixnum } declare set-alien-unsigned-1 ] + [ ##set-alien-integer-1? ] contains-insn? +] unit-test \ No newline at end of file diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index 186e2f8c31..6092a6dca6 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -4,7 +4,7 @@ sbufs strings tools.test vectors words sequences.private quotations classes classes.algebra classes.tuple.private continuations growable namespaces hints alien.accessors compiler.tree.builder compiler.tree.optimizer sequences.deep -compiler definitions ; +compiler definitions generic.single ; IN: compiler.tests.optimizer GENERIC: xyz ( obj -- obj ) @@ -423,3 +423,5 @@ M: object bad-dispatch-position-test* ; \ bad-dispatch-position-test* forget ] with-compilation-unit ] unit-test + +[ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with \ No newline at end of file