{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE StandaloneDeriving #-}
{-|
    Module      :  AERN2.MP.Float.Type
    Description :  Arbitrary precision floating point numbers (via cdar)
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    Arbitrary precision floating-point numbers, re-using CDAR Approx type.
-}
module AERN2.MP.Float.Type
  (
   -- * MPFloat numbers and their basic operations
   MPFloat(..)
   , lift1, lift2, lift2R
   , getErrorStepSizeLog
   , setPrecisionCEDU
   , p2cdarPrec
   , getBoundsCEDU
   )
where

import MixedTypesNumPrelude
import qualified Prelude as P

-- import Data.Bits (unsafeShiftL)
import Data.Typeable

import AERN2.Norm
import AERN2.MP.Precision
import AERN2.MP.Float.Auxi

import qualified Data.CDAR as MPLow
import Control.DeepSeq (NFData)
import GHC.Generics (Generic)

{-| Multiple-precision floating-point type based on CDAR.Approx with 0 radius. -}
newtype MPFloat = MPFloat { MPFloat -> Approx
unMPFloat :: MPLow.Approx }
  deriving (forall x. Rep MPFloat x -> MPFloat
forall x. MPFloat -> Rep MPFloat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MPFloat x -> MPFloat
$cfrom :: forall x. MPFloat -> Rep MPFloat x
Generic)

lift1 :: (MPLow.Approx -> MPLow.Approx) -> MPFloat -> MPFloat
lift1 :: (Approx -> Approx) -> MPFloat -> MPFloat
lift1 Approx -> Approx
f (MPFloat Approx
a) = Approx -> MPFloat
MPFloat (Approx -> Approx
f Approx
a)

lift2 :: 
  (MPLow.Approx -> MPLow.Approx -> MPLow.Approx) -> 
  (MPFloat -> MPFloat -> MPFloat)
lift2 :: (Approx -> Approx -> Approx) -> MPFloat -> MPFloat -> MPFloat
lift2 Approx -> Approx -> Approx
f (MPFloat Approx
a1) (MPFloat Approx
a2) = Approx -> MPFloat
MPFloat (Approx -> Approx -> Approx
f Approx
a1 Approx
a2)

lift2R :: 
  (MPLow.Approx -> MPLow.Approx -> t) -> 
  (MPFloat -> MPFloat -> t)
lift2R :: forall t. (Approx -> Approx -> t) -> MPFloat -> MPFloat -> t
lift2R Approx -> Approx -> t
f (MPFloat Approx
a1) (MPFloat Approx
a2) = Approx -> Approx -> t
f Approx
a1 Approx
a2

instance Show MPFloat where
  show :: MPFloat -> String
show MPFloat
x = Approx -> String
MPLow.showA forall a b. (a -> b) -> a -> b
$ MPFloat -> Approx
unMPFloat MPFloat
x

deriving instance (Typeable MPFloat)
instance NFData MPFloat

p2cdarPrec :: Precision -> MPLow.Precision
p2cdarPrec :: Precision -> Precision
p2cdarPrec = forall a. Num a => Integer -> a
P.fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeInteger t => t -> Integer
integer

getBoundsCEDU :: MPFloat -> BoundsCEDU MPFloat
getBoundsCEDU :: MPFloat -> BoundsCEDU MPFloat
getBoundsCEDU (MPFloat (MPLow.Approx Precision
mb Integer
m Integer
e Precision
s)) = 
  forall a. a -> a -> a -> a -> BoundsCEDU a
BoundsCEDU 
    (Approx -> MPFloat
MPFloat forall a b. (a -> b) -> a -> b
$ Precision -> Integer -> Integer -> Precision -> Approx
MPLow.Approx Precision
mb Integer
m Integer
0 Precision
s) (Approx -> MPFloat
MPFloat forall a b. (a -> b) -> a -> b
$ Precision -> Integer -> Integer -> Precision -> Approx
MPLow.approxMB Precision
eb_mb Integer
e Integer
0 Precision
s)
    (Approx -> MPFloat
MPFloat forall a b. (a -> b) -> a -> b
$ Precision -> Integer -> Integer -> Precision -> Approx
MPLow.Approx Precision
mb (Integer
mforall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
e) Integer
0 Precision
s) (Approx -> MPFloat
MPFloat forall a b. (a -> b) -> a -> b
$ Precision -> Integer -> Integer -> Precision -> Approx
MPLow.Approx Precision
mb (Integer
mforall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
e) Integer
0 Precision
s)
getBoundsCEDU (MPFloat Approx
MPLow.Bottom) =
  forall a. a -> a -> a -> a -> BoundsCEDU a
BoundsCEDU
    (Approx -> MPFloat
MPFloat Approx
MPLow.Bottom) (Approx -> MPFloat
MPFloat Approx
MPLow.Bottom) 
    (Approx -> MPFloat
MPFloat Approx
MPLow.Bottom) (Approx -> MPFloat
MPFloat Approx
MPLow.Bottom)

{-| The bit-size bound for the error bound in CEDU -}
eb_prec :: Precision
eb_prec :: Precision
eb_prec = Integer -> Precision
prec Integer
63

{-| The bit-size bound for the error bound in CEDU -}
eb_mb :: Int
eb_mb :: Precision
eb_mb = forall t. CanBeInt t => t -> Precision
int forall a b. (a -> b) -> a -> b
$ forall t. CanBeInteger t => t -> Integer
integer Precision
eb_prec

instance HasPrecision MPFloat where
  getPrecision :: MPFloat -> Precision
getPrecision (MPFloat (MPLow.Approx Precision
mb Integer
_ Integer
_ Precision
_)) = Integer -> Precision
prec (forall a. Integral a => a -> Integer
P.toInteger forall a b. (a -> b) -> a -> b
$ Precision
mb)
  getPrecision (MPFloat Approx
MPLow.Bottom) = forall a. HasCallStack => String -> a
error String
"illegal MPFloat (Bottom)"
  
instance CanSetPrecision MPFloat where
  setPrecision :: Precision -> MPFloat -> MPFloat
setPrecision Precision
p = forall a. BoundsCEDU a -> a
ceduCentre forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precision -> MPFloat -> BoundsCEDU MPFloat
setPrecisionCEDU Precision
p

setPrecisionCEDU :: Precision -> MPFloat -> BoundsCEDU MPFloat
setPrecisionCEDU :: Precision -> MPFloat -> BoundsCEDU MPFloat
setPrecisionCEDU Precision
pp = 
  MPFloat -> BoundsCEDU MPFloat
getBoundsCEDU forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Approx -> Approx) -> MPFloat -> MPFloat
lift1 Approx -> Approx
MPLow.enforceMB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Approx -> Approx) -> MPFloat -> MPFloat
lift1 (Precision -> Approx -> Approx
MPLow.setMB (Precision -> Precision
p2cdarPrec Precision
pp))

instance HasNorm MPFloat where
  getNormLog :: MPFloat -> NormLog
getNormLog (MPFloat (MPLow.Approx Precision
_ Integer
m Integer
_ Precision
s)) = (forall a. HasNorm a => a -> NormLog
getNormLog Integer
m) forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (forall t. CanBeInteger t => t -> Integer
integer Precision
s)
  getNormLog (MPFloat Approx
MPLow.Bottom) = forall a. HasCallStack => String -> a
error String
"getNormLog undefined for Bottom"

{-|
  Returns @s@ such that @2^s@ is the distance to the nearest other number with the same precision.
  Returns Nothing for Bottom.
-}
getErrorStepSizeLog :: MPLow.Approx -> Maybe Int
getErrorStepSizeLog :: Approx -> Maybe Precision
getErrorStepSizeLog (MPLow.Approx Precision
_ Integer
_ Integer
_ Precision
s) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Precision
s
getErrorStepSizeLog Approx
_ = forall a. Maybe a
Nothing -- represents +Infinity