```{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Numeric.Floating.IEEE.Internal.RoundToIntegral
( round'
, roundAway'
, truncate'
, ceiling'
, floor'
, round
, roundAway
, truncate
, ceiling
, floor
) where
import           MyPrelude

default ()

-- \$setup
-- >>> :set -XScopedTypeVariables
-- >>> import Numeric.Floating.IEEE.Internal.Classify (isFinite)

-- |
-- @'round'' x@ returns the nearest integral value to @x@; the even integer if @x@ is equidistant between two integers.
--
-- IEEE 754 @roundToIntegralTiesToEven@ operation.
--
-- prop> \(x :: Double) -> isFinite x ==> (round' x == fromInteger (round x))
-- >>> round' (-0.5)
-- -0.0
round' :: RealFloat a => a -> a
round' :: a -> a
round' a
x | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x
round' a
x = case a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round a
x of
Integer
0 | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 -> -a
0
| Bool
otherwise -> a
0
Integer
n -> Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n
{-# NOINLINE [1] round' #-}

-- |
-- @'roundAway'' x@ returns the nearest integral value to @x@; the one with larger magnitude is returned if @x@ is equidistant between two integers.
--
-- IEEE 754 @roundToIntegralTiesToAway@ operation.
--
-- prop> \(x :: Double) -> isFinite x ==> roundAway' x == fromInteger (roundAway x)
-- >>> roundAway' (-0.5)
-- -1.0
-- >>> roundAway' (-0.4)
-- -0.0
roundAway' :: RealFloat a => a -> a
roundAway' :: a -> a
roundAway' a
x | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x
roundAway' a
x = case a -> (Integer, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction a
x of
-- x == n + f, signum x == signum f, 0 <= abs f < 1
(Integer
n,a
r) -> if a -> a
forall a. Num a => a -> a
abs a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0.5 then
-- round toward zero
if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then
a
0.0 a -> a -> a
forall a. Num a => a -> a -> a
* a
r -- signed zero
else
Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n
else
-- round away from zero
if a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then
Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
else
Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
{-# NOINLINE [1] roundAway' #-}

-- |
-- @'truncate'' x@ returns the integral value nearest to @x@, and whose magnitude is not greater than that of @x@.
--
-- IEEE 754 @roundToIntegralTowardZero@ operation.
--
-- prop> \(x :: Double) -> isFinite x ==> truncate' x == fromInteger (truncate x)
-- >>> truncate' (-0.5)
-- -0.0
truncate' :: RealFloat a => a -> a
truncate' :: a -> a
truncate' a
x | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x
truncate' a
x = case a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate a
x of
Integer
0 | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 -> -a
0
| Bool
otherwise -> a
0
Integer
n -> Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n
{-# NOINLINE [1] truncate' #-}

-- |
-- @'ceiling'' x@ returns the least integral value that is not less than @x@.
--
-- IEEE 754 @roundToIntegralTowardPositive@ operation.
--
-- prop> \(x :: Double) -> isFinite x ==> ceiling' x == fromInteger (ceiling x)
-- >>> ceiling' (-0.8)
-- -0.0
-- >>> ceiling' (-0.5)
-- -0.0
ceiling' :: RealFloat a => a -> a
ceiling' :: a -> a
ceiling' a
x | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x
ceiling' a
x = case a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling a
x of
Integer
0 | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 -> -a
0
| Bool
otherwise -> a
0
Integer
n -> Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n
{-# NOINLINE [1] ceiling' #-}

-- |
-- @'floor'' x@ returns the greatest integral value that is not greater than @x@.
--
-- IEEE 754 @roundToIntegralTowardNegative@ operation.
--
-- prop> \(x :: Double) -> isFinite x ==> floor' x == fromInteger (floor x)
-- >>> floor' (-0.1)
-- -1.0
-- >>> floor' (-0)
-- -0.0
floor' :: RealFloat a => a -> a
floor' :: a -> a
floor' a
x | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x
| Bool
otherwise = Integer -> a
forall a. Num a => Integer -> a
fromInteger (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor a
x)
{-# NOINLINE [1] floor' #-}

-- |
-- @'roundAway' x@ returns the nearest integer to @x@; the integer with larger magnitude is returned if @x@ is equidistant between two integers.
--
-- IEEE 754 @convertToIntegerTiesToAway@ operation.
--
-- >>> roundAway 4.5
-- 5
roundAway :: (RealFrac a, Integral b) => a -> b
roundAway :: a -> b
roundAway a
x = case a -> (b, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction a
x of
-- x == n + f, signum x == signum f, 0 <= abs f < 1
(b
n,a
r) -> if a -> a
forall a. Num a => a -> a
abs a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0.5 then
b
n
else
if a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then
b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1
else
b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1
{-# INLINE roundAway #-}

#ifdef USE_FFI

foreign import ccall unsafe "ceilf"
c_ceilFloat :: Float -> Float
foreign import ccall unsafe "ceil"
c_ceilDouble :: Double -> Double
foreign import ccall unsafe "floorf"
c_floorFloat :: Float -> Float
foreign import ccall unsafe "floor"
c_floorDouble :: Double -> Double
foreign import ccall unsafe "roundf"
c_roundFloat :: Float -> Float -- ties to away
foreign import ccall unsafe "round"
c_roundDouble :: Double -> Double -- ties to away
foreign import ccall unsafe "truncf"
c_truncFloat :: Float -> Float
foreign import ccall unsafe "trunc"
c_truncDouble :: Double -> Double

{-# RULES
"roundAway'/Float"
roundAway' = c_roundFloat
"roundAway'/Double"
roundAway' = c_roundDouble
"truncate'/Float"
truncate' = c_truncFloat
"truncate'/Double"
truncate' = c_truncDouble
"ceiling'/Float"
ceiling' = c_ceilFloat
"ceiling'/Double"
ceiling' = c_ceilDouble
"floor'/Float"
floor' = c_floorFloat
"floor'/Double"
floor' = c_floorDouble
#-}

{- from base
foreign import ccall unsafe "rintFloat"
c_rintFloat :: Float -> Float
foreign import ccall unsafe "rintDouble"
c_rintDouble :: Double -> Double
-}
#if defined(HAS_FAST_ROUNDEVEN)
foreign import ccall unsafe "hs_roundevenFloat"
c_roundevenFloat :: Float -> Float
foreign import ccall unsafe "hs_roundevenDouble"
c_roundevenDouble :: Double -> Double

{-# RULES
"round'/Float"
round' = c_roundevenFloat
"round'/Double"
round' = c_roundevenDouble
#-}
#endif

#endif
```