use radix literals

[factor.git] / core / math / floats / floats.factor

diff --git a/core/math/floats/floats.factor b/core/math/floats/floats.factor
index aa55e2d0eed6585a2dd78895bba17f317289e3f6..b441276a886631046fcb2952f45fdace1a8a5d99 100644 (file)
--- a/core/math/floats/floats.factor
+++ b/core/math/floats/floats.factor
@@ -1,14 +1,12 @@
-! 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? ] either? ;
 : float-min ( x y -- z ) [ float< ] most ; foldable
 : float-max ( x y -- z ) [ float> ] most ; foldable
 
-M: fixnum >float fixnum>float ; inline
-M: bignum >float bignum>float ; inline
-
 M: float >fixnum float>fixnum ; inline
 M: float >bignum float>bignum ; inline
 M: float >float ; inline
@@ -17,23 +15,31 @@ M: float hashcode* nip float>bits ; inline
 M: float equal? over float? [ float= ] [ 2drop f ] if ; inline
 M: float number= float= ; inline
 
-M: float < float< ; inline
+M: float <  float< ; inline
 M: float <= float<= ; inline
-M: float > float> ; inline
+M: float >  float> ; inline
 M: float >= float>= ; inline
 
+M: float unordered? float-unordered? ; inline
+M: float u<  float-u< ; inline
+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
 M: float / float/f ; inline
 M: float /f float/f ; inline
 M: float /i float/f >integer ; inline
-M: float mod float-mod ; inline
 
 M: real abs dup 0 < [ neg ] when ; inline
 
 M: float fp-special?
-    double>bits -52 shift HEX: 7ff [ bitand ] keep = ; inline
+    double>bits -52 shift 0x7ff [ bitand ] keep = ; inline
 
 M: float fp-nan-payload
     double>bits 52 2^ 1 - bitand ; inline
@@ -50,7 +56,7 @@ M: float fp-snan?
 M: float fp-infinity?
     dup fp-special? [ fp-nan-payload zero? ] [ drop f ] if ; inline
 
-M: float next-float ( m -- n )
+M: float next-float
     double>bits
     dup -0.0 double>bits > [ 1 - bits>double ] [ ! negative non-zero
         dup -0.0 double>bits = [ drop 0.0 ] [ ! negative zero
@@ -58,12 +64,14 @@ M: float next-float ( m -- n )
         ] if
     ] if ; inline
 
-M: float unordered? [ fp-nan? ] bi@ or ; inline
-
-M: float prev-float ( m -- n )
+M: float prev-float
     double>bits
     dup -0.0 double>bits >= [ 1 + bits>double ] [ ! negative
         dup 0.0 double>bits = [ drop -0.0 ] [ ! positive zero
             1 - bits>double ! positive non-zero
         ] if
     ] if ; inline
+
+M: float fp-sign double>bits 63 bit? ; inline
+
+M: float abs double>bits 63 2^ bitnot bitand bits>double ; inline