{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Causal.Process (
   Causal.T, MV,
   CausalClass.fromSignal,
   CausalClass.toSignal,
   (CausalClass.$<), (CausalClass.$>), (CausalClass.$*),
   ($<#), ($>#), ($*#),
   map,
   zipWith,
   takeWhile,
   take,
   mix,
   raise,
   envelope,
   envelopeStereo,
   amplify,
   amplifyStereo,
   mapLinear,
   mapExponential,
   loop,
   loopZero,
   integrate,
   integrateZero,
   delay1,
   delayControlled,
   delayControlledInterpolated,
   differentiate,
   feedbackControlled,
   feedbackControlledZero,
   mapAccum,
   fromModifier,
   osciCoreSync,
   osciCore,
   osci,
   shapeModOsci,
   skip,
   frequencyModulation,
   frequencyModulationLinear,
   Causal.quantizeLift,
   track,
   delay,
   delayZero,
   Causal.replicateControlled,
   replicateControlledParam,
   stereoFromMono,
   stereoFromMonoControlled,
   stereoFromMonoParameterized,
   comb,
   combStereo,
   reverbExplicit,
   reverbParams,
   trigger,
   arrayElement,
   vectorize,
   pipeline,
   ) where

import qualified Synthesizer.LLVM.Causal.Parameterized as Parameterized
import qualified Synthesizer.LLVM.Causal.Private as Causal
import qualified Synthesizer.LLVM.Generator.Private as SigPriv
import qualified Synthesizer.LLVM.Generator.Signal as Sig
import qualified Synthesizer.LLVM.RingBuffer as RingBuffer
import qualified Synthesizer.LLVM.Interpolation as Interpolation
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import qualified Synthesizer.LLVM.Frame as Frame
import Synthesizer.LLVM.Generator.Private (arraySize)
import Synthesizer.LLVM.Private (noLocalPtr, unbool)

import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Synthesizer.Causal.Class as CausalClass
import Synthesizer.Causal.Class (($*), ($<))

import qualified LLVM.DSL.Expression as Expr
import LLVM.DSL.Expression (Exp)

import qualified LLVM.Extra.Multi.Vector as MultiVector
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.Tuple as Tuple
import qualified LLVM.Extra.Iterator as Iter
import qualified LLVM.Extra.Control as C
import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core as LLVM

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

import qualified Data.List as List
import Data.Traversable (sequenceA)
import Data.Tuple.HT (mapSnd, swap)
import Data.Word (Word)

import qualified Control.Arrow as Arrow
import qualified Control.Category as Cat
import qualified Control.Monad.Trans.State as MS
import qualified Control.Functor.HT as FuncHT
import qualified Control.Applicative.HT as App
import Control.Arrow (Arrow, arr, (<<<), (^<<), (<<^), (>>>), (***), (&&&))
import Control.Applicative (pure, liftA2, liftA3, (<$>))

import qualified System.Unsafe as Unsafe
import System.Random (Random, RandomGen, randomR)

import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric
import NumericPrelude.Base hiding (map, zipWith, takeWhile, take)
import Prelude ()


type MV a b = Causal.T (MultiValue.T a) (MultiValue.T b)


infixl 0 $<#, $>#, $*#

{- |
provide constant input in a comfortable way
-}
($*#) ::
   (CausalClass.C process, CausalClass.SignalOf process ~ signal,
    MultiValue.C a) =>
   process (MultiValue.T a) b -> a -> signal b
process (T a) b
proc $*# :: forall (process :: * -> * -> *) (signal :: * -> *) a b.
(C process, SignalOf process ~ signal, C a) =>
process (T a) b -> a -> signal b
$*# a
x = process (T a) b -> T a -> SignalOf process b
forall (process :: * -> * -> *) a b.
C process =>
process a b -> a -> SignalOf process b
CausalClass.applyConst process (T a) b
proc (T a -> SignalOf process b) -> T a -> SignalOf process b
forall a b. (a -> b) -> a -> b
$ a -> T a
forall a. C a => a -> T a
MultiValue.cons a
x

($<#) ::
   (CausalClass.C process, MultiValue.C a) =>
   process (MultiValue.T a, b) c -> a -> process b c
process (T a, b) c
proc $<# :: forall (process :: * -> * -> *) a b c.
(C process, C a) =>
process (T a, b) c -> a -> process b c
$<# a
x = process (T a, b) c -> T a -> process b c
forall (process :: * -> * -> *) a b c.
Arrow process =>
process (a, b) c -> a -> process b c
CausalClass.applyConstFst process (T a, b) c
proc (T a -> process b c) -> T a -> process b c
forall a b. (a -> b) -> a -> b
$ a -> T a
forall a. C a => a -> T a
MultiValue.cons a
x

($>#) ::
   (CausalClass.C process, MultiValue.C b) =>
   process (a, MultiValue.T b) c -> b -> process a c
process (a, T b) c
proc $># :: forall (process :: * -> * -> *) b a c.
(C process, C b) =>
process (a, T b) c -> b -> process a c
$># b
x = process (a, T b) c -> T b -> process a c
forall (process :: * -> * -> *) a b c.
Arrow process =>
process (a, b) c -> b -> process a c
CausalClass.applyConstSnd process (a, T b) c
proc (T b -> process a c) -> T b -> process a c
forall a b. (a -> b) -> a -> b
$ b -> T b
forall a. C a => a -> T a
MultiValue.cons b
x



map ::
   (Expr.Aggregate ae a, Expr.Aggregate be b) =>
   (ae -> be) -> Causal.T a b
map :: forall ae a be b.
(Aggregate ae a, Aggregate be b) =>
(ae -> be) -> T a b
map ae -> be
f = (forall r. a -> CodeGenFunction r b) -> T a b
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
Causal.map (\a
a -> be -> CodeGenFunction r b
forall r. be -> CodeGenFunction r b
forall exp mv r. Aggregate exp mv => exp -> CodeGenFunction r mv
Expr.bundle (ae -> be
f (a -> ae
forall exp mv. Aggregate exp mv => mv -> exp
Expr.dissect a
a)))

zipWith ::
   (Expr.Aggregate ae a, Expr.Aggregate be b, Expr.Aggregate ce c) =>
   (ae -> be -> ce) -> Causal.T (a,b) c
zipWith :: forall ae a be b ce c.
(Aggregate ae a, Aggregate be b, Aggregate ce c) =>
(ae -> be -> ce) -> T (a, b) c
zipWith ae -> be -> ce
f = ((ae, be) -> ce) -> T (a, b) c
forall ae a be b.
(Aggregate ae a, Aggregate be b) =>
(ae -> be) -> T a b
map ((ae -> be -> ce) -> (ae, be) -> ce
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ae -> be -> ce
f)

takeWhile :: (Expr.Aggregate ae a) => (ae -> Exp Bool) -> Causal.T a a
takeWhile :: forall ae a. Aggregate ae a => (ae -> Exp Bool) -> T a a
takeWhile ae -> Exp Bool
p = (forall r c. Phi c => a -> () -> T r c (a, ()))
-> (forall r. CodeGenFunction r ()) -> T a a
forall state a b.
C state =>
(forall r c. Phi c => a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
Causal.simple
   (\a
a () -> do
      Value Bool -> T r c ()
forall z r. Phi z => Value Bool -> T r z ()
MaybeCont.guard (Value Bool -> T r c ())
-> (T Bool -> Value Bool) -> T Bool -> T r c ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Bool -> Value Bool
unbool (T Bool -> T r c ()) -> T r c (T Bool) -> T r c ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CodeGenFunction r (T Bool) -> T r c (T Bool)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift ((ae -> Exp Bool) -> a -> CodeGenFunction r (T Bool)
forall ae am be bm r.
(Aggregate ae am, Aggregate be bm) =>
(ae -> be) -> am -> CodeGenFunction r bm
Expr.unliftM1 ae -> Exp Bool
p a
a)
      (a, ()) -> T r c (a, ())
forall a. a -> T r c a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,()))
   (() -> CodeGenFunction r ()
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

take :: Exp Word -> Causal.T a a
take :: forall a. Exp Word -> T a a
take Exp Word
len =
   ((T Word, a) -> a) -> T (T Word, a) a
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (T Word, a) -> a
forall a b. (a, b) -> b
snd T (T Word, a) a -> SignalOf T (T Word) -> T a a
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
$< ((Exp Word -> Exp Bool) -> T (T Word) (T Word)
forall ae a. Aggregate ae a => (ae -> Exp Bool) -> T a a
takeWhile (Exp Word
0 Exp Word -> Exp Word -> Exp Bool
forall a. Comparison a => Exp a -> Exp a -> Exp Bool
Expr.<*) T (T Word) (T Word) -> SignalOf T (T Word) -> SignalOf T (T Word)
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
$* (Exp Word -> Exp Word) -> Exp Word -> MV Word
forall a. C a => (Exp a -> Exp a) -> Exp a -> MV a
Sig.iterate (Exp Word -> Exp Word -> Exp Word
forall a. C a => a -> a -> a
subtract Exp Word
1) Exp Word
len)


{- |
You may also use '(+)'.
-}
mix :: (A.Additive a) => Causal.T (a,a) a
mix :: forall a. Additive a => T (a, a) a
mix = (forall r. a -> a -> CodeGenFunction r a) -> T (a, a) a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Additive a => a -> a -> CodeGenFunction r a
Frame.mix

{- |
You may also use '(+)' and a 'Sig.constant' signal or a number literal.
-}
raise :: (Marshal.C a, MultiValue.Additive a) => Exp a -> MV a a
raise :: forall a. (C a, Additive a) => Exp a -> MV a a
raise Exp a
x = T (T a, T a) (T a)
forall a. Additive a => T (a, a) a
mix T (T a, T a) (T a) -> SignalOf T (T a) -> T (T a) (T a)
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
$< Exp a -> T (T a)
forall ae al. (Aggregate ae al, C al) => ae -> T al
Sig.constant Exp a
x


{- |
You may also use '(*)'.
-}
envelope :: (A.PseudoRing a) => Causal.T (a, a) a
envelope :: forall a. PseudoRing a => T (a, a) a
envelope = (forall r. a -> a -> CodeGenFunction r a) -> T (a, a) a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
Frame.amplifyMono

envelopeStereo :: (A.PseudoRing a) => Causal.T (a, Stereo.T a) (Stereo.T a)
envelopeStereo :: forall a. PseudoRing a => T (a, T a) (T a)
envelopeStereo = (forall r. a -> T a -> CodeGenFunction r (T a)) -> T (a, T a) (T a)
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith a -> T a -> CodeGenFunction r (T a)
forall r. a -> T a -> CodeGenFunction r (T a)
forall a r. PseudoRing a => a -> T a -> CodeGenFunction r (T a)
Frame.amplifyStereo

{- |
You may also use '(*)' and a 'Sig.constant' signal or a number literal.
-}
amplify ::
   (Expr.Aggregate ea a, Memory.C a, A.PseudoRing a) =>
   ea -> Causal.T a a
amplify :: forall ea a. (Aggregate ea a, C a, PseudoRing a) => ea -> T a a
amplify ea
x = T (a, a) a
forall a. PseudoRing a => T (a, a) a
envelope T (a, a) a -> SignalOf T a -> T a a
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
$< ea -> T a
forall ae al. (Aggregate ae al, C al) => ae -> T al
Sig.constant ea
x

amplifyStereo ::
   (Marshal.C a, MultiValue.PseudoRing a, Stereo.T (MultiValue.T a) ~ stereo) =>
   Exp a -> Causal.T stereo stereo
amplifyStereo :: forall a stereo.
(C a, PseudoRing a, T (T a) ~ stereo) =>
Exp a -> T stereo stereo
amplifyStereo Exp a
x = T (T a, stereo) stereo
T (T a, T (T a)) (T (T a))
forall a. PseudoRing a => T (a, T a) (T a)
envelopeStereo T (T a, stereo) stereo -> SignalOf T (T a) -> T stereo stereo
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
$< Exp a -> T (T a)
forall ae al. (Aggregate ae al, C al) => ae -> T al
Sig.constant Exp a
x


mapLinear ::
   (Marshal.C a, MultiValue.T a ~ am,
    MultiValue.PseudoRing a, MultiValue.IntegerConstant a) =>
   Exp a -> Exp a -> Causal.T am am
mapLinear :: forall a am.
(C a, T a ~ am, PseudoRing a, IntegerConstant a) =>
Exp a -> Exp a -> T am am
mapLinear Exp a
depth Exp a
center = (Exp a -> Exp a) -> T am am
forall ae a be b.
(Aggregate ae a, Aggregate be b) =>
(ae -> be) -> T a b
map (\Exp a
x -> Exp a
center Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
+ Exp a
depthExp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
*Exp a
x)

-- ToDo: use base 2
mapExponential ::
   (Marshal.C a, MultiValue.T a ~ am,
    MultiValue.Transcendental a, MultiValue.RationalConstant a) =>
   Exp a -> Exp a -> Causal.T am am
mapExponential :: forall a am.
(C a, T a ~ am, Transcendental a, RationalConstant a) =>
Exp a -> Exp a -> T am am
mapExponential Exp a
depth Exp a
center =
   let logDepth :: Exp a
logDepth = Exp a -> Exp a
forall a. C a => a -> a
log Exp a
depth
   in (Exp a -> Exp a) -> T am am
forall ae a be b.
(Aggregate ae a, Aggregate be b) =>
(ae -> be) -> T a b
map (\Exp a
x -> Exp a
center Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
* Exp a -> Exp a
forall a. C a => a -> a
exp (Exp a
logDepth Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
* Exp a
x))


loop ::
   (Expr.Aggregate ce c, Memory.C c) =>
   ce -> Causal.T (a,c) (b,c) -> Causal.T a b
loop :: forall ce c a b.
(Aggregate ce c, C c) =>
ce -> T (a, c) (b, c) -> T a b
loop ce
initial = (forall r. CodeGenFunction r c) -> T (a, c) (b, c) -> T a b
forall c a b.
C c =>
(forall r. CodeGenFunction r c) -> T (a, c) (b, c) -> T a b
Causal.loop (ce -> CodeGenFunction r c
forall r. ce -> CodeGenFunction r c
forall exp mv r. Aggregate exp mv => exp -> CodeGenFunction r mv
Expr.bundle ce
initial)

loopZero ::
   (A.Additive c, Memory.C c) =>
   Causal.T (a,c) (b,c) -> Causal.T a b
loopZero :: forall c a b. (Additive c, C c) => T (a, c) (b, c) -> T a b
loopZero = (forall r. CodeGenFunction r c) -> T (a, c) (b, c) -> T a b
forall c a b.
C c =>
(forall r. CodeGenFunction r c) -> T (a, c) (b, c) -> T a b
Causal.loop (c -> CodeGenFunction r c
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return c
forall a. Additive a => a
A.zero)

loopConst ::
   (Memory.C c) =>
   c -> Causal.T (a,c) (b,c) -> Causal.T a b
loopConst :: forall c a b. C c => c -> T (a, c) (b, c) -> T a b
loopConst c
c = (forall r. CodeGenFunction r c) -> T (a, c) (b, c) -> T a b
forall c a b.
C c =>
(forall r. CodeGenFunction r c) -> T (a, c) (b, c) -> T a b
Causal.loop (c -> CodeGenFunction r c
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return c
c)


integrate ::
   (Expr.Aggregate ae a, A.Additive a, Memory.C a) => ae -> Causal.T a a
integrate :: forall ae a. (Aggregate ae a, Additive a, C a) => ae -> T a a
integrate ae
initial = ae -> T (a, a) (a, a) -> T a a
forall ce c a b.
(Aggregate ce c, C c) =>
ce -> T (a, c) (b, c) -> T a b
loop ae
initial (((a, a) -> a) -> T (a, a) a
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (a, a) -> a
forall a b. (a, b) -> b
snd T (a, a) a -> T (a, a) a -> T (a, a) (a, a)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (forall r. a -> a -> CodeGenFunction r a) -> T (a, a) a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.add)

integrateZero :: (A.Additive a, Memory.C a) => Causal.T a a
integrateZero :: forall a. (Additive a, C a) => T a a
integrateZero = T (a, a) (a, a) -> T a a
forall c a b. (Additive c, C c) => T (a, c) (b, c) -> T a b
loopZero (((a, a) -> a) -> T (a, a) a
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (a, a) -> a
forall a b. (a, b) -> b
snd T (a, a) a -> T (a, a) a -> T (a, a) (a, a)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (forall r. a -> a -> CodeGenFunction r a) -> T (a, a) a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.add)


feedbackControlledAux ::
   (Arrow arrow) =>
   arrow ((ctrl,a),c) b ->
   arrow (ctrl,b) c ->
   arrow ((ctrl,a),c) (b,c)
feedbackControlledAux :: forall (arrow :: * -> * -> *) ctrl a c b.
Arrow arrow =>
arrow ((ctrl, a), c) b
-> arrow (ctrl, b) c -> arrow ((ctrl, a), c) (b, c)
feedbackControlledAux arrow ((ctrl, a), c) b
forth arrow (ctrl, b) c
back =
   ((ctrl, b) -> b) -> arrow (ctrl, b) b
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (ctrl, b) -> b
forall a b. (a, b) -> b
snd arrow (ctrl, b) b -> arrow (ctrl, b) c -> arrow (ctrl, b) (b, c)
forall b c c'. arrow b c -> arrow b c' -> arrow b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& arrow (ctrl, b) c
back  arrow (ctrl, b) (b, c)
-> arrow ((ctrl, a), c) (ctrl, b) -> arrow ((ctrl, a), c) (b, c)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<  (((ctrl, a), c) -> ctrl) -> arrow ((ctrl, a), c) ctrl
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((ctrl, a) -> ctrl
forall a b. (a, b) -> a
fst((ctrl, a) -> ctrl)
-> (((ctrl, a), c) -> (ctrl, a)) -> ((ctrl, a), c) -> ctrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((ctrl, a), c) -> (ctrl, a)
forall a b. (a, b) -> a
fst) arrow ((ctrl, a), c) ctrl
-> arrow ((ctrl, a), c) b -> arrow ((ctrl, a), c) (ctrl, b)
forall b c c'. arrow b c -> arrow b c' -> arrow b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& arrow ((ctrl, a), c) b
forth

feedbackControlled ::
   (Expr.Aggregate ce c, Memory.C c) =>
   ce -> Causal.T ((ctrl,a),c) b -> Causal.T (ctrl,b) c -> Causal.T (ctrl,a) b
feedbackControlled :: forall ce c ctrl a b.
(Aggregate ce c, C c) =>
ce -> T ((ctrl, a), c) b -> T (ctrl, b) c -> T (ctrl, a) b
feedbackControlled ce
initial T ((ctrl, a), c) b
forth T (ctrl, b) c
back =
   ce -> T ((ctrl, a), c) (b, c) -> T (ctrl, a) b
forall ce c a b.
(Aggregate ce c, C c) =>
ce -> T (a, c) (b, c) -> T a b
loop ce
initial (T ((ctrl, a), c) b -> T (ctrl, b) c -> T ((ctrl, a), c) (b, c)
forall (arrow :: * -> * -> *) ctrl a c b.
Arrow arrow =>
arrow ((ctrl, a), c) b
-> arrow (ctrl, b) c -> arrow ((ctrl, a), c) (b, c)
feedbackControlledAux T ((ctrl, a), c) b
forth T (ctrl, b) c
back)

feedbackControlledZero ::
   (A.Additive c, Memory.C c) =>
   Causal.T ((ctrl,a),c) b -> Causal.T (ctrl,b) c -> Causal.T (ctrl,a) b
feedbackControlledZero :: forall c ctrl a b.
(Additive c, C c) =>
T ((ctrl, a), c) b -> T (ctrl, b) c -> T (ctrl, a) b
feedbackControlledZero T ((ctrl, a), c) b
forth T (ctrl, b) c
back =
   T ((ctrl, a), c) (b, c) -> T (ctrl, a) b
forall c a b. (Additive c, C c) => T (a, c) (b, c) -> T a b
loopZero (T ((ctrl, a), c) b -> T (ctrl, b) c -> T ((ctrl, a), c) (b, c)
forall (arrow :: * -> * -> *) ctrl a c b.
Arrow arrow =>
arrow ((ctrl, a), c) b
-> arrow (ctrl, b) c -> arrow ((ctrl, a), c) (b, c)
feedbackControlledAux T ((ctrl, a), c) b
forth T (ctrl, b) c
back)


arrayPtr ::
   (TypeNum.Natural n, LLVM.IsSized a) =>
   LLVM.Value (LLVM.Ptr a) ->
   LLVM.CodeGenFunction r (LLVM.Value (LLVM.Ptr (LLVM.Array n a)))
arrayPtr :: forall n a r.
(Natural n, IsSized a) =>
Value (Ptr a) -> CodeGenFunction r (Value (Ptr (Array n a)))
arrayPtr = Value (Ptr a) -> CodeGenFunction r (Value (Ptr (Array n a)))
forall (value :: * -> *) a b r.
(ValueCons value, IsSized a, IsSized b, SizeOf a ~ SizeOf b) =>
value a -> CodeGenFunction r (value b)
LLVM.bitcast

replicateControlledParam ::
   (TypeNum.Natural n) =>
   (Tuple.Undefined a, Tuple.Phi a) =>
   (Marshal.C b, (n TypeNum.:*: LLVM.SizeOf (Marshal.Struct b)) ~ bSize,
    TypeNum.Natural bSize) =>
   (Exp b -> Causal.T (c,a) a) ->
   Exp (MultiValue.Array n b) -> Causal.T (c,a) a
replicateControlledParam :: forall n a b bSize c.
(Natural n, Undefined a, Phi a, C b,
 (n :*: SizeOf (Struct b)) ~ bSize, Natural bSize) =>
(Exp b -> T (c, a) a) -> Exp (Array n b) -> T (c, a) a
replicateControlledParam Exp b -> T (c, a) a
f Exp (Array n b)
ps = IO (T (c, a) a) -> T (c, a) a
forall a. IO a -> a
Unsafe.performIO (IO (T (c, a) a) -> T (c, a) a) -> IO (T (c, a) a) -> T (c, a) a
forall a b. (a -> b) -> a -> b
$ do
   let n :: Word
       n :: Word
n = Proxy n -> Word
forall n a. (Integer n, Num a) => Proxy n -> a
TypeNum.integralFromProxy (Proxy n -> Word) -> Proxy n -> Word
forall a b. (a -> b) -> a -> b
$ Exp (Array n b) -> Proxy n
forall (value :: * -> *) (array :: * -> * -> *) n a.
value (array n a) -> Proxy n
arraySize Exp (Array n b)
ps
   T (Value (Ptr (Struct b))) (c, a) a
paramd <- String
-> (Exp b -> T (c, a) a)
-> IO (T (Value (Ptr (Struct b))) (c, a) a)
forall p a b.
C p =>
String -> (Exp p -> T a b) -> IO (T (Value (Ptr (Struct p))) a b)
Parameterized.fromProcessPtr String
"Causal.replicateControlledParam" Exp b -> T (c, a) a
f
   T (c, a) a -> IO (T (c, a) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (T (c, a) a -> IO (T (c, a) a)) -> T (c, a) a -> IO (T (c, a) a)
forall a b. (a -> b) -> a -> b
$
      case T (Value (Ptr (Struct b))) (c, a) a
paramd of
         Parameterized.Cons forall r c.
Phi c =>
Value (Ptr (Struct b))
-> global
-> Value (Ptr local)
-> (c, a)
-> state
-> T r c (a, state)
next forall r.
Value (Ptr (Struct b)) -> CodeGenFunction r (global, state)
start forall r. Value (Ptr (Struct b)) -> global -> CodeGenFunction r ()
stop ->
            (forall r c.
 Phi c =>
 (Value (Ptr (Struct b)), Value (Ptr (Struct global)))
 -> Value (Ptr (Ptr local))
 -> (c, a)
 -> Value (Ptr (Struct state))
 -> T r c (a, Value (Ptr (Struct state))))
-> (forall r.
    CodeGenFunction
      r
      ((Value (Ptr (Struct b)), Value (Ptr (Struct global))),
       Value (Ptr (Struct state))))
-> (forall r.
    (Value (Ptr (Struct b)), Value (Ptr (Struct global)))
    -> CodeGenFunction r ())
-> T (c, a) a
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Causal.Cons
               (\(Value (Ptr (Struct b))
bPtr,Value (Ptr (Struct global))
globalPtr) Value (Ptr (Ptr local))
localPtr (c
c,a
a0) Value (Ptr (Struct state))
statePtr -> do
                  a
a1 <-
                     CodeGenFunction r (Value Bool, a) -> T r c a
forall z r a. Phi z => CodeGenFunction r (Value Bool, a) -> T r z a
MaybeCont.fromBool (CodeGenFunction r (Value Bool, a) -> T r c a)
-> CodeGenFunction r (Value Bool, a) -> T r c a
forall a b. (a -> b) -> a -> b
$
                     ((Value (Ptr (Struct b)), Value (Ptr (Struct global)),
  Value (Ptr (Ptr local)), Value (Ptr (Struct state)))
 -> (Value Bool, a)
 -> CodeGenFunction r (Value Bool, (Value Bool, a)))
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Ptr local)), Value (Ptr (Struct state)))
-> (Value Bool, a)
-> CodeGenFunction r (Value Bool, a)
forall t a r.
Phi t =>
(a -> t -> CodeGenFunction r (Value Bool, t))
-> T r a -> t -> CodeGenFunction r t
Iter.mapWhileState_
                        (\(Value (Ptr (Struct b))
biPtr,Value (Ptr (Struct global))
globalIPtr,Value (Ptr (Ptr local))
localIPtr,Value (Ptr (Struct state))
stateIPtr)
                              (Value Bool
_cont,a
ai0) -> do
                           global
global <- Value (Ptr (Struct global)) -> CodeGenFunction r 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))
globalIPtr
                           Value (Ptr local)
local <- Value (Ptr (Struct (Value (Ptr local))))
-> CodeGenFunction r (Value (Ptr local))
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r.
Value (Ptr (Struct (Value (Ptr local))))
-> CodeGenFunction r (Value (Ptr local))
Memory.load Value (Ptr (Struct (Value (Ptr local))))
Value (Ptr (Ptr local))
localIPtr
                           state
state0 <- Value (Ptr (Struct state)) -> CodeGenFunction r 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))
stateIPtr
                           (Value Bool
conti,(a
ai1,state
state1)) <-
                              T r (Value Bool, (a, state)) (a, state)
-> CodeGenFunction r (Value Bool, (a, state))
forall a r.
Undefined a =>
T r (Value Bool, a) a -> CodeGenFunction r (Value Bool, a)
MaybeCont.toBool (T r (Value Bool, (a, state)) (a, state)
 -> CodeGenFunction r (Value Bool, (a, state)))
-> T r (Value Bool, (a, state)) (a, state)
-> CodeGenFunction r (Value Bool, (a, state))
forall a b. (a -> b) -> a -> b
$
                              Value (Ptr (Struct b))
-> global
-> Value (Ptr local)
-> (c, a)
-> state
-> T r (Value Bool, (a, state)) (a, state)
forall r c.
Phi c =>
Value (Ptr (Struct b))
-> global
-> Value (Ptr local)
-> (c, a)
-> state
-> T r c (a, state)
next Value (Ptr (Struct b))
biPtr global
global Value (Ptr local)
local (c
c,a
ai0) state
state0
                           (Value (Struct state)
 -> Value (Ptr (Struct state)) -> CodeGenFunction r ())
-> Value (Ptr (Struct state))
-> Value (Struct state)
-> CodeGenFunction r ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value (Struct state)
-> Value (Ptr (Struct state)) -> CodeGenFunction r ()
forall a r. Value a -> Value (Ptr a) -> CodeGenFunction r ()
LLVM.store Value (Ptr (Struct state))
stateIPtr (Value (Struct state) -> CodeGenFunction r ())
-> CodeGenFunction r (Value (Struct state)) -> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< state -> CodeGenFunction r (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
state1
                           (Value Bool, (Value Bool, a))
-> CodeGenFunction r (Value Bool, (Value Bool, a))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value Bool
conti,(Value Bool
conti,a
ai1)))
                        (Value Word
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Ptr local)), Value (Ptr (Struct state)))
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Ptr local)), Value (Ptr (Struct state)))
forall i r a.
(Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> T r a -> T r a
Iter.take (Word -> Value Word
forall a. IsConst a => a -> Value a
LLVM.valueOf Word
n) (T r
   (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
    Value (Ptr (Ptr local)), Value (Ptr (Struct state)))
 -> T r
      (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
       Value (Ptr (Ptr local)), Value (Ptr (Struct state))))
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Ptr local)), Value (Ptr (Struct state)))
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Ptr local)), Value (Ptr (Struct state)))
forall a b. (a -> b) -> a -> b
$
                         (Value (Ptr (Struct b))
 -> Value (Ptr (Struct global))
 -> Value (Ptr (Ptr local))
 -> Value (Ptr (Struct state))
 -> (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
     Value (Ptr (Ptr local)), Value (Ptr (Struct state))))
