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