{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP #-}
{-|
    Module      :  AERN2.MP.Ball.PreludeOps
    Description :  Instances of Prelude.Num etc
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

    Instances of Prelude classes Eq, Ord, Num etc
-}
module AERN2.MP.Ball.PreludeOps
(
)
where

import MixedTypesNumPrelude
import qualified Prelude as P

import AERN2.Kleenean
import AERN2.MP.Dyadic (dyadic)

import AERN2.MP.Ball.Type
import AERN2.MP.Ball.Conversions ()
import AERN2.MP.Ball.Comparisons ()
import AERN2.MP.Ball.Field ()
import AERN2.MP.Ball.Elementary ()

{- Instances of Prelude numerical classes provided for convenient use outside AERN2
   and also because Template Haskell translates (-x) to (Prelude.negate x) -}

instance P.Eq MPBall where
  MPBall
a == :: MPBall -> MPBall -> Bool
== MPBall
b =
    case MPBall
a forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== MPBall
b of
      EqCompareType MPBall MPBall
Kleenean
CertainTrue  -> Bool
True
      EqCompareType MPBall MPBall
Kleenean
CertainFalse  -> Bool
False
      EqCompareType MPBall MPBall
_ ->
        forall a. HasCallStack => [Char] -> a
error [Char]
"Failed to decide equality of MPBalls.  If you switch to MixedTypesNumPrelude instead of Prelude, comparison of MPBalls returns Kleenean instead of Bool."

instance P.Ord MPBall where
  compare :: MPBall -> MPBall -> Ordering
compare MPBall
a MPBall
b =
    case (MPBall
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< MPBall
b, MPBall
a forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== MPBall
b, MPBall
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> MPBall
b) of
      (Kleenean
CertainTrue, Kleenean
_, Kleenean
_) -> Ordering
P.LT
      (Kleenean
_, Kleenean
CertainTrue, Kleenean
_) -> Ordering
P.EQ
      (Kleenean
_, Kleenean
_, Kleenean
CertainTrue) -> Ordering
P.GT
      (Kleenean, Kleenean, Kleenean)
_ ->
        forall a. HasCallStack => [Char] -> a
error [Char]
"Failed to decide order of MPBalls.  If you switch to MixedTypesNumPrelude instead of Prelude, comparison of MPBalls returns Kleenean instead of Bool."

instance P.Num MPBall where
    fromInteger :: Integer -> MPBall
fromInteger = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly
    negate :: MPBall -> MPBall
negate = forall t. CanNeg t => t -> NegType t
negate
    + :: MPBall -> MPBall -> MPBall
(+) = forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
(+)
    * :: MPBall -> MPBall -> MPBall
(*) = forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
(*)
    abs :: MPBall -> MPBall
abs = forall t. CanAbs t => t -> AbsType t
abs
    signum :: MPBall -> MPBall
signum = forall a. HasCallStack => [Char] -> a
error [Char]
"Prelude.signum not implemented for MPBall"

instance P.Fractional MPBall where
    fromRational :: Rational -> MPBall
fromRational = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeDyadic t => t -> Dyadic
dyadic -- will work only for dyadic rationals
    recip :: MPBall -> MPBall
recip = forall t. CanRecip t => t -> DivType Integer t
recip
    / :: MPBall -> MPBall -> MPBall
(/) = forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
(/)

instance P.Floating MPBall where
    pi :: MPBall
pi = forall a. HasCallStack => [Char] -> a
error [Char]
"There is no pi :: MPBall, use pi :: Real instead"
    sqrt :: MPBall -> MPBall
sqrt = forall t. CanSqrt t => t -> SqrtType t
sqrt
    exp :: MPBall -> MPBall
exp = forall t. CanExp t => t -> ExpType t
exp
    sin :: MPBall -> MPBall
sin = forall t. CanSinCos t => t -> SinCosType t
sin
    cos :: MPBall -> MPBall
cos = forall t. CanSinCos t => t -> SinCosType t
cos
    log :: MPBall -> MPBall
log = forall t. CanLog t => t -> LogType t
log
    atan :: MPBall -> MPBall
atan = forall a. HasCallStack => [Char] -> a
error [Char]
"MPBall: atan not implemented yet"
    atanh :: MPBall -> MPBall
atanh = forall a. HasCallStack => [Char] -> a
error [Char]
"MPBall: atanh not implemented yet"
    asin :: MPBall -> MPBall
asin = forall a. HasCallStack => [Char] -> a
error [Char]
"MPBall: asin not implemented yet"
    acos :: MPBall -> MPBall
acos = forall a. HasCallStack => [Char] -> a
error [Char]
"MPBall: acos not implemented yet"
    sinh :: MPBall -> MPBall
sinh = forall a. HasCallStack => [Char] -> a
error [Char]
"MPBall: sinh not implemented yet"
    cosh :: MPBall -> MPBall
cosh = forall a. HasCallStack => [Char] -> a
error [Char]
"MPBall: cosh not implemented yet"
    asinh :: MPBall -> MPBall
asinh = forall a. HasCallStack => [Char] -> a
error [Char]
"MPBall: asinh not implemented yet"
    acosh :: MPBall -> MPBall
acosh = forall a. HasCallStack => [Char] -> a
error [Char]
"MPBall: acosh not implemented yet"