steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Rework min and max so that behavior with floats and NaNs is consistent between generic arithmetic and open-coded float intrinsics

db4
Slava Pestov 2010-01-13 22:20:16 +13:00
parent 1c10196c43
commit 47a5e96547
10 changed files with 73 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
basis/compiler/tests/float.factor
View File

@ -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

28
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -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

20
basis/compiler/tree/propagation/transforms/transforms.factor
View File

@ -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>> {

11
basis/math/vectors/vectors.factor
View File

@ -58,21 +58,14 @@ M: object v*hs+ [ * ] 2map (h+) ;
GENERIC: v/ ( u v -- w )
M: object v/ [ / ] 2map ;
<PRIVATE
: if-both-floats ( x y p q -- )
[ 2dup [ float? ] both? ] 2dip if ; inline
PRIVATE>
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+-

5
core/math/floats/floats-tests.factor
View File

@ -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

7
core/math/floats/floats.factor
View File

@ -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

8
core/math/integers/integers-tests.factor
View File

@ -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

9
core/math/integers/integers.factor
View File

@ -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

6
core/math/order/order-docs.factor
View File

@ -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" } }

10
core/math/order/order.factor
View File

@ -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 -- ? )