{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Synthesizer.LLVM.Generator.Render where
import qualified Synthesizer.LLVM.Causal.Parameterized as Parameterized
import qualified Synthesizer.LLVM.Generator.Source as Source
import qualified Synthesizer.LLVM.Storable.ChunkIterator as ChunkIt
import qualified Synthesizer.LLVM.Storable.LazySizeIterator as SizeIt
import qualified Synthesizer.LLVM.EventIterator as EventIt
import Synthesizer.LLVM.Generator.Private (T(Cons))
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import qualified Synthesizer.LLVM.Storable.Vector as SVU
import qualified Synthesizer.LLVM.ForeignPtr as ForeignPtr
import qualified Synthesizer.LLVM.ConstantPiece as Const
import qualified Synthesizer.PiecewiseConstant.Signal as PC
import qualified Synthesizer.Causal.Class as CausalClass
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.Control as C
import qualified LLVM.Extra.Arithmetic as A
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.Lazy as SVL
import qualified Data.StorableVector.Base as SVB
import qualified Data.StorableVector as SV
import qualified Data.EventList.Relative.BodyTime as EventList
import qualified Numeric.NonNegative.Wrapper as NonNeg
import qualified Numeric.NonNegative.Chunky as NonNegChunky
import Control.Monad (join)
import Control.Applicative (liftA3)
import Foreign.ForeignPtr (touchForeignPtr)
import Foreign.Ptr (Ptr)
import Data.Foldable (traverse_)
import Data.Tuple.Strict (mapPair, mapTriple)
import Data.Word (Word, Word8, Word32)
import qualified System.Unsafe as Unsafe
foreign import ccall safe "dynamic" derefFillPtr ::
Exec.Importer (LLVM.Ptr param -> Word -> Ptr struct -> IO Word)
compile ::
(Storable.C a, MultiValue.T a ~ value,
Marshal.C param, Marshal.Struct param ~ paramStruct) =>
(Exp param -> T value) ->
IO (LLVM.Ptr paramStruct -> Word -> Ptr a -> IO Word)
compile :: forall a value param paramStruct.
(C a, T a ~ value, C param, Struct param ~ paramStruct) =>
(Exp param -> T value)
-> IO (Ptr paramStruct -> Word -> Ptr a -> IO Word)
compile Exp param -> T value
sig =
String
-> Exec (Ptr paramStruct -> Word -> Ptr a -> IO Word)
-> IO (Ptr paramStruct -> Word -> Ptr a -> IO Word)
forall funcs. String -> Exec funcs -> IO funcs
Exec.compile String
"signal" (Exec (Ptr paramStruct -> Word -> Ptr a -> IO Word)
-> IO (Ptr paramStruct -> Word -> Ptr a -> IO Word))
-> Exec (Ptr paramStruct -> Word -> Ptr a -> IO Word)
-> IO (Ptr paramStruct -> Word -> Ptr a -> IO Word)
forall a b. (a -> b) -> a -> b
$
Importer (Ptr paramStruct -> Word -> Ptr a -> IO Word)
-> String
-> CodeGen (Ptr paramStruct -> Word -> Ptr a -> IO Word)
-> Exec (Ptr paramStruct -> Word -> Ptr a -> IO Word)
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
Exec.createFunction Importer (Ptr paramStruct -> Word -> Ptr a -> IO Word)
forall param struct.
Importer (Ptr param -> Word -> Ptr struct -> IO Word)
derefFillPtr String
"fill" (CodeGen (Ptr paramStruct -> Word -> Ptr a -> IO Word)
-> Exec (Ptr paramStruct -> Word -> Ptr a -> IO Word))
-> CodeGen (Ptr paramStruct -> Word -> Ptr a -> IO Word)
-> Exec (Ptr paramStruct -> Word -> Ptr a -> IO Word)
forall a b. (a -> b) -> a -> b
$ \Value (Ptr paramStruct)
paramPtr Value Word
size Value (Ptr a)
bPtr ->
case Exp param -> T value
sig ((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) -> state -> T r c (value, 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)
-> state
-> (Value (Ptr a)
-> state -> T Word (T (Value (Ptr a), state)) state)
-> CodeGenFunction Word (Value Word, T state)
forall s i a ptrA z r.
(Phi s, Undefined s, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i, Storable a, Value (Ptr a) ~ ptrA,
T (ptrA, s) ~ z) =>
Value i
-> ptrA
-> s
-> (ptrA -> s -> T r z s)
-> CodeGenFunction r (Value i, T s)
Storable.arrayLoopMaybeCont Value Word
size Value (Ptr a)
bPtr state
s ((Value (Ptr a)
-> state -> T Word (T (Value (Ptr a), state)) state)
-> CodeGenFunction Word (Value Word, T state))
-> (Value (Ptr a)
-> state -> T Word (T (Value (Ptr a), state)) state)
-> CodeGenFunction Word (Value Word, T state)
forall a b. (a -> b) -> a -> b
$ \ Value (Ptr a)
ptri state
s0 -> do
(value
y,state
s1) <- global
-> Value (Ptr local)
-> state
-> T Word (T (Value (Ptr a), state)) (value, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (value, state)
next global
global Value (Ptr local)
local state
s0
CodeGenFunction Word () -> T Word (T (Value (Ptr a), state)) ()
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction Word () -> T Word (T (Value (Ptr a), state)) ())
-> CodeGenFunction Word () -> T Word (T (Value (Ptr a), state)) ()
forall a b. (a -> b) -> a -> b
$ T a -> Value (Ptr a) -> CodeGenFunction Word ()
forall r. T a -> Value (Ptr a) -> CodeGenFunction r ()
forall a r. C a => T a -> Value (Ptr a) -> CodeGenFunction r ()
Storable.store value
T a
y Value (Ptr a)
ptri
state -> T Word (T (Value (Ptr a), state)) state
forall a. a -> T Word (T (Value (Ptr a), 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 ~ value) =>
(Exp p -> T value) -> IO (IO () -> Int -> p -> IO (SV.Vector a))
runAux :: forall p a value.
(C p, C a, T a ~ value) =>
(Exp p -> T value) -> IO (IO () -> Int -> p -> IO (Vector a))
runAux Exp p -> T value
sig = do
Ptr (Struct (Repr p)) -> Word -> Ptr a -> IO Word
fill <- (Exp p -> T value)
-> IO (Ptr (Struct (Repr p)) -> Word -> Ptr a -> IO Word)
forall a value param paramStruct.
(C a, T a ~ value, C param, Struct param ~ paramStruct) =>
(Exp param -> T value)
-> IO (Ptr paramStruct -> Word -> Ptr a -> IO Word)
compile Exp p -> T value
sig
(IO () -> Int -> p -> IO (Vector a))
-> IO (IO () -> Int -> p -> IO (Vector a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO () -> Int -> p -> IO (Vector a))
-> IO (IO () -> Int -> p -> IO (Vector a)))
-> (IO () -> Int -> p -> IO (Vector a))
-> IO (IO () -> Int -> p -> IO (Vector a))
forall a b. (a -> b) -> a -> b
$ \IO ()
final Int
len p
param ->
p -> (Ptr (Struct (Repr p)) -> IO (Vector a)) -> IO (Vector a)
forall a b. C a => a -> (Ptr (Struct a) -> IO b) -> IO b
Marshal.with p
param ((Ptr (Struct (Repr p)) -> IO (Vector a)) -> IO (Vector a))
-> (Ptr (Struct (Repr p)) -> IO (Vector a)) -> IO (Vector a)
forall a b. (a -> b) -> a -> b
$ \Ptr (Struct (Repr p))
paramPtr ->
Int -> (Ptr a -> IO Int) -> IO (Vector a)
forall a. Storable a => Int -> (Ptr a -> IO Int) -> IO (Vector a)
SVB.createAndTrim Int
len ((Ptr a -> IO Int) -> IO (Vector a))
-> (Ptr a -> IO Int) -> IO (Vector a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
Word
n <- Ptr (Struct (Repr p)) -> Word -> Ptr a -> IO Word
fill Ptr (Struct (Repr p))
paramPtr (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr a
ptr
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 ~ value) =>
(Exp p -> T value) -> IO (Int -> p -> IO (SV.Vector a))
run_ :: forall p a value.
(C p, C a, T a ~ value) =>
(Exp p -> T value) -> IO (Int -> p -> IO (Vector a))
run_ = ((IO () -> Int -> p -> IO (Vector a)) -> Int -> p -> IO (Vector a))
-> IO (IO () -> Int -> p -> IO (Vector a))
-> IO (Int -> p -> IO (Vector a))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IO () -> Int -> p -> IO (Vector a))
-> IO () -> Int -> p -> IO (Vector a)
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO (IO () -> Int -> p -> IO (Vector a))
-> IO (Int -> p -> IO (Vector a)))
-> ((Exp p -> T value) -> IO (IO () -> Int -> p -> IO (Vector a)))
-> (Exp p -> T value)
-> IO (Int -> p -> IO (Vector a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp p -> T value) -> IO (IO () -> Int -> p -> IO (Vector a))
forall p a value.
(C p, C a, T a ~ value) =>
(Exp p -> T value) -> IO (IO () -> Int -> p -> IO (Vector a))
runAux
foreign import ccall safe "dynamic" derefStartPtr ::
Exec.Importer (LLVM.Ptr param -> IO (LLVM.Ptr globalState))
foreign import ccall safe "dynamic" derefStopPtr ::
Exec.Importer (LLVM.Ptr globalState -> IO ())
foreign import ccall safe "dynamic" derefChunkPtr ::
Exec.Importer (LLVM.Ptr globalState -> Word -> Ptr a -> IO Word)
type MemoryPtr a = LLVM.Ptr (Memory.Struct a)
type WithGlobalState param = LLVM.Struct (param, ())
type Pair a b = LLVM.Struct (a,(b,()))
type Triple a b c = LLVM.Struct (a,(b,(c,())))
tripleStruct ::
(LLVM.IsSized a, LLVM.IsSized b, LLVM.IsSized c) =>
LLVM.Value a -> LLVM.Value b -> LLVM.Value c ->
LLVM.CodeGenFunction r (LLVM.Value (Triple a b c))
tripleStruct :: 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 a
a Value b
b Value c
c = do
Value (Triple a b c)
s0 <- Value (Triple a b c)
-> Value (ValueType (Triple a b c) (Proxy D0))
-> Proxy D0
-> CodeGenFunction r (Value (Triple a b c))
forall r agg i.
GetValue agg i =>
Value agg
-> Value (ValueType agg i) -> i -> CodeGenFunction r (Value agg)
LLVM.insertvalue Value (Triple a b c)
forall a. Undefined a => a
Tuple.undef Value a
Value (ValueType (Triple a b c) (Proxy D0))
a Proxy D0
TypeNum.d0
Value (Triple a b c)
s1 <- Value (Triple a b c)
-> Value (ValueType (Triple a b c) (Proxy D1))
-> Proxy D1
-> CodeGenFunction r (Value (Triple a b c))
forall r agg i.
GetValue agg i =>
Value agg
-> Value (ValueType agg i) -> i -> CodeGenFunction r (Value agg)
LLVM.insertvalue Value (Triple a b c)
s0 Value b
Value (ValueType (Triple a b c) (Proxy D1))
b Proxy D1
TypeNum.d1
Value (Triple a b c)
-> Value (ValueType (Triple a b c) (Proxy D2))
-> Proxy D2
-> CodeGenFunction r (Value (Triple a b c))
forall r agg i.
GetValue agg i =>
Value agg
-> Value (ValueType agg i) -> i -> CodeGenFunction r (Value agg)
LLVM.insertvalue Value (Triple a b c)
s1 Value c
Value (ValueType (Triple a b c) (Proxy D2))
c Proxy D2
TypeNum.d2
compileHandler ::
(Marshal.C param, Marshal.Struct param ~ paramStruct,
Storable.C a, MultiValue.T a ~ value) =>
(Exp param -> T value) ->
LLVM.CodeGenModule
(LLVM.Function
(Word8 -> LLVM.Ptr paramStruct -> Word -> Ptr a ->
IO (Pair (LLVM.Ptr (WithGlobalState paramStruct)) Word)))
compileHandler :: forall param paramStruct a value.
(C param, Struct param ~ paramStruct, C a, T a ~ value) =>
(Exp param -> T value)
-> CodeGenModule
(Function
(Word8
-> Ptr paramStruct
-> Word
-> Ptr a
-> IO (Pair (Ptr (WithGlobalState paramStruct)) Word)))
compileHandler Exp param -> T value
sig =
Linkage
-> String
-> FunctionCodeGen
(Word8
-> Ptr paramStruct
-> Word
-> Ptr a
-> IO (Pair (Ptr (WithGlobalState paramStruct)) Word))
-> CodeGenModule
(Value
(FunPtr
(Word8
-> Ptr paramStruct
-> Word
-> Ptr a
-> IO (Pair (Ptr (WithGlobalState paramStruct)) Word))))
forall f.
FunctionArgs f =>
Linkage
-> String -> FunctionCodeGen f -> CodeGenModule (Function f)
LLVM.createNamedFunction Linkage
LLVM.InternalLinkage String
"handlesignal" (FunctionCodeGen
(Word8
-> Ptr paramStruct
-> Word
-> Ptr a
-> IO (Pair (Ptr (WithGlobalState paramStruct)) Word))
-> CodeGenModule
(Value
(FunPtr
(Word8
-> Ptr paramStruct
-> Word
-> Ptr a
-> IO (Pair (Ptr (WithGlobalState paramStruct)) Word)))))
-> FunctionCodeGen
(Word8
-> Ptr paramStruct
-> Word
-> Ptr a
-> IO (Pair (Ptr (WithGlobalState paramStruct)) Word))
-> CodeGenModule
(Value
(FunPtr
(Word8
-> Ptr paramStruct
-> Word
-> Ptr a
-> IO (Pair (Ptr (WithGlobalState paramStruct)) Word))))
forall a b. (a -> b) -> a -> b
$
\Value Word8
phase Value (Ptr paramStruct)
paramPtr Value Word
loopLen Value (Ptr a)
bufferPtr ->
case Exp param -> T value
sig (Exp param -> T value) -> Exp param -> T value
forall a b. (a -> b) -> a -> b
$ (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) -> state -> T r c (value, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop -> do
Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
paramGlobalStatePtr <- Value (Ptr paramStruct)
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Ptr (Triple paramStruct (Struct global) (Struct state))))
forall (value :: * -> *) a b r.
(ValueCons value, IsSized a, IsSized b, SizeOf a ~ SizeOf b) =>
value a -> CodeGenFunction r (value b)
LLVM.bitcast Value (Ptr paramStruct)
paramPtr
let create :: CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
create = do
Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
newParamGlobalStatePtr <- CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Ptr (Triple paramStruct (Struct global) (Struct state))))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.malloc
(global
global,state
state) <- CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) (global, state)
forall r. CodeGenFunction r (global, state)
start
(Value (Triple paramStruct (Struct global) (Struct state))
-> Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ())
-> Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
-> Value (Triple paramStruct (Struct global) (Struct state))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value (Triple paramStruct (Struct global) (Struct state))
-> Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ()
forall a r. Value a -> Value (Ptr a) -> CodeGenFunction r ()
LLVM.store Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
newParamGlobalStatePtr (Value (Triple paramStruct (Struct global) (Struct state))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ())
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Triple paramStruct (Struct global) (Struct state)))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Triple paramStruct (Struct global) (Struct state))))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Triple paramStruct (Struct global) (Struct state)))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
((Value paramStruct
-> Value (Struct global)
-> Value (Struct state)
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Triple paramStruct (Struct global) (Struct state))))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) (Value paramStruct)
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Struct global))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Struct state))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Triple paramStruct (Struct global) (Struct state))))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Value paramStruct
-> Value (Struct global)
-> Value (Struct state)
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Triple paramStruct (Struct global) (Struct state)))
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
(Pair (Ptr (WithGlobalState paramStruct)) Word) (Value paramStruct)
forall a r. Value (Ptr a) -> CodeGenFunction r (Value a)
LLVM.load Value (Ptr paramStruct)
paramPtr)
(global
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(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
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(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 (WithGlobalState paramStruct))
newOpaqueParamGlobalStatePtr <-
Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Ptr (WithGlobalState paramStruct)))
forall (value :: * -> *) a b r.
(ValueCons value, IsSized a, IsSized b, SizeOf a ~ SizeOf b) =>
value a -> CodeGenFunction r (value b)
LLVM.bitcast
(Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
newParamGlobalStatePtr Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
-> Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
-> Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
forall a. a -> a -> a
`asTypeOf` Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
paramGlobalStatePtr)
Value (Pair (Ptr (WithGlobalState paramStruct)) Word)
-> Value
(ValueType
(Pair (Ptr (WithGlobalState paramStruct)) Word) (Proxy D0))
-> Proxy D0
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
forall r agg i.
GetValue agg i =>
Value agg
-> Value (ValueType agg i) -> i -> CodeGenFunction r (Value agg)
LLVM.insertvalue Value (Pair (Ptr (WithGlobalState paramStruct)) Word)
forall a. Undefined a => a
Tuple.undef
Value
(ValueType
(Pair (Ptr (WithGlobalState paramStruct)) Word) (Proxy D0))
Value (Ptr (WithGlobalState paramStruct))
newOpaqueParamGlobalStatePtr Proxy D0
TypeNum.d0
let delete :: CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
delete = do
Value (Ptr (Struct global))
globalPtr <-
Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
-> (Proxy D1, ())
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value
(Ptr
(ElementPtrType
(Triple paramStruct (Struct global) (Struct state))
(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 (Struct global) (Struct state)))
paramGlobalStatePtr (Proxy D1
TypeNum.d1, ())
global
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ()
forall r. global -> CodeGenFunction r ()
stop (global
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ())
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) global
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr (Struct global))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) 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))
globalPtr
Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
paramGlobalStatePtr
Value (Pair (Ptr (WithGlobalState paramStruct)) Word)
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
forall a.
a
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) a
forall (m :: * -> *) a. Monad m => a -> m a
return Value (Pair (Ptr (WithGlobalState paramStruct)) Word)
forall a. Undefined a => a
Tuple.undef
let fill :: CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
fill = do
Value (Ptr (Struct global))
globalPtr <-
Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
-> (Proxy D1, ())
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value
(Ptr
(ElementPtrType
(Triple paramStruct (Struct global) (Struct state))
(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 (Struct global) (Struct state)))
paramGlobalStatePtr (Proxy D1
TypeNum.d1, ())
Value (Ptr (Struct state))
statePtr <-
Value (Ptr (Triple paramStruct (Struct global) (Struct state)))
-> (Proxy D2, ())
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value
(Ptr
(ElementPtrType
(Triple paramStruct (Struct global) (Struct state))
(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 (Struct global) (Struct state)))
paramGlobalStatePtr (Proxy D2
TypeNum.d2, ())
global
global <- Value (Ptr (Struct global))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) 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))
globalPtr
state
sInit <- Value (Ptr (Struct state))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) 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))
statePtr
Value (Ptr local)
local <- CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) 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)
-> state
-> (Value (Ptr a)
-> state
-> T (Pair (Ptr (WithGlobalState paramStruct)) Word)
(T (Value (Ptr a), state))
state)
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value Word, T state)
forall s i a ptrA z r.
(Phi s, Undefined s, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i, Storable a, Value (Ptr a) ~ ptrA,
T (ptrA, s) ~ z) =>
Value i
-> ptrA
-> s
-> (ptrA -> s -> T r z s)
-> CodeGenFunction r (Value i, T s)
Storable.arrayLoopMaybeCont Value Word
loopLen Value (Ptr a)
bufferPtr state
sInit ((Value (Ptr a)
-> state
-> T (Pair (Ptr (WithGlobalState paramStruct)) Word)
(T (Value (Ptr a), state))
state)
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value Word, T state))
-> (Value (Ptr a)
-> state
-> T (Pair (Ptr (WithGlobalState paramStruct)) Word)
(T (Value (Ptr a), state))
state)
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value Word, T state)
forall a b. (a -> b) -> a -> b
$
\ Value (Ptr a)
ptr state
s0 -> do
(value
y,state
s1) <- global
-> Value (Ptr local)
-> state
-> T (Pair (Ptr (WithGlobalState paramStruct)) Word)
(T (Value (Ptr a), state))
(value, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (value, state)
next global
global Value (Ptr local)
local state
s0
CodeGenFunction (Pair (Ptr (WithGlobalState paramStruct)) Word) ()
-> T (Pair (Ptr (WithGlobalState paramStruct)) Word)
(T (Value (Ptr a), state))
()
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction (Pair (Ptr (WithGlobalState paramStruct)) Word) ()
-> T (Pair (Ptr (WithGlobalState paramStruct)) Word)
(T (Value (Ptr a), state))
())
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ()
-> T (Pair (Ptr (WithGlobalState paramStruct)) Word)
(T (Value (Ptr a), state))
()
forall a b. (a -> b) -> a -> b
$ T a
-> Value (Ptr a)
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ()
forall r. T a -> Value (Ptr a) -> CodeGenFunction r ()
forall a r. C a => T a -> Value (Ptr a) -> CodeGenFunction r ()
Storable.store value
T a
y Value (Ptr a)
ptr
state
-> T (Pair (Ptr (WithGlobalState paramStruct)) Word)
(T (Value (Ptr a), state))
state
forall a.
a
-> T (Pair (Ptr (WithGlobalState paramStruct)) Word)
(T (Value (Ptr a), state))
a
forall (m :: * -> *) a. Monad m => a -> m a
return state
s1
state
-> Value (Ptr (Struct state))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) 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))
statePtr
Value (Pair (Ptr (WithGlobalState paramStruct)) Word)
-> Value
(ValueType
(Pair (Ptr (WithGlobalState paramStruct)) Word) (Proxy D1))
-> Proxy D1
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
forall r agg i.
GetValue agg i =>
Value agg
-> Value (ValueType agg i) -> i -> CodeGenFunction r (Value agg)
LLVM.insertvalue Value (Pair (Ptr (WithGlobalState paramStruct)) Word)
forall a. Undefined a => a
Tuple.undef Value Word
Value
(ValueType
(Pair (Ptr (WithGlobalState paramStruct)) Word) (Proxy D1))
pos Proxy D1
TypeNum.d1
Value Bool
doCreate <- CmpPredicate
-> Value Word8
-> Value Word8
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(CmpResult (Value Word8))
forall r.
CmpPredicate
-> Value Word8
-> Value Word8
-> CodeGenFunction r (CmpResult (Value Word8))
forall a r.
Comparison a =>
CmpPredicate -> a -> a -> CodeGenFunction r (CmpResult a)
A.cmp CmpPredicate
LLVM.CmpEQ (Word8 -> Value Word8
forall a. IsConst a => a -> Value a
LLVM.valueOf Word8
0) Value Word8
phase
Value Bool
doDelete <- CmpPredicate
-> Value Word8
-> Value Word8
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(CmpResult (Value Word8))
forall r.
CmpPredicate
-> Value Word8
-> Value Word8
-> CodeGenFunction r (CmpResult (Value Word8))
forall a r.
Comparison a =>
CmpPredicate -> a -> a -> CodeGenFunction r (CmpResult a)
A.cmp CmpPredicate
LLVM.CmpEQ (Word8 -> Value Word8
forall a. IsConst a => a -> Value a
LLVM.valueOf Word8
1) Value Word8
phase
Value (Pair (Ptr (WithGlobalState paramStruct)) Word)
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ()
forall a. Value a -> CodeGenFunction a ()
C.ret (Value (Pair (Ptr (WithGlobalState paramStruct)) Word)
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ())
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
(Value Bool
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
forall a r.
Phi a =>
Value Bool
-> CodeGenFunction r a
-> CodeGenFunction r a
-> CodeGenFunction r a
C.ifThenElse Value Bool
doCreate CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
create (CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word)))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
forall a b. (a -> b) -> a -> b
$
Value Bool
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
-> CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
forall a r.
Phi a =>
Value Bool
-> CodeGenFunction r a
-> CodeGenFunction r a
-> CodeGenFunction r a
C.ifThenElse Value Bool
doDelete CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
delete CodeGenFunction
(Pair (Ptr (WithGlobalState paramStruct)) Word)
(Value (Pair (Ptr (WithGlobalState paramStruct)) Word))
fill)
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 ~ value) =>
(forall r z. (Tuple.Phi z) =>
pPtr -> global -> LLVM.Value (LLVM.Ptr local) ->
() -> state -> MaybeCont.T r z (value, 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 -> IO Word)
compileChunky :: forall paramStruct pPtr state stateStruct global globalStruct
triple local a value.
(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 ~ value) =>
(forall r z.
Phi z =>
pPtr
-> global
-> Value (Ptr local)
-> ()
-> state
-> T r z (value, 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 -> IO Word)
compileChunky forall r z.
Phi z =>
pPtr
-> global
-> Value (Ptr local)
-> ()
-> state
-> T r z (value, 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 -> IO Word)
-> IO
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> IO Word)
forall funcs. String -> Exec funcs -> IO funcs
Exec.compile String
"signal-chunky" (Exec
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> IO Word)
-> IO
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> IO Word))
-> Exec
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> IO Word)
-> IO
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> IO Word)
forall a b. (a -> b) -> a -> b
$
((Ptr paramStruct -> IO (Ptr triple))
-> Finalizer triple
-> (Ptr triple -> Word -> Ptr a -> IO Word)
-> (Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> IO Word))
-> Compose
CodeGenModule EngineAccess (Ptr paramStruct -> IO (Ptr triple))
-> Compose CodeGenModule EngineAccess (Finalizer triple)
-> Compose
CodeGenModule EngineAccess (Ptr triple -> Word -> Ptr a -> IO Word)
-> Exec
(Ptr paramStruct -> IO (Ptr triple), Finalizer triple,
Ptr triple -> Word -> Ptr a -> 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
"startsignal" (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
"stopsignal" (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 -> IO Word)
-> String
-> CodeGen (Ptr triple -> Word -> Ptr a -> IO Word)
-> Compose
CodeGenModule EngineAccess (Ptr triple -> Word -> Ptr a -> IO Word)
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
Exec.createFunction Importer (Ptr triple -> Word -> Ptr a -> IO Word)
forall param struct.
Importer (Ptr param -> Word -> Ptr struct -> IO Word)
derefChunkPtr String
"fillsignal" (CodeGen (Ptr triple -> Word -> Ptr a -> IO Word)
-> Compose
CodeGenModule
EngineAccess
(Ptr triple -> Word -> Ptr a -> IO Word))
-> CodeGen (Ptr triple -> Word -> Ptr a -> IO Word)
-> Compose
CodeGenModule EngineAccess (Ptr triple -> Word -> Ptr a -> IO Word)
forall a b. (a -> b) -> a -> b
$
\Value (Ptr (Triple paramStruct globalStruct stateStruct))
paramGlobalStatePtr Value Word
loopLen Value (Ptr a)
ptr -> 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, ())
global
global <-
Value (Ptr globalStruct) -> CodeGenFunction Word 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 globalStruct) -> CodeGenFunction Word global)
-> CodeGenFunction Word (Value (Ptr globalStruct))
-> CodeGenFunction Word global
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
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, ())
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)
-> state
-> (Value (Ptr a)
-> state -> T Word (T (Value (Ptr a), state)) state)
-> CodeGenFunction Word (Value Word, T state)
forall s i a ptrA z r.
(Phi s, Undefined s, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i, Storable a, Value (Ptr a) ~ ptrA,
T (ptrA, s) ~ z) =>
Value i
-> ptrA
-> s
-> (ptrA -> s -> T r z s)
-> CodeGenFunction r (Value i, T s)
Storable.arrayLoopMaybeCont Value Word
loopLen Value (Ptr a)
ptr state
sInit ((Value (Ptr a)
-> state -> T Word (T (Value (Ptr a), state)) state)
-> CodeGenFunction Word (Value Word, T state))
-> (Value (Ptr a)
-> state -> T Word (T (Value (Ptr a), state)) state)
-> CodeGenFunction Word (Value Word, T state)
forall a b. (a -> b) -> a -> b
$
\ Value (Ptr a)
ptri state
s0 -> do
(value
y,state
s1) <- pPtr
-> global
-> Value (Ptr local)
-> ()
-> state
-> T Word (T (Value (Ptr a), state)) (value, state)
forall r z.
Phi z =>
pPtr
-> global
-> Value (Ptr local)
-> ()
-> state
-> T r z (value, state)
next pPtr
paramPtr global
global Value (Ptr local)
local () state
s0
CodeGenFunction Word () -> T Word (T (Value (Ptr a), state)) ()
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction Word () -> T Word (T (Value (Ptr a), state)) ())
-> CodeGenFunction Word () -> T Word (T (Value (Ptr a), state)) ()
forall a b. (a -> b) -> a -> b
$ T a -> Value (Ptr a) -> CodeGenFunction Word ()
forall r. T a -> Value (Ptr a) -> CodeGenFunction r ()
forall a r. C a => T a -> Value (Ptr a) -> CodeGenFunction r ()
Storable.store value
T a
y Value (Ptr a)
ptri
state -> T Word (T (Value (Ptr a), state)) state
forall a. a -> T Word (T (Value (Ptr a), 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)
runChunkyAux ::
(Storable.C a, MultiValue.T a ~ value, Marshal.C p) =>
(Exp p -> T value) -> IO (IO () -> SVL.ChunkSize -> p -> IO (SVL.Vector a))
runChunkyAux :: forall a value p.
(C a, T a ~ value, C p) =>
(Exp p -> T value) -> IO (IO () -> ChunkSize -> p -> IO (Vector a))
runChunkyAux Exp p -> T value
sig = do
T (Value (Ptr (Struct (Repr p)))) () (T a)
paramd <-
String
-> (Exp p -> T () (T a))
-> IO (T (Value (Ptr (Struct (Repr p)))) () (T a))
forall p a b.
C p =>
String -> (Exp p -> T a b) -> IO (T (Value (Ptr (Struct p))) a b)
Parameterized.fromProcessPtr String
"Signal.run" (SignalOf T (T a) -> T () (T a)
T value -> T () (T a)
forall b a. SignalOf T b -> T a b
forall (process :: * -> * -> *) b a.
C process =>
SignalOf process b -> process a b
CausalClass.fromSignal (T value -> T () (T a))
-> (Exp p -> T value) -> Exp p -> T () (T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp p -> T value
sig)
case T (Value (Ptr (Struct (Repr p)))) () (T a)
paramd of
Parameterized.Cons forall r c.
Phi c =>
Value (Ptr (Struct (Repr p)))
-> global -> Value (Ptr local) -> () -> state -> T r c (T a, state)
next forall r.
Value (Ptr (Struct (Repr p))) -> CodeGenFunction r (global, state)
start forall r.
Value (Ptr (Struct (Repr p))) -> global -> CodeGenFunction r ()
stop -> do
(Ptr (Struct (Repr p))
-> IO
(Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state)))
startFunc,Finalizer (Triple (Struct (Repr p)) (Struct global) (Struct state))
stopFunc,Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state))
-> Word -> Ptr a -> IO Word
fill) <- (forall r c.
Phi c =>
Value (Ptr (Struct (Repr p)))
-> global
-> Value (Ptr local)
-> ()
-> state
-> T r c (T a, state))
-> (forall r.
Value (Ptr (Struct (Repr p))) -> CodeGenFunction r (global, state))
-> (forall r.
Value (Ptr (Struct (Repr p))) -> global -> CodeGenFunction r ())
-> IO
(Ptr (Struct (Repr p))
-> IO
(Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state))),
Finalizer
(Triple (Struct (Repr p)) (Struct global) (Struct state)),
Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state))
-> Word -> Ptr a -> IO Word)
forall paramStruct pPtr state stateStruct global globalStruct
triple local a value.
(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 ~ value) =>
(forall r z.
Phi z =>
pPtr
-> global
-> Value (Ptr local)
-> ()
-> state
-> T r z (value, 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 -> IO Word)
compileChunky Value (Ptr (Struct (Repr p)))
-> global -> Value (Ptr local) -> () -> state -> T r z (T a, state)
forall r c.
Phi c =>
Value (Ptr (Struct (Repr p)))
-> global -> Value (Ptr local) -> () -> state -> T r c (T a, state)
next Value (Ptr (Struct (Repr p))) -> CodeGenFunction r (global, state)
forall r.
Value (Ptr (Struct (Repr p))) -> CodeGenFunction r (global, state)
start Value (Ptr (Struct (Repr p))) -> global -> CodeGenFunction r ()
forall r.
Value (Ptr (Struct (Repr p))) -> global -> CodeGenFunction r ()
stop
(IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (IO () -> ChunkSize -> p -> IO (Vector a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (IO () -> ChunkSize -> p -> IO (Vector a)))
-> (IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (IO () -> ChunkSize -> p -> IO (Vector a))
forall a b. (a -> b) -> a -> b
$ \IO ()
final (SVL.ChunkSize Int
size) p
p -> do
MemoryPtr (Triple (Struct (Repr p)) (Struct global) (Struct state))
statePtr <- Finalizer (Triple (Struct (Repr p)) (Struct global) (Struct state))
-> (Ptr (Struct (Repr p))
-> IO
(Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state))))
-> p
-> IO
(MemoryPtr
(Triple (Struct (Repr p)) (Struct global) (Struct state)))
forall b a.
C b =>
Finalizer a
-> (Ptr (Struct b) -> IO (Ptr a)) -> b -> IO (MemoryPtr a)
ForeignPtr.newParamMV Finalizer (Triple (Struct (Repr p)) (Struct global) (Struct state))
stopFunc Ptr (Struct (Repr p))
-> IO
(Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state)))
startFunc p
p
let go :: IO [Vector a]
go =
IO [Vector a] -> IO [Vector a]
forall a. IO a -> IO a
Unsafe.interleaveIO (IO [Vector a] -> IO [Vector a]) -> IO [Vector a] -> IO [Vector a]
forall a b. (a -> b) -> a -> b
$ do
Vector a
v <-
MemoryPtr (Triple (Struct (Repr p)) (Struct global) (Struct state))
-> (Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state))
-> IO (Vector a))
-> IO (Vector a)
forall struct a. MemoryPtr struct -> (Ptr struct -> IO a) -> IO a
ForeignPtr.with MemoryPtr (Triple (Struct (Repr p)) (Struct global) (Struct state))
statePtr ((Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state))
-> IO (Vector a))
-> IO (Vector a))
-> (Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state))
-> IO (Vector a))
-> IO (Vector a)
forall a b. (a -> b) -> a -> b
$ \Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state))
sptr ->
Int -> (Ptr a -> IO Int) -> IO (Vector a)
forall a. Storable a => Int -> (Ptr a -> IO Int) -> IO (Vector a)
SVB.createAndTrim Int
size ((Ptr a -> IO Int) -> IO (Vector a))
-> (Ptr a -> IO Int) -> IO (Vector a)
forall a b. (a -> b) -> a -> b
$
(Word -> Int) -> IO Word -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word -> Int) (IO Word -> IO Int) -> (Ptr a -> IO Word) -> Ptr a -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state))
-> Word -> Ptr a -> IO Word
fill Ptr (Triple (Struct (Repr p)) (Struct global) (Struct state))
sptr (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
(if Vector a -> Int
forall a. Vector a -> Int
SV.length Vector a
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then ([Vector a] -> [Vector a]) -> IO [Vector a] -> IO [Vector a]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector a
vVector a -> [Vector a] -> [Vector a]
forall a. a -> [a] -> [a]
:)
else IO [Vector a] -> IO [Vector a]
forall a. a -> a
id) (IO [Vector a] -> IO [Vector a]) -> IO [Vector a] -> IO [Vector a]
forall a b. (a -> b) -> a -> b
$
(if Vector a -> Int
forall a. Vector a -> Int
SV.length Vector a
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size
then IO ()
final IO () -> IO [Vector a] -> IO [Vector a]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Vector a] -> IO [Vector a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else IO [Vector a]
go)
([Vector a] -> Vector a) -> IO [Vector a] -> IO (Vector a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Vector a] -> Vector a
forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks IO [Vector a]
go
runChunky ::
(Storable.C a, MultiValue.T a ~ value, Marshal.C p) =>
(Exp p -> T value) -> IO (SVL.ChunkSize -> p -> IO (SVL.Vector a))
runChunky :: forall a value p.
(C a, T a ~ value, C p) =>
(Exp p -> T value) -> IO (ChunkSize -> p -> IO (Vector a))
runChunky = ((IO () -> ChunkSize -> p -> IO (Vector a))
-> ChunkSize -> p -> IO (Vector a))
-> IO (IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (ChunkSize -> p -> IO (Vector a))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IO () -> ChunkSize -> p -> IO (Vector a))
-> IO () -> ChunkSize -> p -> IO (Vector a)
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO (IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (ChunkSize -> p -> IO (Vector a)))
-> ((Exp p -> T value)
-> IO (IO () -> ChunkSize -> p -> IO (Vector a)))
-> (Exp p -> T value)
-> IO (ChunkSize -> p -> IO (Vector a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp p -> T value) -> IO (IO () -> ChunkSize -> p -> IO (Vector a))
forall a value p.
(C a, T a ~ value, C p) =>
(Exp p -> T value) -> IO (IO () -> ChunkSize -> p -> IO (Vector a))
runChunkyAux
runChunkyOnVector ::
(Storable.C a, MultiValue.T a ~ al) =>
(Storable.C b, MultiValue.T b ~ bl) =>
(T al -> T bl) ->
IO (SVL.ChunkSize -> SV.Vector a -> IO (SVL.Vector b))
runChunkyOnVector :: forall a al b bl.
(C a, T a ~ al, C b, T b ~ bl) =>
(T al -> T bl) -> IO (ChunkSize -> Vector a -> IO (Vector b))
runChunkyOnVector T al -> T bl
sig = do
IO () -> ChunkSize -> StorableVector a -> IO (Vector b)
f <- (Exp (StorableVector a) -> T bl)
-> IO (IO () -> ChunkSize -> StorableVector a -> IO (Vector b))
forall a value p.
(C a, T a ~ value, C p) =>
(Exp p -> T value) -> IO (IO () -> ChunkSize -> p -> IO (Vector a))
runChunkyAux (T al -> T bl
sig (T al -> T bl)
-> (Exp (StorableVector a) -> T al)
-> Exp (StorableVector a)
-> T bl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (StorableVector a) -> T al
Exp (StorableVector a) -> T a
forall a. C a => Exp (StorableVector a) -> T a
Source.storableVector)
(ChunkSize -> Vector a -> IO (Vector b))
-> IO (ChunkSize -> Vector a -> IO (Vector b))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ChunkSize -> Vector a -> IO (Vector b))
-> IO (ChunkSize -> Vector a -> IO (Vector b)))
-> (ChunkSize -> Vector a -> IO (Vector b))
-> IO (ChunkSize -> Vector a -> IO (Vector b))
forall a b. (a -> b) -> a -> b
$ \ChunkSize
chunkSize Vector a
av -> do
let (ForeignPtr a
fp,Ptr a
ptr,Int
l) = Vector a -> (ForeignPtr a, Ptr a, Int)
forall a. Storable a => Vector a -> (ForeignPtr a, Ptr a, Int)
SVU.unsafeToPointers Vector a
av
IO () -> ChunkSize -> StorableVector a -> IO (Vector b)
f (ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
fp) ChunkSize
chunkSize (Ptr a -> Int -> StorableVector a
forall a. Ptr a -> Int -> StorableVector a
Source.consStorableVector Ptr a
ptr Int
l)
class Run f where
type DSL f
type Shape f
build ::
(Marshal.C p) =>
(Exp p -> DSL f) -> IO (IO (p, IO ()) -> Shape f -> f)
instance (Storable.C a) => Run (SVL.Vector a) where
type DSL (SVL.Vector a) = T (MultiValue.T a)
type Shape (SVL.Vector a) = SVL.ChunkSize
build :: forall p.
C p =>
(Exp p -> DSL (Vector a))
-> IO (IO (p, IO ()) -> Shape (Vector a) -> Vector a)
build =
((IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (p, IO ()) -> ChunkSize -> Vector a)
-> IO (IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (IO (p, IO ()) -> ChunkSize -> Vector a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IO () -> ChunkSize -> p -> IO (Vector a)
f IO (p, IO ())
create ChunkSize
shape -> IO (Vector a) -> Vector a
forall a. IO a -> a
Unsafe.performIO (IO (Vector a) -> Vector a) -> IO (Vector a) -> Vector a
forall a b. (a -> b) -> a -> b
$ (IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (p, IO ()) -> ChunkSize -> IO (Vector a)
forall (m :: * -> *) final shape p a.
Monad m =>
(final -> shape -> p -> m a) -> m (p, final) -> shape -> m a
buildIOGen IO () -> ChunkSize -> p -> IO (Vector a)
f IO (p, IO ())
create ChunkSize
shape) (IO (IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (IO (p, IO ()) -> ChunkSize -> Vector a))
-> ((Exp p -> T (T a))
-> IO (IO () -> ChunkSize -> p -> IO (Vector a)))
-> (Exp p -> T (T a))
-> IO (IO (p, IO ()) -> ChunkSize -> Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Exp p -> T (T a)) -> IO (IO () -> ChunkSize -> p -> IO (Vector a))
forall a value p.
(C a, T a ~ value, C p) =>
(Exp p -> T value) -> IO (IO () -> ChunkSize -> p -> IO (Vector a))
runChunkyAux
instance (Storable.C a) => Run (SV.Vector a) where
type DSL (SV.Vector a) = T (MultiValue.T a)
type Shape (SV.Vector a) = Int
build :: forall p.
C p =>
(Exp p -> DSL (Vector a))
-> IO (IO (p, IO ()) -> Shape (Vector a) -> Vector a)
build =
((IO () -> Int -> p -> IO (Vector a))
-> IO (p, IO ()) -> Int -> Vector a)
-> IO (IO () -> Int -> p -> IO (Vector a))
-> IO (IO (p, IO ()) -> Int -> Vector a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IO () -> Int -> p -> IO (Vector a)
f IO (p, IO ())
create Int
shape -> IO (Vector a) -> Vector a
forall a. IO a -> a
Unsafe.performIO (IO (Vector a) -> Vector a) -> IO (Vector a) -> Vector a
forall a b. (a -> b) -> a -> b
$ (IO () -> Int -> p -> IO (Vector a))
-> IO (p, IO ()) -> Int -> IO (Vector a)
forall (m :: * -> *) final shape p a.
Monad m =>
(final -> shape -> p -> m a) -> m (p, final) -> shape -> m a
buildIOGen IO () -> Int -> p -> IO (Vector a)
f IO (p, IO ())
create Int
shape) (IO (IO () -> Int -> p -> IO (Vector a))
-> IO (IO (p, IO ()) -> Int -> Vector a))
-> ((Exp p -> T (T a)) -> IO (IO () -> Int -> p -> IO (Vector a)))
-> (Exp p -> T (T a))
-> IO (IO (p, IO ()) -> Int -> Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Exp p -> T (T a)) -> IO (IO () -> Int -> p -> IO (Vector a))
forall p a value.
(C p, C a, T a ~ value) =>
(Exp p -> T value) -> IO (IO () -> Int -> p -> IO (Vector a))
runAux
instance (RunIO a) => Run (IO a) where
type DSL (IO a) = T (DSL_IO a)
type Shape (IO a) = ShapeIO a
build :: forall p.
C p =>
(Exp p -> DSL (IO a)) -> IO (IO (p, IO ()) -> Shape (IO a) -> IO a)
build = (Exp p -> T (DSL_IO a)) -> IO (IO (p, IO ()) -> ShapeIO a -> IO a)
(Exp p -> DSL (IO a)) -> IO (IO (p, IO ()) -> Shape (IO a) -> IO a)
forall p.
C p =>
(Exp p -> T (DSL_IO a)) -> IO (IO (p, IO ()) -> ShapeIO a -> IO a)
forall a p.
(RunIO a, C p) =>
(Exp p -> T (DSL_IO a)) -> IO (IO (p, IO ()) -> ShapeIO a -> IO a)
buildIO
instance (RunArg a, Run f) => Run (a -> f) where
type DSL (a -> f) = DSLArg a -> DSL f
type Shape (a -> f) = Shape f
build :: forall p.
C p =>
(Exp p -> DSL (a -> f))
-> IO (IO (p, IO ()) -> Shape (a -> f) -> a -> f)
build Exp p -> DSL (a -> f)
sig =
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 ()) -> Shape f -> f
f <- (Exp (p, al) -> DSL f) -> IO (IO ((p, al), IO ()) -> Shape f -> f)
forall p.
C p =>
(Exp p -> DSL f) -> IO (IO (p, IO ()) -> Shape f -> f)
forall f p.
(Run f, C p) =>
(Exp p -> DSL f) -> IO (IO (p, IO ()) -> Shape f -> f)
build ((Exp p -> Exp al -> DSL f) -> Exp (p, al) -> DSL f
forall a b c. (Exp a -> Exp b -> c) -> Exp (a, b) -> c
Expr.uncurry ((Exp p -> Exp al -> DSL f) -> Exp (p, al) -> DSL f)
-> (Exp p -> Exp al -> DSL f) -> Exp (p, al) -> DSL f
forall a b. (a -> b) -> a -> b
$ \Exp p
p -> Exp p -> DSL (a -> f)
sig Exp p
p (DSLArg a -> DSL f) -> (Exp al -> DSLArg a) -> Exp al -> DSL f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp al -> DSLArg a
pass)
(IO (p, IO ()) -> Shape f -> a -> f)
-> IO (IO (p, IO ()) -> Shape f -> a -> f)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO (p, IO ()) -> Shape f -> a -> f)
-> IO (IO (p, IO ()) -> Shape f -> a -> f))
-> (IO (p, IO ()) -> Shape f -> a -> f)
-> IO (IO (p, IO ()) -> Shape f -> a -> f)
forall a b. (a -> b) -> a -> b
$ \IO (p, IO ())
createP Shape f
shape a
av ->
IO ((p, al), IO ()) -> Shape f -> 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))
Shape f
shape
class RunIO a where
type DSL_IO a
type ShapeIO a
buildIO ::
(Marshal.C p) =>
(Exp p -> T (DSL_IO a)) -> IO (IO (p, IO ()) -> ShapeIO a -> IO a)
instance (Storable.C a) => RunIO (SVL.Vector a) where
type DSL_IO (SVL.Vector a) = MultiValue.T a
type ShapeIO (SVL.Vector a) = SVL.ChunkSize
buildIO :: forall p.
C p =>
(Exp p -> T (DSL_IO (Vector a)))
-> IO (IO (p, IO ()) -> ShapeIO (Vector a) -> IO (Vector a))
buildIO = ((IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (p, IO ()) -> ChunkSize -> IO (Vector a))
-> IO (IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (IO (p, IO ()) -> ChunkSize -> IO (Vector a))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (p, IO ()) -> ChunkSize -> IO (Vector a)
forall (m :: * -> *) final shape p a.
Monad m =>
(final -> shape -> p -> m a) -> m (p, final) -> shape -> m a
buildIOGen (IO (IO () -> ChunkSize -> p -> IO (Vector a))
-> IO (IO (p, IO ()) -> ChunkSize -> IO (Vector a)))
-> ((Exp p -> T (T a))
-> IO (IO () -> ChunkSize -> p -> IO (Vector a)))
-> (Exp p -> T (T a))
-> IO (IO (p, IO ()) -> ChunkSize -> IO (Vector a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp p -> T (T a)) -> IO (IO () -> ChunkSize -> p -> IO (Vector a))
forall a value p.
(C a, T a ~ value, C p) =>
(Exp p -> T value) -> IO (IO () -> ChunkSize -> p -> IO (Vector a))
runChunkyAux
instance (Storable.C a) => RunIO (SV.Vector a) where
type DSL_IO (SV.Vector a) = MultiValue.T a
type ShapeIO (SV.Vector a) = Int
buildIO :: forall p.
C p =>
(Exp p -> T (DSL_IO (Vector a)))
-> IO (IO (p, IO ()) -> ShapeIO (Vector a) -> IO (Vector a))
buildIO = ((IO () -> Int -> p -> IO (Vector a))
-> IO (p, IO ()) -> Int -> IO (Vector a))
-> IO (IO () -> Int -> p -> IO (Vector a))
-> IO (IO (p, IO ()) -> Int -> IO (Vector a))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IO () -> Int -> p -> IO (Vector a))
-> IO (p, IO ()) -> Int -> IO (Vector a)
forall (m :: * -> *) final shape p a.
Monad m =>
(final -> shape -> p -> m a) -> m (p, final) -> shape -> m a
buildIOGen (IO (IO () -> Int -> p -> IO (Vector a))
-> IO (IO (p, IO ()) -> Int -> IO (Vector a)))
-> ((Exp p -> T (T a)) -> IO (IO () -> Int -> p -> IO (Vector a)))
-> (Exp p -> T (T a))
-> IO (IO (p, IO ()) -> Int -> IO (Vector a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp p -> T (T a)) -> IO (IO () -> Int -> p -> IO (Vector a))
forall p a value.
(C p, C a, T a ~ value) =>
(Exp p -> T value) -> IO (IO () -> Int -> p -> IO (Vector a))
runAux
buildIOGen ::
(Monad m) => (final -> shape -> p -> m a) -> m (p, final) -> shape -> m a
buildIOGen :: forall (m :: * -> *) final shape p a.
Monad m =>
(final -> shape -> p -> m a) -> m (p, final) -> shape -> m a
buildIOGen final -> shape -> p -> m a
f m (p, final)
create shape
shape = do (p
p,final
final) <- m (p, final)
create; final -> shape -> p -> m a
f final
final shape
shape p
p
data BuildArg a =
forall al. Marshal.C al =>
BuildArg (Exp al -> DSLArg a) (a -> IO (al, IO ()))
class RunArg a where
type DSLArg a
buildArg :: BuildArg a
instance RunArg () where
type DSLArg () = ()
buildArg :: BuildArg ()
buildArg = (Exp () -> DSLArg ()) -> (() -> IO ((), IO ())) -> BuildArg ()
forall a al.
C al =>
(Exp al -> DSLArg a) -> (a -> IO (al, IO ())) -> BuildArg a
BuildArg (\ Exp ()
_unit -> ()) (\() -> ((), 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 ()))
instance (RunArg a, RunArg b) => RunArg (a,b) where
type DSLArg (a,b) = (DSLArg a, DSLArg b)
buildArg :: BuildArg (a, b)
buildArg =
case (BuildArg a
forall a. RunArg a => BuildArg a
buildArg,BuildArg b
forall a. RunArg a => BuildArg a
buildArg) of
(BuildArg Exp al -> DSLArg a
passA a -> IO (al, IO ())
createA, BuildArg Exp al -> DSLArg b
passB b -> IO (al, IO ())
createB) ->
(Exp (al, al) -> DSLArg (a, b))
-> ((a, b) -> IO ((al, al), IO ())) -> BuildArg (a, b)
forall a al.
C al =>
(Exp al -> DSLArg a) -> (a -> IO (al, IO ())) -> BuildArg a
BuildArg
((Exp al -> DSLArg a, Exp al -> DSLArg b)
-> (Exp al, Exp al) -> (DSLArg a, DSLArg b)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (Exp al -> DSLArg a
passA,Exp al -> DSLArg b
passB) ((Exp al, Exp al) -> (DSLArg a, DSLArg b))
-> (Exp (al, al) -> (Exp al, Exp al))
-> Exp (al, al)
-> (DSLArg a, DSLArg b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (al, al) -> (Exp al, Exp al)
forall (val :: * -> *) a b.
Value val =>
val (a, b) -> (val a, val b)
Expr.unzip)
(\(a
a,b
b) -> do
(al
pa,IO ()
finalA) <- a -> IO (al, IO ())
createA a
a
(al
pb,IO ()
finalB) <- b -> IO (al, IO ())
createB b
b
((al, al), IO ()) -> IO ((al, al), IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((al
pa,al
pb), IO ()
finalBIO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>IO ()
finalA))
instance (RunArg a, RunArg b, RunArg c) => RunArg (a,b,c) where
type DSLArg (a,b,c) = (DSLArg a, DSLArg b, DSLArg c)
buildArg :: BuildArg (a, b, c)
buildArg =
case (BuildArg a
forall a. RunArg a => BuildArg a
buildArg,BuildArg b
forall a. RunArg a => BuildArg a
buildArg,BuildArg c
forall a. RunArg a => BuildArg a
buildArg) of
(BuildArg Exp al -> DSLArg a
passA a -> IO (al, IO ())
createA, BuildArg Exp al -> DSLArg b
passB b -> IO (al, IO ())
createB,
BuildArg Exp al -> DSLArg c
passC c -> IO (al, IO ())
createC) ->
(Exp (al, al, al) -> DSLArg (a, b, c))
-> ((a, b, c) -> IO ((al, al, al), IO ())) -> BuildArg (a, b, c)
forall a al.
C al =>
(Exp al -> DSLArg a) -> (a -> IO (al, IO ())) -> BuildArg a
BuildArg
((Exp al -> DSLArg a, Exp al -> DSLArg b, Exp al -> DSLArg c)
-> (Exp al, Exp al, Exp al) -> (DSLArg a, DSLArg b, DSLArg c)
forall a d b e c f.
(a -> d, b -> e, c -> f) -> (a, b, c) -> (d, e, f)
mapTriple (Exp al -> DSLArg a
passA,Exp al -> DSLArg b
passB,Exp al -> DSLArg c
passC) ((Exp al, Exp al, Exp al) -> (DSLArg a, DSLArg b, DSLArg c))
-> (Exp (al, al, al) -> (Exp al, Exp al, Exp al))
-> Exp (al, al, al)
-> (DSLArg a, DSLArg b, DSLArg c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (al, al, al) -> (Exp al, Exp al, Exp al)
forall (val :: * -> *) a b c.
Value val =>
val (a, b, c) -> (val a, val b, val c)
Expr.unzip3)
(\(a
a,b
b,c
c) -> do
(al
pa,IO ()
finalA) <- a -> IO (al, IO ())
createA a
a
(al
pb,IO ()
finalB) <- b -> IO (al, IO ())
createB b
b
(al
pc,IO ()
finalC) <- c -> IO (al, IO ())
createC c
c
((al, al, al), IO ()) -> IO ((al, al, al), IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((al
pa,al
pb,al
pc), IO ()
finalCIO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>IO ()
finalBIO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>IO ()
finalA))
primitiveArg :: (Marshal.C a, DSLArg a ~ Exp a) => BuildArg a
primitiveArg :: forall a. (C a, DSLArg a ~ Exp a) => BuildArg a
primitiveArg = (Exp a -> DSLArg a) -> (a -> IO (a, IO ())) -> BuildArg a
forall a al.
C al =>
(Exp al -> DSLArg a) -> (a -> IO (al, IO ())) -> BuildArg a
BuildArg Exp a -> Exp a
Exp a -> DSLArg a
forall a. a -> a
id (\a
a -> (a, IO ()) -> IO (a, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
instance RunArg Float where
type DSLArg Float = Exp Float
buildArg :: BuildArg Float
buildArg = BuildArg Float
forall a. (C a, DSLArg a ~ Exp a) => BuildArg a
primitiveArg
instance RunArg Int where
type DSLArg Int = Exp Int
buildArg :: BuildArg Int
buildArg = BuildArg Int
forall a. (C a, DSLArg a ~ Exp a) => BuildArg a
primitiveArg
instance RunArg Word where
type DSLArg Word = Exp Word
buildArg :: BuildArg Word
buildArg = BuildArg Word
forall a. (C a, DSLArg a ~ Exp a) => BuildArg a
primitiveArg
instance RunArg Word32 where
type DSLArg Word32 = Exp Word32
buildArg :: BuildArg Word32
buildArg = BuildArg Word32
forall a. (C a, DSLArg a ~ Exp a) => BuildArg a
primitiveArg
instance (RunArg a) => RunArg (Stereo.T a) where
type DSLArg (Stereo.T a) = Stereo.T (DSLArg a)
buildArg :: BuildArg (T a)
buildArg =
case BuildArg a
forall a. RunArg a => BuildArg a
buildArg of
BuildArg Exp al -> DSLArg a
pass a -> IO (al, IO ())
create ->
(Exp (T al) -> DSLArg (T a))
-> (T a -> IO (T al, IO ())) -> BuildArg (T a)
forall a al.
C al =>
(Exp al -> DSLArg a) -> (a -> IO (al, IO ())) -> BuildArg a
BuildArg
((Exp al -> DSLArg a) -> T (Exp al) -> T (DSLArg a)
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp al -> DSLArg a
pass (T (Exp al) -> T (DSLArg a))
-> (Exp (T al) -> T (Exp al)) -> Exp (T al) -> T (DSLArg a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (T al) -> T (Exp al)
forall a. Exp (T a) -> T (Exp a)
Stereo.unExpression)
(\T a
s -> do
T (al, IO ())
pf <- (a -> IO (al, IO ())) -> T a -> IO (T (al, IO ()))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> T a -> f (T b)
traverse a -> IO (al, IO ())
create T a
s
(T al, IO ()) -> IO (T al, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((al, IO ()) -> al
forall a b. (a, b) -> a
fst((al, IO ()) -> al) -> T (al, IO ()) -> T al
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>T (al, IO ())
pf, ((al, IO ()) -> IO ()) -> T (al, IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (al, IO ()) -> IO ()
forall a b. (a, b) -> b
snd T (al, IO ())
pf))
instance
(TypeNum.Natural n, Marshal.C a, LLVM.IsSized (Marshal.Struct a),
TypeNum.Natural (n TypeNum.:*: LLVM.SizeOf (Marshal.Struct a))) =>
RunArg (MultiValue.Array n a) where
type DSLArg (MultiValue.Array n a) = Exp (MultiValue.Array n a)
buildArg :: BuildArg (Array n a)
buildArg = BuildArg (Array n a)
forall a. (C a, DSLArg a ~ Exp a) => BuildArg a
primitiveArg
instance (Storable.C a) => RunArg (SV.Vector a) where
type DSLArg (SV.Vector a) = T (MultiValue.T a)
buildArg :: BuildArg (Vector a)
buildArg =
(Exp (StorableVector a) -> DSLArg (Vector a))
-> (Vector a -> IO (StorableVector a, IO ()))
-> BuildArg (Vector a)
forall a al.
C al =>
(Exp al -> DSLArg a) -> (a -> IO (al, IO ())) -> BuildArg a
BuildArg
Exp (StorableVector a) -> T a
Exp (StorableVector a) -> DSLArg (Vector a)
forall a. C a => Exp (StorableVector a) -> T a
Source.storableVector
(\Vector a
av -> do
let (ForeignPtr a
fp,Ptr a
ptr,Int
l) = Vector a -> (ForeignPtr a, Ptr a, Int)
forall a. Storable a => Vector a -> (ForeignPtr a, Ptr a, Int)
SVU.unsafeToPointers Vector a
av
(StorableVector a, IO ()) -> IO (StorableVector a, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr a -> Int -> StorableVector a
forall a. Ptr a -> Int -> StorableVector a
Source.consStorableVector Ptr a
ptr Int
l, ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
fp))
newtype Buffer a = Buffer (SV.Vector a)
buffer :: SV.Vector a -> Buffer a
buffer :: forall a. Vector a -> Buffer a
buffer = Vector a -> Buffer a
forall a. Vector a -> Buffer a
Buffer
instance (Storable.C a) => RunArg (Buffer a) where
type DSLArg (Buffer a) = Exp (Source.StorableVector a)
buildArg :: BuildArg (Buffer a)
buildArg =
(Exp (StorableVector a) -> DSLArg (Buffer a))
-> (Buffer a -> IO (StorableVector a, IO ()))
-> BuildArg (Buffer a)
forall a al.
C al =>
(Exp al -> DSLArg a) -> (a -> IO (al, IO ())) -> BuildArg a
BuildArg Exp (StorableVector a) -> Exp (StorableVector a)
Exp (StorableVector a) -> DSLArg (Buffer a)
forall a. a -> a
id
(\(Buffer Vector a
av) -> do
let (ForeignPtr a
fp,Ptr a
ptr,Int
l) = Vector a -> (ForeignPtr a, Ptr a, Int)
forall a. Storable a => Vector a -> (ForeignPtr a, Ptr a, Int)
SVU.unsafeToPointers Vector a
av
(StorableVector a, IO ()) -> IO (StorableVector a, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr a -> Int -> StorableVector a
forall a. Ptr a -> Int -> StorableVector a
Source.consStorableVector Ptr a
ptr Int
l, ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
fp))
newDisposeArg ::
(Marshal.C handle) =>
(a -> IO handle) -> (handle -> IO ()) ->
(Exp handle -> DSLArg a) -> BuildArg a
newDisposeArg :: forall handle a.
C handle =>
(a -> IO handle)
-> (handle -> IO ()) -> (Exp handle -> DSLArg a) -> BuildArg a
newDisposeArg a -> IO handle
new handle -> IO ()
dispose Exp handle -> DSLArg a
fetch =
(Exp handle -> DSLArg a) -> (a -> IO (handle, IO ())) -> BuildArg a
forall a al.
C al =>
(Exp al -> DSLArg a) -> (a -> IO (al, IO ())) -> BuildArg a
BuildArg Exp handle -> DSLArg a
fetch
(\a
x -> do
handle
it <- a -> IO handle
new a
x
(handle, IO ()) -> IO (handle, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (handle
it, handle -> IO ()
dispose handle
it))
instance (Storable.C a) => RunArg (SVL.Vector a) where
type DSLArg (SVL.Vector a) = T (MultiValue.T a)
buildArg :: BuildArg (Vector a)
buildArg =
(Vector a -> IO (StablePtr (T a)))
-> (StablePtr (T a) -> IO ())
-> (Exp (StablePtr (T a)) -> DSLArg (Vector a))
-> BuildArg (Vector a)
forall handle a.
C handle =>
(a -> IO handle)
-> (handle -> IO ()) -> (Exp handle -> DSLArg a) -> BuildArg a
newDisposeArg Vector a -> IO (StablePtr (T a))
forall a. Storable a => Vector a -> IO (StablePtr (T a))
ChunkIt.new StablePtr (T a) -> IO ()
forall a. StablePtr (T a) -> IO ()
ChunkIt.dispose Exp (StablePtr (T a)) -> T a
Exp (StablePtr (T a)) -> DSLArg (Vector a)
forall a. C a => Exp (StablePtr (T a)) -> T a
Source.storableVectorLazy
class TimeInteger int where
subdivideLong :: EventList.T (NonNeg.T int) a -> EventList.T NonNeg.Int a
instance TimeInteger Int where
subdivideLong :: forall a. T (T Int) a -> T (T Int) a
subdivideLong = T (T Int) a -> T (T Int) a
forall a. a -> a
id
instance TimeInteger Integer where
subdivideLong :: forall a. T (T Integer) a -> T (T Int) a
subdivideLong = T (T Integer) a -> T (T Int) a
forall a. T (T Integer) a -> T (T Int) a
PC.subdivideLongStrict
instance
(time ~ NonNeg.T int, TimeInteger int, Marshal.C a) =>
RunArg (EventList.T time a) where
type DSLArg (EventList.T time a) = T (Const.T (MultiValue.T a))
buildArg :: BuildArg (T time a)
buildArg =
(T time a -> IO (StablePtr (T a)))
-> (StablePtr (T a) -> IO ())
-> (Exp (StablePtr (T a)) -> DSLArg (T time a))
-> BuildArg (T time a)
forall handle a.
C handle =>
(a -> IO handle)
-> (handle -> IO ()) -> (Exp handle -> DSLArg a) -> BuildArg a
newDisposeArg
(T (T Int) a -> IO (StablePtr (T a))
forall a. C a => T (T Int) a -> IO (StablePtr (T a))
EventIt.new (T (T Int) a -> IO (StablePtr (T a)))
-> (T time a -> T (T Int) a) -> T time a -> IO (StablePtr (T a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time a -> T (T Int) a
T (T int) a -> T (T Int) a
forall a. T (T int) a -> T (T Int) a
forall int a. TimeInteger int => T (T int) a -> T (T Int) a
subdivideLong) StablePtr (T a) -> IO ()
forall a. StablePtr (T a) -> IO ()
EventIt.dispose Exp (StablePtr (T a)) -> T (T (T a))
Exp (StablePtr (T a)) -> DSLArg (T time a)
forall a. C a => Exp (StablePtr (T a)) -> T (T (T a))
Source.eventList
instance (a ~ SVL.ChunkSize) => RunArg (NonNegChunky.T a) where
type DSLArg (NonNegChunky.T a) = T (Const.T ())
buildArg :: BuildArg (T a)
buildArg =
(T a -> IO (StablePtr T))
-> (StablePtr T -> IO ())
-> (Exp (StablePtr T) -> DSLArg (T a))
-> BuildArg (T a)
forall handle a.
C handle =>
(a -> IO handle)
-> (handle -> IO ()) -> (Exp handle -> DSLArg a) -> BuildArg a
newDisposeArg T a -> IO (StablePtr T)
LazySize -> IO (StablePtr T)
SizeIt.new StablePtr T -> IO ()
SizeIt.dispose Exp (StablePtr T) -> T (T ())
Exp (StablePtr T) -> DSLArg (T a)
Source.lazySize
run :: (Run f) => DSL f -> IO (Shape f -> f)
run :: forall f. Run f => DSL f -> IO (Shape f -> f)
run DSL f
sig = do
IO ((), IO ()) -> Shape f -> f
act <- (Exp () -> DSL f) -> IO (IO ((), IO ()) -> Shape f -> f)
forall p.
C p =>
(Exp p -> DSL f) -> IO (IO (p, IO ()) -> Shape f -> f)
forall f p.
(Run f, C p) =>
(Exp p -> DSL f) -> IO (IO (p, IO ()) -> Shape f -> f)
build (DSL f -> Exp () -> DSL f
forall a b. a -> b -> a
const DSL f
sig)
(Shape f -> f) -> IO (Shape f -> f)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Shape f -> f) -> IO (Shape f -> f))
-> (Shape f -> f) -> IO (Shape f -> f)
forall a b. (a -> b) -> a -> b
$ IO ((), IO ()) -> Shape f -> 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 ()))