Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] View of /branches/lamont/src/compiler/simplify/simple-pp.sml
ViewVC logotype

View of /branches/lamont/src/compiler/simplify/simple-pp.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2246 - (download) (annotate)
Sun Mar 3 14:51:31 2013 UTC (6 years, 7 months ago) by lamonts
File size: 10670 byte(s)
Added Reductions into its own block and allow strands to use the strand pool correctly when allocating new strands
(* simple-pp.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Pretty printing for the Simple-AST representation.
 *)

structure SimplePP : sig

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

  end = struct

    structure PP = TextIOPP
    structure TU = TypeUtil
    structure S = Simple

    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

    (* converts the reduction op to a string *) 
    fun reductionToString(r) = (case r 
     of S.R_Max => "max"
      | S.R_Min => "min" 
      | S.R_Exists => "exists" 
      | S.R_All => "all" 
      | S.R_Mean => "mean" 
      | S.R_Variance => "variance" 
      | S.R_Product => "product" 
      | S.R_Sum => "sum") 


  (* 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 ppSets(ppStrm,sets) = let 
      val string = PP.string ppStrm 
      fun ppSetsList([]) = () 
        | ppSetsList(x::[]) = (case x 
            of S.SS_All => string "all" 
             | S.SS_Active => string "active"
             | S.SS_Stable => string "stable")
        | ppSetsList(x::xs) = (case x 
            of S.SS_All => (string "all,"; ppSetsList(xs)) 
             | S.SS_Active => (string "active,"; ppSetsList(xs))
             | S.SS_Stable => (string "stable,";  ppSetsList(xs)))
      in 
         ppSetsList(sets)
      end 

    fun ppVar (ppStrm, x) = PP.string ppStrm (Var.uniqueNameOf x)

    fun ppVarDecl ppStrm = let
	  fun sp () = PP.space ppStrm 1
	  val string = PP.string ppStrm
	  in
	    fn x => (
	      PP.openHBox ppStrm;
		case Var.kindOf x
		 of S.InputVar => (string "input"; sp())
		  | S.StrandOutputVar => (string "output"; sp())
		  | _ => ()
		(* end case *);
		string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.uniqueNameOf x); string ";";
	      PP.closeBox ppStrm)
	  end

    fun ppExp (ppStrm, e) = let
	  fun sp () = PP.space ppStrm 1
	  val string = PP.string ppStrm
	  fun var x = ppVar (ppStrm, x)
	  fun ppIndex (ppStrm, NONE) = PP.string ppStrm ":"
	    | ppIndex (ppStrm, SOME i) = var i
	  fun pp e = (case e
		 of S.E_Var x => var x
		  | S.E_Lit lit => string (Literal.toString lit)
          | S.E_Selector(x,f,ty) => (
               var x; string "."; string (Atom.toString f); sp()  ) 
          | S.E_StrandSet(sets,ty) => (
                 string "{"; ppSets (ppStrm,sets); string "}")
          | S.E_Reduction(r,sv,_,xExp,ty) =>
                (string (reductionToString(r)); string "{"; sp(); var xExp; string "}"; sp())   
		  | S.E_Tuple es => ppArgs (ppStrm, es)
		  | S.E_Apply(f, [], args, _) => (var f; sp(); ppArgs (ppStrm, args))
		  | S.E_Apply(f, mvs, args, _) => (
		      var f; ppTyArgs (ppStrm, mvs); sp(); ppArgs (ppStrm, args))
		  | S.E_Cons es => (
		      ppList ppVar ("[", ",", "]") (ppStrm, es))
		  | S.E_Seq es => (
		      ppList ppVar ("{", ",", "}") (ppStrm, es))
		  | S.E_Slice(x, indices, _) => (
		      var x;
		      ppList ppIndex ("[", ",", "]") (ppStrm, indices))
                  | S.E_Coerce{srcTy, dstTy, x} => (
                      string "("; string(TU.toString dstTy); string ")"; var x)
		  | S.E_LoadSeq(ty, nrrd) => (
		      string "loadSeq<"; string(TU.toString ty); string ">(\"";
		      string(String.toString nrrd); string "\")")
		  | S.E_LoadImage(ty, nrrd, _) => (
		      string "loadImage<"; string(TU.toString ty); string ">(\"";
		      string(String.toString nrrd); string "\")")
		(* end case *))
	  in
	    pp e
	  end

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

    fun ppBlock (ppStrm, [], S.Block[]) = PP.string ppStrm "{ }"
      | ppBlock (ppStrm, vars, S.Block stms) = let
	  fun sp () = PP.space ppStrm 1
	  fun nl () = PP.newline ppStrm
	  val string = PP.string ppStrm
	  fun var x = ppVar (ppStrm, x)
	  fun ppStmt stmt = (
		nl();
		case stmt
		 of S.S_Var x => (
		      PP.openHBox ppStrm;
			string(TU.toString(#2(Var.typeOf x))); sp(); var x; string ";";
		      PP.closeBox ppStrm)
		  | S.S_Assign(x, e) => (
		      PP.openHBox ppStrm;
			var x; sp(); string "="; sp(); ppExp(ppStrm, e); string ";";
		      PP.closeBox ppStrm)
		  | S.S_IfThenElse(x, S.Block[s1], S.Block[]) => (
		      PP.openVBox ppStrm indent;
			PP.openHBox ppStrm;
			  string "if"; sp(); ppVar(ppStrm, x);
			PP.closeBox ppStrm;
			ppStmt s1;
		      PP.closeBox ppStrm)
		  | S.S_IfThenElse(x, blk, S.Block[]) => (
		      PP.openHBox ppStrm;
			string "if"; sp(); ppVar(ppStrm, x);
			sp(); ppBlock (ppStrm, [], blk);
		      PP.closeBox ppStrm)
		  | S.S_IfThenElse(x, S.Block[s1], S.Block[s2]) => (
		      PP.openVBox ppStrm indent;
			PP.openHBox ppStrm;
			  string "if"; sp(); ppVar(ppStrm, x);
			PP.closeBox ppStrm;
			ppStmt s1;
		      PP.closeBox ppStrm;
		      nl();
		      PP.openVBox ppStrm indent;
			string "else";
			ppStmt s2;
		      PP.closeBox ppStrm)
		  | S.S_IfThenElse(x, blk1, blk2) => (
		      PP.openHBox ppStrm;
			string "if"; sp(); ppVar(ppStrm, x);
			sp(); ppBlock (ppStrm, [], blk1);
		      PP.closeBox ppStrm;
		      PP.openHBox ppStrm;
			sp(); string "else"; sp(); ppBlock (ppStrm, [], blk2);
		      PP.closeBox ppStrm)
          | S.S_Foreach (x, e, S.Block[s]) => (
              PP.openHBox ppStrm;
              string "foreach("; sp(); ppVar(ppStrm, x); string " = "; ppExp(ppStrm,e); string ")";
              sp(); nl(); ppStmt s;
              PP.closeBox ppStrm) 
          | S.S_Foreach (x,e,blk) => (
              PP.openVBox ppStrm indent;
			  PP.openHBox ppStrm;
              string "foreach("; sp(); ppVar(ppStrm, x);  string " = "; ppExp(ppStrm,e); string ")";
			  PP.closeBox ppStrm;
			  nl();
			  ppBlock (ppStrm,[], blk);
		      PP.closeBox ppStrm) 
		  | S.S_New(strand, args) => (
		      PP.openHBox ppStrm;
			string "new"; sp(); string(Atom.toString strand); sp();
			ppArgs (ppStrm, args); string ";";
		      PP.closeBox ppStrm)
		  | S.S_Die => string "die;"
		  | S.S_Stabilize => string "stabilize;"
                  | S.S_Print args => (
                      PP.openHBox ppStrm;
                        string "print"; sp(); ppArgs (ppStrm, args); string ";";
                      PP.closeBox ppStrm;
                      nl())
		(* end case *))
	  in
	    PP.openVBox ppStrm (PP.Abs 0);
	      string "{";
	      PP.openVBox ppStrm indent;
	        List.app (fn vdcl => (nl(); ppVarDecl ppStrm vdcl)) vars;
		List.app ppStmt stms;
	      PP.closeBox ppStrm;
	      nl(); string "}";
	    PP.closeBox ppStrm
	  end

    fun ppInit (ppStrm, S.Initially{isArray, rangeInit, iters, create}) = let
	  fun sp () = PP.space ppStrm 1
	  fun nl () = PP.newline ppStrm
	  val string = PP.string ppStrm
	  fun var x = ppVar (ppStrm, x)
	  val label = if isArray then "Array" else "Collection"
	  fun ppIters [] = let
		val S.C_Create{argInit, name, args} = create
		in
		  ppBlock (ppStrm, [], argInit); nl();
		  PP.openHBox ppStrm;
		    string "new"; sp(); string(Atom.toString name);
		    ppArgs (ppStrm, args); string ";";
		  PP.closeBox ppStrm
		end
	    | ppIters ({param, lo, hi} :: iters) = (
		PP.openVBox ppStrm indent;
		  PP.openHBox ppStrm;
		    string "for"; sp();
		    string(TU.toString(#2(Var.typeOf param))); sp(); var param;
		    sp(); string "="; sp(); var lo; sp(); string ".."; sp(); var hi;
		  PP.closeBox ppStrm;
		  nl();
		  ppIters iters;
		PP.closeBox ppStrm)
	  in
	    PP.openVBox ppStrm indent;
	      string label; nl();
	      ppBlock (ppStrm, [], rangeInit); nl();
	      ppIters iters;
	    PP.closeBox ppStrm;
	    nl()
	  end

    fun ppStrand ppStrm (S.Strand{name, params, state, stateInit, methods}) = let
	  fun sp () = PP.space ppStrm 1
	  fun nl () = PP.newline ppStrm
	  val string = PP.string ppStrm
	  fun var x = ppVar (ppStrm, x)
	  fun ppMethod (S.Method(name, body)) = (
		nl(); string(StrandUtil.nameToString name); nl(); ppBlock (ppStrm, [], body))
	  in
	    PP.openHBox ppStrm;
	      string "strand"; 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 "{";
	      ppBlock (ppStrm, state, stateInit);
	      List.app ppMethod methods;
	    PP.closeBox ppStrm;
	    nl();
	    string "}";  nl()
	  end

    fun ppInput ppStrm = let
	  fun sp () = PP.space ppStrm 1
	  fun nl () = PP.newline ppStrm
	  val string = PP.string ppStrm
	  fun var x = ppVar (ppStrm, x)
	  fun pp (x, Inputs.INP{name, desc, init, ...}) = (
		PP.openHBox ppStrm;
		  string "input"; sp();
		  string(TU.toString(#2(Var.typeOf x))); sp();
		  ppVar (ppStrm, x); string ": ";
		  string name;
		  case desc
		   of SOME desc => string(concat["(\"", desc, "\")"])
		    | NONE => ()
		  (* end case *);
		  case init
		   of SOME init => (
			sp(); string "="; sp();
			string(Inputs.initToString init); string ";")
		    | NONE => string ";"
		  (* end case *);
		  nl();
		PP.closeBox ppStrm)
	  in
	    pp
	  end

    fun output (outS, S.Program{inputs, globals, globalInit, globalReduce, globalBlock, strands, init,...}) = let
	  val ppStrm = PP.openOut {dst = outS, wid = 120}
	  fun nl () = PP.newline ppStrm
	  in
	    PP.openVBox ppStrm (PP.Abs 0);
	      PP.string ppStrm "/* Simplified Program start */"; nl();
	      List.app (ppInput ppStrm) inputs;
	      ppBlock (ppStrm, globals, globalInit);
	      nl();
	      PP.string ppStrm "(*** Global Block ***)"; nl();
          ppBlock (ppStrm, [], globalBlock); 
	      nl();
	      PP.string ppStrm "(*** Global Reduce ***)"; nl();
          ppBlock (ppStrm, [], globalReduce); 
	      nl();
	      ppInit (ppStrm, init);
	      List.app (ppStrand ppStrm) strands;
	      PP.string ppStrm "/* Program end */"; PP.newline ppStrm;
	    PP.closeBox ppStrm;
	    PP.closeStream ppStrm
	  end

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0