(*
 * A compiler.
 *)
structure Compiler : Compiler = struct
  open Parser

  exception CmplNonVarLHSofAssign
  exception ComplNonVarAfterFor

  (*
   * Commands.
   *)
  datatype command =
    Push of int
  | Load of string
  | Store of string
  | MulMinusOne
  | Multiply
  | Divide
  | Add
  | Subtract
  | LessThan
  | GreaterThan
  | Equal
  | NotEqual
  | And
  | Or
  | Jump of int
  | JumpOnCond of int
  | Quit

  (*
   * generatorForExp generates a list of commands for an expressions.
   *)
  fun generatorForExp (NumNode n) = [Push n]
    | generatorForExp (VarNode v) = [Load v]
    | generatorForExp (UminusNode e) 
      = let val cl = generatorForExp e in cl @ [MulMinusOne] end
    | generatorForExp (MulNode (e1,e2))
      = let val cl1 = generatorForExp e1; 
            val cl2 = generatorForExp e2
        in cl1 @ cl2 @ [Multiply] end
    | generatorForExp (DivNode (e1,e2))
      = let val cl1 = generatorForExp e1; 
            val cl2 = generatorForExp e2
        in cl1 @ cl2 @ [Divide] end
    | generatorForExp (PlusNode (e1,e2))
      = let val cl1 = generatorForExp e1; 
            val cl2 = generatorForExp e2
        in cl1 @ cl2 @ [Add] end
    | generatorForExp (MinusNode (e1,e2))
      = let val cl1 = generatorForExp e1; 
            val cl2 = generatorForExp e2
        in cl1 @ cl2 @ [Subtract] end
    | generatorForExp (LtNode (e1,e2))
      = let val cl1 = generatorForExp e1; 
            val cl2 = generatorForExp e2
        in cl1 @ cl2 @ [LessThan] end
    | generatorForExp (GtNode (e1,e2))
      = let val cl1 = generatorForExp e1; 
            val cl2 = generatorForExp e2
        in cl1 @ cl2 @ [GreaterThan] end
    | generatorForExp (EqNode (e1,e2))
      = let val cl1 = generatorForExp e1; 
            val cl2 = generatorForExp e2
        in cl1 @ cl2 @ [Equal] end
    | generatorForExp (NeqNode (e1,e2))
      = let val cl1 = generatorForExp e1; 
            val cl2 = generatorForExp e2
        in cl1 @ cl2 @ [NotEqual] end
    | generatorForExp (AndNode (e1,e2))
      = let val cl1 = generatorForExp e1; 
            val cl2 = generatorForExp e2
        in cl1 @ cl2 @ [And] end
    | generatorForExp (OrNode (e1,e2))
      = let val cl1 = generatorForExp e1; 
            val cl2 = generatorForExp e2
        in cl1 @ cl2 @ [Or] end

  (*
   * generator generates a list of commands for a program,
   * which is a statement.
   * generatorForAssign, generatorForIf, generatorForWhile and generateForFor are 
   * auxiliary for generator.
   *)
  fun generator [] cl = cl 
    | generator (s::sl) cl 
      = case s of
          AssignNode (e1,e2) 
          => (case e1 of
                (VarNode v) => let val cl1 = generatorForAssign v e2
                              in generator sl (cl @ cl1) end
              | _ => raise CmplNonVarLHSofAssign)
        | IfNode (e,sl1,sl2) 
          => let val cl1 = generatorForIf e sl1 sl2 
             in generator sl (cl @ cl1) end
        | WhileNode (e,sl1) 
          => let val cl1 = generatorForWhile e sl1 
             in generator sl (cl @ cl1) end
        | ForNode (e1,e2,e3,sl1) 
          => (case e1 of
                (VarNode v) => let val cl1 = generatorForFor v e2 e3 sl1 
                               in generator sl (cl @ cl1) end
              | _ => raise ComplNonVarAfterFor)
  and generatorForAssign v e 
      = let val cl = generatorForExp e in cl @ [(Store v)] end
  and generatorForIf e sl1 sl2 
      = let val cl1 = generatorForExp e;
            val cl2 = generator sl1 [];
            val cl3 = generator sl2 []
        in cl1 @ [JumpOnCond 2,Jump ((length cl2)+2)] 
               @ cl2 @ [Jump ((length cl3)+1)] @ cl3 end
  and generatorForWhile e sl1
      = let val cl1 = generatorForExp e;
            val cl2 = generator sl1 []
        in cl1 @ [JumpOnCond 2,Jump ((length cl2)+2)] @ cl2 
               @ [Jump (~ ((length cl1)+(length cl2)+2))] end
  (*
   * generatorForFor is not implemented as intended.
   * The current implementation just ignores for statements.
   *)
  and generatorForFor v e1 e2 sl1 = []

  fun compiler sl = (generator sl []) @ [Quit]
end