(* ssa-pp-fn.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
 * All rights reserved.
 *
 * Pretty printing for SSA representations
 *)

functor SSAPPFn (IL : SSA) : sig

    val output : TextIO.outstream * IL.program -> unit

  end = struct

    structure Op = IL.Op
    structure Var = IL.Var

    fun indent (outS, i) = TextIO.output(outS, StringCvt.padLeft #" " i "")
    fun incIndent (outS, i) = (outS, i+2)
    fun pr ((outS, _), s) = TextIO.output(outS, s)
    fun prl (out, l) = pr(out, concat l)

    fun ppRHS (out, IL.VAR x) = pr(out, Var.toString x)
      | ppRHS (out, IL.LIT lit) = pr(out, Literal.toString lit)
      | ppRHS (out, IL.OP(rator, args)) = prl (out, [
	    Op.toString rator, "(", String.concatWith "," (List.map Var.toString args), ")"
	  ])
      | ppRHS (out, IL.CONS xs) =
	  prl (out, ["[", String.concatWith "," (List.map Var.toString xs), "]"])

    fun labelOf (IL.STM{id, ...}) = "L"^Stamp.toString id

    fun ppStmt (out, stm as IL.STM{id, kind, next, ...}) = let
	  val out1 = incIndent out
	  fun prPhi (y, xs) = (
		indent out1;
		prl (out1, [
		    Var.toString y, " = phi(",
		    String.concatWith "," (List.map Var.toString xs), ")\n"
		  ]))
	  in
	    indent out;
	    prl (out, [
		IL.Stmt.toString stm, "(", IL.Node.toString(IL.Stmt.entry stm), "):  # preds = [",
		String.concatWith "," (List.map IL.Node.toString (IL.Node.preds(IL.Stmt.entry stm))),
		"]\n"
	      ]);
	    case kind
	     of IL.S_SIMPLE(IL.ND{kind, ...}) => (case kind
		   of IL.NULL => raise Fail "unexpected S_SIMPLE with NULL node"
		    | IL.ENTRY _ => (indent out1; pr(out1, "entry;\n"))
		    | IL.JOIN{phis, ...} => List.app prPhi (!phis)
		    | IL.COND _ => raise Fail "unexpected S_SIMPLE with COND node"
		    | IL.BLOCK{body=ref [], ...} => (indent out1; pr (out, "empty;\n"))
		    | IL.BLOCK{body, ...} => (
			List.app
			  (fn (y, rhs) => (
			      indent out1;
			      prl(out1, [Var.toString y, " = "]); ppRHS(out1, rhs); pr(out1, ";\n"))
			  ) (!body))
		    | IL.NEW{actor, args, ...} => (
			indent out1;
			prl (out1, [
			    "new ", Atom.toString actor, "(",
			    String.concatWith "," (List.map Var.toString args), ");\n"
			  ]))
		    | IL.DIE _ => (indent out1; pr(out1, "die;\n"))
		    | IL.STABILIZE _ => (indent out1; pr(out1, "stabilize;\n"))
		    | IL.EXIT _ => (indent out1; pr(out1, "exit;\n"))
		  (* end case *))
	      | IL.S_IF{cond=IL.ND{kind=IL.COND{cond, ...}, ...}, thenBranch, elseBranch} => (
		  indent out1;  prl(out1, ["if ", Var.toString cond, " then\n"]);
		  ppStmt (incIndent out1, thenBranch);
		  indent out1; pr(out1, "else\n");
		  ppStmt (incIndent out1, elseBranch);
		  indent out1; pr(out1, "endif;\n"))
	      | IL.S_LOOP _ => raise Fail "LOOP"
	    (* end case *);
	    ppNext (out, next)
	  end

    and ppNext (out, NONE) = ()
      | ppNext (out, SOME stm) = ppStmt (out, stm)

    fun ppMethod (out, IL.Method{name, stateIn, stateOut, body}) = let
	  val out1 = incIndent out
	  fun prVars xs = List.app (fn x => prl(out, [" ", Var.toString x])) xs
	  in
	    indent out; prl(out, ["method ", Atom.toString name, "\n"]);
	    indent out1; pr(out1, "state in: "); prVars stateIn; pr(out1, "\n");
	    ppStmt (incIndent out1, body);
	    indent out1; pr(out1, "state out:"); prVars stateOut; pr(out1, "\n");
	    indent out; prl(out, ["end ", Atom.toString name, "\n"])
	  end

    and ppActor (out, IL.Actor{name, params, state, stateInit, methods}) = let
	  val out1 = incIndent out
	  fun prVars xs = List.app (fn x => prl(out, [" ", Var.toString x])) xs
	  in
	    indent out;
	    prl(out, [
		"actor ", Atom.toString name, " (",
		String.concatWith "," (List.map Var.toString params), ")\n"
	      ]);
	    indent out1; pr(out1, "state: "); prVars state; pr(out1, "\n");
	    ppStmt (incIndent out1, stateInit);
	    List.app (fn m => ppMethod(out1, m)) methods;
	    indent out; prl(out, ["end ", Atom.toString name, "\n"])
	  end

    fun output (outS, IL.Program{globals, globalInit, actors}) = let
	  val out = (outS, 0)
	  val out1 = incIndent out
	  in
	    pr (out, "## globals\n");
	    List.app (fn x => (indent out1; prl(out1, ["global ", Var.toString x, "\n"]))) globals;
	    pr (out, "## global initialization\n");
	    ppStmt (out1, globalInit);
	    pr (out, "## actors\n");
	    List.app (fn actor => ppActor(out1, actor)) actors;
	    pr (out, "## end program")
	  end

  end