{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Numeric.Floating.IEEE.Internal.RoundToIntegral
  ( round'
  , roundAway'
  , truncate'
  , ceiling'
  , floor'
  , round
  , roundAway
  , truncate
  , ceiling
  , floor
  ) where
import           MyPrelude
#if defined(USE_FFI) && defined(SOME_LIBC_FUNCTIONS_MIGHT_BE_BUGGY)
import           Numeric.Floating.IEEE.Internal.Conversion
#endif

default ()

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

-- |
-- @'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' :: forall a. RealFloat a => a -> a
round' a
x | forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero a
x = a
x forall a. Num a => a -> a -> a
+ a
x
round' a
x = case forall a b. (RealFrac a, Integral b) => a -> b
round a
x of
             Integer
0 | a
x forall a. Ord a => a -> a -> Bool
< a
0 -> -a
0
               | Bool
otherwise -> a
0
             Integer
n -> 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' :: forall a. RealFloat a => a -> a
roundAway' a
x | forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero a
x = a
x forall a. Num a => a -> a -> a
+ a
x
roundAway' a
x = case 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 forall a. Num a => a -> a
abs a
r forall a. Ord a => a -> a -> Bool
< a
0.5 then
                            -- round toward zero
                            if Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0 then
                              a
0.0 forall a. Num a => a -> a -> a
* a
r -- signed zero
                            else
                              forall a. Num a => Integer -> a
fromInteger Integer
n
                          else
                            -- round away from zero
                            if a
r forall a. Ord a => a -> a -> Bool
< a
0 then
                              forall a. Num a => Integer -> a
fromInteger (Integer
n forall a. Num a => a -> a -> a
- Integer
1)
                            else
                              forall a. Num a => Integer -> a
fromInteger (Integer
n 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' :: forall a. RealFloat a => a -> a
truncate' a
x | forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero a
x = a
x forall a. Num a => a -> a -> a
+ a
x
truncate' a
x = case forall a b. (RealFrac a, Integral b) => a -> b
truncate a
x of
                Integer
0 | a
x forall a. Ord a => a -> a -> Bool
< a
0 -> -a
0
                  | Bool
otherwise -> a
0
                Integer
n -> 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' :: forall a. RealFloat a => a -> a
ceiling' a
x | forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero a
x = a
x forall a. Num a => a -> a -> a
+ a
x
ceiling' a
x = case forall a b. (RealFrac a, Integral b) => a -> b
ceiling a
x of
               Integer
0 | a
x forall a. Ord a => a -> a -> Bool
< a
0 -> -a
0
                 | Bool
otherwise -> a
0
               Integer
n -> 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' :: forall a. RealFloat a => a -> a
floor' a
x | forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero a
x = a
x forall a. Num a => a -> a -> a
+ a
x
         | Bool
otherwise = forall a. Num a => Integer -> a
fromInteger (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 :: forall a b. (RealFrac a, Integral b) => a -> b
roundAway a
x = case 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 forall a. Num a => a -> a
abs a
r forall a. Ord a => a -> a -> Bool
< a
0.5 then
                           b
n
                         else
                           if a
r forall a. Ord a => a -> a -> Bool
< a
0 then
                             b
n forall a. Num a => a -> a -> a
- b
1
                           else
                             b
n 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

#if defined(SOME_LIBC_FUNCTIONS_MIGHT_BE_BUGGY)
{-# RULES
"roundAway'/Float"
  roundAway' = c_roundFloat . canonicalizeFloat
"roundAway'/Double"
  roundAway' = c_roundDouble . canonicalizeDouble
"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
  #-}
#else
{-# 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
  #-}
#endif

{- 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