{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK not-home #-}
#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.Num.Integer
import GHC.Base
import GHC.Num ()
#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64
#define TO64 integerToInt64#
#define FROM64 integerFromInt64#
#define MINUS64 minusInt64#
#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 ()
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))
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)
{-# 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
{-# 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)
{-# 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)
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))
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)
{-# 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
{-# 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)
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)
{-# 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 import ccall unsafe "rintDouble"
c_rintDouble :: Double -> Double
foreign import ccall unsafe "rintFloat"
c_rintFloat :: Float -> Float