module CSPM.Evaluator.Monad where
import Prelude hiding (lookup)
import CSPM.DataStructures.Names
import CSPM.Evaluator.Environment
import CSPM.Evaluator.Values
import Util.Exception
data EvaluationState =
EvaluationState {
environment :: Environment
}
type EvaluationMonad = LazyEvalMonad EvaluationState
newtype LazyEvalMonad s a = LazyEvalMonad {
unLazyEvalMonad :: s -> a
}
runLazyEvalMonad :: s -> LazyEvalMonad s a -> a
runLazyEvalMonad st (LazyEvalMonad prog) = prog st
gets :: (s -> a) -> LazyEvalMonad s a
gets f = LazyEvalMonad (\st -> f st)
modify :: (s -> s) -> LazyEvalMonad s a -> LazyEvalMonad s a
modify f prog = LazyEvalMonad (\st -> unLazyEvalMonad prog (f st))
instance Monad (LazyEvalMonad a) where
(LazyEvalMonad p1) >>= f =
LazyEvalMonad (\ st ->
let
a = p1 st
LazyEvalMonad p2 = f a
in p2 st)
return k = LazyEvalMonad (\ st -> k)
runEvaluator :: EvaluationState -> EvaluationMonad a -> a
runEvaluator st prog = runLazyEvalMonad st prog
getState :: EvaluationMonad EvaluationState
getState = gets id
getEnvironment :: EvaluationMonad Environment
getEnvironment = gets environment
lookupVar :: Name -> EvaluationMonad Value
lookupVar n = do
env <- getEnvironment
return $ lookup env n
addScopeAndBind :: [(Name, Value)] -> EvaluationMonad a -> EvaluationMonad a
addScopeAndBind bs = addScopeAndBindM [(n, return v) | (n, v) <- bs]
addScopeAndBindM :: [(Name, EvaluationMonad Value)] -> EvaluationMonad a -> EvaluationMonad a
addScopeAndBindM binds prog = do
st <- getState
let
env' = newLayerAndBind (environment st) bs
st' = st { environment = env' }
bs = [(n, runEvaluator st' v) | (n, v) <- binds]
modify (\_ -> st') prog
throwError :: ErrorMessage -> a
throwError err = throwSourceError [err]