add an "unordered?" predicate to math, with a dumb implementation for now

diff --git a/core/math/floats/floats-tests.factor b/core/math/floats/floats-tests.factor
index 097e2c14aaad74fefb872f4cf314345e06d02ee8..de84346a580469534ebd867276677a5025c61e09 100644 (file)
--- a/core/math/floats/floats-tests.factor
+++ b/core/math/floats/floats-tests.factor
@@ -61,3 +61,9 @@ unit-test
 [ t ] [ 64 [ 2^ 0.5 * ] map [ < ] monotonic? ] unit-test
 
 [ 5 ] [ 10.5 1.9 /i ] unit-test
+
+[ t ] [ 0/0. 0/0. unordered? ] unit-test
+[ t ] [ 1.0 0/0. unordered? ] unit-test
+[ t ] [ 0/0. 1.0 unordered? ] unit-test
+[ f ] [ 1.0 1.0 unordered? ] unit-test
+

diff --git a/core/math/floats/floats.factor b/core/math/floats/floats.factor
index 53c3fe543e0d067b546e8bad0b852dba53671323..aa55e2d0eed6585a2dd78895bba17f317289e3f6 100644 (file)
--- a/core/math/floats/floats.factor
+++ b/core/math/floats/floats.factor
@@ -39,7 +39,7 @@ 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
+    dup float= not ;
 
 M: float fp-qnan?
     dup fp-nan? [ fp-nan-payload 51 2^ bitand zero? not ] [ drop f ] if ; inline
@@ -58,6 +58,8 @@ M: float next-float ( m -- n )
         ] if
     ] if ; inline
 
+M: float unordered? [ fp-nan? ] bi@ or ; inline
+
 M: float prev-float ( m -- n )
     double>bits
     dup -0.0 double>bits >= [ 1 + bits>double ] [ ! negative

diff --git a/core/math/math.factor b/core/math/math.factor
index e6c34c112c11da5e4fae85a5e394f759fc6ea864..4fb39f93f76a2e39adf80057cf58959aed2cd55b 100755 (executable)
--- a/core/math/math.factor
+++ b/core/math/math.factor
@@ -22,6 +22,9 @@ MATH: <  ( x y -- ? ) foldable
 MATH: <= ( x y -- ? ) foldable
 MATH: >  ( x y -- ? ) foldable
 MATH: >= ( x y -- ? ) foldable
+MATH: unordered? ( x y -- ? ) foldable
+
+M: object unordered? 2drop f ;
 
 MATH: +   ( x y -- z ) foldable
 MATH: -   ( x y -- z ) foldable