(*
 * There is a function 'evaluate' in the following structure that
 * allows you to evaluate programs. So after type checking a program,
 * you should call 'evaluate' on the program to see if the program
 * evaluates as is expected.
 *)

structure Expressions =
    struct
	structure A = Array
	structure S = Symbol

	datatype oper =
	    PlusOp | MinusOp | TimesOp | DivideOp
	  | GtOp | GeOp | LtOp | LeOp
	  | AndOp | OrOp
	  | IntEq | IntNeq | StrEq | StrNeq | TupEq | TupNeq

	datatype var =
	    SimpleVar of S.symbol
	  | SelectVar of var * int
	  | SubscriptVar of var * exp

	and exp =
	    VarExp of var
	  | NilExp
	  | IntExp of int
	  | StringExp of string
	  | CallExp of S.symbol * exp list
	  | OpExp of exp * oper * exp
	  | ArrayExp of exp * exp (* size and init *)
	  | TupleExp of exp list
	  | SeqExp of exp list
	  | AssignExp of var * exp
	  | IfThenExp of exp * exp
	  | IfThenElseExp of exp * exp * exp
	  | WhileExp of exp * exp
	  | BreakExp
	  | LetExp of dec list * exp

	and dec =
	    FunDec of fundec list
	  | VarDec of S.symbol * exp * bool ref
	    (* var, init, escape *)

	withtype param = S.symbol * bool ref

	and fundec = S.symbol * param list * exp

	val subscriptError =
	    SeqExp [CallExp (S.symbol "print", [StringExp "Subscript Error"]),
		    CallExp (S.symbol "exit", [IntExp 1])]

	fun for2while (ind: S.symbol, esc: bool ref,
		       lo: exp, hi: exp, body: exp): exp =
	    let
		val indVar = SimpleVar ind
		val lim = S.newSymbol ()
		val limVar = SimpleVar lim
	    in
		LetExp ([VarDec (ind, lo, esc),
			 VarDec (lim, hi, ref false)],
			WhileExp (OpExp (VarExp indVar, LeOp, VarExp limVar),
				  SeqExp [body,
					  AssignExp (indVar,
						     OpExp (VarExp indVar, PlusOp, IntExp 1))]))
	    end

	datatype value =
	    ArrVal of value A.array
	  | IntVal of int
	  | StrVal of string
	  | TupVal of value A.array

	val UnitVal = IntVal 0

	datatype valueRef =
	    RefVR of value ref
	  | ArrVR of value A.array * int

	fun readVR (RefVR r) = !r
	  | readVR (ArrVR (a, i)) = A.sub (a, i)

	fun writeVR (RefVR r, v) = (r := v)
	  | writeVR (ArrVR (a, i), v) = A.update (a, i, v)

	type venv = (valueRef) S.table

	val base_venv = S.empty

	datatype function =
	    Fun0 of (value list -> value)
	  | Fun1 of S.symbol list * exp

	type fenv = function S.table

	exception Exit of int

	val initFunList: (S.symbol * function) list =
	    [(S.symbol "print", Fun0 (fn [StrVal s] => (print s; UnitVal))),

	     (S.symbol "flush",
	      Fun0 (fn [] => (TextIO.flushOut (TextIO.stdOut); UnitVal))),

	     (S.symbol "ord",
	      Fun0 (fn [StrVal s] =>
		    case Char.fromString s of
			SOME c => IntVal (Char.ord c)
		      | NONE => Error.err "function ord: argument is not a char")),
	     (S.symbol "chr",
	      Fun0 (fn [IntVal i] => StrVal (Char.toString (Char.chr i)))),

	     (S.symbol "getchar",
	      Fun0 (fn [] =>
		    case TextIO.input1 (TextIO.stdIn) of
			SOME c => StrVal (Char.toString c) | NONE => StrVal "")),
	     (S.symbol "not",
	      Fun0 (fn [IntVal i] => if i = 0 then IntVal 1 else UnitVal)),

	     (S.symbol "concat",
	      Fun0 (fn [StrVal s, StrVal s'] => StrVal (s ^ s'))),

	     (S.symbol "size",
	      Fun0 (fn [StrVal s] => IntVal (String.size s))),

	     (S.symbol "substring",
	      Fun0 (fn [StrVal s, IntVal b, IntVal e] =>
		    StrVal (String.substring (s, b, e)))),

	     (S.symbol "exit", Fun0 (fn [IntVal i] => raise (Exit i)))]


	val base_fenv = S.enterList (S.empty, initFunList)

	exception Break

	fun evalVar (fenv: fenv, venv: venv, v: var): valueRef =
	    case v of
		SimpleVar id =>
		    (case S.look (venv, id) of
			 SOME v => v
		       | NONE => Error.err ("evalVar: unbound variable: " ^ S.name id))
	      | SelectVar (v, i) =>
		  let
		      val v = evalVar (fenv, venv, v)
		      val TupVal a = readVR v
		  in
		      ArrVR (a, i)
		  end
	      | SubscriptVar (v, e) =>
		  let
		      val v = evalVar (fenv, venv, v)
		      val ArrVal a = readVR v
		      val IntVal i = evalExp (fenv, venv, e)
		  in
		      ArrVR (a, i)
		  end		

	and evalExp (fenv: fenv, venv: venv, e: exp): value =
	    case e of
		VarExp v => let val v = evalVar (fenv, venv, v) in readVR v end

	      | NilExp => UnitVal
	      | IntExp i => IntVal i
	      | StringExp s => StrVal s

	      | CallExp (fid, es) =>
                  let
		      val es = evalExpList (fenv, venv, es)
		      val SOME f = S.look (fenv, fid)
		  in
		      case f of
			  Fun0 f => f es
			| Fun1 (ids, body) =>
                            let
				fun aux ([], [], venv) = venv
				  | aux (id :: ids, e :: es, venv) =
				    let
					val venv = S.enter (venv, id, RefVR (ref e))
				    in
					aux (ids, es, venv)
				    end
				val venv = aux (ids, es, venv)
			    in
				evalExp (fenv, venv, body)
			    end
		  end

	      | OpExp (e1, oper, e2) =>
		  let
		      val e1 = evalExp (fenv, venv, e1)
		      val e2 = evalExp (fenv, venv, e2)
		  in
		      case oper of
			  PlusOp =>
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				IntVal (i1 + i2)
			    end
			| MinusOp =>
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				IntVal (i1 - i2)
			    end
			| TimesOp =>
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				IntVal (i1 * i2)
			    end
			| DivideOp =>
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				IntVal (i1 div i2)
			    end
			| GtOp =>
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				if i1 > i2 then IntVal 1 else IntVal 0
			    end
			| GeOp =>
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				if i1 >= i2 then IntVal 1 else IntVal 0
			    end
			| LtOp =>
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				if i1 < i2 then IntVal 1 else IntVal 0
			    end
			| LeOp =>
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				if i1 <= i2 then IntVal 1 else IntVal 0
			    end
			| AndOp => 
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				if i1 <> 0 then 
				    if i2 <> 0 then IntVal 1 else IntVal 0
				else IntVal 0
			    end
			| OrOp => 
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				if i1 <> 0 then IntVal 1
				else if i2 <> 0 then IntVal 1 else IntVal 0
			    end
			| IntEq =>
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				if i1 = i2 then IntVal 1 else IntVal 0
			    end
			| IntNeq =>
			    let
				val IntVal i1 = e1 and IntVal i2 = e2
			    in
				if i1 <> i2 then IntVal 1 else IntVal 0
			    end
			| StrEq => 
			    let
				val StrVal s1 = e1 and StrVal s2 = e2
			    in
				if s1 = s2 then IntVal 1 else IntVal 0
			    end
			| StrNeq => 
			    let
				val StrVal s1 = e1 and StrVal s2 = e2
			    in
				if s1 = s2 then IntVal 0 else IntVal 1
			    end
			| TupEq =>
			    (case (e1, e2) of
				 (IntVal _, IntVal _) => IntVal 1
			       | (IntVal _, TupVal _) => IntVal 0
			       | (TupVal _, IntVal _) => IntVal 0
			       | (_, _) => Error.err "eval: TupEq")
			| TupNeq =>
			    (case (e1, e2) of
				 (IntVal _, IntVal _) => IntVal 0
			       | (IntVal _, TupVal _) => IntVal 1
			       | (TupVal _, IntVal _) => IntVal 1
			       | (_, _) => Error.err "eval: TupEq")
		  end

	  | ArrayExp (e1, e2) =>
              let
		  val IntVal i1 = evalExp (fenv, venv, e1)
		  and e2 = evalExp (fenv, venv, e2)
	      in
		  ArrVal (A.array (i1, e2))
	      end

	  | TupleExp es =>
	      let
		  val es = evalExpList (fenv, venv, es)
	      in
		  TupVal (A.fromList es)
	      end

	  | SeqExp es =>
	      let
		  fun aux (res, []) = res
		    | aux (res, e :: es) =
		      aux (evalExp (fenv, venv, e), es)
	      in
		  aux (UnitVal, es)
	      end

	  | AssignExp (v, e) =>
	      (writeVR (evalVar (fenv, venv, v), evalExp (fenv, venv, e)); UnitVal)

	  | IfThenExp (e1, e2) =>
	      let
		  val IntVal i1 = evalExp (fenv, venv, e1)
	      in
		  if i1 <> 0 then evalExp (fenv, venv, e2) else UnitVal
	      end

	  | IfThenElseExp (e1, e2, e3) =>
	      let
		  val IntVal i1 = evalExp (fenv, venv, e1)
	      in
		  if i1 <> 0 then evalExp (fenv, venv, e2) else evalExp (fenv, venv, e3)
	      end

	  | WhileExp (e1, e2) =>
	      let
		  fun loop () =
		      let
			  val IntVal i1 = evalExp (fenv, venv, e1)
		      in
			  if i1 <> 0 then (evalExp (fenv, venv, e2); loop ())
			  else UnitVal
		      end
	      in
		  loop () handle Break => IntVal 0
	      end
	  
	  | BreakExp => raise Break

	  | LetExp (ds, e) =>
	      let
		  val (fenv, venv) = evalDecs (fenv, venv, ds)
	      in
		  evalExp (fenv, venv, e)
	      end

	and evalExpList (fenv: fenv, venv: venv, es: exp list): value list =
	    List.map (fn e => evalExp (fenv, venv, e)) es

	and evalDec (fenv: fenv, venv: venv, d: dec): fenv * venv =
	    case d of
		FunDec fds => evalFunDec (fenv, venv, fds)
	      | VarDec (id, e, _) =>
		  let
		      val e = evalExp (fenv, venv, e)
		      val r = ref e
		      val venv = S.enter (venv, id, RefVR r)
		  in
		      (fenv, venv)
		  end

	and evalFunDec (fenv: fenv, venv: venv, fds: fundec list): fenv * venv =
	    let
		val fenv =
		    List.foldr
		    (fn ((fid, params, body), fenv) =>
		     S.enter (fenv, fid, Fun1 (List.map (fn (id, _) => id) params, body)))
		    fenv fds
	    in
		(fenv, venv)
	    end

	and evalDecs (fenv: fenv, venv: venv, ds: dec list): fenv * venv =
	    case ds of
		[] => (fenv, venv)
	      | d :: ds =>
		 let
		     val (fenv, venv) = evalDec (fenv, venv, d)
		 in
		     evalDecs (fenv, venv, ds)
		 end

	fun evaluate (e: exp): value =
	    evalExp (base_fenv, base_venv, e)
    end