{-# LINE 1 "src/LibBF/Mutable.hsc" #-}
{-# Language ForeignFunctionInterface, CApiFFI #-}
{-# Language PatternSynonyms #-}
{-# Language MultiWayIf #-}
{-# Language BlockArguments #-}
-- | Mutable big-float computation.
module LibBF.Mutable
  ( -- * Allocation
    newContext, BFContext
  , new, BF

    -- * Assignment
  , setNaN
  , setZero
  , setInf
  , Sign(..)
  , setWord
  , setInt
  , setDouble
  , setInteger
  , setBF
  , setString

    -- * Queries and Comparisons
  , cmpEq
  , cmpLT
  , cmpLEQ
  , cmpAbs
  , cmp
  , getSign
  , getExp

  , isFinite
  , isInf
  , LibBF.Mutable.isNaN
  , isZero

    -- * Arithmetic
  , fneg
  , fadd
  , faddInt
  , fsub
  , fmul
  , fmulInt
  , fmulWord
  , fmul2Exp
  , ffma
  , fdiv
  , frem
  , fsqrt
  , fpow
  , fround
  , frint


  -- * Convert from a number
  , toDouble
  , toString
  , toRep, BFRep(..), BFNum(..)

  -- * Configuration
  , module LibBF.Opts
  , toChunks

  ) where


import Foreign.Marshal.Alloc(alloca,free)
import Foreign.Ptr(Ptr,FunPtr,minusPtr)
import Foreign.ForeignPtr
import Foreign.C.Types
import Foreign.C.String
import Data.Word
import Data.Int
import Data.Bits
import Data.Hashable
import Data.List(unfoldr)
import Control.Monad(foldM,when)

import Foreign.Storable



import LibBF.Opts

-- | State of the current computation context.
newtype BFContext = BFContext (ForeignPtr BFContext)

foreign import ccall "bf_context_init_hs"
  bf_context_init_hs :: Ptr BFContext -> IO ()

foreign import ccall "&bf_context_end"
  bf_context_end :: FunPtr (Ptr BFContext -> IO ())

{-| Allocate a new numeric context. -}
newContext :: IO BFContext
newContext :: IO BFContext
newContext =
  do ForeignPtr BFContext
fptr <- Int -> IO (ForeignPtr BFContext)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Int
120)
{-# LINE 98 "src/LibBF/Mutable.hsc" #-}
     withForeignPtr fptr bf_context_init_hs
     FinalizerPtr BFContext -> ForeignPtr BFContext -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
addForeignPtrFinalizer FinalizerPtr BFContext
bf_context_end ForeignPtr BFContext
fptr
     BFContext -> IO BFContext
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr BFContext -> BFContext
BFContext ForeignPtr BFContext
fptr)


-- | A mutable high precision floating point number.
newtype BF = BF (ForeignPtr BF)

foreign import ccall "bf_init"
  bf_init :: Ptr BFContext -> Ptr BF -> IO ()

foreign import ccall "&bf_delete_hs"
  bf_delete :: FunPtr (Ptr BF -> IO ())

{-| Allocate a new number.  Starts off as zero. -}
new :: BFContext -> IO BF
new :: BFContext -> IO BF
new (BFContext ForeignPtr BFContext
fctx) =
  ForeignPtr BFContext -> (Ptr BFContext -> IO BF) -> IO BF
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BFContext
fctx \Ptr BFContext
ctx ->
  do ForeignPtr BF
fptr <- Int -> IO (ForeignPtr BF)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Int
40)
{-# LINE 117 "src/LibBF/Mutable.hsc" #-}
     withForeignPtr fptr (bf_init ctx)
     FinalizerPtr BF -> ForeignPtr BF -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
addForeignPtrFinalizer FinalizerPtr BF
bf_delete ForeignPtr BF
fptr
     BF -> IO BF
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr BF -> BF
BF ForeignPtr BF
fptr)

--------------------------------------------------------------------------------
-- FFI Helpers

signToC :: Sign -> CInt
signToC :: Sign -> CInt
signToC Sign
s = case Sign
s of
              Sign
Pos -> CInt
0
              Sign
Neg -> CInt
1

asSign :: CInt -> Sign
asSign :: CInt -> Sign
asSign CInt
s = if CInt
s CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 then Sign
Pos else Sign
Neg

asBool :: CInt -> Bool
asBool :: CInt -> Bool
asBool = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0)

asOrd :: CInt -> Ordering
asOrd :: CInt -> Ordering
asOrd CInt
x
  | CInt
x CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0     = Ordering
LT
  | CInt
x CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0     = Ordering
GT
  | Bool
otherwise = Ordering
EQ


bf1 :: (Ptr BF -> IO a) -> BF -> IO a
bf1 :: (Ptr BF -> IO a) -> BF -> IO a
bf1 Ptr BF -> IO a
f (BF ForeignPtr BF
fout) = ForeignPtr BF -> (Ptr BF -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fout Ptr BF -> IO a
f

bfQuery :: (Ptr BF -> IO CInt) -> BF -> IO Bool
bfQuery :: (Ptr BF -> IO CInt) -> BF -> IO Bool
bfQuery Ptr BF -> IO CInt
f = (Ptr BF -> IO Bool) -> BF -> IO Bool
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 ((CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Bool
asBool (IO CInt -> IO Bool) -> (Ptr BF -> IO CInt) -> Ptr BF -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr BF -> IO CInt
f)

bfRel :: (Ptr BF -> Ptr BF -> IO CInt) -> BF -> BF -> IO Bool
bfRel :: (Ptr BF -> Ptr BF -> IO CInt) -> BF -> BF -> IO Bool
bfRel Ptr BF -> Ptr BF -> IO CInt
f = (Ptr BF -> Ptr BF -> IO Bool) -> BF -> BF -> IO Bool
forall a. (Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> IO a
bf2 \Ptr BF
x Ptr BF
y -> CInt -> Bool
asBool (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr BF -> Ptr BF -> IO CInt
f Ptr BF
y Ptr BF
x

bfOrd :: (Ptr BF -> Ptr BF -> IO CInt) -> BF -> BF -> IO Ordering
bfOrd :: (Ptr BF -> Ptr BF -> IO CInt) -> BF -> BF -> IO Ordering
bfOrd Ptr BF -> Ptr BF -> IO CInt
f = (Ptr BF -> Ptr BF -> IO Ordering) -> BF -> BF -> IO Ordering
forall a. (Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> IO a
bf2 \Ptr BF
x Ptr BF
y -> CInt -> Ordering
asOrd (CInt -> Ordering) -> IO CInt -> IO Ordering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr BF -> Ptr BF -> IO CInt
f Ptr BF
y Ptr BF
x

bf2 :: (Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> IO a
bf2 :: (Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> IO a
bf2 Ptr BF -> Ptr BF -> IO a
f (BF ForeignPtr BF
fin1) (BF ForeignPtr BF
fout) =
  ForeignPtr BF -> (Ptr BF -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fin1 \Ptr BF
in1 ->
  ForeignPtr BF -> (Ptr BF -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fout \Ptr BF
out1 ->
    Ptr BF -> Ptr BF -> IO a
f Ptr BF
out1 Ptr BF
in1

bf3 :: (Ptr BF -> Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> BF -> IO a
bf3 :: (Ptr BF -> Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> BF -> IO a
bf3 Ptr BF -> Ptr BF -> Ptr BF -> IO a
f (BF ForeignPtr BF
fin1) (BF ForeignPtr BF
fin2) (BF ForeignPtr BF
fout) =
  ForeignPtr BF -> (Ptr BF -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fin1 \Ptr BF
in1 ->
  ForeignPtr BF -> (Ptr BF -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fin2 \Ptr BF
in2 ->
  ForeignPtr BF -> (Ptr BF -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fout \Ptr BF
out ->
    Ptr BF -> Ptr BF -> Ptr BF -> IO a
f Ptr BF
out Ptr BF
in1 Ptr BF
in2






--------------------------------------------------------------------------------
-- Assignment


-- | Indicates if a number is positive or negative.
data Sign = Neg {-^ Negative -} | Pos {-^ Positive -}
             deriving (Sign -> Sign -> Bool
(Sign -> Sign -> Bool) -> (Sign -> Sign -> Bool) -> Eq Sign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sign -> Sign -> Bool
$c/= :: Sign -> Sign -> Bool
== :: Sign -> Sign -> Bool
$c== :: Sign -> Sign -> Bool
Eq,Eq Sign
Eq Sign
-> (Sign -> Sign -> Ordering)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Sign)
-> (Sign -> Sign -> Sign)
-> Ord Sign
Sign -> Sign -> Bool
Sign -> Sign -> Ordering
Sign -> Sign -> Sign
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Sign -> Sign -> Sign
$cmin :: Sign -> Sign -> Sign
max :: Sign -> Sign -> Sign
$cmax :: Sign -> Sign -> Sign
>= :: Sign -> Sign -> Bool
$c>= :: Sign -> Sign -> Bool
> :: Sign -> Sign -> Bool
$c> :: Sign -> Sign -> Bool
<= :: Sign -> Sign -> Bool
$c<= :: Sign -> Sign -> Bool
< :: Sign -> Sign -> Bool
$c< :: Sign -> Sign -> Bool
compare :: Sign -> Sign -> Ordering
$ccompare :: Sign -> Sign -> Ordering
$cp1Ord :: Eq Sign
Ord,Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show)


foreign import ccall "bf_set_nan"
  bf_set_nan :: Ptr BF -> IO ()

-- | Assign @NaN@ to the number.
setNaN :: BF -> IO ()
setNaN :: BF -> IO ()
setNaN (BF ForeignPtr BF
fptr) = ForeignPtr BF -> (Ptr BF -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fptr Ptr BF -> IO ()
bf_set_nan


foreign import ccall "bf_set_zero"
  bf_set_zero :: Ptr BF -> CInt -> IO ()

-- | Assign a zero to the number.
setZero :: Sign -> BF -> IO ()
setZero :: Sign -> BF -> IO ()
setZero Sign
sig = (Ptr BF -> IO ()) -> BF -> IO ()
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (Ptr BF -> CInt -> IO ()
`bf_set_zero` Sign -> CInt
signToC Sign
sig)


foreign import ccall "bf_set_inf"
  bf_set_inf :: Ptr BF -> CInt -> IO ()

-- | Assign an infinty to the number.
setInf :: Sign -> BF -> IO ()
setInf :: Sign -> BF -> IO ()
setInf Sign
sig = (Ptr BF -> IO ()) -> BF -> IO ()
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (Ptr BF -> CInt -> IO ()
`bf_set_inf` Sign -> CInt
signToC Sign
sig)


foreign import ccall "bf_set_ui"
  bf_set_ui :: Ptr BF -> Word64 -> IO ()

{-| Assign from a word -}
setWord :: Word64 -> BF -> IO ()
setWord :: Word64 -> BF -> IO ()
setWord Word64
w = (Ptr BF -> IO ()) -> BF -> IO ()
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (Ptr BF -> Word64 -> IO ()
`bf_set_ui` Word64
w)


foreign import ccall "bf_set_si"
  bf_set_si :: Ptr BF -> Int64 -> IO ()

{-| Assign from an int -}
setInt :: Int64 -> BF -> IO ()
setInt :: Int64 -> BF -> IO ()
setInt Int64
s = (Ptr BF -> IO ()) -> BF -> IO ()
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (Ptr BF -> Int64 -> IO ()
`bf_set_si` Int64
s)

-- | Set an integer.  If the integer is larger than the primitive types,
-- this does repreated Int64 additions and multiplications.
setInteger :: Integer -> BF -> IO ()
setInteger :: Integer -> BF -> IO ()
setInteger Integer
n0 BF
bf0
  | Integer
n0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
maxBound :: Word64) =
    Word64 -> BF -> IO ()
setWord (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
n0) BF
bf0
  | Integer
n0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
&& Integer
n0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
minBound :: Int64) =
    Int64 -> BF -> IO ()
setInt (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
n0) BF
bf0
  | Bool
otherwise =
  do Sign -> BF -> IO ()
setZero Sign
Pos BF
bf0
     Integer -> BF -> IO ()
go (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n0) BF
bf0
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
n0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) (BF -> IO ()
fneg BF
bf0)
  where
  chunk :: Integer
chunk = Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
maxBound :: Int64) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1

  go :: Integer -> BF -> IO ()
go Integer
n BF
bf
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    | Bool
otherwise =
      do let (Integer
next,Integer
this) = Integer
n Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
chunk
         Integer -> BF -> IO ()
go Integer
next BF
bf
         Status
Ok <- BFOpts -> BF -> Word64 -> BF -> IO Status
fmulWord BFOpts
infPrec BF
bf (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
chunk) BF
bf
         Status
Ok <- BFOpts -> BF -> Int64 -> BF -> IO Status
faddInt  BFOpts
infPrec BF
bf (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
this)  BF
bf
         () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Chunk a non-negative integer into words,
-- least significatn first
toChunks :: Integer -> [LimbT]
toChunks :: Integer -> [Word64]
toChunks = (Integer -> Maybe (Word64, Integer)) -> Integer -> [Word64]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Integer -> Maybe (Word64, Integer)
step
  where
  step :: Integer -> Maybe (Word64, Integer)
step Integer
n = if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Maybe (Word64, Integer)
forall a. Maybe a
Nothing
                     else (Word64, Integer) -> Maybe (Word64, Integer)
forall a. a -> Maybe a
Just (Integer -> Word64
leastChunk Integer
n, Integer
n Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
unit)

  unit :: Int
unit = Int
64 :: Int
{-# LINE 253 "src/LibBF/Mutable.hsc" #-}
  mask = (1 `shiftL` unit) - 1

  leastChunk :: Integer -> LimbT
  leastChunk :: Integer -> Word64
leastChunk Integer
n = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
mask)



foreign import ccall "bf_set_float64"
  bf_set_float64 :: Ptr BF -> Double -> IO ()

{-| Assign from a double -}
setDouble :: Double -> BF -> IO ()
setDouble :: Double -> BF -> IO ()
setDouble Double
d = (Ptr BF -> IO ()) -> BF -> IO ()
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (Ptr BF -> Double -> IO ()
`bf_set_float64` Double
d)


foreign import ccall "bf_set"
  bf_set :: Ptr BF -> Ptr BF -> IO ()

{-| Assign from another number. -}
setBF :: BF -> BF {-^ This number is changed -} -> IO ()
setBF :: BF -> BF -> IO ()
setBF = (Ptr BF -> Ptr BF -> IO ()) -> BF -> BF -> IO ()
forall a. (Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> IO a
bf2 (\Ptr BF
out Ptr BF
in1 -> Ptr BF -> Ptr BF -> IO ()
bf_set Ptr BF
out Ptr BF
in1)


--------------------------------------------------------------------------------
-- Comparisons

foreign import capi "libbf.h bf_cmp_eq"
  bf_cmp_eq :: Ptr BF -> Ptr BF -> IO CInt

{-| Check if the two numbers are equal. -}
cmpEq :: BF -> BF -> IO Bool
cmpEq :: BF -> BF -> IO Bool
cmpEq = (Ptr BF -> Ptr BF -> IO CInt) -> BF -> BF -> IO Bool
bfRel Ptr BF -> Ptr BF -> IO CInt
bf_cmp_eq


foreign import capi "libbf.h bf_cmp_lt"
  bf_cmp_lt :: Ptr BF -> Ptr BF -> IO CInt

{-| Check if the first number is strictly less than the second. -}
cmpLT :: BF -> BF -> IO Bool
cmpLT :: BF -> BF -> IO Bool
cmpLT = (Ptr BF -> Ptr BF -> IO CInt) -> BF -> BF -> IO Bool
bfRel Ptr BF -> Ptr BF -> IO CInt
bf_cmp_lt


foreign import capi "libbf.h bf_cmp_le"
  bf_cmp_le :: Ptr BF -> Ptr BF -> IO CInt

{-| Check if the first number is less than, or equal to, the second. -}
cmpLEQ :: BF -> BF -> IO Bool
cmpLEQ :: BF -> BF -> IO Bool
cmpLEQ = (Ptr BF -> Ptr BF -> IO CInt) -> BF -> BF -> IO Bool
bfRel Ptr BF -> Ptr BF -> IO CInt
bf_cmp_le


foreign import ccall "bf_cmpu"
  bf_cmpu :: Ptr BF -> Ptr BF -> IO CInt

{-| Compare the absolute values of the two numbers. See also 'cmp'. -}
cmpAbs :: BF -> BF -> IO Ordering
cmpAbs :: BF -> BF -> IO Ordering
cmpAbs = (Ptr BF -> Ptr BF -> IO CInt) -> BF -> BF -> IO Ordering
bfOrd Ptr BF -> Ptr BF -> IO CInt
bf_cmpu


foreign import ccall "bf_cmp_full"
  bf_cmp_full :: Ptr BF -> Ptr BF -> IO CInt

{-| Compare the two numbers.  The special values are ordered like this:

      * -0 < 0
      * NaN == NaN
      * NaN is larger than all other numbers
-}
cmp :: BF -> BF -> IO Ordering
cmp :: BF -> BF -> IO Ordering
cmp = (Ptr BF -> Ptr BF -> IO CInt) -> BF -> BF -> IO Ordering
bfOrd Ptr BF -> Ptr BF -> IO CInt
bf_cmp_full







foreign import capi "libbf.h bf_is_finite"
  bf_is_finite :: Ptr BF -> IO CInt

foreign import capi "libbf.h bf_is_nan"
  bf_is_nan :: Ptr BF -> IO CInt

foreign import capi "libbf.h bf_is_zero"
  bf_is_zero :: Ptr BF -> IO CInt

{-| Check if the number is "normal", i.e. (not infinite or NaN) -}
isFinite :: BF -> IO Bool
isFinite :: BF -> IO Bool
isFinite = (Ptr BF -> IO CInt) -> BF -> IO Bool
bfQuery Ptr BF -> IO CInt
bf_is_finite

{-| Check if the number is NaN -}
isNaN :: BF -> IO Bool
isNaN :: BF -> IO Bool
isNaN = (Ptr BF -> IO CInt) -> BF -> IO Bool
bfQuery Ptr BF -> IO CInt
bf_is_nan

{-| Check if the given number is a zero. -}
isZero :: BF -> IO Bool
isZero :: BF -> IO Bool
isZero = (Ptr BF -> IO CInt) -> BF -> IO Bool
bfQuery Ptr BF -> IO CInt
bf_is_zero

foreign import capi "libbf.h bf_neg"
  bf_neg :: Ptr BF -> IO ()

foreign import ccall "bf_add"
  bf_add :: Ptr BF -> Ptr BF -> Ptr BF -> LimbT -> FlagsT -> IO Status

foreign import ccall "bf_add_si"
  bf_add_si :: Ptr BF -> Ptr BF -> Int64 -> LimbT -> FlagsT -> IO Status

foreign import ccall "bf_sub"
  bf_sub :: Ptr BF -> Ptr BF -> Ptr BF -> LimbT -> FlagsT -> IO Status

foreign import ccall "bf_mul"
  bf_mul :: Ptr BF -> Ptr BF -> Ptr BF -> LimbT -> FlagsT -> IO Status

foreign import ccall "bf_mul_si"
  bf_mul_si :: Ptr BF -> Ptr BF -> Int64 -> LimbT -> FlagsT -> IO Status

foreign import ccall "bf_mul_ui"
  bf_mul_ui :: Ptr BF -> Ptr BF -> Word64 -> LimbT -> FlagsT -> IO Status

foreign import ccall "bf_mul_2exp"
  bf_mul_2exp :: Ptr BF -> SLimbT -> LimbT -> FlagsT -> IO Status

foreign import ccall "bf_div"
  bf_div :: Ptr BF -> Ptr BF -> Ptr BF -> LimbT -> FlagsT -> IO Status

foreign import ccall "bf_rem"
  bf_rem :: Ptr BF -> Ptr BF -> Ptr BF -> LimbT -> FlagsT -> CInt -> IO Status

foreign import ccall "bf_pow"
  bf_pow :: Ptr BF -> Ptr BF -> Ptr BF -> LimbT -> FlagsT -> IO Status

foreign import ccall "bf_round"
  bf_round :: Ptr BF -> LimbT -> FlagsT -> IO Status

foreign import ccall "bf_rint"
  bf_rint :: Ptr BF -> CInt -> IO Status

foreign import ccall "bf_sqrt"
  bf_sqrt :: Ptr BF -> Ptr BF -> LimbT -> FlagsT -> IO Status



bfArith :: (Ptr BF -> Ptr BF -> Ptr BF -> LimbT -> FlagsT -> IO Status) ->
           BFOpts -> BF -> BF -> BF -> IO Status
bfArith :: (Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status)
-> BFOpts -> BF -> BF -> BF -> IO Status
bfArith Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status
fun (BFOpts Word64
prec FlagsT
flags) (BF ForeignPtr BF
fa) (BF ForeignPtr BF
fb) (BF ForeignPtr BF
fr) =
  ForeignPtr BF -> (Ptr BF -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fa \Ptr BF
a ->
  ForeignPtr BF -> (Ptr BF -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fb \Ptr BF
b ->
  ForeignPtr BF -> (Ptr BF -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fr \Ptr BF
r ->
  Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status
fun Ptr BF
r Ptr BF
a Ptr BF
b Word64
prec FlagsT
flags


-- | Negate the number.
fneg :: BF -> IO ()
fneg :: BF -> IO ()
fneg = (Ptr BF -> IO ()) -> BF -> IO ()
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 Ptr BF -> IO ()
bf_neg

-- | Add two numbers, using the given settings, and store the
-- result in the last.
fadd :: BFOpts -> BF -> BF -> BF -> IO Status
fadd :: BFOpts -> BF -> BF -> BF -> IO Status
fadd = (Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status)
-> BFOpts -> BF -> BF -> BF -> IO Status
bfArith Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status
bf_add

-- | Add a number and an int64 and store the result in the last.
faddInt :: BFOpts -> BF -> Int64 -> BF -> IO Status
faddInt :: BFOpts -> BF -> Int64 -> BF -> IO Status
faddInt (BFOpts Word64
p FlagsT
f) BF
x Int64
y BF
z = (Ptr BF -> Ptr BF -> IO Status) -> BF -> BF -> IO Status
forall a. (Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> IO a
bf2 (\Ptr BF
out Ptr BF
in1 -> Ptr BF -> Ptr BF -> Int64 -> Word64 -> FlagsT -> IO Status
bf_add_si Ptr BF
out Ptr BF
in1 Int64
y Word64
p FlagsT
f) BF
x BF
z

-- | Subtract two numbers, using the given settings, and store the
-- result in the last.
fsub :: BFOpts -> BF -> BF -> BF -> IO Status
fsub :: BFOpts -> BF -> BF -> BF -> IO Status
fsub = (Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status)
-> BFOpts -> BF -> BF -> BF -> IO Status
bfArith Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status
bf_sub

-- | Multiply two numbers, using the given settings, and store the
-- result in the last.
fmul :: BFOpts -> BF -> BF -> BF -> IO Status
fmul :: BFOpts -> BF -> BF -> BF -> IO Status
fmul = (Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status)
-> BFOpts -> BF -> BF -> BF -> IO Status
bfArith Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status
bf_mul

-- | Compute the fused-multiply-add.
--   @ffma opts x y z r@ computes @r := (x*y)+z@.
ffma :: BFOpts -> BF -> BF -> BF -> BF -> IO Status
ffma :: BFOpts -> BF -> BF -> BF -> BF -> IO Status
ffma (BFOpts Word64
prec FlagsT
f) (BF ForeignPtr BF
x) (BF ForeignPtr BF
y) (BF ForeignPtr BF
z) (BF ForeignPtr BF
r) =
  ForeignPtr BF -> (Ptr BF -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
x \Ptr BF
xp ->
  ForeignPtr BF -> (Ptr BF -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
y \Ptr BF
yp ->
  ForeignPtr BF -> (Ptr BF -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
z \Ptr BF
zp ->
  ForeignPtr BF -> (Ptr BF -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
r \Ptr BF
out ->
    do Status
s1 <- Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status
bf_mul Ptr BF
out Ptr BF
xp Ptr BF
yp Word64
4611686018427387903 FlagsT
0
{-# LINE 435 "src/LibBF/Mutable.hsc" #-}
       case s1 of
         MemError -> return s1
         _ ->
           do s2 <- bf_add out out zp prec f
              pure (s1 <> s2)

-- | Multiply the number by the given word, and store the result
-- in the second number.
fmulWord :: BFOpts -> BF -> Word64 -> BF -> IO Status
fmulWord :: BFOpts -> BF -> Word64 -> BF -> IO Status
fmulWord (BFOpts Word64
p FlagsT
f) BF
x Word64
y BF
z = (Ptr BF -> Ptr BF -> IO Status) -> BF -> BF -> IO Status
forall a. (Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> IO a
bf2 (\Ptr BF
out Ptr BF
in1 -> Ptr BF -> Ptr BF -> Word64 -> Word64 -> FlagsT -> IO Status
bf_mul_ui Ptr BF
out Ptr BF
in1 Word64
y Word64
p FlagsT
f) BF
x BF
z

-- | Multiply the number by the given int, and store the result
-- in the second number.
fmulInt :: BFOpts -> BF -> Int64 -> BF -> IO Status
fmulInt :: BFOpts -> BF -> Int64 -> BF -> IO Status
fmulInt (BFOpts Word64
p FlagsT
f) BF
x Int64
y BF
z = (Ptr BF -> Ptr BF -> IO Status) -> BF -> BF -> IO Status
forall a. (Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> IO a
bf2 (\Ptr BF
out Ptr BF
in1 -> Ptr BF -> Ptr BF -> Int64 -> Word64 -> FlagsT -> IO Status
bf_mul_si Ptr BF
out Ptr BF
in1 Int64
y Word64
p FlagsT
f) BF
x BF
z

-- | Multiply the number by @2^e@.
fmul2Exp :: BFOpts -> Int64 -> BF -> IO Status
fmul2Exp :: BFOpts -> Int64 -> BF -> IO Status
fmul2Exp (BFOpts Word64
p FlagsT
f) Int64
e = (Ptr BF -> IO Status) -> BF -> IO Status
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (\Ptr BF
out -> Ptr BF -> Int64 -> Word64 -> FlagsT -> IO Status
bf_mul_2exp Ptr BF
out Int64
e Word64
p FlagsT
f)

-- | Divide two numbers, using the given settings, and store the
-- result in the last.
fdiv :: BFOpts -> BF -> BF -> BF -> IO Status
fdiv :: BFOpts -> BF -> BF -> BF -> IO Status
fdiv = (Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status)
-> BFOpts -> BF -> BF -> BF -> IO Status
bfArith Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status
bf_div

-- | Compute the remainder @x - y * n@ where @n@ is the integer
--   nearest to @x/y@ (with ties broken to even values of @n@).
--   Output is written into the final argument.
frem :: BFOpts -> BF -> BF -> BF -> IO Status
frem :: BFOpts -> BF -> BF -> BF -> IO Status
frem (BFOpts Word64
p FlagsT
f) (BF ForeignPtr BF
fin1) (BF ForeignPtr BF
fin2) (BF ForeignPtr BF
fout) =
  ForeignPtr BF -> (Ptr BF -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fin1 \Ptr BF
in1 ->
  ForeignPtr BF -> (Ptr BF -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fin2 \Ptr BF
in2 ->
  ForeignPtr BF -> (Ptr BF -> IO Status) -> IO Status
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BF
fout \Ptr BF
out ->
    Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> CInt -> IO Status
bf_rem Ptr BF
out Ptr BF
in1 Ptr BF
in2 Word64
p FlagsT
f CInt
0
{-# LINE 469 "src/LibBF/Mutable.hsc" #-}

-- | Compute the square root of the first number and store the result
-- in the second.
fsqrt :: BFOpts -> BF -> BF -> IO Status
fsqrt :: BFOpts -> BF -> BF -> IO Status
fsqrt (BFOpts Word64
p FlagsT
f) = (Ptr BF -> Ptr BF -> IO Status) -> BF -> BF -> IO Status
forall a. (Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> IO a
bf2 (\Ptr BF
res Ptr BF
inp -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status
bf_sqrt Ptr BF
res Ptr BF
inp Word64
p FlagsT
f)

-- | Round to the nearest float matching the configuration parameters.
fround :: BFOpts -> BF -> IO Status
fround :: BFOpts -> BF -> IO Status
fround (BFOpts Word64
p FlagsT
f) = (Ptr BF -> IO Status) -> BF -> IO Status
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (\Ptr BF
ptr -> Ptr BF -> Word64 -> FlagsT -> IO Status
bf_round Ptr BF
ptr Word64
p FlagsT
f)

-- | Round to the neareset integer.
frint :: RoundMode -> BF -> IO Status
frint :: RoundMode -> BF -> IO Status
frint (RoundMode FlagsT
r) = (Ptr BF -> IO Status) -> BF -> IO Status
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (\Ptr BF
ptr -> Ptr BF -> CInt -> IO Status
bf_rint Ptr BF
ptr (FlagsT -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral FlagsT
r :: CInt))

-- | Exponentiate the first number by the second,
-- and store the result in the third number.
fpow :: BFOpts -> BF -> BF -> BF -> IO Status
fpow :: BFOpts -> BF -> BF -> BF -> IO Status
fpow (BFOpts Word64
prec FlagsT
flags) = (Ptr BF -> Ptr BF -> Ptr BF -> IO Status)
-> BF -> BF -> BF -> IO Status
forall a.
(Ptr BF -> Ptr BF -> Ptr BF -> IO a) -> BF -> BF -> BF -> IO a
bf3 (\Ptr BF
out Ptr BF
in1 Ptr BF
in2 -> Ptr BF -> Ptr BF -> Ptr BF -> Word64 -> FlagsT -> IO Status
bf_pow Ptr BF
out Ptr BF
in1 Ptr BF
in2 Word64
prec FlagsT
flags)





--------------------------------------------------------------------------------
-- export

foreign import ccall "bf_get_float64"
  bf_get_float64 :: Ptr BF -> Ptr Double -> RoundMode -> IO Status

-- | Get the current value of a 'BF' as a Haskell `Double`.
toDouble :: RoundMode -> BF -> IO (Double, Status)
toDouble :: RoundMode -> BF -> IO (Double, Status)
toDouble RoundMode
r = (Ptr BF -> IO (Double, Status)) -> BF -> IO (Double, Status)
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (\Ptr BF
inp ->
  (Ptr Double -> IO (Double, Status)) -> IO (Double, Status)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr Double
out ->
   do Status
s <- Ptr BF -> Ptr Double -> RoundMode -> IO Status
bf_get_float64 Ptr BF
inp Ptr Double
out RoundMode
r
      Double
d <- Ptr Double -> IO Double
forall a. Storable a => Ptr a -> IO a
peek Ptr Double
out
      (Double, Status) -> IO (Double, Status)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
d, Status
s)
  ))


foreign import ccall "bf_atof"
  bf_atof ::
    Ptr BF -> CString -> Ptr CString -> CInt -> LimbT -> FlagsT -> IO CInt


{- | Set the value to the float parsed out of the given string.
  * The radix should not exceed 'LibBF.Opts.maxRadix'.
  * Sets the number to @NaN@ on failure.
  * Assumes that characters are encoded with a single byte each.
  * Retruns:
      - Status for the conversion
      - How many bytes we consumed
      - Did we consume the whole input
-}
setString :: Int -> BFOpts -> String -> BF -> IO (Status,Int,Bool)
setString :: Int -> BFOpts -> String -> BF -> IO (Status, Int, Bool)
setString Int
radix (BFOpts Word64
prec FlagsT
flags) String
inStr =
  (Ptr BF -> IO (Status, Int, Bool)) -> BF -> IO (Status, Int, Bool)
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1    \Ptr BF
bfPtr ->
  (Ptr CString -> IO (Status, Int, Bool)) -> IO (Status, Int, Bool)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr CString
nextPtr ->
  String
-> (CString -> IO (Status, Int, Bool)) -> IO (Status, Int, Bool)
forall a. String -> (CString -> IO a) -> IO a
withCAString String
inStr \CString
strPtr ->
  do CInt
stat <- Ptr BF
-> CString -> Ptr CString -> CInt -> Word64 -> FlagsT -> IO CInt
bf_atof Ptr BF
bfPtr CString
strPtr Ptr CString
nextPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radix) Word64
prec FlagsT
flags
     CString
next <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
nextPtr
     let consumed :: Int
consumed = CString
next CString -> CString -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` CString
strPtr
         usedAll :: Bool
usedAll = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
inStr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
consumed
     Int
consumed Int -> IO (Status, Int, Bool) -> IO (Status, Int, Bool)
`seq` Bool
usedAll Bool -> IO (Status, Int, Bool) -> IO (Status, Int, Bool)
`seq` (Status, Int, Bool) -> IO (Status, Int, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> Status
Status CInt
stat, Int
consumed, Bool
usedAll)


foreign import ccall "bf_ftoa"
  bf_ftoa :: Ptr CSize -> Ptr BF -> CInt -> LimbT -> FlagsT -> IO CString

-- | Render a big-float as a Haskell string.
-- The radix should not exceed 'LibBF.Opts.maxRadix'.
toString :: Int -> ShowFmt -> BF -> IO String
toString :: Int -> ShowFmt -> BF -> IO String
toString Int
radix (ShowFmt Word64
ds FlagsT
flags) =
  (Ptr BF -> IO String) -> BF -> IO String
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 \Ptr BF
inp ->
  (Ptr CSize -> IO String) -> IO String
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr CSize
out ->
  do CString
ptr <- Ptr CSize -> Ptr BF -> CInt -> Word64 -> FlagsT -> IO CString
bf_ftoa Ptr CSize
out Ptr BF
inp (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radix) Word64
ds FlagsT
flags
     CSize
len <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
out
     if CSize
len CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
0
       then
         do String
res <- CString -> IO String
peekCString CString
ptr
            CString -> IO ()
forall a. Ptr a -> IO ()
free CString
ptr
            String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
res
       else String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"(error)" -- XXX: throw an exception


-- | An explicit representation for big nums.
data BFRep  = BFRep !Sign !BFNum    -- ^ A signed number
            | BFNaN                 -- ^ Not a number
              deriving (BFRep -> BFRep -> Bool
(BFRep -> BFRep -> Bool) -> (BFRep -> BFRep -> Bool) -> Eq BFRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BFRep -> BFRep -> Bool
$c/= :: BFRep -> BFRep -> Bool
== :: BFRep -> BFRep -> Bool
$c== :: BFRep -> BFRep -> Bool
Eq,Eq BFRep
Eq BFRep
-> (BFRep -> BFRep -> Ordering)
-> (BFRep -> BFRep -> Bool)
-> (BFRep -> BFRep -> Bool)
-> (BFRep -> BFRep -> Bool)
-> (BFRep -> BFRep -> Bool)
-> (BFRep -> BFRep -> BFRep)
-> (BFRep -> BFRep -> BFRep)
-> Ord BFRep
BFRep -> BFRep -> Bool
BFRep -> BFRep -> Ordering
BFRep -> BFRep -> BFRep
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BFRep -> BFRep -> BFRep
$cmin :: BFRep -> BFRep -> BFRep
max :: BFRep -> BFRep -> BFRep
$cmax :: BFRep -> BFRep -> BFRep
>= :: BFRep -> BFRep -> Bool
$c>= :: BFRep -> BFRep -> Bool
> :: BFRep -> BFRep -> Bool
$c> :: BFRep -> BFRep -> Bool
<= :: BFRep -> BFRep -> Bool
$c<= :: BFRep -> BFRep -> Bool
< :: BFRep -> BFRep -> Bool
$c< :: BFRep -> BFRep -> Bool
compare :: BFRep -> BFRep -> Ordering
$ccompare :: BFRep -> BFRep -> Ordering
$cp1Ord :: Eq BFRep
Ord,Int -> BFRep -> ShowS
[BFRep] -> ShowS
BFRep -> String
(Int -> BFRep -> ShowS)
-> (BFRep -> String) -> ([BFRep] -> ShowS) -> Show BFRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BFRep] -> ShowS
$cshowList :: [BFRep] -> ShowS
show :: BFRep -> String
$cshow :: BFRep -> String
showsPrec :: Int -> BFRep -> ShowS
$cshowsPrec :: Int -> BFRep -> ShowS
Show)

instance Hashable BFRep where
  hashWithSalt :: Int -> BFRep -> Int
hashWithSalt Int
s BFRep
BFNaN           = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0::Int)
  hashWithSalt Int
s (BFRep Sign
Pos BFNum
num) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1::Int) Int -> BFNum -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` BFNum
num
  hashWithSalt Int
s (BFRep Sign
Neg BFNum
num) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2::Int) Int -> BFNum -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` BFNum
num

-- | Representations for unsigned floating point numbers.
data BFNum  = Zero                 -- ^ zero
            | Num Integer !Int64   -- ^ @x * 2 ^ y@
            | Inf                  -- ^ infinity
              deriving (BFNum -> BFNum -> Bool
(BFNum -> BFNum -> Bool) -> (BFNum -> BFNum -> Bool) -> Eq BFNum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BFNum -> BFNum -> Bool
$c/= :: BFNum -> BFNum -> Bool
== :: BFNum -> BFNum -> Bool
$c== :: BFNum -> BFNum -> Bool
Eq,Eq BFNum
Eq BFNum
-> (BFNum -> BFNum -> Ordering)
-> (BFNum -> BFNum -> Bool)
-> (BFNum -> BFNum -> Bool)
-> (BFNum -> BFNum -> Bool)
-> (BFNum -> BFNum -> Bool)
-> (BFNum -> BFNum -> BFNum)
-> (BFNum -> BFNum -> BFNum)
-> Ord BFNum
BFNum -> BFNum -> Bool
BFNum -> BFNum -> Ordering
BFNum -> BFNum -> BFNum
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BFNum -> BFNum -> BFNum
$cmin :: BFNum -> BFNum -> BFNum
max :: BFNum -> BFNum -> BFNum
$cmax :: BFNum -> BFNum -> BFNum
>= :: BFNum -> BFNum -> Bool
$c>= :: BFNum -> BFNum -> Bool
> :: BFNum -> BFNum -> Bool
$c> :: BFNum -> BFNum -> Bool
<= :: BFNum -> BFNum -> Bool
$c<= :: BFNum -> BFNum -> Bool
< :: BFNum -> BFNum -> Bool
$c< :: BFNum -> BFNum -> Bool
compare :: BFNum -> BFNum -> Ordering
$ccompare :: BFNum -> BFNum -> Ordering
$cp1Ord :: Eq BFNum
Ord,Int -> BFNum -> ShowS
[BFNum] -> ShowS
BFNum -> String
(Int -> BFNum -> ShowS)
-> (BFNum -> String) -> ([BFNum] -> ShowS) -> Show BFNum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BFNum] -> ShowS
$cshowList :: [BFNum] -> ShowS
show :: BFNum -> String
$cshow :: BFNum -> String
showsPrec :: Int -> BFNum -> ShowS
$cshowsPrec :: Int -> BFNum -> ShowS
Show)

instance Hashable BFNum where
  hashWithSalt :: Int -> BFNum -> Int
hashWithSalt Int
s BFNum
Zero         = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0::Int)
  hashWithSalt Int
s (Num Integer
mag Int64
ex) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1::Int) Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Integer
mag Int -> Int64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int64
ex
  hashWithSalt Int
s BFNum
Inf          = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2::Int)

-- | Returns 'Nothing' for @NaN@.
getSign :: BF -> IO (Maybe Sign)
getSign :: BF -> IO (Maybe Sign)
getSign = (Ptr BF -> IO (Maybe Sign)) -> BF -> IO (Maybe Sign)
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (\Ptr BF
ptr ->
  do Int64
e <- (\Ptr BF
hsc_ptr -> Ptr BF -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr BF
hsc_ptr Int
16) Ptr BF
ptr
{-# LINE 578 "src/LibBF/Mutable.hsc" #-}
     if (e :: SLimbT) == 9223372036854775807
{-# LINE 579 "src/LibBF/Mutable.hsc" #-}
        then pure Nothing
        else (Just . asSign) <$> (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr)
{-# LINE 581 "src/LibBF/Mutable.hsc" #-}

-- | Get the exponent of the number.
-- Returns 'Nothing' for inifinity, zero and NaN.
getExp :: BF -> IO (Maybe Int64)
getExp :: BF -> IO (Maybe Int64)
getExp = (Ptr BF -> IO (Maybe Int64)) -> BF -> IO (Maybe Int64)
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (\Ptr BF
ptr ->
  do Int64
e <- (\Ptr BF
hsc_ptr -> Ptr BF -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr BF
hsc_ptr Int
16) Ptr BF
ptr
{-# LINE 587 "src/LibBF/Mutable.hsc" #-}
     pure $! if (e :: SLimbT) < 9223372036854775806 &&
{-# LINE 588 "src/LibBF/Mutable.hsc" #-}
                e > -9223372036854775808 then Just (fromIntegral e)
{-# LINE 589 "src/LibBF/Mutable.hsc" #-}
                                         else Nothing)

{-| Check if the given numer is infinite. -}
isInf :: BF -> IO Bool
isInf :: BF -> IO Bool
isInf = (Ptr BF -> IO Bool) -> BF -> IO Bool
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (\Ptr BF
ptr ->
  do Int64
e <- (\Ptr BF
hsc_ptr -> Ptr BF -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr BF
hsc_ptr Int
16) Ptr BF
ptr
{-# LINE 595 "src/LibBF/Mutable.hsc" #-}
     if | (e :: SLimbT) == 9223372036854775806 -> pure True
{-# LINE 596 "src/LibBF/Mutable.hsc" #-}
        | otherwise -> pure False)

-- | Get the representation of the number.
toRep :: BF -> IO BFRep
toRep :: BF -> IO BFRep
toRep = (Ptr BF -> IO BFRep) -> BF -> IO BFRep
forall a. (Ptr BF -> IO a) -> BF -> IO a
bf1 (\Ptr BF
ptr ->
  do CInt
s <- (\Ptr BF
hsc_ptr -> Ptr BF -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr BF
hsc_ptr Int
8) Ptr BF
ptr
{-# LINE 602 "src/LibBF/Mutable.hsc" #-}
     let sgn = if asBool s then Neg else Pos
     Int64
e <- (\Ptr BF
hsc_ptr -> Ptr BF -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr BF
hsc_ptr Int
16) Ptr BF
ptr
{-# LINE 604 "src/LibBF/Mutable.hsc" #-}
     if | e == 9223372036854775807  -> pure BFNaN
{-# LINE 605 "src/LibBF/Mutable.hsc" #-}
        | e == 9223372036854775806  -> pure (BFRep sgn Inf)
{-# LINE 606 "src/LibBF/Mutable.hsc" #-}
        | e == -9223372036854775808 -> pure (BFRep sgn Zero)
{-# LINE 607 "src/LibBF/Mutable.hsc" #-}
        | otherwise ->
        do l <- (\hsc_ptr -> peekByteOff hsc_ptr 24)  ptr
{-# LINE 609 "src/LibBF/Mutable.hsc" #-}
           p <- (\hsc_ptr -> peekByteOff hsc_ptr 32)  ptr
{-# LINE 610 "src/LibBF/Mutable.hsc" #-}
           let len = fromIntegral (l :: Word64) :: Int
               -- This should not really limit precision as it counts
               -- number of Word64s (not bytes)

               step x i = do w <- peekElemOff p i
                             pure ((x `shiftL` 64) + fromIntegral (w :: Word64))

           base <- foldM step 0 (reverse (take len [ 0 .. ]))
           let bias = 64 * fromIntegral len
               norm bs bi
                 | even bs    = norm (bs `shiftR` 1) (bi - 1)
                 | otherwise  = BFRep sgn (Num bs (e - bi))

           pure (norm base bias) -- (BFRep sgn (Num base (e - bias)))
  )