import PrelBase
import PrelGHC
+import PrelEnum
+import PrelShow
import PrelNum
-import {-# SOURCE #-} PrelErr ( error )
+import PrelErr ( error )
import PrelList
import PrelMaybe
+import Maybe ( fromMaybe )
import PrelArr ( Array, array, (!) )
import PrelIOBase ( unsafePerformIO )
-import Ix ( Ix(..) )
import PrelCCall () -- we need the definitions of CCallable and
-- CReturnable for the _ccall_s herein.
\end{code}
signum x | x == 0.0 = 0
| x > 0.0 = 1
| 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
+
+ {-# INLINE fromInt #-}
fromInt i = int2Float i
instance Real Float where
floor x = case properFraction x of
(n,r) -> if r < 0.0 then n - 1 else n
+foreign import ccall "__encodeFloat" unsafe
+ encodeFloat# :: Int# -> ByteArray# -> Int -> Float
+foreign import ccall "__int_encodeFloat" unsafe
+ 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
+
instance RealFloat Float where
floatRadix _ = FLT_RADIX -- from float.h
floatDigits _ = FLT_MANT_DIG -- ditto
decodeFloat (F# f#)
= case decodeFloat# f# of
- (# exp#, a#, s#, d# #) -> (J# a# s# d#, I# exp#)
+ (# exp#, s#, d# #) -> (J# s# d#, I# exp#)
- encodeFloat (J# a# s# d#) (I# e#)
- = case encodeFloat# a# s# d# e# of { flt# -> F# flt# }
+ encodeFloat (S# i) j = int_encodeFloat# i j
+ encodeFloat (J# s# d#) e = encodeFloat# s# d# e
exponent x = case decodeFloat x of
(m,n) -> if m == 0 then 0 else n + floatDigits x
scaleFloat k x = case decodeFloat x of
(m,n) -> encodeFloat m (n+k)
- isNaN x =
- (0::Int) /= unsafePerformIO (_ccall_ isFloatNaN x) {- a _pure_function! -}
- isInfinite x =
- (0::Int) /= unsafePerformIO (_ccall_ isFloatInfinite x) {- ditto! -}
- isDenormalized x =
- (0::Int) /= unsafePerformIO (_ccall_ isFloatDenormalized x) -- ..
- isNegativeZero x =
- (0::Int) /= unsafePerformIO (_ccall_ isFloatNegativeZero x) -- ...
- isIEEE x = True
+ isNaN x = 0 /= isFloatNaN x
+ isInfinite x = 0 /= isFloatInfinite x
+ isDenormalized x = 0 /= isFloatDenormalized x
+ isNegativeZero x = 0 /= isFloatNegativeZero x
+ isIEEE _ = True
\end{code}
%*********************************************************
signum x | x == 0.0 = 0
| x > 0.0 = 1
| otherwise = negate 1
+
+ {-# INLINE fromInteger #-}
+ -- See comments with Num Float
fromInteger n = encodeFloat n 0
fromInt (I# n#) = case (int2Double# n#) of { d# -> D# d# }
{-# SPECIALIZE ceiling :: Double -> Integer #-}
{-# SPECIALIZE floor :: Double -> Integer #-}
-#if defined(__UNBOXED_INSTANCES__)
- {-# SPECIALIZE properFraction :: Double -> (Int#, Double) #-}
- {-# SPECIALIZE truncate :: Double -> Int# #-}
- {-# SPECIALIZE round :: Double -> Int# #-}
- {-# SPECIALIZE ceiling :: Double -> Int# #-}
- {-# SPECIALIZE floor :: Double -> Int# #-}
-#endif
-
properFraction x
= case (decodeFloat x) of { (m,n) ->
let b = floatRadix x in
floor x = case properFraction x of
(n,r) -> if r < 0.0 then n - 1 else n
+foreign import ccall "__encodeDouble" unsafe
+ encodeDouble# :: Int# -> ByteArray# -> Int -> Double
+foreign import ccall "__int_encodeDouble" unsafe
+ 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
+
instance RealFloat Double where
floatRadix _ = FLT_RADIX -- from float.h
floatDigits _ = DBL_MANT_DIG -- ditto
floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto
- decodeFloat (D# d#)
- = case decodeDouble# d# of
- (# exp#, a#, s#, d# #) -> (J# a# s# d#, I# exp#)
+ decodeFloat (D# x#)
+ = case decodeDouble# x# of
+ (# exp#, s#, d# #) -> (J# s# d#, I# exp#)
- encodeFloat (J# a# s# d#) (I# e#)
- = case encodeDouble# a# s# d# e# of { dbl# -> D# dbl# }
+ encodeFloat (S# i) j = int_encodeDouble# i j
+ encodeFloat (J# s# d#) e = encodeDouble# s# d# e
exponent x = case decodeFloat x of
(m,n) -> if m == 0 then 0 else n + floatDigits x
scaleFloat k x = case decodeFloat x of
(m,n) -> encodeFloat m (n+k)
- isNaN x =
- (0::Int) /= unsafePerformIO (_ccall_ isDoubleNaN x) {- a _pure_function! -}
- isInfinite x =
- (0::Int) /= unsafePerformIO (_ccall_ isDoubleInfinite x) {- ditto -}
- isDenormalized x =
- (0::Int) /= unsafePerformIO (_ccall_ isDoubleDenormalized x) -- ..
- isNegativeZero x =
- (0::Int) /= unsafePerformIO (_ccall_ isDoubleNegativeZero x) -- ...
- isIEEE x = True
+
+ isNaN x = 0 /= isDoubleNaN x
+ isInfinite x = 0 /= isDoubleInfinite x
+ isDenormalized x = 0 /= isDoubleDenormalized x
+ isNegativeZero x = 0 /= isDoubleNegativeZero x
+ isIEEE _ = True
instance Show Double where
showsPrec x = showSigned showFloat x
%*********************************************************
\begin{code}
-{- SPECIALIZE fromIntegral ::
+{-# SPECIALIZE fromIntegral ::
Int -> Rational,
Integer -> Rational,
Int -> Int,
fromIntegral :: (Integral a, Num b) => a -> b
fromIntegral = fromInteger . toInteger
-{- SPECIALIZE fromRealFrac ::
+{-# SPECIALIZE realToFrac ::
Double -> Rational,
Rational -> Double,
Float -> Rational,
Double -> Float,
Float -> Float,
Float -> Double #-}
-fromRealFrac :: (RealFrac a, Fractional b) => a -> b
-fromRealFrac = fromRational . toRational
+realToFrac :: (Real a, Fractional b) => a -> b
+realToFrac = fromRational . toRational
\end{code}
%*********************************************************
\begin{code}
instance Enum Float where
+ succ x = x + 1
+ pred x = x - 1
toEnum = fromIntegral
fromEnum = fromInteger . truncate -- may overflow
enumFrom = numericEnumFrom
+ enumFromTo = numericEnumFromTo
enumFromThen = numericEnumFromThen
enumFromThenTo = numericEnumFromThenTo
instance Enum Double where
+ succ x = x + 1
+ pred x = x - 1
toEnum = fromIntegral
fromEnum = fromInteger . truncate -- may overflow
enumFrom = numericEnumFrom
+ enumFromTo = numericEnumFromTo
enumFromThen = numericEnumFromThen
enumFromThenTo = numericEnumFromThenTo
-numericEnumFrom :: (Real a) => a -> [a]
-numericEnumFromThen :: (Real a) => a -> a -> [a]
-numericEnumFromThenTo :: (Real a) => a -> a -> a -> [a]
+numericEnumFrom :: (Fractional a) => a -> [a]
numericEnumFrom = iterate (+1)
+
+numericEnumFromThen :: (Fractional a) => a -> a -> [a]
numericEnumFromThen n m = iterate (+(m-n)) n
-numericEnumFromThenTo n m p = takeWhile (if m >= n then (<= p) else (>= p))
- (numericEnumFromThen n m)
+
+numericEnumFromTo :: (Ord a, Fractional a) => a -> a -> [a]
+numericEnumFromTo n m = takeWhile (<= m + 1/2) (numericEnumFrom n)
+
+numericEnumFromThenTo :: (Ord a, Fractional a) => a -> a -> a -> [a]
+numericEnumFromThenTo e1 e2 e3 = takeWhile pred (numericEnumFromThen e1 e2)
+ where
+ mid = (e2 - e1) / 2
+ pred | e2 > e1 = (<= e3 + mid)
+ | otherwise = (>= e3 + mid)
+
\end{code}
@approxRational@, applied to two real fractional numbers x and epsilon,
\begin{code}
approxRational :: (RealFrac a) => a -> a -> Rational
-approxRational x eps = simplest (x-eps) (x+eps)
+approxRational rat eps = simplest (rat-eps) (rat+eps)
where simplest x y | y < x = simplest y x
| x == y = xr
| x > 0 = simplest' n d n' d'
(x:%y) * (x':%y') = reduce (x * x') (y * y')
negate (x:%y) = (-x) :% y
abs (x:%y) = abs x :% y
- signum (x:%y) = signum x :% 1
+ signum (x:%_) = signum x :% 1
fromInteger x = fromInteger x :% 1
instance (Integral a) => Real (Ratio a) where
where (q,r) = quotRem x y
instance (Integral a) => Enum (Ratio a) where
- enumFrom = iterate ((+)1)
- enumFromThen n m = iterate ((+)(m-n)) n
+ succ x = x + 1
+ pred x = x - 1
+
toEnum n = fromIntegral n :% 1
fromEnum = fromInteger . truncate
+ enumFrom = bounded_iterator True (1)
+ enumFromThen n m = bounded_iterator (diff >= 0) diff n
+ where diff = m - n
+
+
+bounded_iterator :: (Ord a, Num a) => Bool -> a -> a -> [a]
+bounded_iterator inc step v
+ | inc && v > new_v = [v] -- oflow
+ | not inc && v < new_v = [v] -- uflow
+ | otherwise = v : bounded_iterator inc step new_v
+ where
+ new_v = v + step
+
ratio_prec :: Int
ratio_prec = 7
let (r', e) = normalize r
in prR n r' e
-startExpExp = 4 :: Int
+startExpExp :: Int
+startExpExp = 4
-- make sure 1 <= r < 10
normalize :: Rational -> (Rational, Int)
else
norm startExpExp r 0
where norm :: Int -> Rational -> Int -> (Rational, Int)
- -- Invariant: r*10^e == original r
- norm 0 r e = (r, e)
- norm ee r e =
+ -- Invariant: x*10^e == original r
+ norm 0 x e = (x, e)
+ norm ee x e =
let n = 10^ee
tn = 10^n
- in if r >= tn then norm ee (r/tn) (e+n) else norm (ee-1) r e
-
-drop0 "" = ""
-drop0 (c:cs) = c : reverse (dropWhile (=='0') (reverse cs))
+ in if x >= tn then norm ee (x/tn) (e+n) else norm (ee-1) x e
prR :: Int -> Rational -> Int -> String
-prR n r e | r < 1 = prR n (r*10) (e-1) -- final adjustment
-prR n r e | r >= 10 = prR n (r/10) (e+1)
-prR n r e0 =
- let s = show ((round (r * 10^n))::Integer)
- e = e0+1
- in if e > 0 && e < 8 then
- take e s ++ "." ++ drop0 (drop e s)
- else if e <= 0 && e > -3 then
- "0." ++ take (-e) (repeat '0') ++ drop0 s
- else
- head s : "."++ drop0 (tail s) ++ "e" ++ show e0
+prR n r e | r < 1 = prR n (r*10) (e-1) -- final adjustment
+prR n r e | r >= 10 = prR n (r/10) (e+1)
+prR n r e0
+ | e > 0 && e < 8 = takeN e s ('.' : drop0 (drop e s) [])
+ | e <= 0 && e > -3 = '0': '.' : takeN (-e) (repeat '0') (drop0 s [])
+ | otherwise = h : '.' : drop0 t ('e':show e0)
+ where
+ s@(h:t) = show ((round (r * 10^n))::Integer)
+ e = e0+1
+
+#ifdef USE_REPORT_PRELUDE
+ takeN n ls rs = take n ls ++ rs
+#else
+ takeN (I# n#) ls rs = takeUInt_append n# ls rs
+#endif
+
+drop0 :: String -> String -> String
+drop0 [] rs = rs
+drop0 (c:cs) rs = c : fromMaybe rs (dropTrailing0s cs) --WAS (yuck): reverse (dropWhile (=='0') (reverse cs))
+ where
+ dropTrailing0s [] = Nothing
+ dropTrailing0s ('0':xs) =
+ case dropTrailing0s xs of
+ Nothing -> Nothing
+ Just ls -> Just ('0':ls)
+ dropTrailing0s (x:xs) =
+ case dropTrailing0s xs of
+ Nothing -> Just [x]
+ Just ls -> Just (x:ls)
+
\end{code}
[In response to a request for documentation of how fromRational works,
Lennart's code follows, and it works...
\begin{pseudocode}
-{-# SPECIALISE fromRat ::
- Rational -> Double,
- Rational -> Float #-}
fromRat :: (RealFloat a) => Rational -> a
fromRat x = x'
where x' = f e
Now, here's Lennart's code.
\begin{code}
---fromRat :: (RealFloat a) => Rational -> a
-fromRat x =
- if x == 0 then encodeFloat 0 0 -- Handle exceptional cases
- else if x < 0 then - fromRat' (-x) -- first.
- else fromRat' x
+{-# 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
-- Conversion process:
-- Scale the rational number by the RealFloat base until
p = floatDigits r
(minExp0, _) = floatRange r
minExp = minExp0 - p -- the real minimum exponent
- xMin = toRational (expt b (p-1))
- xMax = toRational (expt b p)
+ xMin = toRational (expt b (p-1))
+ xMax = toRational (expt b p)
p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp
f = if p0 < 0 then 1 % expt b (-p0) else expt b p0 % 1
(x', p') = scaleRat (toRational b) minExp xMin xMax p0 (x / f)
-- Scale x until xMin <= x < xMax, or p (the exponent) <= minExp.
scaleRat :: Rational -> Int -> Rational -> Rational -> Int -> Rational -> (Rational, Int)
-scaleRat b minExp xMin xMax p x =
- if p <= minExp then
- (x, p)
- else if x >= xMax then
- scaleRat b minExp xMin xMax (p+1) (x/b)
- else if x < xMin then
- scaleRat b minExp xMin xMax (p-1) (x*b)
- else
- (x, p)
+scaleRat b minExp xMin xMax p x
+ | p <= minExp = (x, p)
+ | x >= xMax = scaleRat b minExp xMin xMax (p+1) (x/b)
+ | x < xMin = scaleRat b minExp xMin xMax (p-1) (x*b)
+ | otherwise = (x, p)
-- Exponentiation with a cache for the most common numbers.
-minExpt = 0::Int
-maxExpt = 1100::Int
+minExpt, maxExpt :: Int
+minExpt = 0
+maxExpt = 1100
+
expt :: Integer -> Int -> Integer
expt base n =
if base == 2 && n >= minExpt && n <= maxExpt then
expts!n
else
base^n
+
expts :: Array Int Integer
expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
-- Simplest way would be just divide i by b until it's smaller then b, but that would
-- be very slow! We are just slightly more clever.
integerLogBase :: Integer -> Integer -> Int
-integerLogBase b i =
- if i < b then
- 0
- else
+integerLogBase b i
+ | i < b = 0
+ | otherwise = doDiv (i `div` (b^l)) l
+ where
-- Try squaring the base first to cut down the number of divisions.
- let l = 2 * integerLogBase (b*b) i
- doDiv :: Integer -> Int -> Int
- doDiv i l = if i < b then l else doDiv (i `div` b) (l+1)
- in doDiv (i `div` (b^l)) l
+ l = 2 * integerLogBase (b*b) i
+
+ doDiv :: Integer -> Int -> Int
+ doDiv x y
+ | x < b = y
+ | otherwise = doDiv (x `div` b) (y+1)
+
\end{code}
%*********************************************************
--Exported from std library Numeric, defined here to
--avoid mut. rec. between PrelNum and Numeric.
showSigned :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS
-showSigned showPos p x = if x < 0 then showParen (p > 6)
- (showChar '-' . showPos (-x))
- else showPos x
+showSigned showPos p x
+ | x < 0 = showParen (p > 6) (showChar '-' . showPos (-x))
+ | otherwise = showPos x
+showFloat :: (RealFloat a) => a -> ShowS
showFloat x = showString (formatRealFloat FFGeneric Nothing x)
-- These are the format types. This type is not exported.
-data FFFormat = FFExponent | FFFixed | FFGeneric --no need: deriving (Eq, Ord, Show)
+data FFFormat = FFExponent | FFFixed | FFGeneric
formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String
-formatRealFloat fmt decs x = s
+formatRealFloat fmt decs x
+ | isNaN x = "NaN"
+ | isInfinite x = if x < 0 then "-Infinity" else "Infinity"
+ | x < 0 || isNegativeZero x = '-':doFmt fmt (floatToDigits (toInteger base) (-x))
+ | otherwise = doFmt fmt (floatToDigits (toInteger base) x)
where
base = 10
- s = if isNaN x
- then "NaN"
- else
- if isInfinite x then
- if x < 0 then "-Infinity" else "Infinity"
- else
- if x < 0 || isNegativeZero x then
- '-':doFmt fmt (floatToDigits (toInteger base) (-x))
- else
- doFmt fmt (floatToDigits (toInteger base) x)
-
- doFmt fmt (is, e) =
+
+ doFmt format (is, e) =
let ds = map intToDigit is in
- case fmt of
+ case format of
FFGeneric ->
- doFmt (if e <0 || e > 7 then FFExponent else FFFixed)
+ doFmt (if e < 0 || e > 7 then FFExponent else FFFixed)
(is,e)
FFExponent ->
case decs of
Nothing ->
let e' = if e==0 then 0 else e-1 in
(case ds of
- [d] -> d : ".0e"
- (d:ds) -> d : '.' : ds ++ "e") ++ show e'
+ [d] -> d : ".0e"
+ (d:ds') -> d : '.' : ds' ++ "e") ++ show e'
Just dec ->
let dec' = max dec 1 in
case is of
- [0] -> '0':'.':take dec' (repeat '0') ++ "e0"
+ [0] -> '0' :'.' : take dec' (repeat '0') ++ "e0"
_ ->
let
(ei,is') = roundTo base (dec'+1) is
- d:ds = map intToDigit (if ei > 0 then init is' else is')
+ (d:ds') = map intToDigit (if ei > 0 then init is' else is')
in
- d:'.':ds ++ 'e':show (e-1+ei)
+ d:'.':ds' ++ 'e':show (e-1+ei)
FFFixed ->
let
mk0 ls = case ls of { "" -> "0" ; _ -> ls}
case decs of
Nothing ->
let
- f 0 s ds = mk0 (reverse s) ++ '.':mk0 ds
- f n s "" = f (n-1) ('0':s) ""
- f n s (d:ds) = f (n-1) (d:s) ds
+ 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 1 in
+ let dec' = max dec 0 in
if e >= 0 then
let
(ei,is') = roundTo base (dec' + e) is
else
let
(ei,is') = roundTo base dec' (replicate (-e) 0 ++ is)
- d:ds = map intToDigit (if ei > 0 then is' else 0:is')
+ d:ds' = map intToDigit (if ei > 0 then is' else 0:is')
in
- d : '.' : ds
+ d : '.' : ds'
roundTo :: Int -> Int -> [Int] -> (Int,[Int])
roundTo base d is =
- let
- v = f d is
- in
- case v of
- (0,is) -> v
- (1,is) -> (1, 1:is)
+ case f d is of
+ x@(0,_) -> x
+ (1,xs) -> (1, 1:xs)
where
b2 = base `div` 2
- f n [] = (0, replicate n 0)
- f 0 (i:_) = (if i>=b2 then 1 else 0, [])
- f d (i:is) =
- let
- (c,ds) = f (d-1) is
- i' = c + i
- in
- if i' == base then (1,0:ds) else (0,i':ds)
+ f n [] = (0, replicate n 0)
+ f 0 (x:_) = (if x >= b2 then 1 else 0, [])
+ f n (i:xs)
+ | i' == base = (1,0:ds)
+ | otherwise = (0,i':ds)
+ where
+ (c,ds) = f (n-1) xs
+ i' = c + i
--
-- Based on "Printing Floating-Point Numbers Quickly and Accurately"
-- This function returns a list of digits (Ints in [0..base-1]) and an
-- exponent.
---floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int)
+
+floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int)
floatToDigits _ 0 = ([0], 0)
floatToDigits base x =
let
else
ceiling ((log (fromInteger (f+1)) +
fromInt e * log (fromInteger b)) /
- fromInt e * log (fromInteger b))
+ log (fromInteger base))
+--WAS: fromInt e * log (fromInteger b))
fixup n =
if n >= 0 then
used in the case of partial applications, etc.
\begin{code}
+plusFloat, minusFloat, timesFloat, divideFloat :: Float -> Float -> Float
plusFloat (F# x) (F# y) = F# (plusFloat# x y)
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)
+
+negateFloat :: Float -> Float
negateFloat (F# x) = F# (negateFloat# x)
+gtFloat, geFloat, eqFloat, neFloat, ltFloat, leFloat :: Float -> Float -> Bool
gtFloat (F# x) (F# y) = gtFloat# x y
geFloat (F# x) (F# y) = geFloat# x y
eqFloat (F# x) (F# y) = eqFloat# x y
ltFloat (F# x) (F# y) = ltFloat# x y
leFloat (F# x) (F# y) = leFloat# x y
+float2Int :: Float -> Int
float2Int (F# x) = I# (float2Int# x)
+
+int2Float :: Int -> Float
int2Float (I# x) = F# (int2Float# x)
+expFloat, logFloat, sqrtFloat :: Float -> Float
+sinFloat, cosFloat, tanFloat :: Float -> Float
+asinFloat, acosFloat, atanFloat :: Float -> Float
+sinhFloat, coshFloat, tanhFloat :: Float -> Float
expFloat (F# x) = F# (expFloat# x)
logFloat (F# x) = F# (logFloat# x)
sqrtFloat (F# x) = F# (sqrtFloat# x)
coshFloat (F# x) = F# (coshFloat# x)
tanhFloat (F# x) = F# (tanhFloat# x)
+powerFloat :: Float -> Float -> Float
powerFloat (F# x) (F# y) = F# (powerFloat# x y)
-- definitions of the boxed PrimOps; these will be
-- used in the case of partial applications, etc.
+plusDouble, minusDouble, timesDouble, divideDouble :: Double -> Double -> Double
plusDouble (D# x) (D# y) = D# (x +## y)
minusDouble (D# x) (D# y) = D# (x -## y)
timesDouble (D# x) (D# y) = D# (x *## y)
divideDouble (D# x) (D# y) = D# (x /## y)
+
+negateDouble :: Double -> Double
negateDouble (D# x) = D# (negateDouble# x)
+gtDouble, geDouble, eqDouble, neDouble, leDouble, ltDouble :: Double -> Double -> Bool
gtDouble (D# x) (D# y) = x >## y
geDouble (D# x) (D# y) = x >=## y
eqDouble (D# x) (D# y) = x ==## y
ltDouble (D# x) (D# y) = x <## y
leDouble (D# x) (D# y) = x <=## y
+double2Int :: Double -> Int
double2Int (D# x) = I# (double2Int# x)
+
+int2Double :: Int -> Double
int2Double (I# x) = D# (int2Double# x)
+
+double2Float :: Double -> Float
double2Float (D# x) = F# (double2Float# x)
+float2Double :: Float -> Double
float2Double (F# x) = D# (float2Double# x)
+expDouble, logDouble, sqrtDouble :: Double -> Double
+sinDouble, cosDouble, tanDouble :: Double -> Double
+asinDouble, acosDouble, atanDouble :: Double -> Double
+sinhDouble, coshDouble, tanhDouble :: Double -> Double
expDouble (D# x) = D# (expDouble# x)
logDouble (D# x) = D# (logDouble# x)
sqrtDouble (D# x) = D# (sqrtDouble# x)
coshDouble (D# x) = D# (coshDouble# x)
tanhDouble (D# x) = D# (tanhDouble# x)
+powerDouble :: Double -> Double -> Double
powerDouble (D# x) (D# y) = D# (x **## y)
\end{code}
projects / ghc-hetmet.git / blobdiff