{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ExistentialQuantification #-}
module Synthesizer.Causal.Process (
T(Cons),
fromStateMaybe,
fromState,
fromSimpleModifier,
fromInitializedModifier,
id,
map,
first,
second,
compose,
split,
fanout,
loop,
apply,
applyFst,
applySnd,
applySameType,
applyConst,
apply2,
apply3,
applyStorableChunk,
feed,
feedFst,
feedSnd,
feedGenericFst,
feedGenericSnd,
feedConstFst,
feedConstSnd,
crochetL,
mapAccumL,
scanL,
scanL1,
zipWith,
consInit,
chainControlled,
replicateControlled,
feedback,
feedbackControlled,
applyFst',
applySnd',
) where
import qualified Synthesizer.State.Signal as Sig
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Causal.Class as Class
import qualified Synthesizer.Causal.Utility as ArrowUtil
import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Data.StorableVector as SV
import Foreign.Storable (Storable, )
import qualified Control.Category as Cat
import Control.Arrow
(Arrow(..), returnA, (<<<), (>>>), (^>>), ArrowLoop(..),
Kleisli(Kleisli), runKleisli, )
import Control.Monad.Trans.State
(State, runState,
StateT(StateT), runStateT, )
import Control.Monad (liftM, )
import Control.Applicative (Applicative, liftA2, pure, (<*>), )
import Data.Tuple.HT (mapSnd, )
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified Prelude as P
import Prelude hiding (id, map, zipWith, )
data T a b =
forall s.
Cons !(a -> StateT s Maybe b)
!s
{-# INLINE fromStateMaybe #-}
fromStateMaybe :: (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe :: forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe = forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons
{-# INLINE fromState #-}
fromState :: (a -> State s b) -> s -> T a b
fromState :: forall a s b. (a -> State s b) -> s -> T a b
fromState a -> State s b
f =
forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe (\a
x -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. State s a -> s -> (a, s)
runState (a -> State s b
f a
x)))
{-# INLINE fromSimpleModifier #-}
fromSimpleModifier ::
Modifier.Simple s ctrl a b -> T (ctrl,a) b
fromSimpleModifier :: forall s ctrl a b. Simple s ctrl a b -> T (ctrl, a) b
fromSimpleModifier (Modifier.Simple s
s ctrl -> a -> State s b
f) =
forall a s b. (a -> State s b) -> s -> T a b
fromState (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ctrl -> a -> State s b
f) s
s
{-# INLINE fromInitializedModifier #-}
fromInitializedModifier ::
Modifier.Initialized s init ctrl a b -> init -> T (ctrl,a) b
fromInitializedModifier :: forall s init ctrl a b.
Initialized s init ctrl a b -> init -> T (ctrl, a) b
fromInitializedModifier (Modifier.Initialized init -> s
initF ctrl -> a -> State s b
f) init
initS =
forall a s b. (a -> State s b) -> s -> T a b
fromState (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ctrl -> a -> State s b
f) (init -> s
initF init
initS)
instance Cat.Category T where
{-# INLINE id #-}
{-# INLINE (.) #-}
id :: forall a. T a a
id = forall a s b. (a -> State s b) -> s -> T a b
fromState forall (m :: * -> *) a. Monad m => a -> m a
return ()
. :: forall b c a. T b c -> T a b -> T a c
(.) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b c. T a b -> T b c -> T a c
compose
instance Arrow T where
{-# INLINE arr #-}
{-# INLINE first #-}
{-# INLINE second #-}
{-# INLINE (***) #-}
{-# INLINE (&&&) #-}
arr :: forall b c. (b -> c) -> T b c
arr = forall b c. (b -> c) -> T b c
map
first :: forall b c d. T b c -> T (b, d) (c, d)
first = forall a0 a1 b0 b1.
(forall s.
Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1)
-> T a0 a1 -> T b0 b1
liftKleisli forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first
second :: forall b c d. T b c -> T (d, b) (d, c)
second = forall a0 a1 b0 b1.
(forall s.
Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1)
-> T a0 a1 -> T b0 b1
liftKleisli forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
*** :: forall b c b' c'. T b c -> T b' c' -> T (b, b') (c, c')
(***) = forall b c b' c'. T b c -> T b' c' -> T (b, b') (c, c')
split
&&& :: forall b c c'. T b c -> T b c' -> T b (c, c')
(&&&) = forall b c c'. T b c -> T b c' -> T b (c, c')
fanout
instance ArrowLoop T where
{-# INLINE loop #-}
loop :: forall b d c. T (b, d) (c, d) -> T b c
loop = forall a0 a1 b0 b1.
(forall s.
Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1)
-> T a0 a1 -> T b0 b1
liftKleisli forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop
type instance Class.ProcessOf Sig.T = T
instance Class.C T where
type SignalOf T = Sig.T
toSignal :: forall a. T () a -> SignalOf T a
toSignal = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. T a b -> a -> T b
applyConst ()
fromSignal :: forall b a. SignalOf T b -> T a b
fromSignal SignalOf T b
sig = forall a b. a -> b -> a
const () forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> forall (sig :: * -> *) a. Read sig a => sig a -> T () a
feed SignalOf T b
sig
instance Functor (T a) where
fmap :: forall a b. (a -> b) -> T a a -> T a b
fmap = forall (arrow :: * -> * -> *) b c a.
Arrow arrow =>
(b -> c) -> arrow a b -> arrow a c
ArrowUtil.map
instance Applicative (T a) where
pure :: forall a. a -> T a a
pure = forall (arrow :: * -> * -> *) b a. Arrow arrow => b -> arrow a b
ArrowUtil.pure
<*> :: forall a b. T a (a -> b) -> T a a -> T a b
(<*>) = forall (arrow :: * -> * -> *) a b c.
Arrow arrow =>
arrow a (b -> c) -> arrow a b -> arrow a c
ArrowUtil.apply
instance (Additive.C b) => Additive.C (T a b) where
zero :: T a b
zero = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. C a => a
Additive.zero
negate :: T a b -> T a b
negate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. C a => a -> a
Additive.negate
+ :: T a b -> T a b -> T a b
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. C a => a -> a -> a
(Additive.+)
(-) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. C a => a -> a -> a
(Additive.-)
instance (Ring.C b) => Ring.C (T a b) where
one :: T a b
one = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. C a => a
Ring.one
* :: T a b -> T a b -> T a b
(*) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. C a => a -> a -> a
(Ring.*)
T a b
x^ :: T a b -> Integer -> T a b
^Integer
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. C a => a -> Integer -> a
Ring.^ Integer
n) T a b
x
fromInteger :: Integer -> T a b
fromInteger = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => Integer -> a
Ring.fromInteger
instance (Field.C b) => Field.C (T a b) where
/ :: T a b -> T a b -> T a b
(/) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. C a => a -> a -> a
(Field./)
recip :: T a b -> T a b
recip = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. C a => a -> a
Field.recip
fromRational' :: Rational -> T a b
fromRational' = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => Rational -> a
Field.fromRational'
instance (P.Num b) => P.Num (T a b) where
+ :: T a b -> T a b -> T a b
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(P.+)
(-) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(P.-)
* :: T a b -> T a b -> T a b
(*) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(P.*)
negate :: T a b -> T a b
negate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
P.negate
abs :: T a b -> T a b
abs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
P.abs
signum :: T a b -> T a b
signum = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
P.signum
fromInteger :: Integer -> T a b
fromInteger = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
P.fromInteger
instance (P.Fractional b) => P.Fractional (T a b) where
/ :: T a b -> T a b -> T a b
(/) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Fractional a => a -> a -> a
(P./)
fromRational :: Rational -> T a b
fromRational = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
P.fromRational
{-# INLINE extendStateFstT #-}
extendStateFstT :: Monad m => StateT s m a -> StateT (t,s) m a
extendStateFstT :: forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (t, s) m a
extendStateFstT StateT s m a
st =
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (\(t
t0,s
s0) -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (\s
s1 -> (t
t0,s
s1))) (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
st s
s0))
{-# INLINE extendStateSndT #-}
extendStateSndT :: Monad m => StateT s m a -> StateT (s,t) m a
extendStateSndT :: forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (s, t) m a
extendStateSndT StateT s m a
st =
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (\(s
s0,t
t0) -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (\s
s1 -> (s
s1,t
t0))) (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
st s
s0))
{-# INLINE liftKleisli #-}
liftKleisli ::
(forall s.
Kleisli (StateT s Maybe) a0 a1 ->
Kleisli (StateT s Maybe) b0 b1) ->
T a0 a1 -> T b0 b1
liftKleisli :: forall a0 a1 b0 b1.
(forall s.
Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1)
-> T a0 a1 -> T b0 b1
liftKleisli forall s.
Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1
op (Cons a0 -> StateT s Maybe a1
f s
s) =
forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons (forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli forall a b. (a -> b) -> a -> b
$ forall s.
Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1
op forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli a0 -> StateT s Maybe a1
f) s
s
{-# INLINE liftKleisli2 #-}
liftKleisli2 ::
(forall s.
Kleisli (StateT s Maybe) a0 a1 ->
Kleisli (StateT s Maybe) b0 b1 ->
Kleisli (StateT s Maybe) c0 c1) ->
T a0 a1 -> T b0 b1 -> T c0 c1
liftKleisli2 :: forall a0 a1 b0 b1 c0 c1.
(forall s.
Kleisli (StateT s Maybe) a0 a1
-> Kleisli (StateT s Maybe) b0 b1
-> Kleisli (StateT s Maybe) c0 c1)
-> T a0 a1 -> T b0 b1 -> T c0 c1
liftKleisli2 forall s.
Kleisli (StateT s Maybe) a0 a1
-> Kleisli (StateT s Maybe) b0 b1 -> Kleisli (StateT s Maybe) c0 c1
op (Cons a0 -> StateT s Maybe a1
f s
s) (Cons b0 -> StateT s Maybe b1
g s
t) =
forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons
(forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli
(forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (s, t) m a
extendStateSndT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a0 -> StateT s Maybe a1
f) forall s.
Kleisli (StateT s Maybe) a0 a1
-> Kleisli (StateT s Maybe) b0 b1 -> Kleisli (StateT s Maybe) c0 c1
`op`
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (t, s) m a
extendStateFstT forall b c a. (b -> c) -> (a -> b) -> a -> c
. b0 -> StateT s Maybe b1
g)))
(s
s,s
t)
{-# INLINE id #-}
id :: T a a
id :: forall a. T a a
id = forall (a :: * -> * -> *) b. Arrow a => a b b
returnA
{-# INLINE map #-}
map :: (a -> b) -> T a b
map :: forall b c. (b -> c) -> T b c
map a -> b
f = forall a s b. (a -> State s b) -> s -> T a b
fromState (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ()
{-# INLINE compose #-}
compose :: T a b -> T b c -> T a c
compose :: forall a b c. T a b -> T b c -> T a c
compose = forall a0 a1 b0 b1 c0 c1.
(forall s.
Kleisli (StateT s Maybe) a0 a1
-> Kleisli (StateT s Maybe) b0 b1
-> Kleisli (StateT s Maybe) c0 c1)
-> T a0 a1 -> T b0 b1 -> T c0 c1
liftKleisli2 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>)
{-# INLINE split #-}
split :: T a b -> T c d -> T (a,c) (b,d)
split :: forall b c b' c'. T b c -> T b' c' -> T (b, b') (c, c')
split = forall a0 a1 b0 b1 c0 c1.
(forall s.
Kleisli (StateT s Maybe) a0 a1
-> Kleisli (StateT s Maybe) b0 b1
-> Kleisli (StateT s Maybe) c0 c1)
-> T a0 a1 -> T b0 b1 -> T c0 c1
liftKleisli2 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***)
{-# INLINE fanout #-}
fanout :: T a b -> T a c -> T a (b,c)
fanout :: forall b c c'. T b c -> T b c' -> T b (c, c')
fanout = forall a0 a1 b0 b1 c0 c1.
(forall s.
Kleisli (StateT s Maybe) a0 a1
-> Kleisli (StateT s Maybe) b0 b1
-> Kleisli (StateT s Maybe) c0 c1)
-> T a0 a1 -> T b0 b1 -> T c0 c1
liftKleisli2 forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&)
{-# INLINE runViewL #-}
runViewL :: (SigG.Read sig a) =>
sig a ->
(forall s. StateT s Maybe a -> s -> x) ->
x
runViewL :: forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig a
sig forall s. StateT s Maybe a -> s -> x
cont =
forall (sig :: * -> *) y x.
Read sig y =>
sig y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
SigG.runViewL sig a
sig (\s -> Maybe (a, s)
f s
s -> forall s. StateT s Maybe a -> s -> x
cont (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT s -> Maybe (a, s)
f) s
s)
{-# INLINE apply #-}
apply :: (SigG.Transform sig a, SigG.Transform sig b) =>
T a b -> sig a -> sig b
apply :: forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
apply (Cons a -> StateT s Maybe b
f s
s) =
forall (sig :: * -> *) y0 y1 s.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
SigG.crochetL (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT s Maybe b
f) s
s
{-# INLINE applySameType #-}
applySameType :: (SigG.Transform sig a) =>
T a a -> sig a -> sig a
applySameType :: forall (sig :: * -> *) a.
Transform sig a =>
T a a -> sig a -> sig a
applySameType (Cons a -> StateT s Maybe a
f s
s) =
forall (sig :: * -> *) y0 y1 s.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
SigG.crochetL (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT s Maybe a
f) s
s
{-# INLINE applyFst #-}
applyFst, applyFst' :: (SigG.Read sig a) =>
T (a,b) c -> sig a -> T b c
applyFst :: forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
applyFst T (a, b) c
c sig a
as =
T (a, b) c
c forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
feedFst sig a
as
applyFst' :: forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
applyFst' (Cons (a, b) -> StateT s Maybe c
f s
s) sig a
as =
forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig a
as (\StateT s Maybe a
getNext s
r ->
forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons (\b
b ->
do a
a <- forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (t, s) m a
extendStateFstT StateT s Maybe a
getNext
forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (s, t) m a
extendStateSndT ((a, b) -> StateT s Maybe c
f (a
a,b
b)))
(s
s,s
r))
{-# INLINE applySnd #-}
applySnd, applySnd' :: (SigG.Read sig b) =>
T (a,b) c -> sig b -> T a c
applySnd :: forall (sig :: * -> *) b a c.
Read sig b =>
T (a, b) c -> sig b -> T a c
applySnd T (a, b) c
c sig b
as =
T (a, b) c
c forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (sig :: * -> *) a b. Read sig a => sig a -> T b (b, a)
feedSnd sig b
as
applySnd' :: forall (sig :: * -> *) b a c.
Read sig b =>
T (a, b) c -> sig b -> T a c
applySnd' (Cons (a, b) -> StateT s Maybe c
f s
s) sig b
bs =
forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig b
bs (\StateT s Maybe b
getNext s
r ->
forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons (\a
a ->
do b
b <- forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (t, s) m a
extendStateFstT StateT s Maybe b
getNext
forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (s, t) m a
extendStateSndT ((a, b) -> StateT s Maybe c
f (a
a,b
b)))
(s
s,s
r))
{-# INLINE applyConst #-}
applyConst :: T a b -> a -> Sig.T b
applyConst :: forall a b. T a b -> a -> T b
applyConst (Cons a -> StateT s Maybe b
f s
s) a
a =
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
Sig.unfoldR (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT s Maybe b
f a
a)) s
s
{-# INLINE apply2 #-}
apply2 ::
(SigG.Read sig a, SigG.Transform sig b, SigG.Transform sig c) =>
T (a,b) c -> sig a -> sig b -> sig c
apply2 :: forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
T (a, b) c -> sig a -> sig b -> sig c
apply2 T (a, b) c
f sig a
x sig b
y =
forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
apply (forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
applyFst T (a, b) c
f sig a
x) sig b
y
{-# INLINE apply3 #-}
apply3 ::
(SigG.Read sig a, SigG.Read sig b, SigG.Transform sig c, SigG.Transform sig d) =>
T (a,b,c) d -> sig a -> sig b -> sig c -> sig d
apply3 :: forall (sig :: * -> *) a b c d.
(Read sig a, Read sig b, Transform sig c, Transform sig d) =>
T (a, b, c) d -> sig a -> sig b -> sig c -> sig d
apply3 T (a, b, c) d
f sig a
x sig b
y sig c
z =
forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
T (a, b) c -> sig a -> sig b -> sig c
apply2 (forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
applyFst ((\(a
a,(b
b,c
c)) -> (a
a,b
b,c
c)) forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> T (a, b, c) d
f) sig a
x) sig b
y sig c
z
applyStorableChunk ::
(Storable a, Storable b) =>
T a b -> T (SV.Vector a) (SV.Vector b)
applyStorableChunk :: forall a b.
(Storable a, Storable b) =>
T a b -> T (Vector a) (Vector b)
applyStorableChunk (Cons a -> StateT s Maybe b
next s
start) = forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons
(\Vector a
a -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \Maybe s
ms ->
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe s
ms forall a b. (a -> b) -> a -> b
$ \s
s ->
forall x y acc.
(Storable x, Storable y) =>
(x -> acc -> Maybe (y, acc))
-> acc -> Vector x -> (Vector y, Maybe acc)
SV.crochetLResult (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT s Maybe b
next) s
s Vector a
a)
(forall a. a -> Maybe a
Just s
start)
{-# INLINE feed #-}
feed :: (SigG.Read sig a) =>
sig a -> T () a
feed :: forall (sig :: * -> *) a. Read sig a => sig a -> T () a
feed sig a
proc =
forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig a
proc (\StateT s Maybe a
getNext ->
forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe (forall a b. a -> b -> a
const StateT s Maybe a
getNext))
{-# INLINE feedFst #-}
feedFst :: (SigG.Read sig a) =>
sig a -> T b (a,b)
feedFst :: forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
feedFst sig a
proc =
forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig a
proc (\StateT s Maybe a
getNext ->
forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe (\b
b -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) b
b) StateT s Maybe a
getNext))
{-# INLINE feedSnd #-}
feedSnd :: (SigG.Read sig a) =>
sig a -> T b (b,a)
feedSnd :: forall (sig :: * -> *) a b. Read sig a => sig a -> T b (b, a)
feedSnd sig a
proc =
forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig a
proc (\StateT s Maybe a
getNext ->
forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe (\b
b -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) b
b) StateT s Maybe a
getNext))
{-# INLINE feedConstFst #-}
feedConstFst :: a -> T b (a,b)
feedConstFst :: forall a b. a -> T b (a, b)
feedConstFst a
a = forall b c. (b -> c) -> T b c
map (\b
b -> (a
a,b
b))
{-# INLINE feedConstSnd #-}
feedConstSnd :: a -> T b (b,a)
feedConstSnd :: forall a b. a -> T b (b, a)
feedConstSnd a
a = forall b c. (b -> c) -> T b c
map (\b
b -> (b
b,a
a))
{-# INLINE feedGenericFst #-}
feedGenericFst :: (SigG.Read sig a) =>
sig a -> T b (a,b)
feedGenericFst :: forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
feedGenericFst =
forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
feedFst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState
{-# INLINE feedGenericSnd #-}
feedGenericSnd :: (SigG.Read sig a) =>
sig a -> T b (b,a)
feedGenericSnd :: forall (sig :: * -> *) a b. Read sig a => sig a -> T b (b, a)
feedGenericSnd =
forall (sig :: * -> *) a b. Read sig a => sig a -> T b (b, a)
feedSnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState
{-# INLINE crochetL #-}
crochetL :: (x -> acc -> Maybe (y, acc)) -> acc -> T x y
crochetL :: forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x y
crochetL x -> acc -> Maybe (y, acc)
f acc
s = forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> acc -> Maybe (y, acc)
f) acc
s
{-# INLINE mapAccumL #-}
mapAccumL :: (x -> acc -> (y, acc)) -> acc -> T x y
mapAccumL :: forall x acc y. (x -> acc -> (y, acc)) -> acc -> T x y
mapAccumL x -> acc -> (y, acc)
next = forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x y
crochetL (\x
a acc
s -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ x -> acc -> (y, acc)
next x
a acc
s)
{-# INLINE scanL #-}
scanL :: (acc -> x -> acc) -> acc -> T x acc
scanL :: forall acc x. (acc -> x -> acc) -> acc -> T x acc
scanL acc -> x -> acc
f = forall x acc y. (x -> acc -> (y, acc)) -> acc -> T x y
mapAccumL (\x
x acc
acc -> (acc
acc, acc -> x -> acc
f acc
acc x
x))
{-# INLINE scanL1 #-}
scanL1 :: (x -> x -> x) -> T x x
scanL1 :: forall x. (x -> x -> x) -> T x x
scanL1 x -> x -> x
f =
forall x acc y. (x -> acc -> (y, acc)) -> acc -> T x y
mapAccumL (\x
x Maybe x
acc -> (x
x, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe x
x (forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> x -> x
f x
x) Maybe x
acc)) forall a. Maybe a
Nothing
{-# INLINE zipWith #-}
zipWith :: (SigG.Read sig a) =>
(a -> b -> c) -> sig a -> T b c
zipWith :: forall (sig :: * -> *) a b c.
Read sig a =>
(a -> b -> c) -> sig a -> T b c
zipWith a -> b -> c
f = forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
applyFst (forall b c. (b -> c) -> T b c
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c
f))
{-# INLINE consInit #-}
consInit :: x -> T x x
consInit :: forall x. x -> T x x
consInit = forall x acc y. (x -> acc -> (y, acc)) -> acc -> T x y
mapAccumL (\x
x x
acc -> (x
acc, x
x))
{-# INLINE chainControlled #-}
chainControlled :: [T (c,x) x] -> T (c,x) x
chainControlled :: forall c x. [T (c, x) x] -> T (c, x) x
chainControlled = forall (arrow :: * -> * -> *) c x.
Arrow arrow =>
[arrow (c, x) x] -> arrow (c, x) x
Class.chainControlled
{-# INLINE replicateControlled #-}
replicateControlled :: Int -> T (c,x) x -> T (c,x) x
replicateControlled :: forall c x. Int -> T (c, x) x -> T (c, x) x
replicateControlled = forall (arrow :: * -> * -> *) c x.
Arrow arrow =>
Int -> arrow (c, x) x -> arrow (c, x) x
Class.replicateControlled
{-# INLINE feedback #-}
feedback :: T (a,c) b -> T b c -> T a b
feedback :: forall a c b. T (a, c) b -> T b c -> T a b
feedback T (a, c) b
forth T b c
back =
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop (T (a, c) b
forth forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. T a a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T b c
back)
{-# INLINE feedbackControlled #-}
feedbackControlled :: T ((ctrl,a),c) b -> T (ctrl,b) c -> T (ctrl,a) b
feedbackControlled :: forall ctrl a c b.
T ((ctrl, a), c) b -> T (ctrl, b) c -> T (ctrl, a) b
feedbackControlled T ((ctrl, a), c) b
forth T (ctrl, b) c
back =
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop (forall b c. (b -> c) -> T b c
map (forall a b. (a, b) -> a
fstforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T ((ctrl, a), c) b
forth forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall b c. (b -> c) -> T b c
map forall a b. (a, b) -> b
snd forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T (ctrl, b) c
back)