(* Homework 2 Sample Solution *)

(****** local exception used internally by loop and exit ******)

exception ExitSignal of State

(******************** helper functions ********************)

fun uncurry f = (fn (x,y) => f x y)

fun bool true = Num 1
  | bool false = Num 0

fun getNum (Num n) = n
  | getNum _ = raise TypeError

fun getName (Name x) = x
  | getName _ = raise TypeError

fun getProc (Proc p) = p
  | getProc _ = raise TypeError

(******************** exec ********************)

fun exec (Push v) (vs,ds) = (v::vs,ds)
  | exec Add (n::m::vs,ds) = (Num (getNum m+getNum n)::vs,ds)
  | exec Neg (n::vs,ds) = (Num (~(getNum n))::vs,ds)
  | exec Eq (n::m::vs,ds) = (bool (getNum m=getNum n)::vs,ds)
  | exec Lt (n::m::vs,ds) = (bool (getNum m<getNum n)::vs,ds)
          (* Be careful about the order of arguments to < !! *)
  | exec Dup (v::vs,ds) = (v::v::vs,ds)
  | exec Exch (v2::v1::vs,ds) = (v1::v2::vs,ds)
  | exec Pop (v::vs,ds) = (vs,ds)
  | exec Read (vs,ds) = (Num (readNum ())::vs,ds)
  | exec Write (n::vs,ds) = (writeNum (getNum n); (vs,ds))
  | exec IfElse (fproc::tproc::n::vs,ds) =
           if getNum n <> 0 
           then execute (getProc tproc) (vs,ds)
           else execute (getProc fproc) (vs,ds)
  | exec Loop (body::vs,ds) =
           let fun loop state = loop (execute (getProc body) state)
           in 
	       loop (vs,ds)
               handle ExitSignal state => state
           end
  | exec Exit state = raise (ExitSignal state)
  | exec Begin (vs,d::ds) = (vs,d::d::ds)
  | exec End (vs,[d]) = raise EndWithoutBegin
  | exec End (vs,d::ds) = (vs,ds)
            (* Note that the first dict on the dict stack is the current
             * dict, not a saved dict, so the size of the dict stack
             * must never drop below one.
             *)
  | exec Def (v::x::vs,d::ds) =
           (vs,insert (getName x) v d::ds)
  | exec (Exec x) (vs,d::ds) =
           (case lookup x d of
              Proc proc => execute proc (vs,d::ds)
	    | v => (v::vs,d::ds))
  | exec _ _ = raise StackUnderflow

(******************** execute and interp ********************)


and execute cs state = foldl (uncurry exec) state cs

(* or without using foldl *)
(*

and execute [] state = state
  | execute (c::cs) state = let val state' = exec c state
                          in execute cs state'
                          end
*)
 

fun interp filename =
  let val prog = parse filename
      val (vs,_) = execute prog ([],[empty])
                   handle ExitSignal _ => raise ExitOutsideLoop
  in
      vs
  end