X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FFloat.lhs;h=5c3043910eaf4ef4d4ea6818655667ebc9714876;hb=073a40996177960147ef91988910c6131ef29cb3;hp=382ef645da810b45e8c675fb88ff4fc1409ce876;hpb=b706340c451952adf230b5b8daecad8a1f34d714;p=ghc-base.git diff --git a/GHC/Float.lhs b/GHC/Float.lhs index 382ef64..5c30439 100644 --- a/GHC/Float.lhs +++ b/GHC/Float.lhs @@ -98,7 +98,10 @@ class (RealFrac a, Floating a) => RealFloat a where %********************************************************* \begin{code} +-- | Single-precision floating point numbers. data Float = F# Float# + +-- | Double-precision floating point numbers. data Double = D# Double# instance CCallable Float @@ -675,14 +678,18 @@ fromRat x = x' Now, here's Lennart's code (which works) \begin{code} -{-# SPECIALISE fromRat :: - Rational -> Double, - Rational -> Float #-} +{-# SPECIALISE fromRat :: Rational -> Double, + Rational -> Float #-} fromRat :: (RealFloat a) => Rational -> a -fromRat x - | x == 0 = encodeFloat 0 0 -- Handle exceptional cases - | x < 0 = - fromRat' (-x) -- first. - | otherwise = fromRat' x + +-- Deal with special cases first, delegating the real work to fromRat' +fromRat (n :% 0) | n > 0 = 1/0 -- +Infinity + | n == 0 = 0/0 -- NaN + | n < 0 = -1/0 -- -Infinity + +fromRat (n :% d) | n > 0 = fromRat' (n :% d) + | n == 0 = encodeFloat 0 0 -- Zero + | n < 0 = - fromRat' ((-n) :% d) -- Conversion process: -- Scale the rational number by the RealFloat base until @@ -693,6 +700,7 @@ fromRat x -- a first guess of the exponent. fromRat' :: (RealFloat a) => Rational -> a +-- Invariant: argument is strictly positive fromRat' x = r where b = floatRadix r p = floatDigits r