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

-----------------------------------------------------------------------------
-- |
-- 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"

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.Num.Integer

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

#if WORD_SIZE_IN_BITS < 64

import GHC.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.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