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