{-# 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 ())
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))