module Csound.Exp.SE(
Outs,
SE(..), LocalHistory(..),
se, se_, stmtOnly, runSE, execSE,
writeVar, readVar, initVar, newLocalVar
) where
import Control.Applicative
import Control.Monad(ap)
import Control.Monad.Trans.State.Strict
import Data.Default
import Data.Maybe(fromJust)
import Data.Fix(Fix(..))
import Csound.Exp
import Csound.Exp.Wrapper
type Outs = SE [Sig]
newtype SE a = SE { unSE :: State LocalHistory a }
data LocalHistory = LocalHistory
{ expDependency :: Maybe E
, locals :: Locals }
instance Default LocalHistory where
def = LocalHistory def def
data Locals = Locals
{ newVarId :: Int
, localInits :: [SE ()] }
instance Default Locals where
def = Locals def def
instance Functor SE where
fmap f = SE . fmap f . unSE
instance Applicative SE where
pure = return
(<*>) = ap
instance Monad SE where
return = SE . return
ma >>= mf = SE $ unSE ma >>= unSE . mf
runSE :: SE a -> (a, LocalHistory)
runSE a = runState (unSE a) def
execSE :: SE a -> E
execSE a
| null initList = expr
| otherwise = execSE $ applyInitList initList expr >> clearInitList
where st = snd $ runSE a
expr = fromJust $ expDependency st
initList = localInits $ locals st
clearInitList = SE $ modify $ \s -> s{ locals = def }
applyInitList inits xs = sequence_ inits >> se_ xs
se :: (Val a) => E -> SE a
se a = SE $ state $ \s ->
let x = Fix $ (unFix a) { ratedExpDepends = expDependency s }
in (fromE x, s{ expDependency = Just x } )
se_ :: E -> SE ()
se_ = fmap (const ()) . (se :: E -> SE E)
stmtOnly :: Exp E -> SE ()
stmtOnly stmt = se_ $ fromE $ noRate stmt
writeVar :: (Val a) => Var -> a -> SE ()
writeVar v x = se_ $ noRate $ WriteVar v $ toPrimOr $ toE x
readVar :: (Val a) => Var -> a
readVar v = noRate $ ReadVar v
initVar :: (Val a) => Var -> a -> SE ()
initVar v x = se_ $ noRate $ InitVar v $ toPrimOr $ toE x
newLocalVar :: Val a => Rate -> a -> SE Var
newLocalVar rate initVal = SE $ do
s <- get
let (var, locals') = newVarOnLocals rate initVal (locals s)
put $ s { locals = locals' }
return var
newVarOnLocals :: Val a => Rate -> a -> Locals -> (Var, Locals)
newVarOnLocals rate initVal st =
(var, st { newVarId = succ n, localInits = initStmt : localInits st })
where var = Var LocalVar rate (show n)
n = newVarId st
initStmt = initVar var initVal