-% ------------------------------------------------------------------------------
-% $Id: Float.lhs,v 1.5 2002/02/27 14:33:09 simonmar Exp $
-%
-% (c) The University of Glasgow, 1994-2000
-%
-
-\section[GHC.Num]{Module @GHC.Num@}
-
-The types
-
- Float
- Double
-
-and the classes
-
- Floating
- RealFloat
-
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : GHC.Float
+-- Copyright : (c) The University of Glasgow 1994-2002
+-- License : see libraries/base/LICENSE
+--
+-- Maintainer : cvs-ghc@haskell.org
+-- Stability : internal
+-- Portability : non-portable (GHC Extensions)
+--
+-- The types 'Float' and 'Double', and the classes 'Floating' and 'RealFloat'.
+--
+-----------------------------------------------------------------------------
#include "ieee-flpt.h"
%*********************************************************
\begin{code}
+-- | Single-precision floating point numbers.
data Float = F# Float#
+
+-- | Double-precision floating point numbers.
data Double = D# Double#
instance CCallable Float
{-# SPECIALIZE properFraction :: Float -> (Int, Float) #-}
{-# SPECIALIZE round :: Float -> Int #-}
- {-# SPECIALIZE ceiling :: Float -> Int #-}
- {-# SPECIALIZE floor :: Float -> Int #-}
- {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-}
- {-# SPECIALIZE truncate :: Float -> Integer #-}
+ {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-}
{-# SPECIALIZE round :: Float -> Integer #-}
- {-# SPECIALIZE ceiling :: Float -> Integer #-}
- {-# SPECIALIZE floor :: Float -> Integer #-}
+
+ -- ceiling, floor, and truncate are all small
+ {-# INLINE ceiling #-}
+ {-# INLINE floor #-}
+ {-# INLINE truncate #-}
properFraction x
= case (decodeFloat x) of { (m,n) ->
{-# SPECIALIZE properFraction :: Double -> (Int, Double) #-}
{-# SPECIALIZE round :: Double -> Int #-}
- {-# SPECIALIZE ceiling :: Double -> Int #-}
- {-# SPECIALIZE floor :: Double -> Int #-}
{-# SPECIALIZE properFraction :: Double -> (Integer, Double) #-}
- {-# SPECIALIZE truncate :: Double -> Integer #-}
{-# SPECIALIZE round :: Double -> Integer #-}
- {-# SPECIALIZE ceiling :: Double -> Integer #-}
- {-# SPECIALIZE floor :: Double -> Integer #-}
+
+ -- ceiling, floor, and truncate are all small
+ {-# INLINE ceiling #-}
+ {-# INLINE floor #-}
+ {-# INLINE truncate #-}
properFraction x
= case (decodeFloat x) of { (m,n) ->
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
-- 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