module CheckedMonad where
import Prelude hiding (LT, GT, EQ, id)
import FirstClassFunctions hiding (evaluate)
import ErrorChecking hiding (evaluate)
import Control.Monad
instance Functor Checked where
fmap = liftM
instance Applicative Checked where
pure val = ST (\m -> (val, m))
(<*>) = ap
instance Monad Checked where
return = pure
a >>= f =
case a of
Error msg -> Error msg
Good v -> f v
evaluate :: Exp -> Env -> Checked Value
evaluate (Literal v) env = return v
evaluate (Unary op a) env = do
av <- evaluate a env
checked_unary op av
evaluate (Binary op a b) env = do
av <- evaluate a env
bv <- evaluate b env
checked_binary op av bv
evaluate (If a b c) env = do
av <- evaluate a env
case av of
BoolV cond -> evaluate (if cond then b else c) env
_ -> Error ("Expected boolean but found " ++ show av)
-- variables and declarations
evaluate (Variable x) env =
case lookup x env of
Nothing -> Error ("Variable " ++ x ++ " undefined")
Just v -> return v
evaluate (Declare x e body) env = do -- non-recursive case
ev <- evaluate e env
let newEnv = (x, ev) : env
evaluate body newEnv
-- function definitions and function calls
evaluate (Function x body) env = return (ClosureV x body env)
evaluate (Call fun arg) env = do
funv <- evaluate fun env
case funv of
ClosureV x body closeEnv -> do
argv <- evaluate arg env
let newEnv = (x, argv) : closeEnv
evaluate body newEnv
_ -> Error ("Expected function but found " ++ show funv)