{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Synthesizer.LLVM.Causal.Render where
import qualified Synthesizer.LLVM.Causal.Parameterized as Parameterized
import Synthesizer.LLVM.Causal.Private (T(Cons))
import Synthesizer.LLVM.Generator.Render
(Triple, tripleStruct,
derefStartPtr, derefStopPtr,
RunArg, DSLArg, BuildArg(BuildArg), buildArg)
import qualified Synthesizer.LLVM.Plug.Input as PIn
import qualified Synthesizer.LLVM.Plug.Output as POut
import qualified Synthesizer.CausalIO.Process as PIO
import qualified Synthesizer.Generic.Cut as Cut
import qualified LLVM.DSL.Execution as Exec
import qualified LLVM.DSL.Expression as Expr
import LLVM.DSL.Expression (Exp(Exp))
import qualified LLVM.Extra.Multi.Value.Storable as Storable
import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.MaybeContinuation as MaybeCont
import qualified LLVM.Extra.Maybe as Maybe
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Core as LLVM
import qualified Type.Data.Num.Decimal as TypeNum
import qualified Data.StorableVector.Base as SVB
import qualified Data.StorableVector as SV
import Control.Monad (when, join)
import Control.Applicative (liftA3)
import Foreign.Ptr (Ptr)
import Data.Tuple.HT (snd3)
import Data.Word (Word)
foreign import ccall safe "dynamic" derefFillPtr ::
Exec.Importer (LLVM.Ptr global -> Word -> Ptr a -> Ptr b -> IO Word)
compile ::
(Storable.C a, MultiValue.T a ~ al,
Storable.C b, MultiValue.T b ~ bl,
Marshal.C param, Marshal.Struct param ~ paramStruct) =>
(Exp param -> T al bl) ->
IO (LLVM.Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
compile :: forall a al b bl param paramStruct.
(C a, T a ~ al, C b, T b ~ bl, C param,
Struct param ~ paramStruct) =>
(Exp param -> T al bl)
-> IO (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
compile Exp param -> T al bl
proc =
String
-> Exec (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
-> IO (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
forall funcs. String -> Exec funcs -> IO funcs
Exec.compile String
"process" (Exec (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
-> IO (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word))
-> Exec (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
-> IO (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
forall a b. (a -> b) -> a -> b
$
Importer (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
-> String
-> CodeGen (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
-> Exec (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
Exec.createFunction Importer (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
forall global a b.
Importer (Ptr global -> Word -> Ptr a -> Ptr b -> IO Word)
derefFillPtr String
"fill" (CodeGen (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
-> Exec (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word))
-> CodeGen (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
-> Exec (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
forall a b. (a -> b) -> a -> b
$ \Value (Ptr paramStruct)
paramPtr Value Word
size Value (Ptr a)
aPtr Value (Ptr b)
bPtr ->
case Exp param -> T al bl
proc ((forall r. CodeGenFunction r (T param)) -> Exp param
forall a. (forall r. CodeGenFunction r (T a)) -> Exp a
Exp (Value (Ptr (Struct (T param))) -> CodeGenFunction r (T param)
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r.
Value (Ptr (Struct (T param))) -> CodeGenFunction r (T param)
Memory.load Value (Ptr paramStruct)
Value (Ptr (Struct (T param)))
paramPtr)) of
Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> al -> state -> T r c (bl, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop -> do
(global
global,state
s) <- CodeGenFunction Word (global, state)
forall r. CodeGenFunction r (global, state)
start
Value (Ptr local)
local <- CodeGenFunction Word (Value (Ptr local))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.alloca
(Value Word
pos,T state
_) <- Value Word
-> Value (Ptr a)
-> Value (Ptr b)
-> state
-> (Value (Ptr a)
-> Value (Ptr b)
-> state
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) state)
-> CodeGenFunction Word (Value Word, T state)
forall s i a ptrA b ptrB z r.
(Phi s, Undefined s, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i, Storable a, Value (Ptr a) ~ ptrA, Storable b,
Value (Ptr b) ~ ptrB, T (ptrA, (ptrB, s)) ~ z) =>
Value i
-> ptrA
-> ptrB
-> s
-> (ptrA -> ptrB -> s -> T r z s)
-> CodeGenFunction r (Value i, T s)
Storable.arrayLoopMaybeCont2 Value Word
size Value (Ptr a)
aPtr Value (Ptr b)
bPtr state
s ((Value (Ptr a)
-> Value (Ptr b)
-> state
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) state)
-> CodeGenFunction Word (Value Word, T state))
-> (Value (Ptr a)
-> Value (Ptr b)
-> state
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) state)
-> CodeGenFunction Word (Value Word, T state)
forall a b. (a -> b) -> a -> b
$
\Value (Ptr a)
aPtri Value (Ptr b)
bPtri state
s0 -> do
T a
a <- CodeGenFunction Word (T a)
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) (T a)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction Word (T a)
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) (T a))
-> CodeGenFunction Word (T a)
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) (T a)
forall a b. (a -> b) -> a -> b
$ Value (Ptr a) -> CodeGenFunction Word (T a)
forall a r. C a => Value (Ptr a) -> CodeGenFunction r (T a)
forall r. Value (Ptr a) -> CodeGenFunction r (T a)
Storable.load Value (Ptr a)
aPtri
(bl
b,state
s1) <- global
-> Value (Ptr local)
-> al
-> state
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) (bl, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> al -> state -> T r c (bl, state)
next global
global Value (Ptr local)
local al
T a
a state
s0
CodeGenFunction Word ()
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) ()
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction Word ()
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) ())
-> CodeGenFunction Word ()
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) ()
forall a b. (a -> b) -> a -> b
$ T b -> Value (Ptr b) -> CodeGenFunction Word ()
forall r. T b -> Value (Ptr b) -> CodeGenFunction r ()
forall a r. C a => T a -> Value (Ptr a) -> CodeGenFunction r ()
Storable.store bl
T b
b Value (Ptr b)
bPtri
state -> T Word (T (Value (Ptr a), (Value (Ptr b), state))) state
forall a. a -> T Word (T (Value (Ptr a), (Value (Ptr b), state))) a
forall (m :: * -> *) a. Monad m => a -> m a
return state
s1
global -> CodeGenFunction Word ()
forall r. global -> CodeGenFunction r ()
stop global
global
Value Word -> CodeGenFunction Word (Value Word)
forall a. a -> CodeGenFunction Word a
forall (m :: * -> *) a. Monad m => a -> m a
return Value Word
pos
runAux ::
(Marshal.C p,
Storable.C a, MultiValue.T a ~ al,
Storable.C b, MultiValue.T b ~ bl) =>
(Exp p -> T al bl) ->
IO (IO () -> p -> SV.Vector a -> IO (SV.Vector b))
runAux :: forall p a al b bl.
(C p, C a, T a ~ al, C b, T b ~ bl) =>
(Exp p -> T al bl) -> IO (IO () -> p -> Vector a -> IO (Vector b))
runAux Exp p -> T al bl
proc = do
Ptr (Struct (Repr p)) -> Word -> Ptr a -> Ptr b -> IO Word
fill <- (Exp p -> T al bl)
-> IO (Ptr (Struct (Repr p)) -> Word -> Ptr a -> Ptr b -> IO Word)
forall a al b bl param paramStruct.
(C a, T a ~ al, C b, T b ~ bl, C param,
Struct param ~ paramStruct) =>
(Exp param -> T al bl)
-> IO (Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)
compile Exp p -> T al bl
proc
(IO () -> p -> Vector a -> IO (Vector b))
-> IO (IO () -> p -> Vector a -> IO (Vector b))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO () -> p -> Vector a -> IO (Vector b))
-> IO (IO () -> p -> Vector a -> IO (Vector b)))
-> (IO () -> p -> Vector a -> IO (Vector b))
-> IO (IO () -> p -> Vector a -> IO (Vector b))
forall a b. (a -> b) -> a -> b
$ \IO ()
final p
param Vector a
as ->
p -> (Ptr (Struct (Repr p)) -> IO (Vector b)) -> IO (Vector b)
forall a b. C a => a -> (Ptr (Struct a) -> IO b) -> IO b
Marshal.with p
param ((Ptr (Struct (Repr p)) -> IO (Vector b)) -> IO (Vector b))
-> (Ptr (Struct (Repr p)) -> IO (Vector b)) -> IO (Vector b)
forall a b. (a -> b) -> a -> b
$ \Ptr (Struct (Repr p))
paramPtr ->
Vector a -> (Ptr a -> Int -> IO (Vector b)) -> IO (Vector b)
forall a b.
Storable a =>
Vector a -> (Ptr a -> Int -> IO b) -> IO b
SVB.withStartPtr Vector a
as ((Ptr a -> Int -> IO (Vector b)) -> IO (Vector b))
-> (Ptr a -> Int -> IO (Vector b)) -> IO (Vector b)
forall a b. (a -> b) -> a -> b
$ \ Ptr a
aPtr Int
len ->
Int -> (Ptr b -> IO Int) -> IO (Vector b)
forall a. Storable a => Int -> (Ptr a -> IO Int) -> IO (Vector a)
SVB.createAndTrim Int
len ((Ptr b -> IO Int) -> IO (Vector b))
-> (Ptr b -> IO Int) -> IO (Vector b)
forall a b. (a -> b) -> a -> b
$ \Ptr b
bPtr -> do
Word
n <- Ptr (Struct (Repr p)) -> Word -> Ptr a -> Ptr b -> IO Word
fill Ptr (Struct (Repr p))
paramPtr (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr a
aPtr Ptr b
bPtr
IO ()
final
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n
run_ ::
(Marshal.C p,
Storable.C a, MultiValue.T a ~ al,
Storable.C b, MultiValue.T b ~ bl) =>
(Exp p -> T al bl) -> IO (p -> SV.Vector a -> IO (SV.Vector b))
run_ :: forall p a al b bl.
(C p, C a, T a ~ al, C b, T b ~ bl) =>
(Exp p -> T al bl) -> IO (p -> Vector a -> IO (Vector b))
run_ = ((IO () -> p -> Vector a -> IO (Vector b))
-> p -> Vector a -> IO (Vector b))
-> IO (IO () -> p -> Vector a -> IO (Vector b))
-> IO (p -> Vector a -> IO (Vector b))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IO () -> p -> Vector a -> IO (Vector b))
-> IO () -> p -> Vector a -> IO (Vector b)
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO (IO () -> p -> Vector a -> IO (Vector b))
-> IO (p -> Vector a -> IO (Vector b)))
-> ((Exp p -> T al bl)
-> IO (IO () -> p -> Vector a -> IO (Vector b)))
-> (Exp p -> T al bl)
-> IO (p -> Vector a -> IO (Vector b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp p -> T al bl) -> IO (IO () -> p -> Vector a -> IO (Vector b))
forall p a al b bl.
(C p, C a, T a ~ al, C b, T b ~ bl) =>
(Exp p -> T al bl) -> IO (IO () -> p -> Vector a -> IO (Vector b))
runAux
foreign import ccall safe "dynamic" derefChunkPtr ::
Exec.Importer (LLVM.Ptr globalState -> Word -> Ptr a -> Ptr b -> IO Word)
compileChunky ::
(LLVM.IsSized paramStruct, LLVM.Value (LLVM.Ptr paramStruct) ~ pPtr,
Memory.C state, Memory.Struct state ~ stateStruct,
Memory.C global, Memory.Struct global ~ globalStruct,
Triple paramStruct globalStruct stateStruct ~ triple,
LLVM.IsSized local,
Storable.C a, MultiValue.T a ~ valueA,
Storable.C b, MultiValue.T b ~ valueB) =>
(forall r z. (Tuple.Phi z) =>
pPtr ->
global -> LLVM.Value (LLVM.Ptr local) ->
valueA -> state -> MaybeCont.T r z (valueB, state)) ->
(forall r. pPtr -> LLVM.CodeGenFunction r (global, state)) ->
(forall r. pPtr -> global -> LLVM.CodeGenFunction r ()) ->
IO (LLVM.Ptr paramStruct -> IO (LLVM.Ptr triple),
Exec.Finalizer triple,
LLVM.Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
compileChunky :: forall paramStruct pPtr state stateStruct global globalStruct
triple local a valueA b valueB.
(IsSized paramStruct, Value (Ptr paramStruct) ~ pPtr, C state,
Struct state ~ stateStruct, C global, Struct global ~ globalStruct,
Triple paramStruct globalStruct stateStruct ~ triple,
IsSized local, C a, T a ~ valueA, C b, T b ~ valueB) =>
(forall r z.
Phi z =>
pPtr
-> global
-> Value (Ptr local)
-> valueA
-> state
-> T r z (valueB, state))
-> (forall r. pPtr -> CodeGenFunction r (global, state))
-> (forall r. pPtr -> global -> CodeGenFunction r ())
-> IO
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
compileChunky forall r z.
Phi z =>
pPtr
-> global
-> Value (Ptr local)
-> valueA
-> state
-> T r z (valueB, state)
next forall r. pPtr -> CodeGenFunction r (global, state)
start forall r. pPtr -> global -> CodeGenFunction r ()
stop =
String
-> Exec
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
-> IO
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
forall funcs. String -> Exec funcs -> IO funcs
Exec.compile String
"process-chunky" (Exec
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
-> IO
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word))
-> Exec
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
-> IO
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
forall a b. (a -> b) -> a -> b
$
((Ptr paramStruct -> IO (Ptr triple))
-> Finalizer triple
-> (Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
-> (Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word))
-> Compose
CodeGenModule EngineAccess (Ptr paramStruct -> IO (Ptr triple))
-> Compose CodeGenModule EngineAccess (Finalizer triple)
-> Compose
CodeGenModule
EngineAccess
(Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
-> Exec
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,)
(Importer (Ptr paramStruct -> IO (Ptr triple))
-> String
-> CodeGen (Ptr paramStruct -> IO (Ptr triple))
-> Compose
CodeGenModule EngineAccess (Ptr paramStruct -> IO (Ptr triple))
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
Exec.createFunction Importer (Ptr paramStruct -> IO (Ptr triple))
forall param globalState.
Importer (Ptr param -> IO (Ptr globalState))
derefStartPtr String
"startprocess" (CodeGen (Ptr paramStruct -> IO (Ptr triple))
-> Compose
CodeGenModule EngineAccess (Ptr paramStruct -> IO (Ptr triple)))
-> CodeGen (Ptr paramStruct -> IO (Ptr triple))
-> Compose
CodeGenModule EngineAccess (Ptr paramStruct -> IO (Ptr triple))
forall a b. (a -> b) -> a -> b
$
\pPtr
paramPtr -> do
Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr <- CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Ptr (Triple paramStruct globalStruct stateStruct)))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.malloc
(global
global,state
state) <- pPtr
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) (global, state)
forall r. pPtr -> CodeGenFunction r (global, state)
start pPtr
paramPtr
(Value (Triple paramStruct globalStruct stateStruct)
-> Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) ())
-> Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> Value (Triple paramStruct globalStruct stateStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value (Triple paramStruct globalStruct stateStruct)
-> Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) ()
forall a r. Value a -> Value (Ptr a) -> CodeGenFunction r ()
LLVM.store Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Value (Triple paramStruct globalStruct stateStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) ())
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct)))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
((Value paramStruct
-> Value globalStruct
-> Value stateStruct
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct)))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value paramStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value globalStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value stateStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct)))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Value paramStruct
-> Value globalStruct
-> Value stateStruct
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct))
forall a b c r.
(IsSized a, IsSized b, IsSized c) =>
Value a
-> Value b -> Value c -> CodeGenFunction r (Value (Triple a b c))
tripleStruct
(Value (Ptr paramStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value paramStruct)
forall a r. Value (Ptr a) -> CodeGenFunction r (Value a)
LLVM.load pPtr
Value (Ptr paramStruct)
paramPtr)
(global
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Struct global))
forall r. global -> CodeGenFunction r (Value (Struct global))
forall llvmValue r.
C llvmValue =>
llvmValue -> CodeGenFunction r (Value (Struct llvmValue))
Memory.compose global
global)
(state
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Struct state))
forall r. state -> CodeGenFunction r (Value (Struct state))
forall llvmValue r.
C llvmValue =>
llvmValue -> CodeGenFunction r (Value (Struct llvmValue))
Memory.compose state
state))
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Ptr (Triple paramStruct globalStruct stateStruct)))
forall a.
a
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr)
(Importer (Ptr triple -> IO ())
-> String
-> CodeGen (Ptr triple -> IO ())
-> Compose CodeGenModule EngineAccess (Finalizer triple)
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec (ExecutionEngine, f)
Exec.createFinalizer Importer (Ptr triple -> IO ())
forall globalState. Importer (Ptr globalState -> IO ())
derefStopPtr String
"stopprocess" (CodeGen (Ptr triple -> IO ())
-> Compose CodeGenModule EngineAccess (Finalizer triple))
-> CodeGen (Ptr triple -> IO ())
-> Compose CodeGenModule EngineAccess (Finalizer triple)
forall a b. (a -> b) -> a -> b
$
\Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr -> do
pPtr
paramPtr <-
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> (Proxy D0, ())
-> CodeGenFunction
()
(Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D0, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Proxy D0
TypeNum.d0, ())
pPtr -> global -> CodeGenFunction () ()
forall r. pPtr -> global -> CodeGenFunction r ()
stop pPtr
paramPtr (global -> CodeGenFunction () ())
-> CodeGenFunction () global -> CodeGenFunction () ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
Value (Ptr globalStruct) -> CodeGenFunction () global
Value (Ptr (Struct global)) -> CodeGenFunction () global
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct global)) -> CodeGenFunction r global
Memory.load (Value (Ptr globalStruct) -> CodeGenFunction () global)
-> CodeGenFunction () (Value (Ptr globalStruct))
-> CodeGenFunction () global
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> (Proxy D1, ())
-> CodeGenFunction
()
(Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D1, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Proxy D1
TypeNum.d1, ())
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> CodeGenFunction () ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr)
(Importer (Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
-> String
-> CodeGen (Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
-> Compose
CodeGenModule
EngineAccess
(Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
Exec.createFunction Importer (Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
forall global a b.
Importer (Ptr global -> Word -> Ptr a -> Ptr b -> IO Word)
derefChunkPtr String
"fillprocess" (CodeGen (Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
-> Compose
CodeGenModule
EngineAccess
(Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word))
-> CodeGen (Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
-> Compose
CodeGenModule
EngineAccess
(Ptr triple -> Word -> Ptr a -> Ptr b -> IO Word)
forall a b. (a -> b) -> a -> b
$
\Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr Value Word
loopLen Value (Ptr a)
aPtr Value (Ptr b)
bPtr -> do
pPtr
paramPtr <-
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> (Proxy D0, ())
-> CodeGenFunction
Word
(Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D0, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Proxy D0
TypeNum.d0, ())
Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D1, ())))
globalPtr <-
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> (Proxy D1, ())
-> CodeGenFunction
Word
(Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D1, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Proxy D1
TypeNum.d1, ())
Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D2, ())))
statePtr <-
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> (Proxy D2, ())
-> CodeGenFunction
Word
(Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D2, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Proxy D2
TypeNum.d2, ())
global
global <- Value (Ptr (Struct global)) -> CodeGenFunction Word global
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct global)) -> CodeGenFunction r global
Memory.load Value (Ptr (Struct global))
Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D1, ())))
globalPtr
state
sInit <- Value (Ptr (Struct state)) -> CodeGenFunction Word state
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct state)) -> CodeGenFunction r state
Memory.load Value (Ptr (Struct state))
Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D2, ())))
statePtr
Value (Ptr local)
local <- CodeGenFunction Word (Value (Ptr local))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.alloca
(Value Word
pos,T state
sExit) <-
Value Word
-> Value (Ptr a)
-> Value (Ptr b)
-> state
-> (Value (Ptr a)
-> Value (Ptr b)
-> state
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) state)
-> CodeGenFunction Word (Value Word, T state)
forall s i a ptrA b ptrB z r.
(Phi s, Undefined s, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i, Storable a, Value (Ptr a) ~ ptrA, Storable b,
Value (Ptr b) ~ ptrB, T (ptrA, (ptrB, s)) ~ z) =>
Value i
-> ptrA
-> ptrB
-> s
-> (ptrA -> ptrB -> s -> T r z s)
-> CodeGenFunction r (Value i, T s)
Storable.arrayLoopMaybeCont2 Value Word
loopLen Value (Ptr a)
aPtr Value (Ptr b)
bPtr state
sInit ((Value (Ptr a)
-> Value (Ptr b)
-> state
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) state)
-> CodeGenFunction Word (Value Word, T state))
-> (Value (Ptr a)
-> Value (Ptr b)
-> state
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) state)
-> CodeGenFunction Word (Value Word, T state)
forall a b. (a -> b) -> a -> b
$
\ Value (Ptr a)
aPtri Value (Ptr b)
bPtri state
s0 -> do
T a
a <- CodeGenFunction Word (T a)
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) (T a)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction Word (T a)
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) (T a))
-> CodeGenFunction Word (T a)
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) (T a)
forall a b. (a -> b) -> a -> b
$ Value (Ptr a) -> CodeGenFunction Word (T a)
forall a r. C a => Value (Ptr a) -> CodeGenFunction r (T a)
forall r. Value (Ptr a) -> CodeGenFunction r (T a)
Storable.load Value (Ptr a)
aPtri
(valueB
b,state
s1) <- pPtr
-> global
-> Value (Ptr local)
-> valueA
-> state
-> T Word
(T (Value (Ptr a), (Value (Ptr b), state)))
(valueB, state)
forall r z.
Phi z =>
pPtr
-> global
-> Value (Ptr local)
-> valueA
-> state
-> T r z (valueB, state)
next pPtr
paramPtr global
global Value (Ptr local)
local valueA
T a
a state
s0
CodeGenFunction Word ()
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) ()
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction Word ()
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) ())
-> CodeGenFunction Word ()
-> T Word (T (Value (Ptr a), (Value (Ptr b), state))) ()
forall a b. (a -> b) -> a -> b
$ T b -> Value (Ptr b) -> CodeGenFunction Word ()
forall r. T b -> Value (Ptr b) -> CodeGenFunction r ()
forall a r. C a => T a -> Value (Ptr a) -> CodeGenFunction r ()
Storable.store valueB
T b
b Value (Ptr b)
bPtri
state -> T Word (T (Value (Ptr a), (Value (Ptr b), state))) state
forall a. a -> T Word (T (Value (Ptr a), (Value (Ptr b), state))) a
forall (m :: * -> *) a. Monad m => a -> m a
return state
s1
state -> Value (Ptr (Struct state)) -> CodeGenFunction Word ()
forall r.
state -> Value (Ptr (Struct state)) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store (T state -> state
forall a. T a -> a
Maybe.fromJust T state
sExit) Value (Ptr (Struct state))
Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D2, ())))
statePtr
Value Word -> CodeGenFunction Word (Value Word)
forall a. a -> CodeGenFunction Word a
forall (m :: * -> *) a. Monad m => a -> m a
return Value Word
pos)
foreign import ccall safe "dynamic" derefChunkPluggedPtr ::
Exec.Importer
(LLVM.Ptr globalStateStruct -> Word ->
LLVM.Ptr inp -> LLVM.Ptr out -> IO Word)
compilePlugged ::
(Tuple.Undefined stateIn, Tuple.Phi stateIn) =>
(Tuple.Undefined stateOut, Tuple.Phi stateOut) =>
(LLVM.IsSized paramStruct, LLVM.Value (LLVM.Ptr paramStruct) ~ pPtr,
Memory.C state, Memory.Struct state ~ stateStruct,
Memory.C global, Memory.Struct global ~ globalStruct,
Triple paramStruct globalStruct stateStruct ~ triple) =>
(LLVM.IsSized local) =>
(Memory.C paramIn, Memory.Struct paramIn ~ inStruct) =>
(Memory.C paramOut, Memory.Struct paramOut ~ outStruct) =>
(forall r.
paramIn -> stateIn -> LLVM.CodeGenFunction r (valueA, stateIn)) ->
(forall r.
paramIn -> LLVM.CodeGenFunction r stateIn) ->
(forall r z. (Tuple.Phi z) =>
pPtr -> global -> LLVM.Value (LLVM.Ptr local) ->
valueA -> state -> MaybeCont.T r z (valueB, state)) ->
(forall r. pPtr -> LLVM.CodeGenFunction r (global, state)) ->
(forall r. pPtr -> global -> LLVM.CodeGenFunction r ()) ->
(forall r.
paramOut -> valueB -> stateOut -> LLVM.CodeGenFunction r stateOut) ->
(forall r.
paramOut -> LLVM.CodeGenFunction r stateOut) ->
IO (LLVM.Ptr paramStruct -> IO (LLVM.Ptr triple),
LLVM.Ptr triple -> IO (),
LLVM.Ptr triple ->
Word -> LLVM.Ptr inStruct -> LLVM.Ptr outStruct -> IO Word)
compilePlugged :: forall stateIn stateOut paramStruct pPtr state stateStruct global
globalStruct triple local paramIn inStruct paramOut outStruct
valueA valueB.
(Undefined stateIn, Phi stateIn, Undefined stateOut, Phi stateOut,
IsSized paramStruct, Value (Ptr paramStruct) ~ pPtr, C state,
Struct state ~ stateStruct, C global, Struct global ~ globalStruct,
Triple paramStruct globalStruct stateStruct ~ triple,
IsSized local, C paramIn, Struct paramIn ~ inStruct, C paramOut,
Struct paramOut ~ outStruct) =>
(forall r.
paramIn -> stateIn -> CodeGenFunction r (valueA, stateIn))
-> (forall r. paramIn -> CodeGenFunction r stateIn)
-> (forall r z.
Phi z =>
pPtr
-> global
-> Value (Ptr local)
-> valueA
-> state
-> T r z (valueB, state))
-> (forall r. pPtr -> CodeGenFunction r (global, state))
-> (forall r. pPtr -> global -> CodeGenFunction r ())
-> (forall r.
paramOut -> valueB -> stateOut -> CodeGenFunction r stateOut)
-> (forall r. paramOut -> CodeGenFunction r stateOut)
-> IO
(Ptr paramStruct -> IO (Ptr triple), Ptr triple -> IO (),
Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
compilePlugged forall r. paramIn -> stateIn -> CodeGenFunction r (valueA, stateIn)
nextIn forall r. paramIn -> CodeGenFunction r stateIn
startIn forall r z.
Phi z =>
pPtr
-> global
-> Value (Ptr local)
-> valueA
-> state
-> T r z (valueB, state)
next forall r. pPtr -> CodeGenFunction r (global, state)
start forall r. pPtr -> global -> CodeGenFunction r ()
stop forall r.
paramOut -> valueB -> stateOut -> CodeGenFunction r stateOut
nextOut forall r. paramOut -> CodeGenFunction r stateOut
startOut =
String
-> Exec
(Ptr paramStruct -> IO (Ptr triple), Ptr triple -> IO (),
Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
-> IO
(Ptr paramStruct -> IO (Ptr triple), Ptr triple -> IO (),
Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
forall funcs. String -> Exec funcs -> IO funcs
Exec.compile String
"process-plugged" (Exec
(Ptr paramStruct -> IO (Ptr triple), Ptr triple -> IO (),
Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
-> IO
(Ptr paramStruct -> IO (Ptr triple), Ptr triple -> IO (),
Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word))
-> Exec
(Ptr paramStruct -> IO (Ptr triple), Ptr triple -> IO (),
Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
-> IO
(Ptr paramStruct -> IO (Ptr triple), Ptr triple -> IO (),
Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
forall a b. (a -> b) -> a -> b
$
((Ptr paramStruct -> IO (Ptr triple))
-> (Ptr triple -> IO ())
-> (Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
-> (Ptr paramStruct -> IO (Ptr triple), Ptr triple -> IO (),
Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word))
-> Compose
CodeGenModule EngineAccess (Ptr paramStruct -> IO (Ptr triple))
-> Compose CodeGenModule EngineAccess (Ptr triple -> IO ())
-> Compose
CodeGenModule
EngineAccess
(Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
-> Exec
(Ptr paramStruct -> IO (Ptr triple), Ptr triple -> IO (),
Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,)
(Importer (Ptr paramStruct -> IO (Ptr triple))
-> String
-> CodeGen (Ptr paramStruct -> IO (Ptr triple))
-> Compose
CodeGenModule EngineAccess (Ptr paramStruct -> IO (Ptr triple))
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
Exec.createFunction Importer (Ptr paramStruct -> IO (Ptr triple))
forall param globalState.
Importer (Ptr param -> IO (Ptr globalState))
derefStartPtr String
"startprocess" (CodeGen (Ptr paramStruct -> IO (Ptr triple))
-> Compose
CodeGenModule EngineAccess (Ptr paramStruct -> IO (Ptr triple)))
-> CodeGen (Ptr paramStruct -> IO (Ptr triple))
-> Compose
CodeGenModule EngineAccess (Ptr paramStruct -> IO (Ptr triple))
forall a b. (a -> b) -> a -> b
$
\pPtr
paramPtr -> do
Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr <- CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Ptr (Triple paramStruct globalStruct stateStruct)))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.malloc
(global
global,state
state) <- pPtr
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) (global, state)
forall r. pPtr -> CodeGenFunction r (global, state)
start pPtr
paramPtr
(Value (Triple paramStruct globalStruct stateStruct)
-> Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) ())
-> Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> Value (Triple paramStruct globalStruct stateStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value (Triple paramStruct globalStruct stateStruct)
-> Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) ()
forall a r. Value a -> Value (Ptr a) -> CodeGenFunction r ()
LLVM.store Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Value (Triple paramStruct globalStruct stateStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) ())
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct)))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
((Value paramStruct
-> Value globalStruct
-> Value stateStruct
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct)))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value paramStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value globalStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value stateStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct)))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Value paramStruct
-> Value globalStruct
-> Value stateStruct
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Triple paramStruct globalStruct stateStruct))
forall a b c r.
(IsSized a, IsSized b, IsSized c) =>
Value a
-> Value b -> Value c -> CodeGenFunction r (Value (Triple a b c))
tripleStruct
(Value (Ptr paramStruct)
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value paramStruct)
forall a r. Value (Ptr a) -> CodeGenFunction r (Value a)
LLVM.load pPtr
Value (Ptr paramStruct)
paramPtr)
(global
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Struct global))
forall r. global -> CodeGenFunction r (Value (Struct global))
forall llvmValue r.
C llvmValue =>
llvmValue -> CodeGenFunction r (Value (Struct llvmValue))
Memory.compose global
global)
(state
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Struct state))
forall r. state -> CodeGenFunction r (Value (Struct state))
forall llvmValue r.
C llvmValue =>
llvmValue -> CodeGenFunction r (Value (Struct llvmValue))
Memory.compose state
state))
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct))
(Value (Ptr (Triple paramStruct globalStruct stateStruct)))
forall a.
a
-> CodeGenFunction
(Ptr (Triple paramStruct globalStruct stateStruct)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr)
(Importer (Ptr triple -> IO ())
-> String
-> CodeGen (Ptr triple -> IO ())
-> Compose CodeGenModule EngineAccess (Ptr triple -> IO ())
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
Exec.createFunction Importer (Ptr triple -> IO ())
forall globalState. Importer (Ptr globalState -> IO ())
derefStopPtr String
"stopprocess" (CodeGen (Ptr triple -> IO ())
-> Compose CodeGenModule EngineAccess (Ptr triple -> IO ()))
-> CodeGen (Ptr triple -> IO ())
-> Compose CodeGenModule EngineAccess (Ptr triple -> IO ())
forall a b. (a -> b) -> a -> b
$
\Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr -> do
pPtr
paramPtr <-
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> (Proxy D0, ())
-> CodeGenFunction
()
(Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D0, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Proxy D0
TypeNum.d0, ())
pPtr -> global -> CodeGenFunction () ()
forall r. pPtr -> global -> CodeGenFunction r ()
stop pPtr
paramPtr (global -> CodeGenFunction () ())
-> CodeGenFunction () global -> CodeGenFunction () ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
Value (Ptr globalStruct) -> CodeGenFunction () global
Value (Ptr (Struct global)) -> CodeGenFunction () global
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct global)) -> CodeGenFunction r global
Memory.load (Value (Ptr globalStruct) -> CodeGenFunction () global)
-> CodeGenFunction () (Value (Ptr globalStruct))
-> CodeGenFunction () global
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> (Proxy D1, ())
-> CodeGenFunction
()
(Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D1, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Proxy D1
TypeNum.d1, ())
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> CodeGenFunction () ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr)
(Importer
(Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
-> String
-> CodeGen
(Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
-> Compose
CodeGenModule
EngineAccess
(Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
Exec.createFunction Importer
(Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
forall globalStateStruct inp out.
Importer
(Ptr globalStateStruct -> Word -> Ptr inp -> Ptr out -> IO Word)
derefChunkPluggedPtr String
"fillprocess" (CodeGen
(Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
-> Compose
CodeGenModule
EngineAccess
(Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word))
-> CodeGen
(Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
-> Compose
CodeGenModule
EngineAccess
(Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
forall a b. (a -> b) -> a -> b
$
\Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr Value Word
loopLen Value (Ptr inStruct)
inPtr Value (Ptr outStruct)
outPtr -> do
pPtr
paramPtr <-
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> (Proxy D0, ())
-> CodeGenFunction
Word
(Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D0, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Proxy D0
TypeNum.d0, ())
Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D1, ())))
globalPtr <-
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> (Proxy D1, ())
-> CodeGenFunction
Word
(Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D1, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Proxy D1
TypeNum.d1, ())
Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D2, ())))
statePtr <-
Value (Ptr (Triple paramStruct globalStruct stateStruct))
-> (Proxy D2, ())
-> CodeGenFunction
Word
(Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D2, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr (Proxy D2
TypeNum.d2, ())
global
global <- Value (Ptr (Struct global)) -> CodeGenFunction Word global
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct global)) -> CodeGenFunction r global
Memory.load Value (Ptr (Struct global))
Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D1, ())))
globalPtr
state
sInit <- Value (Ptr (Struct state)) -> CodeGenFunction Word state
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct state)) -> CodeGenFunction r state
Memory.load Value (Ptr (Struct state))
Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D2, ())))
statePtr
paramIn
inParam <- Value (Ptr (Struct paramIn)) -> CodeGenFunction Word paramIn
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct paramIn)) -> CodeGenFunction r paramIn
Memory.load Value (Ptr inStruct)
Value (Ptr (Struct paramIn))
inPtr
paramOut
outParam <- Value (Ptr (Struct paramOut)) -> CodeGenFunction Word paramOut
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r.
Value (Ptr (Struct paramOut)) -> CodeGenFunction r paramOut
Memory.load Value (Ptr outStruct)
Value (Ptr (Struct paramOut))
outPtr
stateIn
inInit <- paramIn -> CodeGenFunction Word stateIn
forall r. paramIn -> CodeGenFunction r stateIn
startIn paramIn
inParam
stateOut
outInit <- paramOut -> CodeGenFunction Word stateOut
forall r. paramOut -> CodeGenFunction r stateOut
startOut paramOut
outParam
Value (Ptr local)
local <- CodeGenFunction Word (Value (Ptr local))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.alloca
(Value Word
pos,T (stateIn, state, stateOut)
sExit) <-
Value Word
-> (stateIn, state, stateOut)
-> ((stateIn, state, stateOut)
-> T Word
(T (stateIn, state, stateOut))
(stateIn, state, stateOut))
-> CodeGenFunction Word (Value Word, T (stateIn, state, stateOut))
forall s i r.
(Phi s, Undefined s, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i) =>
Value i
-> s -> (s -> T r (T s) s) -> CodeGenFunction r (Value i, T s)
MaybeCont.fixedLengthLoop Value Word
loopLen (stateIn
inInit, state
sInit, stateOut
outInit) (((stateIn, state, stateOut)
-> T Word
(T (stateIn, state, stateOut))
(stateIn, state, stateOut))
-> CodeGenFunction Word (Value Word, T (stateIn, state, stateOut)))
-> ((stateIn, state, stateOut)
-> T Word
(T (stateIn, state, stateOut))
(stateIn, state, stateOut))
-> CodeGenFunction Word (Value Word, T (stateIn, state, stateOut))
forall a b. (a -> b) -> a -> b
$
\ (stateIn
in0,state
s0,stateOut
out0) -> do
(valueA
a,stateIn
in1) <- CodeGenFunction Word (valueA, stateIn)
-> T Word (T (stateIn, state, stateOut)) (valueA, stateIn)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction Word (valueA, stateIn)
-> T Word (T (stateIn, state, stateOut)) (valueA, stateIn))
-> CodeGenFunction Word (valueA, stateIn)
-> T Word (T (stateIn, state, stateOut)) (valueA, stateIn)
forall a b. (a -> b) -> a -> b
$ paramIn -> stateIn -> CodeGenFunction Word (valueA, stateIn)
forall r. paramIn -> stateIn -> CodeGenFunction r (valueA, stateIn)
nextIn paramIn
inParam stateIn
in0
(valueB
b,state
s1) <- pPtr
-> global
-> Value (Ptr local)
-> valueA
-> state
-> T Word (T (stateIn, state, stateOut)) (valueB, state)
forall r z.
Phi z =>
pPtr
-> global
-> Value (Ptr local)
-> valueA
-> state
-> T r z (valueB, state)
next pPtr
paramPtr global
global Value (Ptr local)
local valueA
a state
s0
stateOut
out1 <- CodeGenFunction Word stateOut
-> T Word (T (stateIn, state, stateOut)) stateOut
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction Word stateOut
-> T Word (T (stateIn, state, stateOut)) stateOut)
-> CodeGenFunction Word stateOut
-> T Word (T (stateIn, state, stateOut)) stateOut
forall a b. (a -> b) -> a -> b
$ paramOut -> valueB -> stateOut -> CodeGenFunction Word stateOut
forall r.
paramOut -> valueB -> stateOut -> CodeGenFunction r stateOut
nextOut paramOut
outParam valueB
b stateOut
out0
(stateIn, state, stateOut)
-> T Word (T (stateIn, state, stateOut)) (stateIn, state, stateOut)
forall a. a -> T Word (T (stateIn, state, stateOut)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (stateIn
in1, state
s1, stateOut
out1)
state -> Value (Ptr (Struct state)) -> CodeGenFunction Word ()
forall r.
state -> Value (Ptr (Struct state)) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store ((stateIn, state, stateOut) -> state
forall a b c. (a, b, c) -> b
snd3 ((stateIn, state, stateOut) -> state)
-> (stateIn, state, stateOut) -> state
forall a b. (a -> b) -> a -> b
$ T (stateIn, state, stateOut) -> (stateIn, state, stateOut)
forall a. T a -> a
Maybe.fromJust T (stateIn, state, stateOut)
sExit) Value (Ptr (Struct state))
Value
(Ptr
(ElementPtrType
(Triple paramStruct globalStruct stateStruct) (Proxy D2, ())))
statePtr
Value Word -> CodeGenFunction Word (Value Word)
forall a. a -> CodeGenFunction Word a
forall (m :: * -> *) a. Monad m => a -> m a
return Value Word
pos)
processIOParameterized ::
(Marshal.C p, Cut.Read a, x ~ LLVM.Value (LLVM.Ptr (Marshal.Struct p))) =>
PIn.T a b -> Parameterized.T x b c -> POut.T c d ->
IO (IO (p, IO ()) -> PIO.T a d)
processIOParameterized :: forall p a x b c d.
(C p, Read a, x ~ Value (Ptr (Struct p))) =>
T a b -> T x b c -> T c d -> IO (IO (p, IO ()) -> T a d)
processIOParameterized
(PIn.Cons forall r. T parameters -> state -> CodeGenFunction r (b, state)
nextIn forall r. T parameters -> CodeGenFunction r state
startIn a -> IO (ioContext, parameters)
createIn ioContext -> IO ()
deleteIn)
T x b c
paramd
(POut.Cons forall r. T parameters -> c -> state -> CodeGenFunction r state
nextOut forall r. T parameters -> CodeGenFunction r state
startOut Int -> IO (ioContext, parameters)
createOut Int -> ioContext -> IO d
deleteOut) = do
case T x b c
paramd of
Parameterized.Cons forall r c.
Phi c =>
x -> global -> Value (Ptr local) -> b -> state -> T r c (c, state)
next forall r. x -> CodeGenFunction r (global, state)
start forall r. x -> global -> CodeGenFunction r ()
stop -> do
(Ptr (Struct p)
-> IO (Ptr (Triple (Struct p) (Struct global) (Struct state)))
startFunc, Ptr (Triple (Struct p) (Struct global) (Struct state)) -> IO ()
stopFunc, Ptr (Triple (Struct p) (Struct global) (Struct state))
-> Word
-> Ptr (Struct (T parameters))
-> Ptr (Struct (T parameters))
-> IO Word
fill) <-
(forall r. T parameters -> state -> CodeGenFunction r (b, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (forall r z.
Phi z =>
Value (Ptr (Struct p))
-> global -> Value (Ptr local) -> b -> state -> T r z (c, state))
-> (forall r.
Value (Ptr (Struct p)) -> CodeGenFunction r (global, state))
-> (forall r.
Value (Ptr (Struct p)) -> global -> CodeGenFunction r ())
-> (forall r.
T parameters -> c -> state -> CodeGenFunction r state)
-> (forall r. T parameters -> CodeGenFunction r state)
-> IO
(Ptr (Struct p)
-> IO (Ptr (Triple (Struct p) (Struct global) (Struct state))),
Ptr (Triple (Struct p) (Struct global) (Struct state)) -> IO (),
Ptr (Triple (Struct p) (Struct global) (Struct state))
-> Word
-> Ptr (Struct (T parameters))
-> Ptr (Struct (T parameters))
-> IO Word)
forall stateIn stateOut paramStruct pPtr state stateStruct global
globalStruct triple local paramIn inStruct paramOut outStruct
valueA valueB.
(Undefined stateIn, Phi stateIn, Undefined stateOut, Phi stateOut,
IsSized paramStruct, Value (Ptr paramStruct) ~ pPtr, C state,
Struct state ~ stateStruct, C global, Struct global ~ globalStruct,
Triple paramStruct globalStruct stateStruct ~ triple,
IsSized local, C paramIn, Struct paramIn ~ inStruct, C paramOut,
Struct paramOut ~ outStruct) =>
(forall r.
paramIn -> stateIn -> CodeGenFunction r (valueA, stateIn))
-> (forall r. paramIn -> CodeGenFunction r stateIn)
-> (forall r z.
Phi z =>
pPtr
-> global
-> Value (Ptr local)
-> valueA
-> state
-> T r z (valueB, state))
-> (forall r. pPtr -> CodeGenFunction r (global, state))
-> (forall r. pPtr -> global -> CodeGenFunction r ())
-> (forall r.
paramOut -> valueB -> stateOut -> CodeGenFunction r stateOut)
-> (forall r. paramOut -> CodeGenFunction r stateOut)
-> IO
(Ptr paramStruct -> IO (Ptr triple), Ptr triple -> IO (),
Ptr triple -> Word -> Ptr inStruct -> Ptr outStruct -> IO Word)
compilePlugged
T parameters -> state -> CodeGenFunction r (b, state)
forall r. T parameters -> state -> CodeGenFunction r (b, state)
nextIn T parameters -> CodeGenFunction r state
forall r. T parameters -> CodeGenFunction r state
startIn
x -> global -> Value (Ptr local) -> b -> state -> T r z (c, state)
Value (Ptr (Struct p))
-> global -> Value (Ptr local) -> b -> state -> T r z (c, state)
forall r c.
Phi c =>
x -> global -> Value (Ptr local) -> b -> state -> T r c (c, state)
forall r z.
Phi z =>
Value (Ptr (Struct p))
-> global -> Value (Ptr local) -> b -> state -> T r z (c, state)
next x -> CodeGenFunction r (global, state)
Value (Ptr (Struct p)) -> CodeGenFunction r (global, state)
forall r. x -> CodeGenFunction r (global, state)
forall r.
Value (Ptr (Struct p)) -> CodeGenFunction r (global, state)
start x -> global -> CodeGenFunction r ()
Value (Ptr (Struct p)) -> global -> CodeGenFunction r ()
forall r. x -> global -> CodeGenFunction r ()
forall r. Value (Ptr (Struct p)) -> global -> CodeGenFunction r ()
stop
T parameters -> c -> state -> CodeGenFunction r state
forall r. T parameters -> c -> state -> CodeGenFunction r state
nextOut T parameters -> CodeGenFunction r state
forall r. T parameters -> CodeGenFunction r state
startOut
(IO (p, IO ()) -> T a d) -> IO (IO (p, IO ()) -> T a d)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO (p, IO ()) -> T a d) -> IO (IO (p, IO ()) -> T a d))
-> (IO (p, IO ()) -> T a d) -> IO (IO (p, IO ()) -> T a d)
forall a b. (a -> b) -> a -> b
$ \IO (p, IO ())
createContext -> (a
-> (IO (), Ptr (Triple (Struct p) (Struct global) (Struct state)))
-> IO
(d,
(IO (), Ptr (Triple (Struct p) (Struct global) (Struct state)))))
-> IO
(IO (), Ptr (Triple (Struct p) (Struct global) (Struct state)))
-> ((IO (), Ptr (Triple (Struct p) (Struct global) (Struct state)))
-> IO ())
-> T a d
forall a b state.
(a -> state -> IO (b, state))
-> IO state -> (state -> IO ()) -> T a b
PIO.Cons
(\a
a s :: (IO (), Ptr (Triple (Struct p) (Struct global) (Struct state)))
s@(IO ()
_,Ptr (Triple (Struct p) (Struct global) (Struct state))
statePtr) -> do
let maximumSize :: Int
maximumSize = a -> Int
forall sig. Read sig => sig -> Int
Cut.length a
a
(ioContext
contextIn, parameters
paramIn) <- a -> IO (ioContext, parameters)
createIn a
a
(ioContext
contextOut,parameters
paramOut) <- Int -> IO (ioContext, parameters)
createOut Int
maximumSize
Word
actualSize <-
parameters
-> (Ptr (Struct (Repr parameters)) -> IO Word) -> IO Word
forall a b. C a => a -> (Ptr (Struct a) -> IO b) -> IO b
Marshal.with parameters
paramIn ((Ptr (Struct (Repr parameters)) -> IO Word) -> IO Word)
-> (Ptr (Struct (Repr parameters)) -> IO Word) -> IO Word
forall a b. (a -> b) -> a -> b
$ \Ptr (Struct (Repr parameters))
inptr ->
parameters
-> (Ptr (Struct (Repr parameters)) -> IO Word) -> IO Word
forall a b. C a => a -> (Ptr (Struct a) -> IO b) -> IO b
Marshal.with parameters
paramOut ((Ptr (Struct (Repr parameters)) -> IO Word) -> IO Word)
-> (Ptr (Struct (Repr parameters)) -> IO Word) -> IO Word
forall a b. (a -> b) -> a -> b
$ \Ptr (Struct (Repr parameters))
outptr ->
Ptr (Triple (Struct p) (Struct global) (Struct state))
-> Word
-> Ptr (Struct (T parameters))
-> Ptr (Struct (T parameters))
-> IO Word
fill Ptr (Triple (Struct p) (Struct global) (Struct state))
statePtr (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maximumSize) Ptr (Struct (Repr parameters))
Ptr (Struct (T parameters))
inptr Ptr (Struct (Repr parameters))
Ptr (Struct (T parameters))
outptr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
actualSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maximumSize) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"CausalParametrized.Process: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"output size " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
actualSize String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" > input size " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
maximumSize
ioContext -> IO ()
deleteIn ioContext
contextIn
d
b <- Int -> ioContext -> IO d
deleteOut (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
actualSize) ioContext
contextOut
(d,
(IO (), Ptr (Triple (Struct p) (Struct global) (Struct state))))
-> IO
(d,
(IO (), Ptr (Triple (Struct p) (Struct global) (Struct state))))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (d
b, (IO (), Ptr (Triple (Struct p) (Struct global) (Struct state)))
s))
(do
(p
p, IO ()
deleteContext) <- IO (p, IO ())
createContext
Ptr (Triple (Struct p) (Struct global) (Struct state))
ptr <- p
-> (Ptr (Struct p)
-> IO (Ptr (Triple (Struct p) (Struct global) (Struct state))))
-> IO (Ptr (Triple (Struct p) (Struct global) (Struct state)))
forall a b. C a => a -> (Ptr (Struct a) -> IO b) -> IO b
Marshal.with p
p Ptr (Struct p)
-> IO (Ptr (Triple (Struct p) (Struct global) (Struct state)))
startFunc
(IO (), Ptr (Triple (Struct p) (Struct global) (Struct state)))
-> IO
(IO (), Ptr (Triple (Struct p) (Struct global) (Struct state)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO ()
deleteContext, Ptr (Triple (Struct p) (Struct global) (Struct state))
ptr))
(\(IO ()
deleteContext, Ptr (Triple (Struct p) (Struct global) (Struct state))
ptr) -> Ptr (Triple (Struct p) (Struct global) (Struct state)) -> IO ()
stopFunc Ptr (Triple (Struct p) (Struct global) (Struct state))
ptr IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
deleteContext)
processIOCore ::
(Marshal.C p, Cut.Read a) =>
PIn.T a b -> (Exp p -> T b c) -> POut.T c d ->
IO (IO (p, IO ()) -> PIO.T a d)
processIOCore :: forall p a b c d.
(C p, Read a) =>
T a b -> (Exp p -> T b c) -> T c d -> IO (IO (p, IO ()) -> T a d)
processIOCore T a b
pin Exp p -> T b c
proc T c d
pout = do
T (Value (Ptr (Struct (Repr p)))) b c
paramd <- String
-> (Exp p -> T b c) -> IO (T (Value (Ptr (Struct (Repr p)))) b c)
forall p a b.
C p =>
String -> (Exp p -> T a b) -> IO (T (Value (Ptr (Struct p))) a b)
Parameterized.fromProcessPtr String
"Causal.process" Exp p -> T b c
proc
T a b
-> T (Value (Ptr (Struct (Repr p)))) b c
-> T c d
-> IO (IO (p, IO ()) -> T a d)
forall p a x b c d.
(C p, Read a, x ~ Value (Ptr (Struct p))) =>
T a b -> T x b c -> T c d -> IO (IO (p, IO ()) -> T a d)
processIOParameterized T a b
pin T (Value (Ptr (Struct (Repr p)))) b c
paramd T c d
pout
processIO ::
(Marshal.C p, Cut.Read a, PIn.Default a, POut.Default d) =>
(Exp p -> T (PIn.Element a) (POut.Element d)) ->
IO (p -> PIO.T a d)
processIO :: forall p a d.
(C p, Read a, Default a, Default d) =>
(Exp p -> T (Element a) (Element d)) -> IO (p -> T a d)
processIO Exp p -> T (Element a) (Element d)
proc =
((IO (p, IO ()) -> T a d) -> p -> T a d)
-> IO (IO (p, IO ()) -> T a d) -> IO (p -> T a d)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IO (p, IO ()) -> T a d
f p
p -> IO (p, IO ()) -> T a d
f ((p, IO ()) -> IO (p, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (p
p, () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))) (IO (IO (p, IO ()) -> T a d) -> IO (p -> T a d))
-> IO (IO (p, IO ()) -> T a d) -> IO (p -> T a d)
forall a b. (a -> b) -> a -> b
$
T a (Element a)
-> (Exp p -> T (Element a) (Element d))
-> T (Element d) d
-> IO (IO (p, IO ()) -> T a d)
forall p a b c d.
(C p, Read a) =>
T a b -> (Exp p -> T b c) -> T c d -> IO (IO (p, IO ()) -> T a d)
processIOCore T a (Element a)
forall a. Default a => T a (Element a)
PIn.deflt Exp p -> T (Element a) (Element d)
proc T (Element d) d
forall b. Default b => T (Element b) b
POut.deflt
class Run f where
type DSL f a b
type In f
type Out f
build ::
(Marshal.C p) =>
PIn.T (In f) a -> (Exp p -> DSL f a b) -> POut.T b (Out f) ->
IO (IO (p, IO ()) -> f)
instance (Cut.Read a) => Run (PIO.T a b) where
type DSL (PIO.T a b) al bl = T al bl
type In (PIO.T a b) = a
type Out (PIO.T a b) = b
build :: forall p a b.
C p =>
T (In (T a b)) a
-> (Exp p -> DSL (T a b) a b)
-> T b (Out (T a b))
-> IO (IO (p, IO ()) -> T a b)
build = T a a -> (Exp p -> T a b) -> T b b -> IO (IO (p, IO ()) -> T a b)
T (In (T a b)) a
-> (Exp p -> DSL (T a b) a b)
-> T b (Out (T a b))
-> IO (IO (p, IO ()) -> T a b)
forall p a b c d.
(C p, Read a) =>
T a b -> (Exp p -> T b c) -> T c d -> IO (IO (p, IO ()) -> T a d)
processIOCore
instance (RunArg a, Run f) => Run (a -> f) where
type DSL (a -> f) al bl = DSLArg a -> DSL f al bl
type In (a -> f) = In f
type Out (a -> f) = Out f
build :: forall p a b.
C p =>
T (In (a -> f)) a
-> (Exp p -> DSL (a -> f) a b)
-> T b (Out (a -> f))
-> IO (IO (p, IO ()) -> a -> f)
build T (In (a -> f)) a
pin Exp p -> DSL (a -> f) a b
sig T b (Out (a -> f))
pout =
case BuildArg a
forall a. RunArg a => BuildArg a
buildArg of
BuildArg Exp al -> DSLArg a
pass a -> IO (al, IO ())
createA -> do
IO ((p, al), IO ()) -> f
f <- T (In f) a
-> (Exp (p, al) -> DSL f a b)
-> T b (Out f)
-> IO (IO ((p, al), IO ()) -> f)
forall f p a b.
(Run f, C p) =>
T (In f) a
-> (Exp p -> DSL f a b) -> T b (Out f) -> IO (IO (p, IO ()) -> f)
forall p a b.
C p =>
T (In f) a
-> (Exp p -> DSL f a b) -> T b (Out f) -> IO (IO (p, IO ()) -> f)
build T (In f) a
T (In (a -> f)) a
pin ((Exp p -> Exp al -> DSL f a b) -> Exp (p, al) -> DSL f a b
forall a b c. (Exp a -> Exp b -> c) -> Exp (a, b) -> c
Expr.uncurry ((Exp p -> Exp al -> DSL f a b) -> Exp (p, al) -> DSL f a b)
-> (Exp p -> Exp al -> DSL f a b) -> Exp (p, al) -> DSL f a b
forall a b. (a -> b) -> a -> b
$ \Exp p
p -> Exp p -> DSL (a -> f) a b
sig Exp p
p (DSLArg a -> DSL f a b)
-> (Exp al -> DSLArg a) -> Exp al -> DSL f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp al -> DSLArg a
pass) T b (Out f)
T b (Out (a -> f))
pout
(IO (p, IO ()) -> a -> f) -> IO (IO (p, IO ()) -> a -> f)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO (p, IO ()) -> a -> f) -> IO (IO (p, IO ()) -> a -> f))
-> (IO (p, IO ()) -> a -> f) -> IO (IO (p, IO ()) -> a -> f)
forall a b. (a -> b) -> a -> b
$ \IO (p, IO ())
createP a
av ->
IO ((p, al), IO ()) -> f
f (do (p
p,IO ()
finalP) <- IO (p, IO ())
createP
(al
pa,IO ()
finalA) <- a -> IO (al, IO ())
createA a
av
((p, al), IO ()) -> IO ((p, al), IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((p
p,al
pa), IO ()
finalA IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
finalP))
runPlugged :: (Run f) => PIn.T (In f) a -> DSL f a b -> POut.T b (Out f) -> IO f
runPlugged :: forall f a b.
Run f =>
T (In f) a -> DSL f a b -> T b (Out f) -> IO f
runPlugged T (In f) a
pin DSL f a b
sig T b (Out f)
pout = do
IO ((), IO ()) -> f
act <- T (In f) a
-> (Exp () -> DSL f a b) -> T b (Out f) -> IO (IO ((), IO ()) -> f)
forall f p a b.
(Run f, C p) =>
T (In f) a
-> (Exp p -> DSL f a b) -> T b (Out f) -> IO (IO (p, IO ()) -> f)
forall p a b.
C p =>
T (In f) a
-> (Exp p -> DSL f a b) -> T b (Out f) -> IO (IO (p, IO ()) -> f)
build T (In f) a
pin (DSL f a b -> Exp () -> DSL f a b
forall a b. a -> b -> a
const DSL f a b
sig) T b (Out f)
pout
f -> IO f
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (f -> IO f) -> f -> IO f
forall a b. (a -> b) -> a -> b
$ IO ((), IO ()) -> f
act (((), IO ()) -> IO ((), IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
run ::
(Run f) =>
(In f ~ a, PIn.Default a, PIn.Element a ~ al) =>
(Out f ~ b, POut.Default b, POut.Element b ~ bl) =>
DSL f al bl -> IO f
run :: forall f a al b bl.
(Run f, In f ~ a, Default a, Element a ~ al, Out f ~ b, Default b,
Element b ~ bl) =>
DSL f al bl -> IO f
run DSL f al bl
sig = T (In f) al
-> DSL f al (Element b) -> T (Element b) (Out f) -> IO f
forall f a b.
Run f =>
T (In f) a -> DSL f a b -> T b (Out f) -> IO f
runPlugged T a (Element a)
T (In f) al
forall a. Default a => T a (Element a)
PIn.deflt DSL f al bl
DSL f al (Element b)
sig T (Element b) b
T (Element b) (Out f)
forall b. Default b => T (Element b) b
POut.deflt