(* ast-pp.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
 * All rights reserved.
 *
 * Pretty printing for the AST representation.
 *)

structure ASTPP : sig

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

  end = struct

    structure PP = TextIOPP
    structure TU = TypeUtil

    val indent = PP.Abs 2

    fun ppList ppFn (left, sep, right) (ppStrm, list) = let
	  fun sp () = PP.space ppStrm 1
	  val string = PP.string ppStrm
	  fun pp [] = string right
	    | pp [x] = (ppFn(ppStrm, x); string right)
	    | pp (x::xs) = (ppFn(ppStrm, x); string sep; sp(); pp xs)
	  in
	    string left; pp list
	  end

  (* print type arguments; we use "#" to denote differentiation arguments, "$" to denote
   * shape arguments, and "%" to denote dimension arguments.
   *)
    fun ppTyArgs (ppStrm, mvs) = let
	  val string = PP.string ppStrm
	  fun ppTyArg (_, mv) = (case mv
		 of Types.TYPE tv => string(TU.toString(TU.resolve tv))
		  | Types.DIFF dv => string("#"^TU.diffToString(TU.resolveDiff dv))
		  | Types.SHAPE sv => string("$"^TU.shapeToString(TU.resolveShape sv))
		  | Types.DIM dv => string("%"^TU.dimToString(TU.resolveDim dv))
		(* end case *))
	  in
	    ppList ppTyArg ("<", ";", ">") (ppStrm, mvs)
	  end

    fun ppExp (ppStrm, e) = let
	  fun sp () = PP.space ppStrm 1
	  val string = PP.string ppStrm
	  fun var x = string(Var.nameOf x)
	  fun pp e = (case e
		 of AST.E_Var(x, [], _) => var x
		  | AST.E_Var(x, mvs, ty) => (var x; ppTyArgs (ppStrm, mvs))
		  | AST.E_Lit lit => string (Literal.toString lit)
		  | AST.E_Tuple es => ppArgs (ppStrm, es)
		  | AST.E_Apply(f, [], args, _) => (var f; sp(); ppArgs (ppStrm, args))
		  | AST.E_Apply(f, mvs, args, _) => (
		      var f; ppTyArgs (ppStrm, mvs); sp(); ppArgs (ppStrm, args))
		  | AST.E_Cons es => (
		      ppList ppExp ("[", ",", "]") (ppStrm, es))
		  | AST.E_Cond(e1, e2, e3) => (
		      pp e1; sp(); string "?"; sp(); pp e2; sp(); string ":"; sp(); pp e3)
		(* end case *))
	  in
	    pp e
	  end

    and ppArgs (ppStrm, args) = ppList ppExp ("(", ",", ")") (ppStrm, args)

    fun ppVarDecl ppStrm (AST.VD_Decl(x, e)) = let
	  fun sp () = PP.space ppStrm 1
	  val string = PP.string ppStrm
	  fun var x = string(Var.nameOf x)
	  in
	    PP.openHBox ppStrm;
	      string(TU.toString(#2(Var.typeOf x))); sp(); var x;
	      sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
	    PP.closeBox ppStrm
	  end

    fun ppBlock (ppStrm, stms) = let
	  fun sp () = PP.space ppStrm 1
	  fun nl () = PP.newline ppStrm
	  val string = PP.string ppStrm
	  fun var x = string(Var.nameOf x)
	  fun ppStmt stmt = (case stmt
		 of AST.S_Block stms => ppBlock (ppStrm, stms)
		  | AST.S_Decl vdcl => (ppVarDecl ppStrm vdcl; nl())
		  | AST.S_IfThenElse(e, AST.S_Block stms, AST.S_Block[]) => (
		      PP.openHBox ppStrm;
			string "if"; sp(); ppExp(ppStrm, e);
			sp(); ppBlock (ppStrm, stms);
		      PP.closeBox ppStrm)
		  | AST.S_IfThenElse(e, s1, AST.S_Block[]) => (
		      PP.openVBox ppStrm indent;
			PP.openHBox ppStrm;
			  string "if"; sp(); ppExp(ppStrm, e);
			PP.closeBox ppStrm;
			nl();
			ppStmt s1;
		      PP.closeBox ppStrm;
		      nl())
		  | AST.S_IfThenElse(e, AST.S_Block stms1, AST.S_Block stms2) => (
		      PP.openHBox ppStrm;
			string "if"; sp(); ppExp(ppStrm, e);
			sp(); ppBlock (ppStrm, stms1);
		      PP.closeBox ppStrm;
		      PP.openHBox ppStrm;
			string "else"; sp(); ppBlock (ppStrm, stms2);
		      PP.closeBox ppStrm)
		  | AST.S_IfThenElse(e, AST.S_Block stms1, s2) => raise Fail "FIXME"
		  | AST.S_IfThenElse(e, s1, AST.S_Block stms2) => raise Fail "FIXME"
		  | AST.S_IfThenElse(e, s1, s2) => (
		      PP.openVBox ppStrm indent;
			PP.openHBox ppStrm;
			  string "if"; sp(); ppExp(ppStrm, e);
			PP.closeBox ppStrm;
			nl();
			ppStmt s1;
		      PP.closeBox ppStrm;
		      nl();
		      PP.openVBox ppStrm indent;
			string "else"; nl();
			ppStmt s2;
		      PP.closeBox ppStrm;
		      nl())
		  | AST.S_Assign(x, e) => (
		      PP.openHBox ppStrm;
			var x; sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
		      PP.closeBox ppStrm;
		      nl())
		  | AST.S_New(actor, args) => (
		      PP.openHBox ppStrm;
			string "new"; sp(); string(Atom.toString actor); sp();
			ppArgs (ppStrm, args); string ";";
		      PP.closeBox ppStrm;
		      nl())
		  | AST.S_Die => (string "die;"; nl())
		  | AST.S_Stabilize => (string "stabilize;"; nl())
		(* end case *))
	  in
	    PP.openVBox ppStrm (PP.Abs 0);
	      string "{"; nl();
	      PP.openVBox ppStrm indent;
		List.app ppStmt stms;
	      PP.closeBox ppStrm;
	      string "}"; nl();
	    PP.closeBox ppStrm
	  end

    fun ppActor (ppStrm, {name, params, state, methods}) = let
	  fun sp () = PP.space ppStrm 1
	  fun nl () = PP.newline ppStrm
	  val string = PP.string ppStrm
	  fun var x = string(Var.nameOf x)
	  fun ppMethod (AST.M_Method(name, AST.S_Block stms)) = (
		nl(); string(Atom.toString name); nl(); ppBlock (ppStrm, stms))
	    | ppMethod (AST.M_Method(name, stm)) = (
		nl(); string(Atom.toString name); nl(); ppBlock (ppStrm, [stm]))
	  in
	    PP.openHBox ppStrm;
	      string "actor"; sp(); string(Atom.toString name); sp();
	      ppList (fn (_, x) => (string(TU.toString(#2(Var.typeOf x))); sp(); var x))
		("(", ",", ")") (ppStrm, params);
	    PP.closeBox ppStrm;
	    nl();
	    PP.openVBox ppStrm indent;
	      string "{";
	      List.app (fn vdcl => (nl(); ppVarDecl ppStrm vdcl)) state;
	      List.app ppMethod methods;
	    PP.closeBox ppStrm;
	    nl();
	    string "}";  nl()
	  end

    fun ppDecl ppStrm = let
	  fun sp () = PP.space ppStrm 1
	  fun nl () = PP.newline ppStrm
	  val string = PP.string ppStrm
	  fun var x = string(Var.nameOf x)
	  in
	    fn AST.D_Input(x, NONE) => (
		PP.openHBox ppStrm;
		  string "input"; sp();
		  string(TU.toString(#2(Var.typeOf x))); sp(); var x; string ";";
		PP.closeBox ppStrm;
		nl())
	     | AST.D_Input(x, SOME e) => (
		PP.openHBox ppStrm;
		  string "input"; sp();
		  string(TU.toString(#2(Var.typeOf x))); sp(); var x;
		  sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
		PP.closeBox ppStrm;
		nl())
	     | AST.D_Var vdcl => (ppVarDecl ppStrm vdcl; nl())
	     | AST.D_Actor def => ppActor (ppStrm, def)
	     | AST.D_InitialArray(create, iters) => (* FIXME *) ()
	     | AST.D_InitialCollection(create, iters) => (* FIXME *) ()
	  end

    fun output (outS, AST.Program decls) = let
	  val ppStrm = PP.openOut {dst = outS, wid = 120}
	  in
	    PP.openVBox ppStrm (PP.Abs 0);
	      PP.string ppStrm "/* Program start */"; PP.newline ppStrm;
	      List.app (ppDecl ppStrm) decls;
	      PP.string ppStrm "/* Program end */"; PP.newline ppStrm;
	    PP.closeBox ppStrm;
	    PP.closeStream ppStrm
	  end

  end

<script type="text/javascript">//<![CDATA[
		function toggle_ffErrors() {
			var errorsblock = document.getElementById("ffErrorsBlock");
			var errorsgroup = document.getElementById("ffErrors");
			if (errorsblock.style.display == "none") {
				errorsblock.style.display = "block";
				errorsgroup.style.right = "10px";
			} else {
				errorsblock.style.display = "none";
				errorsgroup.style.right = "300px";
			}
		}
//]]></script>
<div id="ffErrors">
<a href="javascript:toggle_ffErrors();">Click to toggle</a>
<div id="ffErrorsBlock">
	<div class="error">does not end with &lt;/html&gt; tag</div>
	<div class="error">does not end with &lt;/body&gt; tag</div>
	<div class="info">The output has ended thus: rogram end */&quot;; PP.newline ppStrm;
	    PP.closeBox ppStrm;
	    PP.closeStream ppStrm
	  end

  end</div>
</div></div>
</body></html>