-> T r (Value (Ptr (Struct b)))
-> T r (Value (Ptr (Struct global)))
-> T r (Value (Ptr (Ptr local)))
-> T r (Value (Ptr (Struct state)))
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Ptr local)), Value (Ptr (Struct state)))
forall (m :: * -> *) a b c d r.
Applicative m =>
(a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
App.lift4 (,,,)
                           (Value (Ptr (Struct b)) -> T r (Value (Ptr (Struct b)))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
Iter.arrayPtrs Value (Ptr (Struct b))
bPtr)
                           (Value (Ptr (Struct global)) -> T r (Value (Ptr (Struct global)))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
Iter.arrayPtrs Value (Ptr (Struct global))
globalPtr)
                           (Value (Ptr (Ptr local)) -> T r (Value (Ptr (Ptr local)))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
Iter.arrayPtrs Value (Ptr (Ptr local))
localPtr)
                           (Value (Ptr (Struct state)) -> T r (Value (Ptr (Struct state)))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
Iter.arrayPtrs Value (Ptr (Struct state))
statePtr))
                        (Bool -> Value Bool
forall a. IsConst a => a -> Value a
LLVM.valueOf Bool
True, a
a0)
                  (a, Value (Ptr (Struct state)))
-> T r c (a, Value (Ptr (Struct state)))
forall a. a -> T r c a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a1, Value (Ptr (Struct state))
statePtr))
               (do
                  T (Array n b)
bArr <- Exp (Array n b) -> forall r. CodeGenFunction r (T (Array n b))
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp Exp (Array n b)
ps
                  Value (Ptr (Struct b))
bPtr <- Word -> CodeGenFunction r (Value (Ptr (Struct b)))
forall a r s.
(IsSized a, AllocArg s) =>
s -> CodeGenFunction r (Value (Ptr a))
LLVM.arrayMalloc Word
n
                  T (Array n b)
-> Value (Ptr (Struct (T (Array n b)))) -> CodeGenFunction r ()
forall r.
T (Array n b)
-> Value (Ptr (Struct (T (Array n b)))) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store T (Array n b)
bArr (Value (Ptr (Array n (Struct b))) -> CodeGenFunction r ())
-> CodeGenFunction r (Value (Ptr (Array n (Struct b))))
-> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr (Struct b))
-> CodeGenFunction r (Value (Ptr (Array n (Struct b))))
forall n a r.
(Natural n, IsSized a) =>
Value (Ptr a) -> CodeGenFunction r (Value (Ptr (Array n a)))
arrayPtr Value (Ptr (Struct b))
bPtr
                  {-
                  ToDo:
                  Instead of a pointer to a malloced with dynamic length
                  we could use LLVM.Array.
                  However, we would have to establish the constraint
                  Natural (n :*: LLVM.SizeOf (Marshal.Struct a))
                  This is pretty cumbersome
                  with current decimal number representation.
                  It would be feasible with type-level natural numbers, though.
                  -}
                  Value (Ptr (Struct global))
