(* print-as-c.sml
 *
 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Print the CLang representation using C99 syntax.
 *)

structure PrintAsC : sig

    type strm

    val new : TextIO.outstream -> strm

    val close : strm -> unit

    val output : strm * CLang.decl -> unit

  end = struct

    structure CL = CLang
    structure PP = TextIOPP

    type strm = PP.stream

    val indent = (PP.Abs 4)	(* standard indentation amount *)

    fun new outs = PP.openOut {dst = outs, wid = 90}

    val close = PP.closeStream

    fun output (strm, decl) = let
	  val str = PP.string strm
	  fun sp () = PP.space strm 1
	  fun inHBox f = (PP.openHBox strm; f(); PP.closeBox strm)
	  fun ppComLn s = (
		inHBox (fn () => (str "// "; str s));
		PP.newline strm)
	  fun ppList {pp, sep, l} = let
		fun ppList' [] = ()
		  | ppList' [x] = pp x
		  | ppList' (x::xs) = (pp x; sep(); ppList' xs)
		in
		  ppList' l
		end
	  fun ppTy (ty, optVar) = let
		fun getBaseTy (CL.T_Ptr ty) = getBaseTy ty
		  | getBaseTy (CL.T_Array(ty, _)) = getBaseTy ty
		  | getBaseTy (CL.T_Num rty) = (case rty
		       of RawTypes.RT_Int8 => "int8_t"
			| RawTypes.RT_UInt8 => "uint8_t"
			| RawTypes.RT_Int16 => "int16_t"
			| RawTypes.RT_UInt16 => "uint16_t"
			| RawTypes.RT_Int32 => "int32_t"
			| RawTypes.RT_UInt32 => "uint32_t"
			| RawTypes.RT_Int64 => "int64_t"
			| RawTypes.RT_UInt64 => "uint64_t"
			| RawTypes.RT_Float => "float"
			| RawTypes.RT_Double => "double"
		      (* end case *))
		  | getBaseTy (CL.T_Named ty) = ty
		fun pp (isFirst, CL.T_Ptr ty, optVar) = (
		      if isFirst then sp() else ();
		      case ty
		       of CL.T_Array _ => (
			    str "(*"; pp(false, ty, optVar); str ")")
			| _ => (str "*"; pp(false, ty, optVar))
		      (* end case *))
		  | pp (isFirst, CL.T_Array(ty, optN), optVar) = (
		      pp (isFirst, ty, optVar);
		      case optN
		       of NONE => str "[]"
			| SOME n => (str "["; str(Int.toString n); str "]")
		      (* end case *))
		  | pp (isFirst, _, SOME x) = (
		      if isFirst then sp() else ();
		      str x)
		  | pp (_, _, NONE) = ()
		in
		  str (getBaseTy ty);
		  pp (true, ty, optVar)
		end
          fun ppAttrs [] = ()
            | ppAttrs attrs = (
                ppList {pp=str, sep=sp, l = attrs};
                sp())
	  fun ppDecl dcl = (case dcl
		 of CL.D_Comment l => List.app ppComLn l
		  | CL.D_Verbatim l =>
		      List.app (fn s => (str s; PP.newline strm)) l
		  | CL.D_Var(attrs, ty, x, optInit) => (
		      inHBox (fn () => (
			ppAttrs attrs;
			ppTy (ty, SOME x);
			case optInit
			 of SOME init => (sp(); str "="; sp(); ppInit init)
			  | NONE => ()
			(* end case *);
			str ";"));
		      PP.newline strm)
		  | CL.D_Func(attrs, ty, f, params, body) => (
		      inHBox (fn () => (
			ppAttrs attrs;
			ppTy(ty, SOME f);
			sp(); str "(";
			ppList {pp=ppParam, sep=fn () => (str ","; sp()), l=params};
			str ")"));
		      PP.newline strm;
		      ppBlock (case body of CL.S_Block stms => stms | stm => [stm]))
		  | CL.D_StructDef(fields, tyName) => (
		      str "typedef struct {"; 
		      PP.openVBox strm indent;
			List.app (fn (ty, x) => (
			    PP.newline strm;
			    inHBox (fn () => (ppTy(ty, SOME x); str ";"))))
			  fields;
		      PP.closeBox strm;
		      PP.newline strm;
		      inHBox (fn () => (str "}"; sp(); str tyName; str ";"));
		      PP.newline strm)
		(* end case *))
	  and ppParam (CL.PARAM(attrs, ty, x)) = (
		ppAttrs attrs;
		ppTy(ty, SOME(CL.varToString x)))
	  and ppInit init = (case init
		 of CL.I_Exp e => ppExp e
		  | CL.I_Struct fields => (
		      str "{";
		      PP.openHVBox strm indent;
			List.app (fn (lab, init) => (
			    PP.break strm;
			    inHBox (fn () => (
			      str("." ^ lab); sp(); str "="; sp(); ppInit init; str ","))))
			  fields;
		      PP.closeBox strm;
		      str "}")
		  | CL.I_Array elems => (
		      str "{";
		      PP.openHVBox strm indent;
			List.app (fn (i, init) => (
			    PP.break strm;
			    inHBox (fn () => (
			      str(concat["[", Int.toString i, "]"]); sp(); str "="; sp();
			      ppInit init; str ","))))
			  elems;
		      PP.closeBox strm;
		      str "}")
		(* end case *))
	  and ppBlock stms =  (
		str "{";
		PP.openVBox strm indent;
		  PP.newline strm;
		  List.app ppStm stms;
		PP.closeBox strm;
		str "}"; PP.newline strm)
	  and ppStm stm = (case stm
		 of CL.S_Block stms => ppBlock stms
		  | CL.S_Comment l => List.app ppComLn l
		  | CL.S_Decl(attrs, ty, x, NONE) => (
		      inHBox ( fn () => (
		        ppAttrs attrs;
                        ppTy(ty, SOME x); str ";"));
                      PP.newline strm)
		  | CL.S_Decl(attrs, ty, x, SOME e) => (
		      inHBox (fn () => (
		        ppAttrs attrs;
			ppTy(ty, SOME x); sp(); str "="; sp(); ppInit e; str ";"));
		      PP.newline strm)
		  | CL.S_Exp e => (
		      inHBox (fn () => (ppExp e; str ";"));
		      PP.newline strm)
		  | CL.S_If(e, blk, CL.S_Block[]) =>
		      inHBox (fn () => (str "if"; sp(); ppExp e; ppStms blk))
		  | CL.S_If(e, blk1, blk2) => (
		      inHBox (fn () => (str "if"; sp(); ppExp e)); ppStms blk1;
		      str "else"; ppStms blk2)
		  | CL.S_While(e, blk) => (
		      inHBox (fn () => (str "while"; sp(); ppExp e)); ppStms blk)
		  | CL.S_For(inits, cond, incrs, blk) => let
		      fun ppInit (ty, x, e) = inHBox (fn () => (
			    ppTy(ty, SOME x);
			    sp(); str "="; sp();
			    ppExp e))
		      in
			inHBox (fn () => (
			  str "for"; sp(); str "(";
			  ppList {pp = ppInit, sep = fn () => str ",", l = inits};
			  str ";"; sp();
			  ppExp cond; str ";"; sp();
			  ppList {pp = ppExp, sep = fn () => str ",", l = incrs}));
			  str ")";
			ppStms blk
		      end
		  | CL.S_Call(f, args) => (
		      inHBox (fn () => (str f; ppArgs args; str ";"));
		      PP.newline strm)
		  | CL.S_Return(SOME e) => (
		      inHBox (fn () => (str "return"; sp(); ppExp e; str ";"));
		      PP.newline strm)
		  | CL.S_Return _ => (str "return;"; PP.newline strm)
		  | CL.S_Break => (str "break;"; PP.newline strm)
		  | CL.S_Continue => (str "continue;"; PP.newline strm)
		(* end case *))
	  and ppStms (CL.S_Block stms) = (sp(); ppBlock stms)
	    | ppStms stm = (
		PP.openVBox strm indent;
		  PP.newline strm;
		  ppStm stm;
		PP.closeBox strm)
	  and ppExp e = (case e
		 of CL.E_Grp e => (str "("; ppExp e; str ")")
		  | CL.E_AssignOp(lhs, rator, rhs) => (
		      ppExp lhs; sp(); str(CL.assignopToString rator); sp(); ppExp rhs)
		  | CL.E_BinOp(e1, rator, e2) => (ppExp e1; str(CL.binopToString rator); ppExp e2)
		  | CL.E_UnOp(rator, e) => (str(CL.unopToString rator); ppExp e)
		  | CL.E_PostOp(e, rator) => (ppExp e; str(CL.postopToString rator))
		  | CL.E_Apply(f, args) => (str f; ppArgs args)
		  | CL.E_Subscript(e1, e2) => (ppExp e1; str "["; ppExp e2; str "]")
		  | CL.E_Select(e, f) => (ppExp e; str "."; str f)
		  | CL.E_Indirect(e, f) => (ppExp e; str "->"; str f)
		  | CL.E_Cast(ty, e) => (
		      str "("; ppTy(ty, NONE); str ")"; ppExp e)
		  | CL.E_Var x => str(CL.varToString x)
		  | CL.E_Int(n, CL.T_Num(RawTypes.RT_Int64)) =>
		      str(IntegerLit.toString n ^ "l")
		  | CL.E_Int(n, _) => str(IntegerLit.toString n)
		  | CL.E_Flt(f, ty) => let
		      val isDouble = (case ty
			     of CL.T_Num(RawTypes.RT_Float) => false
			      | _ => true
			    (* end case *))
		    (* NOTE: the CLang.mkFlt function guarantees that f is non-negative *)
		      val f = if FloatLit.same(FloatLit.posInf, f)
			      then if isDouble
				then "HUGE_VAL"
				else "HUGE_VALF"
			    else if FloatLit.same(FloatLit.nan, f)
			      then if isDouble
				then "nan(\"\")"
				else "nanf(\"\")"
			    else if isDouble
			      then FloatLit.toString f
			      else FloatLit.toString f ^ "f"
		      in
			str f
		      end
		  | CL.E_Bool b => str(Bool.toString b)
		  | CL.E_Str s => str(concat["\"", String.toCString s, "\""])
		  | CL.E_Sizeof ty => (str "sizeof("; ppTy(ty, NONE); str ")")
		(* end case *))
	  and ppArgs args = (
		str "(";
		PP.openHOVBox strm indent;
		  PP.cut strm;
		  ppList {
		      pp = fn e => (PP.openHBox strm; ppExp e; PP.closeBox strm),
		      sep = fn () => (str ","; sp()),
		      l = args
		    };
		  str ")";
		PP.closeBox strm)
	  in
	    ppDecl decl
	  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: ()),
		      l = args
		    };
		  str &quot;)&quot;;
		PP.closeBox strm)
	  in
	    ppDecl decl
	  end

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