module Synthesizer.Plain.Modifier where
import Control.Monad.Trans.State (State, state, runState, evalState, )
import Control.Monad (zipWithM, )
import qualified Data.StorableVector as SV
import Foreign.Storable (Storable(..))
import qualified Data.List as List
import Prelude hiding (init)
type T a = [a]
data Simple s ctrl a b =
Simple {
forall s ctrl a b. Simple s ctrl a b -> s
init :: s,
forall s ctrl a b. Simple s ctrl a b -> ctrl -> a -> State s b
step :: ctrl -> a -> State s b
}
static ::
Simple s ctrl a b -> ctrl -> T a -> T b
static :: forall s ctrl a b. Simple s ctrl a b -> ctrl -> T a -> T b
static Simple s ctrl a b
modif ctrl
control T a
x =
forall s a. State s a -> s -> a
evalState (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall s ctrl a b. Simple s ctrl a b -> ctrl -> a -> State s b
step Simple s ctrl a b
modif ctrl
control) T a
x) (forall s ctrl a b. Simple s ctrl a b -> s
init Simple s ctrl a b
modif)
modulated ::
Simple s ctrl a b -> T ctrl -> T a -> T b
modulated :: forall s ctrl a b. Simple s ctrl a b -> T ctrl -> T a -> T b
modulated Simple s ctrl a b
modif T ctrl
control T a
x =
forall s a. State s a -> s -> a
evalState (forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (forall s ctrl a b. Simple s ctrl a b -> ctrl -> a -> State s b
step Simple s ctrl a b
modif) T ctrl
control T a
x) (forall s ctrl a b. Simple s ctrl a b -> s
init Simple s ctrl a b
modif)
data Initialized s init ctrl a b =
Initialized {
forall s init ctrl a b. Initialized s init ctrl a b -> init -> s
initInit :: init -> s,
forall s init ctrl a b.
Initialized s init ctrl a b -> ctrl -> a -> State s b
initStep :: ctrl -> a -> State s b
}
initialize ::
Initialized s init ctrl a b -> init -> Simple s ctrl a b
initialize :: forall s init ctrl a b.
Initialized s init ctrl a b -> init -> Simple s ctrl a b
initialize Initialized s init ctrl a b
modif init
stateInit =
forall s ctrl a b.
s -> (ctrl -> a -> State s b) -> Simple s ctrl a b
Simple (forall s init ctrl a b. Initialized s init ctrl a b -> init -> s
initInit Initialized s init ctrl a b
modif init
stateInit) (forall s init ctrl a b.
Initialized s init ctrl a b -> ctrl -> a -> State s b
initStep Initialized s init ctrl a b
modif)
staticInit ::
Initialized s init ctrl a b -> init -> ctrl -> T a -> T b
staticInit :: forall s init ctrl a b.
Initialized s init ctrl a b -> init -> ctrl -> T a -> T b
staticInit Initialized s init ctrl a b
modif init
state_ =
forall s ctrl a b. Simple s ctrl a b -> ctrl -> T a -> T b
static (forall s init ctrl a b.
Initialized s init ctrl a b -> init -> Simple s ctrl a b
initialize Initialized s init ctrl a b
modif init
state_)
modulatedInit ::
Initialized s init ctrl a b -> init -> T ctrl -> T a -> T b
modulatedInit :: forall s init ctrl a b.
Initialized s init ctrl a b -> init -> T ctrl -> T a -> T b
modulatedInit Initialized s init ctrl a b
modif init
state_ =
forall s ctrl a b. Simple s ctrl a b -> T ctrl -> T a -> T b
modulated (forall s init ctrl a b.
Initialized s init ctrl a b -> init -> Simple s ctrl a b
initialize Initialized s init ctrl a b
modif init
state_)
stackStatesR :: (a -> State s a) -> (a -> State [s] a)
stackStatesR :: forall a s. (a -> State s a) -> a -> State [s] a
stackStatesR a -> State s a
m =
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumR (forall s a. State s a -> s -> (a, s)
runState forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> State s a
m)
stackStatesL :: (a -> State s a) -> (a -> State [s] a)
stackStatesL :: forall a s. (a -> State s a) -> a -> State [s] a
stackStatesL a -> State s a
m =
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL (forall s a. State s a -> s -> (a, s)
runState forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> State s a
m)
{-# INLINE stackStatesStorableR #-}
stackStatesStorableR :: (Storable s) =>
(a -> State s a) -> (a -> State (SV.Vector s) a)
stackStatesStorableR :: forall s a.
Storable s =>
(a -> State s a) -> a -> State (Vector s) a
stackStatesStorableR a -> State s a
m =
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b acc.
(Storable a, Storable b) =>
(acc -> a -> (acc, b)) -> acc -> Vector a -> (acc, Vector b)
SV.mapAccumR (forall s a. State s a -> s -> (a, s)
runState forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> State s a
m)
{-# INLINE stackStatesStorableL #-}
stackStatesStorableL :: (Storable s) =>
(a -> State s a) -> (a -> State (SV.Vector s) a)
stackStatesStorableL :: forall s a.
Storable s =>
(a -> State s a) -> a -> State (Vector s) a
stackStatesStorableL a -> State s a
m =
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b acc.
(Storable a, Storable b) =>
(acc -> a -> (acc, b)) -> acc -> Vector a -> (acc, Vector b)
SV.mapAccumL (forall s a. State s a -> s -> (a, s)
runState forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> State s a
m)
{-# INLINE stackStatesStorableVaryL #-}
stackStatesStorableVaryL :: (Storable s, Storable c) =>
(c -> a -> State s a) -> (SV.Vector c -> a -> State (SV.Vector s) a)
stackStatesStorableVaryL :: forall s c a.
(Storable s, Storable c) =>
(c -> a -> State s a) -> Vector c -> a -> State (Vector s) a
stackStatesStorableVaryL c -> a -> State s a
m Vector c
cv a
a = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \Vector s
sv ->
let (Vector s
svFinal, Maybe (Vector c, Vector s, a)
mcsa) =
forall b a.
Storable b =>
Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
SV.unfoldrN (forall a. Vector a -> Int
SV.length Vector s
sv)
(\(Vector c
cv0,Vector s
sv0,a
a0) ->
do (c
c,Vector c
cv1) <- forall a. Storable a => Vector a -> Maybe (a, Vector a)
SV.viewL Vector c
cv0
(s
s,Vector s
sv1) <- forall a. Storable a => Vector a -> Maybe (a, Vector a)
SV.viewL Vector s
sv0
let (a
a1,s
sNew) = forall s a. State s a -> s -> (a, s)
runState (c -> a -> State s a
m c
c a
a0) s
s
forall (m :: * -> *) a. Monad m => a -> m a
return (s
sNew,(Vector c
cv1,Vector s
sv1,a
a1)))
(Vector c
cv,Vector s
sv,a
a)
in (case Maybe (Vector c, Vector s, a)
mcsa of
Just (Vector c
_, Vector s
_, a
aFinal) -> a
aFinal
Maybe (Vector c, Vector s, a)
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Modifier: control vector too short - "
forall a. [a] -> [a] -> [a]
++ [Char]
"status size " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Vector a -> Int
SV.length Vector s
sv) forall a. [a] -> [a] -> [a]
++ [Char]
" vs. "
forall a. [a] -> [a] -> [a]
++ [Char]
"control size " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Vector a -> Int
SV.length Vector c
cv),
Vector s
svFinal)