globalPtr <- Word -> CodeGenFunction r (Value (Ptr (Struct global)))
forall a r s.
(IsSized a, AllocArg s) =>
s -> CodeGenFunction r (Value (Ptr a))
LLVM.arrayMalloc Word
n
                  Value (Ptr (Struct state))
statePtr <- Word -> CodeGenFunction r (Value (Ptr (Struct state)))
forall a r s.
(IsSized a, AllocArg s) =>
s -> CodeGenFunction r (Value (Ptr a))
LLVM.arrayMalloc Word
n
                  ((Value (Ptr (Struct b)), Value (Ptr (Struct global)),
  Value (Ptr (Struct state)))
 -> CodeGenFunction r ())
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Struct state)))
-> CodeGenFunction r ()
forall a r.
(a -> CodeGenFunction r ()) -> T r a -> CodeGenFunction r ()
Iter.mapM_
                     (\(Value (Ptr (Struct b))
biPtr,Value (Ptr (Struct global))
globalIPtr,Value (Ptr (Struct state))
stateIPtr) -> do
                        (global
global,state
state) <- Value (Ptr (Struct b)) -> CodeGenFunction r (global, state)
forall r.
Value (Ptr (Struct b)) -> CodeGenFunction r (global, state)
start Value (Ptr (Struct b))
biPtr
                        (Value (Struct global)
 -> Value (Ptr (Struct global)) -> CodeGenFunction r ())
-> Value (Ptr (Struct global))
-> Value (Struct global)
-> CodeGenFunction r ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value (Struct global)
-> Value (Ptr (Struct global)) -> CodeGenFunction r ()
forall a r. Value a -> Value (Ptr a) -> CodeGenFunction r ()
LLVM.store Value (Ptr (Struct global))
globalIPtr (Value (Struct global) -> CodeGenFunction r ())
-> CodeGenFunction r (Value (Struct global))
-> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< global -> CodeGenFunction r (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
                        (Value (Struct state)
 -> Value (Ptr (Struct state)) -> CodeGenFunction r ())
-> Value (Ptr (Struct state))
-> Value (Struct state)
-> CodeGenFunction r ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value (Struct state)
-> Value (Ptr (Struct state)) -> CodeGenFunction r ()
forall a r. Value a -> Value (Ptr a) -> CodeGenFunction r ()
LLVM.store Value (Ptr (Struct state))
stateIPtr (Value (Struct state) -> CodeGenFunction r ())
-> CodeGenFunction r (Value (Struct state)) -> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< state -> CodeGenFunction r (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 Word
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Struct state)))
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Struct state)))
forall i r a.
(Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> T r a -> T r a
Iter.take (Word -> Value Word
forall a. IsConst a => a -> Value a
LLVM.valueOf Word
n) (T r
   (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
    Value (Ptr (Struct state)))
 -> T r
      (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
       Value (Ptr (Struct state))))
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Struct state)))
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Struct state)))
forall a b. (a -> b) -> a -> b
$
                      (Value (Ptr (Struct b))
 -> Value (Ptr (Struct global))
 -> Value (Ptr (Struct state))
 -> (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
     Value (Ptr (Struct state))))
-> T r (Value (Ptr (Struct b)))
-> T r (Value (Ptr (Struct global)))
-> T r (Value (Ptr (Struct state)))
-> T r
     (Value (Ptr (Struct b)), Value (Ptr (Struct global)),
      Value (Ptr (Struct state)))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,)
                        (Value (Ptr (Struct b)) -> T r (Value (Ptr (Struct b)))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
Iter.arrayPtrs Value (Ptr (Struct b))
bPtr)
                        (Value (Ptr (Struct global)) -> T r (Value (Ptr (Struct global)))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
Iter.arrayPtrs Value (Ptr (Struct global))
globalPtr)
                        (Value (Ptr (Struct state)) -> T r (Value (Ptr (Struct state)))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
Iter.arrayPtrs Value (Ptr (Struct state))
statePtr))
                  ((Value (Ptr (Struct b)), Value (Ptr (Struct global))),
 Value (Ptr (Struct state)))
-> CodeGenFunction
     r
     ((Value (Ptr (Struct b)), Value (Ptr (Struct global))),
      Value (Ptr (Struct state)))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Value (Ptr (Struct b))
bPtr,Value (Ptr (Struct global))
globalPtr), Value (Ptr (Struct state))
statePtr))
               (\(Value (Ptr (Struct b))
bPtr,Value (Ptr (Struct global))
globalPtr) ->
                  ((Value (Ptr (Struct b)), Value (Ptr (Struct global)))
 -> CodeGenFunction r ())
-> T r (Value (Ptr (Struct b)), Value (Ptr (Struct global)))
-> CodeGenFunction r ()
forall a r.
(a -> CodeGenFunction r ()) -> T r a -> CodeGenFunction r ()
Iter.mapM_
                     (\(Value (Ptr (Struct b))
biPtr,Value (Ptr (Struct global))
globalIPtr) -> do
                        Value (Ptr (Struct b)) -> global -> CodeGenFunction r ()
forall r. Value (Ptr (Struct b)) -> global -> CodeGenFunction r ()
stop Value (Ptr (Struct b))
biPtr (global -> CodeGenFunction r ())
-> CodeGenFunction r global -> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr (Struct global)) -> CodeGenFunction r 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))
globalIPtr)
                     (Value Word
-> T r (Value (Ptr (Struct b)), Value (Ptr (Struct global)))
-> T r (Value (Ptr (Struct b)), Value (Ptr (Struct global)))
forall i r a.
(Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> T r a -> T r a
Iter.take (Word -> Value Word
forall a. IsConst a => a -> Value a
LLVM.valueOf Word
n) (T r (Value (Ptr (Struct b)), Value (Ptr (Struct global)))
 -> T r (Value (Ptr (Struct b)), Value (Ptr (Struct global))))
-> T r (Value (Ptr (Struct b)), Value (Ptr (Struct global)))
-> T r (Value (Ptr (Struct b)), Value (Ptr (Struct global)))
forall a b. (a -> b) -> a -> b
$
                      (Value (Ptr (Struct b))
 -> Value (Ptr (Struct global))
 -> (Value (Ptr (Struct b)), Value (Ptr (Struct global))))
-> T r (Value (Ptr (Struct b)))
-> T r (Value (Ptr (Struct global)))
-> T r (Value (Ptr (Struct b)), Value (Ptr (Struct global)))
forall a b c. (a -> b -> c) -> T r a -> T r b -> T r c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)
                        (Value (Ptr (Struct b)) -> T r (Value (Ptr (Struct b)))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
Iter.arrayPtrs Value (Ptr (Struct b))
bPtr)
                        (Value (Ptr (Struct global)) -> T r (Value (Ptr (Struct global)))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
Iter.arrayPtrs Value (Ptr (Struct global))
globalPtr)))


{- |
Run a causal process independently on each stereo channel.
-}
stereoFromMono ::
   (Tuple.Phi a, Tuple.Undefined a, Tuple.Phi b, Tuple.Undefined b) =>
   Causal.T a b -> Causal.T (Stereo.T a) (Stereo.T b)
stereoFromMono :: forall a b.
(Phi a, Undefined a, Phi b, Undefined b) =>
T a b -> T (T a) (T b)
stereoFromMono T a b
proc =
   (T a, T b) -> T b
forall a b. (a, b) -> b
snd
   ((T a, T b) -> T b) -> T (T a) (T a, T b) -> T (T a) (T b)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
   Exp Word -> T (T a, T b) (T a, T b) -> T (T a, T b) (T a, T b)
