(* tree-il-pp.sml
 *
 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Printing for the TreeIL
 *)

structure TreeILPP : sig

    val statement : TextIO.outstream * TreeIL.stm -> unit

    val block : TextIO.outstream * TreeIL.block -> unit

    val program : TextIO.outstream * TreeIL.program -> unit

  end = struct

    structure IL = TreeIL
    structure Op = IL.Op
    structure Var = IL.Var
    structure Ty = IL.Ty

    fun indent (outS, i) = TextIO.output(outS, StringCvt.padLeft #" " i "")
    fun incIndent (outS, i) = (outS, i+2)
    fun decIndent (outS, i) = (outS, Int.max(0, i-2))
    fun pr ((outS, _), s) = TextIO.output(outS, s)
    fun prl (out, l) = pr(out, concat l)
    fun prln (out, l) = (indent out; prl(out, l))

    fun expToString e = let
	  fun toS (IL.E_Var x, l) = Var.name x :: l
	    | toS (IL.E_Lit lit, l) = Literal.toString lit :: l
	    | toS (IL.E_Op(rator, args), l) = let
		fun argToS ([], l) = l
		  | argToS ([e], l) = toS (e, l) 
		  | argToS (e::es, l) = toS(e, "," :: argToS(es, l))
		in
		  Op.toString rator :: "(" :: argToS(args, ")" :: l)
		end
	  in
	    String.concat (toS (e, []))
	  end

    fun argsToString (prefix, es) = String.concat[
	    prefix, "(", String.concatWith "," (List.map expToString es), ")"
	  ]

    fun ppVarDecl out x = prln (out, [Ty.toString(Var.ty x), " ", Var.name x, ";\n"])

    fun ppStrand out (IL.Strand{name, params, state, stateInit, methods}) = let
	  val out' = incIndent out
	  fun ppParams [] = ()
	    | ppParams [x] = prl(out, [Ty.toString (Var.ty x), " ", Var.name x])
	    | ppParams (x::r) = (
		prl(out, [Ty.toString (Var.ty x), " ", Var.name x, ","]);
		ppParams r)
	  in
	    prln (out, ["strand ", Atom.toString name, " ("]);
	    ppParams params; pr(out, ") {\n");
	    List.app (ppVarDecl out') state;
	    prln (out', ["init () "]); ppBlock(out', stateInit); pr (out', "\n");
	    List.app (ppMethod out') methods;
	    prln (out, ["}\n"])
	  end

    and ppMethod out (IL.Method{name, body}) = (
	  prln (out, [Atom.toString name, " () "]);
	  ppBlock (out, body);
	  pr (out, "\n"))

    and ppBlock (out, IL.Block{locals, body}) = let
	  val out' = incIndent out
	  in
	    pr (out, "{\n");
	    List.app (ppVarDecl out') locals;
	    List.app (fn stm => ppStm(out', stm)) body;
	    indent out; pr (out, "}")
	  end

    and ppStm (out, stm) = (case stm
	   of IL.S_Comment text => let
		val out = decIndent out
		in
		  List.app (fn s => prln(out, ["// ", s, "\n"])) text
		end
	    | IL.S_Assign(x, e) => prln(out, [Var.name x, " = ", expToString e, ";\n"])
	    | IL.S_Cons(x, args) => let
		fun mkStrings [] = []
		  | mkStrings [e] = [expToString e]
		  | mkStrings (e::es) = (expToString e ^ ",") :: mkStrings es
		val args = mkStrings args
		in
		  if (List.foldl (fn (s, n) => n+size s) 0 args > 60)
		    then let
		      val out' = incIndent out
		      val out'' = incIndent out'
		      fun prArgs (_, []) = (
			    pr (out', "\n");
			    prln (out', ["};\n"]))
			| prArgs (n, arg::args) =
			    if (n = 0)
			      then (
				prln (out'', [arg]);
				prArgs (n + size arg, args))
			    else if (n + size arg > 60)
			      then (
				pr(out'', "\n");
				prArgs (0, arg::args))
			      else (
				pr(out'', " ");
				pr(out'', arg);
				prArgs (n + size arg + 1, args))
		      in
			prln (out, [Var.name x, " = {\n"]);
			prArgs (0, args)
		      end
		    else (
		      prln (out, Var.name x :: " = {" :: args);
		      pr (out, "};\n"))
		end  
	    | IL.S_LoadVoxels(x, dim, exp) => 
		prln (out, [
		    Var.name x, " = loadVoxels<",
		    Int.toString dim, "> (", expToString exp, ");\n"
		  ])
	    | IL.S_LoadImage(x, dim, exp) =>
		prln (out, [
		    Var.name x, " = load<", Int.toString dim, "> (", expToString exp, ");\n"
		  ])
	    | IL.S_Input(x, name, NONE) =>
		prln (out, [
		    Var.name x, " = input<", Ty.toString(Var.ty x), "> (\"",
		    String.toString name, "\");\n"
		  ])
	    | IL.S_Input(x, name, SOME dflt) =>
		prln (out, [
		    Var.name x, " = input<", Ty.toString(Var.ty x), "> (\"",
		    String.toString name, "\",", expToString dflt, ");\n"
		  ])
	    | IL.S_IfThen(cond, blk) => (
		prln (out, ["if (", expToString cond, ") "]);
		ppBlock (out, blk);
		pr (out, "\n"))
	    | IL.S_IfThenElse(cond, blk1, blk2) => (
		prln (out, ["if (", expToString cond, ") "]);
		ppBlock (out, blk1);
		pr (out, " else ");
		ppBlock (out, blk2);
		pr (out, "\n"))
	    | IL.S_Exit es => prln (out, [argsToString("exit", es), ";\n"])
	  (* return functions for methods *)
	    | IL.S_Active es => prln (out, [argsToString("active", es), ";\n"])
	    | IL.S_Stabilize es => prln (out, [argsToString("stabilize", es), ";\n"])
	    | IL.S_Die => prln (out, ["die;\n"])
	  (* end case *))

    fun statement (outS, stm) = ppStm((outS, 0), stm)

    fun block (outS, blk) = (ppBlock ((outS, 0), blk); pr ((outS, 0), "\n"))

    fun program (outS, IL.Program{globals, globalInit, strands}) = let
	  val out = (outS, 0)
	  val out' = incIndent out
	  in
	    prln(out, ["//***** GLOBALS *****\n"]);
	    List.app (ppVarDecl out') globals;
	    prln(out, ["//***** GLOBAL INIT *****\n"]);
	    indent out'; ppBlock (out', globalInit); pr (out, "\n");
	    prln(out, ["//***** STRANDS *****\n"]);
	    List.app (ppStrand out) strands
	  end

  end