module Data.Number.Flint.Calcium.Fexpr.Instances where

import System.IO.Unsafe

import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import Foreign.Storable
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Array (advancePtr)

import qualified Data.Map as Map
import Data.Map (Map, (!), (!?))

import Data.Number.Flint.Fmpz
import Data.Number.Flint.Fmpq
import Data.Number.Flint.Fmpz.Instances
import Data.Number.Flint.Arb.Arf
import Data.Number.Flint.Calcium.Fexpr
import Data.Number.Flint.Calcium.Fexpr.Builtin

instance Show Fexpr where
  show :: Fexpr -> String
show Fexpr
x = (Fexpr, String) -> String
forall a b. (a, b) -> b
snd ((Fexpr, String) -> String) -> (Fexpr, String) -> String
forall a b. (a -> b) -> a -> b
$ IO (Fexpr, String) -> (Fexpr, String)
forall a. IO a -> a
unsafePerformIO (IO (Fexpr, String) -> (Fexpr, String))
-> IO (Fexpr, String) -> (Fexpr, String)
forall a b. (a -> b) -> a -> b
$ do
    Fexpr -> (Ptr CFexpr -> IO String) -> IO (Fexpr, String)
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
x ((Ptr CFexpr -> IO String) -> IO (Fexpr, String))
-> (Ptr CFexpr -> IO String) -> IO (Fexpr, String)
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
x -> do
      CString
cs <- Ptr CFexpr -> IO CString
fexpr_get_str Ptr CFexpr
x
      String
s <- CString -> IO String
peekCString CString
cs
      CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cs
      String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
s

