#include "MachDeps.h"
module GHC.Float.RealFracMethods
(
properFractionDoubleInteger
, truncateDoubleInteger
, floorDoubleInteger
, ceilingDoubleInteger
, roundDoubleInteger
, properFractionDoubleInt
, floorDoubleInt
, ceilingDoubleInt
, roundDoubleInt
, double2Int
, int2Double
, properFractionFloatInteger
, truncateFloatInteger
, floorFloatInteger
, ceilingFloatInteger
, roundFloatInteger
, properFractionFloatInt
, floorFloatInt
, ceilingFloatInt
, roundFloatInt
, 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 ()
properFractionFloatInt :: Float -> (Int, Float)
properFractionFloatInt (F# x) =
if isTrue# (x `eqFloat#` 0.0#)
then (I# 0#, F# 0.0#)
else case float2Int# x of
n -> (I# n, F# (x `minusFloat#` int2Float# n))
floorFloatInt :: Float -> Int
floorFloatInt (F# x) =
case float2Int# x of
n | isTrue# (x `ltFloat#` int2Float# n) -> I# (n -# 1#)
| otherwise -> I# n
ceilingFloatInt :: Float -> Int
ceilingFloatInt (F# x) =
case float2Int# x of
n | isTrue# (int2Float# n `ltFloat#` x) -> I# (n +# 1#)
| otherwise -> I# n
roundFloatInt :: Float -> Int
roundFloatInt x = float2Int (c_rintFloat x)
properFractionFloatInteger :: Float -> (Integer, Float)
properFractionFloatInteger v@(F# x) =
case decodeFloat_Int# x of
(# m, e #)
| isTrue# (e <# 0#) ->
case negateInt# e of
s | isTrue# (s ># 23#) -> (0, v)
| isTrue# (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#)
truncateFloatInteger :: Float -> Integer
truncateFloatInteger x =
case properFractionFloatInteger x of
(n, _) -> n
floorFloatInteger :: Float -> Integer
floorFloatInteger (F# x) =
case decodeFloat_Int# x of
(# m, e #)
| isTrue# (e <# 0#) ->
case negateInt# e of
s | isTrue# (s ># 23#) -> if isTrue# (m <# 0#) then (1) else 0
| otherwise -> smallInteger (m `uncheckedIShiftRA#` s)
| otherwise -> shiftLInteger (smallInteger m) e
ceilingFloatInteger :: Float -> Integer
ceilingFloatInteger (F# x) =
negateInteger (floorFloatInteger (F# (negateFloat# x)))
roundFloatInteger :: Float -> Integer
roundFloatInteger x = float2Integer (c_rintFloat x)
properFractionDoubleInt :: Double -> (Int, Double)
properFractionDoubleInt (D# x) =
if isTrue# (x ==## 0.0##)
then (I# 0#, D# 0.0##)
else case double2Int# x of
n -> (I# n, D# (x -## int2Double# n))
floorDoubleInt :: Double -> Int
floorDoubleInt (D# x) =
case double2Int# x of
n | isTrue# (x <## int2Double# n) -> I# (n -# 1#)
| otherwise -> I# n
ceilingDoubleInt :: Double -> Int
ceilingDoubleInt (D# x) =
case double2Int# x of
n | isTrue# (int2Double# n <## x) -> I# (n +# 1#)
| otherwise -> I# n
roundDoubleInt :: Double -> Int
roundDoubleInt x = double2Int (c_rintDouble x)
properFractionDoubleInteger :: Double -> (Integer, Double)
properFractionDoubleInteger v@(D# x) =
case decodeDoubleInteger x of
(# m, e #)
| isTrue# (e <# 0#) ->
case negateInt# e of
s | isTrue# (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##)
truncateDoubleInteger :: Double -> Integer
truncateDoubleInteger x =
case properFractionDoubleInteger x of
(n, _) -> n
floorDoubleInteger :: Double -> Integer
floorDoubleInteger (D# x) =
case decodeDoubleInteger x of
(# m, e #)
| isTrue# (e <# 0#) ->
case negateInt# e of
s | isTrue# (s ># 52#) -> if m < 0 then (1) else 0
| otherwise ->
case TO64 m of
n -> FROM64 (n `uncheckedIShiftRA64#` s)
| otherwise -> shiftLInteger m e
ceilingDoubleInteger :: Double -> Integer
ceilingDoubleInteger (D# x) =
negateInteger (floorDoubleInteger (D# (negateDouble# x)))
roundDoubleInteger :: Double -> Integer
roundDoubleInteger x = double2Integer (c_rintDouble x)
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)
double2Integer :: Double -> Integer
double2Integer (D# x) =
case decodeDoubleInteger x of
(# m, e #)
| isTrue# (e <# 0#) ->
case TO64 m of
n -> FROM64 (n `uncheckedIShiftRA64#` negateInt# e)
| otherwise -> shiftLInteger m e
float2Integer :: Float -> Integer
float2Integer (F# x) =
case decodeFloat_Int# x of
(# m, e #)
| isTrue# (e <# 0#) -> smallInteger (m `uncheckedIShiftRA#` negateInt# e)
| otherwise -> shiftLInteger (smallInteger m) e
foreign import ccall unsafe "rintDouble"
c_rintDouble :: Double -> Double
foreign import ccall unsafe "rintFloat"
c_rintFloat :: Float -> Float