285e050e3050e7c836cdd788a2c346f13c286636
2 - Copyright (C) 2009-2010 Nick Bowler.
4 - License BSD2: 2-clause BSD license. See LICENSE for full terms.
5 - This is free software: you are free to change and redistribute it.
6 - There is NO WARRANTY, to the extent permitted by law.
9 {-# LANGUAGE CPP, ForeignFunctionInterface, MagicHash, UnboxedTuples #-}
10 {-# OPTIONS_GHC -I. #-}
11 module Data
.Floating
.Types
.Double (
17 import Prelude
hiding (Double, Floating
(..), RealFloat
(..), Ord
(..))
18 import Control
.Applicative
25 import GHC
.Exts
hiding (Double(..))
31 import System
.IO.Unsafe
33 import Data
.Floating
.Types
.Core
34 import Data
.Floating
.Helpers
35 import Data
.Floating
.CMath
37 foreign import ccall unsafe
"double_signum"
38 double_signum
:: CDouble
-> CDouble
39 foreign import ccall unsafe
"double_classify"
40 double_classify
:: CDouble
-> CInt
41 foreign import ccall unsafe
"double_compare"
42 double_compare
:: CDouble
-> CDouble
-> CInt
43 foreign import ccall unsafe
"strtod"
44 c_strtod
:: CString
-> Ptr CString
-> IO CDouble
46 instance Show Double where
47 show = formatDouble
'a
' (-1)
49 instance Read Double where
50 readsPrec _ s
= unsafePerformIO
. withCString s
$ \str
-> do
51 alloca
$ \endbuf
-> do
52 val
<- toFloating
<$> c_strtod str endbuf
56 else peekCString end
>>= \rem
-> return [(val
, rem)]
58 instance Eq
Double where
59 D
# x
== D
# y
= x
==## y
60 D
# x
/= D
# y
= x
/=## y
62 instance Num
Double where
63 D
# x
+ D
# y
= D
# (x
+## y
)
64 D
# x
- D
# y
= D
# (x
-## y
)
65 D
# x
* D
# y
= D
# (x
*## y
)
66 negate (D
# x
) = D
# (negateDouble
# x
)
67 fromInteger = toFloating
68 signum = libmDouble double_signum
69 abs = libmDouble c_fabs
71 instance Enum
Double where
72 pred x
= nextafter x
(-infinity
)
73 succ x
= nextafter x infinity
75 fromEnum = fromJust . toIntegral
77 instance Poset
Double where
78 compare a b
= toEnum . fromIntegral $ double_compare a
' b
' where
82 D
# x
<= D
# y
= x
<=## y
83 D
# x
>= D
# y
= x
>=## y
86 instance Sortable
Double where
87 isOrdered
= not . ((== FPNaN
) . classify
)
88 max = libmDouble2 c_fmax
89 min = libmDouble2 c_fmin
91 instance Fractional
Double where
92 (D
# x
) / (D
# y
) = D
# (x
/## y
)
93 fromRational x
= scalb
(toFloating s
) (negate e
) where
94 scale
= scaleRational
(undefined :: Double)
97 -- | Internal function which discards the fractional component of a Double.
98 -- The results are meaningful only for finite input.
99 dropFrac
:: Double -> Integer
102 |
otherwise = quot s
(2^
(negate e
))
104 !(# s
, e
# #) = decodeDoubleInteger x
107 instance Roundable
Double where
108 toIntegral x
= case classify x
of
109 FPInfinite
-> Nothing
111 otherwise -> Just
. fromInteger . dropFrac
$ x
112 floor = libmDouble c_floor
113 ceiling = libmDouble c_ceil
114 truncate = libmDouble c_trunc
115 round = libmDouble c_round
117 instance Floating
Double where
118 (D
# x
) ** (D
# y
) = D
# (x
**## y
)
119 sqrt (D
# x
) = D
# (sqrtDouble
# x
)
120 acos (D
# x
) = D
# (acosDouble
# x
)
121 asin (D
# x
) = D
# (asinDouble
# x
)
122 atan (D
# x
) = D
# (atanDouble
# x
)
123 cos (D
# x
) = D
# (cosDouble
# x
)
124 sin (D
# x
) = D
# (sinDouble
# x
)
125 tan (D
# x
) = D
# (tanDouble
# x
)
126 cosh (D
# x
) = D
# (coshDouble
# x
)
127 sinh (D
# x
) = D
# (sinhDouble
# x
)
128 tanh (D
# x
) = D
# (tanhDouble
# x
)
129 exp (D
# x
) = D
# (expDouble
# x
)
130 log (D
# x
) = D
# (logDouble
# x
)
131 acosh = libmDouble c_acosh
132 asinh = libmDouble c_asinh
133 atanh = libmDouble c_atanh
135 instance RealFloat
Double where
136 fma
= libmDouble3 c_fma
137 copysign
= libmDouble2 c_copysign
138 nextafter
= libmDouble2 c_nextafter
139 fmod
= libmDouble2 c_fmod
140 frem
= libmDouble2 c_remainder
141 atan2 = libmDouble2 c_atan2
142 hypot
= libmDouble2 c_hypot
143 cbrt
= libmDouble c_cbrt
144 exp2
= libmDouble c_exp2
145 expm1
= libmDouble c_expm1
146 log10
= libmDouble c_log10
147 log1p
= libmDouble c_log1p
148 log2
= libmDouble c_log2
149 erf
= libmDouble c_erf
150 erfc
= libmDouble c_erfc
151 gamma
= libmDouble c_tgamma
152 lgamma
= libmDouble c_lgamma
153 nearbyint
= libmDouble c_nearbyint
154 rint
= libmDouble c_rint
156 instance PrimFloat
Double where
157 floatRadix = const FLT_RADIX_VAL
158 floatPrecision
= const DBL_MANT_DIG_VAL
159 floatRange = const (DBL_MIN_EXP_VAL
, DBL_MAX_EXP_VAL
)
160 classify
= toEnum . fromIntegral . double_classify
. toFloating
161 logb
= libmDouble c_logb
162 scalb x e
= toFloating
$ c_scalbln
(toFloating x
) (fromIntegral e
)