add infinity? and nan? to math.floating-point

diff --git a/extra/math/floating-point/floating-point-tests.factor b/extra/math/floating-point/floating-point-tests.factor
index 7f3a87f9a59f2408a88caa34bac6b4f3758f4ad6..129956331bce51358bf44252ec0b80d2b2572495 100644 (file)
--- a/extra/math/floating-point/floating-point-tests.factor
+++ b/extra/math/floating-point/floating-point-tests.factor
@@ -1,7 +1,17 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test math.floating-point math.constants kernel ;
+USING: tools.test math.floating-point math.constants kernel
+math.constants fry sequences kernel math ;
 IN: math.floating-point.tests
 
 [ t ] [ pi >double< >double pi = ] unit-test
 [ t ] [ -1.0 >double< >double -1.0 = ] unit-test
+
+[ t ] [ 1/0. infinity? ] unit-test
+[ t ] [ -1/0. infinity? ] unit-test
+[ f ] [ 0/0. infinity? ] unit-test
+[ f ] [ 10. infinity? ] unit-test
+[ f ] [ -10. infinity? ] unit-test
+[ f ] [ 0. infinity? ] unit-test
+
+[ t ] [ 0/0. nan? ] unit-test

diff --git a/extra/math/floating-point/floating-point.factor b/extra/math/floating-point/floating-point.factor
index 0d224bfc9dceee19cf398d34bb7e3dd02c5ecde6..02fcd01e11ee4156658a5a923329500df703281d 100644 (file)
--- a/extra/math/floating-point/floating-point.factor
+++ b/extra/math/floating-point/floating-point.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math sequences prettyprint math.parser io
-math.functions math.bitwise ;
+math.functions math.bitwise combinators.short-circuit ;
 IN: math.floating-point
 
 : (double-sign) ( bits -- n ) -63 shift ; inline
@@ -37,3 +37,17 @@ IN: math.floating-point
         (double-mantissa-bits) >bin 52 CHAR: 0 pad-left
         11 [ bl ] times print
     ] tri ;
+
+: nan? ( double -- ? )
+    double>bits
+    {
+        [ (double-exponent-bits) 11 on-bits = ]
+        [ (double-mantissa-bits) 0 > ]
+    } 1&& ;
+
+: infinity? ( double -- ? )
+    double>bits
+    {
+        [ (double-exponent-bits) 11 on-bits = ]
+        [ (double-mantissa-bits) 0 = ]
+    } 1&& ;