{-# LANGUAGE NoImplicitPrelude #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE ExistentialQuantification #-}{-# LANGUAGE Rank2Types #-}{-# LANGUAGE ForeignFunctionInterface #-}moduleSynthesizer.LLVM.CausalParameterized.Process(T(Cons),simple,mapAccum,map,mapSimple,apply,compose,first,feedFst,feedSnd,take,integrate,moduleSynthesizer.LLVM.CausalParameterized.Process)whereimportSynthesizer.LLVM.CausalParameterized.ProcessPrivateimportqualifiedSynthesizer.LLVM.ParameterasParamimportSynthesizer.LLVM.Parameterized.Signal(($#),)importqualifiedSynthesizer.LLVM.Parameterized.SignalasSigimportqualifiedSynthesizer.LLVM.Frame.StereoasStereoimportqualifiedSynthesizer.LLVM.SampleasSampleimportqualifiedSynthesizer.LLVM.ExecutionasExecimportqualifiedSynthesizer.LLVM.Simple.ValueasValueimportqualifiedData.StorableVector.LazyasSVLimportqualifiedData.StorableVectorasSVimportqualifiedData.StorableVector.BaseasSVBimportqualifiedSynthesizer.Plain.ModifierasModifierimportqualifiedLLVM.Extra.ScalarOrVectorasSoVimportqualifiedLLVM.Extra.VectorasVectorimportqualifiedLLVM.Extra.MaybeContinuationasMaybeimportqualifiedLLVM.Extra.RepresentationasRepimportqualifiedLLVM.Extra.ControlasCimportqualifiedLLVM.Extra.ClassasClassimportqualifiedLLVM.Extra.ArithmeticasAimportLLVM.CoreasLLVMimportData.TypeLevel.Num(D2,)importqualifiedData.TypeLevel.NumasTypeNumimportqualifiedData.TypeLevel.Num.SetsasSetsimportqualifiedControl.Monad.HTasMimportqualifiedControl.ArrowasArrimportqualifiedControl.CategoryasCatimportControl.Monad.Trans.State(runState,state,evalState,)importControl.Arrow((<<<),(>>>),(&&&),)importControl.Monad(liftM2,liftM3,)importControl.Applicative(liftA2,)importSystem.Random(Random,RandomGen,randomR,)importqualifiedAlgebra.TranscendentalasTransimportqualifiedAlgebra.FieldasFieldimportqualifiedAlgebra.RingasRingimportqualifiedAlgebra.AdditiveasAdditiveimportData.Function.HT(nest,)importData.Word(Word32,)importForeign.Storable.Tuple()importForeign.Storable(Storable,poke,)importqualifiedForeign.Marshal.ArrayasArrayimportqualifiedForeign.Marshal.AllocasAllocimportForeign.ForeignPtr(withForeignPtr,)importForeign.Ptr(FunPtr,)importControl.Exception(bracket,)importSystem.IO.Unsafe(unsafePerformIO,unsafeInterleaveIO,)importqualifiedData.ListasListimportNumericPrelude.NumericimportNumericPrelude.Basehiding(and,iterate,map,zip,zipWith,take,)infixl0$<,$>,$*,$<#,$>#,$*#-- infixr 0 $:* -- can be used together with $applyFst,($<)::Tp(a,b)c->Sig.Tpa->TpbcapplyFstprocsig=proc<<<feedFstsigapplySnd,($>)::Tp(a,b)c->Sig.Tpb->TpacapplySndprocsig=proc<<<feedSndsig{-
These infix operators may become methods of a type class
that can also have synthesizer-core:Causal.Process as instance.
-}($*)::Tpab->Sig.Tpa->Sig.Tpb($*)=apply($<)=applyFst($>)=applySnd{- |
provide constant input in a comfortable way
-}($*#)::(Storableah,MakeValueTupleaha,Rep.Memoryaam,IsSizedamas)=>Tpab->ah->Sig.Tpbproc$*#x=proc$*(Sig.constant$#x)($<#)::(Storableah,MakeValueTupleaha,Rep.Memoryaam,IsSizedamas)=>Tp(a,b)c->ah->Tpbcproc$<#x=proc$<(Sig.constant$#x)($>#)::(Storablebh,MakeValueTuplebhb,Rep.Memorybbm,IsSizedbmbs)=>Tp(a,b)c->bh->Tpacproc$>#x=proc$>(Sig.constant$#x)mapAccumSimple::(Rep.Memorysstruct,IsSizedstructsa)=>(forallr.a->s->CodeGenFunctionr(b,s))->(forallr.CodeGenFunctionrs)->TpabmapAccumSimplefs=mapAccum(\()->f)(\()->s)(return())(return()){- |
Not quite the loop of ArrowLoop
because we need a delay of one time step
and thus an initialization value.
For a real ArrowLoop.loop, that is a zero-delay loop,
we would formally need a MonadFix instance of CodeGenFunction.
But this will not become reality, since LLVM is not able to re-order code
in a way that allows to access a result before creating the input.
-}loop::(Storablech,MakeValueTuplechc,Rep.Memoryccp,IsSizedcpcs)=>Param.Tpch->Tp(a,c)(b,c)->Tpabloopinitial(ConsnextstartcreateIOContextdeleteIOContext)=Cons(\pa0(c0,s0)->do((b1,c1),s1)<-nextp(a0,c0)s0return(b1,(c1,s1)))(\(i,p)->fmap((,)(Param.valueinitiali))$startp)(\p->do(ctx,(nextParam,startParam))<-createIOContextpreturn(ctx,(nextParam,(Param.getinitialp,startParam))))deleteIOContext-- cf. synthesizer-core:Causal.Process, can be defined for any arrow{-# INLINE replicateControlled #-}replicateControlled::Int->Tp(c,x)x->Tp(c,x)xreplicateControllednp=nestn(Arr.arrfst&&&p>>>)(Arr.arrsnd)-- cf. synthesizer-core:Causal.Process{-# INLINE feedbackControlled #-}feedbackControlled::(Storablech,MakeValueTuplechc,Rep.Memoryccp,IsSizedcpcs)=>Param.Tpch->Tp((ctrl,a),c)b->Tp(ctrl,b)c->Tp(ctrl,a)bfeedbackControlledinitialforthback=loopinitial(Arr.arr(fst.fst)&&&forth>>>Arr.arrsnd&&&back)fromModifier::(Value.Flattenahal,Value.Flattenbhbl,Value.Flattenchcl,Value.Flattenshsl,Rep.Memoryslsp,IsSizedspss)=>Modifier.Simpleshchahbh->Tp(cl,al)blfromModifier(Modifier.Simpleinitialstep)=mapAccumSimple(\(c,a)s->Value.flatten$runState(step(Value.unfoldc)(Value.unfolda))(Value.unfolds))(Value.flatteninitial){- |
Run a causal process independently on each stereo channel.
-}stereoFromMono::Tpab->Tp(Stereo.Ta)(Stereo.Tb)stereoFromMono=Stereo.arrowFromMonostereoFromMonoControlled::Tp(c,a)b->Tp(c,Stereo.Ta)(Stereo.Tb)stereoFromMonoControlled=Stereo.arrowFromMonoControlledstereoFromChannels::Tpab->Tpab->Tp(Stereo.Ta)(Stereo.Tb)stereoFromChannels=Stereo.arrowFromChannels{-
In order to let this work we have to give the disable-mmx option somewhere,
but where?
-}stereoFromVector::(IsPrimitivea,IsPrimitiveb)=>Tp(Value(VectorD2a))(Value(VectorD2b))->Tp(Stereo.T(Valuea))(Stereo.T(Valueb))stereoFromVectorproc=mapSimpleSample.stereoFromVector<<<proc<<<mapSimpleSample.vectorFromStereovectorize::(Vector.Accessnava,Vector.Accessnbvb)=>Tpab->Tpvavbvectorize=vectorizeSizeundefined{-
insert and extract instructions will be in opposite order,
no matter whether we use foldr or foldl
and independent from the order of proc and channel in replaceChannel.
However, LLVM neglects the order anyway.
-}vectorizeSize::(Vector.Accessnava,Vector.Accessnbvb)=>n->Tpab->TpvavbvectorizeSizenproc=foldl(\acci->replaceChanneliprocacc)(Arr.arr(const$LLVM.undefTuple))$List.take(TypeNum.toIntn)[0..]{- |
Given a vector process, replace the i-th output by output
that is generated by a scalar process from the i-th input.
-}replaceChannel::(Vector.Accessnava,Vector.Accessnbvb)=>Int->Tpab->Tpvavb->TpvavbreplaceChannelichannelproc=letli=valueOf$fromIntegraliinmapSimple(uncurry(Vector.insertli))<<<(channel<<<mapSimple(Vector.extractli))&&&proczipWithSimple::(forallr.a->b->CodeGenFunctionrc)->Tp(a,b)czipWithSimplef=mapSimple(uncurryf)mix::(IsArithmetica)=>Tp(Valuea,Valuea)(Valuea)mix=zipWithSimpleSample.mixMonomixStereo::(IsArithmetica)=>Tp(Stereo.T(Valuea),Stereo.T(Valuea))(Stereo.T(Valuea))mixStereo=zipWithSimpleSample.mixStereoraise::(IsArithmetica,Storablea,MakeValueTuplea(Valuea),IsSizedasize)=>Param.Tpa->Tp(Valuea)(Valuea)raise=mapSample.mixMonoenvelope::(IsArithmetica)=>Tp(Valuea,Valuea)(Valuea)envelope=zipWithSimpleSample.amplifyMonoenvelopeStereo::(IsArithmetica)=>Tp(Valuea,Stereo.T(Valuea))(Stereo.T(Valuea))envelopeStereo=zipWithSimpleSample.amplifyStereoamplify::(IsArithmetica,Storablea,MakeValueTuplea(Valuea),IsFirstClassa,IsSizedasize)=>Param.Tpa->Tp(Valuea)(Valuea)amplify=mapSample.amplifyMonoamplifyStereo::(IsArithmetica,Storablea,MakeValueTuplea(Valuea),IsFirstClassa,IsSizedasize)=>Param.Tpa->Tp(Stereo.T(Valuea))(Stereo.T(Valuea))amplifyStereo=mapSample.amplifyStereomapLinear::(IsArithmetica,Storablea,MakeValueTuplea(Valuea),IsFirstClassa,IsSizedasize)=>Param.Tpa->Param.Tpa->Tp(Valuea)(Valuea)mapLineardepthcenter=map(\(d,c)x->A.addc=<<A.muldx)(depth&&&center)mapExponential::(Trans.Ca,IsFloatinga,IsConsta,Storablea,MakeValueTuplea(Valuea),IsFirstClassa,IsSizedasize)=>Param.Tpa->Param.Tpa->Tp(Valuea)(Valuea)mapExponentialdepthcenter=map(\(d,c)x->A.mulc=<<A.exp=<<A.muldx)(logdepth&&&center){- |
@quantizeLift k f@ applies the process @f@ to every @k@th sample
and repeats the result @k@ times.
Like 'SigP.interpolateConstant' this function can be used
for computation of filter parameters at a lower rate.
This can be useful, if you have a frequency control signal at sample rate
that shall be used both for an oscillator and a frequency filter.
-}quantizeLift::(Rep.Memorybstruct,IsSizedstructsize,Ring.Cc,IsFloatingc,CmpRetcBool,Storablec,MakeValueTuplec(Valuec),IsConstc,IsFirstClassc,IsSizedcsc)=>Param.Tpc->Tpab->TpabquantizeLiftk(ConsnextstartcreateIOContextdeleteIOContext)=Cons(\(kl,parameter)a0bState0->do((b1,state1),ss1)<-Maybe.fromBool$C.whileLoop(valueOfTrue,bState0)(\(cont1,(_,ss1))->andcont1=<<A.fcmpFPOLEss1(valueLLVM.zero))(\(_,((_,state01),ss1))->Maybe.toBool$liftM2(,)(nextparametera0state01)(Maybe.lift$A.addss1(Param.valuekkl)))ss2<-Maybe.lift$A.subss1(valueOfRing.one)return(b1,((b1,state1),ss2)))(fmap(\sa->((undefTuple,sa),valueLLVM.zero)).start)(\p->do(ioContext,(nextParam,startParam))<-createIOContextpreturn(ioContext,((Param.getkp,nextParam),startParam)))deleteIOContext{- |
Compute the phases from phase distortions and frequencies.
It's like integrate but with wrap-around performed by @fraction@.
For FM synthesis we need also negative phase distortions,
thus we use 'SoV.addToPhase' which supports that.
-}osciCore::(IsFirstClasst,IsSizedtsize,SoV.Fractiont,IsConstt,Additive.Ct)=>Tp(Valuet,Valuet)(Valuet)osciCore=mapSimple(uncurrySoV.addToPhase)<<<Arr.second(mapAccumSimple(\as->dob<-SoV.incPhaseasreturn(s,b))(return(valueOfAdditive.zero)))osciSimple::(IsFirstClasst,IsSizedtsize,SoV.Fractiont,IsConstt,Additive.Ct)=>(forallr.Valuet->CodeGenFunctionry)->Tp(Valuet,Valuet)yosciSimplewave=mapSimplewave<<<osciCoreshapeModOsci::(IsFirstClasst,IsSizedtsize,SoV.Fractiont,IsConstt,Additive.Ct)=>(forallr.c->Valuet->CodeGenFunctionry)->Tp(c,(Valuet,Valuet))yshapeModOsciwave=mapSimple(uncurrywave)<<<Arr.secondosciCore{- |
Delay time must be non-negative.
The initial value is needed in order to determine the ring buffer element type.
-}delay::(Storablea,MakeValueTupleaal,Rep.Memoryalap,IsSizedapas)=>Param.Tpa->Param.TpInt->Tpalaldelayinitialtime=lettime32=fmap(fromIntegral::Int->Word32)timeinCons(\(size,ptr)a0(remain0,ptri0)->Maybe.lift$doRep.storea0ptri0cont<-A.icmpIntNEremain0(valueOf0)(remain1,ptri1)<-C.ifThenSelectcont(Param.valuetime32size,ptr)(liftM2(,)(A.decremain0)(A.advanceArrayElementPtrptri0))a1<-Rep.loadptri1return(a1,(remain1,ptri1)))(\(x,(size,ptr))->dosize1<-A.inc(Param.valuetime32size)-- cf. LLVM.Storable.Signal.fillC.arrayLoopsize1ptr()$\ptri()->Rep.store(Param.valueinitialx)ptri>>return()return(size,ptr))(\p->doletsize=Param.gettimepx=Param.getinitialp{-
We allocate one element more than necessary
in order to simplify handling of delay time zero
-}ptr<-Array.mallocArray(size+1)letparam=(fromIntegralsize::Word32,Rep.castStorablePtr(ptrAsTypeOfptrx))return(ptr,(param,(x,param))))Alloc.freeptrAsTypeOf::Ptra->a->PtraptrAsTypeOfp_=p{- |
Delay by one sample.
For very small delay times (say up to 8)
it may be more efficient to apply 'delay1' several times
or to use a pipeline,
e.g. @pipeline (id :: T (Vector D4 Float) (Vector D4 Float))@
delays by 4 samples in an efficient way.
In principle it would be also possible to use
@unpack (delay1 (const $ toVector (0,0,0,0)))@
but 'unpack' causes an additional delay.
Thus @unpack (id :: T (Vector D4 Float) (Vector D4 Float))@ may do,
what you want.
-}delay1::(Storablea,MakeValueTupleaal,Rep.Memoryalap,IsSizedapas)=>Param.Tpa->Tpalaldelay1initial=simple(\()as->return(s,a))return(return())initial{- |
Delay time must be greater than zero!
-}comb::(Ring.Ca,Storablea,IsArithmetica,MakeValueTuplea(Valuea),IsFirstClassa,IsSizedaas)=>Param.Tpa->Param.TpInt->Tp(Valuea)(Valuea)combgaintime=letz=Additive.zero`asTypeOf`gaininloopz(mix>>>(Cat.id&&&(delayz(subtract1time)>>>amplifygain)))combStereo::(Ring.Ca,Storablea,IsArithmetica,MakeValueTuplea(Valuea),IsFirstClassa,IsSizedaas)=>Param.Tpa->Param.TpInt->Tp(Stereo.T(Valuea))(Stereo.T(Valuea))combStereogaintime=letz=Additive.zero`asTypeOf`(liftA2Stereo.consgaingain)inloopz(mixStereo>>>(Cat.id&&&(delayz(subtract1time)>>>amplifyStereogain)))reverb::(Field.Ca,Randoma,Storablea,IsArithmetica,MakeValueTuplea(Valuea),IsFirstClassa,IsSizedaas,RandomGeng)=>g->Int->(a,a)->(Int,Int)->Tp(Valuea)(Valuea)reverbrndnumgainRangetimeRange=amplify(return(recip(fromIntegralnum)))<<<(foldl(\procchan->mix<<<(proc&&&chan))Cat.id$List.takenum$List.map(\(g,t)->comb$#g$#t)$flipevalStaternd$M.repeat$liftM2(,)(state(randomRgainRange))(state(randomRtimeRange))){- |
This allows to compute a chain of equal processes efficiently,
if all of these processes can be bundled in one vectorial process.
Applications are an allpass cascade or an FM operator cascade.
The function expects that the vectorial input process
works like parallel scalar processes.
The different pipeline stages may be controlled by different parameters,
but the structure of all pipeline stages must be equal.
Our function feeds the input of the pipelined process
to the zeroth element of the Vector.
The result of processing the i-th element (the i-th channel, so to speak)
is fed to the (i+1)-th element.
The (n-1)-th element of the vectorial process is emitted as output of pipelined process.
The pipeline necessarily introduces a delay of (n-1) values.
For simplification we extend this to n values delay.
If you need to combine the resulting signal from the pipeline
with another signal in a 'zip'-like way,
you may delay that signal with @pipeline id@.
The first input values in later stages of the pipeline
are initialized with zero.
If this is not appropriate for your application,
then we may add a more sensible initialization.
-}pipeline::(Vector.Accessnav,Class.Zerov,Rep.Memoryvvp,IsSizedvps)=>Tpvv->Tpaapipeline(ConsnextstartcreateIOContextdeleteIOContext)=Cons(\parama0(v0,s0)->do(a1,v1)<-Maybe.lift$Vector.shiftUpa0v0(v2,s2)<-nextparamv1s0return(a1,(v2,s2)))(\p->dos<-startpreturn(Class.zeroTuple,s))createIOContextdeleteIOContextlinearInterpolation::(Ring.Ca,IsArithmetica,IsConsta)=>Valuea->(Valuea,Valuea)->CodeGenFunctionr(Valuea)linearInterpolationr(a,b)=dora<-A.mula=<<A.sub(valueOfone)rrb<-A.mulbrA.addrarb{- |
> frequencyModulationLinear signal
is a causal process mapping from a shrinking factor
to the modulated input @signal@.
Similar to 'Sig.interpolateConstant'
but the factor is reciprocal and controllable
and we use linear interpolation.
The shrinking factor must be non-negative.
-}frequencyModulationLinear::(-- Rep.Memory a struct, IsSized struct size,Ring.Ca,IsFloatinga,CmpRetaBool,Storablea,MakeValueTuplea(Valuea),IsConsta,IsFirstClassa,IsSizedasa)=>Sig.Tp(Valuea)->Tp(Valuea)(Valuea)frequencyModulationLinear(Sig.ConsnextstartcreateIOContextdeleteIOContext)=Cons(\parameterkyState0->do(((y02,y12),state2),ss2)<-Maybe.fromBool$C.whileLoop(valueOfTrue,yState0)(\(cont0,(_,ss0))->andcont0=<<A.fcmpFPOGEss0(valueOfRing.one))(\(_,(((_,y01),state0),ss0))->Maybe.toBool$liftM2(,)(do(y11,state1)<-nextparameterstate0return((y01,y11),state1))(Maybe.lift$A.subss0(valueOfRing.one)))Maybe.lift$doy<-linearInterpolationss2(y02,y12)ss3<-A.addss2kreturn(y,(((y02,y12),state2),ss3)))(\p->dosa<-startpreturn(((valueundef,valueundef),sa),valueOf2))createIOContextdeleteIOContext{- |
@trigger fill signal@ send @signal@ to the output
and restart it whenever the Boolean process input is 'True'.
Before the first occurrence of 'True'
and between instances of the signal the output is filled with the @fill@ value.
Attention:
This function will crash if the input generator
uses fromStorableVectorLazy, piecewiseConstant or lazySize,
since these functions contain mutable references and in-place updates,
and thus they cannot read lazy Haskell data multiple times.
-}trigger::(Storablea,MakeValueTupleaal,C.Selectal,Rep.Memoryalas,IsSizedasasize)=>Param.Tpa->Sig.Tpal->Tp(ValueBool)altriggerfill(Sig.ConsnextstartcreateIOContextdeleteIOContext)=Cons(\(nextParam,startParam,f)b0(active0,s0)->Maybe.lift$do(active1,s1)<-C.ifThenb0(active0,s0)(fmap((,)(valueOfFalse))$startstartParam)(active2,(a2,s2))<-Maybe.toBool$Maybe.guardactive1>>nextnextParams1a3<-C.selectactive2a2(Param.valuefillf)return(a3,(active2,s2)))(\()->return(valueOfFalse,undefTuple))(\p->do(context,(nextParam,startParam))<-createIOContextpreturn(context,((nextParam,startParam,Param.getfillp),())))deleteIOContext{- |
On each restart the parameters of type @b@ are passed to the signal.
triggerParam ::
(MakeValueTuple a al,
MakeValueTuple b bl) =>
Param.T p a ->
(Param.T p b -> Sig.T p a) ->
T p (Value Bool, bl) al
triggerParam fill sig =
-}foreignimportccallsafe"dynamic"derefFillPtr::Exec.Importer(Ptrparam->Word32->Ptra->Ptrb->IOWord32)runStorable::(Storablea,MakeValueTupleavalueA,Rep.MemoryvalueAstructA,Storableb,MakeValueTuplebvalueB,Rep.MemoryvalueBstructB)=>TpvalueAvalueB->IO(p->SV.Vectora->SV.Vectorb)runStorable(ConsnextstartcreateIOContextdeleteIOContext)=dofill<-fmapderefFillPtr$Exec.compileModule$createFunctionExternalLinkage$\paramPtrsizealPtrblPtr->do(nextParam,startParam)<-Rep.loadparamPtrs<-startstartParam(pos,_)<-Maybe.arrayLoop2sizealPtrblPtrs$\aPtribPtris0->doa<-Maybe.lift$Rep.loadaPtri(b,s1)<-nextnextParamas0Maybe.lift$Rep.storebbPtrireturns1ret(pos::ValueWord32)return$\pas->unsafePerformIO$bracket(createIOContextp)(deleteIOContext.fst)$\(_,params)->SVB.withStartPtras$\aPtrlen->SVB.createAndTrimlen$\bPtr->Alloc.alloca$\paramPtr->pokeparamPtrparams>>(fmapfromIntegral$fill(Rep.castStorablePtrparamPtr)(fromIntegrallen)(Rep.castStorablePtraPtr)(Rep.castStorablePtrbPtr))applyStorable::(Storablea,MakeValueTupleavalueA,Rep.MemoryvalueAstructA,Storableb,MakeValueTuplebvalueB,Rep.MemoryvalueBstructB)=>TpvalueAvalueB->p->SV.Vectora->SV.VectorbapplyStorablegen=unsafePerformIO$runStorablegenforeignimportccallsafe"dynamic"derefChunkPtr::Exec.Importer(PtrnextParamStruct->PtrstateStruct->Word32->PtrstructA->PtrstructB->IOWord32)compileChunky::(Rep.MemoryvalueAstructA,Rep.MemoryvalueBstructB,Rep.MemorystatestateStruct,IsSizedstateStructstateSize,Rep.MemorystartParamValuestartParamStruct,Rep.MemorynextParamValuenextParamStruct,IsSizedstartParamStructstartParamSize,IsSizednextParamStructnextParamSize)=>(forallr.nextParamValue->valueA->state->Maybe.Tr(ValueBool,(Value(PtrstructB),state))(valueB,state))->(forallr.startParamValue->CodeGenFunctionrstate)->IO(FunPtr(PtrstartParamStruct->IO(PtrstateStruct)),FunPtr(PtrstateStruct->IO()),FunPtr(PtrnextParamStruct->PtrstateStruct->Word32->PtrstructA->PtrstructB->IOWord32))compileChunkynextstart=Exec.compileModule$liftM3(,,)(createFunctionExternalLinkage$\paramPtr->do-- FIXME: size computation in LLVM currently does not work for structs!pptr<-Rep.mallocflipRep.storepptr=<<start=<<Rep.loadparamPtrretpptr)(createFunctionExternalLinkage$\pptr->Rep.freepptr>>ret())(createFunctionExternalLinkage$\paramPtrsptrloopLenaPtrbPtr->doparam<-Rep.loadparamPtrsInit<-Rep.loadsptr(pos,sExit)<-Maybe.arrayLoop2loopLenaPtrbPtrsInit$\aPtribPtris0->doa<-Maybe.lift$Rep.loadaPtri(b,s1)<-nextparamas0Maybe.lift$Rep.storebbPtrireturns1Rep.storesExitsptrret(pos::ValueWord32))runStorableChunky::(Storablea,MakeValueTupleavalueA,Rep.MemoryvalueAstructA,Storableb,MakeValueTuplebvalueB,Rep.MemoryvalueBstructB)=>TpvalueAvalueB->IO(p->SVL.Vectora->SVL.Vectorb)runStorableChunkyproc=fmap($constSVL.empty)$runStorableChunkyContproc{-
I liked to write something with signature
> import qualified Synthesizer.Causal.Process as Causal
>
> liftStorableChunk ::
> T p valueA valueB ->
> IO (p -> Causal.T (SV.Vector a) (SV.Vector b))
This could be used to convert a LLVM causal process
to something that works on Haskell values (here: strict storable vectors).
In a second step we could convert this to a processor of lazy lists,
and thus to a processor of chunky storable vectors.
Unfortunately @Causal.T@ uses an immutable state internally,
whereas @T@ uses mutable states.
In principle the immutable state of @Causal.T@
could be used for breaking the processing of a stream
and continue it on two different streams in parallel.
I have no function that makes use of this feature,
and thus an @ST@ monad might be a way out.
-}{- |
This function should be used
instead of @StorableVector.Lazy.Pattern.splitAt@ and subsequent @append@,
because it does not have the risk of a memory leak.
-}runStorableChunkyCont::(Storablea,MakeValueTupleavalueA,Rep.MemoryvalueAstructA,Storableb,MakeValueTuplebvalueB,Rep.MemoryvalueBstructB)=>TpvalueAvalueB->IO((SVL.Vectora->SVL.Vectorb)->p->SVL.Vectora->SVL.Vectorb)runStorableChunkyCont(ConsnextstartcreateIOContextdeleteIOContext)=do(startFunc,stopFunc,fill)<-compileChunkynextstartreturn$\procRestpsig->SVL.fromChunks$unsafePerformIO$do(ioContext,(nextParam,startParam))<-createIOContextpstatePtr<-Rep.newForeignPtrParamstopFuncstartFuncstartParamnextParamPtr<-Rep.newForeignPtr(deleteIOContextioContext)nextParamletgoxt=unsafeInterleaveIO$casextof[]->return[]x:xs->SVB.withStartPtrx$\aPtrsize->dov<-Rep.withForeignPtrnextParamPtr$\nptr->withForeignPtrstatePtr$\sptr->SVB.createAndTrimsize$fmapfromIntegral.derefChunkPtrfillnptrsptr(fromIntegralsize)(Rep.castStorablePtraPtr).Rep.castStorablePtr(ifSV.lengthv>0thenfmap(v:)elseid)$(ifSV.lengthv<sizethenreturn$SVL.chunks$procRest$SVL.fromChunks$SV.drop(SV.lengthv)x:xselsegoxs)go(SVL.chunkssig)applyStorableChunky::(Storablea,MakeValueTupleavalueA,Rep.MemoryvalueAstructA,Storableb,MakeValueTuplebvalueB,Rep.MemoryvalueBstructB)=>TpvalueAvalueB->p->SVL.Vectora->SVL.VectorbapplyStorableChunkygen=unsafePerformIO(runStorableChunkygen)