(* block.ml *)
(* 15-411 *)
(* by Arthur O'Dwyer *)
(* @version $Id: block.ml,v 1.2 2004/10/30 19:33:21 ajo Exp $ *)

open Ir
module TP = Temp
module A = Absyn

exception InternalError

type block = Ir.stmt list

let rec ce = function
  | CALLOP(id, eli) -> CALLOP(id, List.map ce eli)
  | TEMP t -> TEMP t
  | CONST n -> CONST n
  | REG_EBP -> REG_EBP
  | NAME s -> NAME s
  | ESEQ(NOTHING,e) -> ce e
  | ESEQ(s1,ESEQ(s2, e)) -> ce (ESEQ(SEQ(s1, s2), e))
  | ESEQ(s1,e) -> ESEQ(cs s1, ce e)
  | BINOP(op,ESEQ(s,e1),e2) -> ESEQ(cs s, BINOP(op, ce e1, ce e2))
  | BINOP(op,((CONST _) as e1),ESEQ(s,e2)) ->
      ESEQ(cs s, BINOP(op, ce e1, ce e2))
  | BINOP(op,e1,ESEQ(s,e2)) -> (
      let t = TP.simpTemp() in
      ESEQ(Ir.seq_of [
        MOVE(TEMP t, e1);
        cs s
      ], BINOP(op, TEMP t, ce e2))
    )
  | BINOP(op,e1,e2) -> BINOP(op, ce e1, ce e2)
  | UNOP(op,ESEQ(s,e)) -> ESEQ(cs s, ce (UNOP(op, e)))
  | UNOP(op,e) -> UNOP(op, ce e)

and cs = function
  | SEQ(NOTHING,s) -> cs s
  | SEQ(s, NOTHING) -> cs s
  | SEQ(s1,SEQ(s2,s3)) -> cs (SEQ(SEQ(s1, s2), s3))
  | SEQ(s1,s2) -> SEQ(cs s1, cs s2)
  | EXP(ESEQ(s,e)) -> cs (SEQ(s, EXP e))
  | EXP e -> EXP (ce e)
  | CJUMP(c,ESEQ(s,e1),e2,lt,lf) ->
      cs (SEQ(s, CJUMP(c, e1, e2, lt, lf)))
  | CJUMP(c,((CONST _) as e1),ESEQ(s,e2),lt,lf) ->
      cs (SEQ(s, CJUMP(c, e1, e2, lt, lf)))
  | CJUMP(c,e1,ESEQ(s,e2),lt,lf) -> (
      let t = TP.simpTemp() in
      Ir.seq_of [
        MOVE(TEMP t, ce e1);
        cs s;
        CJUMP(c, TEMP t, ce e2, lt, lf)
      ]
    )
  | CJUMP(c,e1,e2,lt,lf) -> CJUMP(c, ce e1, ce e2, lt, lf)
  | MOVE(ESEQ(s,e1),e2) -> SEQ(cs s, MOVE(ce e1, ce e2))
  | MOVE(e1,ESEQ(s,e2)) -> SEQ(cs s, MOVE(ce e1, ce e2))
  | MOVE(e1,e2) -> MOVE(ce e1, ce e2)
  | LEA(ESEQ(s,e1),e2) -> SEQ(cs s, LEA(ce e1, ce e2))
  | LEA(e1,ESEQ(s,e2)) -> SEQ(cs s, LEA(ce e1, ce e2))
  | LEA(e1,e2) -> LEA(ce e1, ce e2)
  | RETURN(ESEQ(s,e)) -> SEQ(s,RETURN (ce e))
  | RETURN e -> RETURN (ce e)
  | LABEL id -> LABEL id
  | JUMP id -> JUMP id
  | COMMENT id -> COMMENT id
  | NOTHING -> NOTHING


let create_basic_blocks irtree =
  begin
    let result = ref []
    and curblock = ref [] in
    let rec appendstmt s =
      curblock := s :: !curblock
    and newblock () = (
      result := (List.rev !curblock) :: !result;
      curblock := []
    )
    and finish () = (newblock(); List.rev !result)
    in
    let rec process x = (
      match x with
      | SEQ(s1,s2) -> process s1; process s2
      | MOVE _ | LEA _ | COMMENT _ | RETURN _ | EXP _ -> appendstmt x
      | NOTHING -> ()
      | JUMP _ | CJUMP _ -> appendstmt x; newblock()
      | LABEL s -> appendstmt(JUMP s); newblock(); appendstmt x
    )
    in
    process irtree; finish()
  end


let reorder_basic_blocks bli =
  begin
    (* Todo: Write me. *)
    bli
  end


let rec collapse_basic_blocks = function
  | [] -> []
  | []::t2 -> collapse_basic_blocks t2
  | (h::t)::t2 -> h :: (collapse_basic_blocks (t :: t2))


let schedule irtree =
  begin
    Printf.printf "go!\n";
    let can = ref (cs irtree) in
    let can2 = ref (cs !can) in
    let counter = ref 1 in
    while (!can <> !can2) do
      Printf.printf "\n%i---------\n" (counter := !counter+1; !counter);
      can := !can2;
      can2 := cs !can
    done;
    Printf.printf "\n";
    let bli = create_basic_blocks !can in
    let bli = reorder_basic_blocks bli in
    let bli = collapse_basic_blocks bli in
    bli
  end