forall a. (Undefined a, Phi a) => Exp Word -> T a a -> T a a
Causal.replicateSerial Exp Word
2
      ((\((b
x,T a
a),T b
b) -> (T a -> T a
forall a. T a -> T a
Stereo.swap T a
a, b -> b -> T b
forall a. a -> a -> T a
Stereo.cons (T b -> b
forall a. T a -> a
Stereo.right T b
b) b
x))
       (((b, T a), T b) -> (T a, T b))
-> T (T a, T b) ((b, T a), T b) -> T (T a, T b) (T a, T b)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
       T (T a) (b, T a) -> T (T a, T b) ((b, T a), T b)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arrow.first ((T a b
proc T a b -> (T a -> a) -> T (T a) b
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ T a -> a
forall a. T a -> a
Stereo.left) T (T a) b -> T (T a) (T a) -> T (T a) (b, T a)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T (T a) (T a)
forall a. T a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id))
   T (T a, T b) (T a, T b)
-> (T a -> (T a, T b)) -> T (T a) (T a, T b)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
   (\T a
a -> (T a
a, T b
forall a. Undefined a => a
Tuple.undef))

stereoFromMonoControlled ::
   (Tuple.Phi a, Tuple.Phi b, Tuple.Phi c,
    Tuple.Undefined a, Tuple.Undefined b, Tuple.Undefined c) =>
   Causal.T (c,a) b -> Causal.T (c, Stereo.T a) (Stereo.T b)
stereoFromMonoControlled :: forall a b c.
(Phi a, Phi b, Phi c, Undefined a, Undefined b, Undefined c) =>
T (c, a) b -> T (c, T a) (T b)
stereoFromMonoControlled T (c, a) b
proc =
   T (c, a) b -> T (T (c, a)) (T b)
