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 = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
x 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
      forall a. Ptr a -> IO ()
free CString
cs
      forall (m :: * -> *) a. Monad m => a -> m a
return String
s

instance Num Fexpr where
  {-# INLINE (+) #-}
  + :: 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 (-) #-}
  (-) = 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
(*) = 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 = forall {a}. (Ptr CFexpr -> Ptr CFexpr -> IO a) -> Fexpr -> Fexpr
lift1 Ptr CFexpr -> Ptr CFexpr -> IO ()
fexpr_neg
  abs :: Fexpr -> Fexpr
abs    = forall a. HasCallStack => a
undefined
  fromInteger :: Integer -> Fexpr
fromInteger Integer
x = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Fexpr
expr <- IO Fexpr
newFexpr
    forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
expr forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
expr -> do
      forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz (forall a. Num a => Integer -> a
fromInteger Integer
x) 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
    forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
expr
  signum :: Fexpr -> Fexpr
signum = 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
    forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result 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 forall k a. Ord k => Map k a -> k -> a
! FEXR_Builtin
x)
    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
    forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
expr -> do
      forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz Fmpz
x 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
    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
    forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
expr -> do
      forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
x 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
    forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
result

instance FlintExpression CDouble where
  toFexpr :: CDouble -> IO Fexpr
toFexpr = 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 = 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 = 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
    forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
expr -> do
      forall {a}. Arf -> (Ptr CArf -> IO a) -> IO (Arf, a)
withArf Arf
x 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
    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
    forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
result -> do
      forall a. String -> (CString -> IO a) -> IO a
withCString String
name forall a b. (a -> b) -> a -> b
$ \CString
name -> do
        Ptr CFexpr -> CString -> IO ()
fexpr_set_symbol_str Ptr CFexpr
result CString
name
    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 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  Fexpr
z <- IO Fexpr
newFexpr
  forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
x forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
x ->
    forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
z forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
z -> Ptr CFexpr -> Ptr CFexpr -> IO a
f Ptr CFexpr
z Ptr CFexpr
x
  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 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  Fexpr
z <- IO Fexpr
newFexpr
  forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
x forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
x ->
    forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
y forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
y ->
      forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
z 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
  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
    forall {a}. Fexpr -> (Ptr CFexpr -> IO a) -> IO (Fexpr, a)
withFexpr Fexpr
result forall a b. (a -> b) -> a -> b
$ \Ptr CFexpr
expr -> Ptr CFexpr -> t -> IO a
f Ptr CFexpr
expr t
x
    forall (m :: * -> *) a. Monad m => a -> m a
return Fexpr
result