(* ir.ml *)
(* 15-411 *)
(* by Roland Flury *)
(* @version $Id: ir.ml,v 1.4 2004/10/26 05:10:07 ajo Exp $ *)

(* The Intermediate Representation Tree Language *)

open Absyn
module TP = Temp

exception InternalError

type jump_t = JGE | JG | JLE | JL | JNZ | JZ | JA | JAE | JB | JBE
type label = string

let label_counter : int ref = ref 0

let simpLabel () =
  label_counter := !label_counter + 1;
  ".L"^(string_of_int !label_counter)

let rel2jmp = function
  | RELLE -> JLE | RELLT -> JL | RELGE -> JGE | RELGT -> JG
  | RELEQ -> JZ | RELNE -> JNZ | _ -> raise InternalError
let jmp2str = function
  | JGE -> "JGE" | JG -> "JG" | JLE -> "JLE" | JL -> "JL"
  | JNZ -> "JNZ" | JZ -> "JZ" | JA -> "JA" | JAE -> "JAE"
  | JB -> "JB" | JBE -> "JBE"
let jmpconverse = function
  | JGE -> JL | JG -> JLE | JLE -> JG | JL -> JGE
  | JNZ -> JZ | JZ -> JNZ | JA -> JBE | JAE -> JB
  | JB -> JAE | JBE -> JA

type stmt =
  | EXP of exp
  | MOVE of exp * exp
  | LEA of exp * exp
  | SEQ of stmt * stmt
  | COMMENT of string
  | RETURN of exp
  | JUMP of label
  | CJUMP of jump_t * exp * exp * label * label
  | LABEL of label
  | NOTHING

and exp =
  | ESEQ of stmt * exp
  | CONST of int32
  | NAME of string
  | TEMP of TP.temp
  | REG_EBP
  | UNOP of unop * exp
  | BINOP of binop * exp * exp
  | CALLOP of string * (exp list)

let rec seq_of = function
  | [] -> NOTHING
  | [s] -> s
  | s::t -> SEQ(s, seq_of t)


(***********************************************************************)
(* print an IR-tree *)
(***********************************************************************)

let ps s = print_string s
let pnl () = print_newline ()
let pp_level = ref 0

(* print new-line with indentation on following line *)
let pnls () =
  print_newline();
  for i=1 to !pp_level do ps " "; done

(* modify the level of indentation *)
let inc x = pp_level := !pp_level + x
let dec x = pp_level := !pp_level - x

let pbinop = function
  | LOGOR -> "LOGOR" | LOGXOR -> "LOGXOR" | LOGAND -> "LOGAND"
  | RELEQ -> "RELEQ" | RELNE -> "RELNE" | PTREQ -> "PTREQ" | PTRNE -> "PTRNE"
  | RELLT -> "RELLT" | RELLE -> "RELLE" | RELGT -> "RELGT" | RELGE -> "RELGE"
  | PTRPLUS -> "PTRPLUS" | PTRMINUS -> "PTRMINUS"
  | BITOR -> "BITOR" | BITXOR -> "BITXOR" | BITAND -> "BITAND"
  | BITSHL -> "BITSHL" | BITSHR -> "BITSHR"
  | PLUS -> "PLUS" | MINUS -> "MINUS" | TIMES -> "TIMES"
  | DIVIDE -> "DIVIDE" | MOD -> "MOD"
and punop = function
  | NEGATE -> "NEGATE" | LOGNEGATE -> "LOGNEGATE"
  | BITNEGATE -> "BITNEGATE" | DEREF -> "DEREF"
  | _ -> raise InternalError

let rec pexp = function
  | ESEQ(s,e) ->
      ps "ESEQ("; inc 5; pstmt s; ps ", "; pnls ();
      pexp e; ps ")"; dec 6
  | CONST(i) -> ps ("CONST("^(Int32.to_string i)^")")
  | NAME s -> ps ("NAME("^s^")")
  | REG_EBP -> ps "REG_EBP"
  | TEMP(t) -> ps ("TEMP("^(TP.temp2string t)^")")
  | BINOP(o,e1,e2) ->
      ps "BINOP("; inc 6; ps (nice_binop o); ps ", "; pnls ();
      pexp e1; ps ", "; pnls ();
      pexp e2; ps ")"; dec 6
  | UNOP(DEREF,e) ->
      ps "MEM("; pexp e; ps ")"
  | UNOP(o,e) ->
      ps "UNOP("; inc 6; ps (nice_unop o); ps ", "; pnls ();
      pexp e; ps ")"; dec 6
  | CALLOP(f,eli) -> (
      let help e = pexp e; pnls () in
      ps ("CALLOP(\""^f^"\","); inc 6; List.iter help eli; ps ")"; dec 6
    )

and pstmt = function
  | COMMENT(s) -> ps "COMMENT("; ps s; ps ")"; pnls ()
  | MOVE(e1,e2) -> ps "MOVE("; inc 5; pexp e1; ps ", "; pnls ();
      pexp e2; ps ")"; dec 5; pnls ()
  | LEA(e1,e2) -> ps "LEA("; inc 5; pexp e1; ps ", "; pnls ();
      pexp e2; ps ")"; dec 5; pnls ()
  | SEQ(s1, s2) -> pstmt s1; pstmt s2
  | EXP(e) -> ps "EXP("; inc 4; pexp e; dec 4; ps ")"; pnls ()
  | JUMP(id) -> ps ("JUMP("^id^")"); pnls ()
  | CJUMP(cond, e1, e2, lt, lf) ->
      ps ((jmp2str cond)^"("); pexp e1; ps ", "; pnls ();
      pexp e2; pnls (); ps (", "^lt^", "^lf^")"); pnls ()
  | LABEL(id) -> ps ("LABEL("^id^")"); pnls ()
  | RETURN(e) -> ps "RETURN("; inc 7; pexp e; ps ")"; dec 7; pnls ()
  | NOTHING -> ps "NOTHING"; pnls ()

(*
   Prints the IR-tree given a statement.
   (The whole program is a single IR "statement.")
*)
let print_ir program =
  ps "================= IR ====================\n";
  ps "bindings: "; TP.listBindings ();
  pnl ();
  pstmt program;
  pnl (); pnl();
  ps "=============== END IR ==================\n"