forall a b.
(Phi a, Undefined a, Phi b, Undefined b) =>
T a b -> T (T a) (T b)
stereoFromMono T (c, a) b
proc T (T (c, a)) (T b) -> ((c, T a) -> T (c, a)) -> T (c, T a) (T b)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ (\(c
c,T a
sa) -> (,) c
c (a -> (c, a)) -> T a -> T (c, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T a
sa)

arrayFromStereo ::
   (Marshal.C a) =>
   Stereo.T (MultiValue.T a) ->
   LLVM.CodeGenFunction r (MultiValue.T (MultiValue.Array TypeNum.D2 a))
arrayFromStereo :: forall a r. C a => T (T a) -> CodeGenFunction r (T (Array D2 a))
arrayFromStereo T (T a)
a =
   Proxy D0
-> T a -> T (Array D2 a) -> CodeGenFunction r (T (Array D2 a))
forall n i a r.
(Natural n, ArrayIndex n i, C a) =>
i -> T a -> T (Array n a) -> CodeGenFunction r (T (Array n a))
MultiValue.insertArrayValue Proxy D0
TypeNum.d0 (T (T a) -> T a
forall a. T a -> a
Stereo.left T (T a)
a) (T (Array D2 a) -> CodeGenFunction r (T (Array D2 a)))
-> CodeGenFunction r (T (Array D2 a))
-> CodeGenFunction r (T (Array D2 a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
   Proxy D1
-> T a -> T (Array D2 a) -> CodeGenFunction r (T (Array D2 a))
forall n i a r.
(Natural n, ArrayIndex n i, C a) =>
i -> T a -> T (Array n a) -> CodeGenFunction r (T (Array n a))
MultiValue.insertArrayValue Proxy D1
TypeNum.d1 (T (T a) -> T a
forall a. T a -> a
Stereo.right T (T a)
a) T (Array D2 a)
forall a. C a => T a
MultiValue.undef

stereoFromMonoParameterized ::
   (Marshal.C x,
    Tuple.Phi a, Tuple.Undefined a, Tuple.Phi b, Tuple.Undefined b) =>
   ((TypeNum.D2 TypeNum.:*: LLVM.SizeOf (Marshal.Struct x)) ~ xSize,
    TypeNum.Natural xSize) =>
   (Exp x -> Causal.T a b) ->
   Stereo.T (Exp x) -> Causal.T (Stereo.T a) (Stereo.T b)
stereoFromMonoParameterized :: forall x a b xSize.
(C x, Phi a, Undefined a, Phi b, Undefined b,
 (D2 :*: SizeOf (Struct x)) ~ xSize, Natural xSize) =>
(Exp x -> T a b) -> T (Exp x) -> T (T a) (T b)
stereoFromMonoParameterized Exp x -> T a b
f T (Exp x)
sx =
   (T a, T b) -> T b
forall a b. (a, b) -> b
snd
   ((T a, T b) -> T b) -> T (T a) (T a, T b) -> T (T a) (T b)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
   (Exp x -> T ((), (T a, T b)) (T a, T b))
-> Exp (Array D2 x) -> T ((), (T a, T b)) (T a, T b)
forall n a b bSize c.
(Natural n, Undefined a, Phi a, C b,
 (n :*: SizeOf (Struct b)) ~ bSize, Natural bSize) =>
(Exp b -> T (c, a) a) -> Exp (Array n b) -> T (c, a) a
replicateControlledParam
      (\Exp x
x ->
         (\((b
y,T a
a),T b
b) -> (T a -> T a
forall a. T a -> T a
Stereo.swap T a
a, b -> b -> T b
forall a. a -> a -> T a
Stereo.cons (T b -> b
forall a. T a -> a
Stereo.right T b
b) b
y))
         (((b, T a), T b) -> (T a, T b))
-> T ((), (T a, T b)) ((b, T a), T b)
-> T ((), (T a, T b)) (T a, T b)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
         T (T a) (b, T a) -> T (T a, T b) ((b, T a), T b)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arrow.first ((Exp x -> T a b
f Exp x
x T a b -> (T a -> a) -> T (T a) b
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ T a -> a
forall a. T a -> a
Stereo.left) T (T a) b -> T (T a) (T a) -> T (T a) (b, T a)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T (T a) (T a)
forall a. T a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id)
         T (T a, T b) ((b, T a), T b)
-> (((), (T a, T b)) -> (T a, T b))
-> T ((), (T a, T b)) ((b, T a), T b)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
         ((), (T a, T b)) -> (T a, T b)
forall a b. (a, b) -> b
snd)
      ((forall r. T (T x) -> CodeGenFunction r (T (Array D2 x)))
-> T (Exp x) -> Exp (Array D2 x)
forall ae am b.
Aggregate ae am =>
(forall r. am -> CodeGenFunction r (T b)) -> ae -> Exp b
Expr.liftM T (T x) -> CodeGenFunction r (T (Array D2 x))
forall r. T (T x) -> CodeGenFunction r (T (Array D2 x))
forall a r. C a => T (T a) -> CodeGenFunction r (T (Array D2 a))
arrayFromStereo T (Exp x)
sx)
   T ((), (T a, T b)) (T a, T b)
-> (T a -> ((), (T a, T b))) -> T (T a) (T a, T b)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
   (\T a
a -> ((),(T a
a,T b
forall a. Undefined a => a
Tuple.undef)))


mapAccum ::
   (Expr.Aggregate state statel, Memory.C statel,
    Expr.Aggregate a al, Expr.Aggregate b bl) =>
   (a -> state -> (b, state)) -> state -> Causal.T al bl
mapAccum :: forall state statel a al b bl.
(Aggregate state statel, C statel, Aggregate a al,
 Aggregate b bl) =>
(a -> state -> (b, state)) -> state -> T al bl
mapAccum a -> state -> (b, state)
next state
start =
   (forall r. al -> statel -> CodeGenFunction r (bl, statel))
-> (forall r. CodeGenFunction r statel) -> T al bl
forall state a b.
C state =>
(forall r. a -> state -> CodeGenFunction r (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
Causal.mapAccum
      (\al
a statel
s -> (b, state) -> CodeGenFunction r (bl, statel)
forall r. (b, state) -> CodeGenFunction r (bl, statel)
forall exp mv r. Aggregate exp mv => exp -> CodeGenFunction r mv
Expr.bundle ((b, state) -> CodeGenFunction r (bl, statel))
-> (b, state) -> CodeGenFunction r (bl, statel)
forall a b. (a -> b) -> a -> b
$ a -> state -> (b, state)
next (al -> a
forall exp mv. Aggregate exp mv => mv -> exp
Expr.dissect al
a) (statel -> state
forall exp mv. Aggregate exp mv => mv -> exp
Expr.dissect statel
s))
      (state -> CodeGenFunction r statel
forall r. state -> CodeGenFunction r statel
forall exp mv r. Aggregate exp mv => exp -> CodeGenFunction r mv
Expr.bundle state
start)

fromModifier ::
   (Expr.Aggregate ae al,
    Expr.Aggregate be bl,
    Expr.Aggregate ce cl,
    Expr.Aggregate se sl, Memory.C sl) =>
   Modifier.Simple se ce ae be -> Causal.T (cl,al) bl
fromModifier :: forall ae al be bl ce cl se sl.
(Aggregate ae al, Aggregate be bl, Aggregate ce cl,
 Aggregate se sl, C sl) =>
Simple se ce ae be -> T (cl, al) bl
fromModifier (Modifier.Simple se
initial ce -> ae -> State se be
step) =
   ((ce, ae) -> se -> (be, se)) -> se -> T (cl, al) bl
forall state statel a al b bl.
(Aggregate state statel, C statel, Aggregate a al,
 Aggregate b bl) =>
(a -> state -> (b, state)) -> state -> T al bl
mapAccum (\(ce
c,ae
a) -> State se be -> se -> (be, se)
forall s a. State s a -> s -> (a, s)
MS.runState (ce -> ae -> State se be
step ce
c ae
a)) se
initial


delay1 :: (Expr.Aggregate ae a, Memory.C a) => ae -> Causal.T a a
delay1 :: forall ae a. (Aggregate ae a, C a) => ae -> T a a
delay1 ae
initial  =  ae -> T (a, a) (a, a) -> T a a
forall ce c a b.
(Aggregate ce c, C c) =>
ce -> T (a, c) (b, c) -> T a b
loop ae
initial (((a, a) -> (a, a)) -> T (a, a) (a, a)
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (a, a) -> (a, a)
forall a b. (a, b) -> (b, a)
swap)

differentiate ::
   (A.Additive a, Expr.Aggregate ae a, Memory.C a) => ae -> Causal.T a a
differentiate :: forall a ae. (Additive a, Aggregate ae a, C a) => ae -> T a a
differentiate ae
initial  =  T a a
forall a. T a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id T a a -> T a a -> T a a
forall a. C a => a -> a -> a
- ae -> T a a
forall ae a. (Aggregate ae a, C a) => ae -> T a a
delay1 ae
initial


{- |
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 'A.addToPhase' which supports that.
-}
osciCore, _osciCore, osciCoreSync ::
   (Memory.C t, A.Fraction t) => Causal.T (t, t) t
_osciCore :: forall t. (C t, Fraction t) => T (t, t) t
_osciCore =
   (forall r. t -> t -> CodeGenFunction r t) -> T (t, t) t
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith t -> t -> CodeGenFunction r t
forall r. t -> t -> CodeGenFunction r t
forall a r. Fraction a => a -> a -> CodeGenFunction r a
A.addToPhase T (t, t) t -> T (t, t) (t, t) -> T (t, t) t
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
   T t t -> T (t, t) (t, t)
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second
      ((forall r. t -> t -> CodeGenFunction r (t, t))
-> (forall r. CodeGenFunction r t) -> T t t
forall state a b.
C state =>
(forall r. a -> state -> CodeGenFunction r (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
Causal.mapAccum
         (\t
a t
s -> do
            t
b <- t -> t -> CodeGenFunction r t
forall a r. Fraction a => a -> a -> CodeGenFunction r a
A.incPhase t
a t
s
            (t, t) -> CodeGenFunction r (t, t)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (t
s,t
b))
         (t -> CodeGenFunction r t
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return t
forall a. Additive a => a
A.zero))

{-
This could be implemented using a generalized frequencyModulation,
however, osciCoreSync allows for negative phase differences.
-}
osciCoreSync :: forall t. (C t, Fraction t) => T (t, t) t
osciCoreSync =
   (forall r. t -> t -> CodeGenFunction r t) -> T (t, t) t
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith t -> t -> CodeGenFunction r t
forall r. t -> t -> CodeGenFunction r t
forall a r. Fraction a => a -> a -> CodeGenFunction r a
A.addToPhase T (t, t) t -> T (t, t) (t, t) -> T (t, t) t
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
   T t t -> T (t, t) (t, t)
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second
      ((forall r. t -> t -> CodeGenFunction r (t, t))
-> (forall r. CodeGenFunction r t) -> T t t
forall state a b.
C state =>
(forall r. a -> state -> CodeGenFunction r (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
Causal.mapAccum
         (\t
a t
s -> do
            t
b <- t -> t -> CodeGenFunction r t
forall a r. Fraction a => a -> a -> CodeGenFunction r a
A.incPhase t
a t
s
            (t, t) -> CodeGenFunction r (t, t)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (t
b,t
b))
         (t -> CodeGenFunction r t
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return t
forall a. Additive a => a
A.zero))

osciCore :: forall t. (C t, Fraction t) => T (t, t) t
osciCore =
   (forall r. t -> t -> CodeGenFunction r t) -> T (t, t) t
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith t -> t -> CodeGenFunction r t
forall r. t -> t -> CodeGenFunction r t
forall a r. Fraction a => a -> a -> CodeGenFunction r a
A.addToPhase T (t, t) t -> T (t, t) (t, t) -> T (t, t) t
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
   T t t -> T (t, t) (t, t)
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second (T (t, t) (t, t) -> T t t
forall c a b. (Additive c, C c) => T (a, c) (b, c) -> T a b
loopZero (((t, t) -> t) -> T (t, t) t
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (t, t) -> t
forall a b. (a, b) -> b
snd T (t, t) t -> T (t, t) t -> T (t, t) (t, t)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (forall r. t -> t -> CodeGenFunction r t) -> T (t, t) t
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith t -> t -> CodeGenFunction r t
forall r. t -> t -> CodeGenFunction r t
forall a r. Fraction a => a -> a -> CodeGenFunction r a
A.incPhase))

osci ::
   (Memory.C t, A.Fraction t) =>
   (forall r. t -> LLVM.CodeGenFunction r y) ->
   Causal.T (t, t) y
osci :: forall t y.
(C t, Fraction t) =>
(forall r. t -> CodeGenFunction r y) -> T (t, t) y
osci forall r. t -> CodeGenFunction r y
wave  =  (forall r. t -> CodeGenFunction r y) -> T t y
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
Causal.map t -> CodeGenFunction r y
forall r. t -> CodeGenFunction r y
wave T t y -> T (t, t) t -> T (t, t) y
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< T (t, t) t
forall t. (C t, Fraction t) => T (t, t) t
osciCore

shapeModOsci ::
   (Memory.C t, A.Fraction t) =>
   (forall r. c -> t -> LLVM.CodeGenFunction r y) ->
   Causal.T (c, (t, t)) y
shapeModOsci :: forall t c y.
(C t, Fraction t) =>
(forall r. c -> t -> CodeGenFunction r y) -> T (c, (t, t)) y
shapeModOsci forall r. c -> t -> CodeGenFunction r y
wave  =  (forall r. c -> t -> CodeGenFunction r y) -> T (c, t) y
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith c -> t -> CodeGenFunction r y
forall r. c -> t -> CodeGenFunction r y
wave T (c, t) y -> T (c, (t, t)) (c, t) -> T (c, (t, t)) y
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< T (t, t) t -> T (c, (t, t)) (c, t)
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second T (t, t) t
forall t. (C t, Fraction t) => T (t, t) t
osciCore


{- |
Feeds a signal into a causal process while holding or skipping signal elements
according to the process input.
The skip happens after a value is passed from the fed signal.

@skip x $* 0@ repeats the first signal value in the output.
@skip x $* 1@ feeds the signal to the output as is.
@skip x $* 2@ feeds the signal to the output with double speed.
-}
skip ::
   (Tuple.Undefined a, Tuple.Phi a, Memory.C a) =>
   Sig.T a -> Causal.T (MultiValue.T Word) a
skip :: forall a. (Undefined a, Phi a, C a) => T a -> T (T Word) a
skip (SigPriv.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 global
 -> Value (Ptr local)
 -> T Word
 -> ((a, state), T Word)
 -> T r c (a, ((a, state), T Word)))
-> (forall r. CodeGenFunction r (global, ((a, state), T Word)))
-> (forall r. global -> CodeGenFunction r ())
-> T (T Word) a
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Causal.Cons
   (\global
global Value (Ptr local)
local T Word
n1 ((a, state)
yState0, MultiValue.Cons Repr Word
n0) -> do
      yState1 :: (a, state)
yState1@(a
y,state
_) <-
         CodeGenFunction r (T (a, state)) -> T r c (a, state)
forall z r a. Phi z => CodeGenFunction r (T a) -> T r z a
MaybeCont.fromMaybe (CodeGenFunction r (T (a, state)) -> T r c (a, state))
-> CodeGenFunction r (T (a, state)) -> T r c (a, state)
forall a b. (a -> b) -> a -> b
$ ((Value Word, T (a, state)) -> T (a, state))
-> CodeGenFunction r (Value Word, T (a, state))
-> CodeGenFunction r (T (a, 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 (Value Word, T (a, state)) -> T (a, state)
forall a b. (a, b) -> b
snd (CodeGenFunction r (Value Word, T (a, state))
 -> CodeGenFunction r (T (a, state)))
-> CodeGenFunction r (Value Word, T (a, state))
-> CodeGenFunction r (T (a, state))
forall a b. (a -> b) -> a -> b
$
         Value Word
-> (a, state)
-> ((a, state) -> T r (T (a, state)) (a, state))
-> CodeGenFunction r (Value Word, T (a, state))
forall s i r.
(Phi s, Undefined s, Num i, IsConst i, IsInteger i, CmpRet i,
 IsPrimitive i) =>
Value i
-> s -> (s -> T r (T s) s) -> CodeGenFunction r (Value i, T s)
MaybeCont.fixedLengthLoop Repr Word
Value Word
n0 (a, state)
yState0 (((a, state) -> T r (T (a, state)) (a, state))
 -> CodeGenFunction r (Value Word, T (a, state)))
-> ((a, state) -> T r (T (a, state)) (a, state))
-> CodeGenFunction r (Value Word, T (a, state))
forall a b. (a -> b) -> a -> b
$
         global
-> Value (Ptr local) -> state -> T r (T (a, state)) (a, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next global
global Value (Ptr local)
local (state -> T r (T (a, state)) (a, state))
-> ((a, state) -> state)
-> (a, state)
-> T r (T (a, state)) (a, state)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, state) -> state
forall a b. (a, b) -> b
snd
      (a, ((a, state), T Word)) -> T r c (a, ((a, state), T Word))
forall a. a -> T r c a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
y, ((a, state)
yState1,T Word
n1)))
   ((state -> ((a, state), T Word))
-> (global, state) -> (global, ((a, state), T Word))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (\state
s -> ((a
forall a. Undefined a => a
Tuple.undef, state
s), T Word
forall a. IntegerConstant a => a
A.one)) ((global, state) -> (global, ((a, state), T Word)))
-> CodeGenFunction r (global, state)
-> CodeGenFunction r (global, ((a, state), T Word))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start)
   global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop

frequencyModulation ::
   (Marshal.C a,
    MultiValue.IntegerConstant a,
    MultiValue.Additive a,
    MultiValue.Comparison a,
    Tuple.Undefined nodes, Tuple.Phi nodes, Memory.C nodes) =>
   (forall r. MultiValue.T a -> nodes -> LLVM.CodeGenFunction r v) ->
   SigPriv.T nodes -> Causal.T (MultiValue.T a) v
frequencyModulation :: forall a nodes v.
(C a, IntegerConstant a, Additive a, Comparison a, Undefined nodes,
 Phi nodes, C nodes) =>
(forall r. T a -> nodes -> CodeGenFunction r v)
-> T nodes -> T (T a) v
frequencyModulation forall r. T a -> nodes -> CodeGenFunction r v
ip (SigPriv.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (nodes, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 global
 -> Value (Ptr local)
 -> T a
 -> ((nodes, state), T a)
 -> T r c (v, ((nodes, state), T a)))
-> (forall r. CodeGenFunction r (global, ((nodes, state), T a)))
-> (forall r. global -> CodeGenFunction r ())
-> T (T a) v
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Causal.Cons
   (\global
global Value (Ptr local)
local T a
k ((nodes, state), T a)
yState0 -> do
      ((nodes
nodes2,state
state2), T a
ss2) <-
         CodeGenFunction r (Value Bool, ((nodes, state), T a))
-> T r c ((nodes, state), T a)
forall z r a. Phi z => CodeGenFunction r (Value Bool, a) -> T r z a
MaybeCont.fromBool (CodeGenFunction r (Value Bool, ((nodes, state), T a))
 -> T r c ((nodes, state), T a))
-> CodeGenFunction r (Value Bool, ((nodes, state), T a))
-> T r c ((nodes, state), T a)
forall a b. (a -> b) -> a -> b
$
         (Value Bool, ((nodes, state), T a))
-> ((Value Bool, ((nodes, state), T a))
    -> CodeGenFunction r (Value Bool))
-> ((Value Bool, ((nodes, state), T a))
    -> CodeGenFunction r (Value Bool, ((nodes, state), T a)))
-> CodeGenFunction r (Value Bool, ((nodes, state), T a))
forall a r.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool))
-> (a -> CodeGenFunction r a)
-> CodeGenFunction r a
C.whileLoop
            (Bool -> Value Bool
forall a. IsConst a => a -> Value a
LLVM.valueOf Bool
True, ((nodes, state), T a)
yState0)
            (\(Value Bool
cont0, ((nodes, state)
_, T a
ss0)) ->
               Value Bool
-> Value Bool -> CodeGenFunction r (BinOpValue Value Value Bool)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.and Value Bool
cont0 (Value Bool -> CodeGenFunction r (Value Bool))
-> (T Bool -> Value Bool)
-> T Bool
-> CodeGenFunction r (Value Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Bool -> Value Bool
unbool (T Bool -> CodeGenFunction r (Value Bool))
-> CodeGenFunction r (T Bool) -> CodeGenFunction r (Value Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmpPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
forall r. CmpPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
forall a r.
Comparison a =>
CmpPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
MultiValue.cmp CmpPredicate
LLVM.CmpGE T a
ss0 T a
forall a. IntegerConstant a => a
A.one)
            (\(Value Bool
_,((nodes
_,state
state0), T a
ss0)) ->
               T r (Value Bool, ((nodes, state), T a)) ((nodes, state), T a)
-> CodeGenFunction r (Value Bool, ((nodes, state), T a))
forall a r.
Undefined a =>
T r (Value Bool, a) a -> CodeGenFunction r (Value Bool, a)
MaybeCont.toBool (T r (Value Bool, ((nodes, state), T a)) ((nodes, state), T a)
 -> CodeGenFunction r (Value Bool, ((nodes, state), T a)))
-> T r (Value Bool, ((nodes, state), T a)) ((nodes, state), T a)
-> CodeGenFunction r (Value Bool, ((nodes, state), T a))
forall a b. (a -> b) -> a -> b
$ ((nodes, state) -> T a -> ((nodes, state), T a))
-> T r (Value Bool, ((nodes, state), T a)) (nodes, state)
-> T r (Value Bool, ((nodes, state), T a)) (T a)
-> T r (Value Bool, ((nodes, state), T a)) ((nodes, state), T a)
forall a b c.
(a -> b -> c)
-> T r (Value Bool, ((nodes, state), T a)) a
-> T r (Value Bool, ((nodes, state), T a)) b
-> T r (Value Bool, ((nodes, state), T a)) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)
                  (global
-> Value (Ptr local)
-> state
-> T r (Value Bool, ((nodes, state), T a)) (nodes, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (nodes, state)
next global
global Value (Ptr local)
local state
state0)
                  (CodeGenFunction r (T a)
-> T r (Value Bool, ((nodes, state), T a)) (T a)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (T a)
 -> T r (Value Bool, ((nodes, state), T a)) (T a))
-> CodeGenFunction r (T a)
-> T r (Value Bool, ((nodes, state), T a)) (T a)
forall a b. (a -> b) -> a -> b
$ T a -> T a -> CodeGenFunction r (T a)
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r. T a -> T a -> CodeGenFunction r (T a)
A.sub T a
ss0 T a
forall a. IntegerConstant a => a
A.one))

      CodeGenFunction r (v, ((nodes, state), T a))
-> T r c (v, ((nodes, state), T a))
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (v, ((nodes, state), T a))
 -> T r c (v, ((nodes, state), T a)))
-> CodeGenFunction r (v, ((nodes, state), T a))
-> T r c (v, ((nodes, state), T a))
forall a b. (a -> b) -> a -> b
$ do
         v
y <- T a -> nodes -> CodeGenFunction r v
forall r. T a -> nodes -> CodeGenFunction r v
ip T a
ss2 nodes
nodes2
         T a
ss3 <- T a -> T a -> CodeGenFunction r (T a)
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r. T a -> T a -> CodeGenFunction r (T a)
A.add T a
ss2 T a
k
         (v, ((nodes, state), T a))
-> CodeGenFunction r (v, ((nodes, state), T a))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (v
y, ((nodes
nodes2, state
state2), T a
ss3)))
   (((global, state) -> (global, ((nodes, state), T a)))
-> CodeGenFunction r (global, state)
-> CodeGenFunction r (global, ((nodes, state), T a))
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(global
global,state
sa) -> (global
global, ((nodes
forall a. Undefined a => a
Tuple.undef, state
sa), T a
forall a. IntegerConstant a => a
A.one))) CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start)
   global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop

frequencyModulationLinear ::
   (MultiValue.PseudoRing a, MultiValue.IntegerConstant a,
    MultiValue.Comparison a, Marshal.C a) =>
   Sig.MV a -> MV a a
frequencyModulationLinear :: forall a.
(PseudoRing a, IntegerConstant a, Comparison a, C a) =>
MV a -> MV a a
frequencyModulationLinear MV a
sig =
   (forall r. T a -> Nodes02 (T a) -> CodeGenFunction r (T a))
-> T (Nodes02 (T a)) -> T (T a) (T a)
forall a nodes v.
(C a, IntegerConstant a, Additive a, Comparison a, Undefined nodes,
 Phi nodes, C nodes) =>
(forall r. T a -> nodes -> CodeGenFunction r v)
-> T nodes -> T (T a) v
frequencyModulation T r Nodes02 (T a) (T a)
forall r. T a -> Nodes02 (T a) -> CodeGenFunction r (T a)
forall a r. (PseudoRing a, IntegerConstant a) => T r Nodes02 a a
Interpolation.linear (MV a -> T (Nodes02 (T a))
forall a. C a => T a -> T (Nodes02 a)
Sig.adjacentNodes02 MV a
sig)


track ::
   (Expr.Aggregate ae al, Memory.C al) =>
   ae -> Exp Word -> Causal.T al (RingBuffer.T al)
track :: forall ae al.
(Aggregate ae al, C al) =>
ae -> Exp Word -> T al (T al)
track ae
initial Exp Word
time = (forall r c.
 Phi c =>
 (Value Word, Value (Ptr (Struct al)))
 -> Value (Ptr (Struct ()))
 -> al
 -> Value Word
 -> T r c (T al, Value Word))
-> (forall r.
    CodeGenFunction
      r ((Value Word, Value (Ptr (Struct al))), Value Word))
-> (forall r.
    (Value Word, Value (Ptr (Struct al))) -> CodeGenFunction r ())
-> T al (T al)
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Causal.Cons
   (\(Value Word
size0,Value (Ptr (Struct al))
ptr) -> (al -> Value Word -> T r c (T al, Value Word))
-> Value (Ptr (Struct ()))
-> al
-> Value Word
-> T r c (T al, Value Word)
forall f. f -> Value (Ptr (Struct ())) -> f
noLocalPtr ((al -> Value Word -> T r c (T al, Value Word))
 -> Value (Ptr (Struct ()))
 -> al
 -> Value Word
 -> T r c (T al, Value Word))
-> (al -> Value Word -> T r c (T al, Value Word))
-> Value (Ptr (Struct ()))
-> al
-> Value Word
-> T r c (T al, Value Word)
forall a b. (a -> b) -> a -> b
$ \al
a Value Word
remain0 -> CodeGenFunction r (T al, Value Word) -> T r c (T al, Value Word)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (T al, Value Word) -> T r c (T al, Value Word))
-> CodeGenFunction r (T al, Value Word) -> T r c (T al, Value Word)
forall a b. (a -> b) -> a -> b
$ do
      al -> Value (Ptr (Struct al)) -> CodeGenFunction r ()
forall r. al -> Value (Ptr (Struct al)) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store al
a (Value (Ptr (Struct al)) -> CodeGenFunction r ())
-> CodeGenFunction r (Value (Ptr (Struct al)))
-> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr (Struct al))
-> (Value Word, ())
-> CodeGenFunction r (Value (Ptr (ElementPtrType (Struct al) ())))
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 (Struct al))
ptr (Value Word
remain0, ())
      Value Bool
cont <- 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.CmpGT Value Word
remain0 Value Word
forall a. Additive a => a
A.zero
      Value Word
remain1 <- Value Bool
-> Value Word
-> CodeGenFunction r (Value Word)
-> CodeGenFunction r (Value Word)
forall a r.
Select a =>
Value Bool -> a -> CodeGenFunction r a -> CodeGenFunction r a
C.ifThenSelect Value Bool
cont Value Word
size0 (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
remain0)
      Value Word
size1 <- Value Word -> CodeGenFunction r (Value Word)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
A.inc Value Word
size0
      (T al, Value Word) -> CodeGenFunction r (T al, Value Word)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (Ptr (Struct al))
-> Value Word -> Value Word -> Value Word -> T al
forall a.
Value (MemoryPtr a)
-> Value Word -> Value Word -> Value Word -> T a
RingBuffer.Cons Value (Ptr (Struct al))
ptr Value Word
size1 Value Word
remain0 Value Word
remain1, Value Word
remain1))
   (do
      MultiValue.Cons Repr Word
size0 <- Exp Word -> forall r. CodeGenFunction r (T Word)
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp Exp Word
time
      Value Word
size1 <- Value Word -> CodeGenFunction r (Value Word)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
A.inc Repr Word
Value Word
size0
      Value (Ptr (Struct al))
ptr <- Value Word -> CodeGenFunction r (Value (Ptr (Struct al)))
forall a r s.
(IsSized a, AllocArg s) =>
s -> CodeGenFunction r (Value (Ptr a))
LLVM.arrayMalloc Value Word
size1
      al
a <- ae -> CodeGenFunction r al
forall r. ae -> CodeGenFunction r al
forall exp mv r. Aggregate exp mv => exp -> CodeGenFunction r mv
Expr.bundle ae
initial
      -- cf. LLVM.Storable.Signal.fill
      Value Word
-> Value (Ptr (Struct al))
-> ()
-> (Value (Ptr (Struct al)) -> () -> CodeGenFunction r ())
-> CodeGenFunction r ()
forall a b i r.
(Phi a, IsType b, Num i, IsConst i, IsInteger i, CmpRet i,
 IsPrimitive i) =>
Value i
-> Value (Ptr b)
-> a
-> (Value (Ptr b) -> a -> CodeGenFunction r a)
-> CodeGenFunction r a
C.arrayLoop Value Word
size1 Value (Ptr (Struct al))
ptr () ((Value (Ptr (Struct al)) -> () -> CodeGenFunction r ())
 -> CodeGenFunction r ())
-> (Value (Ptr (Struct al)) -> () -> CodeGenFunction r ())
-> CodeGenFunction r ()
forall a b. (a -> b) -> a -> b
$ \ Value (Ptr (Struct al))
ptri () -> al -> Value (Ptr (Struct al)) -> CodeGenFunction r ()
forall r. al -> Value (Ptr (Struct al)) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store al
a Value (Ptr (Struct al))
ptri
      ((Value Word, Value (Ptr (Struct al))), Value Word)
-> CodeGenFunction
     r ((Value Word, Value (Ptr (Struct al))), Value Word)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Repr Word
Value Word
size0,Value (Ptr (Struct al))
ptr), Repr Word
Value Word
size0))
   (Value (Ptr (Struct al)) -> CodeGenFunction r ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free (Value (Ptr (Struct al)) -> CodeGenFunction r ())
-> ((Value Word, Value (Ptr (Struct al)))
    -> Value (Ptr (Struct al)))
-> (Value Word, Value (Ptr (Struct al)))
-> CodeGenFunction r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value Word, Value (Ptr (Struct al))) -> Value (Ptr (Struct al))
forall a b. (a, b) -> b
snd)

{- |
Delay time must be non-negative.
-}
delay ::
   (Expr.Aggregate ae al, Memory.C al) =>
   ae -> Exp Word -> Causal.T al al
delay :: forall ae al. (Aggregate ae al, C al) => ae -> Exp Word -> T al al
delay ae
initial Exp Word
time = (forall r. T al -> CodeGenFunction r al) -> T (T al) al
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
Causal.map T al -> CodeGenFunction r al
forall r. T al -> CodeGenFunction r al
forall a r. C a => T a -> CodeGenFunction r a
RingBuffer.oldest T (T al) al -> T al (T al) -> T al al
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< ae -> Exp Word -> T al (T al)
forall ae al.
(Aggregate ae al, C al) =>
ae -> Exp Word -> T al (T al)
track ae
initial Exp Word
time

delayZero ::
   (Expr.Aggregate ae al, Additive.C ae, Memory.C al) =>
   Exp Word -> Causal.T al al
delayZero :: forall ae al. (Aggregate ae al, C ae, C al) => Exp Word -> T al al
delayZero = ae -> Exp Word -> T al al
forall ae al. (Aggregate ae al, C al) => ae -> Exp Word -> T al al
delay ae
forall a. C a => a
zero

{- |
Delay time must be greater than zero!
-}
comb ::
   (Marshal.C a, MultiValue.PseudoRing a) =>
   Exp a -> Exp Word -> MV a a
comb :: forall a. (C a, PseudoRing a) => Exp a -> Exp Word -> MV a a
comb Exp a
gain Exp Word
time =
   T (T a, T a) (T a, T a) -> T (T a) (T a)
forall c a b. (Additive c, C c) => T (a, c) (b, c) -> T a b
loopZero (T (T a, T a) (T a)
forall a. Additive a => T (a, a) a
mix T (T a, T a) (T a) -> T (T a) (T a, T a) -> T (T a, T a) (T a, T a)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (T (T a) (T a)
forall a. T a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id T (T a) (T a) -> T (T a) (T a) -> T (T a) (T a, T a)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Exp Word -> T (T a) (T a)
forall ae al. (Aggregate ae al, C ae, C al) => Exp Word -> T al al
delayZero (Exp Word
timeExp Word -> Exp Word -> Exp Word
forall a. C a => a -> a -> a
-Exp Word
1) T (T a) (T a) -> T (T a) (T a) -> T (T a) (T a)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Exp a -> T (T a) (T a)
forall ea a. (Aggregate ea a, C a, PseudoRing a) => ea -> T a a
amplify Exp a
gain)))

