content: {-# LANGUAGE Trustworthy #-}
  {-# LANGUAGE CPP, MagicHash, UnboxedTuples, ForeignFunctionInterface,
      NoImplicitPrelude #-}
  {-# OPTIONS_HADDOCK hide #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  GHC.Float.RealFracMethods
  -- Copyright   :  (c) Daniel Fischer 2010
  -- License     :  see libraries/base/LICENSE
  --
  -- Maintainer  :  cvs-ghc@haskell.org
  -- Stability   :  internal
  -- Portability :  non-portable (GHC Extensions)
  --
  -- Methods for the RealFrac instances for 'Float' and 'Double',
  -- with specialised versions for 'Int'.
  --
  -- Moved to their own module to not bloat GHC.Float further.
  --
  -----------------------------------------------------------------------------
  
  #include "MachDeps.h"
  
  -- #hide
  module GHC.Float.RealFracMethods
      ( -- * Double methods
        -- ** Integer results
        properFractionDoubleInteger
      , truncateDoubleInteger
      , floorDoubleInteger
      , ceilingDoubleInteger
      , roundDoubleInteger
        -- ** Int results
      , properFractionDoubleInt
      , floorDoubleInt
      , ceilingDoubleInt
      , roundDoubleInt
        -- * Double/Int conversions, wrapped primops
      , double2Int
      , int2Double
        -- * Float methods
        -- ** Integer results
      , properFractionFloatInteger
      , truncateFloatInteger
      , floorFloatInteger
      , ceilingFloatInteger
      , roundFloatInteger
        -- ** Int results
      , properFractionFloatInt
      , floorFloatInt
      , ceilingFloatInt
      , roundFloatInt
        -- * Float/Int conversions, wrapped primops
      , float2Int
      , int2Float
      ) where
  
  import GHC.Integer
  
  import GHC.Base
  import GHC.Num ()
  
  #if WORD_SIZE_IN_BITS < 64
  
  import GHC.IntWord64
  
  #define TO64 integerToInt64
  #define FROM64 int64ToInteger
  #define MINUS64 minusInt64#
  #define NEGATE64 negateInt64#
  
  #else
  
  #define TO64 integerToInt
  #define FROM64 smallInteger
  #define MINUS64 ( -# )
  #define NEGATE64 negateInt#
  
  uncheckedIShiftRA64# :: Int# -> Int# -> Int#
  uncheckedIShiftRA64# = uncheckedIShiftRA#
  
  uncheckedIShiftL64# :: Int# -> Int# -> Int#
  uncheckedIShiftL64# = uncheckedIShiftL#
  
  #endif
  
  default ()
  
  ------------------------------------------------------------------------------
  --                              Float Methods                               --
  ------------------------------------------------------------------------------
  
  -- Special Functions for Int, nice, easy and fast.
  -- They should be small enough to be inlined automatically.
  
  -- We have to test for ±0.0 to avoid returning -0.0 in the second
  -- component of the pair. Unfortunately the branching costs a lot
  -- of performance.
  properFractionFloatInt :: Float -> (Int, Float)
  properFractionFloatInt (F# x) =
      if x `eqFloat#` 0.0#
          then (I# 0#, F# 0.0#)
          else case float2Int# x of
                  n -> (I# n, F# (x `minusFloat#` int2Float# n))
  
  -- truncateFloatInt = float2Int
  
  floorFloatInt :: Float -> Int
  floorFloatInt (F# x) =
      case float2Int# x of
        n | x `ltFloat#` int2Float# n -> I# (n -# 1#)
          | otherwise                 -> I# n
  
  ceilingFloatInt :: Float -> Int
  ceilingFloatInt (F# x) =
      case float2Int# x of
        n | int2Float# n `ltFloat#` x  -> I# (n +# 1#)
          | otherwise                 -> I# n
  
  roundFloatInt :: Float -> Int
  roundFloatInt x = float2Int (c_rintFloat x)
  
  -- Functions with Integer results
  
  -- With the new code generator in GHC 7, the explicit bit-fiddling is
  -- slower than the old code for values of small modulus, but when the
  -- 'Int' range is left, the bit-fiddling quickly wins big, so we use that.
  -- If the methods are called on smallish values, hopefully people go
  -- through Int and not larger types.
  
  -- Note: For negative exponents, we must check the validity of the shift
  -- distance for the right shifts of the mantissa.
  
  {-# INLINE properFractionFloatInteger #-}
  properFractionFloatInteger :: Float -> (Integer, Float)
  properFractionFloatInteger v@(F# x) =
      case decodeFloat_Int# x of
        (# m, e #)
          | e <# 0#   ->
            case negateInt# e of
              s | s ># 23#    -> (0, v)
                | m <# 0#     ->
                  case negateInt# (negateInt# m `uncheckedIShiftRA#` s) of
                    k -> (smallInteger k,
                              case m -# (k `uncheckedIShiftL#` s) of
                                r -> F# (encodeFloatInteger (smallInteger r) e))
                | otherwise           ->
                  case m `uncheckedIShiftRL#` s of
                    k -> (smallInteger k,
                              case m -# (k `uncheckedIShiftL#` s) of
                                r -> F# (encodeFloatInteger (smallInteger r) e))
          | otherwise -> (shiftLInteger (smallInteger m) e, F# 0.0#)
  
  {-# INLINE truncateFloatInteger #-}
  truncateFloatInteger :: Float -> Integer
  truncateFloatInteger x =
      case properFractionFloatInteger x of
        (n, _) -> n
  
  -- floor is easier for negative numbers than truncate, so this gets its
  -- own implementation, it's a little faster.
  {-# INLINE floorFloatInteger #-}
  floorFloatInteger :: Float -> Integer
  floorFloatInteger (F# x) =
      case decodeFloat_Int# x of
        (# m, e #)
          | e <# 0#   ->
            case negateInt# e of
              s | s ># 23#    -> if m <# 0# then (-1) else 0
                | otherwise   -> smallInteger (m `uncheckedIShiftRA#` s)
          | otherwise -> shiftLInteger (smallInteger m) e
  
  -- ceiling x = -floor (-x)
  -- If giving this its own implementation is faster at all,
  -- it's only marginally so, hence we keep it short.
  {-# INLINE ceilingFloatInteger #-}
  ceilingFloatInteger :: Float -> Integer
  ceilingFloatInteger (F# x) =
      negateInteger (floorFloatInteger (F# (negateFloat# x)))
  
  {-# INLINE roundFloatInteger #-}
  roundFloatInteger :: Float -> Integer
  roundFloatInteger x = float2Integer (c_rintFloat x)
  
  ------------------------------------------------------------------------------
  --                              Double Methods                              --
  ------------------------------------------------------------------------------
  
  -- Special Functions for Int, nice, easy and fast.
  -- They should be small enough to be inlined automatically.
  
  -- We have to test for ±0.0 to avoid returning -0.0 in the second
  -- component of the pair. Unfortunately the branching costs a lot
  -- of performance.
  properFractionDoubleInt :: Double -> (Int, Double)
  properFractionDoubleInt (D# x) =
      if x ==## 0.0##
          then (I# 0#, D# 0.0##)
          else case double2Int# x of
                  n -> (I# n, D# (x -## int2Double# n))
  
  -- truncateDoubleInt = double2Int
  
  floorDoubleInt :: Double -> Int
  floorDoubleInt (D# x) =
      case double2Int# x of
        n | x <## int2Double# n   -> I# (n -# 1#)
          | otherwise             -> I# n
  
  ceilingDoubleInt :: Double -> Int
  ceilingDoubleInt (D# x) =
      case double2Int# x of
        n | int2Double# n <## x   -> I# (n +# 1#)
          | otherwise             -> I# n
  
  roundDoubleInt :: Double -> Int
  roundDoubleInt x = double2Int (c_rintDouble x)
  
  -- Functions with Integer results
  
  -- The new Code generator isn't quite as good for the old 'Double' code
  -- as for the 'Float' code, so for 'Double' the bit-fiddling also wins
  -- when the values have small modulus.
  
  -- When the exponent is negative, all mantissae have less than 64 bits
  -- and the right shifting of sized types is much faster than that of
  -- 'Integer's, especially when we can
  
  -- Note: For negative exponents, we must check the validity of the shift
  -- distance for the right shifts of the mantissa.
  
  {-# INLINE properFractionDoubleInteger #-}
  properFractionDoubleInteger :: Double -> (Integer, Double)
  properFractionDoubleInteger v@(D# x) =
      case decodeDoubleInteger x of
        (# m, e #)
          | e <# 0#   ->
            case negateInt# e of
              s | s ># 52#    -> (0, v)
                | m < 0       ->
                  case TO64 (negateInteger m) of
                    n ->
                      case n `uncheckedIShiftRA64#` s of
                        k ->
                          (FROM64 (NEGATE64 k),
                            case MINUS64 n (k `uncheckedIShiftL64#` s) of
                              r ->
                                D# (encodeDoubleInteger (FROM64 (NEGATE64 r)) e))
                | otherwise           ->
                  case TO64 m of
                    n ->
                      case n `uncheckedIShiftRA64#` s of
                        k -> (FROM64 k,
                              case MINUS64 n (k `uncheckedIShiftL64#` s) of
                                r -> D# (encodeDoubleInteger (FROM64 r) e))
          | otherwise -> (shiftLInteger m e, D# 0.0##)
  
  {-# INLINE truncateDoubleInteger #-}
  truncateDoubleInteger :: Double -> Integer
  truncateDoubleInteger x =
      case properFractionDoubleInteger x of
        (n, _) -> n
  
  -- floor is easier for negative numbers than truncate, so this gets its
  -- own implementation, it's a little faster.
  {-# INLINE floorDoubleInteger #-}
  floorDoubleInteger :: Double -> Integer
  floorDoubleInteger (D# x) =
      case decodeDoubleInteger x of
        (# m, e #)
          | e <# 0#   ->
            case negateInt# e of
              s | s ># 52#    -> if m < 0 then (-1) else 0
                | otherwise   ->
                  case TO64 m of
                    n -> FROM64 (n `uncheckedIShiftRA64#` s)
          | otherwise -> shiftLInteger m e
  
  {-# INLINE ceilingDoubleInteger #-}
  ceilingDoubleInteger :: Double -> Integer
  ceilingDoubleInteger (D# x) =
      negateInteger (floorDoubleInteger (D# (negateDouble# x)))
  
  {-# INLINE roundDoubleInteger #-}
  roundDoubleInteger :: Double -> Integer
  roundDoubleInteger x = double2Integer (c_rintDouble x)
  
  -- Wrappers around double2Int#, int2Double#, float2Int# and int2Float#,
  -- we need them here, so we move them from GHC.Float and re-export them
  -- explicitly from there.
  
  double2Int :: Double -> Int
  double2Int (D# x) = I# (double2Int# x)
  
  int2Double :: Int -> Double
  int2Double (I# i) = D# (int2Double# i)
  
  float2Int :: Float -> Int
  float2Int (F# x) = I# (float2Int# x)
  
  int2Float :: Int -> Float
  int2Float (I# i) = F# (int2Float# i)
  
  -- Quicker conversions from 'Double' and 'Float' to 'Integer',
  -- assuming the floating point value is integral.
  --
  -- Note: Since the value is integral, the exponent can't be less than
  -- (-TYP_MANT_DIG), so we need not check the validity of the shift
  -- distance for the right shfts here.
  
  {-# INLINE double2Integer #-}
  double2Integer :: Double -> Integer
  double2Integer (D# x) =
      case decodeDoubleInteger x of
        (# m, e #)
          | e <# 0#   ->
            case TO64 m of
              n -> FROM64 (n `uncheckedIShiftRA64#` negateInt# e)
          | otherwise -> shiftLInteger m e
  
  {-# INLINE float2Integer #-}
  float2Integer :: Float -> Integer
  float2Integer (F# x) =
      case decodeFloat_Int# x of
        (# m, e #)
          | e <# 0#   -> smallInteger (m `uncheckedIShiftRA#` negateInt# e)
          | otherwise -> shiftLInteger (smallInteger m) e
  
  -- Foreign imports, the rounding is done faster in C when the value
  -- isn't integral, so we call out for rounding. For values of large
  -- modulus, calling out to C is slower than staying in Haskell, but
  -- presumably 'round' is mostly called for values with smaller modulus,
  -- when calling out to C is a major win.
  -- For all other functions, calling out to C gives at most a marginal
  -- speedup for values of small modulus and is much slower than staying
  -- in Haskell for values of large modulus, so those are done in Haskell.
  
  foreign import ccall unsafe "rintDouble"
      c_rintDouble :: Double -> Double
  
  foreign import ccall unsafe "rintFloat"
      c_rintFloat :: Float -> Float
  
  