Update base for latest Safe Haskell.
[packages/base.git] / GHC / Float / RealFracMethods.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, MagicHash, UnboxedTuples, ForeignFunctionInterface,
3 NoImplicitPrelude #-}
4 {-# OPTIONS_HADDOCK hide #-}
5
6 -----------------------------------------------------------------------------
7 -- |
8 -- Module : GHC.Float.RealFracMethods
9 -- Copyright : (c) Daniel Fischer 2010
10 -- License : see libraries/base/LICENSE
11 --
12 -- Maintainer : cvs-ghc@haskell.org
13 -- Stability : internal
14 -- Portability : non-portable (GHC Extensions)
15 --
16 -- Methods for the RealFrac instances for 'Float' and 'Double',
17 -- with specialised versions for 'Int'.
18 --
19 -- Moved to their own module to not bloat GHC.Float further.
20 --
21 -----------------------------------------------------------------------------
22
23 #include "MachDeps.h"
24
25 -- #hide
26 module GHC.Float.RealFracMethods
27 ( -- * Double methods
28 -- ** Integer results
29 properFractionDoubleInteger
30 , truncateDoubleInteger
31 , floorDoubleInteger
32 , ceilingDoubleInteger
33 , roundDoubleInteger
34 -- ** Int results
35 , properFractionDoubleInt
36 , floorDoubleInt
37 , ceilingDoubleInt
38 , roundDoubleInt
39 -- * Double/Int conversions, wrapped primops
40 , double2Int
41 , int2Double
42 -- * Float methods
43 -- ** Integer results
44 , properFractionFloatInteger
45 , truncateFloatInteger
46 , floorFloatInteger
47 , ceilingFloatInteger
48 , roundFloatInteger
49 -- ** Int results
50 , properFractionFloatInt
51 , floorFloatInt
52 , ceilingFloatInt
53 , roundFloatInt
54 -- * Float/Int conversions, wrapped primops
55 , float2Int
56 , int2Float
57 ) where
58
59 import GHC.Integer
60
61 import GHC.Base
62 import GHC.Num ()
63
64 #if WORD_SIZE_IN_BITS < 64
65
66 import GHC.IntWord64
67
68 #define TO64 integerToInt64
69 #define FROM64 int64ToInteger
70 #define MINUS64 minusInt64#
71 #define NEGATE64 negateInt64#
72
73 #else
74
75 #define TO64 integerToInt
76 #define FROM64 smallInteger
77 #define MINUS64 ( -# )
78 #define NEGATE64 negateInt#
79
80 uncheckedIShiftRA64# :: Int# -> Int# -> Int#
81 uncheckedIShiftRA64# = uncheckedIShiftRA#
82
83 uncheckedIShiftL64# :: Int# -> Int# -> Int#
84 uncheckedIShiftL64# = uncheckedIShiftL#
85
86 #endif
87
88 default ()
89
90 ------------------------------------------------------------------------------
91 -- Float Methods --
92 ------------------------------------------------------------------------------
93
94 -- Special Functions for Int, nice, easy and fast.
95 -- They should be small enough to be inlined automatically.
96
97 -- We have to test for ±0.0 to avoid returning -0.0 in the second
98 -- component of the pair. Unfortunately the branching costs a lot
99 -- of performance.
100 properFractionFloatInt :: Float -> (Int, Float)
101 properFractionFloatInt (F# x) =
102 if x `eqFloat#` 0.0#
103 then (I# 0#, F# 0.0#)
104 else case float2Int# x of
105 n -> (I# n, F# (x `minusFloat#` int2Float# n))
106
107 -- truncateFloatInt = float2Int
108
109 floorFloatInt :: Float -> Int
110 floorFloatInt (F# x) =
111 case float2Int# x of
112 n | x `ltFloat#` int2Float# n -> I# (n -# 1#)
113 | otherwise -> I# n
114
115 ceilingFloatInt :: Float -> Int
116 ceilingFloatInt (F# x) =
117 case float2Int# x of
118 n | int2Float# n `ltFloat#` x -> I# (n +# 1#)
119 | otherwise -> I# n
120
121 roundFloatInt :: Float -> Int
122 roundFloatInt x = float2Int (c_rintFloat x)
123
124 -- Functions with Integer results
125
126 -- With the new code generator in GHC 7, the explicit bit-fiddling is
127 -- slower than the old code for values of small modulus, but when the
128 -- 'Int' range is left, the bit-fiddling quickly wins big, so we use that.
129 -- If the methods are called on smallish values, hopefully people go
130 -- through Int and not larger types.
131
132 -- Note: For negative exponents, we must check the validity of the shift
133 -- distance for the right shifts of the mantissa.
134
135 {-# INLINE properFractionFloatInteger #-}
136 properFractionFloatInteger :: Float -> (Integer, Float)
137 properFractionFloatInteger v@(F# x) =
138 case decodeFloat_Int# x of
139 (# m, e #)
140 | e <# 0# ->
141 case negateInt# e of
142 s | s ># 23# -> (0, v)
143 | m <# 0# ->
144 case negateInt# (negateInt# m `uncheckedIShiftRA#` s) of
145 k -> (smallInteger k,
146 case m -# (k `uncheckedIShiftL#` s) of
147 r -> F# (encodeFloatInteger (smallInteger r) e))
148 | otherwise ->
149 case m `uncheckedIShiftRL#` s of
150 k -> (smallInteger k,
151 case m -# (k `uncheckedIShiftL#` s) of
152 r -> F# (encodeFloatInteger (smallInteger r) e))
153 | otherwise -> (shiftLInteger (smallInteger m) e, F# 0.0#)
154
155 {-# INLINE truncateFloatInteger #-}
156 truncateFloatInteger :: Float -> Integer
157 truncateFloatInteger x =
158 case properFractionFloatInteger x of
159 (n, _) -> n
160
161 -- floor is easier for negative numbers than truncate, so this gets its
162 -- own implementation, it's a little faster.
163 {-# INLINE floorFloatInteger #-}
164 floorFloatInteger :: Float -> Integer
165 floorFloatInteger (F# x) =
166 case decodeFloat_Int# x of
167 (# m, e #)
168 | e <# 0# ->
169 case negateInt# e of
170 s | s ># 23# -> if m <# 0# then (-1) else 0
171 | otherwise -> smallInteger (m `uncheckedIShiftRA#` s)
172 | otherwise -> shiftLInteger (smallInteger m) e
173
174 -- ceiling x = -floor (-x)
175 -- If giving this its own implementation is faster at all,
176 -- it's only marginally so, hence we keep it short.
177 {-# INLINE ceilingFloatInteger #-}
178 ceilingFloatInteger :: Float -> Integer
179 ceilingFloatInteger (F# x) =
180 negateInteger (floorFloatInteger (F# (negateFloat# x)))
181
182 {-# INLINE roundFloatInteger #-}
183 roundFloatInteger :: Float -> Integer
184 roundFloatInteger x = float2Integer (c_rintFloat x)
185
186 ------------------------------------------------------------------------------
187 -- Double Methods --
188 ------------------------------------------------------------------------------
189
190 -- Special Functions for Int, nice, easy and fast.
191 -- They should be small enough to be inlined automatically.
192
193 -- We have to test for ±0.0 to avoid returning -0.0 in the second
194 -- component of the pair. Unfortunately the branching costs a lot
195 -- of performance.
196 properFractionDoubleInt :: Double -> (Int, Double)
197 properFractionDoubleInt (D# x) =
198 if x ==## 0.0##
199 then (I# 0#, D# 0.0##)
200 else case double2Int# x of
201 n -> (I# n, D# (x -## int2Double# n))
202
203 -- truncateDoubleInt = double2Int
204
205 floorDoubleInt :: Double -> Int
206 floorDoubleInt (D# x) =
207 case double2Int# x of
208 n | x <## int2Double# n -> I# (n -# 1#)
209 | otherwise -> I# n
210
211 ceilingDoubleInt :: Double -> Int
212 ceilingDoubleInt (D# x) =
213 case double2Int# x of
214 n | int2Double# n <## x -> I# (n +# 1#)
215 | otherwise -> I# n
216
217 roundDoubleInt :: Double -> Int
218 roundDoubleInt x = double2Int (c_rintDouble x)
219
220 -- Functions with Integer results
221
222 -- The new Code generator isn't quite as good for the old 'Double' code
223 -- as for the 'Float' code, so for 'Double' the bit-fiddling also wins
224 -- when the values have small modulus.
225
226 -- When the exponent is negative, all mantissae have less than 64 bits
227 -- and the right shifting of sized types is much faster than that of
228 -- 'Integer's, especially when we can
229
230 -- Note: For negative exponents, we must check the validity of the shift
231 -- distance for the right shifts of the mantissa.
232
233 {-# INLINE properFractionDoubleInteger #-}
234 properFractionDoubleInteger :: Double -> (Integer, Double)
235 properFractionDoubleInteger v@(D# x) =
236 case decodeDoubleInteger x of
237 (# m, e #)
238 | e <# 0# ->
239 case negateInt# e of
240 s | s ># 52# -> (0, v)
241 | m < 0 ->
242 case TO64 (negateInteger m) of
243 n ->
244 case n `uncheckedIShiftRA64#` s of
245 k ->
246 (FROM64 (NEGATE64 k),
247 case MINUS64 n (k `uncheckedIShiftL64#` s) of
248 r ->
249 D# (encodeDoubleInteger (FROM64 (NEGATE64 r)) e))
250 | otherwise ->
251 case TO64 m of
252 n ->
253 case n `uncheckedIShiftRA64#` s of
254 k -> (FROM64 k,
255 case MINUS64 n (k `uncheckedIShiftL64#` s) of
256 r -> D# (encodeDoubleInteger (FROM64 r) e))
257 | otherwise -> (shiftLInteger m e, D# 0.0##)
258
259 {-# INLINE truncateDoubleInteger #-}
260 truncateDoubleInteger :: Double -> Integer
261 truncateDoubleInteger x =
262 case properFractionDoubleInteger x of
263 (n, _) -> n
264
265 -- floor is easier for negative numbers than truncate, so this gets its
266 -- own implementation, it's a little faster.
267 {-# INLINE floorDoubleInteger #-}
268 floorDoubleInteger :: Double -> Integer
269 floorDoubleInteger (D# x) =
270 case decodeDoubleInteger x of
271 (# m, e #)
272 | e <# 0# ->
273 case negateInt# e of
274 s | s ># 52# -> if m < 0 then (-1) else 0
275 | otherwise ->
276 case TO64 m of
277 n -> FROM64 (n `uncheckedIShiftRA64#` s)
278 | otherwise -> shiftLInteger m e
279
280 {-# INLINE ceilingDoubleInteger #-}
281 ceilingDoubleInteger :: Double -> Integer
282 ceilingDoubleInteger (D# x) =
283 negateInteger (floorDoubleInteger (D# (negateDouble# x)))
284
285 {-# INLINE roundDoubleInteger #-}
286 roundDoubleInteger :: Double -> Integer
287 roundDoubleInteger x = double2Integer (c_rintDouble x)
288
289 -- Wrappers around double2Int#, int2Double#, float2Int# and int2Float#,
290 -- we need them here, so we move them from GHC.Float and re-export them
291 -- explicitly from there.
292
293 double2Int :: Double -> Int
294 double2Int (D# x) = I# (double2Int# x)
295
296 int2Double :: Int -> Double
297 int2Double (I# i) = D# (int2Double# i)
298
299 float2Int :: Float -> Int
300 float2Int (F# x) = I# (float2Int# x)
301
302 int2Float :: Int -> Float
303 int2Float (I# i) = F# (int2Float# i)
304
305 -- Quicker conversions from 'Double' and 'Float' to 'Integer',
306 -- assuming the floating point value is integral.
307 --
308 -- Note: Since the value is integral, the exponent can't be less than
309 -- (-TYP_MANT_DIG), so we need not check the validity of the shift
310 -- distance for the right shfts here.
311
312 {-# INLINE double2Integer #-}
313 double2Integer :: Double -> Integer
314 double2Integer (D# x) =
315 case decodeDoubleInteger x of
316 (# m, e #)
317 | e <# 0# ->
318 case TO64 m of
319 n -> FROM64 (n `uncheckedIShiftRA64#` negateInt# e)
320 | otherwise -> shiftLInteger m e
321
322 {-# INLINE float2Integer #-}
323 float2Integer :: Float -> Integer
324 float2Integer (F# x) =
325 case decodeFloat_Int# x of
326 (# m, e #)
327 | e <# 0# -> smallInteger (m `uncheckedIShiftRA#` negateInt# e)
328 | otherwise -> shiftLInteger (smallInteger m) e
329
330 -- Foreign imports, the rounding is done faster in C when the value
331 -- isn't integral, so we call out for rounding. For values of large
332 -- modulus, calling out to C is slower than staying in Haskell, but
333 -- presumably 'round' is mostly called for values with smaller modulus,
334 -- when calling out to C is a major win.
335 -- For all other functions, calling out to C gives at most a marginal
336 -- speedup for values of small modulus and is much slower than staying
337 -- in Haskell for values of large modulus, so those are done in Haskell.
338
339 foreign import ccall unsafe "rintDouble"
340 c_rintDouble :: Double -> Double
341
342 foreign import ccall unsafe "rintFloat"
343 c_rintFloat :: Float -> Float
344