datatype Exp = 
  Constant of int               (*   5     *)
| Variable of string            (*   x     *)
| Minus of (Exp * Exp)          (*  x - 5  *)
| Greater of (Exp * Exp)        (*  x > 1  *)
| Times of (Exp * Exp)          (*  x * 4  *)
| Divide of (Exp * Exp)         (* x / 3   *)


datatype Com =
  Assign of (string * Exp)         (*  x := 1                       *)
| Seq of (Com * Com)               (*  { x := 1; y := 2 }           *)
| If of (Exp * Com * Com)          (*  if x then x := 1 else y := 1 *) 
| While of (Exp * Com)             (*  while x>0 do x := x - 1      *)
| Declare of (string * Exp * Com)  (*  Declare x = 1 in x := x - 1  *) 
| Print of string * Exp            (* Print "answer" (x+2)          *) 



(* ***** environments ****** *)

exception Error;

fun error s = (print s; raise Error);

type env = string list * int list ;

fun lookup x [] = error ("variable not found: "^x)
  | lookup x ((y,v)::zs) = if x=y then v else lookup x zs;

fun ext nm v zs = (nm,v)::zs;

fun remove (z::zs) = zs;

fun set name v [] = error ("name not found: "^name)
  | set name v ((z as (y,_))::zs) =
     if name=y then (y,v)::zs else z::(set name v zs);



(* ************* interpreters ************** *)

type env = (string * int) list;

(* eval0 : Exp -> env -> int   *)
fun eval0 exp env  = 
case exp of
  Constant n => n
| Variable s => lookup s env
| Minus(x,y) =>   let val a = eval0 x env 
                      val b = eval0 y env
                  in a - b end
| Greater(x,y) => let val a = eval0 x env
                      val b = eval0 y env
                  in if a '>' b then 1 else 0 end
| Times(x,y) =>   let val a = eval0 x env
                      val b = eval0 y env

                  in a * b end;
				
(* interp0 : Com -> env -> env *)
fun interp0 stmt env =
case stmt of
  Assign(name,e) => 
   let val v = eval0 e env 
   in set name v env end 
| Seq(s1,s2) => 
   let val env1 = interp0 s1 env 
       val env2 = interp0 s2 env1 
   in env2 end 
| If(e,s1,s2) =>
   let val x = eval0 e env
   in if x=1 
	     then interp0 s1 env
	     else interp0 s2 env
   end
| While(e,body) => 
   let fun loop env =
           let val v = eval0 e env
           in if v=0 
                 then env
                 else let val env1 =  interp0 body env
                      in loop env1 end
           end
    in loop env end
| Declare(nm,e,stmt) =>
   let val v = eval0 e env
       val env1 = ext nm v env 
   in remove(interp0 stmt env1) end;   


(* ******* Suppose we add a print statement ******* *)

			
(* interp1 : Com -> env -> (env * string) *)
fun interp1 stmt env =
case stmt of
  Assign(name,e) => 
   let val v = eval0 e env 
   in (set name v env,"") end 
| Seq(s1,s2) => 
   let val (env1,s1) = interp1 s1 env 
       val (env2,s2) = interp1 s2 env1 
   in (env2,s1 ^ s2) end 
| If(e,s1,s2) =>
   let val x = eval0 e env
   in if x=1 
	     then interp1 s1 env
	     else interp1 s2 env
   end
| While(e,body) => 
   let fun loop env s =
           let val v = eval0 e env
           in if v=0 
                 then (env,s)
                 else let val (env1,s1) = interp1 body env
                      in loop env1 (s^s1) end
           end
    in loop env "" end
| Declare(nm,e,stmt) =>
   let val v = eval0 e env
       val env1 = ext nm v env
       val (env2,s) = interp1 stmt env1  
   in (remove env2,s) end;   

(* ************ Add divide and cope with division by 0 ************ *)



(* eval2 : Exp -> env -> int option   *)
fun eval2 exp env  = 
case exp of
  Constant n => SOME n
