    {-# LANGUAGE ForeignFunctionInterface #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module     : Numeric.IEEE
    -- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>
    -- License    : BSD3
    -- Maintainer : Patrick Perry <patperry@gmail.com>
    -- Stability  : experimental
    --
    -- Operations on IEEE floating point numbers.
    --
    module Numeric.IEEE (
        -- * IEEE type class
        IEEE(..),
        -- * NaN-aware minimum and maximum
        minNum,
        maxNum,
        minNaN,
        maxNaN,
        ) where

    import Data.Word
    import Foreign.C.Types( CFloat, CDouble )

    -- | IEEE floating point types.
    class (RealFloat a) => IEEE a where
        -- | Infinity value.
        infinity :: a

        -- | The smallest representable positive value.
        minDenormal :: a

        -- | The smallest representable positive normalized value.
        minNormal :: a

        -- | The largest representable finite value.
        maxFinite :: a

        -- | The smallest positive value @x@ such that @1 + x@ is representable.
        epsilon :: a

        -- | @copySign x y@ returns @x@ with its sign changed to @y@'s.
        copySign :: a -> a -> a

        -- | Return 'True' if two values are /exactly/ (bitwise) equal.
        identicalIEEE :: a -> a -> Bool

        -- | Return the next largest IEEE value (@Infinity@ and @NaN@ are
        -- unchanged).
        succIEEE :: a -> a

        -- | Return the next smallest IEEE value (@-Infinity@ and @NaN@ are
        -- unchanged).
        predIEEE :: a -> a

        -- | Given two values with the same sign, return the value halfway
        -- between them on the IEEE number line.  If the signs of the values
        -- differ or either is @NaN@, the value is undefined.
        bisectIEEE :: a -> a -> a

        -- | The number of significand bits which are equal in the two arguments
        -- (equivalent to @feqrel@ from the Tango Math library).  The result is
        -- between @0@ and @'floatDigits'@.
        sameSignificandBits :: a -> a -> Int

        -- | Default @NaN@ value.
        nan :: a

        -- | Quiet @NaN@ value with a positive integer payload.  Payload must be
        -- less than 'maxNaNPayload'.  Beware that while some platforms allow
        -- using @0@ as a payload, this behavior is not portable.
        nanWithPayload :: Word64 -> a

        -- | Maximum @NaN@ payload for type @a@.
        maxNaNPayload :: a -> Word64

        -- | The payload stored in a @NaN@ value.  Undefined if the argument
        -- is not @NaN@.
        nanPayload :: a -> Word64

    -- | Return the maximum of two values; if one value is @NaN@, return the
    -- other.  Prefer the first if both values are @NaN@.
    maxNum :: (RealFloat a) => a -> a -> a
    maxNum x y | x >= y || isNaN y = x
               | otherwise         = y
    {-# INLINE maxNum #-}

    -- | Return the minimum of two values; if one value is @NaN@, return the
    -- other.  Prefer the first if both values are @NaN@.
    minNum :: (RealFloat a) => a -> a -> a
    minNum x y | x <= y || isNaN y = x
               | otherwise         = y
    {-# INLINE minNum #-}

    -- | Return the maximum of two values; if one value is @NaN@, return it.
    -- Prefer the first if both values are @NaN@.
    maxNaN :: (RealFloat a) => a -> a -> a
    maxNaN x y | x >= y || isNaN x = x
               | otherwise         = y
    {-# INLINE maxNaN #-}

    -- | Return the minimum of two values; if one value is @NaN@, return it.
    -- Prefer the first if both values are @NaN@.
    minNaN :: (RealFloat a) =>  a -> a -> a
    minNaN x y | x <= y || isNaN x = x
               | otherwise         = y
    {-# INLINE minNaN #-}

    instance IEEE Float where
        identicalIEEE x y = c_identicalf x y /= 0
        {-# INLINE identicalIEEE #-}
        infinity = 1/0
        {-# INLINE infinity #-}
        nan = (0/0)
        {-# INLINE nan #-}
        nanWithPayload n = c_mknanf (fromIntegral n)
        {-# INLINE nanWithPayload #-}
        maxNaNPayload _ = 0x003FFFFF
        {-# INLINE maxNaNPayload #-}
        nanPayload x = fromIntegral $ c_getnanf x
        {-# INLINE nanPayload #-}
        minDenormal = 1e-45
        {-# INLINE minDenormal #-}
        minNormal = 1.17549435e-38
        {-# INLINE minNormal #-}
        maxFinite = 3.40282347e+38
        {-# INLINE maxFinite #-}
        epsilon = 1.19209290e-07
        {-# INLINE epsilon #-}
        copySign = c_copysignf
        {-# INLINE copySign #-}
        succIEEE = c_ieeesuccf
        {-# INLINE succIEEE #-}
        predIEEE = c_ieeepredf
        {-# INLINE predIEEE #-}
        bisectIEEE = c_ieeemeanf
        {-# INLINE bisectIEEE #-}
        sameSignificandBits = c_feqrelf
        {-# INLINE sameSignificandBits #-}

    instance IEEE CFloat where
        identicalIEEE x y = c_identicalf (realToFrac x) (realToFrac y) /= 0
        {-# INLINE identicalIEEE #-}
        infinity = 1/0
        {-# INLINE infinity #-}
        nan = (0/0)
        {-# INLINE nan #-}
        nanWithPayload n = realToFrac $ c_mknanf (fromIntegral n)
        {-# INLINE nanWithPayload #-}
        maxNaNPayload _ = 0x003FFFFF
        {-# INLINE maxNaNPayload #-}
        nanPayload x = fromIntegral $ c_getnanf (realToFrac x)
        {-# INLINE nanPayload #-}
        minDenormal = 1e-45
        {-# INLINE minDenormal #-}
        minNormal = 1.17549435e-38
        {-# INLINE minNormal #-}
        maxFinite = 3.40282347e+38
        {-# INLINE maxFinite #-}
        epsilon = 1.19209290e-07
        {-# INLINE epsilon #-}
        copySign x y = realToFrac $ c_copysignf (realToFrac x) (realToFrac y)
        {-# INLINE copySign #-}
        succIEEE x = realToFrac $ c_ieeesuccf (realToFrac x)
        {-# INLINE succIEEE #-}
        predIEEE x = realToFrac $ c_ieeepredf (realToFrac x)
        {-# INLINE predIEEE #-}
        bisectIEEE x y = realToFrac $ c_ieeemeanf (realToFrac x) (realToFrac y)
        {-# INLINE bisectIEEE #-}
        sameSignificandBits x y = c_feqrelf (realToFrac x) (realToFrac y)
        {-# INLINE sameSignificandBits #-}

    instance IEEE Double where
        identicalIEEE x y = c_identical x y /= 0
        {-# INLINE identicalIEEE #-}
        infinity = 1/0
        {-# INLINE infinity #-}
        nan = (0/0)
        {-# INLINE nan #-}
        nanWithPayload n = c_mknan n
        {-# INLINE nanWithPayload #-}
        maxNaNPayload _ = 0x0007FFFFFFFFFFFF
        {-# INLINE maxNaNPayload #-}
        nanPayload x = c_getnan x
        {-# INLINE nanPayload #-}
        minDenormal = 5e-324
        {-# INLINE minDenormal #-}
        minNormal = 2.2250738585072014e-308
        {-# INLINE minNormal #-}
        maxFinite = 1.7976931348623157e+308
        {-# INLINE maxFinite #-}
        epsilon = 2.2204460492503131e-16
        {-# INLINE epsilon #-}
        copySign = c_copysign
        {-# INLINE copySign #-}
        succIEEE = c_ieeesucc
        {-# INLINE succIEEE #-}
        predIEEE = c_ieeepred
        {-# INLINE predIEEE #-}
        bisectIEEE = c_ieeemean
        {-# INLINE bisectIEEE #-}
        sameSignificandBits = c_feqrel
        {-# INLINE sameSignificandBits #-}

    instance IEEE CDouble where
        identicalIEEE x y = c_identical (realToFrac x) (realToFrac y) /= 0
        {-# INLINE identicalIEEE #-}
        infinity = 1/0
        {-# INLINE infinity #-}
        nan = (0/0)
        {-# INLINE nan #-}
        nanWithPayload n = realToFrac $ c_mknan n
        {-# INLINE nanWithPayload #-}
        maxNaNPayload _ = 0x0007FFFFFFFFFFFF
        {-# INLINE maxNaNPayload #-}
        nanPayload x = c_getnan (realToFrac x)
        {-# INLINE nanPayload #-}
        minDenormal = 5e-324
        {-# INLINE minDenormal #-}
        minNormal = 2.2250738585072014e-308
        {-# INLINE minNormal #-}
        maxFinite = 1.7976931348623157e+308
        {-# INLINE maxFinite #-}
        epsilon = 2.2204460492503131e-16
        {-# INLINE epsilon #-}
        succIEEE x = realToFrac $ c_ieeesucc (realToFrac x)
        {-# INLINE succIEEE #-}
        copySign x y = realToFrac $ c_copysign (realToFrac x) (realToFrac y)
        {-# INLINE copySign #-}
        predIEEE x = realToFrac $ c_ieeepred (realToFrac x)
        {-# INLINE predIEEE #-}
        bisectIEEE x y = realToFrac $ c_ieeemean (realToFrac x) (realToFrac y)
        {-# INLINE bisectIEEE #-}
        sameSignificandBits x y = c_feqrel (realToFrac x) (realToFrac y)
        {-# INLINE sameSignificandBits #-}

    foreign import ccall unsafe "identical"
        c_identical :: Double -> Double -> Int

    foreign import ccall unsafe "identicalf"
        c_identicalf :: Float -> Float -> Int

    foreign import ccall unsafe "feqrel"
        c_feqrel :: Double -> Double -> Int
    foreign import ccall unsafe "feqrelf"
        c_feqrelf :: Float -> Float -> Int

    foreign import ccall unsafe "ieeesucc"
        c_ieeesucc :: Double -> Double

    foreign import ccall unsafe "ieeesuccf"
        c_ieeesuccf :: Float -> Float

    foreign import ccall unsafe "ieeepred"
        c_ieeepred :: Double -> Double

    foreign import ccall unsafe "ieeepredf"
        c_ieeepredf :: Float -> Float

    foreign import ccall unsafe "ieeemean"
        c_ieeemean :: Double -> Double -> Double

    foreign import ccall unsafe "ieeemeanf"
        c_ieeemeanf :: Float -> Float -> Float

    foreign import ccall unsafe "copysign"
        c_copysign :: Double -> Double -> Double

    foreign import ccall unsafe "copysignf"
        c_copysignf :: Float -> Float -> Float

    foreign import ccall unsafe "mknan"
        c_mknan :: Word64 -> Double

    foreign import ccall unsafe "getnan"
        c_getnan :: Double -> Word64

    foreign import ccall unsafe "mknanf"
        c_mknanf :: Word32 -> Float

    foreign import ccall unsafe "getnanf"
        c_getnanf :: Float -> Word32