{-# 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 $<#, $>#, $*#
($*#) ::
(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)
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
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
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
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)
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
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)))
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
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))
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
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
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 ::
(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
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))
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
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))
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
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
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
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 ::
(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