| Variable s => SOME (lookup s env)
| Minus(x,y) => 
   (case eval2 x env of
       SOME a => (case eval2 y env of
                    SOME b => SOME(a - b)
                  | _ => NONE)
    | _ => NONE) 
| Greater(x,y) => 
   (case eval2 x env of
       SOME a => (case eval2 y env of
                    SOME b => SOME(if a '>' b then 1 else 0)
                  | _ => NONE)
    | _ => NONE)
| Times(x,y) => 
   (case eval2 x env of
       SOME a => (case eval2 y env of
                    SOME b => SOME(a * b)
                  | _ => NONE)
    | _ => NONE) 
| Divide(x,y) => 
   (case eval2 x env of
       SOME a => (case eval2 y env of
                    SOME 0 => NONE
                  | SOME b => SOME(a div b)
                  | _ => NONE)
    | _ => NONE) 


		
(* interp2 : Com -> env -> env option *)
fun interp2 stmt env =
case stmt of
  Assign(name,e) => 
   (case eval2 e env of
      SOME v => SOME(set name v env)
    | _ => NONE)
| Seq(s1,s2) => 
   (case interp2 s1 env of
      SOME env1 => interp2 s2 env1
    | NONE => NONE)
| If(e,s1,s2) =>
   (case eval2 e env of
      SOME x => if x=1 
	           then interp2 s1 env
	           else interp2 s2 env
    | NONE => NONE)
;

(* ************ What about one that returns multiple values ************ *)



type env = (string * int list) list;


fun mapp f [] = []
  | mapp f (x::xs) = (f x) @ (mapp f xs);

(* eval3 : Exp -> env -> int   *)
fun eval3 exp env  = 
case exp of
  Constant n => [n]
| Variable s => lookup s env
| Minus(x,y) =>   
   let val xs = eval3 x env 
       fun f x = let val ys = eval3 y env
                     fun g y = [x - y]
                 in mapp g ys end
   in mapp f xs end
| Greater(x,y) => 
   let val xs = eval3 x env 
       fun f x = let val ys = eval3 y env
                     fun g y = [ if x '>' y then 1 else 0]
                 in mapp g ys end
   in mapp f xs end
| Times(x,y) =>   
   let val xs = eval3 x env 
       fun f x = let val ys = eval3 y env
                     fun g y = [x * y]
                 in mapp g ys end
   in mapp f xs end

val env3 = [("x",[9,5]),("y",[2,4])]
val test2 = eval3 (Minus (Variable "x",Variable "y")) env3;

(* What about an inerpreter with all these features? *)

(* *************  monads ********************* *)


fun return x = (x,"");
fun bind (x,s1) g = let val (y,s2) = g x in (y,s1^s2) end;


fun return x = SOME x;
fun bind (SOME x) g = g x
  | bind NONE g = NONE;

fun return x = [x];
fun bind xs g = mapp g xs;


(* ********************************************** *)

datatype 'a OP = OP of 'a * string;

fun return x = OP(x,"");

fun bind (OP(x,s1)) g = let val OP(y,s2) = g x in OP(y,s1^s2) end;

val om = Mon(return,bind);

(* ********************************************** *)



val em = let fun return x = SOME x;
             fun bind (SOME x) g = g x
               | bind NONE g = NONE;
         in Mon(return,bind) end;

(* *********************************************** *)


val mvm = 
  let fun return x = [x];
      fun mapp f [] = []
        | mapp f (x::xs) = (f x) @ (mapp f xs);
      fun bind xs g = mapp g xs;
  in Mon(return,bind) end;



(* ******************************************************* *)

fun eval4 m exp env  = 
case exp of
  Constant n => Return m n
| Variable s => lookup s env
| Minus(x,y) => 
    Do m { a <- eval4 m x env 
         ; b <- eval4 m y env
         ; Return m (a - b)
         }
| Greater(x,y) => 
    Do m { a <- eval4 m x env 
         ; b <- eval4 m y env
         ; Return m (if a '>' b then 1 else 0)
         }
| Times(x,y) =>  
    Do m { a <- eval4 m x env 
         ; b <- eval4 m y env
         ; Return m (a * b)
         }

