From: panne <unknown>
Date: Wed, 10 May 2000 09:27:59 +0000 (+0000)
Subject: [project @ 2000-05-10 09:27:59 by panne]
X-Git-Tag: Approximately_9120_patches~4537
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=cdc022f6f568886cee383427969d06451dd400c6;p=ghc-hetmet.git

[project @ 2000-05-10 09:27:59 by panne]
Added RULES for realToFrac with types
   Double   -> Float
   Float    -> Double
   Double   -> Double
   Float    -> Float
   Rational -> Rational
---

diff --git a/ghc/lib/std/Prelude.lhs b/ghc/lib/std/Prelude.lhs
index 7a09c42..58de274 100644
--- a/ghc/lib/std/Prelude.lhs
+++ b/ghc/lib/std/Prelude.lhs
@@ -200,13 +200,24 @@ fromIntegral	=  fromInteger . toInteger
     Double	-> Rational, 
     Rational	-> Double,
     Float	-> Rational,
-    Rational	-> Float,
-    Rational	-> Rational,
-    Double	-> Double,
-    Double	-> Float,
-    Float	-> Float,
-    Float	-> Double #-}
+    Rational	-> Float
+ #-}
 realToFrac	:: (Real a, Fractional b) => a -> b
 realToFrac	=  fromRational . toRational
+
+{-# RULES
+"realToFrac/Double->Float"      realToFrac = doubleToFloat
+"realToFrac/Float->Double"      realToFrac = floatToDouble
+"realToFrac/Double->Double"     realToFrac = id :: Double -> Double
+"realToFrac/Float->Float"       realToFrac = id :: Float -> Float
+"realToFrac/Rational->Rational" realToFrac = id :: Rational -> Rational
+ #-}
+
+doubleToFloat :: Double -> Float
+doubleToFloat (D# d) = F# (double2Float# d)
+
+floatToDouble :: Float -> Double
+floatToDouble (F# f) = D# (float2Double# f)
+
 \end{code}