{-# 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
   , showMPFloat
   , 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

{-| Multiple-precision floating-point type based on CDAR.Approx with 0 radius. -}
type MPFloat = MPLow.Approx

showMPFloat :: MPFloat -> String
showMPFloat :: MPFloat -> String
showMPFloat MPFloat
x = MPFloat -> String
MPLow.showA MPFloat
x

deriving instance (Typeable MPFloat)

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

getBoundsCEDU :: MPFloat -> BoundsCEDU MPFloat
getBoundsCEDU :: MPFloat -> BoundsCEDU MPFloat
getBoundsCEDU (MPLow.Approx Precision
mb Integer
m Integer
e Precision
s) = 
  MPFloat -> MPFloat -> MPFloat -> MPFloat -> BoundsCEDU MPFloat
forall a. a -> a -> a -> a -> BoundsCEDU a
BoundsCEDU 
    (Precision -> Integer -> Integer -> Precision -> MPFloat
MPLow.Approx Precision
mb Integer
m Integer
0 Precision
s) (Precision -> Integer -> Integer -> Precision -> MPFloat
MPLow.approxMB Precision
eb_mb Integer
e Integer
0 Precision
s)
    (Precision -> Integer -> Integer -> Precision -> MPFloat
MPLow.Approx Precision
mb (Integer
mInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
e) Integer
0 Precision
s) (Precision -> Integer -> Integer -> Precision -> MPFloat
MPLow.Approx Precision
mb (Integer
mInteger -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
e) Integer
0 Precision
s)
getBoundsCEDU MPFloat
MPLow.Bottom =
  MPFloat -> MPFloat -> MPFloat -> MPFloat -> BoundsCEDU MPFloat
forall a. a -> a -> a -> a -> BoundsCEDU a
BoundsCEDU
    MPFloat
MPLow.Bottom MPFloat
MPLow.Bottom MPFloat
MPLow.Bottom MPFloat
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 = Integer -> Precision
forall t. CanBeInt t => t -> Precision
int (Integer -> Precision) -> Integer -> Precision
forall a b. (a -> b) -> a -> b
$ Precision -> Integer
forall t. CanBeInteger t => t -> Integer
integer Precision
eb_prec

instance HasPrecision MPFloat where
  getPrecision :: MPFloat -> Precision
getPrecision (MPLow.Approx Precision
mb Integer
_ Integer
_ Precision
_) = Integer -> Precision
prec (Precision -> Integer
forall a. Integral a => a -> Integer
P.toInteger (Precision -> Integer) -> Precision -> Integer
forall a b. (a -> b) -> a -> b
$ Precision
mb)
  getPrecision MPFloat
MPLow.Bottom = String -> Precision
forall a. HasCallStack => String -> a
error String
"illegal MPFloat (Bottom)"
  
instance CanSetPrecision MPFloat where
  setPrecision :: Precision -> MPFloat -> MPFloat
setPrecision Precision
p = BoundsCEDU MPFloat -> MPFloat
forall a. BoundsCEDU a -> a
ceduCentre (BoundsCEDU MPFloat -> MPFloat)
-> (MPFloat -> BoundsCEDU MPFloat) -> MPFloat -> MPFloat
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 (MPFloat -> BoundsCEDU MPFloat)
-> (MPFloat -> MPFloat) -> MPFloat -> BoundsCEDU MPFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPFloat -> MPFloat
MPLow.enforceMB (MPFloat -> MPFloat) -> (MPFloat -> MPFloat) -> MPFloat -> MPFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precision -> MPFloat -> MPFloat
MPLow.setMB (Precision -> Precision
p2cdarPrec Precision
pp)

instance HasNorm MPFloat where
  getNormLog :: MPFloat -> NormLog
getNormLog (MPLow.Approx Precision
_ Integer
m Integer
_ Precision
s) = (Integer -> NormLog
forall a. HasNorm a => a -> NormLog
getNormLog Integer
m) NormLog -> Integer -> AddType NormLog Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Precision -> Integer
forall t. CanBeInteger t => t -> Integer
integer Precision
s)
  getNormLog MPFloat
MPLow.Bottom = String -> NormLog
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 :: MPFloat -> Maybe Precision
getErrorStepSizeLog (MPLow.Approx Precision
_ Integer
_ Integer
_ Precision
s) = Precision -> Maybe Precision
forall a. a -> Maybe a
Just (Precision -> Maybe Precision) -> Precision -> Maybe Precision
forall a b. (a -> b) -> a -> b
$ Precision
s
getErrorStepSizeLog MPFloat
_ = Maybe Precision
forall a. Maybe a
Nothing -- represents +Infinity