instance Num Fexpr where
  {-# INLINE (+) #-}
  + :: Fexpr -> Fexpr -> Fexpr
(+) = (Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO ())
-> Fexpr -> Fexpr -> Fexpr
forall {a}.
(Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO a)
-> Fexpr -> Fexpr -> Fexpr
lift2 Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO ()
fexpr_add
  {-# INLINE (-) #-}
  (-) = (Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO ())
-> Fexpr -> Fexpr -> Fexpr
forall {a}.
(Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO a)
-> Fexpr -> Fexpr -> Fexpr
lift2 Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO ()
fexpr_sub
  {-# INLINE (*) #-}
  * :: Fexpr -> Fexpr -> Fexpr
(*) = (Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO ())
-> Fexpr -> Fexpr -> Fexpr
forall {a}.
(Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO a)
-> Fexpr -> Fexpr -> Fexpr
lift2 Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO ()
fexpr_mul
  negate :: Fexpr -> Fexpr
negate = (Ptr CFexpr -> Ptr CFexpr -> IO ()) -> Fexpr -> Fexpr
forall {a}. (Ptr CFexpr -> Ptr CFexpr -> IO a) -> Fexpr -> Fexpr
lift1 Ptr CFexpr -> Ptr CFexpr -> IO ()
fexpr_neg
  abs :: Fexpr -> Fexpr
abs    = Fexpr -> Fexpr
forall a. HasCallStack => a
undefined
  fromInteger :: Integer -> Fexpr
fromInteger Integer
x = IO Fexpr -> Fexpr
forall a. IO a -> a
unsafePerformIO (IO Fexpr -> Fexpr) -> IO Fexpr -> Fexpr
forall a b. (a -> b) -> a -> b
$ do
    Fexpr
expr <- IO Fexpr
newFexpr
    Fexpr -> (Ptr CFexpr -> IO (Fmpz, ())) -> IO (Fexpr, (Fmpz, ()))
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
expr ((Ptr CFexpr -> IO (Fmpz, ())) -> IO (Fexpr, (Fmpz, ())))
-> (Ptr CFexpr -> IO (Fmpz, ())) -> IO (Fexpr, (Fmpz, ()))
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
expr -> do
      Fmpz -> (Ptr CFmpz -> IO ()) -> IO (Fmpz, ())
forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz (Integer -> Fmpz
forall a. Num a => Integer -> a
fromInteger Integer
x) ((Ptr CFmpz -> IO ()) -> IO (Fmpz, ()))
-> (Ptr CFmpz -> IO ()) -> IO (Fmpz, ())
forall a b. (a -> b) -> a -> b
$ \Ptr CFmpz
tmp -> do
        Ptr CFexpr -> Ptr CFmpz -> IO ()
fexpr_set_fmpz Ptr CFexpr
expr Ptr CFmpz
tmp
    Fexpr -> IO Fexpr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
expr
  signum :: Fexpr -> Fexpr
signum = Fexpr -> Fexpr
forall a. HasCallStack => a
undefined

class FlintExpression a where
  toFexpr :: a -> IO Fexpr

instance FlintExpression FEXR_Builtin where
  toFexpr :: FEXR_Builtin -> IO Fexpr
toFexpr FEXR_Builtin
x = do
    Fexpr
result <- IO Fexpr
newFexpr
    Fexpr -> (Ptr CFexpr -> IO ()) -> IO (Fexpr, ())
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result ((Ptr CFexpr -> IO ()) -> IO (Fexpr, ()))
-> (Ptr CFexpr -> IO ()) -> IO (Fexpr, ())
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
result -> do
      Ptr CFexpr -> CLong -> IO ()
fexpr_set_symbol_builtin Ptr CFexpr
result (Map FEXR_Builtin CLong
fexpr_builtin_hash Map FEXR_Builtin CLong -> FEXR_Builtin -> CLong
forall k a. Ord k => Map k a -> k -> a
! FEXR_Builtin
x)
    Fexpr -> IO Fexpr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
result

instance FlintExpression Fmpz where
  toFexpr :: Fmpz -> IO Fexpr
toFexpr Fmpz
x = do
    Fexpr
result <- IO Fexpr
newFexpr
    Fexpr -> (Ptr CFexpr -> IO (Fmpz, ())) -> IO (Fexpr, (Fmpz, ()))
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result ((Ptr CFexpr -> IO (Fmpz, ())) -> IO (Fexpr, (Fmpz, ())))
-> (Ptr CFexpr -> IO (Fmpz, ())) -> IO (Fexpr, (Fmpz, ()))
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
expr -> do
      Fmpz -> (Ptr CFmpz -> IO ()) -> IO (Fmpz, ())
forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz Fmpz
x ((Ptr CFmpz -> IO ()) -> IO (Fmpz, ()))
-> (Ptr CFmpz -> IO ()) -> IO (Fmpz, ())
forall a b. (a -> b) -> a -> b
$ \Ptr CFmpz
x -> do
        Ptr CFexpr -> Ptr CFmpz -> IO ()
fexpr_set_fmpz Ptr CFexpr
expr Ptr CFmpz
x
    Fexpr -> IO Fexpr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
result

instance FlintExpression Fmpq where
  toFexpr :: Fmpq -> IO Fexpr
toFexpr Fmpq
x = do
    Fexpr
result <- IO Fexpr
newFexpr
    Fexpr -> (Ptr CFexpr -> IO (Fmpq, ())) -> IO (Fexpr, (Fmpq, ()))
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result ((Ptr CFexpr -> IO (Fmpq, ())) -> IO (Fexpr, (Fmpq, ())))
-> (Ptr CFexpr -> IO (Fmpq, ())) -> IO (Fexpr, (Fmpq, ()))
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
expr -> do
      Fmpq -> (Ptr CFmpq -> IO ()) -> IO (Fmpq, ())
forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
x ((Ptr CFmpq -> IO ()) -> IO (Fmpq, ()))
-> (Ptr CFmpq -> IO ()) -> IO (Fmpq, ())
forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
x -> do
        Ptr CFexpr -> Ptr CFmpq -> IO ()
fexpr_set_fmpq Ptr CFexpr
expr Ptr CFmpq
x
    Fexpr -> IO Fexpr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
result

instance FlintExpression CDouble where
  toFexpr :: CDouble -> IO Fexpr
toFexpr = (Ptr CFexpr -> CDouble -> IO ()) -> CDouble -> IO Fexpr
forall {t} {a}. (Ptr CFexpr -> t -> IO a) -> t -> IO Fexpr
liftTo Ptr CFexpr -> CDouble -> IO ()
fexpr_set_d

instance FlintExpression CLong where
  toFexpr :: CLong -> IO Fexpr
toFexpr = (Ptr CFexpr -> CLong -> IO ()) -> CLong -> IO Fexpr
forall {t} {a}. (Ptr CFexpr -> t -> IO a) -> t -> IO Fexpr
liftTo Ptr CFexpr -> CLong -> IO ()
fexpr_set_si

instance FlintExpression CULong where
  toFexpr :: CULong -> IO Fexpr
toFexpr = (Ptr CFexpr -> CULong -> IO ()) -> CULong -> IO Fexpr
forall {t} {a}. (Ptr CFexpr -> t -> IO a) -> t -> IO Fexpr
liftTo Ptr CFexpr -> CULong -> IO ()
fexpr_set_ui

instance FlintExpression Arf where
  toFexpr :: Arf -> IO Fexpr
toFexpr Arf
x = do
    Fexpr
result <- IO Fexpr
newFexpr
    Fexpr -> (Ptr CFexpr -> IO (Arf, ())) -> IO (Fexpr, (Arf, ()))
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result ((Ptr CFexpr -> IO (Arf, ())) -> IO (Fexpr, (Arf, ())))
-> (Ptr CFexpr -> IO (Arf, ())) -> IO (Fexpr, (Arf, ()))
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
expr -> do
      Arf -> (Ptr CArf -> IO ()) -> IO (Arf, ())
forall {a}. Arf -> (Ptr CArf -> IO a) -> IO (Arf, a)
withArf Arf
x ((Ptr CArf -> IO ()) -> IO (Arf, ()))
-> (Ptr CArf -> IO ()) -> IO (Arf, ())
forall a b. (a -> b) -> a -> b
$ \Ptr CArf
x -> do
        Ptr CFexpr -> Ptr CArf -> IO ()
fexpr_set_arf Ptr CFexpr
expr Ptr CArf
x
    Fexpr -> IO Fexpr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
result

instance FlintExpression String where
  toFexpr :: String -> IO Fexpr
toFexpr String
name = do
    Fexpr
result <- IO Fexpr
newFexpr
    Fexpr -> (Ptr CFexpr -> IO ()) -> IO (Fexpr, ())
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result ((Ptr CFexpr -> IO ()) -> IO (Fexpr, ()))
-> (Ptr CFexpr -> IO ()) -> IO (Fexpr, ())
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
result -> do
      String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
name -> do
        Ptr CFexpr -> CString -> IO ()
fexpr_set_symbol_str Ptr CFexpr
result CString
name
    Fexpr -> IO Fexpr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
result

--------------------------------------------------------------------------------

lift1 :: (Ptr CFexpr -> Ptr CFexpr -> IO a) -> Fexpr -> Fexpr
lift1 Ptr CFexpr -> Ptr CFexpr -> IO a
f Fexpr
x = IO Fexpr -> Fexpr
forall a. IO a -> a
unsafePerformIO (IO Fexpr -> Fexpr) -> IO Fexpr -> Fexpr
forall a b. (a -> b) -> a -> b
$ do
  Fexpr
z <- IO Fexpr
newFexpr
  Fexpr -> (Ptr CFexpr -> IO (Fexpr, a)) -> IO (Fexpr, (Fexpr, a))
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
x ((Ptr CFexpr -> IO (Fexpr, a)) -> IO (Fexpr, (Fexpr, a)))
-> (Ptr CFexpr -> IO (Fexpr, a)) -> IO (Fexpr, (Fexpr, a))
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
x ->
    Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
z ((Ptr CFexpr -> IO a) -> IO (Fexpr, a))
-> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
z -> Ptr CFexpr -> Ptr CFexpr -> IO a
f Ptr CFexpr
z Ptr CFexpr
x
  Fexpr -> IO Fexpr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
z
  
lift2 :: (Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO a)
-> Fexpr -> Fexpr -> Fexpr
lift2 Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO a
f Fexpr
x Fexpr
y = IO Fexpr -> Fexpr
forall a. IO a -> a
unsafePerformIO (IO Fexpr -> Fexpr) -> IO Fexpr -> Fexpr
forall a b. (a -> b) -> a -> b
$ do
  Fexpr
z <- IO Fexpr
newFexpr
  Fexpr
-> (Ptr CFexpr -> IO (Fexpr, (Fexpr, a)))
-> IO (Fexpr, (Fexpr, (Fexpr, a)))
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
x ((Ptr CFexpr -> IO (Fexpr, (Fexpr, a)))
 -> IO (Fexpr, (Fexpr, (Fexpr, a))))
-> (Ptr CFexpr -> IO (Fexpr, (Fexpr, a)))
-> IO (Fexpr, (Fexpr, (Fexpr, a)))
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
x ->
    Fexpr -> (Ptr CFexpr -> IO (Fexpr, a)) -> IO (Fexpr, (Fexpr, a))
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
y ((Ptr CFexpr -> IO (Fexpr, a)) -> IO (Fexpr, (Fexpr, a)))
-> (Ptr CFexpr -> IO (Fexpr, a)) -> IO (Fexpr, (Fexpr, a))
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
y ->
      Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
z ((Ptr CFexpr -> IO a) -> IO (Fexpr, a))
-> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
z -> Ptr CFexpr -> Ptr CFexpr -> Ptr CFexpr -> IO a
f Ptr CFexpr
z Ptr CFexpr
x Ptr CFexpr
y
  Fexpr -> IO Fexpr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
z

liftTo :: (Ptr CFexpr -> t -> IO a) -> t -> IO Fexpr
liftTo Ptr CFexpr -> t -> IO a
f t
x = do
    Fexpr
result <- IO Fexpr
newFexpr
    Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result ((Ptr CFexpr -> IO a) -> IO (Fexpr, a))
-> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
expr -> Ptr CFexpr -> t -> IO a
f Ptr CFexpr
expr t
x
    Fexpr -> IO Fexpr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
result