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 =
State s (T b) -> s -> T b
forall s a. State s a -> s -> a
evalState ((a -> StateT s Identity b) -> T a -> State s (T b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Simple s ctrl a b -> ctrl -> a -> StateT s Identity b
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) (Simple s ctrl a b -> s
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 =
State s (T b) -> s -> T b
forall s a. State s a -> s -> a
evalState ((ctrl -> a -> StateT s Identity b)
-> T ctrl -> T a -> State s (T b)
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Simple s ctrl a b -> ctrl -> a -> StateT s Identity b
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) (Simple s ctrl a b -> s
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 =
s -> (ctrl -> a -> State s b) -> Simple s ctrl a b
forall s ctrl a b.
s -> (ctrl -> a -> State s b) -> Simple s ctrl a b
Simple (Initialized s init ctrl a b -> init -> s
forall s init ctrl a b. Initialized s init ctrl a b -> init -> s
initInit Initialized s init ctrl a b
modif init
stateInit) (Initialized s init ctrl a b -> ctrl -> a -> State s b
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_ =
Simple s ctrl a b -> ctrl -> T a -> T b
forall s ctrl a b. Simple s ctrl a b -> ctrl -> T a -> T b
static (Initialized s init ctrl a b -> init -> Simple s ctrl a b
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_ =
Simple s ctrl a b -> T ctrl -> T a -> T b
forall s ctrl a b. Simple s ctrl a b -> T ctrl -> T a -> T b
modulated (Initialized s init ctrl a b -> init -> Simple s ctrl a b
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 =
([s] -> (a, [s])) -> StateT [s] Identity a
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (([s] -> (a, [s])) -> StateT [s] Identity a)
-> (a -> [s] -> (a, [s])) -> a -> StateT [s] Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> s -> (a, s)) -> a -> [s] -> (a, [s])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumR (State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState (State s a -> s -> (a, s)) -> (a -> State s a) -> a -> s -> (a, s)
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 =
([s] -> (a, [s])) -> StateT [s] Identity a
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (([s] -> (a, [s])) -> StateT [s] Identity a)
-> (a -> [s] -> (a, [s])) -> a -> StateT [s] Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> s -> (a, s)) -> a -> [s] -> (a, [s])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL (State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState (State s a -> s -> (a, s)) -> (a -> State s a) -> a -> s -> (a, s)
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 =
(Vector s -> (a, Vector s)) -> StateT (Vector s) Identity a
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Vector s -> (a, Vector s)) -> StateT (Vector s) Identity a)
-> (a -> Vector s -> (a, Vector s))
-> a
-> StateT (Vector s) Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> s -> (a, s)) -> a -> Vector s -> (a, Vector s)
forall a b acc.
(Storable a, Storable b) =>
(acc -> a -> (acc, b)) -> acc -> Vector a -> (acc, Vector b)
SV.mapAccumR (State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState (State s a -> s -> (a, s)) -> (a -> State s a) -> a -> s -> (a, s)
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 =
(Vector s -> (a, Vector s)) -> StateT (Vector s) Identity a
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Vector s -> (a, Vector s)) -> StateT (Vector s) Identity a)
-> (a -> Vector s -> (a, Vector s))
-> a
-> StateT (Vector s) Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> s -> (a, s)) -> a -> Vector s -> (a, Vector s)
forall a b acc.
(Storable a, Storable b) =>
(acc -> a -> (acc, b)) -> acc -> Vector a -> (acc, Vector b)
SV.mapAccumL (State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState (State s a -> s -> (a, s)) -> (a -> State s a) -> a -> s -> (a, s)
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 = (Vector s -> (a, Vector s)) -> StateT (Vector s) Identity a
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Vector s -> (a, Vector s)) -> StateT (Vector s) Identity a)
-> (Vector s -> (a, Vector s)) -> StateT (Vector s) Identity a
forall a b. (a -> b) -> a -> b
$ \Vector s
sv ->
let (Vector s
svFinal, Maybe (Vector c, Vector s, a)
mcsa) =
Int
-> ((Vector c, Vector s, a) -> Maybe (s, (Vector c, Vector s, a)))
-> (Vector c, Vector s, a)
-> (Vector s, Maybe (Vector c, Vector s, a))
forall b a.
Storable b =>
Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
SV.unfoldrN (Vector s -> Int
forall a. Vector a -> Int
SV.length Vector s
sv)
(\(Vector c
cv0,Vector s
sv0,a
a0) ->
do (c
c,Vector c
cv1) <- Vector c -> Maybe (c, Vector c)
forall a. Storable a => Vector a -> Maybe (a, Vector a)
SV.viewL Vector c
cv0
(s
s,Vector s
sv1) <- Vector s -> Maybe (s, Vector s)
forall a. Storable a => Vector a -> Maybe (a, Vector a)
SV.viewL Vector s
sv0
let (a
a1,s
sNew) = State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState (c -> a -> State s a
m c
c a
a0) s
s
(s, (Vector c, Vector s, a)) -> Maybe (s, (Vector c, Vector s, a))
forall a. a -> Maybe a
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)
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Modifier: control vector too short - "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"status size " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Vector s -> Int
forall a. Vector a -> Int
SV.length Vector s
sv) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" vs. "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"control size " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Vector c -> Int
forall a. Vector a -> Int
SV.length Vector c
cv),
Vector s
svFinal)