combStereo ::
   (Marshal.C a, MultiValue.PseudoRing a, Stereo.T (MultiValue.T a) ~ stereo) =>
   Exp a -> Exp Word -> Causal.T stereo stereo
combStereo :: forall a stereo.
(C a, PseudoRing a, T (T a) ~ stereo) =>
Exp a -> Exp Word -> T stereo stereo
combStereo Exp a
gain Exp Word
time =
   T (stereo, stereo) (stereo, stereo) -> T stereo stereo
forall c a b. (Additive c, C c) => T (a, c) (b, c) -> T a b
loopZero (T (stereo, stereo) stereo
forall a. Additive a => T (a, a) a
mix T (stereo, stereo) stereo
-> T stereo (stereo, stereo) -> T (stereo, stereo) (stereo, stereo)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (T stereo stereo
forall a. T a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id T stereo stereo -> T stereo stereo -> T stereo (stereo, stereo)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Exp Word -> T stereo stereo
forall ae al. (Aggregate ae al, C ae, C al) => Exp Word -> T al al
delayZero (Exp Word
timeExp Word -> Exp Word -> Exp Word
forall a. C a => a -> a -> a
-Exp Word
1) T stereo stereo -> T stereo stereo -> T stereo stereo
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Exp a -> T stereo stereo
forall a stereo.
(C a, PseudoRing a, T (T a) ~ stereo) =>
Exp a -> T stereo stereo
amplifyStereo Exp a
gain)))

reverbExplicit ::
   (TypeNum.Natural n, (n TypeNum.:*: LLVM.UnknownSize) ~ paramSize,
    TypeNum.Natural paramSize) =>
   (Marshal.C a,
    MultiValue.Field a, MultiValue.Real a, MultiValue.IntegerConstant a) =>
   Exp (MultiValue.Array n (a,Word)) -> MV a a
reverbExplicit :: forall n paramSize a.
(Natural n, (n :*: UnknownSize) ~ paramSize, Natural paramSize,
 C a, Field a, Real a, IntegerConstant a) =>
Exp (Array n (a, Word)) -> MV a a
reverbExplicit Exp (Array n (a, Word))
params =
   Exp a -> T (T a) (T a)
forall ea a. (Aggregate ea a, C a, PseudoRing a) => ea -> T a a
amplify (Exp a -> Exp a
forall a. (Field a, IntegerConstant a) => Exp a -> Exp a
Expr.recip (Exp a -> Exp a) -> Exp a -> Exp a
forall a b. (a -> b) -> a -> b
$ Proxy n -> Exp a
forall n a. (Integer n, Num a) => Proxy n -> a
TypeNum.integralFromProxy (Proxy n -> Exp a) -> Proxy n -> Exp a
forall a b. (a -> b) -> a -> b
$ Exp (Array n (a, Word)) -> Proxy n
forall (value :: * -> *) (array :: * -> * -> *) n a.
value (array n a) -> Proxy n
arraySize Exp (Array n (a, Word))
params)
   T (T a) (T a) -> T (T a) (T a) -> T (T a) (T a)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
   (Exp (a, Word) -> T (T a, T a) (T a))
-> Exp (Array n (a, Word)) -> T (T a, T a) (T a)
forall n a b bSize c.
(Natural n, Undefined a, Phi a, C b,
 (n :*: SizeOf (Struct b)) ~ bSize, Natural bSize) =>
(Exp b -> T (c, a) a) -> Exp (Array n b) -> T (c, a) a
replicateControlledParam
      (\Exp (a, Word)
p -> T (T a) (T a) -> T (T a, T a) (T a, T a)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arrow.first (Exp a -> Exp Word -> T (T a) (T a)
forall a. (C a, PseudoRing a) => Exp a -> Exp Word -> MV a a
comb (Exp (a, Word) -> Exp a
forall (val :: * -> *) a b. Value val => val (a, b) -> val a
Expr.fst Exp (a, Word)
p) (Exp (a, Word) -> Exp Word
forall (val :: * -> *) a b. Value val => val (a, b) -> val b
Expr.snd Exp (a, Word)
p)) T (T a, T a) (T a, T a) -> T (T a, T a) (T a) -> T (T a, T a) (T a)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> T (T a, T a) (T a)
forall a. Additive a => T (a, a) a
mix)
      Exp (Array n (a, Word))
params
   T (T a, T a) (T a) -> (T a -> (T a, T a)) -> T (T a) (T a)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
   (\T a
a -> (T a
a,T a
a))

reverbParams ::
   (RandomGen g, TypeNum.Integer n, Random a) =>
   g -> Proxy n -> (a,a) -> (Word, Word) -> MultiValue.Array n (a, Word)
