GHC/Float/RealFracMethods.hs

   1 {-# LANGUAGE CPP, MagicHash, UnboxedTuples, ForeignFunctionInterface,
   2     NoImplicitPrelude #-}
   3 {-# OPTIONS_HADDOCK hide #-}
   4 -----------------------------------------------------------------------------
   5 -- |
   6 -- Module      :  GHC.Float.RealFracMethods
   7 -- Copyright   :  (c) Daniel Fischer 2010
   8 -- License     :  see libraries/base/LICENSE
   9 --
  10 -- Maintainer  :  cvs-ghc@haskell.org
  11 -- Stability   :  internal
  12 -- Portability :  non-portable (GHC Extensions)
  13 --
  14 -- Methods for the RealFrac instances for 'Float' and 'Double',
  15 -- with specialised versions for 'Int'.
  16 --
  17 -- Moved to their own module to not bloat GHC.Float further.
  18 --
  19 -----------------------------------------------------------------------------
  20
  21 #include "MachDeps.h"
  22
  23 -- #hide
  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 toInt#
  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 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 | 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 | 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         | e <# 0#   ->
 139           case negateInt# e of
 140             s | s ># 23#    -> (0, v)
 141               | 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         | e <# 0#   ->
 167           case negateInt# e of
 168             s | s ># 23#    -> if 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 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 | 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 | 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         | e <# 0#   ->
 237           case negateInt# e of
 238             s | 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         | e <# 0#   ->
 271           case negateInt# e of
 272             s | 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         | 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         | 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