(*
| Divide(x,y) =>  
    Do m { a <- eval4 m x env 
         ; b <- eval4 m y env
         ; if b = 0
              then NONE
              else Return m (a div b)
         }
*)


val term = (Minus (Variable "x",Variable "y"))

val envMVM = [("x",[9,5]),("y",[2,4])]
val ans1 = eval4 mvm term envMVM;
 
val envEM = [("x",SOME 4),("y",SOME 2)]
val ans2 = eval4 em term envEM;

(* *********************************************** *)


fun interp4 m stmt env =
case stmt of
  Assign(name,e) => 
   Do m { v <- eval4 m e env 
        ; Return m(set name (Return m v) env) }
| Seq(s1,s2) => 
   Do m { env1 <- interp4 m s1 env 
        ; interp4 m s2 env1 }
| If(e,s1,s2) =>
   Do m { x <- eval4 m e env
        ; if x=1 
	     then interp4 m s1 env
	     else interp4 m s2 env }
| While(e,body) => 
   let fun loop env =
            Do m { v <- eval4 m e env
                 ; if v=0 
                      then Return m env
                      else Do m { env1 <- interp4 m body env
                                ; loop env1 }}
    in loop env end
| Declare(nm,e,stmt) =>
   Do m { v <- eval4 m e env
        ; env2 <- interp4 m stmt (ext nm (Return m v) env)
        ; Return m (remove env2) } ;  


(* ************************************************** *)

datatype 'a M = M of (('a list) option) * string;

fun return x = M(SOME[x],"");
fun mapp f [] = M(SOME[],"")
  | mapp f (x::xs) = 
       (case f x of 
          M(NONE,s) => M(NONE,s)
        | M(SOME ys,s1) => 
            (case mapp f xs of
               M(SOME zs,s2) => M(SOME(ys @ zs),s1^s2)
             | M(NONE,s2) => M(NONE,s1^s2)))
  
fun bind (M(NONE,s)) g = M(NONE,s)
  | bind (M(SOME xs,s1)) g = let val M(zs,s2) = mapp g xs in M(zs,s1^s2) end

val m = Mon(return,bind);


fun output s = M(SOME[s],s);
fun fail s = M(NONE,s);


(* ****************************************************** *)



fun eval5 exp env  = 
case exp of
  Constant n => Return m n
| Variable s => lookup s env
| Minus(x,y) =>   Do m { a <- eval5 x env 
                       ; b <- eval5 y env
                       ; Return m (a - b) }
| Greater(x,y) => Do m { a <- eval5 x env 
                       ; b <- eval5 y env
                       ; Return m (if a '>' b then 1 else 0)}
| Times(x,y) =>   Do m { a <- eval5 x env 
                       ; b <- eval5 y env
                       ; Return m (a * b) }
| Divide(x,y) =>  Do m { a <- eval5 x env 
                       ; b <- eval5 y env
                       ; if b = 0
                            then fail "Divide by 0"
                            else Return m (a div b) }



(* interp5 : Com -> (string * int M) list -> (string * int M) list M *)
fun interp5 stmt env =
case stmt of
  Assign(name,e) => 
   Do m { v <- eval5 e env; Return m(set name (Return m v) env) }
| Seq(s1,s2) => 
   Do m { env1 <- interp5 s1 env; interp5 s2 env1 }
| If(e,s1,s2) =>
   Do m { x <- eval5 e env
        ; if x=1 then interp5 s1 env  else interp5 s2 env }
| While(e,body) => 
   let fun loop env =
            Do m { v <- eval5 e env
                 ; if v=0 
                      then Return m env
                      else Do m { env1 <- interp5 body env
                                ; loop env1 }}
    in loop env end
| Declare(nm,e,stmt) =>
   Do m { v <- eval5 e env
        ; env2 <- interp5 stmt (ext nm (Return m v) env)
        ; Return m (remove env2) }
| Print(s,e) =>
   Do m { v <- eval5 e env
        ; output (s^" "^(show v))
        ; Return m env }