{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ExistentialQuantification #-}
module LLVM.DSL.Render.Argument (
   T(Cons),
   Creator,
   unit,
   primitive,
   wrap,
   pair,
   triple,
   newDispose,
   ) where

import qualified LLVM.DSL.Expression as Expr
import LLVM.DSL.Expression (Exp)

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal

import Data.Tuple.Strict (mapPair, mapTriple)

import Prelude2010
import Prelude ()



type Creator p = IO (p, IO ())


{- |
Transfer 'a' to 'adsl' with 'al' as transit stop.
-}
data T a adsl =
   forall al. Marshal.C al =>
   Cons (Exp al -> adsl) (a -> Creator al)


primitiveCreator :: a -> Creator a
primitiveCreator :: forall a. a -> Creator a
primitiveCreator a
a = (a, IO ()) -> IO (a, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

unit :: T () ()
unit :: T () ()
unit = (Exp () -> ()) -> (() -> Creator ()) -> T () ()
forall a adsl al.
C al =>
(Exp al -> adsl) -> (a -> Creator al) -> T a adsl
Cons (\ Exp ()
_unit -> ()) () -> Creator ()
forall a. a -> Creator a
primitiveCreator

primitive :: (Marshal.C a) => T a (Exp a)
primitive :: forall a. C a => T a (Exp a)
primitive = (Exp a -> Exp a) -> (a -> Creator a) -> T a (Exp a)
forall a adsl al.
C al =>
(Exp al -> adsl) -> (a -> Creator al) -> T a adsl
Cons Exp a -> Exp a
forall a. a -> a
id a -> Creator a
forall a. a -> Creator a
primitiveCreator

wrap :: (Marshal.C a) => (b -> a) -> (adsl -> bdsl) -> T a adsl -> T b bdsl
wrap :: forall a b adsl bdsl.
C a =>
(b -> a) -> (adsl -> bdsl) -> T a adsl -> T b bdsl
wrap b -> a
unwrp adsl -> bdsl
wrp (Cons Exp al -> adsl
pass a -> Creator al
create) = (Exp al -> bdsl) -> (b -> Creator al) -> T b bdsl
forall a adsl al.
C al =>
(Exp al -> adsl) -> (a -> Creator al) -> T a adsl
Cons (adsl -> bdsl
wrp (adsl -> bdsl) -> (Exp al -> adsl) -> Exp al -> bdsl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp al -> adsl
pass) (a -> Creator al
create (a -> Creator al) -> (b -> a) -> b -> Creator al
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
unwrp)


pair :: T a ad -> T b bd -> T (a,b) (ad,bd)
pair :: forall a ad b bd. T a ad -> T b bd -> T (a, b) (ad, bd)
pair (Cons Exp al -> ad
passA a -> Creator al
createA) (Cons Exp al -> bd
passB b -> Creator al
createB) =
   (Exp (al, al) -> (ad, bd))
-> ((a, b) -> Creator (al, al)) -> T (a, b) (ad, bd)
forall a adsl al.
C al =>
(Exp al -> adsl) -> (a -> Creator al) -> T a adsl
Cons
      ((Exp al -> ad, Exp al -> bd) -> (Exp al, Exp al) -> (ad, bd)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (Exp al -> ad
passA,Exp al -> bd
passB) ((Exp al, Exp al) -> (ad, bd))
-> (Exp (al, al) -> (Exp al, Exp al)) -> Exp (al, al) -> (ad, bd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (al, al) -> (Exp al, Exp al)
forall (val :: * -> *) a b.
Value val =>
val (a, b) -> (val a, val b)
Expr.unzip)
      (\(a
a,b
b) -> do
         (al
pa,IO ()
finalA) <- a -> Creator al
createA a
a
         (al
pb,IO ()
finalB) <- b -> Creator al
createB b
b
         ((al, al), IO ()) -> Creator (al, al)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((al
pa,al
pb), IO ()
finalBIO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>IO ()
finalA))

triple :: T a ad -> T b bd -> T c cd -> T (a,b,c) (ad,bd,cd)
triple :: forall a ad b bd c cd.
T a ad -> T b bd -> T c cd -> T (a, b, c) (ad, bd, cd)
triple (Cons Exp al -> ad
passA a -> Creator al
createA) (Cons Exp al -> bd
passB b -> Creator al
createB) (Cons Exp al -> cd
passC c -> Creator al
createC) =
   (Exp (al, al, al) -> (ad, bd, cd))
-> ((a, b, c) -> Creator (al, al, al)) -> T (a, b, c) (ad, bd, cd)
forall a adsl al.
C al =>
(Exp al -> adsl) -> (a -> Creator al) -> T a adsl
Cons
      ((Exp al -> ad, Exp al -> bd, Exp al -> cd)
-> (Exp al, Exp al, Exp al) -> (ad, bd, cd)
forall a d b e c f.
(a -> d, b -> e, c -> f) -> (a, b, c) -> (d, e, f)
mapTriple (Exp al -> ad
passA,Exp al -> bd
passB,Exp al -> cd
passC) ((Exp al, Exp al, Exp al) -> (ad, bd, cd))
-> (Exp (al, al, al) -> (Exp al, Exp al, Exp al))
-> Exp (al, al, al)
-> (ad, bd, cd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (al, al, al) -> (Exp al, Exp al, Exp al)
forall (val :: * -> *) a b c.
Value val =>
val (a, b, c) -> (val a, val b, val c)
Expr.unzip3)
      (\(a
a,b
b,c
c) -> do
         (al
pa,IO ()
finalA) <- a -> Creator al
createA a
a
         (al
pb,IO ()
finalB) <- b -> Creator al
createB b
b
         (al
pc,IO ()
finalC) <- c -> Creator al
createC c
c
         ((al, al, al), IO ()) -> Creator (al, al, al)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((al
pa,al
pb,al
pc), IO ()
finalCIO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>IO ()
finalBIO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>IO ()
finalA))


newDispose ::
   (Marshal.C handle) =>
   (a -> IO handle) -> (handle -> IO ()) ->
   (Exp handle -> ad) -> T a ad
newDispose :: forall handle a ad.
C handle =>
(a -> IO handle)
-> (handle -> IO ()) -> (Exp handle -> ad) -> T a ad
newDispose a -> IO handle
new handle -> IO ()
dispose Exp handle -> ad
fetch =
   (Exp handle -> ad) -> (a -> Creator handle) -> T a ad
forall a adsl al.
C al =>
(Exp al -> adsl) -> (a -> Creator al) -> T a adsl
Cons Exp handle -> ad
fetch
      (\a
x -> do
         handle
it <- a -> IO handle
new a
x
         (handle, IO ()) -> Creator handle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (handle
it, handle -> IO ()
dispose handle
it))