(*
 * A virtual machine.
 *)
structure VirtualMachine : VirtualMachine = struct
  open List
  open Env
  open Parser
  open Compiler

  exception Executing
  exception VMUndefVar  

  (*
   * exec executes a list cl of commands.
   * pc is a program counter, which is an integer.
   * stk is a stack, which is a list of integers.
   * env is an environment in which (variable,integer)-pairs are stored.
   *)
  fun exec cl pc stk env
      =  case nth (cl,pc) of
           (Push n) => exec cl (pc+1) (n::stk) env
         | (Load v) => (case lookup(v,env) of
                          NONE => raise VMUndefVar
                        | SOME x => exec cl (pc+1) (x::stk) env)
         | (Store v) 
           => exec cl (pc+1) (tl stk) (update (v,(hd stk),env))
         | MulMinusOne 
           => let val x1 = hd stk; 
              in exec cl (pc+1) ((~ x1)::(tl stk)) env end
         | Multiply
           => let val x2 = hd stk;
                  val x1 = hd (tl stk)
              in exec cl (pc+1) ((x1*x2)::(tl (tl stk))) env end
         | Divide
           => let val x2 = hd stk;
                  val x1 = hd (tl stk)
              in exec cl (pc+1) ((x1 div x2)::(tl (tl stk))) env end
         | Add
           => let val x2 = hd stk;
                  val x1 = hd (tl stk)
              in exec cl (pc+1) ((x1+x2)::(tl (tl stk))) env end
         | Subtract
           => let val x2 = hd stk;
                  val x1 = hd (tl stk)
              in exec cl (pc+1) ((x1-x2)::(tl (tl stk))) env end
         | LessThan
           => let val x2 = hd stk;
                  val x1 = hd (tl stk);
                  val x = case x1 < x2 of true => 1 | false => 0
              in exec cl (pc+1) (x::(tl (tl stk))) env end
         | GreaterThan
           => let val x2 = hd stk;
                  val x1 = hd (tl stk);
                  val x = case x1 > x2 of true => 1 | false => 0
              in exec cl (pc+1) (x::(tl (tl stk))) env end
         | Equal
           => let val x2 = hd stk;
                  val x1 = hd (tl stk);
                  val x = case x1 = x2 of true => 1 | false => 0
              in exec cl (pc+1) (x::(tl (tl stk))) env end
         | NotEqual
           => let val x2 = hd stk;
                  val x1 = hd (tl stk);
                  val x = case x1 <> x2 of true => 1 | false => 0
              in exec cl (pc+1) (x::(tl (tl stk))) env end
         | And
           => let val x2 = hd stk;
                  val x1 = hd (tl stk);
                  val x = case x1 <> 0 andalso x2 <> 0 of true => 1 | false => 0
              in exec cl (pc+1) (x::(tl (tl stk))) env end
         | Or
           => let val x2 = hd stk;
                  val x1 = hd (tl stk);
                  val x = case x1 <> 0 orelse x2 <> 0 of true => 1 | false => 0
              in exec cl (pc+1) (x::(tl (tl stk))) env end
         | (Jump n) => exec cl (pc+n) stk env
         | (JumpOnCond n)
           => let val x = case (hd stk) <> 0 of true => n | false => 1
              in exec cl (pc+x) (tl stk) env end
         | Quit => env

  fun vm cl = toList (exec cl 0 [] empty)
end