module Data.Number.Flint.Arb.Poly.Instances (
    ArbPoly (..)
  , module GHC.Exts
) where

import Test.QuickCheck

import GHC.Exts

import System.IO.Unsafe
import Control.Monad

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

import Data.Number.Flint.Arb
import Data.Number.Flint.Arb.Instances
import Data.Number.Flint.Arb.Poly

import Data.Number.Flint.UFD

instance Show ArbPoly where
  show :: ArbPoly -> String
show ArbPoly
p = (ArbPoly, String) -> String
forall a b. (a, b) -> b
snd ((ArbPoly, String) -> String) -> (ArbPoly, String) -> String
forall a b. (a -> b) -> a -> b
$ IO (ArbPoly, String) -> (ArbPoly, String)
forall a. IO a -> a
unsafePerformIO (IO (ArbPoly, String) -> (ArbPoly, String))
-> IO (ArbPoly, String) -> (ArbPoly, String)
forall a b. (a -> b) -> a -> b
$ do
    ArbPoly -> (Ptr CArbPoly -> IO String) -> IO (ArbPoly, String)
forall {a}. ArbPoly -> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
withArbPoly ArbPoly
p ((Ptr CArbPoly -> IO String) -> IO (ArbPoly, String))
-> (Ptr CArbPoly -> IO String) -> IO (ArbPoly, String)
forall a b. (a -> b) -> a -> b
$ \Ptr CArbPoly
p -> do
      CString
cs <- Ptr CArbPoly -> CLong -> IO CString
arb_poly_get_strd Ptr CArbPoly
p CLong
16
      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 IsList ArbPoly where
  type Item ArbPoly = Arb
  fromList :: [Item ArbPoly] -> ArbPoly
fromList [Item ArbPoly]
c = IO ArbPoly -> ArbPoly
forall a. IO a -> a
unsafePerformIO (IO ArbPoly -> ArbPoly) -> IO ArbPoly -> ArbPoly
forall a b. (a -> b) -> a -> b
$ do
    ArbPoly
p <- IO ArbPoly
newArbPoly
    ArbPoly -> (Ptr CArbPoly -> IO ()) -> IO (ArbPoly, ())
forall {a}. ArbPoly -> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
withArbPoly ArbPoly
p ((Ptr CArbPoly -> IO ()) -> IO (ArbPoly, ()))
-> (Ptr CArbPoly -> IO ()) -> IO (ArbPoly, ())
forall a b. (a -> b) -> a -> b
$ \Ptr CArbPoly
p -> 
      [Int] -> (Int -> IO (Arb, ())) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..[Arb] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Item ArbPoly]
