1 {-# LANGUAGE CPP, MagicHash, UnboxedTuples, ForeignFunctionInterface,
3 {-# OPTIONS_HADDOCK hide #-}
4 -----------------------------------------------------------------------------
6 -- Module : GHC.Float.RealFracMethods
7 -- Copyright : (c) Daniel Fischer 2010
8 -- License : see libraries/base/LICENSE
10 -- Maintainer : cvs-ghc@haskell.org
11 -- Stability : internal
12 -- Portability : non-portable (GHC Extensions)
14 -- Methods for the RealFrac instances for 'Float' and 'Double',
15 -- with specialised versions for 'Int'.
17 -- Moved to their own module to not bloat GHC.Float further.
19 -----------------------------------------------------------------------------
24 module GHC.Float.RealFracMethods
27 properFractionDoubleInteger
28 , truncateDoubleInteger
30 , ceilingDoubleInteger
33 , properFractionDoubleInt
37 -- * Double/Int conversions, wrapped primops
42 , properFractionFloatInteger
43 , truncateFloatInteger
48 , properFractionFloatInt
52 -- * Float/Int conversions, wrapped primops
62 #if WORD_SIZE_IN_BITS < 64
66 #define TO64 integerToInt64
67 #define FROM64 int64ToInteger
68 #define MINUS64 minusInt64#
69 #define NEGATE64 negateInt64#
74 #define FROM64 smallInteger
75 #define MINUS64 ( -# )
76 #define NEGATE64 negateInt#
78 uncheckedIShiftRA64# :: Int# -> Int# -> Int#
79 uncheckedIShiftRA64# = uncheckedIShiftRA#
81 uncheckedIShiftL64# :: Int# -> Int# -> Int#
82 uncheckedIShiftL64# = uncheckedIShiftL#
88 ------------------------------------------------------------------------------
90 ------------------------------------------------------------------------------
92 -- Special Functions for Int, nice, easy and fast.
93 -- They should be small enough to be inlined automatically.
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
98 properFractionFloatInt :: Float -> (Int, Float)
99 properFractionFloatInt (F# x) =
101 then (I# 0#, F# 0.0#)
102 else case float2Int# x of
103 n -> (I# n, F# (x `minusFloat#` int2Float# n))
105 -- truncateFloatInt = float2Int
107 floorFloatInt :: Float -> Int
108 floorFloatInt (F# x) =
110 n | x `ltFloat#` int2Float# n -> I# (n -# 1#)
113 ceilingFloatInt :: Float -> Int
114 ceilingFloatInt (F# x) =
116 n | int2Float# n `ltFloat#` x -> I# (n +# 1#)
119 roundFloatInt :: Float -> Int
120 roundFloatInt x = float2Int (c_rintFloat x)
122 -- Functions with Integer results
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.
130 -- Note: For negative exponents, we must check the validity of the shift
131 -- distance for the right shifts of the mantissa.
133 {-# INLINE properFractionFloatInteger #-}
134 properFractionFloatInteger :: Float -> (Integer, Float)
135 properFractionFloatInteger v@(F# x) =
136 case decodeFloat_Int# x of
140 s | s ># 23# -> (0, v)
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))
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#)
153 {-# INLINE truncateFloatInteger #-}
154 truncateFloatInteger :: Float -> Integer
155 truncateFloatInteger x =
156 case properFractionFloatInteger x of
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
168 s | s ># 23# -> if m <# 0# then (-1) else 0
169 | otherwise -> smallInteger (m `uncheckedIShiftRA#` s)
170 | otherwise -> shiftLInteger (smallInteger m) e
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)))
180 {-# INLINE roundFloatInteger #-}
181 roundFloatInteger :: Float -> Integer
182 roundFloatInteger x = float2Integer (c_rintFloat x)
184 ------------------------------------------------------------------------------
186 ------------------------------------------------------------------------------
188 -- Special Functions for Int, nice, easy and fast.
189 -- They should be small enough to be inlined automatically.
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
194 properFractionDoubleInt :: Double -> (Int, Double)
195 properFractionDoubleInt (D# x) =
197 then (I# 0#, D# 0.0##)
198 else case double2Int# x of
199 n -> (I# n, D# (x -## int2Double# n))
201 -- truncateDoubleInt = double2Int
203 floorDoubleInt :: Double -> Int
204 floorDoubleInt (D# x) =
205 case double2Int# x of
206 n | x <## int2Double# n -> I# (n -# 1#)
209 ceilingDoubleInt :: Double -> Int
210 ceilingDoubleInt (D# x) =
211 case double2Int# x of
212 n | int2Double# n <## x -> I# (n +# 1#)
215 roundDoubleInt :: Double -> Int
216 roundDoubleInt x = double2Int (c_rintDouble x)
218 -- Functions with Integer results
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.
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
228 -- Note: For negative exponents, we must check the validity of the shift
229 -- distance for the right shifts of the mantissa.
231 {-# INLINE properFractionDoubleInteger #-}
232 properFractionDoubleInteger :: Double -> (Integer, Double)
233 properFractionDoubleInteger v@(D# x) =
234 case decodeDoubleInteger x of
238 s | s ># 52# -> (0, v)
240 case TO64 (negateInteger m) of
242 case n `uncheckedIShiftRA64#` s of
244 (FROM64 (NEGATE64 k),
245 case MINUS64 n (k `uncheckedIShiftL64#` s) of
247 D# (encodeDoubleInteger (FROM64 (NEGATE64 r)) e))
251 case n `uncheckedIShiftRA64#` s of
253 case MINUS64 n (k `uncheckedIShiftL64#` s) of
254 r -> D# (encodeDoubleInteger (FROM64 r) e))
255 | otherwise -> (shiftLInteger m e, D# 0.0##)
257 {-# INLINE truncateDoubleInteger #-}
258 truncateDoubleInteger :: Double -> Integer
259 truncateDoubleInteger x =
260 case properFractionDoubleInteger x of
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
272 s | s ># 52# -> if m < 0 then (-1) else 0
275 n -> FROM64 (n `uncheckedIShiftRA64#` s)
276 | otherwise -> shiftLInteger m e
278 {-# INLINE ceilingDoubleInteger #-}
279 ceilingDoubleInteger :: Double -> Integer
280 ceilingDoubleInteger (D# x) =
281 negateInteger (floorDoubleInteger (D# (negateDouble# x)))
283 {-# INLINE roundDoubleInteger #-}
284 roundDoubleInteger :: Double -> Integer
285 roundDoubleInteger x = double2Integer (c_rintDouble x)
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.
291 double2Int :: Double -> Int
292 double2Int (D# x) = I# (double2Int# x)
294 int2Double :: Int -> Double
295 int2Double (I# i) = D# (int2Double# i)
297 float2Int :: Float -> Int
298 float2Int (F# x) = I# (float2Int# x)
300 int2Float :: Int -> Float
301 int2Float (I# i) = F# (int2Float# i)
303 -- Quicker conversions from 'Double' and 'Float' to 'Integer',
304 -- assuming the floating point value is integral.
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.
310 {-# INLINE double2Integer #-}
311 double2Integer :: Double -> Integer
312 double2Integer (D# x) =
313 case decodeDoubleInteger x of
317 n -> FROM64 (n `uncheckedIShiftRA64#` negateInt# e)
318 | otherwise -> shiftLInteger m e
320 {-# INLINE float2Integer #-}
321 float2Integer :: Float -> Integer
322 float2Integer (F# x) =
323 case decodeFloat_Int# x of
325 | e <# 0# -> smallInteger (m `uncheckedIShiftRA#` negateInt# e)
326 | otherwise -> shiftLInteger (smallInteger m) e
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.
337 foreign import ccall unsafe "rintDouble"
338 c_rintDouble :: Double -> Double
340 foreign import ccall unsafe "rintFloat"
341 c_rintFloat :: Float -> Float