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

{- |
This is a pretty ugly hack, but its seems to be the least ugly one.
We need to solve the following problem:
We have a function of type @Exp param -> T value@.
This means that all methods in @T value@ depend on @Exp param@.
We need to choose one piece of LLVM code in @Exp param@
that generates appropriate code for all methods in @T value@.
If we access a function parameter via @Memory.load paramPtr@
this means that all methods must end up in the same LLVM function
in order to access this parameter.
Thus I have to put all functionality in one LLVM function
and then the three functions in 'compileChunky'
jump into the handler function with a 'Word8' code
specifying the actual sub-routine.
We need to squeeze all possible inputs and outputs
through one function interface.

However, since the handler is marked as internal
the optimizer inlines it in the three functions from 'compileChunky'
and eliminates dead code.
This way, we end up with the code that we would have written otherwise.

The alternative would be to construct @T value@ multiple times.
Due to existential quantification we cannot prove
that the pointer types of different methods match,
so we need to cast pointers.
However, with the current approach we also have to do that.
-}
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

{-
do f <- run (\n -> takeWhile (<*n) (iterate (1+) 0) <> takeWhile (<*n) (iterate (2+) 0)); f SVL.defaultChunkSize (12::Float) :: IO (SVL.Vector Float)
do f <- Sig.run (\n -> Sig.takeWhile (Expr.<*n) (Sig.iterate (1+) 0) <> Sig.takeWhile (Expr.<*n) (Sig.iterate (2+) 0)); f SVL.defaultChunkSize (12::Float) :: IO (SVL.Vector Float)
-}
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 ()))