shithub: MicroHs

Download patch

ref: f292a26d47527ae5dd9de040754c6d0a64a162da
parent: faf4d16a06726e00ca9997479421f9fd13157e51
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Mon Feb 5 16:20:43 EST 2024

Roundtrip in & nan via Rational

--- a/lib/Data/Double.hs
+++ b/lib/Data/Double.hs
@@ -44,7 +44,11 @@
   -- This version of fromRational can go horribly wrong
   -- if the integers are bigger than can be represented in a Double.
   -- It'll do for now.
-  fromRational x = fromInteger (numerator x) `primDoubleDiv` fromInteger (denominator x)
+  fromRational x | x == rationalNaN = 0/0
+                 | x == rationalInfinity = 1/0
+                 | x == -rationalInfinity = (-1)/0
+                 | otherwise =
+    fromInteger (numerator x) / fromInteger (denominator x)
 
 instance Eq Double where
   (==) = primDoubleEQ
@@ -64,9 +68,11 @@
   readsPrec _ = readSigned $ \ r -> [ (primDoubleRead s, t) | (s@(c:_), t) <- lex r, isDigit c ]
 
 instance Real Double where
-  toRational x =
-    let (m, e) = decodeFloat x
-    in  toRational m * 2^^e
+  toRational x | isNaN x = rationalNaN
+               | isInfinite x = if x < 0 then -rationalInfinity else rationalInfinity
+               | otherwise =
+    case decodeFloat x of
+      (m, e) -> toRational m * 2^^e
 
 instance Floating Double where
   pi     = 3.141592653589793
--