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


{-
I liked to write something with signature

> import qualified Synthesizer.Causal.Process as Causal
>
> liftStorableChunk ::
>    (Exp param -> T valueA valueB) ->
>    IO (param -> Causal.T (SV.Vector a) (SV.Vector b))

but it does not quite work this way.
@Causal.T@ from @synthesizer-core@ uses an immutable state internally,
whereas @T@ uses mutable states.
In principle the immutable state of @Causal.T@
could be used for breaking the processing of a stream
and continue it on two different streams in parallel.
I have no function that makes use of this feature,
and thus an @ST@ monad might be a way out.

With this function we can convert an LLVM causal process to a causal IO arrow.
We also need the plugs in order
to read and write LLVM values from and to Haskell data chunks.

In a second step we could convert this to a processor of lazy lists,
and thus to a processor of chunky storable vectors.
-}
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
               -- print actualSize
               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