reverbParams :: forall g n a.
(RandomGen g, Integer n, Random a) =>
g -> Proxy n -> (a, a) -> (Word, Word) -> Array n (a, Word)
reverbParams g
rnd Proxy n
Proxy (a, a)
gainRange (Word, Word)
timeRange =
   (State g (Array n (a, Word)) -> g -> Array n (a, Word))
-> g -> State g (Array n (a, Word)) -> Array n (a, Word)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State g (Array n (a, Word)) -> g -> Array n (a, Word)
forall s a. State s a -> s -> a
MS.evalState g
rnd (State g (Array n (a, Word)) -> Array n (a, Word))
-> State g (Array n (a, Word)) -> Array n (a, Word)
forall a b. (a -> b) -> a -> b
$
   Array n (StateT g Identity (a, Word))
-> State g (Array n (a, Word))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Array n (f a) -> f (Array n a)
sequenceA (Array n (StateT g Identity (a, Word))
 -> State g (Array n (a, Word)))
-> Array n (StateT g Identity (a, Word))
-> State g (Array n (a, Word))
forall a b. (a -> b) -> a -> b
$ StateT g Identity (a, Word)
-> Array n (StateT g Identity (a, Word))
forall a. a -> Array n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateT g Identity (a, Word)
 -> Array n (StateT g Identity (a, Word)))
-> StateT g Identity (a, Word)
-> Array n (StateT g Identity (a, Word))
forall a b. (a -> b) -> a -> b
$
   (a -> Word -> (a, Word))
-> StateT g Identity a
-> StateT g Identity Word
-> StateT g Identity (a, Word)
forall a b c.
(a -> b -> c)
-> StateT g Identity a
-> StateT g Identity b
-> StateT g Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)
      ((g -> (a, g)) -> StateT g Identity a
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state ((a, a) -> g -> (a, g)
forall g. RandomGen g => (a, a) -> g -> (a, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (a, a)
gainRange))
      ((g -> (Word, g)) -> StateT g Identity Word
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state ((Word, Word) -> g -> (Word, g)
forall g. RandomGen g => (Word, Word) -> g -> (Word, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Word, Word)
timeRange))


{- |
Delay by a variable amount of samples.
The momentum delay must be between @0@ and @maxTime@, inclusively.
How about automated clipping?
-}
delayControlled ::
   (Expr.Aggregate ae al, Memory.C al) =>
   ae -> Exp Word -> Causal.T (MultiValue.T Word, al) al
delayControlled :: forall ae al.
(Aggregate ae al, C al) =>
ae -> Exp Word -> T (T Word, al) al
delayControlled ae
initial Exp Word
maxTime =
   (forall r. Value Word -> T al -> CodeGenFunction r al)
-> T (Value Word, T al) al
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith Value Word -> T al -> CodeGenFunction r al
forall r. Value Word -> T al -> CodeGenFunction r al
forall a r. C a => Value Word -> T a -> CodeGenFunction r a
RingBuffer.index
   T (Value Word, T al) al
-> T (T Word, al) (Value Word, T al) -> T (T Word, al) al
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
   (T Word -> Value Word) -> T (T Word) (Value Word)
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(MultiValue.Cons Repr Word
i) -> Repr Word
Value Word
i) T (T Word) (Value Word)
-> T al (T al) -> T (T Word, al) (Value Word, T al)
forall b c b' c'. T b c -> T b' c' -> T (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ae -> Exp Word -> T al (T al)
forall ae al.
(Aggregate ae al, C al) =>
ae -> Exp Word -> T al (T al)
track ae
initial Exp Word
maxTime

{- |
Delay by a variable fractional amount of samples.
Non-integer delays are achieved by interpolation.
The momentum delay must be between @0@ and @maxTime@, inclusively.
-}
delayControlledInterpolated ::
   (Interpolation.C nodes) =>
   (MultiValue.T a ~ am) =>
   (MultiValue.NativeFloating a ar, MultiValue.Additive a) =>
   (Expr.Aggregate ve v, Memory.C v) =>
   (forall r. Interpolation.T r nodes am v) ->
   ve -> Exp Word -> Causal.T (am, v) v
delayControlledInterpolated :: forall (nodes :: * -> *) a am ar ve v.
(C nodes, T a ~ am, NativeFloating a ar, Additive a,
 Aggregate ve v, C v) =>
(forall r. T r nodes am v) -> ve -> Exp Word -> T (am, v) v
delayControlledInterpolated forall r. T r nodes am v
ip ve
initial Exp Word
maxTime =
   let margin :: Margin (nodes v)
margin = (forall r. T r nodes (T a) v) -> Margin (nodes v)
forall (nodes :: * -> *) a v.
C nodes =>
(forall r. T r nodes a v) -> Margin (nodes v)
Interpolation.toMargin T r nodes am v
T a -> nodes v -> CodeGenFunction r v
forall r. T r nodes am v
forall r. T r nodes (T a) v
ip
   in (forall r. am -> T v -> CodeGenFunction r v) -> T (am, T v) v
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith
         (\am
del T v
buf -> do
            let offset :: T Word
offset =
                  Integer -> T Word
forall a. IntegerConstant a => Integer -> a
A.fromInteger' (Integer -> T Word) -> Integer -> T Word
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$
                  Margin (nodes v) -> Int
forall nodes. Margin nodes -> Int
Interpolation.marginOffset Margin (nodes v)
margin
            T Word
n <- T Word -> T Word -> CodeGenFunction r (T Word)
forall a r. Real a => a -> a -> CodeGenFunction r a
forall r. T Word -> T Word -> CodeGenFunction r (T Word)
A.max T Word
offset (T Word -> CodeGenFunction r (T Word))
-> CodeGenFunction r (T Word) -> CodeGenFunction r (T Word)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< T a -> CodeGenFunction r (T Word)
forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar) =>
T a -> CodeGenFunction r (T i)
MultiValue.truncateToInt am
T a
del
            am
k <- am -> am -> CodeGenFunction r am
forall r. am -> am -> CodeGenFunction r am
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.sub am
del (am -> CodeGenFunction r am)
-> CodeGenFunction r am -> CodeGenFunction r am
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< T Word -> CodeGenFunction r (T a)
forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar) =>
T i -> CodeGenFunction r (T a)
MultiValue.fromIntegral T Word
n
            ~(MultiValue.Cons Repr Word
m) <- T Word -> T Word -> CodeGenFunction r (T Word)
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r. T Word -> T Word -> CodeGenFunction r (T Word)
A.sub T Word
n (T Word
offset :: MultiValue.T Word)
            T r nodes am v
forall r. T r nodes am v
ip am
k (nodes v -> CodeGenFunction r v)
-> CodeGenFunction r (nodes v) -> CodeGenFunction r v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
               (Value Word -> CodeGenFunction r v)
-> Value Word -> Value Word -> CodeGenFunction r (nodes v)
forall (nodes :: * -> *) r v.
C nodes =>
(Value Word -> CodeGenFunction r v)
-> Value Word -> Value Word -> CodeGenFunction r (nodes v)
Interpolation.indexNodes ((Value Word -> T v -> CodeGenFunction r v)
-> T v -> Value Word -> CodeGenFunction r v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value Word -> T v -> CodeGenFunction r v
forall a r. C a => Value Word -> T a -> CodeGenFunction r a
RingBuffer.index T v
buf) Value Word
forall a. IntegerConstant a => a
A.one Repr Word
Value Word
m)
      T (am, T v) v -> T (am, v) (am, T v) -> T (am, v) v
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
      T v (T v) -> T (am, v) (am, T v)
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second
         (ve -> Exp Word -> T v (T v)
forall ae al.
(Aggregate ae al, C al) =>
ae -> Exp Word -> T al (T al)
track ve
initial
             (Int -> Exp Word
forall a b. (C a, C b) => a -> b
fromIntegral (Margin (nodes v) -> Int
forall nodes. Margin nodes -> Int
Interpolation.marginNumber Margin (nodes v)
margin) Exp Word -> Exp Word -> Exp Word
forall a. C a => a -> a -> a
+ Exp Word
maxTime))


{- |
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 the 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 ::
   (TypeNum.Positive n, MultiVector.C x,
    v ~ MultiVector.T n x,
    a ~ MultiValue.T x,
    Tuple.Zero v, Memory.C v) =>
   Causal.T v v -> Causal.T a a
pipeline :: forall n x v a.
(Positive n, C x, v ~ T n x, a ~ T x, Zero v, C v) =>
T v v -> T a a
pipeline T v v
vectorProcess =
   T n x -> T (a, T n x) (a, T n x) -> T a a
forall c a b. C c => c -> T (a, c) (b, c) -> T a b
loopConst T n x
forall a n. (C a, Positive n) => T n a
forall n. Positive n => T n x
MultiVector.zero (T (a, T n x) (a, T n x) -> T a a)
-> T (a, T n x) (a, T n x) -> T a a
forall a b. (a -> b) -> a -> b
$
      (forall r. (a, T n x) -> CodeGenFunction r (a, v))
-> T (a, T n x) (a, v)
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
Causal.map ((a -> T n x -> CodeGenFunction r (a, v))
-> (a, T n x) -> CodeGenFunction r (a, v)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> T n x -> CodeGenFunction r (a, v)
T x -> T n x -> CodeGenFunction r (T x, T n x)
forall n a r.
(Positive n, C a) =>
T a -> T n a -> CodeGenFunction r (T a, T n a)
MultiVector.shiftUp)
      T (a, T n x) (a, v)
-> T (a, v) (a, T n x) -> T (a, T n x) (a, T n x)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      T v (T n x) -> T (a, v) (a, T n x)
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second T v v
T v (T n x)
vectorProcess


{-
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.
-}
vectorize ::
   (TypeNum.Positive n,
    MultiVector.C x, MultiValue.T x ~ a, MultiVector.T n x ~ va,
    MultiVector.C y, MultiValue.T y ~ b, MultiVector.T n y ~ vb) =>
   Causal.T a b -> Causal.T va vb
vectorize :: forall n x a va y b vb.
(Positive n, C x, T x ~ a, T n x ~ va, C y, T y ~ b, T n y ~ vb) =>
T a b -> T va vb
vectorize T a b
proc =
   (Singleton n -> T va vb) -> T va vb
forall n a v (f :: * -> *).
(Positive n, T n a ~ v) =>
(Singleton n -> f v) -> f v
withSize ((Singleton n -> T va vb) -> T va vb)
-> (Singleton n -> T va vb) -> T va vb
forall a b. (a -> b) -> a -> b
$ \Singleton n
n ->
      (T va vb -> Int -> T va vb) -> T va vb -> [Int] -> T va vb
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
         (\T va vb
acc Int
i -> Int -> T a b -> T va vb -> T va vb
forall n x a va y b vb.
(Positive n, C x, T x ~ a, T n x ~ va, C y, T y ~ b, T n y ~ vb) =>
Int -> T a b -> T va vb -> T va vb
replaceChannel Int
i T a b
proc T va vb
acc)
         ((va -> vb) -> T va vb
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (vb -> va -> vb
forall a b. a -> b -> a
const vb
forall a. Undefined a => a
Tuple.undef)) ([Int] -> T va vb) -> [Int] -> T va vb
forall a b. (a -> b) -> a -> b
$
      Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
List.take (Singleton n -> Int
forall n a. (Integer n, Num a) => Singleton n -> a
TypeNum.integralFromSingleton Singleton n
n) [Int
0 ..]

withSize ::
   (TypeNum.Positive n, MultiVector.T n a ~ v) =>
   (TypeNum.Singleton n -> f v) ->
   f v
withSize :: forall n a v (f :: * -> *).
(Positive n, T n a ~ v) =>
(Singleton n -> f v) -> f v
withSize Singleton n -> f v
f = Singleton n -> f v
f Singleton n
forall x. Integer x => Singleton x
TypeNum.singleton

{- |
Given a vector process, replace the i-th output by output
that is generated by a scalar process from the i-th input.
-}
replaceChannel ::
   (TypeNum.Positive n,
    MultiVector.C x, MultiValue.T x ~ a, MultiVector.T n x ~ va,
    MultiVector.C y, MultiValue.T y ~ b, MultiVector.T n y ~ vb) =>
   Int -> Causal.T a b -> Causal.T va vb -> Causal.T va vb
replaceChannel :: forall n x a va y b vb.
(Positive n, C x, T x ~ a, T n x ~ va, C y, T y ~ b, T n y ~ vb) =>
Int -> T a b -> T va vb -> T va vb
replaceChannel Int
i T a b
channel T va vb
proc =
   let li :: Value Word32
li = Word32 -> Value Word32
forall a. IsConst a => a -> Value a
LLVM.valueOf (Word32 -> Value Word32) -> Word32 -> Value Word32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (C a, C b) => a -> b
fromIntegral Int
i
   in (forall r. b -> vb -> CodeGenFunction r vb) -> T (b, vb) vb
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith (Value Word32 -> T y -> T n y -> CodeGenFunction r (T n y)
forall a n r.
(C a, Positive n) =>
Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a)
forall n r.
Positive n =>
Value Word32 -> T y -> T n y -> CodeGenFunction r (T n y)
MultiVector.insert Value Word32
li) T (b, vb) vb -> T va (b, vb) -> T va vb
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
         (T a b
channel T a b -> T va a -> T va b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< (forall r. va -> CodeGenFunction r a) -> T va a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
Causal.map (Value Word32 -> T n x -> CodeGenFunction r (T x)
forall a n r.
(C a, Positive n) =>
Value Word32 -> T n a -> CodeGenFunction r (T a)
forall n r.
Positive n =>
Value Word32 -> T n x -> CodeGenFunction r (T x)
MultiVector.extract Value Word32
li)) T va b -> T va vb -> T va (b, vb)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
         T va vb
