{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Synthesizer.Dimensional.Arrow where
import qualified Synthesizer.Dimensional.Sample as Sample
import Synthesizer.Dimensional.Sample (Amplitude, Displacement, )
import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.Causal.Arrow as CausalArrow
import qualified Control.Arrow as Arrow
import qualified Control.Category as Category
import Control.Arrow (Arrow, ArrowLoop, (>>>), (***), )
import Control.Category (Category, )
import Control.Applicative (Applicative, liftA2, )
import qualified Synthesizer.State.Signal as Sig
import qualified Synthesizer.Generic.Signal as SigG
import qualified Algebra.Module as Module
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import Algebra.Module ((*>))
import qualified Number.DimensionTerm as DN
import qualified Algebra.DimensionTerm as Dim
import NumericPrelude.Numeric (one)
import NumericPrelude.Base hiding (id)
import Prelude ()
newtype T arrow sample0 sample1 =
Cons (Amplitude sample0 ->
(arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
type Single arrow amp0 amp1 yv0 yv1 =
T arrow (Sample.T amp0 yv0) (Sample.T amp1 yv1)
class CausalArrow.C arrow => Applicable arrow rate
instance Applicable (->) rate
infixl 9 `apply`
{-# INLINE apply #-}
apply ::
(SigG.Transform sig (Displacement sample0),
SigG.Transform sig (Displacement sample1),
Applicable arrow rate) =>
T arrow sample0 sample1 ->
SigA.T rate (Amplitude sample0) (sig (Displacement sample0)) ->
SigA.T rate (Amplitude sample1) (sig (Displacement sample1))
apply :: forall (sig :: * -> *) sample0 sample1 (arrow :: * -> * -> *) rate.
(Transform sig (Displacement sample0),
Transform sig (Displacement sample1), Applicable arrow rate) =>
T arrow sample0 sample1
-> T rate (Amplitude sample0) (sig (Displacement sample0))
-> T rate (Amplitude sample1) (sig (Displacement sample1))
apply (Cons Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1)
f) (SigA.Cons rate
rate Amplitude sample0
xAmp sig (Displacement sample0)
samples) =
let (arrow (Displacement sample0) (Displacement sample1)
arrow, Amplitude sample1
yAmp) = Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1)
f Amplitude sample0
xAmp
in forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons rate
rate Amplitude sample1
yAmp (forall (arrow :: * -> * -> *) (sig :: * -> *) a b.
(C arrow, Transform sig a, Transform sig b) =>
arrow a b -> sig a -> sig b
CausalArrow.apply arrow (Displacement sample0) (Displacement sample1)
arrow sig (Displacement sample0)
samples)
{-# INLINE applyFlat #-}
applyFlat ::
(Flat.C yv0 amp0,
SigG.Transform sig yv0,
SigG.Transform sig yv1, Applicable arrow rate) =>
Single arrow (Amp.Flat yv0) amp1 yv0 yv1 ->
SigA.T rate amp0 (sig yv0) ->
SigA.T rate amp1 (sig yv1)
applyFlat :: forall yv0 amp0 (sig :: * -> *) yv1 (arrow :: * -> * -> *) rate
amp1.
(C yv0 amp0, Transform sig yv0, Transform sig yv1,
Applicable arrow rate) =>
Single arrow (Flat yv0) amp1 yv0 yv1
-> T rate amp0 (sig yv0) -> T rate amp1 (sig yv1)
applyFlat Single arrow (Flat yv0) amp1 yv0 yv1
f =
forall (sig :: * -> *) sample0 sample1 (arrow :: * -> * -> *) rate.
(Transform sig (Displacement sample0),
Transform sig (Displacement sample1), Applicable arrow rate) =>
T arrow sample0 sample1
-> T rate (Amplitude sample0) (sig (Displacement sample0))
-> T rate (Amplitude sample1) (sig (Displacement sample1))
apply (forall y flat (arrow :: * -> * -> *).
(C y flat, Arrow arrow) =>
Single arrow flat (Flat y) y y
canonicalizeFlat forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Single arrow (Flat yv0) amp1 yv0 yv1
f)
{-# INLINE canonicalizeFlat #-}
canonicalizeFlat ::
(Flat.C y flat, Arrow arrow) =>
Single arrow flat (Amp.Flat y) y y
canonicalizeFlat :: forall y flat (arrow :: * -> * -> *).
(C y flat, Arrow arrow) =>
Single arrow flat (Flat y) y y
canonicalizeFlat =
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \ Amplitude (T flat y)
amp -> (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
Arrow.arr (forall y amp. C y amp => amp -> y -> y
Flat.amplifySample Amplitude (T flat y)
amp), forall y. Flat y
Amp.Flat)
{-# INLINE applyConst #-}
applyConst ::
(Amp.C amp1, Ring.C y0, CausalArrow.C arrow) =>
Single arrow (Amp.Numeric amp0) amp1 y0 yv1 ->
amp0 ->
SigA.T (Rate.Phantom s) amp1 (Sig.T yv1)
applyConst :: forall amp1 y0 (arrow :: * -> * -> *) amp0 yv1 s.
(C amp1, C y0, C arrow) =>
Single arrow (Numeric amp0) amp1 y0 yv1
-> amp0 -> T (Phantom s) amp1 (T yv1)
applyConst (Cons Amplitude (T (Numeric amp0) y0)
-> (arrow
(Displacement (T (Numeric amp0) y0)) (Displacement (T amp1 yv1)),
Amplitude (T amp1 yv1))
f) amp0
x =
let (arrow
(Displacement (T (Numeric amp0) y0)) (Displacement (T amp1 yv1))
arrow, Amplitude (T amp1 yv1)
yAmp) = Amplitude (T (Numeric amp0) y0)
-> (arrow
(Displacement (T (Numeric amp0) y0)) (Displacement (T amp1 yv1)),
Amplitude (T amp1 yv1))
f (forall amp. amp -> Numeric amp
Amp.Numeric amp0
x)
in forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons forall s. Phantom s
Rate.Phantom Amplitude (T amp1 yv1)
yAmp
(forall (arrow :: * -> * -> *) (sig :: * -> *) a b.
(C arrow, Transform sig a, Transform sig b) =>
arrow a b -> sig a -> sig b
CausalArrow.apply arrow
(Displacement (T (Numeric amp0) y0)) (Displacement (T amp1 yv1))
arrow (forall a. a -> T a
Sig.repeat forall a. C a => a
one))
infixl 0 $/:, $/-
{-# INLINE ($/:) #-}
($/:) ::
(Applicative f,
SigG.Transform sig yv0, SigG.Transform sig yv1,
Applicable arrow rate) =>
f (Single arrow amp0 amp1 yv0 yv1) ->
f (SigA.T rate amp0 (sig yv0)) ->
f (SigA.T rate amp1 (sig yv1))
$/: :: forall (f :: * -> *) (sig :: * -> *) yv0 yv1 (arrow :: * -> * -> *)
rate amp0 amp1.
(Applicative f, Transform sig yv0, Transform sig yv1,
Applicable arrow rate) =>
f (Single arrow amp0 amp1 yv0 yv1)
-> f (T rate amp0 (sig yv0)) -> f (T rate amp1 (sig yv1))
($/:) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (sig :: * -> *) sample0 sample1 (arrow :: * -> * -> *) rate.
(Transform sig (Displacement sample0),
Transform sig (Displacement sample1), Applicable arrow rate) =>
T arrow sample0 sample1
-> T rate (Amplitude sample0) (sig (Displacement sample0))
-> T rate (Amplitude sample1) (sig (Displacement sample1))
apply
{-# INLINE ($/-) #-}
($/-) ::
(Amp.C amp1, Functor f, Ring.C y0, CausalArrow.C arrow) =>
f (Single arrow (Amp.Numeric amp0) amp1 y0 yv1) ->
amp0 ->
f (SigA.T (Rate.Phantom s) amp1 (Sig.T yv1))
$/- :: forall amp1 (f :: * -> *) y0 (arrow :: * -> * -> *) amp0 yv1 s.
(C amp1, Functor f, C y0, C arrow) =>
f (Single arrow (Numeric amp0) amp1 y0 yv1)
-> amp0 -> f (T (Phantom s) amp1 (T yv1))
($/-) f (Single arrow (Numeric amp0) amp1 y0 yv1)
p amp0
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall amp1 y0 (arrow :: * -> * -> *) amp0 yv1 s.
(C amp1, C y0, C arrow) =>
Single arrow (Numeric amp0) amp1 y0 yv1
-> amp0 -> T (Phantom s) amp1 (T yv1)
applyConst amp0
x) f (Single arrow (Numeric amp0) amp1 y0 yv1)
p
{-# INLINE id #-}
id ::
(Category arrow) =>
T arrow sample sample
id :: forall (arrow :: * -> * -> *) sample.
Category arrow =>
T arrow sample sample
id =
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
Cons (\Amplitude sample
amp -> (forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Category.id, Amplitude sample
amp))
{-# INLINE compose #-}
compose ::
(Category arrow) =>
T arrow sample0 sample1 ->
T arrow sample1 sample2 ->
T arrow sample0 sample2
compose :: forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Category arrow =>
T arrow sample0 sample1
-> T arrow sample1 sample2 -> T arrow sample0 sample2
compose (Cons Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1)
f) (Cons Amplitude sample1
-> (arrow (Displacement sample1) (Displacement sample2),
Amplitude sample2)
g) =
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \ Amplitude sample0
xAmp ->
let (arrow (Displacement sample0) (Displacement sample1)
causalXY, Amplitude sample1
yAmp) = Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1)
f Amplitude sample0
xAmp
(arrow (Displacement sample1) (Displacement sample2)
causalYZ, Amplitude sample2
zAmp) = Amplitude sample1
-> (arrow (Displacement sample1) (Displacement sample2),
Amplitude sample2)
g Amplitude sample1
yAmp
in (arrow (Displacement sample0) (Displacement sample1)
causalXY forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
Arrow.>>> arrow (Displacement sample1) (Displacement sample2)
causalYZ, Amplitude sample2
zAmp)
instance (Category arrow) => Category (T arrow) where
{-# INLINE id #-}
id :: forall a. T arrow a a
id = forall (arrow :: * -> * -> *) sample.
Category arrow =>
T arrow sample sample
id
{-# INLINE (.) #-}
. :: forall b c a. T arrow b c -> T arrow a b -> T arrow a c
(.) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Category arrow =>
T arrow sample0 sample1
-> T arrow sample1 sample2 -> T arrow sample0 sample2
compose
instance (Arrow arrow) => Arrow (T arrow) where
{-# INLINE first #-}
{-# INLINE second #-}
{-# INLINE (***) #-}
{-# INLINE (&&&) #-}
arr :: forall b c. (b -> c) -> T arrow b c
arr = forall a. HasCallStack => [Char] -> a
error [Char]
"Dimensional.Arrow.arr: sorry, there is no reasonable implementation"
first :: forall b c d. T arrow b c -> T arrow (b, d) (c, d)
first = forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample0, sample) (sample1, sample)
first
second :: forall b c d. T arrow b c -> T arrow (d, b) (d, c)
second = forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample, sample0) (sample, sample1)
second
*** :: forall b c b' c'.
T arrow b c -> T arrow b' c' -> T arrow (b, b') (c, c')
(***) = forall (arrow :: * -> * -> *) sample0 sample1 sample2 sample3.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow sample2 sample3
-> T arrow (sample0, sample2) (sample1, sample3)
split
&&& :: forall b c c'. T arrow b c -> T arrow b c' -> T arrow b (c, c')
(&&&) = forall (arrow :: * -> * -> *) sample sample0 sample1.
Arrow arrow =>
T arrow sample sample0
-> T arrow sample sample1 -> T arrow sample (sample0, sample1)
fanout
{-# INLINE arr #-}
arr ::
(Arrow arrow, Sample.Build sample0, Sample.Inspect sample1) =>
(sample0 -> sample1) -> T arrow sample0 sample1
arr :: forall (arrow :: * -> * -> *) sample0 sample1.
(Arrow arrow, Build sample0, Inspect sample1) =>
(sample0 -> sample1) -> T arrow sample0 sample1
arr sample0 -> sample1
f = forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \Amplitude sample0
amp0 ->
(forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
Arrow.arr forall a b. (a -> b) -> a -> b
$ \Displacement sample0
yv0 ->
forall sample. Inspect sample => sample -> Displacement sample
Sample.displacement forall a b. (a -> b) -> a -> b
$ sample0 -> sample1
f forall a b. (a -> b) -> a -> b
$ forall sample.
Build sample =>
Amplitude sample -> Displacement sample -> sample
Sample.build Amplitude sample0
amp0 Displacement sample0
yv0,
forall sample. Inspect sample => sample -> Amplitude sample
Sample.amplitude forall a b. (a -> b) -> a -> b
$ sample0 -> sample1
f forall a b. (a -> b) -> a -> b
$ forall sample.
Build sample =>
Amplitude sample -> Displacement sample -> sample
Sample.build Amplitude sample0
amp0 forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Dimensional.Arrow.arr: " forall a. [a] -> [a] -> [a]
++
[Char]
"output amplitude must not depend on input displacement")
{-# INLINE first #-}
first ::
(Arrow arrow) =>
T arrow sample0 sample1 ->
T arrow (sample0, sample) (sample1, sample)
first :: forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample0, sample) (sample1, sample)
first (Cons Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1)
f) =
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \ (Amplitude sample0
xAmp, Amplitude sample
amp) ->
let (arrow (Displacement sample0) (Displacement sample1)
arrow, Amplitude sample1
yAmp) = Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1)
f Amplitude sample0
xAmp
in (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arrow.first arrow (Displacement sample0) (Displacement sample1)
arrow, (Amplitude sample1
yAmp, Amplitude sample
amp))
{-# INLINE second #-}
second ::
(Arrow arrow) =>
T arrow sample0 sample1 ->
T arrow (sample, sample0) (sample, sample1)
second :: forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample, sample0) (sample, sample1)
second (Cons Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1)
f) =
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \ (Amplitude sample
amp, Amplitude sample0
xAmp) ->
let (arrow (Displacement sample0) (Displacement sample1)
arrow, Amplitude sample1
yAmp) = Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1)
f Amplitude sample0
xAmp
in (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second arrow (Displacement sample0) (Displacement sample1)
arrow, (Amplitude sample
amp, Amplitude sample1
yAmp))
{-# INLINE split #-}
split ::
(Arrow arrow) =>
T arrow sample0 sample1 ->
T arrow sample2 sample3 ->
T arrow (sample0, sample2) (sample1, sample3)
split :: forall (arrow :: * -> * -> *) sample0 sample1 sample2 sample3.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow sample2 sample3
-> T arrow (sample0, sample2) (sample1, sample3)
split T arrow sample0 sample1
f T arrow sample2 sample3
g =
forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Category arrow =>
T arrow sample0 sample1
-> T arrow sample1 sample2 -> T arrow sample0 sample2
compose (forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample0, sample) (sample1, sample)
first T arrow sample0 sample1
f) (forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample, sample0) (sample, sample1)
second T arrow sample2 sample3
g)
{-# INLINE fanout #-}
fanout ::
(Arrow arrow) =>
T arrow sample sample0 ->
T arrow sample sample1 ->
T arrow sample (sample0, sample1)
fanout :: forall (arrow :: * -> * -> *) sample sample0 sample1.
Arrow arrow =>
T arrow sample sample0
-> T arrow sample sample1 -> T arrow sample (sample0, sample1)
fanout T arrow sample sample0
f T arrow sample sample1
g =
forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Category arrow =>
T arrow sample0 sample1
-> T arrow sample1 sample2 -> T arrow sample0 sample2
compose forall (arrow :: * -> * -> *) sample.
Arrow arrow =>
T arrow sample (sample, sample)
double (forall (arrow :: * -> * -> *) sample0 sample1 sample2 sample3.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow sample2 sample3
-> T arrow (sample0, sample2) (sample1, sample3)
split T arrow sample sample0
f T arrow sample sample1
g)
independentMap ::
(Arrow arrow) =>
(Amplitude sample0 -> Amplitude sample1) ->
(Displacement sample0 -> Displacement sample1) ->
T arrow sample0 sample1
independentMap :: forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independentMap Amplitude sample0 -> Amplitude sample1
f Displacement sample0 -> Displacement sample1
g =
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
Cons (\Amplitude sample0
amp -> (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
Arrow.arr Displacement sample0 -> Displacement sample1
g, Amplitude sample0 -> Amplitude sample1
f Amplitude sample0
amp))
double ::
(Arrow arrow) =>
T arrow sample (sample, sample)
double :: forall (arrow :: * -> * -> *) sample.
Arrow arrow =>
T arrow sample (sample, sample)
double =
let aux :: sample -> (sample, sample)
aux :: forall sample. sample -> (sample, sample)
aux sample
x = (sample
x, sample
x)
in forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independentMap forall sample. sample -> (sample, sample)
aux forall sample. sample -> (sample, sample)
aux
{-# INLINE forceDimensionalAmplitude #-}
forceDimensionalAmplitude ::
(Dim.C v, Field.C y, Module.C y yv, Arrow arrow) =>
DN.T v y ->
Single arrow (Amp.Dimensional v y) (Amp.Dimensional v y) yv yv
forceDimensionalAmplitude :: forall v y yv (arrow :: * -> * -> *).
(C v, C y, C y yv, Arrow arrow) =>
T v y -> Single arrow (Dimensional v y) (Dimensional v y) yv yv
forceDimensionalAmplitude T v y
ampOut =
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \(Amp.Numeric T v y
ampIn) ->
(forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
Arrow.arr (forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T v y
ampIn T v y
ampOut forall a v. C a v => a -> v -> v
*>),
forall amp. amp -> Numeric amp
Amp.Numeric T v y
ampOut)
{-# INLINE loop #-}
loop ::
(ArrowLoop arrow) =>
T arrow (restSampleIn, sample) (restSampleOut, sample) ->
T arrow restSampleIn restSampleOut
loop :: forall (arrow :: * -> * -> *) restSampleIn sample restSampleOut.
ArrowLoop arrow =>
T arrow (restSampleIn, sample) (restSampleOut, sample)
-> T arrow restSampleIn restSampleOut
loop (Cons Amplitude (restSampleIn, sample)
-> (arrow
(Displacement (restSampleIn, sample))
(Displacement (restSampleOut, sample)),
Amplitude (restSampleOut, sample))
f) =
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \Amplitude restSampleIn
restAmpIn ->
let (arrow
(Displacement restSampleIn, Displacement sample)
(Displacement restSampleOut, Displacement sample)
arrow, (Amplitude restSampleOut
restAmpOut, Amplitude sample
amp)) = Amplitude (restSampleIn, sample)
-> (arrow
(Displacement (restSampleIn, sample))
(Displacement (restSampleOut, sample)),
Amplitude (restSampleOut, sample))
f (Amplitude restSampleIn
restAmpIn, Amplitude sample
amp)
in (forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
Arrow.loop arrow
(Displacement restSampleIn, Displacement sample)
(Displacement restSampleOut, Displacement sample)
arrow, Amplitude restSampleOut
restAmpOut)
{-# INLINE loopVolume #-}
loopVolume ::
(Field.C y, Module.C y yv, Dim.C v,
ArrowLoop arrow) =>
DN.T v y ->
T arrow
(restSampleIn, Sample.T (Amp.Dimensional v y) yv)
(restSampleOut, Sample.T (Amp.Dimensional v y) yv) ->
T arrow restSampleIn restSampleOut
loopVolume :: forall y yv v (arrow :: * -> * -> *) restSampleIn restSampleOut.
(C y, C y yv, C v, ArrowLoop arrow) =>
T v y
-> T arrow
(restSampleIn, T (Dimensional v y) yv)
(restSampleOut, T (Dimensional v y) yv)
-> T arrow restSampleIn restSampleOut
loopVolume T v y
ampIn T arrow
(restSampleIn, T (Dimensional v y) yv)
(restSampleOut, T (Dimensional v y) yv)
f =
forall (arrow :: * -> * -> *) restSampleIn sample restSampleOut.
ArrowLoop arrow =>
T arrow (restSampleIn, sample) (restSampleOut, sample)
-> T arrow restSampleIn restSampleOut
loop (T arrow
(restSampleIn, T (Dimensional v y) yv)
(restSampleOut, T (Dimensional v y) yv)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample, sample0) (sample, sample1)
second (forall v y yv (arrow :: * -> * -> *).
(C v, C y, C y yv, Arrow arrow) =>
T v y -> Single arrow (Dimensional v y) (Dimensional v y) yv yv
forceDimensionalAmplitude T v y
ampIn))
{-# INLINE loop2Volume #-}
loop2Volume ::
(Field.C y0, Module.C y0 yv0, Dim.C v0,
Field.C y1, Module.C y1 yv1, Dim.C v1,
ArrowLoop arrow) =>
(DN.T v0 y0, DN.T v1 y1) ->
T arrow
(restSampleIn, (Sample.T (Amp.Dimensional v0 y0) yv0,
Sample.T (Amp.Dimensional v1 y1) yv1))
(restSampleOut, (Sample.T (Amp.Dimensional v0 y0) yv0,
Sample.T (Amp.Dimensional v1 y1) yv1)) ->
T arrow restSampleIn restSampleOut
loop2Volume :: forall y0 yv0 v0 y1 yv1 v1 (arrow :: * -> * -> *) restSampleIn
restSampleOut.
(C y0, C y0 yv0, C v0, C y1, C y1 yv1, C v1, ArrowLoop arrow) =>
(T v0 y0, T v1 y1)
-> T arrow
(restSampleIn,
(T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
(restSampleOut,
(T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
-> T arrow restSampleIn restSampleOut
loop2Volume (T v0 y0
ampIn0,T v1 y1
ampIn1) T arrow
(restSampleIn,
(T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
(restSampleOut,
(T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
f =
forall (arrow :: * -> * -> *) restSampleIn sample restSampleOut.
ArrowLoop arrow =>
T arrow (restSampleIn, sample) (restSampleOut, sample)
-> T arrow restSampleIn restSampleOut
loop (T arrow
(restSampleIn,
(T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
(restSampleOut,
(T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample, sample0) (sample, sample1)
second
(forall v y yv (arrow :: * -> * -> *).
(C v, C y, C y yv, Arrow arrow) =>
T v y -> Single arrow (Dimensional v y) (Dimensional v y) yv yv
forceDimensionalAmplitude T v0 y0
ampIn0 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***
forall v y yv (arrow :: * -> * -> *).
(C v, C y, C y yv, Arrow arrow) =>
T v y -> Single arrow (Dimensional v y) (Dimensional v y) yv yv
forceDimensionalAmplitude T v1 y1
ampIn1))