    {-# LANGUAGE NoImplicitPrelude #-}
    module Numeric.Floating.IEEE.Internal.GenericArith where
    import           Data.Proxy
    import           MyPrelude
    import           Numeric.Floating.IEEE.Internal.Classify
    import           Numeric.Floating.IEEE.Internal.Conversion
    import           Numeric.Floating.IEEE.Internal.FMA

    default ()

    -- $setup
    -- >>> :m + Data.Proxy
    -- >>> import Numeric.Floating.IEEE.Internal.GenericArith

    infixl 6 `genericAdd`, `genericSub`
    infixl 7 `genericMul`, `genericDiv`

    -- |
    -- IEEE 754 @addition@ operation.
    genericAdd :: (RealFloat a, RealFloat b) => a -> a -> b
    genericAdd :: forall a b. (RealFloat a, RealFloat b) => a -> a -> b
    genericAdd a
    x a
    y | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 Bool -> Bool -> Bool
    && a
    y a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 = a -> b
    forall a b. (RealFloat a, Fractional b) => a -> b
    realFloatToFrac (a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    y)
                   | a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    x Bool -> Bool -> Bool
    && a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    y = Rational -> b
    forall a. Fractional a => Rational -> a
    fromRational (a -> Rational
    forall a. Real a => a -> Rational
    toRational a
    x Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    + a -> Rational
    forall a. Real a => a -> Rational
    toRational a
    y)
                   | Bool
    otherwise = a -> b
    forall a b. (RealFloat a, Fractional b) => a -> b
    realFloatToFrac (a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    y)
    {-# NOINLINE [1] genericAdd #-}

    -- |
    -- IEEE 754 @subtraction@ operation.
    genericSub :: (RealFloat a, RealFloat b) => a -> a -> b
    genericSub :: forall a b. (RealFloat a, RealFloat b) => a -> a -> b
    genericSub a
    x a
    y | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 Bool -> Bool -> Bool
    && a
    y a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 = a -> b
    forall a b. (RealFloat a, Fractional b) => a -> b
    realFloatToFrac (a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    y)
                   | a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    x Bool -> Bool -> Bool
    && a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    y = Rational -> b
    forall a. Fractional a => Rational -> a
    fromRational (a -> Rational
    forall a. Real a => a -> Rational
    toRational a
    x Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - a -> Rational
    forall a. Real a => a -> Rational
    toRational a
    y)
                   | Bool
    otherwise = a -> b
    forall a b. (RealFloat a, Fractional b) => a -> b
    realFloatToFrac (a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    y)
    {-# NOINLINE [1] genericSub #-}

    -- |
    -- IEEE 754 @multiplication@ operation.
    genericMul :: (RealFloat a, RealFloat b) => a -> a -> b
    genericMul :: forall a b. (RealFloat a, RealFloat b) => a -> a -> b
    genericMul a
    x a
    y | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 Bool -> Bool -> Bool
    || a
    y a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 = a -> b
    forall a b. (RealFloat a, Fractional b) => a -> b
    realFloatToFrac (a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    y)
                   | a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    x Bool -> Bool -> Bool
    && a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    y = Rational -> b
    forall a. Fractional a => Rational -> a
    fromRational (a -> Rational
    forall a. Real a => a -> Rational
    toRational a
    x Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * a -> Rational
    forall a. Real a => a -> Rational
    toRational a
    y)
                   | Bool
    otherwise = a -> b
    forall a b. (RealFloat a, Fractional b) => a -> b
    realFloatToFrac (a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    y)
    {-# NOINLINE [1] genericMul #-}

    -- |
    -- IEEE 754 @division@ operation.
    genericDiv :: (RealFloat a, RealFloat b) => a -> a -> b
    genericDiv :: forall a b. (RealFloat a, RealFloat b) => a -> a -> b
    genericDiv a
    x a
    y | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 Bool -> Bool -> Bool
    || a
    y a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 = a -> b
    forall a b. (RealFloat a, Fractional b) => a -> b
    realFloatToFrac (a
    x a -> a -> a
    forall a. Fractional a => a -> a -> a
    / a
    y)
                   | a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    x Bool -> Bool -> Bool
    && a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    y = Rational -> b
    forall a. Fractional a => Rational -> a
    fromRational (a -> Rational
    forall a. Real a => a -> Rational
    toRational a
    x Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / a -> Rational
    forall a. Real a => a -> Rational
    toRational a
    y)
                   | Bool
    otherwise = a -> b
    forall a b. (RealFloat a, Fractional b) => a -> b
    realFloatToFrac (a
    x a -> a -> a
    forall a. Fractional a => a -> a -> a
    / a
    y)
    {-# NOINLINE [1] genericDiv #-}

    {-
    -- |
    -- IEEE 754 @squareRoot@ operation.
    genericSqrt :: (RealFloat a, RealFloat b) => a -> b
    genericSqrt x | x == 0 = realFloatToFrac x
                  | x > 0, isFinite x = error "not implemented yet"
                  | otherwise = realFloatToFrac (sqrt x)
    -}

    -- |
    -- IEEE 754 @fusedMultiplyAdd@ operation.
    genericFusedMultiplyAdd :: (RealFloat a, RealFloat b) => a -> a -> a -> b
    genericFusedMultiplyAdd :: forall a b. (RealFloat a, RealFloat b) => a -> a -> a -> b
    genericFusedMultiplyAdd a
    a a
    b a
    c
      | a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    a Bool -> Bool -> Bool
    && a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    b Bool -> Bool -> Bool
    && a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    c = case a -> Rational
    forall a. Real a => a -> Rational
    toRational a
    a Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * a -> Rational
    forall a. Real a => a -> Rational
    toRational a
    b Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    + a -> Rational
    forall a. Real a => a -> Rational
    toRational a
    c of
                                                   Rational
    0 | a -> Bool
    forall a. RealFloat a => a -> Bool
    isNegativeZero (a
    a a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    b a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    c) -> -b
    0
                                                   Rational
    r -> Rational -> b
    forall a. Fractional a => Rational -> a
    fromRational Rational
    r
      | a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    a Bool -> Bool -> Bool
    && a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    b = a -> b
    forall a b. (RealFloat a, Fractional b) => a -> b
    realFloatToFrac a
    c -- c is Infinity or NaN
      | Bool
    otherwise = a -> b
    forall a b. (RealFloat a, Fractional b) => a -> b
    realFloatToFrac (a
    a a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    b a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    c)
    {-# NOINLINE [1] genericFusedMultiplyAdd #-}

    {-# RULES
    "genericAdd/a->a" genericAdd = (+)
    "genericSub/a->a" genericSub = (-)
    "genericMul/a->a" genericMul = (*)
    "genericDiv/a->a" genericDiv = (/)
    "genericFusedMultiplyAdd/a->a" genericFusedMultiplyAdd = fusedMultiplyAdd
      #-}

    -- | Returns True if @a@ is a subtype of @b@
    --
    -- >>> isSubFloatingType (undefined :: Float) (undefined :: Double)
    -- True
    -- >>> isSubFloatingType (undefined :: Double) (undefined :: Float)
    -- False
    -- >>> isSubFloatingType (undefined :: Double) (undefined :: Double)
    -- True
    isSubFloatingType :: (RealFloat a, RealFloat b) => a -> b -> Bool
    isSubFloatingType :: forall a b. (RealFloat a, RealFloat b) => a -> b -> Bool
    isSubFloatingType a
    a b
    b = Bool
    ieeeA Bool -> Bool -> Bool
    && Bool
    ieeeB Bool -> Bool -> Bool
    && Integer
    baseA Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    baseB Bool -> Bool -> Bool
    && Int
    eminB Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    eminA Bool -> Bool -> Bool
    && Int
    emaxA Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    emaxB Bool -> Bool -> Bool
    && Int
    digitsA Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    digitsB
      where
        ieeeA :: Bool
    ieeeA = a -> Bool
    forall a. RealFloat a => a -> Bool
    isIEEE a
    a
        ieeeB :: Bool
    ieeeB = b -> Bool
    forall a. RealFloat a => a -> Bool
    isIEEE b
    b
        baseA :: Integer
    baseA = a -> Integer
    forall a. RealFloat a => a -> Integer
    floatRadix a
    a
        baseB :: Integer
    baseB = b -> Integer
    forall a. RealFloat a => a -> Integer
    floatRadix b
    b
        (Int
    eminA,Int
    emaxA) = a -> (Int, Int)
    forall a. RealFloat a => a -> (Int, Int)
    floatRange a
    a
        (Int
    eminB,Int
    emaxB) = b -> (Int, Int)
    forall a. RealFloat a => a -> (Int, Int)
    floatRange b
    b
        digitsA :: Int
    digitsA = a -> Int
    forall a. RealFloat a => a -> Int
    floatDigits a
    a
        digitsB :: Int
    digitsB = b -> Int
    forall a. RealFloat a => a -> Int
    floatDigits b
    b

    -- | Returns True if @a@ is a subtype of @b@
    --
    -- >>> isSubFloatingTypeProxy (Proxy :: Proxy Float) (Proxy :: Proxy Double)
    -- True
    -- >>> isSubFloatingTypeProxy (Proxy :: Proxy Double) (Proxy :: Proxy Float)
    -- False
    -- >>> isSubFloatingTypeProxy (Proxy :: Proxy Double) (Proxy :: Proxy Double)
    -- True
    isSubFloatingTypeProxy :: (RealFloat a, RealFloat b) => Proxy a -> Proxy b -> Bool
    isSubFloatingTypeProxy :: forall a b.
    (RealFloat a, RealFloat b) =>
    Proxy a -> Proxy b -> Bool
    isSubFloatingTypeProxy Proxy a
    proxyA Proxy b
    proxyB = a -> b -> Bool
    forall a b. (RealFloat a, RealFloat b) => a -> b -> Bool
    isSubFloatingType (a
    forall a. HasCallStack => a
    undefined a -> Proxy a -> a
    forall a (proxy :: * -> *). a -> proxy a -> a
    `asProxyTypeOf` Proxy a
    proxyA) (b
    forall a. HasCallStack => a
    undefined b -> Proxy b -> b
    forall a (proxy :: * -> *). a -> proxy a -> a
    `asProxyTypeOf` Proxy b
    proxyB)