{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
module Synthesizer.LLVM.Storable.Process (
makeArranger,
continuePacked,
) where
import qualified Synthesizer.LLVM.Frame.SerialVector.Code as Serial
import qualified Synthesizer.LLVM.Storable.Signal as SigStL
import qualified Synthesizer.CausalIO.Process as PIO
import qualified Synthesizer.Generic.Cut as CutG
import qualified Data.StorableVector as SV
import qualified Data.StorableVector.Base as SVB
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Data.EventList.Relative.TimeTime as EventListTT
import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Data.EventList.Absolute.TimeBody as AbsEventList
import qualified LLVM.Extra.Multi.Value.Storable as Storable
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Arithmetic as A
import qualified Type.Data.Num.Decimal as TypeNum
import qualified Control.Arrow as Arr
import qualified Data.Foldable as Fold
import Foreign.Marshal.Array (advancePtr)
import qualified System.Unsafe as Unsafe
import qualified Number.NonNegative as NonNeg
import NumericPrelude.Numeric
import NumericPrelude.Base
makeArranger ::
(Arr.Arrow arrow, Storable.C a, MultiValue.Additive a) =>
IO (arrow
(EventListTT.T NonNeg.Int (SV.Vector a))
(SV.Vector a))
makeArranger = do
mixer <- SigStL.makeMixer A.add
fill <- SigStL.fillBuffer A.zero
return $ Arr.arr $ \ now ->
let
sznn = EventListTT.duration now
sz = NonNeg.toNumber sznn
xs =
AbsEventList.toPairList $
AbsEventList.mapTime NonNeg.toNumber $
EventList.toAbsoluteEventList 0 $
EventListTM.switchTimeR const now
in Unsafe.performIO $
SVB.createAndTrim sz $ \dstPtr -> do
fill (fromIntegral sz) dstPtr
Fold.forM_ xs $ \(i,s) ->
SVB.withStartPtr s $ \srcPtr len ->
let llen =
if len <= sz-i
then fromIntegral len
else error "Process.arrange: chunk larger that event list"
in mixer llen srcPtr (advancePtr dstPtr i)
return sz
continuePacked ::
(CutG.Transform a, Storable.Vector b, TypeNum.Positive n) =>
PIO.T a (SV.Vector (Serial.T n b)) ->
(b -> PIO.T a (SV.Vector (Serial.T n b))) ->
PIO.T a (SV.Vector (Serial.T n b))
continuePacked proc0 proc1 =
PIO.continueChunk proc0
(proc1 Arr.<<^ SV.last . SigStL.unpackStrict)