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

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

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
+compiler.tree.normalization tools.test math math.order accessors
-accessors sequences arrays kernel.private vectors
+sequences arrays kernel.private vectors alien.accessors
-alien.accessors alien.c-types sequences.private
+alien.c-types sequences.private byte-arrays classes.algebra
-byte-arrays classes.algebra classes.tuple.private
+classes.tuple.private math.functions math.private strings
-math.functions math.private strings layouts
+layouts compiler.tree.propagation.info compiler.tree.def-use
-compiler.tree.propagation.info compiler.tree.def-use
+compiler.tree.debugger compiler.tree.checker slots.private words
-compiler.tree.debugger compiler.tree.checker
+hashtables classes assocs locals specialized-arrays system
-slots.private words hashtables classes assocs locals
+sorting math.libm math.floats.private math.integers.private
-specialized-arrays system sorting math.libm
 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

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

basis/math/vectors/vectors.factor

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

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

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

core/math/integers/integers-tests.factor

@@ -1,5 +1,6 @@
-USING: kernel math math.functions namespaces prettyprint
+USING: kernel math math.functions math.order namespaces
-math.private continuations tools.test sequences random ;
+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

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
+USING: kernel kernel.private sequences sequences.private math
-sequences.private math math.private combinators ;
+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

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

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 ;
+GENERIC: min ( obj1 obj2 -- obj )
-: max ( x y -- z ) [ after? ] most ;
+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 -- ? )