(original) (raw)

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

#include "MachDeps.h"

module GHC.Float.RealFracMethods (

  [properFractionDoubleInteger](GHC.Float.RealFracMethods.html#properFractionDoubleInteger)
, [truncateDoubleInteger](GHC.Float.RealFracMethods.html#truncateDoubleInteger)
, [floorDoubleInteger](GHC.Float.RealFracMethods.html#floorDoubleInteger)
, [ceilingDoubleInteger](GHC.Float.RealFracMethods.html#ceilingDoubleInteger)
, [roundDoubleInteger](GHC.Float.RealFracMethods.html#roundDoubleInteger)
  
, [properFractionDoubleInt](GHC.Float.RealFracMethods.html#properFractionDoubleInt)
, [floorDoubleInt](GHC.Float.RealFracMethods.html#floorDoubleInt)
, [ceilingDoubleInt](GHC.Float.RealFracMethods.html#ceilingDoubleInt)
, [roundDoubleInt](GHC.Float.RealFracMethods.html#roundDoubleInt)
  
, [double2Int](GHC.Float.RealFracMethods.html#double2Int)
, [int2Double](GHC.Float.RealFracMethods.html#int2Double)
  
  
, [properFractionFloatInteger](GHC.Float.RealFracMethods.html#properFractionFloatInteger)
, [truncateFloatInteger](GHC.Float.RealFracMethods.html#truncateFloatInteger)
, [floorFloatInteger](GHC.Float.RealFracMethods.html#floorFloatInteger)
, [ceilingFloatInteger](GHC.Float.RealFracMethods.html#ceilingFloatInteger)
, [roundFloatInteger](GHC.Float.RealFracMethods.html#roundFloatInteger)
  
, [properFractionFloatInt](GHC.Float.RealFracMethods.html#properFractionFloatInt)
, [floorFloatInt](GHC.Float.RealFracMethods.html#floorFloatInt)
, [ceilingFloatInt](GHC.Float.RealFracMethods.html#ceilingFloatInt)
, [roundFloatInt](GHC.Float.RealFracMethods.html#roundFloatInt)
  
, [float2Int](GHC.Float.RealFracMethods.html#float2Int)
, [int2Float](GHC.Float.RealFracMethods.html#int2Float)
) where

import GHC.Num.Integer

import GHC.Base import GHC.Num ()

#if WORD_SIZE_IN_BITS < 64

#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 ()

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