proc


{- |
Read the i-th element from each array.
-}
arrayElement ::
   (Marshal.C a, Marshal.Struct a ~ aStruct, LLVM.IsFirstClass aStruct,
    TypeNum.Natural i, TypeNum.Natural n, i :<: n) =>
   Proxy i -> Causal.T (MultiValue.T (MultiValue.Array n a)) (MultiValue.T a)
arrayElement :: forall a aStruct i n.
(C a, Struct a ~ aStruct, IsFirstClass aStruct, Natural i,
 Natural n, i :<: n) =>
Proxy i -> T (T (Array n a)) (T a)
arrayElement Proxy i
i = (forall r. T (Array n a) -> CodeGenFunction r (T a))
-> T (T (Array n a)) (T a)
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
Causal.map (Proxy i -> T (Array n a) -> CodeGenFunction r (T a)
forall n i a r.
(Natural n, ArrayIndex n i, C a) =>
i -> T (Array n a) -> CodeGenFunction r (T a)
MultiValue.extractArrayValue Proxy i
i)


{- |
@trigger fill signal@ sends @signal@ to the output
and restarts it whenever the process input is 'Just'.
Before the Arrow.first occurrence of 'Just'
and between instances of the signal the output is filled with 'Maybe.nothing'.
-}
trigger ::
   (Marshal.C a, Tuple.Undefined b, Tuple.Phi b) =>
   (Exp a -> Sig.T b) ->
   Causal.T (Maybe.T (MultiValue.T a)) (Maybe.T b)
trigger :: forall a b.
(C a, Undefined b, Phi b) =>
(Exp a -> T b) -> T (T (T a)) (T b)
trigger Exp a -> T b
f = IO (T (T (T a)) (T b)) -> T (T (T a)) (T b)
forall a. IO a -> a
Unsafe.performIO (IO (T (T (T a)) (T b)) -> T (T (T a)) (T b))
-> IO (T (T (T a)) (T b)) -> T (T (T a)) (T b)
forall a b. (a -> b) -> a -> b
$ do
   T (T a) () b
paramd <-
      String -> (Exp a -> T () b) -> IO (T (T a) () b)
forall p a b. String -> (Exp p -> T a b) -> IO (T (T p) a b)
Parameterized.fromProcess String
"Causal.trigger" (SignalOf T b -> T () b
T b -> T () b
forall b a. SignalOf T b -> T a b
forall (process :: * -> * -> *) b a.
C process =>
SignalOf process b -> process a b
CausalClass.fromSignal (T b -> T () b) -> (Exp a -> T b) -> Exp a -> T () b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp a -> T b
f)
   T (T (T a)) (T b) -> IO (T (T (T a)) (T b))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (T (T (T a)) (T b) -> IO (T (T (T a)) (T b)))
-> T (T (T a)) (T b) -> IO (T (T (T a)) (T b))
forall a b. (a -> b) -> a -> b
$
      case T (T a) () b
paramd of
         Parameterized.Cons forall r c.
Phi c =>
T a
-> global -> Value (Ptr local) -> () -> state -> T r c (b, state)
next forall r. T a -> CodeGenFunction r (global, state)
start forall r. T a -> global -> CodeGenFunction r ()
stop -> (forall r c.
 Phi c =>
 Value
   (Ptr
      (Struct
         (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
 -> Value (Ptr local) -> T (T a) -> T state -> T r c (T b, T state))
-> (forall r.
    CodeGenFunction
      r
      (Value
         (Ptr
            (Struct
               (Bool, (Struct (Struct (Repr a), (Struct global, ())), ())))),
       T state))
-> (forall r.
    Value
      (Ptr
         (Struct
            (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
    -> CodeGenFunction r ())
-> T (T (T a)) (T b)
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Causal.Cons
            (\Value
  (Ptr
     (Struct
        (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
globalPtr Value (Ptr local)
local T (T a)
ma T state
ms0 -> CodeGenFunction r (T b, T state) -> T r c (T b, T state)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (T b, T state) -> T r c (T b, T state))
-> CodeGenFunction r (T b, T state) -> T r c (T b, T state)
forall a b. (a -> b) -> a -> b
$ do
               T state
ms1 <-
                  T (T a)
-> CodeGenFunction r (T state)
-> (T a -> CodeGenFunction r (T state))
-> CodeGenFunction r (T state)
forall b a r.
Phi b =>
T a
-> CodeGenFunction r b
-> (a -> CodeGenFunction r b)
-> CodeGenFunction r b
Maybe.run T (T a)
ma
                     (T state -> CodeGenFunction r (T state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return T state
ms0)
                     (\T a
a -> do
                        (T a -> global -> CodeGenFunction r ())
-> Value (Ptr (Struct (T (T a, global)))) -> CodeGenFunction r ()
forall global am r.
(C global, C am) =>
(am -> global -> CodeGenFunction r ())
-> Value (Ptr (Struct (T (am, global)))) -> CodeGenFunction r ()
stopAndFree T a -> global -> CodeGenFunction r ()
forall r. T a -> global -> CodeGenFunction r ()
stop Value (Ptr (Struct (T (T a, global))))
Value
  (Ptr
     (Struct
        (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
globalPtr
                        (global
global2,state
state2) <- T a -> CodeGenFunction r (global, state)
forall r. T a -> CodeGenFunction r (global, state)
start T a
a
                        T (T a, global)
-> Value (Ptr (Struct (T (T a, global)))) -> CodeGenFunction r ()
forall r.
T (T a, global)
-> Value (Ptr (Struct (T (T a, global)))) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store ((T a, global) -> T (T a, global)
forall a. a -> T a
Maybe.just (T a
a,global
global2)) Value (Ptr (Struct (T (T a, global))))
Value
  (Ptr
     (Struct
        (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
globalPtr
                        T state -> CodeGenFunction r (T state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T state -> CodeGenFunction r (T state))
-> T state -> CodeGenFunction r (T state)
forall a b. (a -> b) -> a -> b
$ state -> T state
forall a. a -> T a
Maybe.just state
state2)
               T (T a, global)
mc1 <- Value (Ptr (Struct (T (T a, global))))
-> CodeGenFunction r (T (T a, global))
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r.
Value (Ptr (Struct (T (T a, global))))
-> CodeGenFunction r (T (T a, global))
Memory.load Value (Ptr (Struct (T (T a, global))))
Value
  (Ptr
     (Struct
        (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
globalPtr
               T ((T a, global), state)
mcs1 <- ((T a, global) -> state -> ((T a, global), state))
-> T (T a, global)
-> T state
-> CodeGenFunction r (T ((T a, global), state))
forall a b c r.
(a -> b -> c) -> T a -> T b -> CodeGenFunction r (T c)
Maybe.lift2 (,) T (T a, global)
mc1 T state
ms1
               T (b, state)
as2 <-
                  T ((T a, global), state)
-> CodeGenFunction r (T (b, state))
-> (((T a, global), state) -> CodeGenFunction r (T (b, state)))
-> CodeGenFunction r (T (b, state))
forall b a r.
Phi b =>
T a
-> CodeGenFunction r b
-> (a -> CodeGenFunction r b)
-> CodeGenFunction r b
Maybe.run T ((T a, global), state)
mcs1 (T (b, state) -> CodeGenFunction r (T (b, state))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return T (b, state)
forall a. Undefined a => T a
Maybe.nothing) ((((T a, global), state) -> CodeGenFunction r (T (b, state)))
 -> CodeGenFunction r (T (b, state)))
-> (((T a, global), state) -> CodeGenFunction r (T (b, state)))
-> CodeGenFunction r (T (b, state))
forall a b. (a -> b) -> a -> b
$ \((T a
p1,global
c1),state
s1) ->
                     T r (T (b, state)) (b, state) -> CodeGenFunction r (T (b, state))
forall a r. Undefined a => T r (T a) a -> CodeGenFunction r (T a)
MaybeCont.toMaybe (T r (T (b, state)) (b, state) -> CodeGenFunction r (T (b, state)))
-> T r (T (b, state)) (b, state)
-> CodeGenFunction r (T (b, state))
forall a b. (a -> b) -> a -> b
$ T a
-> global
-> Value (Ptr local)
-> ()
-> state
-> T r (T (b, state)) (b, state)
forall r c.
Phi c =>
T a
-> global -> Value (Ptr local) -> () -> state -> T r c (b, state)
next T a
p1 global
c1 Value (Ptr local)
local () state
s1
               (T b, T state) -> CodeGenFunction r (T b, T state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((T b, T state) -> CodeGenFunction r (T b, T state))
-> (T b, T state) -> CodeGenFunction r (T b, T state)
forall a b. (a -> b) -> a -> b
$ T (b, state) -> (T b, T state)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
FuncHT.unzip T (b, state)
as2)
            (do
               Value
  (Ptr
     (Struct
        (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
globalPtr <- CodeGenFunction
  r
  (Value
     (Ptr
        (Struct
           (Bool, (Struct (Struct (Repr a), (Struct global, ())), ())))))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.malloc
               T (T a, global)
-> Value (Ptr (Struct (T (T a, global)))) -> CodeGenFunction r ()
forall r.
T (T a, global)
-> Value (Ptr (Struct (T (T a, global)))) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store ((Exp a -> T b)
-> (T a -> global -> CodeGenFunction Any ()) -> T (T a, global)
forall a global b ap code.
(C a, Undefined global) =>
(Exp a -> T b) -> (ap -> global -> code) -> T (T a, global)
nothingFromFunc Exp a -> T b
f T a -> global -> CodeGenFunction Any ()
forall r. T a -> global -> CodeGenFunction r ()
stop) Value (Ptr (Struct (T (T a, global))))
Value
  (Ptr
     (Struct
        (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
globalPtr
               (Value
   (Ptr
      (Struct
         (Bool, (Struct (Struct (Repr a), (Struct global, ())), ())))),
 T state)
-> CodeGenFunction
     r
     (Value
        (Ptr
           (Struct
              (Bool, (Struct (Struct (Repr a), (Struct global, ())), ())))),
      T state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value
  (Ptr
     (Struct
        (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
globalPtr, T state
forall a. Undefined a => T a
Maybe.nothing))
            (\Value
  (Ptr
     (Struct
        (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
globalPtr -> do
               (T a -> global -> CodeGenFunction r ())
-> Value (Ptr (Struct (T (T a, global)))) -> CodeGenFunction r ()
forall global am r.
(C global, C am) =>
(am -> global -> CodeGenFunction r ())
-> Value (Ptr (Struct (T (am, global)))) -> CodeGenFunction r ()
stopAndFree T a -> global -> CodeGenFunction r ()
forall r. T a -> global -> CodeGenFunction r ()
stop Value (Ptr (Struct (T (T a, global))))
Value
  (Ptr
     (Struct
        (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
globalPtr
               Value
  (Ptr
     (Struct
        (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
-> CodeGenFunction r ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free Value
  (Ptr
     (Struct
        (Bool, (Struct (Struct (Repr a), (Struct global, ())), ()))))
globalPtr)

stopAndFree ::
   (Memory.C global, Memory.C am) =>
   (am -> global -> LLVM.CodeGenFunction r ()) ->
   LLVM.Value (LLVM.Ptr (Memory.Struct (Maybe.T (am, global)))) ->
   LLVM.CodeGenFunction r ()
stopAndFree :: forall global am r.
(C global, C am) =>
(am -> global -> CodeGenFunction r ())
-> Value (Ptr (Struct (T (am, global)))) -> CodeGenFunction r ()
stopAndFree am -> global -> CodeGenFunction r ()
stop Value (Ptr (Struct (T (am, global))))
globalPtr = do
   T (am, global)
maybeGlobal <- Value (Ptr (Struct (T (am, global))))
-> CodeGenFunction r (T (am, global))
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r.
Value (Ptr (Struct (T (am, global))))
-> CodeGenFunction r (T (am, global))
Memory.load Value (Ptr (Struct (T (am, global))))
globalPtr
   T (am, global)
-> ((am, global) -> CodeGenFunction r ()) -> CodeGenFunction r ()
forall a r.
T a -> (a -> CodeGenFunction r ()) -> CodeGenFunction r ()
Maybe.for T (am, global)
maybeGlobal (((am, global) -> CodeGenFunction r ()) -> CodeGenFunction r ())
-> ((am, global) -> CodeGenFunction r ()) -> CodeGenFunction r ()
forall a b. (a -> b) -> a -> b
$ \(am
a,global
global) -> am -> global -> CodeGenFunction r ()
stop am
a global
global

nothingFromFunc ::
   (MultiValue.C a, Tuple.Undefined global) =>
   (Exp a -> Sig.T b) ->
   (ap -> global -> code) ->
   Maybe.T (MultiValue.T a, global)
nothingFromFunc :: forall a global b ap code.
(C a, Undefined global) =>
(Exp a -> T b) -> (ap -> global -> code) -> T (T a, global)
nothingFromFunc Exp a -> T b
_ ap -> global -> code
_ = T (T a, global)
forall a. Undefined a => T a
Maybe.nothing