My own notes and exercises written while reading Wadler's wonderful "Monads for Functional Programming" in 1998

interp.lhs

A really simple interpreter to use while learning about monads.  Based on
the paper "Monads for Functional Programming" by Phil Wadler.

the type of terms:

> data Term = Con Int
>	    | Div Term Term
>   deriving Show

A test term:

> test = Div (Div (Con 2772) (Con 33)) (Con 2)

A simple evaluator:

> eval :: Term -> Int
> eval (Con v) = v
> eval (Div t1 t2) = (eval t1) `div` (eval t2)


Now let's write a version that counts the number of divisions:

>
> type Answer = (State, Int)
> type State = Int

The first int is the number of divisions performed during evaluation,
the second is the result.

> eval2 :: Term -> Answer
> eval2 (Con v) = (0, v)
> eval2 (Div t1 t2) =
>   let (c1, v1) = eval2 t1
>       (c2, v2) = eval2 t2
>   in (c1 + c2 + 1, v1 `div` v2)

OK, eval2 worked, but it has a slightly odd property:  The definition of
eval2 doesn't take a State as an input parameter.  So it isn't really
"stateful" per se.  A truly stateful interpreter would take a state as
an input parameter *and* produce a state as a result (paired with an
answer).

> eval3 :: Term -> State -> Answer
> eval3 (Con v) s = (s, v)
> eval3 (Div t1 t2) s =
>   let (s', v1) = eval3 t1 s
>	(s'', v2) = eval3 t2 s'
>   in (s'' + 1, v1 `div` v2)
 
First, let's try and abstract over a state transformer:  Something that,
given an initial state, will give us a new state and something else:

> type ST = State -> Answer

(remember Answer is really (State, Int)!)

then, we have:

> eval4 :: Term -> ST
> eval4 (Con v) = \s -> (s,v)
> eval4 (Div t1 t2) = \s ->
>	let (s',v1) = eval4 t1 s
>	    (s'',v2) = eval4 t2 s'
>	in (s'' + 1, v1 `div` v2)

which is entirely equivalent to eval3.

But, of course, we can introduce a true data type for ST, at the cost of
needing to explicitly use pattern matching to extract the value carried
with values of that type:

> data SM a = SM (State -> (State, a))

then clearly eval3 is equivalent to:

> eval5 :: Term -> SM Int
> eval5 (Con v) = SM (\s -> (s,v))
> eval5 (Div t1 t2) = SM (\s ->
>	let (SM st1) = eval5 t1
>	    (s', v1) = st1 s
>	    (SM st2) = eval5 t2
>	    (s'', v2) = st2 s'	    
>	in (s'' + 1, v1 `div` v2))

A little utility function that takes an evaluator that produces an SM Int
and gives us a state transformer function

> testSMe :: (Term -> SM Int) -> Term -> (State -> (State, Int))
> testSMe f term = let (SM st) = f term in st

This lets us test by typing:
testSMe eval5 test 0
at the hugs prompt.

OK, now let's try making SM a monad:

> instance Monad SM where
>   return v = SM (\s -> (s,v))
>   (>>=) = smbind

> smbind :: SM a -> (a -> SM b) -> SM b
> smbind sm0 fsm1 = SM (\s ->
>	 let (SM st0) = sm0
>	     (s', v1) = st0 s
>	     (SM st1) = fsm1 v1
>	     (s'', v2) = st1 s'
>	 in (s'', v2))

Now, let's REWRITE our evaluator in terms of this monad:

> eval6 :: Term -> SM Int
> eval6 (Con v) = return v
> eval6 (Div t1 t2) = (eval6 t1) >>= (\v1 ->
>		                      (eval6 t2) >>= (\v2 ->
>                                                     SM (\s -> (s+1,(v1 `div` v2)))))

> tryeval6 = let (SM st) = eval6 test in st

which we can rewrite using do syntax as:

> eval7 :: Term -> SM Int
> eval7 (Con v) = return v
> eval7 (Div t1 t2) =
>   do v1 <- eval7 t1
>      v2 <- eval7 t2
>      SM (\s -> (s+1,(v1 `div` v2)))

We can add a combinator to update the state of a state monad:

> updateS :: (State -> State) -> SM ()
> updateS f = SM (\s -> (f s, ()))

(Note that, obviously, the value part of the tuple is ()).

Now we can write:

> eval8 :: Term -> SM Int
> eval8 (Con v) = return v
> eval8 (Div t1 t2) =
>   do v1 <- eval8 t1
>      v2 <- eval8 t2
>      updateS (\s -> s+1)
>      return (v1 `div` v2)

Hmmmmm.  What is REALLY going on here?  better put this back in explicit
form by getting rid of the do syntax to see what updateS does:

> eval9 :: Term -> SM Int
> eval9 (Con v) = return v
> eval9 (Div t1 t2) =
>   eval9 t1 >>= (\v1 ->
>                 eval9 t2 >>= (\v2 ->
>                               updateS (\s -> s+1) >>= (\_ ->
>							 return (v1 `div` v2))))