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

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

roundFloatInt :: Float -> Int
roundFloatInt :: Float -> Int
roundFloatInt x :: 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# x :: Float#
x) =
    case Float# -> (# Int#, Int# #)
decodeFloat_Int# Float#
x of
      (# m :: Int#
m, e :: Int#
e #)
        | Int# -> Bool
isTrue# (Int#
e Int# -> Int# -> Int#
<# 0#) ->
          case Int# -> Int#
negateInt# Int#
e of
            s :: Int#
s | Int# -> Bool
isTrue# (Int#
s Int# -> Int# -> Int#
># 23#) -> (0, Float
v)
              | Int# -> Bool
isTrue# (Int#
m Int# -> Int# -> Int#
<#  0#) ->
                case Int# -> Int#
negateInt# (Int# -> Int#
negateInt# Int#
m Int# -> Int# -> Int#
`uncheckedIShiftRA#` Int#
s) of
                  k :: Int#
k -> (Int# -> Integer
smallInteger Int#
k,
                            case Int#
m Int# -> Int# -> Int#
-# (Int#
k Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
s) of
                              r :: Int#
r -> Float# -> Float
F# (Integer -> Int# -> Float#
encodeFloatInteger (Int# -> Integer
smallInteger Int#
r) Int#
e))
              | Bool
otherwise           ->
                case Int#
m Int# -> Int# -> Int#
`uncheckedIShiftRL#` Int#
s of
                  k :: Int#
k -> (Int# -> Integer
smallInteger Int#
k,
                            case Int#
m Int# -> Int# -> Int#
-# (Int#
k Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
s) of
                              r :: Int#
r -> Float# -> Float
F# (Integer -> Int# -> Float#
encodeFloatInteger (Int# -> Integer
smallInteger Int#
r) Int#
e))
        | Bool
otherwise -> (Integer -> Int# -> Integer
shiftLInteger (Int# -> Integer
smallInteger Int#
m) Int#
e, Float# -> Float
F# 0.0#)

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

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

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

roundDoubleInt :: Double -> Int
roundDoubleInt :: Double -> Int
roundDoubleInt x :: 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# x :: Double#
x) =
    case Double# -> (# Integer, Int# #)
decodeDoubleInteger Double#
x of
      (# m :: Integer
m, e :: Int#
e #)
        | Int# -> Bool
isTrue# (Int#
e Int# -> Int# -> Int#
<# 0#) ->
          case Int# -> Int#
negateInt# Int#
e of
            s :: Int#
s | Int# -> Bool
isTrue# (Int#
s Int# -> Int# -> Int#
># 52#) -> (0, Double
v)
              | Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0                 ->
                case TO64 (negateInteger m) of
                  n :: Int#
n ->
                    case Int#
n Int# -> Int# -> Int#
`uncheckedIShiftRA64#` Int#
s of
                      k :: Int#
k ->
                        (FROM64 (NEGATE64 k),
                          case MINUS64 n Int#
(k `uncheckedIShiftL64#` s) of
                            r :: Int#
r ->
                              Double# -> Double
D# (Integer -> Int# -> Double#
encodeDoubleInteger (FROM64 (NEGATE64 r)) e))
              | Bool
otherwise           ->
                case TO64 m of
                  n :: Int#
n ->
                    case Int#
n Int# -> Int# -> Int#
`uncheckedIShiftRA64#` Int#
s of
                      k :: Int#
k -> (FROM64 k,
                            case MINUS64 n Int#
(k `uncheckedIShiftL64#` s) of
                              r :: Int#
r -> Double# -> Double
D# (Integer -> Int# -> Double#
encodeDoubleInteger (FROM64 r) e))
        | Bool
otherwise -> (Integer -> Int# -> Integer
shiftLInteger Integer
m Int#
e, Double# -> Double
D# 0.0##)

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

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

{-# INLINE roundDoubleInteger #-}
roundDoubleInteger :: Double -> Integer
roundDoubleInteger :: Double -> Integer
roundDoubleInteger x :: 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# x :: Double#
x) = Int# -> Int
I# (Double# -> Int#
double2Int# Double#
x)

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

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

int2Float :: Int -> Float
int2Float :: Int -> Float
int2Float (I# 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 shfts here.

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

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