    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
    {-# OPTIONS_HADDOCK not-home #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.Internal.Float.RealFracMethods
    -- Copyright   :  (c) Daniel Fischer 2010
    -- License     :  see libraries/base/LICENSE
    --
    -- Maintainer  :  ghc-devs@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.
    --
    -- /The API of this module is unstable and not meant to be consumed by the general public./
    -- If you absolutely must depend on it, make sure to use a tight upper
    -- bound, e.g., @base < 4.X@ rather than @base < 5@, because the interface can
    -- change rapidly without much warning.
    --
    -----------------------------------------------------------------------------

    #include "MachDeps.h"

    module GHC.Internal.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.Num.Integer

    import GHC.Internal.Base hiding (uncheckedIShiftRA64#, uncheckedIShiftL64#)
    import GHC.Internal.Num ()

    #if WORD_SIZE_IN_BITS < 64

    import GHC.Internal.Base (uncheckedIShiftRA64#, uncheckedIShiftL64#)

    #define TO64 integerToInt64#
    #define FROM64 integerFromInt64#
    #define MINUS64 subInt64#
    #define NEGATE64 negateInt64#

    #else

    #define TO64 integerToInt#
    #define FROM64 IS
    #define MINUS64 ( -# )
    #define NEGATE64 negateInt#

    uncheckedIShiftRA64# :: Int# -> Int# -> Int#
    uncheckedIShiftRA64# :: Int# -> Int# -> Int#
    uncheckedIShiftRA64# = Int# -> Int# -> Int#
    uncheckedIShiftRA#

    uncheckedIShiftL64# :: Int# -> Int# -> Int#
    uncheckedIShiftL64# :: Int# -> Int# -> Int#
    uncheckedIShiftL64# = Int# -> Int# -> Int#
    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 :: Float -> (Int, Float)
    properFractionFloatInt (F# Float#
    x) =
        if Int# -> Bool
    isTrue# (Float#
    x Float# -> Float# -> Int#
    `eqFloat#` Float#
    0.0#)
            then (Int# -> Int
    I# Int#
    0#, Float# -> Float
    F# Float#
    0.0#)
            else case Float# -> Int#
    float2Int# Float#
    x of
                    Int#
    n -> (Int# -> Int
    I# Int#
    n, Float# -> Float
    F# (Float#
    x Float# -> Float# -> Float#
    `minusFloat#` Int# -> Float#
    int2Float# Int#
    n))

    -- truncateFloatInt = float2Int

    floorFloatInt :: Float -> Int
    floorFloatInt :: Float -> Int
    floorFloatInt (F# Float#
    x) =
        case Float# -> Int#
    float2Int# Float#
    x of
          Int#
    n | Int# -> Bool
    isTrue# (Float#
    x Float# -> Float# -> Int#
    `ltFloat#` Int# -> Float#
    int2Float# Int#
    n) -> Int# -> Int
    I# (Int#
    n Int# -> Int# -> Int#
    -# Int#
    1#)
            | Bool
    otherwise                           -> Int# -> Int
    I# Int#
    n

    ceilingFloatInt :: Float -> Int
    ceilingFloatInt :: Float -> Int
    ceilingFloatInt (F# Float#
    x) =
        case Float# -> Int#
    float2Int# Float#
    x of
          Int#
    n | Int# -> Bool
    isTrue# (Int# -> Float#
    int2Float# Int#
    n Float# -> Float# -> Int#
    `ltFloat#` Float#
    x) -> Int# -> Int
    I# (Int#
    n Int# -> Int# -> Int#
    +# Int#
    1#)
            | Bool
    otherwise                           -> Int# -> Int
    I# Int#
    n

    roundFloatInt :: Float -> Int
    roundFloatInt :: Float -> Int
    roundFloatInt Float
    x = Float -> Int
    float2Int (Float -> Float
    c_rintFloat Float
    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 :: Float -> (Integer, Float)
    properFractionFloatInteger v :: Float
    v@(F# Float#
    x) =
        case Float# -> (# Int#, Int# #)
    decodeFloat_Int# Float#
    x of
          (# Int#
    m, Int#
    e #)
            | Int# -> Bool
    isTrue# (Int#
    e Int# -> Int# -> Int#
    <# Int#
    0#) ->
              case Int# -> Int#
    negateInt# Int#
    e of
                Int#
    s | Int# -> Bool
    isTrue# (Int#
    s Int# -> Int# -> Int#
    ># Int#
    23#) -> (Integer
    0, Float
    v)
                  | Int# -> Bool
    isTrue# (Int#
    m Int# -> Int# -> Int#
    <#  Int#
    0#) ->
                    case Int# -> Int#
    negateInt# (Int# -> Int#
    negateInt# Int#
    m Int# -> Int# -> Int#
    `uncheckedIShiftRA#` Int#
    s) of
                      Int#
    k -> (Int# -> Integer
    IS Int#
    k,
                                case Int#
    m Int# -> Int# -> Int#
    -# (Int#
    k Int# -> Int# -> Int#
    `uncheckedIShiftL#` Int#
    s) of
                                  Int#
    r -> Float# -> Float
    F# (Integer -> Int# -> Float#
    integerEncodeFloat# (Int# -> Integer
    IS Int#
    r) Int#
    e))
                  | Bool
    otherwise           ->
                    case Int#
    m Int# -> Int# -> Int#
    `uncheckedIShiftRL#` Int#
    s of
                      Int#
    k -> (Int# -> Integer
    IS Int#
    k,
                                case Int#
    m Int# -> Int# -> Int#
    -# (Int#
    k Int# -> Int# -> Int#
    `uncheckedIShiftL#` Int#
    s) of
                                  Int#
    r -> Float# -> Float
    F# (Integer -> Int# -> Float#
    integerEncodeFloat# (Int# -> Integer
    IS Int#
    r) Int#
    e))
            | Bool
    otherwise -> (Integer -> Word# -> Integer
    integerShiftL# (Int# -> Integer
    IS Int#
    m) (Int# -> Word#
    int2Word# Int#
    e), Float# -> Float
    F# Float#
    0.0#)

    {-# INLINE truncateFloatInteger #-}
    truncateFloatInteger :: Float -> Integer
    truncateFloatInteger :: Float -> Integer
    truncateFloatInteger Float
    x =
        case Float -> (Integer, Float)
    properFractionFloatInteger Float
    x of
          (Integer
    n, Float
    _) -> Integer
    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 :: Float -> Integer
    floorFloatInteger (F# Float#
    x) =
        case Float# -> (# Int#, Int# #)
    decodeFloat_Int# Float#
    x of
          (# Int#
    m, Int#
    e #)
            | Int# -> Bool
    isTrue# (Int#
    e Int# -> Int# -> Int#
    <# Int#
    0#) ->
              case Int# -> Int#
    negateInt# Int#
    e of
                Int#
    s | Int# -> Bool
    isTrue# (Int#
    s Int# -> Int# -> Int#
    ># Int#
    23#) -> if Int# -> Bool
    isTrue# (Int#
    m Int# -> Int# -> Int#
    <# Int#
    0#) then (-Integer
    1) else Integer
    0
                  | Bool
    otherwise          -> Int# -> Integer
    IS (Int#
    m Int# -> Int# -> Int#
    `uncheckedIShiftRA#` Int#
    s)
            | Bool
    otherwise -> Integer -> Word# -> Integer
    integerShiftL# (Int# -> Integer
    IS Int#
    m) (Int# -> Word#
    int2Word# Int#
    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 :: Float -> Integer
    ceilingFloatInteger (F# Float#
    x) =
        Integer -> Integer
    integerNegate (Float -> Integer
    floorFloatInteger (Float# -> Float
    F# (Float# -> Float#
    negateFloat# Float#
    x)))

    {-# INLINE roundFloatInteger #-}
    roundFloatInteger :: Float -> Integer
    roundFloatInteger :: Float -> Integer
    roundFloatInteger Float
    x = Float -> Integer
    float2Integer (Float -> Float
    c_rintFloat Float
    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 :: Double -> (Int, Double)
    properFractionDoubleInt (D# Double#
    x) =
        if Int# -> Bool
    isTrue# (Double#
    x Double# -> Double# -> Int#
    ==## Double#
    0.0##)
            then (Int# -> Int
    I# Int#
    0#, Double# -> Double
    D# Double#
    0.0##)
            else case Double# -> Int#
    double2Int# Double#
    x of
                    Int#
    n -> (Int# -> Int
    I# Int#
    n, Double# -> Double
    D# (Double#
    x Double# -> Double# -> Double#
    -## Int# -> Double#
    int2Double# Int#
    n))

    -- truncateDoubleInt = double2Int

    floorDoubleInt :: Double -> Int
    floorDoubleInt :: Double -> Int
    floorDoubleInt (D# Double#
    x) =
        case Double# -> Int#
    double2Int# Double#
    x of
          Int#
    n | Int# -> Bool
    isTrue# (Double#
    x Double# -> Double# -> Int#
    <## Int# -> Double#
    int2Double# Int#
    n) -> Int# -> Int
    I# (Int#
    n Int# -> Int# -> Int#
    -# Int#
    1#)
            | Bool
    otherwise                     -> Int# -> Int
    I# Int#
    n

    ceilingDoubleInt :: Double -> Int
    ceilingDoubleInt :: Double -> Int
    ceilingDoubleInt (D# Double#
    x) =
        case Double# -> Int#
    double2Int# Double#
    x of
          Int#
    n | Int# -> Bool
    isTrue# (Int# -> Double#
    int2Double# Int#
    n Double# -> Double# -> Int#
    <## Double#
    x) -> Int# -> Int
    I# (Int#
    n Int# -> Int# -> Int#
    +# Int#
    1#)
            | Bool
    otherwise                     -> Int# -> Int
    I# Int#
    n

    roundDoubleInt :: Double -> Int
    roundDoubleInt :: Double -> Int
    roundDoubleInt Double
    x = Double -> Int
    double2Int (Double -> Double
    c_rintDouble Double
    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 :: Double -> (Integer, Double)
    properFractionDoubleInteger v :: Double
    v@(D# Double#
    x) =
        case Double# -> (# Integer, Int# #)
    integerDecodeDouble# Double#
    x of
          (# Integer
    m, Int#
    e #)
            | Int# -> Bool
    isTrue# (Int#
    e Int# -> Int# -> Int#
    <# Int#
    0#) ->
              case Int# -> Int#
    negateInt# Int#
    e of
                Int#
    s | Int# -> Bool
    isTrue# (Int#
    s Int# -> Int# -> Int#
    ># Int#
    52#) -> (Integer
    0, Double
    v)
                  | Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0                 ->
                    case TO64 (integerNegate m) of
                      Int#
    n ->
                        case Int#
    n Int# -> Int# -> Int#
    `uncheckedIShiftRA64#` Int#
    s of
                          Int#
    k ->
                            (FROM64 (NEGATE64 k),
                              case MINUS64 n Int#
    (k `uncheckedIShiftL64#` s) of
                                Int#
    r ->
                                  Double# -> Double
    D# (Integer -> Int# -> Double#
    integerEncodeDouble# (FROM64 (NEGATE64 r)Int#
    ) e))
                  | Bool
    otherwise           ->
                    case TO64 m of
                      Int#
    n ->
                        case Int#
    n Int# -> Int# -> Int#
    `uncheckedIShiftRA64#` Int#
    s of
                          Int#
    k -> (FROM64 k,
                                case MINUS64 n Int#
    (k `uncheckedIShiftL64#` s) of
                                  Int#
    r -> Double# -> Double
    D# (Integer -> Int# -> Double#
    integerEncodeDouble# (FROM64 r) e))
            | Bool
    otherwise -> (Integer -> Word# -> Integer
    integerShiftL# Integer
    m (Int# -> Word#
    int2Word# Int#
    e), Double# -> Double
    D# Double#
    0.0##)

    {-# INLINE truncateDoubleInteger #-}
    truncateDoubleInteger :: Double -> Integer
    truncateDoubleInteger :: Double -> Integer
    truncateDoubleInteger Double
    x =
        case Double -> (Integer, Double)
    properFractionDoubleInteger Double
    x of
          (Integer
    n, Double
    _) -> Integer
    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 :: Double -> Integer
    floorDoubleInteger (D# Double#
    x) =
        case Double# -> (# Integer, Int# #)
    integerDecodeDouble# Double#
    x of
          (# Integer
    m, Int#
    e #)
            | Int# -> Bool
    isTrue# (Int#
    e Int# -> Int# -> Int#
    <# Int#
    0#) ->
              case Int# -> Int#
    negateInt# Int#
    e of
                Int#
    s | Int# -> Bool
    isTrue# (Int#
    s Int# -> Int# -> Int#
    ># Int#
    52#) -> if Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0 then (-Integer
    1) else Integer
    0
                  | Bool
    otherwise          ->
                    case TO64 m of
                      Int#
    n -> FROM64 (n `uncheckedIShiftRA64#` s)
            | Bool
    otherwise -> Integer -> Word# -> Integer
    integerShiftL# Integer
    m (Int# -> Word#
    int2Word# Int#
    e)

    {-# INLINE ceilingDoubleInteger #-}
    ceilingDoubleInteger :: Double -> Integer
    ceilingDoubleInteger :: Double -> Integer
    ceilingDoubleInteger (D# Double#
    x) =
        Integer -> Integer
    integerNegate (Double -> Integer
    floorDoubleInteger (Double# -> Double
    D# (Double# -> Double#
    negateDouble# Double#
    x)))

    {-# INLINE roundDoubleInteger #-}
    roundDoubleInteger :: Double -> Integer
    roundDoubleInteger :: Double -> Integer
    roundDoubleInteger Double
    x = Double -> Integer
    double2Integer (Double -> Double
    c_rintDouble Double
    x)

    -- Wrappers around double2Int#, int2Double#, float2Int# and int2Float#,
    -- we need them here, so we move them from GHC.Internal.Float and re-export them
    -- explicitly from there.

    double2Int :: Double -> Int
    double2Int :: Double -> Int
    double2Int (D# Double#
    x) = Int# -> Int
    I# (Double# -> Int#
    double2Int# Double#
    x)

    int2Double :: Int -> Double
    int2Double :: Int -> Double
    int2Double (I# Int#
    i) = Double# -> Double
    D# (Int# -> Double#
    int2Double# Int#
    i)

    float2Int :: Float -> Int
    float2Int :: Float -> Int
    float2Int (F# Float#
    x) = Int# -> Int
    I# (Float# -> Int#
    float2Int# Float#
    x)

    int2Float :: Int -> Float
    int2Float :: Int -> Float
    int2Float (I# Int#
    i) = Float# -> Float
    F# (Int# -> Float#
    int2Float# Int#
    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 shifts here.

    {-# INLINE double2Integer #-}
    double2Integer :: Double -> Integer
    double2Integer :: Double -> Integer
    double2Integer (D# Double#
    x) =
        case Double# -> (# Integer, Int# #)
    integerDecodeDouble# Double#
    x of
          (# Integer
    m, Int#
    e #)
            | Int# -> Bool
    isTrue# (Int#
    e Int# -> Int# -> Int#
    <# Int#
    0#) ->
              case TO64 m of
                Int#
    n -> FROM64 (n `uncheckedIShiftRA64#` negateInt# e)
            | Bool
    otherwise -> Integer -> Word# -> Integer
    integerShiftL# Integer
    m (Int# -> Word#
    int2Word# Int#
    e)

    {-# INLINE float2Integer #-}
    float2Integer :: Float -> Integer
    float2Integer :: Float -> Integer
    float2Integer (F# Float#
    x) =
        case Float# -> (# Int#, Int# #)
    decodeFloat_Int# Float#
    x of
          (# Int#
    m, Int#
    e #)
            | Int# -> Bool
    isTrue# (Int#
    e Int# -> Int# -> Int#
    <# Int#
    0#) -> Int# -> Integer
    IS (Int#
    m Int# -> Int# -> Int#
    `uncheckedIShiftRA#` Int# -> Int#
    negateInt# Int#
    e)
            | Bool
    otherwise         -> Integer -> Word# -> Integer
    integerShiftL# (Int# -> Integer
    IS Int#
    m) (Int# -> Word#
    int2Word# Int#
    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