diff --git a/core/math/floats/floats-tests.factor b/core/math/floats/floats-tests.factor index 097e2c14aa..de84346a58 100644 --- 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 53c3fe543e..aa55e2d0ee 100644 --- 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 e6c34c112c..4fb39f93f7 100755 --- 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