math: move float methods to math.floats

diff --git a/core/math/floats/floats.factor b/core/math/floats/floats.factor
index 160b220173b7391319e2a179826974a9c33cb2c4..661bccd88c59228542b759b7ddb28ea7de4f41fe 100644 (file)
--- a/core/math/floats/floats.factor
+++ b/core/math/floats/floats.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2006 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov, Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.private ;
 IN: math.floats.private
@@ -28,3 +28,37 @@ 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
+
+M: float fp-nan-payload
+    double>bits 52 2^ 1 - bitand ; inline
+
+M: float fp-nan?
+    dup fp-special? [ fp-nan-payload zero? not ] [ drop f ] if ; inline
+
+M: float fp-qnan?
+    dup fp-nan? [ fp-nan-payload 51 2^ bitand zero? not ] [ drop f ] if ; inline
+
+M: float fp-snan?
+    dup fp-nan? [ fp-nan-payload 51 2^ bitand zero? ] [ drop f ] if ; inline
+
+M: float fp-infinity?
+    dup fp-special? [ fp-nan-payload zero? ] [ drop f ] if ; inline
+
+M: float next-float ( m -- n )
+    double>bits
+    dup -0.0 double>bits > [ 1 - bits>double ] [ ! negative non-zero
+        dup -0.0 double>bits = [ drop 0.0 ] [ ! negative zero
+            1 + bits>double ! positive
+        ] if
+    ] if ; inline
+
+M: float prev-float ( m -- n )
+    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

diff --git a/core/math/math.factor b/core/math/math.factor
index 1213e13a1f493803664b971b75d17a9a80e2f78b..e6c34c112c11da5e4fae85a5e394f759fc6ea864 100755 (executable)
--- a/core/math/math.factor
+++ b/core/math/math.factor
@@ -97,55 +97,18 @@ GENERIC: fp-snan? ( x -- ? )
 GENERIC: fp-infinity? ( x -- ? )
 GENERIC: fp-nan-payload ( x -- bits )
 
-M: object fp-special?
-    drop f ; inline
-M: object fp-nan?
-    drop f ; inline
-M: object fp-qnan?
-    drop f ; inline
-M: object fp-snan?
-    drop f ; inline
-M: object fp-infinity?
-    drop f ; inline
-M: object fp-nan-payload
-    drop f ; inline
-
-M: float fp-special?
-    double>bits -52 shift HEX: 7ff [ bitand ] keep = ; inline
-
-M: float fp-nan-payload
-    double>bits HEX: fffffffffffff bitand ; inline
-
-M: float fp-nan?
-    dup fp-special? [ fp-nan-payload zero? not ] [ drop f ] if ; inline
-
-M: float fp-qnan?
-    dup fp-nan? [ fp-nan-payload HEX: 8000000000000 bitand zero? not ] [ drop f ] if ; inline
-
-M: float fp-snan?
-    dup fp-nan? [ fp-nan-payload HEX: 8000000000000 bitand zero? ] [ drop f ] if ; inline
-
-M: float fp-infinity?
-    dup fp-special? [ fp-nan-payload zero? ] [ drop f ] if ; inline
+M: object fp-special? drop f ; inline
+M: object fp-nan? drop f ; inline
+M: object fp-qnan? drop f ; inline
+M: object fp-snan? drop f ; inline
+M: object fp-infinity? drop f ; inline
+M: object fp-nan-payload drop f ; inline
 
 : <fp-nan> ( payload -- nan )
     HEX: 7ff0000000000000 bitor bits>double ; inline
 
-: next-float ( m -- n )
-    double>bits
-    dup -0.0 double>bits > [ 1 - bits>double ] [ ! negative non-zero
-        dup -0.0 double>bits = [ drop 0.0 ] [ ! negative zero
-            1 + bits>double ! positive
-        ] if
-    ] if ; inline
-
-: prev-float ( m -- n )
-    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
+GENERIC: next-float ( m -- n )
+GENERIC: prev-float ( m -- n )
 
 : next-power-of-2 ( m -- n )
     dup 2 <= [ drop 2 ] [ 1 - log2 1 + 2^ ] if ; inline