Introduction
This article is part of a series of articles on monads.
Its purpose is to motivate the usage of monads (not to explain how they work, nor to explain in details the particular examples shown here).
This article is a condensed version of
This article will show
monads as a flexible, extensible way structuring of programs
monads hide book-keeping/plumbing, removing clutter from main algorithm
using monad transformers (a way to use two or more monads at the same time)
setup
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Mapnon-monadic expression evaluator
An expression evaluator will be used as a running example:
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
eval0 :: Env -> Exp -> Value
eval0 env (Lit i) = IntVal i
eval0 env (Var n) = fromJust (Map.lookup n env)
eval0 env (Plus e1 e2) = let IntVal i1 = eval0 env e1
IntVal i2 = eval0 env e2
in IntVal (i1 + i2)
eval0 env (Abs n e) = FunVal env n e
eval0 env (App e1 e2) = let val1 = eval0 env e1
val2 = eval0 env e2
in case val1 of
FunVal env' n body ->
eval0 (Map.insert n val2 env') bodyGiven the above, evaluating 12 + (\x -> x) (4 + 2) will result in 18 :
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Map
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
eval0 :: Env -> Exp -> Value
eval0 env (Lit i) = IntVal i
eval0 env (Var n) = fromJust (Map.lookup n env)
eval0 env (Plus e1 e2) = let IntVal i1 = eval0 env e1
IntVal i2 = eval0 env e2
in IntVal (i1 + i2)
eval0 env (Abs n e) = FunVal env n e
eval0 env (App e1 e2) = let val1 = eval0 env e1
val2 = eval0 env e2
in case val1 of
FunVal env' n body ->
eval0 (Map.insert n val2 env') body
-- show
exampleExp = Plus (Lit 12) (App (Abs "x" (Var "x")) (Plus (Lit 4) (Lit 2)))
main = putStrLn $ show $ eval0 Map.empty exampleExp
-- ==> IntVal 18
-- /showThe above evaluator works fine for the "happy path", but does not give useful error messages when things go wrong, such as an unbound variable:
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Map
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
eval0 :: Env -> Exp -> Value
eval0 env (Lit i) = IntVal i
eval0 env (Var n) = fromJust (Map.lookup n env)
eval0 env (Plus e1 e2) = let IntVal i1 = eval0 env e1
IntVal i2 = eval0 env e2
in IntVal (i1 + i2)
eval0 env (Abs n e) = FunVal env n e
eval0 env (App e1 e2) = let val1 = eval0 env e1
val2 = eval0 env e2
in case val1 of
FunVal env' n body ->
eval0 (Map.insert n val2 env') body
-- show
exampleExp = Plus (Lit 12) (App (Abs "x" (Var "x")) (Plus (Lit 4) (Lit 2)))
main = putStrLn $ show $ eval0 Map.empty (Var "x")
-- results in an error: Maybe.fromJust: NothingThat can be "fixed" by using Either:
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Map
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
-- show
eval0e :: Env -> Exp -> Either String Value
eval0e env (Lit i) = Right $ IntVal i
eval0e env (Var n) = case Map.lookup n env of
Nothing -> Left $ "unbound var: " ++ n
Just v -> Right v
eval0e env (Plus e1 e2) = let Right (IntVal i1) = eval0e env e1
Right (IntVal i2) = eval0e env e2
in Right $ IntVal (i1 + i2)
eval0e env (Abs n e) = Right $ FunVal env n e
eval0e env (App e1 e2) = let Right val1 = eval0e env e1
Right val2 = eval0e env e2
in case val1 of
FunVal env' n body ->
eval0e (Map.insert n val2 env') body
main = putStrLn $ show $ eval0e Map.empty (Var "x")
-- ==> Left "unbound var: x"
-- /showThat works, but the code gets ugly fast, adding/removing Left and
Right all over the place — and the fix only dealt with unbound
variables, not other problems like a non- IntVal given to Plus
(shown later).
conversion to monadic structure
A better solution is to write the code in a "monadic" style that makes it relatively easy to add, remove or change monads. The monads to be added will handle error conditions, state, etc., (as will be seen later).
type Eval1 alpha = Identity alpha
runEval1 :: Eval1 alpha -> alpha
runEval1 ev = runIdentity ev
eval1 :: Env -> Exp -> Eval1 Value
eval1 env (Lit i) = return $ IntVal i
eval1 env (Var n) = return $ fromJust (Map.lookup n env)
eval1 env (Plus e1 e2) = do IntVal i1 <- eval1 env e1
IntVal i2 <- eval1 env e2
return $ IntVal (i1 + i2)
eval1 env (Abs n e) = return $ FunVal env n e
eval1 env (App e1 e2) = do val1 <- eval1 env e1
val2 <- eval1 env e2
case val1 of
FunVal env' n body ->
eval1 (Map.insert n val2 env') bodyMonadic eval1 is very similar to non-monadic eval0. The only
difference is the type signature and the addition of return, do,
and using <- instead of let.
Again, it is not necessary, in this article, to understand how monads work in this example. The point is what various monads can do, which will be seen below. In other words, why use monads.
eval1 has the same behavior as eval0
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Map
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
type Eval1 alpha = Identity alpha
runEval1 :: Eval1 alpha -> alpha
runEval1 ev = runIdentity ev
eval1 :: Env -> Exp -> Eval1 Value
eval1 env (Lit i) = return $ IntVal i
eval1 env (Var n) = return $ fromJust (Map.lookup n env)
eval1 env (Plus e1 e2) = do IntVal i1 <- eval1 env e1
IntVal i2 <- eval1 env e2
return $ IntVal (i1 + i2)
eval1 env (Abs n e) = return $ FunVal env n e
eval1 env (App e1 e2) = do val1 <- eval1 env e1
val2 <- eval1 env e2
case val1 of
FunVal env' n body ->
eval1 (Map.insert n val2 env') body
exampleExp = Plus (Lit 12) (App (Abs "x" (Var "x")) (Plus (Lit 4) (Lit 2)))
-- show
main = do
putStrLn $ show $ runEval1 (eval1 Map.empty exampleExp)
-- ==> IntVal 18
putStrLn $ show $ runEval1 (eval1 Map.empty (Var "x"))
-- results in error : Maybe.fromJust: Nothing
-- /show(Note: runEval1 is used to get the result of eval1 "out" of the monad.)
The following sections will show how to leverage the monadic structure
of eval1 to fix problems with the evaluator by changing the type of
the evaluator to use more monads — all the while using the same
top-level structure of eval1.
adding error handling
unbound variables
Unbound variables are handled with Either (as in eval0e) but now
the wrapping/unwrapping of Left / Right is hidden "inside" the
monad definition of Either (not shown) rather than cluttering the
program.
eval2a is exactly the same as eval1 except for Var handling
and the type signature. That's the point, the evaluator has become
more powerful without extensive rewriting. Instead, more monads are
used (i.e., ErrorT).
-- String is the type arg to ErrorT : the type of exceptions in example
type Eval2 alpha = ErrorT String Identity alpha
runEval2 :: Eval2 alpha -> Either String alpha
runEval2 ev = runIdentity (runErrorT ev)
eval2a :: Env -> Exp -> Eval2 Value
eval2a env (Lit i) = return $ IntVal i
-- eval1 / eval2a diff:
eval2a env (Var n) = case Map.lookup n env of
Nothing -> fail $ "unbound var: " ++ n
Just v -> return v
eval2a env (Plus e1 e2) = do IntVal i1 <- eval2a env e1
IntVal i2 <- eval2a env e2
return $ IntVal (i1 + i2)
eval2a env (Abs n e) = return $ FunVal env n e
eval2a env (App e1 e2) = do val1 <- eval2a env e1
val2 <- eval2a env e2
case val1 of
FunVal env' n body -> eval2a (Map.insert n val2 env') bodyeval2a handles normal evaluation as before but also handles unbound
variables in a more useful manner:
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Map
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
-- String is the type arg to ErrorT : the type of exceptions in example
type Eval2 alpha = ErrorT String Identity alpha
runEval2 :: Eval2 alpha -> Either String alpha
runEval2 ev = runIdentity (runErrorT ev)
eval2a :: Env -> Exp -> Eval2 Value
eval2a env (Lit i) = return $ IntVal i
-- eval1 / eval2a diff:
eval2a env (Var n) = case Map.lookup n env of
Nothing -> fail $ "unbound var: " ++ n
Just v -> return v
eval2a env (Plus e1 e2) = do IntVal i1 <- eval2a env e1
IntVal i2 <- eval2a env e2
return $ IntVal (i1 + i2)
eval2a env (Abs n e) = return $ FunVal env n e
eval2a env (App e1 e2) = do val1 <- eval2a env e1
val2 <- eval2a env e2
case val1 of
FunVal env' n body -> eval2a (Map.insert n val2 env') body
exampleExp = Plus (Lit 12) (App (Abs "x" (Var "x")) (Plus (Lit 4) (Lit 2)))
-- show
main = do
putStrLn $ show $ runEval2 (eval2a Map.empty exampleExp)
-- ==> Right (IntVal 18)
putStrLn $ show $ runEval2 (eval2a Map.empty (Var "no-way"))
-- ==> Left "unbound var: no-way"
-- /showdynamic type errors
An improvement. But all the evaluators above still give poor error messages for incorrect dynamic typing:
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Map
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
-- String is the type arg to ErrorT : the type of exceptions in example
type Eval2 alpha = ErrorT String Identity alpha
runEval2 :: Eval2 alpha -> Either String alpha
runEval2 ev = runIdentity (runErrorT ev)
eval2a :: Env -> Exp -> Eval2 Value
eval2a env (Lit i) = return $ IntVal i
-- eval1 / eval2a diff:
eval2a env (Var n) = case Map.lookup n env of
Nothing -> fail $ "unbound var: " ++ n
Just v -> return v
eval2a env (Plus e1 e2) = do IntVal i1 <- eval2a env e1
IntVal i2 <- eval2a env e2
return $ IntVal (i1 + i2)
eval2a env (Abs n e) = return $ FunVal env n e
eval2a env (App e1 e2) = do val1 <- eval2a env e1
val2 <- eval2a env e2
case val1 of
FunVal env' n body -> eval2a (Map.insert n val2 env') body
exampleExp = Plus (Lit 12) (App (Abs "x" (Var "x")) (Plus (Lit 4) (Lit 2)))
-- show
-- 12 + (\x -> x)
main = putStrLn $ show $ runEval2 (eval2a Map.empty (Plus (Lit 12) (Abs "x" (Var "x"))))
-- ==> Left "Pattern match failure in do expression at /home/app/isolation-runner-work/projects/24798/src.205/Main.hs:42:31-39"
-- /showThat is fixed by pattern matching in Plus and App handling and
explicitly throwing an appropriate error:
eval2b :: Env -> Exp -> Eval2 Value
eval2b env (Lit i) = return $ IntVal i
eval2b env (Var n) = case Map.lookup n env of
Nothing -> fail $ "unbound var: " ++ n
Just v -> return v
eval2b env (Plus e1 e2) = do e1' <- eval2b env e1
e2' <- eval2b env e2
-- eval2a / eval2b diff:
case (e1', e2') of
(IntVal i1, IntVal i2) -> return $ IntVal (i1 + i2)
_ -> throwError "type error in Plus"
eval2b env (Abs n e) = return $ FunVal env n e
eval2b env (App e1 e2) = do val1 <- eval2b env e1
val2 <- eval2b env e2
-- eval2a / eval2b diff:
case val1 of
FunVal env' n body -> eval2b (Map.insert n val2 env') body
_ -> throwError "type error in App"The monadic structure enabled "throwing" the error without the need to
thread that error return throughout the code. Instead, it is hidden
and handled by the ErrorT monad.
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Map
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
-- String is the type arg to ErrorT : the type of exceptions in example
type Eval2 alpha = ErrorT String Identity alpha
runEval2 :: Eval2 alpha -> Either String alpha
runEval2 ev = runIdentity (runErrorT ev)
eval2b :: Env -> Exp -> Eval2 Value
eval2b env (Lit i) = return $ IntVal i
eval2b env (Var n) = case Map.lookup n env of
Nothing -> fail $ "unbound var: " ++ n
Just v -> return v
eval2b env (Plus e1 e2) = do e1' <- eval2b env e1
e2' <- eval2b env e2
-- eval2a / eval2b diff:
case (e1', e2') of
(IntVal i1, IntVal i2) -> return $ IntVal (i1 + i2)
_ -> throwError "type error in Plus"
eval2b env (Abs n e) = return $ FunVal env n e
eval2b env (App e1 e2) = do val1 <- eval2b env e1
val2 <- eval2b env e2
-- eval2a / eval2b diff:
case val1 of
FunVal env' n body -> eval2b (Map.insert n val2 env') body
_ -> throwError "type error in App"
-- show
main = do
putStrLn $ show $ runEval2 (eval2b Map.empty (Plus (Lit 12) (Abs "x" (Var "x"))))
-- ==> Left "type error in Plus"
putStrLn $ show $ runEval2 (eval2b Map.empty (App (Lit 12) (Lit 0)))
-- ==> Left "type error in App"
-- /showhiding the environment
The next change hides Env (via the ReaderT monad) since Env is
only extended in App and used in Var and Abs.
Notice how, for each successive evaluator (i.e., eval1, eval2,
eval3), an additional monad is pushed onto the front of the "monad
stack" used in the type of the evaluator. Likewise, the final value
expression evaluation is obtained by removing each monad layer via
runIdentity, runErrorT, runReaderT.
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Map
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
exampleExp = Plus (Lit 12) (App (Abs "x" (Var "x")) (Plus (Lit 4) (Lit 2)))
-- show
type Eval3 alpha = ReaderT Env (ErrorT String Identity) alpha
runEval3 :: Env -> Eval3 alpha -> Either String alpha
runEval3 env ev = runIdentity (runErrorT (runReaderT ev env))
eval3 :: Exp -> Eval3 Value
eval3 (Lit i) = return $ IntVal i
eval3 (Var n) = do env <- ask -- eval2b / eval3 diff
case Map.lookup n env of
Nothing -> throwError ("unbound variable: " ++ n)
Just val -> return val
eval3 (Plus e1 e2) = do e1' <- eval3 e1
e2' <- eval3 e2
case (e1', e2') of
(IntVal i1, IntVal i2) -> return $ IntVal (i1 + i2)
_ -> throwError "type error in Plus"
eval3 (Abs n e) = do env <- ask
return $ FunVal env n e
eval3 (App e1 e2) = do val1 <- eval3 e1
val2 <- eval3 e2
case val1 of
-- eval2b / eval3 diff
FunVal env' n body -> local (const (Map.insert n val2 env')) (eval3 body)
_ -> throwError "type error in App"
main = putStrLn $ show $ runEval3 Map.empty (eval3 exampleExp)
-- ==> Right (IntVal 18)
-- /showIn eval3, the ReaderT ask function is used to obtain Env in
Var and Abs, and local is used to extend Env for the recursive
call to eval3 in App. (Note: the local environment, in this
case, does not depend on the current environment, so const is used.)
Again, understanding the exact details mentioned here is not
necessary. Instead, notice how the code only changed where Env is
used. Nothing else changed (other than the type signature and not
giving Env as an explicit parameter to eval3).
adding state
As an example of state, the evaluator is extended with "profiling" : an integer counting calls to the evaluator. The state added is not state like a mutable location in imperative languages. It is "effectful" — meaning updated values are seen after updating but no locations are mutated. How that happens is not covered in this article.
The StateT monad is wrapped around the innermost monad Identity
(order of State and Error matters).
type Eval4 alpha = ReaderT Env (ErrorT String (StateT Integer Identity)) alpha
-- returns evaluation result (error or value) and state
-- give initial state arg for flexibility
runEval4 :: Env -> Integer -> Eval4 alpha -> (Either String alpha, Integer)
runEval4 env st ev = runIdentity (runStateT (runErrorT (runReaderT ev env)) st)
-- tick type not same as =Eval4= so it can reused elsewhere.
tick :: (Num s, MonadState s m) => m ()
tick = do st <- get
put (st + 1)
-- eval4 :: Exp -> Eval4 Value
eval4 (Lit i) = do tick
return $ IntVal i
eval4 (Var n) = do tick
env <- ask
case Map.lookup n env of
Nothing -> throwError ("unbound variable: " ++ n)
Just val -> return val
eval4 (Plus e1 e2) = do tick
e1' <- eval4 e1
e2' <- eval4 e2
case (e1', e2') of
(IntVal i1, IntVal i2) ->
return $ IntVal (i1 + i2)
_ -> throwError "type error in addition"
eval4 (Abs n e) = do tick
env <- ask
return $ FunVal env n e
eval4 (App e1 e2) = do tick
val1 <- eval4 e1
val2 <- eval4 e2
case val1 of
FunVal env' n body -> local (const (Map.insert n val2 env')) (eval4 body)
_ -> throwError "type error in application"eval4 is identical to eval3 (other than the change in type
signature) except each case starts by calling tick (and do is
added to Lit).
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Map
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
type Eval4 alpha = ReaderT Env (ErrorT String (StateT Integer Identity)) alpha
-- returns evaluation result (error or value) and state
-- give initial state arg for flexibility
runEval4 :: Env -> Integer -> Eval4 alpha -> (Either String alpha, Integer)
runEval4 env st ev = runIdentity (runStateT (runErrorT (runReaderT ev env)) st)
-- tick type not same as =Eval4= so it can reused elsewhere.
tick :: (Num s, MonadState s m) => m ()
tick = do st <- get
put (st + 1)
-- eval4 :: Exp -> Eval4 Value
eval4 (Lit i) = do tick
return $ IntVal i
eval4 (Var n) = do tick
env <- ask
case Map.lookup n env of
Nothing -> throwError ("unbound variable: " ++ n)
Just val -> return val
eval4 (Plus e1 e2) = do tick
e1' <- eval4 e1
e2' <- eval4 e2
case (e1', e2') of
(IntVal i1, IntVal i2) ->
return $ IntVal (i1 + i2)
_ -> throwError "type error in addition"
eval4 (Abs n e) = do tick
env <- ask
return $ FunVal env n e
eval4 (App e1 e2) = do tick
val1 <- eval4 e1
val2 <- eval4 e2
case val1 of
FunVal env' n body -> local (const (Map.insert n val2 env')) (eval4 body)
_ -> throwError "type error in application"
exampleExp = Plus (Lit 12) (App (Abs "x" (Var "x")) (Plus (Lit 4) (Lit 2)))
-- show
main = putStrLn $ show $ runEval4 Map.empty 0 (eval4 exampleExp)
-- (Right (IntVal 18),8) -- 8 reduction steps
-- /showadding logging
The evaluator is now extended to collect the name of each variable encountered during evaluation and return the collection when evaluation is done.
That is done via the WriterT monad.
(WriterT is a kind of a dual to ReaderT: WriterT can add (e.g.,
"write") values to result of computation, whereas ReaderT can only
use (e.g., "read") values passed in.)
type Eval5 alpha = ReaderT Env (ErrorT String (WriterT [String] (StateT Integer Identity))) alpha
runEval5 :: Env -> Integer -> Eval5 alpha -> ((Either String alpha, [String]), Integer)
runEval5 env st ev = runIdentity (runStateT (runWriterT (runErrorT (runReaderT ev env))) st)
eval5 :: Exp -> Eval5 Value
eval5 (Lit i) = do tick
return $ IntVal i
eval5 (Var n) = do tick
-- eval4 / eval5 diff
tell [n] -- collect name of each var encountered during evaluation
env <- ask
case Map.lookup n env of
Nothing -> throwError ("unbound variable: " ++ n)
Just val -> return val
eval5 (Plus e1 e2) = do tick
e1' <- eval5 e1
e2' <- eval5 e2
case (e1', e2') of
(IntVal i1, IntVal i2) -> return $ IntVal (i1 + i2)
_ -> throwError "type error in addition"
eval5 (Abs n e) = do tick
env <- ask
return $ FunVal env n e
eval5 (App e1 e2) = do tick
val1 <- eval5 e1
val2 <- eval5 e2
case val1 of
FunVal env' n body -> local (const (Map.insert n val2 env')) (eval5 body)
_ -> throwError "type error in application"The only change from eval4 to eval5 (besides type signature) is
the usage of tell in Var handling.
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Map
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
type Eval5 alpha = ReaderT Env (ErrorT String (WriterT [String] (StateT Integer Identity))) alpha
runEval5 :: Env -> Integer -> Eval5 alpha -> ((Either String alpha, [String]), Integer)
runEval5 env st ev = runIdentity (runStateT (runWriterT (runErrorT (runReaderT ev env))) st)
-- tick type not same as =Eval4= so it can reused elsewhere.
tick :: (Num s, MonadState s m) => m ()
tick = do st <- get
put (st + 1)
eval5 :: Exp -> Eval5 Value
eval5 (Lit i) = do tick
return $ IntVal i
eval5 (Var n) = do tick
-- eval4 / eval5 diff
tell [n] -- collect name of each var encountered during evaluation
env <- ask
case Map.lookup n env of
Nothing -> throwError ("unbound variable: " ++ n)
Just val -> return val
eval5 (Plus e1 e2) = do tick
e1' <- eval5 e1
e2' <- eval5 e2
case (e1', e2') of
(IntVal i1, IntVal i2) -> return $ IntVal (i1 + i2)
_ -> throwError "type error in addition"
eval5 (Abs n e) = do tick
env <- ask
return $ FunVal env n e
eval5 (App e1 e2) = do tick
val1 <- eval5 e1
val2 <- eval5 e2
case val1 of
FunVal env' n body -> local (const (Map.insert n val2 env')) (eval5 body)
_ -> throwError "type error in application"
exampleExp = Plus (Lit 12) (App (Abs "x" (Var "x")) (Plus (Lit 4) (Lit 2)))
-- show
main = putStrLn $ show $ runEval5 Map.empty 0 (eval5 exampleExp)
-- ==> ((Right (IntVal 18),["x"]),8)
-- /showAt first, it may seem like magic that state, logging, etc., can
suddenly be accessed even though they do not seem to appear as
explicit parameters. The magic is in eval's type signature. It is a
monad stack that is essentially a data structure (and more) being
passed throughout eval. Therefore ask, tell, etc., can access the
appropriate part of the stack when needed.
(Aside: There is some "utility" magic in the monad transformers (mtl).
Even though there is a stack of monads, and a function such as ask
needs to operate on a specific monad in the stack (i.e., ReaderT),
the monad transformer implementation "automatically" applies the
function to the appropriate monad in the stack, rather than the main
line code needing to explicitly access the right level.)
IO
The final extension is to add IO to the evaluator: eval6 will print
the value of each Lit encountered during evaluation.
type Eval6 alpha = ReaderT Env (ErrorT String (WriterT [String] (StateT Integer IO))) alpha
runEval6 :: Env -> Integer -> Eval6 alpha -> IO ((Either String alpha, [String]), Integer)
runEval6 env st ev = runStateT (runWriterT (runErrorT (runReaderT ev env))) st
eval6 :: Exp -> Eval6 Value
eval6 (Lit i) = do tick
-- eval5 / eval 6 diff
-- must use =liftIO= to lift into the currently running monad
liftIO $ print i -- print each int when evaluated
return $ IntVal i
eval6 (Var n) = do tick
tell [n]
env <- ask
case Map.lookup n env of
Nothing -> throwError ("unbound variable: " ++ n)
Just val -> return val
eval6 (Plus e1 e2) = do tick
e1' <- eval6 e1
e2' <- eval6 e2
case (e1', e2') of
(IntVal i1, IntVal i2) -> return $ IntVal (i1 + i2)
_ -> throwError "type error in addition"
eval6 (Abs n e) = do tick
env <- ask
return $ FunVal env n e
eval6 (App e1 e2) = do tick
val1 <- eval6 e1
val2 <- eval6 e2
case val1 of
FunVal env' n body -> local (const (Map.insert n val2 env')) (eval6 body)
_ -> throwError "type error in application"The only change from eval5 to eval6 (besides type signature) is
the usage of liftIO ... in Lit handling.
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.Identity
import "mtl" Control.Monad.Error
import "mtl" Control.Monad.Reader
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer
import Data.Maybe
import qualified Data.Map as Map
type Name = String -- variable names
data Exp = Lit Integer -- expressions
| Var Name
| Plus Exp Exp
| Abs Name Exp
| App Exp Exp
deriving (Eq, Show)
data Value = IntVal Integer -- values
| FunVal Env Name Exp
deriving (Eq, Show)
type Env = Map.Map Name Value -- from names to values
type Eval6 alpha = ReaderT Env (ErrorT String (WriterT [String] (StateT Integer IO))) alpha
runEval6 :: Env -> Integer -> Eval6 alpha -> IO ((Either String alpha, [String]), Integer)
runEval6 env st ev = runStateT (runWriterT (runErrorT (runReaderT ev env))) st
-- tick type not same as =Eval4= so it can reused elsewhere.
tick :: (Num s, MonadState s m) => m ()
tick = do st <- get
put (st + 1)
eval6 :: Exp -> Eval6 Value
eval6 (Lit i) = do tick
-- eval5 / eval 6 diff
-- must use =liftIO= to lift into the currently running monad
liftIO $ print i -- print each int when evaluated
return $ IntVal i
eval6 (Var n) = do tick
tell [n]
env <- ask
case Map.lookup n env of
Nothing -> throwError ("unbound variable: " ++ n)
Just val -> return val
eval6 (Plus e1 e2) = do tick
e1' <- eval6 e1
e2' <- eval6 e2
case (e1', e2') of
(IntVal i1, IntVal i2) -> return $ IntVal (i1 + i2)
_ -> throwError "type error in addition"
eval6 (Abs n e) = do tick
env <- ask
return $ FunVal env n e
eval6 (App e1 e2) = do tick
val1 <- eval6 e1
val2 <- eval6 e2
case val1 of
FunVal env' n body -> local (const (Map.insert n val2 env')) (eval6 body)
_ -> throwError "type error in application"
exampleExp = Plus (Lit 12) (App (Abs "x" (Var "x")) (Plus (Lit 4) (Lit 2)))
-- show
main = runEval6 Map.empty 0 (eval6 exampleExp) >>= putStrLn . show
-- prints 12 4 2 on separate lines and returns:
-- ==> ((Right (IntVal 18),["x"]),8)
-- /showsummary
The important point to see is that evaluators eval1 through eval6
all have the same structure. The only change between them is in the
type signature and the usage of specific monad functions (e.g., ask,
tell) to access data "in" the monad stack.
The mechanics of how state, logging, environment hiding, handling errors, etc., are weaved through that structure are hidden inside the monad implementations (rather than cluttering the main program).
Hopefully this article provides a glimpse into the power and usefulness of monads.
source code
The emacs org-mode literate source code of this article is available at:
feedback
Join the discussion at reddit
