X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FFloat.lhs;h=ec27a1206d0018b92464f995282e82c7a36c50f7;hb=40cb4477c2b80707a20ad64ae2e6ac69f0a630a4;hp=186d29c427cfe9acc45b99655f7b53f89bede689;hpb=7f1f4e7a695c402ddd3a1dc2cc7114e649a78ebc;p=ghc-base.git diff --git a/GHC/Float.lhs b/GHC/Float.lhs index 186d29c..ec27a12 100644 --- a/GHC/Float.lhs +++ b/GHC/Float.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: Float.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $ +% $Id: Float.lhs,v 1.4 2002/02/05 17:32:26 simonmar Exp $ % % (c) The University of Glasgow, 1994-2000 % @@ -23,6 +23,8 @@ and the classes module GHC.Float( module GHC.Float, Float#, Double# ) where +import Data.Maybe + import GHC.Base import GHC.List import GHC.Enum @@ -30,7 +32,6 @@ import GHC.Show import GHC.Num import GHC.Real import GHC.Arr -import GHC.Maybe infixr 8 ** \end{code} @@ -495,13 +496,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 +518,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 +538,18 @@ 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 +-- (a) n >= 1 +-- (b) x = 0.d1d2...dn * (base**e) +-- (c) 0 <= di <= base-1 floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int) floatToDigits _ 0 = ([0], 0) @@ -760,6 +768,18 @@ minusFloat (F# x) (F# y) = F# (minusFloat# x y) timesFloat (F# x) (F# y) = F# (timesFloat# x y) divideFloat (F# x) (F# y) = F# (divideFloat# x y) +{-# RULES +"plusFloat x 0.0" forall x#. plusFloat# x# 0.0# = x# +"plusFloat 0.0 x" forall x#. plusFloat# 0.0# x# = x# +"minusFloat x 0.0" forall x#. minusFloat# x# 0.0# = x# +"minusFloat x x" forall x#. minusFloat# x# x# = 0.0# +"timesFloat x 0.0" forall x#. timesFloat# x# 0.0# = 0.0# +"timesFloat0.0 x" forall x#. timesFloat# 0.0# x# = 0.0# +"timesFloat x 1.0" forall x#. timesFloat# x# 1.0# = x# +"timesFloat 1.0 x" forall x#. timesFloat# 1.0# x# = x# +"divideFloat x 1.0" forall x#. divideFloat# x# 1.0# = x# + #-} + negateFloat :: Float -> Float negateFloat (F# x) = F# (negateFloat# x) @@ -806,6 +826,18 @@ minusDouble (D# x) (D# y) = D# (x -## y) timesDouble (D# x) (D# y) = D# (x *## y) divideDouble (D# x) (D# y) = D# (x /## y) +{-# RULES +"plusDouble x 0.0" forall x#. (+##) x# 0.0## = x# +"plusDouble 0.0 x" forall x#. (+##) 0.0## x# = x# +"minusDouble x 0.0" forall x#. (-##) x# 0.0## = x# +"minusDouble x x" forall x#. (-##) x# x# = 0.0## +"timesDouble x 0.0" forall x#. (*##) x# 0.0## = 0.0## +"timesDouble 0.0 x" forall x#. (*##) 0.0## x# = 0.0## +"timesDouble x 1.0" forall x#. (*##) x# 1.0## = x# +"timesDouble 1.0 x" forall x#. (*##) 1.0## x# = x# +"divideDouble x 1.0" forall x#. (/##) x# 1.0## = x# + #-} + negateDouble :: Double -> Double negateDouble (D# x) = D# (negateDouble# x) @@ -851,27 +883,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} %*********************************************************