From 47a5e9654796e1511d8dd95661eb55e65f2c182d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 13 Jan 2010 22:20:16 +1300 Subject: [PATCH] Rework min and max so that behavior with floats and NaNs is consistent between generic arithmetic and open-coded float intrinsics --- basis/compiler/tests/float.factor | 27 ++++++++++++++---- .../tree/propagation/propagation-tests.factor | 28 +++++++++++++------ .../propagation/transforms/transforms.factor | 20 ------------- basis/math/vectors/vectors.factor | 11 ++------ core/math/floats/floats-tests.factor | 5 +++- core/math/floats/floats.factor | 7 +++-- core/math/integers/integers-tests.factor | 8 ++++-- core/math/integers/integers.factor | 9 ++++-- core/math/order/order-docs.factor | 6 ++-- core/math/order/order.factor | 10 +++++-- 10 files changed, 73 insertions(+), 58 deletions(-) diff --git a/basis/compiler/tests/float.factor b/basis/compiler/tests/float.factor index 14b347008c..632a560c0d 100644 --- a/basis/compiler/tests/float.factor +++ b/basis/compiler/tests/float.factor @@ -1,5 +1,5 @@ USING: compiler.units compiler kernel kernel.private memory math -math.private tools.test math.floats.private ; +math.private tools.test math.floats.private math.order fry ; IN: compiler.tests.float [ 5.0 ] [ [ 5.0 ] compile-call gc gc gc ] unit-test @@ -84,11 +84,6 @@ IN: compiler.tests.float [ 315 315.0 ] [ 313 [ 2 fixnum+fast dup fixnum>float ] compile-call ] unit-test -[ 17.5 ] [ -11.3 17.5 [ float-max ] compile-call ] unit-test -[ 17.5 ] [ 17.5 -11.3 [ float-max ] compile-call ] unit-test -[ -11.3 ] [ -11.3 17.5 [ float-min ] compile-call ] unit-test -[ -11.3 ] [ 17.5 -11.3 [ float-min ] compile-call ] unit-test - [ t ] [ 0/0. 0/0. [ float-unordered? ] compile-call ] unit-test [ t ] [ 0/0. 1.0 [ float-unordered? ] compile-call ] unit-test [ t ] [ 1.0 0/0. [ float-unordered? ] compile-call ] unit-test @@ -100,3 +95,23 @@ IN: compiler.tests.float [ 1 ] [ 1.0 0/0. [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test [ 2 ] [ 3.0 1.0 [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test [ 2 ] [ 1.0 3.0 [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test + +! Ensure that float-min and min, and float-max and max, have +! consistent behavior with respect to NaNs + +: two-floats ( a b -- a b ) { float float } declare ; inline + +[ -11.3 ] [ -11.3 17.5 [ two-floats min ] compile-call ] unit-test +[ -11.3 ] [ 17.5 -11.3 [ two-floats min ] compile-call ] unit-test +[ 17.5 ] [ -11.3 17.5 [ two-floats max ] compile-call ] unit-test +[ 17.5 ] [ 17.5 -11.3 [ two-floats max ] compile-call ] unit-test + +: check-compiled-binary-op ( a b word -- ) + [ '[ [ [ two-floats _ execute ] compile-call ] call( a b -- c ) ] ] + [ '[ _ execute ] ] + bi 2bi fp-bitwise= ; inline + +[ t ] [ 0/0. 3.0 \ min check-compiled-binary-op ] unit-test +[ t ] [ 3.0 0/0. \ min check-compiled-binary-op ] unit-test +[ t ] [ 0/0. 3.0 \ max check-compiled-binary-op ] unit-test +[ t ] [ 3.0 0/0. \ max check-compiled-binary-op ] unit-test diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index c7e02aef4c..f8a53b3287 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -1,14 +1,13 @@ USING: kernel compiler.tree.builder compiler.tree compiler.tree.propagation compiler.tree.recursive -compiler.tree.normalization tools.test math math.order -accessors sequences arrays kernel.private vectors -alien.accessors alien.c-types sequences.private -byte-arrays classes.algebra classes.tuple.private -math.functions math.private strings layouts -compiler.tree.propagation.info compiler.tree.def-use -compiler.tree.debugger compiler.tree.checker -slots.private words hashtables classes assocs locals -specialized-arrays system sorting math.libm +compiler.tree.normalization tools.test math math.order accessors +sequences arrays kernel.private vectors alien.accessors +alien.c-types sequences.private byte-arrays classes.algebra +classes.tuple.private math.functions math.private strings +layouts compiler.tree.propagation.info compiler.tree.def-use +compiler.tree.debugger compiler.tree.checker slots.private words +hashtables classes assocs locals specialized-arrays system +sorting math.libm math.floats.private math.integers.private math.intervals quotations effects alien alien.data ; FROM: math => float ; SPECIALIZED-ARRAY: double @@ -942,3 +941,14 @@ M: tuple-with-read-only-slot clone ! Could be bignum not integer but who cares [ V{ integer } ] [ [ 10 >bignum bitand ] final-classes ] unit-test +[ t ] [ [ { fixnum fixnum } declare min ] { min } inlined? ] unit-test +[ f ] [ [ { fixnum fixnum } declare min ] { fixnum-min } inlined? ] unit-test + +[ t ] [ [ { float float } declare min ] { min } inlined? ] unit-test +[ f ] [ [ { float float } declare min ] { float-min } inlined? ] unit-test + +[ t ] [ [ { fixnum fixnum } declare max ] { max } inlined? ] unit-test +[ f ] [ [ { fixnum fixnum } declare max ] { fixnum-max } inlined? ] unit-test + +[ t ] [ [ { float float } declare max ] { max } inlined? ] unit-test +[ f ] [ [ { float float } declare max ] { float-max } inlined? ] unit-test diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index 809b51c6ef..f88b60d338 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -132,26 +132,6 @@ IN: compiler.tree.propagation.transforms ] "custom-inlining" set-word-prop ] each -! Integrate this with generic arithmetic optimization instead? -: both-inputs? ( #call class -- ? ) - [ in-d>> first2 ] dip '[ value-info class>> _ class<= ] both? ; - -\ min [ - { - { [ dup fixnum both-inputs? ] [ [ fixnum-min ] ] } - { [ dup float both-inputs? ] [ [ float-min ] ] } - [ f ] - } cond nip -] "custom-inlining" set-word-prop - -\ max [ - { - { [ dup fixnum both-inputs? ] [ [ fixnum-max ] ] } - { [ dup float both-inputs? ] [ [ float-max ] ] } - [ f ] - } cond nip -] "custom-inlining" set-word-prop - ! Generate more efficient code for common idiom \ clone [ in-d>> first value-info literal>> { diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 311abf50af..69d8929c65 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -58,21 +58,14 @@ M: object v*hs+ [ * ] 2map (h+) ; GENERIC: v/ ( u v -- w ) M: object v/ [ / ] 2map ; - - GENERIC: vavg ( u v -- w ) M: object vavg [ + 2 / ] 2map ; GENERIC: vmax ( u v -- w ) -M: object vmax [ [ float-max ] [ max ] if-both-floats ] 2map ; +M: object vmax [ max ] 2map ; GENERIC: vmin ( u v -- w ) -M: object vmin [ [ float-min ] [ min ] if-both-floats ] 2map ; +M: object vmin [ min ] 2map ; GENERIC: v+- ( u v -- w ) M: object v+- diff --git a/core/math/floats/floats-tests.factor b/core/math/floats/floats-tests.factor index 220eb33960..2c0884c8b1 100644 --- a/core/math/floats/floats-tests.factor +++ b/core/math/floats/floats-tests.factor @@ -1,4 +1,4 @@ -USING: kernel math math.constants tools.test sequences +USING: kernel math math.constants math.order tools.test sequences grouping ; IN: math.floats.tests @@ -75,3 +75,6 @@ unit-test [ t ] [ -0.0 abs 0.0 fp-bitwise= ] unit-test [ 1.5 ] [ -1.5 abs ] unit-test [ 1.5 ] [ 1.5 abs ] unit-test + +[ 5.0 ] [ 3 5.0 max ] unit-test +[ 3 ] [ 3 5.0 min ] unit-test diff --git a/core/math/floats/floats.factor b/core/math/floats/floats.factor index bc419b94c5..97c6f7fc87 100644 --- a/core/math/floats/floats.factor +++ b/core/math/floats/floats.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2004, 2009 Slava Pestov, Joe Groff. +! Copyright (C) 2004, 2010 Slava Pestov, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.private ; +USING: kernel math math.private math.order ; IN: math.floats.private : float-unordered? ( x y -- ? ) [ fp-nan? ] bi@ or ; @@ -29,6 +29,9 @@ M: float u<= float-u<= ; inline M: float u> float-u> ; inline M: float u>= float-u>= ; inline +M: float min over float? [ float-min ] [ call-next-method ] if ; inline +M: float max over float? [ float-max ] [ call-next-method ] if ; inline + M: float + float+ ; inline M: float - float- ; inline M: float * float* ; inline diff --git a/core/math/integers/integers-tests.factor b/core/math/integers/integers-tests.factor index 30d1254082..3f9384e02d 100644 --- a/core/math/integers/integers-tests.factor +++ b/core/math/integers/integers-tests.factor @@ -1,5 +1,6 @@ -USING: kernel math math.functions namespaces prettyprint -math.private continuations tools.test sequences random ; +USING: kernel math math.functions math.order namespaces +prettyprint math.private continuations tools.test sequences +random ; IN: math.integers.tests [ "-8" ] [ -8 unparse ] unit-test @@ -230,3 +231,6 @@ unit-test ! Ensure that /f is accurate for fixnums > 2^53 on 64-bit platforms [ HEX: 1.758bec11492f9p-54 ] [ 1 12345678901234567 /f ] unit-test [ HEX: -1.758bec11492f9p-54 ] [ 1 -12345678901234567 /f ] unit-test + +[ 17 ] [ 17 >bignum 5 max ] unit-test +[ 5 ] [ 17 >bignum 5 min ] unit-test diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index eb94597160..e95c6d832b 100644 --- a/core/math/integers/integers.factor +++ b/core/math/integers/integers.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2004, 2009 Slava Pestov. +! Copyright (C) 2004, 2010 Slava Pestov. ! Copyright (C) 2008, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel kernel.private sequences -sequences.private math math.private combinators ; +USING: kernel kernel.private sequences sequences.private math +math.private math.order combinators ; IN: math.integers.private : fixnum-min ( x y -- z ) [ fixnum< ] most ; foldable @@ -29,6 +29,9 @@ M: fixnum u<= fixnum<= ; inline M: fixnum u> fixnum> ; inline M: fixnum u>= fixnum>= ; inline +M: fixnum min over fixnum? [ fixnum-min ] [ call-next-method ] if ; inline +M: fixnum max over fixnum? [ fixnum-max ] [ call-next-method ] if ; inline + M: fixnum + fixnum+ ; inline M: fixnum - fixnum- ; inline M: fixnum * fixnum* ; inline diff --git a/core/math/order/order-docs.factor b/core/math/order/order-docs.factor index 5d294c1f6f..418107fcd1 100644 --- a/core/math/order/order-docs.factor +++ b/core/math/order/order-docs.factor @@ -44,18 +44,18 @@ HELP: compare } ; HELP: max -{ $values { "x" object } { "y" object } { "z" object } } +{ $values { "obj1" object } { "obj2" object } { "obj" object } } { $description "Outputs the greatest of two ordered values." } { $notes "If one value is a floating point positive zero and the other is a negative zero, the result is undefined." } ; HELP: min -{ $values { "x" object } { "y" object } { "z" object } } +{ $values { "obj1" object } { "obj2" object } { "obj" object } } { $description "Outputs the smallest of two ordered values." } { $notes "If one value is a floating point positive zero and the other is a negative zero, the result is undefined." } ; HELP: clamp { $values { "x" object } { "min" object } { "max" object } { "y" object } } -{ $description "Outputs " { $snippet "x" } " if contained in the interval " { $snippet "[min,max]" } " or outputs one of the endpoints." } ; +{ $description "Outputs " { $snippet "x" } " if contained in the interval " { $snippet "[min,max]" } " or else outputs one of the endpoints." } ; HELP: between? { $values { "x" object } { "y" object } { "z" real } { "?" "a boolean" } } diff --git a/core/math/order/order.factor b/core/math/order/order.factor index fe1454d1d8..499cf06e9a 100644 --- a/core/math/order/order.factor +++ b/core/math/order/order.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 Slava Pestov, Doug Coleman. +! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math ; IN: math.order @@ -32,8 +32,12 @@ M: real after? ( obj1 obj2 -- ? ) > ; inline M: real before=? ( obj1 obj2 -- ? ) <= ; inline M: real after=? ( obj1 obj2 -- ? ) >= ; inline -: min ( x y -- z ) [ before? ] most ; -: max ( x y -- z ) [ after? ] most ; +GENERIC: min ( obj1 obj2 -- obj ) +GENERIC: max ( obj1 obj2 -- obj ) + +M: object min [ before? ] most ; inline +M: object max [ after? ] most ; inline + : clamp ( x min max -- y ) [ max ] dip min ; inline : between? ( x y z -- ? )