--------------------
-- Version one: Expressions with no side-effects

type Var = String
type Env = Var -> Integer

data Expr a = Lit a | Occ Var | Op (Expr a) Char (Expr a)

eval :: Expr Integer -> Integer

eval (Lit n)     env =  n
eval (Occ  x)    env =  env x
eval (Opr e p f) env =  sem p (eval e env) (eval f env)


--------------------
-- Version two: Expressions enhanced with updating variables

data Expr a = Lit a | Occ Var | Set Var (Expr a) | Op (Expr a) Char (Expr a)

eval :: (Expr Integer, Env) -> (Integer, Env)

eval (Lit n,    env)  =  (n,     env)
eval (Occ  x,   env)  =  (env x, env)
eval (Set  x e, env)) =  let (v, env')  = eval (e, env) in
						 (v, update env x v)
eval (Op e p f, env)  =  let (v, env')  = eval (f, env)
							 (v',env'') = eval (e, env') in
						 (getOp p v' v, env'')


--------------------
-- Version three: Monadic re-write of version 2

data Expr a = Lit a | Read | Occ Var | Set Var (Expr a) | Op  (Expr a) Char (Expr a)

eval :: Expr Integer -> Imp Env Integer

eval (Lit n)    = do { return  n }
eval (Occ  x  ) = do { a <- get x; return  a }
eval (Set  x e) = do { a <- eval e; set x a; return  a }
eval (Op e p f) = do { a <- eval f; b <- eval e; return (getOp p b a) }





{-  Other variations, using slightly different syntax

eval (Lit n)    = do return n
eval (Occ  x  ) = do a <- get x
					 return a
eval (Set  x e) = do a <- eval e
					 set x a
					 return a
eval (Op e p f) = do a <- eval f
					 b <- eval e
					 return (getOp p b a)
					 
					 
eval (Lit n)     =  do {                              return  n  }
eval (Occ  x  )  =  do {  a <- get  x;                return  a  }
eval (Set  x e)  =  do {  a <- eval e;  set x a;      return  a  }
eval (Op e p f)  =  do {  a <- eval f;  b <- eval e;  return (getOp p b a) }

-}



--------------------
-- Environments for identifiers

update env x v y = if y==x then v else env y
get x   = Imp (\s -> return (s, s x))
set x v = Imp (\s -> return (update s x v, ()))



--------------------
-- The imperative monad

newtype Imp s a = Imp (s -> (s, a))

instance Monad (Imp s) where
  return a    = Imp $ \s  -> return (s,a)
  Imp p >>= f = Imp $ \s0 -> do (s1, a1) <- p s0
								let Imp q = f a1
								(s2, a2) <- q s1
								return (s2, a2)



sem '+' = (+)
sem '*' = (*)
sem '-' = (-)