prettyprint.backend: fix prettyprinting of special nans.

diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor
index 26cc50bd41ea239a04f738ac80708435d03823e4..56200756c0160f344f208b009071772bc7448e16 100644 (file)
--- a/basis/prettyprint/backend/backend.factor
+++ b/basis/prettyprint/backend/backend.factor
@@ -82,18 +82,22 @@ M: real pprint*
         [ unsupported-number-base ]
     } case ;
 
-: pprint-nan? ( f -- ? )
-    { [ fp-nan? ] [ 0/0. fp-bitwise= not ] [ -0/0. fp-bitwise= not ] } 1&& ;
-
 M: float pprint*
-    dup pprint-nan? [
-        \ NAN: [
-            [ fp-nan-payload ] [ fp-sign ] bi
-            [ 0xfffffffffffff bitxor 1 + neg ] when >hex text
-        ] pprint-prefix
-    ] [
-        call-next-method
-    ] if ;
+    {
+        { [ dup 0/0. fp-bitwise= ] [ drop "0/0." text ] }
+        { [ dup -0/0. fp-bitwise= ] [ drop "-0/0." text ] }
+        { [ dup fp-nan? ] [
+            \ NAN: [
+                [ fp-nan-payload ] [ fp-sign ] bi
+                [ 0xfffffffffffff bitxor 1 + neg ] when >hex text
+            ] pprint-prefix
+        ] }
+        { [ dup 1/0. = ] [ drop "1/0." text ] }
+        { [ dup -1/0. = ] [ drop "-1/0." text ] }
+        { [ dup 0.0 fp-bitwise= ] [ drop "0.0" text ] }
+        { [ dup -0.0 fp-bitwise= ] [ drop "-0.0" text ] }
+        [ call-next-method ]
+    } cond ;
 
 M: f pprint* drop \ f pprint-word ;