{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Plug.Input (
   T(..),
   Default(..),
   rmap,
   split,
   fanout,
   lazySize,
   ignore,
   storableVector,
   piecewiseConstant,
   controllerSet,
   ) where

import qualified Synthesizer.Zip as Zip

import qualified Synthesizer.LLVM.ConstantPiece as Const

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.Arithmetic as A
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.Control as C

import qualified LLVM.ExecutionEngine as EE
import qualified LLVM.Core as LLVM

import qualified Type.Data.Num.Decimal as TypeNum
import Type.Data.Num.Decimal ((:*:))
import Type.Base.Proxy (Proxy)

import qualified Synthesizer.MIDI.PiecewiseConstant.ControllerSet as PCS
import qualified Synthesizer.Generic.Signal as SigG
import qualified Data.EventList.Relative.BodyTime as EventListBT
import qualified Data.EventList.Relative.MixedTime as EventListMT
import qualified Data.EventList.Relative.TimeTime as EventListTT

import qualified Numeric.NonNegative.Wrapper as NonNegW

import qualified Synthesizer.LLVM.Storable.Vector as SVU
import qualified Data.StorableVector as SV

import qualified Foreign.Marshal.Array as Array
import qualified Foreign.Marshal.Alloc as Alloc
import qualified Foreign.ForeignPtr as FPtr
import Foreign.Storable (pokeElemOff)

import qualified Control.Functor.HT as FuncHT
import Control.Applicative (liftA2, (<$>))

import qualified Data.Map as Map
import qualified Data.List as List
import Data.Tuple.Strict (mapFst, zipPair)
import Data.Word (Word)

import Prelude hiding (map)


{-
This datatype does not provide an early exit option, e.g. by Maybe.T,
since we warrant that the driver function will always
read only as much data as is available.
To this end you must provide a @length@ function
via an instance of 'Synthesizer.Generic.Cut.Read'.
-}
data T a b =
   forall state ioContext parameters.
      (Marshal.C parameters, Memory.C state) =>
   Cons
      (forall r.
       MultiValue.T parameters ->
       state -> LLVM.CodeGenFunction r (b, state))
         -- compute next value
      (forall r.
       MultiValue.T parameters ->
       LLVM.CodeGenFunction r state)
         -- initial state
      (a -> IO (ioContext, parameters))
         {- initialization from IO monad
         This is called once input chunk.
         This will be run within Unsafe.performIO,
         so no observable In/Out actions please!
         -}
      (ioContext -> IO ())
         {-
         finalization from IO monad, also run within Unsafe.performIO
         -}


instance Functor (T a) where
   fmap :: forall a b. (a -> b) -> T a a -> T a b
fmap a -> b
f (Cons forall r. T parameters -> state -> CodeGenFunction r (a, state)
next forall r. T parameters -> CodeGenFunction r state
start a -> IO (ioContext, parameters)
create ioContext -> IO ()
delete) =
      (forall r. T parameters -> state -> CodeGenFunction r (b, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (a -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T a b
forall a b state ioContext parameters.
(C parameters, C state) =>
(forall r. T parameters -> state -> CodeGenFunction r (b, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (a -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T a b
Cons (\T parameters
p state
s -> ((a, state) -> (b, state))
-> CodeGenFunction r (a, state) -> CodeGenFunction r (b, state)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, state) -> (b, state)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst a -> b
f) (CodeGenFunction r (a, state) -> CodeGenFunction r (b, state))
-> CodeGenFunction r (a, state) -> CodeGenFunction r (b, state)
forall a b. (a -> b) -> a -> b
$ T parameters -> state -> CodeGenFunction r (a, state)
forall r. T parameters -> state -> CodeGenFunction r (a, state)
next T parameters
p state
s) T parameters -> CodeGenFunction r state
forall r. T parameters -> CodeGenFunction r state
start a -> IO (ioContext, parameters)
create ioContext -> IO ()
delete

map :: (forall r. a -> LLVM.CodeGenFunction r b) -> T inp a -> T inp b
map :: forall a b inp.
(forall r. a -> CodeGenFunction r b) -> T inp a -> T inp b
map forall r. a -> CodeGenFunction r b
f (Cons forall r. T parameters -> state -> CodeGenFunction r (a, state)
next forall r. T parameters -> CodeGenFunction r state
start inp -> IO (ioContext, parameters)
create ioContext -> IO ()
delete) =
   (forall r. T parameters -> state -> CodeGenFunction r (b, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (inp -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T inp b
forall a b state ioContext parameters.
(C parameters, C state) =>
(forall r. T parameters -> state -> CodeGenFunction r (b, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (a -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T a b
Cons (\T parameters
p state
s -> (a -> CodeGenFunction r b)
-> (a, state) -> CodeGenFunction r (b, state)
forall (f :: * -> *) a c b.
Functor f =>
(a -> f c) -> (a, b) -> f (c, b)
FuncHT.mapFst a -> CodeGenFunction r b
forall r. a -> CodeGenFunction r b
f ((a, state) -> CodeGenFunction r (b, state))
-> CodeGenFunction r (a, state) -> CodeGenFunction r (b, state)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< T parameters -> state -> CodeGenFunction r (a, state)
forall r. T parameters -> state -> CodeGenFunction r (a, state)
next T parameters
p state
s) T parameters -> CodeGenFunction r state
forall r. T parameters -> CodeGenFunction r state
start inp -> IO (ioContext, parameters)
create ioContext -> IO ()
delete



class Default a where
   type Element a
   deflt :: T a (Element a)


rmap :: (a -> b) -> T b c -> T a c
rmap :: forall a b c. (a -> b) -> T b c -> T a c
rmap a -> b
f (Cons forall r. T parameters -> state -> CodeGenFunction r (c, state)
next forall r. T parameters -> CodeGenFunction r state
start b -> IO (ioContext, parameters)
create ioContext -> IO ()
delete) =
   (forall r. T parameters -> state -> CodeGenFunction r (c, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (a -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T a c
forall a b state ioContext parameters.
(C parameters, C state) =>
(forall r. T parameters -> state -> CodeGenFunction r (b, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (a -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T a b
Cons T parameters -> state -> CodeGenFunction r (c, state)
forall r. T parameters -> state -> CodeGenFunction r (c, state)
next T parameters -> CodeGenFunction r state
forall r. T parameters -> CodeGenFunction r state
start (b -> IO (ioContext, parameters)
create (b -> IO (ioContext, parameters))
-> (a -> b) -> a -> IO (ioContext, parameters)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ioContext -> IO ()
delete

fanout :: T a b -> T a c -> T a (b,c)
fanout :: forall a b c. T a b -> T a c -> T a (b, c)
fanout T a b
f T a c
g = (a -> T a a) -> T (T a a) (b, c) -> T a (b, c)
forall a b c. (a -> b) -> T b c -> T a c
rmap (\a
a -> a -> a -> T a a
forall a b. a -> b -> T a b
Zip.Cons a
a a
a) (T (T a a) (b, c) -> T a (b, c)) -> T (T a a) (b, c) -> T a (b, c)
forall a b. (a -> b) -> a -> b
$ T a b -> T a c -> T (T a a) (b, c)
forall a c b d. T a c -> T b d -> T (T a b) (c, d)
split T a b
f T a c
g


instance (Default a, Default b) => Default (Zip.T a b) where
   type Element (Zip.T a b) = (Element a, Element b)
   deflt :: T (T a b) (Element (T a b))
deflt = T a (Element a)
-> T b (Element b) -> T (T a b) (Element a, Element b)
forall a c b d. T a c -> T b d -> T (T a b) (c, d)
split T a (Element a)
forall a. Default a => T a (Element a)
deflt T b (Element b)
forall a. Default a => T a (Element a)
deflt

split :: T a c -> T b d -> T (Zip.T a b) (c,d)
split :: forall a c b d. T a c -> T b d -> T (T a b) (c, d)
split (Cons forall r. T parameters -> state -> CodeGenFunction r (c, state)
nextA forall r. T parameters -> CodeGenFunction r state
startA a -> IO (ioContext, parameters)
createA ioContext -> IO ()
deleteA)
      (Cons forall r. T parameters -> state -> CodeGenFunction r (d, state)
nextB forall r. T parameters -> CodeGenFunction r state
startB b -> IO (ioContext, parameters)
createB ioContext -> IO ()
deleteB) = (forall r.
 T (parameters, parameters)
 -> (state, state) -> CodeGenFunction r ((c, d), (state, state)))
-> (forall r.
    T (parameters, parameters) -> CodeGenFunction r (state, state))
-> (T a b -> IO ((ioContext, ioContext), (parameters, parameters)))
-> ((ioContext, ioContext) -> IO ())
-> T (T a b) (c, d)
forall a b state ioContext parameters.
(C parameters, C state) =>
(forall r. T parameters -> state -> CodeGenFunction r (b, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (a -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T a b
Cons
   ((T parameters
 -> T parameters
 -> (state, state)
 -> CodeGenFunction r ((c, d), (state, state)))
-> T (parameters, parameters)
-> (state, state)
-> CodeGenFunction r ((c, d), (state, state))
forall a b c. (T a -> T b -> c) -> T (a, b) -> c
MultiValue.uncurry ((T parameters
  -> T parameters
  -> (state, state)
  -> CodeGenFunction r ((c, d), (state, state)))
 -> T (parameters, parameters)
 -> (state, state)
 -> CodeGenFunction r ((c, d), (state, state)))
-> (T parameters
    -> T parameters
    -> (state, state)
    -> CodeGenFunction r ((c, d), (state, state)))
-> T (parameters, parameters)
-> (state, state)
-> CodeGenFunction r ((c, d), (state, state))
forall a b. (a -> b) -> a -> b
$ \T parameters
parameterA T parameters
parameterB (state
sa,state
sb) ->
      ((c, state) -> (d, state) -> ((c, d), (state, state)))
-> CodeGenFunction r (c, state)
-> CodeGenFunction r (d, state)
-> CodeGenFunction r ((c, d), (state, state))
forall a b c.
(a -> b -> c)
-> CodeGenFunction r a
-> CodeGenFunction r b
-> CodeGenFunction r c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (c, state) -> (d, state) -> ((c, d), (state, state))
forall a b c d. (a, b) -> (c, d) -> ((a, c), (b, d))
zipPair (T parameters -> state -> CodeGenFunction r (c, state)
forall r. T parameters -> state -> CodeGenFunction r (c, state)
nextA T parameters
parameterA state
sa) (T parameters -> state -> CodeGenFunction r (d, state)
forall r. T parameters -> state -> CodeGenFunction r (d, state)
nextB T parameters
parameterB state
sb))
   ((T parameters -> T parameters -> CodeGenFunction r (state, state))
-> T (parameters, parameters) -> CodeGenFunction r (state, state)
forall a b c. (T a -> T b -> c) -> T (a, b) -> c
MultiValue.uncurry ((T parameters -> T parameters -> CodeGenFunction r (state, state))
 -> T (parameters, parameters) -> CodeGenFunction r (state, state))
-> (T parameters
    -> T parameters -> CodeGenFunction r (state, state))
-> T (parameters, parameters)
-> CodeGenFunction r (state, state)
forall a b. (a -> b) -> a -> b
$ \T parameters
parameterA T parameters
parameterB ->
      (state -> state -> (state, state))
-> CodeGenFunction r state
-> CodeGenFunction r state
-> CodeGenFunction r (state, state)
forall a b c.
(a -> b -> c)
-> CodeGenFunction r a
-> CodeGenFunction r b
-> CodeGenFunction r c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (T parameters -> CodeGenFunction r state
forall r. T parameters -> CodeGenFunction r state
startA T parameters
parameterA) (T parameters -> CodeGenFunction r state
forall r. T parameters -> CodeGenFunction r state
startB T parameters
parameterB))
   (\(Zip.Cons a
a b
b) ->
      ((ioContext, parameters)
 -> (ioContext, parameters)
 -> ((ioContext, ioContext), (parameters, parameters)))
-> IO (ioContext, parameters)
-> IO (ioContext, parameters)
-> IO ((ioContext, ioContext), (parameters, parameters))
forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (ioContext, parameters)
-> (ioContext, parameters)
-> ((ioContext, ioContext), (parameters, parameters))
forall a b c d. (a, b) -> (c, d) -> ((a, c), (b, d))
zipPair (a -> IO (ioContext, parameters)
createA a
a) (b -> IO (ioContext, parameters)
createB b
b))
   (\(ioContext
ca,ioContext
cb) -> ioContext -> IO ()
deleteA ioContext
ca IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ioContext -> IO ()
deleteB ioContext
cb)


instance Default SigG.LazySize where
   type Element SigG.LazySize = ()
   deflt :: T LazySize (Element LazySize)
deflt = T LazySize ()
T LazySize (Element LazySize)
lazySize

lazySize :: T SigG.LazySize ()
lazySize :: T LazySize ()
lazySize = T LazySize ()
forall a. T a ()
ignore

ignore :: T a ()
ignore :: forall a. T a ()
ignore =
   (forall r. T () -> T () -> CodeGenFunction r ((), T ()))
-> (forall r. T () -> CodeGenFunction r (T ()))
-> (a -> IO ((), ()))
-> (() -> IO ())
-> T a ()
forall a b state ioContext parameters.
(C parameters, C state) =>
(forall r. T parameters -> state -> CodeGenFunction r (b, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (a -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T a b
Cons
      (\ T ()
_ T ()
unit -> ((), T ()) -> CodeGenFunction r ((), T ())
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), T ()
unit))
      T () -> CodeGenFunction r (T ())
forall a. a -> CodeGenFunction r a
forall r. T () -> CodeGenFunction r (T ())
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 ((), ()))
      (IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

instance (Storable.C a) => Default (SV.Vector a) where
   type Element (SV.Vector a) = MultiValue.T a
   deflt :: T (Vector a) (Element (Vector a))
deflt = T (Vector a) (T a)
T (Vector a) (Element (Vector a))
forall a. C a => T (Vector a) (T a)
storableVector

storableVector :: (Storable.C a) => T (SV.Vector a) (MultiValue.T a)
storableVector :: forall a. C a => T (Vector a) (T a)
storableVector =
   (forall r.
 T (Ptr a) -> T (Ptr a) -> CodeGenFunction r (T a, T (Ptr a)))
-> (forall r. T (Ptr a) -> CodeGenFunction r (T (Ptr a)))
-> (Vector a -> IO (ForeignPtr a, Ptr a))
-> (ForeignPtr a -> IO ())
-> T (Vector a) (T a)
forall a b state ioContext parameters.
(C parameters, C state) =>
(forall r. T parameters -> state -> CodeGenFunction r (b, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (a -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T a b
Cons
      (\ T (Ptr a)
_ (MultiValue.Cons Repr (Ptr a)
p) ->
         (T a -> T (Ptr a) -> (T a, T (Ptr a)))
-> CodeGenFunction r (T a)
-> CodeGenFunction r (T (Ptr a))
-> CodeGenFunction r (T a, T (Ptr a))
forall a b c.
(a -> b -> c)
-> CodeGenFunction r a
-> CodeGenFunction r b
-> CodeGenFunction r c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)
            (Value (Ptr a) -> CodeGenFunction r (T a)
forall a r. C a => Value (Ptr a) -> CodeGenFunction r (T a)
forall r. Value (Ptr a) -> CodeGenFunction r (T a)
Storable.load Repr (Ptr a)
Value (Ptr a)
p)
            (Repr (Ptr a) -> T (Ptr a)
forall a. Repr a -> T a
MultiValue.Cons (Repr (Ptr a) -> T (Ptr a))
-> CodeGenFunction r (Repr (Ptr a))
-> CodeGenFunction r (T (Ptr a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repr (Ptr a) -> CodeGenFunction r (Repr (Ptr a))
forall a ptr r.
(Storable a, Value (Ptr a) ~ ptr) =>
ptr -> CodeGenFunction r ptr
Storable.incrementPtr Repr (Ptr a)
p))
      T (Ptr a) -> CodeGenFunction r (T (Ptr a))
forall a. a -> CodeGenFunction r a
forall r. T (Ptr a) -> CodeGenFunction r (T (Ptr a))
forall (m :: * -> *) a. Monad m => a -> m a
return
      (\Vector a
vec ->
         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
vec
         in  (ForeignPtr a, Ptr a) -> IO (ForeignPtr a, Ptr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr a
fp,Ptr a
ptr))
      -- keep the foreign ptr alive
      ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
FPtr.touchForeignPtr


{-
This is intentionally restricted to NonNegW.Int aka StrictTimeShort,
since chunks must fit into memory.
If you have good reasons to allow other types,
see the versioning history for an according hack.
-}
instance
   (Marshal.C a, time ~ NonNegW.Int) =>
      Default (EventListBT.T time a) where
   type Element (EventListBT.T time a) = MultiValue.T a
   deflt :: T (T time a) (Element (T time a))
deflt = T (T time a) (Element (T time a))
T (T Int a) (T a)
forall a. C a => T (T Int a) (T a)
piecewiseConstant

{-
I would like to re-use code from ConstantPiece here.
Unfortunately, it is based on the LLVM-Maybe-Monad,
but here we do not accept early exit.
-}
piecewiseConstant ::
   (Marshal.C a) => T (EventListBT.T NonNegW.Int a) (MultiValue.T a)
piecewiseConstant :: forall a. C a => T (T Int a) (T a)
piecewiseConstant =
   T (T Int a) (T (T a)) -> T (T Int a) (T a)
forall value events.
C value =>
T events (T value) -> T events value
expandConstantPieces (T (T Int a) (T (T a)) -> T (T Int a) (T a))
-> T (T Int a) (T (T a)) -> T (T Int a) (T a)
forall a b. (a -> b) -> a -> b
$
   (T Int a -> Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
-> T (Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
     (T (T a))
-> T (T Int a) (T (T a))
forall a b c. (a -> b) -> T b c -> T a c
rmap
      ([Stored (Struct (Word, (Struct (Repr a), ())))]
-> Vector (Stored (Struct (Word, (Struct (Repr a), ()))))
forall a. Storable a => [a] -> Vector a
SV.pack ([Stored (Struct (Word, (Struct (Repr a), ())))]
 -> Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
-> (T Int a -> [Stored (Struct (Word, (Struct (Repr a), ())))])
-> T Int a
-> Vector (Stored (Struct (Word, (Struct (Repr a), ()))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       ((a, Int) -> Stored (Struct (Word, (Struct (Repr a), ()))))
-> [(a, Int)] -> [Stored (Struct (Word, (Struct (Repr a), ())))]
forall a b. (a -> b) -> [a] -> [b]
List.map
         (\(a
a,Int
t) -> Struct (Word, (Struct (Repr a), ()))
-> Stored (Struct (Word, (Struct (Repr a), ())))
forall a. a -> Stored a
EE.Stored (Struct (Word, (Struct (Repr a), ()))
 -> Stored (Struct (Word, (Struct (Repr a), ()))))
-> Struct (Word, (Struct (Repr a), ()))
-> Stored (Struct (Word, (Struct (Repr a), ())))
forall a b. (a -> b) -> a -> b
$ (Word, (Struct (Repr a), ()))
-> Struct (Word, (Struct (Repr a), ()))
forall a. a -> Struct a
LLVM.Struct
            (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. T a -> a
NonNegW.toNumber Int
t :: Word, (a -> Struct (Repr a)
forall a. C a => a -> Struct a
Marshal.pack a
a, ()))) ([(a, Int)] -> [Stored (Struct (Word, (Struct (Repr a), ())))])
-> (T Int a -> [(a, Int)])
-> T Int a
-> [Stored (Struct (Word, (Struct (Repr a), ())))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       T Int a -> [(a, Int)]
forall time body. T time body -> [(body, time)]
EventListBT.toPairList) (T (Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
   (T (T a))
 -> T (T Int a) (T (T a)))
-> T (Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
     (T (T a))
-> T (T Int a) (T (T a))
forall a b. (a -> b) -> a -> b
$
   (forall r.
 T (Stored (Struct (Word, (Struct (Repr a), ()))))
 -> CodeGenFunction r (T (T a)))
-> T (Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
     (T (Stored (Struct (Word, (Struct (Repr a), ())))))
-> T (Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
     (T (T a))
forall a b inp.
(forall r. a -> CodeGenFunction r b) -> T inp a -> T inp b
map
      (\(MultiValue.Cons Repr (Stored (Struct (Word, (Struct (Repr a), ()))))
s) -> do
         Value Word
t <- Value (Struct (Word, (Struct (Repr a), ())))
-> Proxy D0
-> CodeGenFunction
     r
     (Value
        (ValueType (Struct (Word, (Struct (Repr a), ()))) (Proxy D0)))
forall r agg i.
GetValue agg i =>
Value agg -> i -> CodeGenFunction r (Value (ValueType agg i))
LLVM.extractvalue Repr (Stored (Struct (Word, (Struct (Repr a), ()))))
Value (Struct (Word, (Struct (Repr a), ())))
s Proxy D0
TypeNum.d0
         Value (ValueType (Struct (Word, (Struct (Repr a), ()))) (Proxy D1))
a <- Value (Struct (Word, (Struct (Repr a), ())))
-> Proxy D1
-> CodeGenFunction
     r
     (Value
        (ValueType (Struct (Word, (Struct (Repr a), ()))) (Proxy D1)))
forall r agg i.
GetValue agg i =>
Value agg -> i -> CodeGenFunction r (Value (ValueType agg i))
LLVM.extractvalue Repr (Stored (Struct (Word, (Struct (Repr a), ()))))
Value (Struct (Word, (Struct (Repr a), ())))
s Proxy D1
TypeNum.d1
         Value Word -> T a -> T (T a)
forall a. Value Word -> a -> T a
Const.Cons Value Word
t (T a -> T (T a)) -> (Repr a -> T a) -> Repr a -> T (T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repr a -> T a
forall a. Repr a -> T a
MultiValue.Cons (Repr a -> T (T a))
-> CodeGenFunction r (Repr a) -> CodeGenFunction r (T (T a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (Struct (Repr a)) -> CodeGenFunction r (Repr a)
forall llvmValue r.
C llvmValue =>
Value (Struct llvmValue) -> CodeGenFunction r llvmValue
forall r. Value (Struct (Repr a)) -> CodeGenFunction r (Repr a)
Memory.decompose Value (Struct (Repr a))
Value (ValueType (Struct (Word, (Struct (Repr a), ()))) (Proxy D1))
a) (T (Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
   (T (Stored (Struct (Word, (Struct (Repr a), ())))))
 -> T (Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
      (T (T a)))
-> T (Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
     (T (Stored (Struct (Word, (Struct (Repr a), ())))))
-> T (Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
     (T (T a))
forall a b. (a -> b) -> a -> b
$
   T (Vector (Stored (Struct (Word, (Struct (Repr a), ())))))
  (T (Stored (Struct (Word, (Struct (Repr a), ())))))
forall a. C a => T (Vector a) (T a)
storableVector

expandConstantPieces ::
   (Memory.C value) => T events (Const.T value) -> T events value
expandConstantPieces :: forall value events.
C value =>
T events (T value) -> T events value
expandConstantPieces (Cons forall r.
T parameters -> state -> CodeGenFunction r (T value, state)
next forall r. T parameters -> CodeGenFunction r state
start events -> IO (ioContext, parameters)
create ioContext -> IO ()
delete) = (forall r.
 T parameters
 -> (T value, state) -> CodeGenFunction r (value, (T value, state)))
-> (forall r. T parameters -> CodeGenFunction r (T value, state))
-> (events -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T events value
forall a b state ioContext parameters.
(C parameters, C state) =>
(forall r. T parameters -> state -> CodeGenFunction r (b, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (a -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T a b
Cons
   (\T parameters
param (T value, state)
state0 -> do
      (Const.Cons Value Word
length1 value
y1, state
s1) <-
         (T value, state)
-> ((T value, state)
    -> (CodeGenFunction r (Value Bool),
        CodeGenFunction r (T value, state)))
-> CodeGenFunction r (T value, state)
forall a r.
Phi a =>
a
-> (a -> (CodeGenFunction r (Value Bool), CodeGenFunction r a))
-> CodeGenFunction r a
C.whileLoopShared (T value, state)
state0
            (\(Const.Cons Value Word
len value
_y, state
s) ->
               (CmpPredicate
-> Value Word
-> Value Word
-> CodeGenFunction r (CmpResult (Value Word))
forall r.
CmpPredicate
-> Value Word
-> Value Word
-> CodeGenFunction r (CmpResult (Value Word))
forall a r.
Comparison a =>
CmpPredicate -> a -> a -> CodeGenFunction r (CmpResult a)
A.cmp CmpPredicate
LLVM.CmpEQ Value Word
len Value Word
forall a. Zero a => a
Tuple.zero,
                T parameters -> state -> CodeGenFunction r (T value, state)
forall r.
T parameters -> state -> CodeGenFunction r (T value, state)
next T parameters
param state
s))
      Value Word
length2 <- Value Word -> CodeGenFunction r (Value Word)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
A.dec Value Word
length1
      (value, (T value, state))
-> CodeGenFunction r (value, (T value, state))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (value
y1, (Value Word -> value -> T value
forall a. Value Word -> a -> T a
Const.Cons Value Word
length2 value
y1, state
s1)))
   (\T parameters
param -> (,) (Value Word -> value -> T value
forall a. Value Word -> a -> T a
Const.Cons Value Word
forall a. Zero a => a
Tuple.zero value
forall a. Undefined a => a
Tuple.undef) (state -> (T value, state))
-> CodeGenFunction r state -> CodeGenFunction r (T value, state)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T parameters -> CodeGenFunction r state
forall r. T parameters -> CodeGenFunction r state
start T parameters
param)
   events -> IO (ioContext, parameters)
create ioContext -> IO ()
delete


{- |
Return an Array and not a pointer to an array,
in order to forbid writing to the array.
-}
controllerSet ::
   (Marshal.C a, Marshal.Struct a ~ aStruct, LLVM.IsSized aStruct,
    TypeNum.Natural n,
    (n:*:LLVM.SizeOf aStruct) ~ arrSize, TypeNum.Natural arrSize) =>
   Proxy n -> T (PCS.T Int a) (MultiValue.T (MultiValue.Array n a))
controllerSet :: forall a aStruct n arrSize.
(C a, Struct a ~ aStruct, IsSized aStruct, Natural n,
 (n :*: SizeOf aStruct) ~ arrSize, Natural arrSize) =>
Proxy n -> T (T Int a) (T (Array n a))
controllerSet Proxy n
pn =
   Proxy n
-> T (Vector (Stored (Struct (Repr (Word, Word, a)))))
     (Value Word, (Value Word, T a))
-> T (T Int a) (T (Array n a))
forall a aStruct n arrSize.
(C a, Struct a ~ aStruct, IsSized aStruct, Natural n,
 (n :*: SizeOf aStruct) ~ arrSize, Natural arrSize) =>
Proxy n
-> T (Vector (Stored (Struct (Word, Word, a))))
     (Value Word, (Value Word, T a))
-> T (T Int a) (T (Array n a))
controllerSetFromSV Proxy n
pn (T (Vector (Stored (Struct (Repr (Word, Word, a)))))
   (Value Word, (Value Word, T a))
 -> T (T Int a) (T (Array n a)))
-> T (Vector (Stored (Struct (Repr (Word, Word, a)))))
     (Value Word, (Value Word, T a))
-> T (T Int a) (T (Array n a))
forall a b. (a -> b) -> a -> b
$
   (forall r.
 T (Stored (Struct (Word, (Word, (aStruct, ())))))
 -> CodeGenFunction r (Value Word, (Value Word, T a)))
-> T (Vector (Stored (Struct (Repr (Word, Word, a)))))
     (T (Stored (Struct (Word, (Word, (aStruct, ()))))))
-> T (Vector (Stored (Struct (Repr (Word, Word, a)))))
     (Value Word, (Value Word, T a))
forall a b inp.
(forall r. a -> CodeGenFunction r b) -> T inp a -> T inp b
map
      (\(MultiValue.Cons Repr (Stored (Struct (Word, (Word, (aStruct, ())))))
s) -> do
         Value Word
len <- Value (Struct (Word, (Word, (aStruct, ()))))
-> Proxy D0
-> CodeGenFunction
     r
     (Value
        (ValueType (Struct (Word, (Word, (aStruct, ())))) (Proxy D0)))
forall r agg i.
GetValue agg i =>
Value agg -> i -> CodeGenFunction r (Value (ValueType agg i))
LLVM.extractvalue Repr (Stored (Struct (Word, (Word, (aStruct, ())))))
Value (Struct (Word, (Word, (aStruct, ()))))
s Proxy D0
TypeNum.d0
         Value Word
i   <- Value (Struct (Word, (Word, (aStruct, ()))))
-> Proxy D1
-> CodeGenFunction
     r
     (Value
        (ValueType (Struct (Word, (Word, (aStruct, ())))) (Proxy D1)))
forall r agg i.
GetValue agg i =>
Value agg -> i -> CodeGenFunction r (Value (ValueType agg i))
LLVM.extractvalue Repr (Stored (Struct (Word, (Word, (aStruct, ())))))
Value (Struct (Word, (Word, (aStruct, ()))))
s Proxy D1
TypeNum.d1
         T a
a   <- Value aStruct -> CodeGenFunction r (T a)
Value (Struct (T a)) -> CodeGenFunction r (T a)
forall llvmValue r.
C llvmValue =>
Value (Struct llvmValue) -> CodeGenFunction r llvmValue
forall r. Value (Struct (T a)) -> CodeGenFunction r (T a)
Memory.decompose (Value aStruct -> CodeGenFunction r (T a))
-> CodeGenFunction r (Value aStruct) -> CodeGenFunction r (T a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Struct (Word, (Word, (aStruct, ()))))
-> Proxy D2
-> CodeGenFunction
     r
     (Value
        (ValueType (Struct (Word, (Word, (aStruct, ())))) (Proxy D2)))
forall r agg i.
GetValue agg i =>
Value agg -> i -> CodeGenFunction r (Value (ValueType agg i))
LLVM.extractvalue Repr (Stored (Struct (Word, (Word, (aStruct, ())))))
Value (Struct (Word, (Word, (aStruct, ()))))
s Proxy D2
TypeNum.d2
         (Value Word, (Value Word, T a))
-> CodeGenFunction r (Value Word, (Value Word, T a))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value Word
len,(Value Word
i,T a
a))) (T (Vector (Stored (Struct (Repr (Word, Word, a)))))
   (T (Stored (Struct (Word, (Word, (aStruct, ()))))))
 -> T (Vector (Stored (Struct (Repr (Word, Word, a)))))
      (Value Word, (Value Word, T a)))
-> T (Vector (Stored (Struct (Repr (Word, Word, a)))))
     (T (Stored (Struct (Word, (Word, (aStruct, ()))))))
-> T (Vector (Stored (Struct (Repr (Word, Word, a)))))
     (Value Word, (Value Word, T a))
forall a b. (a -> b) -> a -> b
$
   T (Vector (Stored (Struct (Repr (Word, Word, a)))))
  (T (Stored (Struct (Word, (Word, (aStruct, ()))))))
T (Vector (Stored (Struct (Word, (Word, (aStruct, ()))))))
  (T (Stored (Struct (Word, (Word, (aStruct, ()))))))
forall a. C a => T (Vector a) (T a)
storableVector

controllerSetFromSV ::
   (Marshal.C a, Marshal.Struct a ~ aStruct, LLVM.IsSized aStruct,
    TypeNum.Natural n,
    (n:*:LLVM.SizeOf aStruct) ~ arrSize, TypeNum.Natural arrSize) =>
   Proxy n ->
   T (SV.Vector (EE.Stored (Marshal.Struct (Word,Word,a))))
     (LLVM.Value Word, (LLVM.Value Word, MultiValue.T a)) ->
   T (PCS.T Int a) (MultiValue.T (MultiValue.Array n a))
controllerSetFromSV :: forall a aStruct n arrSize.
(C a, Struct a ~ aStruct, IsSized aStruct, Natural n,
 (n :*: SizeOf aStruct) ~ arrSize, Natural arrSize) =>
Proxy n
-> T (Vector (Stored (Struct (Word, Word, a))))
     (Value Word, (Value Word, T a))
-> T (T Int a) (T (Array n a))
controllerSetFromSV Proxy n
pn (Cons forall r.
T parameters
-> state
-> CodeGenFunction r ((Value Word, (Value Word, T a)), state)
next forall r. T parameters -> CodeGenFunction r state
start Vector (Stored (Struct (Word, Word, a)))
-> IO (ioContext, parameters)
create ioContext -> IO ()
delete) = (forall r.
 T ((Ptr aStruct, Word), parameters)
 -> (Value Word, state)
 -> CodeGenFunction r (T (Array n a), (Value Word, state)))
-> (forall r.
    T ((Ptr aStruct, Word), parameters)
    -> CodeGenFunction r (Value Word, state))
-> (T Int a
    -> IO
         ((Ptr (Stored aStruct), ioContext),
          ((Ptr aStruct, Word), parameters)))
-> ((Ptr (Stored aStruct), ioContext) -> IO ())
-> T (T Int a) (T (Array n a))
forall a b state ioContext parameters.
(C parameters, C state) =>
(forall r. T parameters -> state -> CodeGenFunction r (b, state))
-> (forall r. T parameters -> CodeGenFunction r state)
-> (a -> IO (ioContext, parameters))
-> (ioContext -> IO ())
-> T a b
Cons
   ((T (Ptr aStruct, Word)
 -> T parameters
 -> (Value Word, state)
 -> CodeGenFunction r (T (Array n a), (Value Word, state)))
-> T ((Ptr aStruct, Word), parameters)
-> (Value Word, state)
-> CodeGenFunction r (T (Array n a), (Value Word, state))
forall a b c. (T a -> T b -> c) -> T (a, b) -> c
MultiValue.uncurry ((T (Ptr aStruct, Word)
  -> T parameters
  -> (Value Word, state)
  -> CodeGenFunction r (T (Array n a), (Value Word, state)))
 -> T ((Ptr aStruct, Word), parameters)
 -> (Value Word, state)
 -> CodeGenFunction r (T (Array n a), (Value Word, state)))
-> (T (Ptr aStruct, Word)
    -> T parameters
    -> (Value Word, state)
    -> CodeGenFunction r (T (Array n a), (Value Word, state)))
-> T ((Ptr aStruct, Word), parameters)
-> (Value Word, state)
-> CodeGenFunction r (T (Array n a), (Value Word, state))
forall a b. (a -> b) -> a -> b
$ \(MultiValue.Cons (Value (Ptr aStruct)
arrPtr, Value Word
_)) T parameters
param (Value Word, state)
state0 -> do
      (Value Word
length2, state
s2) <-
         (Value Word, state)
-> ((Value Word, state)
    -> (CodeGenFunction r (Value Bool),
        CodeGenFunction r (Value Word, state)))
-> CodeGenFunction r (Value Word, state)
forall a r.
Phi a =>
a
-> (a -> (CodeGenFunction r (Value Bool), CodeGenFunction r a))
-> CodeGenFunction r a
C.whileLoopShared (Value Word, state)
state0
            (\(Value Word
len0, state
s0) ->
               (CmpPredicate
-> Value Word
-> Value Word
-> CodeGenFunction r (CmpResult (Value Word))
forall r.
CmpPredicate
-> Value Word
-> Value Word
-> CodeGenFunction r (CmpResult (Value Word))
forall a r.
Comparison a =>
CmpPredicate -> a -> a -> CodeGenFunction r (CmpResult a)
A.cmp CmpPredicate
LLVM.CmpEQ Value Word
len0 Value Word
forall a. Zero a => a
Tuple.zero,
                do ((Value Word
len1, (Value Word
i,T a
a)), state
s1) <- T parameters
-> state
-> CodeGenFunction r ((Value Word, (Value Word, T a)), state)
forall r.
T parameters
-> state
-> CodeGenFunction r ((Value Word, (Value Word, T a)), state)
next T parameters
param state
s0
                   T a -> Value (Ptr (Struct (T a))) -> CodeGenFunction r ()
forall r. T a -> Value (Ptr (Struct (T a))) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store T a
a (Value (Ptr aStruct) -> CodeGenFunction r ())
-> CodeGenFunction r (Value (Ptr aStruct)) -> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr aStruct)
-> (Value Word, ())
-> CodeGenFunction r (Value (Ptr (ElementPtrType aStruct ())))
forall a o i r.
(GetElementPtr o i, IsIndexArg a) =>
Value (Ptr o)
-> (a, i) -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr Value (Ptr aStruct)
arrPtr (Value Word
i, ())
                   (Value Word, state) -> CodeGenFunction r (Value Word, state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value Word
len1, state
s1)))
      Value Word
length3 <- Value Word -> CodeGenFunction r (Value Word)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
A.dec Value Word
length2
      T (Array n a)
arr <- Value (Ptr (Struct (T (Array n a))))
-> CodeGenFunction r (T (Array n a))
Value (Ptr (Array n aStruct)) -> CodeGenFunction r (T (Array n a))
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r.
Value (Ptr (Struct (T (Array n a))))
-> CodeGenFunction r (T (Array n a))
Memory.load (Value (Ptr (Array n aStruct))
 -> CodeGenFunction r (T (Array n a)))
-> CodeGenFunction r (Value (Ptr (Array n aStruct)))
-> CodeGenFunction r (T (Array n a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr aStruct)
-> CodeGenFunction r (Value (Ptr (Array n aStruct)))
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 aStruct)
arrPtr
      (T (Array n a), (Value Word, state))
-> CodeGenFunction r (T (Array n a), (Value Word, state))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T (Array n a)
arr, (Value Word
length3, state
s2)))
   ((T (Ptr aStruct, Word)
 -> T parameters -> CodeGenFunction r (Value Word, state))
-> T ((Ptr aStruct, Word), parameters)
-> CodeGenFunction r (Value Word, state)
forall a b c. (T a -> T b -> c) -> T (a, b) -> c
MultiValue.uncurry ((T (Ptr aStruct, Word)
  -> T parameters -> CodeGenFunction r (Value Word, state))
 -> T ((Ptr aStruct, Word), parameters)
 -> CodeGenFunction r (Value Word, state))
-> (T (Ptr aStruct, Word)
    -> T parameters -> CodeGenFunction r (Value Word, state))
-> T ((Ptr aStruct, Word), parameters)
-> CodeGenFunction r (Value Word, state)
forall a b. (a -> b) -> a -> b
$ \(MultiValue.Cons (Value (Ptr aStruct)
_, Value Word
initialTime)) T parameters
param -> do
      state
state <- T parameters -> CodeGenFunction r state
forall r. T parameters -> CodeGenFunction r state
start T parameters
param
      (Value Word, state) -> CodeGenFunction r (Value Word, state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value Word
initialTime, state
state))

   (\T Int a
pcs ->
      (StrictTime
 -> T StrictTime (Int, a)
 -> IO
      ((Ptr (Stored aStruct), ioContext),
       ((Ptr aStruct, Word), parameters)))
-> T StrictTime (Int, a)
-> IO
     ((Ptr (Stored aStruct), ioContext),
      ((Ptr aStruct, Word), parameters))
forall time body a. (time -> T time body -> a) -> T time body -> a
EventListMT.switchTimeL
         (\StrictTime
initialTime T StrictTime (Int, a)
bt -> do
            (ioContext
context, parameters
param) <-
               Vector (Stored (Struct (Word, Word, a)))
-> IO (ioContext, parameters)
create
                  ([Stored (Struct (Word, (Word, (aStruct, ()))))]
-> Vector (Stored (Struct (Word, Word, a)))
[Stored (Struct (Word, (Word, (aStruct, ()))))]
-> Vector (Stored (Struct (Word, (Word, (aStruct, ())))))
forall a. Storable a => [a] -> Vector a
SV.pack ([Stored (Struct (Word, (Word, (aStruct, ()))))]
 -> Vector (Stored (Struct (Word, Word, a))))
-> (T StrictTime (Int, a)
    -> [Stored (Struct (Word, (Word, (aStruct, ()))))])
-> T StrictTime (Int, a)
-> Vector (Stored (Struct (Word, Word, a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (((Int, a), StrictTime)
 -> Stored (Struct (Word, (Word, (aStruct, ())))))
-> [((Int, a), StrictTime)]
-> [Stored (Struct (Word, (Word, (aStruct, ()))))]
forall a b. (a -> b) -> [a] -> [b]
List.map
                     (\((Int
i,a
a),StrictTime
len) ->
                        Struct (Word, (Word, (aStruct, ())))
-> Stored (Struct (Word, (Word, (aStruct, ()))))
forall a. a -> Stored a
EE.Stored (Struct (Word, (Word, (aStruct, ())))
 -> Stored (Struct (Word, (Word, (aStruct, ())))))
-> Struct (Word, (Word, (aStruct, ())))
-> Stored (Struct (Word, (Word, (aStruct, ()))))
forall a b. (a -> b) -> a -> b
$
                        (Word, Word, a) -> Struct (Word, Word, a)
forall a. C a => a -> Struct a
Marshal.pack
                           (StrictTime -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral StrictTime
len :: Word,
                            Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Word,
                            a
a)) ([((Int, a), StrictTime)]
 -> [Stored (Struct (Word, (Word, (aStruct, ()))))])
-> (T StrictTime (Int, a) -> [((Int, a), StrictTime)])
-> T StrictTime (Int, a)
-> [Stored (Struct (Word, (Word, (aStruct, ()))))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   T StrictTime (Int, a) -> [((Int, a), StrictTime)]
forall time body. T time body -> [(body, time)]
EventListBT.toPairList (T StrictTime (Int, a) -> Vector (Stored (Struct (Word, Word, a))))
-> T StrictTime (Int, a)
-> Vector (Stored (Struct (Word, Word, a)))
forall a b. (a -> b) -> a -> b
$
                   T StrictTime (Int, a)
bt)

            -- FIXME: handle memory exhaustion
            let n :: Int
n = Proxy n -> Int
forall n a. (Integer n, Num a) => Proxy n -> a
TypeNum.integralFromProxy Proxy n
pn
            Ptr (Stored aStruct)
arr <- Int -> IO (Ptr (Stored aStruct))
forall a. Storable a => Int -> IO (Ptr a)
Array.mallocArray Int
n
            (((Int, a) -> IO ()) -> [(Int, a)] -> IO ())
-> [(Int, a)] -> ((Int, a) -> IO ()) -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int, a) -> IO ()) -> [(Int, a)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Map Int a -> [(Int, a)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Int a -> [(Int, a)]) -> Map Int a -> [(Int, a)]
forall a b. (a -> b) -> a -> b
$ T Int a -> Map Int a
forall key a. T key a -> Map key a
PCS.initial T Int a
pcs) (((Int, a) -> IO ()) -> IO ()) -> ((Int, a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i,a
a) ->
               if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
                 then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Plug.Input.controllerSet: array too small"
                 else Ptr (Stored aStruct) -> Int -> Stored aStruct -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr (Stored aStruct)
arr Int
i (Stored aStruct -> IO ()) -> Stored aStruct -> IO ()
forall a b. (a -> b) -> a -> b
$ aStruct -> Stored aStruct
forall a. a -> Stored a
EE.Stored (aStruct -> Stored aStruct) -> aStruct -> Stored aStruct
forall a b. (a -> b) -> a -> b
$ a -> Struct a
forall a. C a => a -> Struct a
Marshal.pack a
a

            ((Ptr (Stored aStruct), ioContext),
 ((Ptr aStruct, Word), parameters))
-> IO
     ((Ptr (Stored aStruct), ioContext),
      ((Ptr aStruct, Word), parameters))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
               ((Ptr (Stored aStruct)
arr, ioContext
context),
                ((Ptr (Stored aStruct) -> Ptr aStruct
forall a. Ptr (Stored a) -> Ptr a
EE.castFromStoredPtr Ptr (Stored aStruct)
arr, StrictTime -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral StrictTime
initialTime :: Word),
                  parameters
param)))
            {-
            It would be more elegant,
            if we could pass Arrays around just like Vectors.

            return (context, ((sampleArray (\i -> maybe Tuple.undef Tuple.valueOf $ Map.lookup i (PCS.initial pcs)), time), param)))
            -}
         (T StrictTime [(Int, a)] -> T StrictTime (Int, a)
forall time body. C time => T time [body] -> T time body
EventListTT.flatten (T Int a -> T StrictTime [(Int, a)]
forall key a. T key a -> T StrictTime [(key, a)]
PCS.stream T Int a
pcs)))
   (\(Ptr (Stored aStruct)
arr, ioContext
context) ->
      Ptr (Stored aStruct) -> IO ()
forall a. Ptr a -> IO ()
Alloc.free Ptr (Stored aStruct)
arr IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ioContext -> IO ()
delete ioContext
context)

{-
We might provide a plug that maps from a sequence of time-stamped controller events
to a stream of (Array Controller Value).
This way, we could select controllers more easily from within an causal arrow.
The disadvantage is, that MIDI controller numbers are then hard-wired into the arrow.
Instead we could use a stream of (Array Index Value)
and a global mapping (Array Controller (Maybe Index)).
This way would both save memory and make the controller numbers exchangeable.
We also have to cope with initialization of values
and have to assert that the exponential function
is computed only once per constant piece in controllerExponential.
-}