[Arb]
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO (Arb, ())) -> IO ()) -> (Int -> IO (Arb, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
j ->
        Arb -> (Ptr CArb -> IO ()) -> IO (Arb, ())
forall {a}. Arb -> (Ptr CArb -> IO a) -> IO (Arb, a)
withArb ([Item ArbPoly]
[Arb]
c[Arb] -> Int -> Arb
forall a. HasCallStack => [a] -> Int -> a
!!Int
j) ((Ptr CArb -> IO ()) -> IO (Arb, ()))
-> (Ptr CArb -> IO ()) -> IO (Arb, ())
forall a b. (a -> b) -> a -> b
$ \Ptr CArb
a -> 
          Ptr CArbPoly -> CLong -> Ptr CArb -> IO ()
arb_poly_set_coeff_arb Ptr CArbPoly
p (Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j) Ptr CArb
a
    ArbPoly -> IO ArbPoly
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ArbPoly
p
  toList :: ArbPoly -> [Item ArbPoly]
toList ArbPoly
p = (ArbPoly, [Item ArbPoly]) -> [Item ArbPoly]
forall a b. (a, b) -> b
snd ((ArbPoly, [Item ArbPoly]) -> [Item ArbPoly])
-> (ArbPoly, [Item ArbPoly]) -> [Item ArbPoly]
forall a b. (a -> b) -> a -> b
$ IO (ArbPoly, [Item ArbPoly]) -> (ArbPoly, [Item ArbPoly])
forall a. IO a -> a
unsafePerformIO (IO (ArbPoly, [Item ArbPoly]) -> (ArbPoly, [Item ArbPoly]))
-> IO (ArbPoly, [Item ArbPoly]) -> (ArbPoly, [Item ArbPoly])
forall a b. (a -> b) -> a -> b
$ 
    ArbPoly
-> (Ptr CArbPoly -> IO [Item ArbPoly])
-> IO (ArbPoly, [Item ArbPoly])
forall {a}. ArbPoly -> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
withArbPoly ArbPoly
p ((Ptr CArbPoly -> IO [Item ArbPoly])
 -> IO (ArbPoly, [Item ArbPoly]))
-> (Ptr CArbPoly -> IO [Item ArbPoly])
-> IO (ArbPoly, [Item ArbPoly])
forall a b. (a -> b) -> a -> b
$ \Ptr CArbPoly
p -> do
      CLong
d <- Ptr CArbPoly -> IO CLong
arb_poly_degree Ptr CArbPoly
p
      [CLong] -> (CLong -> IO Arb) -> IO [Arb]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [CLong
0..CLong
d] ((CLong -> IO Arb) -> IO [Arb]) -> (CLong -> IO Arb) -> IO [Arb]
forall a b. (a -> b) -> a -> b
$ \CLong
j -> do
        Arb
c <- IO Arb
newArb
        Arb -> (Ptr CArb -> IO ()) -> IO (Arb, ())
forall {a}. Arb -> (Ptr CArb -> IO a) -> IO (Arb, a)
withArb Arb
c ((Ptr CArb -> IO ()) -> IO (Arb, ()))
-> (Ptr CArb -> IO ()) -> IO (Arb, ())
forall a b. (a -> b) -> a -> b
$ \Ptr CArb
c -> Ptr CArb -> Ptr CArbPoly -> CLong -> IO ()
arb_poly_get_coeff_arb Ptr CArb
c Ptr CArbPoly
p CLong
j
        Arb -> IO Arb
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Arb
c

lift2 :: (Ptr CArbPoly -> Ptr CArbPoly -> Ptr CArbPoly -> IO a)
-> ArbPoly -> ArbPoly -> ArbPoly
lift2 Ptr CArbPoly -> Ptr CArbPoly -> Ptr CArbPoly -> IO a
f ArbPoly
x ArbPoly
y = IO ArbPoly -> ArbPoly
forall a. IO a -> a
unsafePerformIO (IO ArbPoly -> ArbPoly) -> IO ArbPoly -> ArbPoly
forall a b. (a -> b) -> a -> b
$ do
  ArbPoly
result <- IO ArbPoly
newArbPoly
  ArbPoly
-> (Ptr CArbPoly -> IO (ArbPoly, (ArbPoly, a)))
-> IO (ArbPoly, (ArbPoly, (ArbPoly, a)))
forall {a}. ArbPoly -> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
withArbPoly ArbPoly
result ((Ptr CArbPoly -> IO (ArbPoly, (ArbPoly, a)))
 -> IO (ArbPoly, (ArbPoly, (ArbPoly, a))))
-> (Ptr CArbPoly -> IO (ArbPoly, (ArbPoly, a)))
-> IO (ArbPoly, (ArbPoly, (ArbPoly, a)))
forall a b. (a -> b) -> a -> b
$ \Ptr CArbPoly
result -> do
    ArbPoly
-> (Ptr CArbPoly -> IO (ArbPoly, a)) -> IO (ArbPoly, (ArbPoly, a))
forall {a}. ArbPoly -> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
withArbPoly ArbPoly
x ((Ptr CArbPoly -> IO (ArbPoly, a)) -> IO (ArbPoly, (ArbPoly, a)))
-> (Ptr CArbPoly -> IO (ArbPoly, a)) -> IO (ArbPoly, (ArbPoly, a))
forall a b. (a -> b) -> a -> b
$ \Ptr CArbPoly
x -> do
      ArbPoly -> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
forall {a}. ArbPoly -> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
withArbPoly ArbPoly
y ((Ptr CArbPoly -> IO a) -> IO (ArbPoly, a))
-> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
forall a b. (a -> b) -> a -> b
$ \Ptr CArbPoly
y -> do
        Ptr CArbPoly -> Ptr CArbPoly -> Ptr CArbPoly -> IO a
f Ptr CArbPoly
result Ptr CArbPoly
x Ptr CArbPoly
y
  ArbPoly -> IO ArbPoly
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ArbPoly
result

lift1 :: (Ptr CArbPoly -> Ptr CArbPoly -> IO a) -> ArbPoly -> ArbPoly
lift1 Ptr CArbPoly -> Ptr CArbPoly -> IO a
f ArbPoly
x = IO ArbPoly -> ArbPoly
forall a. IO a -> a
unsafePerformIO (IO ArbPoly -> ArbPoly) -> IO ArbPoly -> ArbPoly
forall a b. (a -> b) -> a -> b
$ do
  ArbPoly
result <- IO ArbPoly
newArbPoly
  ArbPoly
-> (Ptr CArbPoly -> IO (ArbPoly, a)) -> IO (ArbPoly, (ArbPoly, a))
forall {a}. ArbPoly -> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
withArbPoly ArbPoly
result ((Ptr CArbPoly -> IO (ArbPoly, a)) -> IO (ArbPoly, (ArbPoly, a)))
-> (Ptr CArbPoly -> IO (ArbPoly, a)) -> IO (ArbPoly, (ArbPoly, a))
forall a b. (a -> b) -> a -> b
$ \Ptr CArbPoly
result ->
    ArbPoly -> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
forall {a}. ArbPoly -> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
withArbPoly ArbPoly
x ((Ptr CArbPoly -> IO a) -> IO (ArbPoly, a))
-> (Ptr CArbPoly -> IO a) -> IO (ArbPoly, a)
forall a b. (a -> b) -> a -> b
$ \Ptr CArbPoly
x ->
    Ptr CArbPoly -> Ptr CArbPoly -> IO a
f Ptr CArbPoly
result Ptr CArbPoly
x
  ArbPoly -> IO ArbPoly
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ArbPoly
result