\begin{comment}
\begin{code}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
module LiveCoding.Cell.Feedback where
import Control.Arrow
import Data.Data
import Data.Maybe (fromMaybe)
import LiveCoding.Cell
\end{code}
\end{comment}
We would like to have all basic primitives needed to develop standard synchronous signal processing components,
without touching the \mintinline{haskell}{Cell} constructor anymore.
One crucial bit is missing to achieve this goal:
Encapsulating state.
The most general such construction is the feedback loop:
\begin{code}
feedback
:: (Monad m, Data s)
=> s
-> Cell m (a, s) (b, s)
-> Cell m a b
\end{code}
Let us have a look at its internal state:
\begin{code}
data Feedback sPrevious sAdditional = Feedback
{ Feedback sPrevious sAdditional -> sPrevious
sPrevious :: sPrevious
, Feedback sPrevious sAdditional -> sAdditional
sAdditional :: sAdditional
} deriving Typeable (Feedback sPrevious sAdditional)
DataType
Constr
Typeable (Feedback sPrevious sAdditional)
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Feedback sPrevious sAdditional
-> c (Feedback sPrevious sAdditional))
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Feedback sPrevious sAdditional))
-> (Feedback sPrevious sAdditional -> Constr)
-> (Feedback sPrevious sAdditional -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (Feedback sPrevious sAdditional)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Feedback sPrevious sAdditional)))
-> ((forall b. Data b => b -> b)
-> Feedback sPrevious sAdditional
-> Feedback sPrevious sAdditional)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Feedback sPrevious sAdditional
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Feedback sPrevious sAdditional
-> r)
-> (forall u.
(forall d. Data d => d -> u)
-> Feedback sPrevious sAdditional -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u)
-> Feedback sPrevious sAdditional
-> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional))
-> Data (Feedback sPrevious sAdditional)
Feedback sPrevious sAdditional -> DataType
Feedback sPrevious sAdditional -> Constr
(forall b. Data b => b -> b)
-> Feedback sPrevious sAdditional -> Feedback sPrevious sAdditional
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Feedback sPrevious sAdditional
-> c (Feedback sPrevious sAdditional)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Feedback sPrevious sAdditional)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Feedback sPrevious sAdditional))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> Feedback sPrevious sAdditional
-> u
forall u.
(forall d. Data d => d -> u)
-> Feedback sPrevious sAdditional -> [u]
forall sPrevious sAdditional.
(Data sPrevious, Data sAdditional) =>
Typeable (Feedback sPrevious sAdditional)
forall sPrevious sAdditional.
(Data sPrevious, Data sAdditional) =>
Feedback sPrevious sAdditional -> DataType
forall sPrevious sAdditional.
(Data sPrevious, Data sAdditional) =>
Feedback sPrevious sAdditional -> Constr
forall sPrevious sAdditional.
(Data sPrevious, Data sAdditional) =>
(forall b. Data b => b -> b)
-> Feedback sPrevious sAdditional -> Feedback sPrevious sAdditional
forall sPrevious sAdditional u.
(Data sPrevious, Data sAdditional) =>
Int
-> (forall d. Data d => d -> u)
-> Feedback sPrevious sAdditional
-> u
forall sPrevious sAdditional u.
(Data sPrevious, Data sAdditional) =>
(forall d. Data d => d -> u)
-> Feedback sPrevious sAdditional -> [u]
forall sPrevious sAdditional r r'.
(Data sPrevious, Data sAdditional) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Feedback sPrevious sAdditional
-> r
forall sPrevious sAdditional r r'.
(Data sPrevious, Data sAdditional) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Feedback sPrevious sAdditional
-> r
forall sPrevious sAdditional (m :: * -> *).
(Data sPrevious, Data sAdditional, Monad m) =>
(forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional)
forall sPrevious sAdditional (m :: * -> *).
(Data sPrevious, Data sAdditional, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional)
forall sPrevious sAdditional (c :: * -> *).
(Data sPrevious, Data sAdditional) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Feedback sPrevious sAdditional)
forall sPrevious sAdditional (c :: * -> *).
(Data sPrevious, Data sAdditional) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Feedback sPrevious sAdditional
-> c (Feedback sPrevious sAdditional)
forall sPrevious sAdditional (t :: * -> *) (c :: * -> *).
(Data sPrevious, Data sAdditional, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (Feedback sPrevious sAdditional))
forall sPrevious sAdditional (t :: * -> * -> *) (c :: * -> *).
(Data sPrevious, Data sAdditional, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Feedback sPrevious sAdditional))
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Feedback sPrevious sAdditional
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Feedback sPrevious sAdditional
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Feedback sPrevious sAdditional)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Feedback sPrevious sAdditional
-> c (Feedback sPrevious sAdditional)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (Feedback sPrevious sAdditional))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Feedback sPrevious sAdditional))
$cFeedback :: Constr
$tFeedback :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional)
$cgmapMo :: forall sPrevious sAdditional (m :: * -> *).
(Data sPrevious, Data sAdditional, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional)
gmapMp :: (forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional)
$cgmapMp :: forall sPrevious sAdditional (m :: * -> *).
(Data sPrevious, Data sAdditional, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional)
gmapM :: (forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional)
$cgmapM :: forall sPrevious sAdditional (m :: * -> *).
(Data sPrevious, Data sAdditional, Monad m) =>
(forall d. Data d => d -> m d)
-> Feedback sPrevious sAdditional
-> m (Feedback sPrevious sAdditional)
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> Feedback sPrevious sAdditional
-> u
$cgmapQi :: forall sPrevious sAdditional u.
(Data sPrevious, Data sAdditional) =>
Int
-> (forall d. Data d => d -> u)
-> Feedback sPrevious sAdditional
-> u
gmapQ :: (forall d. Data d => d -> u)
-> Feedback sPrevious sAdditional -> [u]
$cgmapQ :: forall sPrevious sAdditional u.
(Data sPrevious, Data sAdditional) =>
(forall d. Data d => d -> u)
-> Feedback sPrevious sAdditional -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Feedback sPrevious sAdditional
-> r
$cgmapQr :: forall sPrevious sAdditional r r'.
(Data sPrevious, Data sAdditional) =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> Feedback sPrevious sAdditional
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Feedback sPrevious sAdditional
-> r
$cgmapQl :: forall sPrevious sAdditional r r'.
(Data sPrevious, Data sAdditional) =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> Feedback sPrevious sAdditional
-> r
gmapT :: (forall b. Data b => b -> b)
-> Feedback sPrevious sAdditional -> Feedback sPrevious sAdditional
$cgmapT :: forall sPrevious sAdditional.
(Data sPrevious, Data sAdditional) =>
(forall b. Data b => b -> b)
-> Feedback sPrevious sAdditional -> Feedback sPrevious sAdditional
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Feedback sPrevious sAdditional))
$cdataCast2 :: forall sPrevious sAdditional (t :: * -> * -> *) (c :: * -> *).
(Data sPrevious, Data sAdditional, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Feedback sPrevious sAdditional))
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c (Feedback sPrevious sAdditional))
$cdataCast1 :: forall sPrevious sAdditional (t :: * -> *) (c :: * -> *).
(Data sPrevious, Data sAdditional, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (Feedback sPrevious sAdditional))
dataTypeOf :: Feedback sPrevious sAdditional -> DataType
$cdataTypeOf :: forall sPrevious sAdditional.
(Data sPrevious, Data sAdditional) =>
Feedback sPrevious sAdditional -> DataType
toConstr :: Feedback sPrevious sAdditional -> Constr
$ctoConstr :: forall sPrevious sAdditional.
(Data sPrevious, Data sAdditional) =>
Feedback sPrevious sAdditional -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Feedback sPrevious sAdditional)
$cgunfold :: forall sPrevious sAdditional (c :: * -> *).
(Data sPrevious, Data sAdditional) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Feedback sPrevious sAdditional)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Feedback sPrevious sAdditional
-> c (Feedback sPrevious sAdditional)
$cgfoldl :: forall sPrevious sAdditional (c :: * -> *).
(Data sPrevious, Data sAdditional) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Feedback sPrevious sAdditional
-> c (Feedback sPrevious sAdditional)
$cp1Data :: forall sPrevious sAdditional.
(Data sPrevious, Data sAdditional) =>
Typeable (Feedback sPrevious sAdditional)
Data
\end{code}
In \mintinline{haskell}{feedback sAdditional cell},
the \mintinline{haskell}{cell} has state \mintinline{haskell}{sPrevious},
and to this state we add \mintinline{haskell}{sAdditional}.
The additional state is received by \mintinline{haskell}{cell} as explicit input,
and \mintinline{haskell}{feedback} hides it.
Note that \mintinline{haskell}{feedback} and \mintinline{haskell}{loop} are different.
While \mintinline{haskell}{loop} provides immediate recursion, it doesn't add new state.
\mintinline{haskell}{feedback} requires an initial state and delays it,
but in turn it is always safe to use since it does not use \mintinline{haskell}{mfix}.
\fxwarning{Possibly remark on Data instance of s?}
\begin{comment}
\begin{code}
feedback :: s -> Cell m (a, s) (b, s) -> Cell m a b
feedback s
sAdditional (Cell s
sPrevious s -> (a, s) -> m ((b, s), s)
step) = Cell :: forall (m :: * -> *) a b s.
Data s =>
s -> (s -> a -> m (b, s)) -> Cell m a b
Cell { Feedback s s
Feedback s s -> a -> m (b, Feedback s s)
cellStep :: Feedback s s -> a -> m (b, Feedback s s)
cellState :: Feedback s s
cellStep :: Feedback s s -> a -> m (b, Feedback s s)
cellState :: Feedback s s
.. }
where
cellState :: Feedback s s
cellState = Feedback :: forall sPrevious sAdditional.
sPrevious -> sAdditional -> Feedback sPrevious sAdditional
Feedback { s
s
sPrevious :: s
sAdditional :: s
sAdditional :: s
sPrevious :: s
.. }
cellStep :: Feedback s s -> a -> m (b, Feedback s s)
cellStep Feedback { s
s
sAdditional :: s
sPrevious :: s
sAdditional :: forall sPrevious sAdditional.
Feedback sPrevious sAdditional -> sAdditional
sPrevious :: forall sPrevious sAdditional.
Feedback sPrevious sAdditional -> sPrevious
.. } a
a = do
((!b
b, !s
sAdditional'), s
sPrevious') <- s -> (a, s) -> m ((b, s), s)
step s
sPrevious (a
a, s
sAdditional)
(b, Feedback s s) -> m (b, Feedback s s)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, s -> s -> Feedback s s
forall sPrevious sAdditional.
sPrevious -> sAdditional -> Feedback sPrevious sAdditional
Feedback s
sPrevious' s
sAdditional')
feedback s
cellState (ArrM (a, s) -> m (b, s)
f) = Cell :: forall (m :: * -> *) a b s.
Data s =>
s -> (s -> a -> m (b, s)) -> Cell m a b
Cell { s
s -> a -> m (b, s)
cellStep :: s -> a -> m (b, s)
cellState :: s
cellStep :: s -> a -> m (b, s)
cellState :: s
.. }
where
cellStep :: s -> a -> m (b, s)
cellStep s
state a
a = (a, s) -> m (b, s)
f (a
a, s
state)
\end{code}
\end{comment}
It enables us to write delays:
\begin{code}
delay :: (Data s, Monad m) => s -> Cell m s s
delay :: s -> Cell m s s
delay s
s = s -> Cell m (s, s) (s, s) -> Cell m s s
forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback s
s (Cell m (s, s) (s, s) -> Cell m s s)
-> Cell m (s, s) (s, s) -> Cell m s s
forall a b. (a -> b) -> a -> b
$ ((s, s) -> (s, s)) -> Cell m (s, s) (s, s)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (s, s) -> (s, s)
forall b a. (b, a) -> (a, b)
swap
where
swap :: (b, a) -> (a, b)
swap (b
sNew, a
sOld) = (a
sOld, b
sNew)
\end{code}
\mintinline{haskell}{feedback} can be used for accumulation of data.
For example, \mintinline{haskell}{sumC} now becomes:
\begin{code}
sumFeedback
:: (Monad m, Num a, Data a)
=> Cell m a a
sumFeedback :: Cell m a a
sumFeedback = a -> Cell m (a, a) (a, a) -> Cell m a a
forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback a
0 (Cell m (a, a) (a, a) -> Cell m a a)
-> Cell m (a, a) (a, a) -> Cell m a a
forall a b. (a -> b) -> a -> b
$ ((a, a) -> (a, a)) -> Cell m (a, a) (a, a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr
(((a, a) -> (a, a)) -> Cell m (a, a) (a, a))
-> ((a, a) -> (a, a)) -> Cell m (a, a) (a, a)
forall a b. (a -> b) -> a -> b
$ \(a
a, a
accum) -> (a
accum, a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
accum)
\end{code}