X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FFloat.lhs;h=9831ec90f35a7ff8e52872c75503826c77b9e762;hb=28fb12f4e4059674e9396fc76a2783e0ae8798cd;hp=186d29c427cfe9acc45b99655f7b53f89bede689;hpb=7f1f4e7a695c402ddd3a1dc2cc7114e649a78ebc;p=ghc-base.git diff --git a/GHC/Float.lhs b/GHC/Float.lhs index 186d29c..9831ec9 100644 --- a/GHC/Float.lhs +++ b/GHC/Float.lhs @@ -1,28 +1,25 @@ -% ------------------------------------------------------------------------------ -% $Id: Float.lhs,v 1.1 2001/06/28 14:15:03 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 #-} +{-# OPTIONS_GHC -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" module GHC.Float( module GHC.Float, Float#, Double# ) where +import Data.Maybe + import GHC.Base import GHC.List import GHC.Enum @@ -30,7 +27,6 @@ import GHC.Show import GHC.Num import GHC.Real import GHC.Arr -import GHC.Maybe infixr 8 ** \end{code} @@ -42,6 +38,11 @@ infixr 8 ** %********************************************************* \begin{code} +-- | Trigonometric and hyperbolic functions and related functions. +-- +-- Minimal complete definition: +-- 'pi', 'exp', 'log', 'sin', 'cos', 'sinh', 'cosh' +-- 'asin', 'acos', 'atan', 'asinh', 'acosh' and 'atanh' class (Fractional a) => Floating a where pi :: a exp, log, sqrt :: a -> a @@ -57,17 +58,58 @@ class (Fractional a) => Floating a where tan x = sin x / cos x tanh x = sinh x / cosh x +-- | Efficient, machine-independent access to the components of a +-- floating-point number. +-- +-- Minimal complete definition: +-- all except 'exponent', 'significand', 'scaleFloat' and 'atan2' class (RealFrac a, Floating a) => RealFloat a where + -- | a constant function, returning the radix of the representation + -- (often @2@) floatRadix :: a -> Integer + -- | a constant function, returning the number of digits of + -- 'floatRadix' in the significand floatDigits :: a -> Int + -- | a constant function, returning the lowest and highest values + -- the exponent may assume floatRange :: a -> (Int,Int) + -- | The function 'decodeFloat' applied to a real floating-point + -- number returns the significand expressed as an 'Integer' and an + -- appropriately scaled exponent (an 'Int'). If @'decodeFloat' x@ + -- yields @(m,n)@, then @x@ is equal in value to @m*b^^n@, where @b@ + -- is the floating-point radix, and furthermore, either @m@ and @n@ + -- are both zero or else @b^(d-1) <= m < b^d@, where @d@ is the value + -- of @'floatDigits' x@. In particular, @'decodeFloat' 0 = (0,0)@. decodeFloat :: a -> (Integer,Int) + -- | 'encodeFloat' performs the inverse of 'decodeFloat' encodeFloat :: Integer -> Int -> a + -- | the second component of 'decodeFloat'. exponent :: a -> Int + -- | the first component of 'decodeFloat', scaled to lie in the open + -- interval (@-1@,@1@) significand :: a -> a + -- | multiplies a floating-point number by an integer power of the radix scaleFloat :: Int -> a -> a - isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE - :: a -> Bool + -- | 'True' if the argument is an IEEE \"not-a-number\" (NaN) value + isNaN :: a -> Bool + -- | 'True' if the argument is an IEEE infinity or negative infinity + isInfinite :: a -> Bool + -- | 'True' if the argument is too small to be represented in + -- normalized format + isDenormalized :: a -> Bool + -- | 'True' if the argument is an IEEE negative zero + isNegativeZero :: a -> Bool + -- | 'True' if the argument is an IEEE floating point number + isIEEE :: a -> Bool + -- | a version of arctangent taking two real floating-point arguments. + -- For real floating @x@ and @y@, @'atan2' y x@ computes the angle + -- (from the positive x-axis) of the vector from the origin to the + -- point @(x,y)@. @'atan2' y x@ returns a value in the range [@-pi@, + -- @pi@]. It follows the Common Lisp semantics for the origin when + -- signed zeroes are supported. @'atan2' y 1@, with @y@ in a type + -- that is 'RealFloat', should return the same value as @'atan' y@. + -- A default definition of 'atan2' is provided, but implementors + -- can provide a more accurate implementation. atan2 :: a -> a -> a @@ -102,14 +144,15 @@ class (RealFrac a, Floating a) => RealFloat a where %********************************************************* \begin{code} +-- | Single-precision floating point numbers. +-- It is desirable that this type be at least equal in range and precision +-- to the IEEE single-precision type. data Float = F# Float# -data Double = D# Double# - -instance CCallable Float -instance CReturnable Float -instance CCallable Double -instance CReturnable Double +-- | Double-precision floating point numbers. +-- It is desirable that this type be at least equal in range and precision +-- to the IEEE double-precision type. +data Double = D# Double# \end{code} @@ -165,14 +208,14 @@ instance RealFrac Float where {-# 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) -> @@ -329,14 +372,14 @@ instance RealFrac Double where {-# 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) -> @@ -450,6 +493,9 @@ instance Enum Double where \begin{code} +-- | Show a signed 'RealFloat' value to full precision +-- using standard decimal notation for arguments whose absolute value lies +-- between @0.1@ and @9,999,999@, and scientific notation otherwise. showFloat :: (RealFloat a) => a -> ShowS showFloat x = showString (formatRealFloat FFGeneric Nothing x) @@ -495,13 +541,15 @@ formatRealFloat fmt decs x mk0 ls = case ls of { "" -> "0" ; _ -> ls} in case decs of - Nothing -> - let - f 0 s rs = mk0 (reverse s) ++ '.':mk0 rs - f n s "" = f (n-1) ('0':s) "" - f n s (r:rs) = f (n-1) (r:s) rs - in - f e "" ds + Nothing + | e <= 0 -> "0." ++ replicate (-e) '0' ++ ds + | otherwise -> + let + f 0 s rs = mk0 (reverse s) ++ '.':mk0 rs + f n s "" = f (n-1) ('0':s) "" + f n s (r:rs) = f (n-1) (r:s) rs + in + f e "" ds Just dec -> let dec' = max dec 0 in if e >= 0 then @@ -515,8 +563,8 @@ formatRealFloat fmt decs x (ei,is') = roundTo base dec' (replicate (-e) 0 ++ is) d:ds' = map intToDigit (if ei > 0 then is' else 0:is') in - d : '.' : ds' - + d : (if null ds' then "" else '.':ds') + roundTo :: Int -> Int -> [Int] -> (Int,[Int]) roundTo base d is = @@ -535,13 +583,23 @@ roundTo base d is = (c,ds) = f (n-1) xs i' = c + i --- -- Based on "Printing Floating-Point Numbers Quickly and Accurately" -- by R.G. Burger and R.K. Dybvig in PLDI 96. -- This version uses a much slower logarithm estimator. It should be improved. --- This function returns a list of digits (Ints in [0..base-1]) and an --- exponent. +-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number, +-- and returns a list of digits and an exponent. +-- In particular, if @x>=0@, and +-- +-- > floatToDigits base x = ([d1,d2,...,dn], e) +-- +-- then +-- +-- (1) @n >= 1@ +-- +-- (2) @x = 0.d1d2...dn * (base**e)@ +-- +-- (3) @0 <= di <= base-1@ floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int) floatToDigits _ 0 = ([0], 0) @@ -672,14 +730,19 @@ fromRat x = x' Now, here's Lennart's code (which works) \begin{code} -{-# SPECIALISE fromRat :: - Rational -> Double, - Rational -> Float #-} +-- | Converts a 'Rational' value into any type in class 'RealFloat'. +{-# 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 @@ -690,6 +753,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 @@ -851,27 +915,27 @@ powerDouble (D# x) (D# y) = D# (x **## y) \end{code} \begin{code} -foreign import ccall "__encodeFloat" unsafe +foreign import ccall unsafe "__encodeFloat" encodeFloat# :: Int# -> ByteArray# -> Int -> Float -foreign import ccall "__int_encodeFloat" unsafe +foreign import ccall unsafe "__int_encodeFloat" int_encodeFloat# :: Int# -> Int -> Float -foreign import ccall "isFloatNaN" unsafe isFloatNaN :: Float -> Int -foreign import ccall "isFloatInfinite" unsafe isFloatInfinite :: Float -> Int -foreign import ccall "isFloatDenormalized" unsafe isFloatDenormalized :: Float -> Int -foreign import ccall "isFloatNegativeZero" unsafe isFloatNegativeZero :: Float -> Int +foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int +foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int +foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int +foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int -foreign import ccall "__encodeDouble" unsafe +foreign import ccall unsafe "__encodeDouble" encodeDouble# :: Int# -> ByteArray# -> Int -> Double -foreign import ccall "__int_encodeDouble" unsafe +foreign import ccall unsafe "__int_encodeDouble" int_encodeDouble# :: Int# -> Int -> Double -foreign import ccall "isDoubleNaN" unsafe isDoubleNaN :: Double -> Int -foreign import ccall "isDoubleInfinite" unsafe isDoubleInfinite :: Double -> Int -foreign import ccall "isDoubleDenormalized" unsafe isDoubleDenormalized :: Double -> Int -foreign import ccall "isDoubleNegativeZero" unsafe isDoubleNegativeZero :: Double -> Int +foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int +foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int +foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Double -> Int +foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int \end{code} %*********************************************************