-% ------------------------------------------------------------------------------
-% $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 #-}
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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"
+-- #hide
module GHC.Float( module GHC.Float, Float#, Double# ) where
+import Data.Maybe
+
import GHC.Base
import GHC.List
import GHC.Enum
import GHC.Num
import GHC.Real
import GHC.Arr
-import GHC.Maybe
infixr 8 **
\end{code}
%*********************************************************
\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
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
%*********************************************************
\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}
| otherwise = negate 1
{-# INLINE fromInteger #-}
- fromInteger n = encodeFloat n 0
- -- It's important that encodeFloat inlines here, and that
- -- fromInteger in turn inlines,
- -- so that if fromInteger is applied to an (S# i) the right thing happens
+ fromInteger (S# i#) = case (int2Float# i#) of { d# -> F# d# }
+ fromInteger (J# s# d#) = encodeFloat# s# d# 0
+ -- previous code: fromInteger n = encodeFloat n 0
+ -- doesn't work too well, because encodeFloat is defined in
+ -- terms of ccalls which can never be simplified away. We
+ -- want simple literals like (fromInteger 3 :: Float) to turn
+ -- into (F# 3.0), hence the special case for S# here.
instance Real Float where
toRational x = (m%1)*(b%1)^^n
{-# 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) ->
\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)
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
(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 =
(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)
(f*b*2, b^(-e+1)*2, b, 1)
else
(f*2, b^(-e)*2, 1, 1)
+ k :: Int
k =
let
+ k0 :: Int
k0 =
if b == 2 && base == 10 then
-- logBase 10 2 is slightly bigger than 3/10 so
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
-- 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
\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}
%*********************************************************
projects / ghc-base.git / blobdiff