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

SCM Repository

[diderot] View of /branches/pure-cfg/src/compiler/IL/translate-fn.sml
ViewVC logotype

View of /branches/pure-cfg/src/compiler/IL/translate-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 654 - (download) (annotate)
Mon Mar 21 17:10:54 2011 UTC (9 years ago) by jhr
File size: 5726 byte(s)
  Added support for tracking output state variables through ILs and generating
  a print function in the C target.
(* translate-fn.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * This functor supports the common parts of translating between different
 * instances of the SSA-based ILs (e.g., from HighIL to MidIL).
 *)

signature TRANSLATE_PARAMS =
  sig

    structure SrcIL : SSA
    structure DstIL : SSA

    type var_env = DstIL.var SrcIL.Var.Tbl.hash_table

    val rename : (var_env * SrcIL.var) -> DstIL.var
    val renameList : (var_env * SrcIL.var list) -> DstIL.var list
    val expand : (var_env * SrcIL.assign) -> DstIL.cfg

  end

functor TranslateFn (Params : TRANSLATE_PARAMS) : sig

    structure SrcIL : SSA
    structure DstIL : SSA

    type var_env = Params.var_env

    val translate : SrcIL.program -> DstIL.program

  end = struct

    structure SrcIL = Params.SrcIL
    structure SrcNd = SrcIL.Node
    structure VTbl = SrcIL.Var.Tbl
    structure DstIL = Params.DstIL
    structure DstNd = DstIL.Node
    structure DstCFG = DstIL.CFG

    type var_env = Params.var_env

    datatype env = E of {
	ndMap : DstIL.node Stamp.Tbl.hash_table,
	vMap : var_env
      }

    fun setBindings (bind, xs) = (List.app (fn x => DstIL.Var.setBinding(x, bind)) xs; xs)

    fun rename (E{vMap, ...}) x = Params.rename(vMap, x)

    fun renameList (E{vMap, ...}, xs) = Params.renameList(vMap, xs)

    fun expand (E{vMap, ...}, assign) = Params.expand (vMap, assign)

    fun insertNd (E{ndMap, ...}, id, nd) = Stamp.Tbl.insert ndMap (id, nd)

    fun findNd (E{ndMap, ...}) = Stamp.Tbl.find ndMap

    fun renameNd (E{ndMap, ...}) (nd as SrcIL.ND{id, ...}) = (
	  case Stamp.Tbl.find ndMap id
	   of SOME nd' => nd'
	    | NONE => raise Fail("unable to find " ^ SrcNd.toString nd)
	  (* end case *))

    fun translateCFG (env, SrcIL.CFG{entry, exit}) = let
	  val findNd = findNd env
	  fun trans (srcNd as SrcIL.ND{id, kind, ...}) = let
		fun newNd nd = (insertNd (env, id, nd); nd)
		in
		  case findNd id
		   of SOME nd => nd
		    | NONE => (case kind
			 of SrcIL.NULL => raise Fail "unexpected NULL node"
			  | SrcIL.ENTRY{succ} => let
			      val nd = newNd (DstNd.mkENTRY())
			      in
				DstNd.addEdge (nd, trans (!succ));
				nd
			      end
			  | SrcIL.JOIN{phis, succ, ...} => let
			      fun cvtPhi (x, xs) = let
				    val x = rename env x
				    val xs = List.map (rename env) xs
				    in
				      DstIL.Var.setBinding (x, DstIL.VB_PHI xs);
				      (x, xs)
				    end
			      val nd = newNd (DstNd.mkJOIN(List.map cvtPhi (!phis)))
			      in
				DstNd.addEdge (nd, trans (!succ));
				nd
			      end
			  | SrcIL.COND{cond, trueBranch, falseBranch, ...} => let
			      val nd = newNd (DstNd.mkCOND{
				      cond = rename env cond,
				      trueBranch = DstNd.dummy,
				      falseBranch = DstNd.dummy
				    })
			      val trueB = trans (!trueBranch)
			      val _ = (DstNd.setTrueBranch (nd, trueB); DstNd.setPred(trueB, nd))
			      val falseB = trans (!falseBranch)
			      val _ = (DstNd.setFalseBranch (nd, falseB); DstNd.setPred(falseB, nd))
			      in
				nd
			      end
			  | SrcIL.COM{text, succ, ...} => let
			      val nd = newNd (DstNd.mkCOM text)
			      in
				DstNd.addEdge (nd, trans (!succ));
				nd
			      end
			  | SrcIL.ASSIGN{stm, succ, ...} => let
			      val cfg = expand (env, stm)
			      in
				if DstCFG.isEmpty cfg
				  then trans (!succ)
				  else (
				    DstNd.addEdge (DstCFG.exit cfg, trans (!succ));
				    DstCFG.entry cfg)
			      end
			  | SrcIL.NEW{strand, args, succ, ...} => let
			      val nd = newNd (DstNd.mkNEW{
				      strand = strand,
				      args = List.map (rename env) args
				    })
			      in
				DstNd.addEdge (nd, trans (!succ));
				nd
			      end
			  | SrcIL.EXIT{kind, live, ...} =>
			      newNd (DstNd.mkEXIT(kind, List.map (rename env) live))
		       (* end case *))
		  (* end case *)
		end
	  val entry = trans entry
	  val exit = (case findNd (SrcNd.id exit)
		 of SOME nd => nd
		  | NONE => DstNd.mkACTIVE[]	(* exit is unreachable *)
		(* end case *))
	  in
	    DstIL.CFG{entry = entry, exit = exit}
	  end

    fun translate (SrcIL.Program{globals, globalInit, initially, strands}) = let
	  val env = E{
		  ndMap = Stamp.Tbl.mkTable (256, Fail "ndMap"),
		  vMap = VTbl.mkTable (256, Fail "env")
		}
	  fun transInitially (SrcIL.Initially{isArray, rangeInit, iters, create}) = let
		val (argInit, strand, args) = create
		fun trIter (param, lo, hi) = let
		      val param = rename env param
		      in
			DstIL.Var.setBinding(param, DstIL.VB_PARAM);
			(param, rename env lo, rename env hi)
		      end
		val iters = List.map trIter iters
		in
		  DstIL.Initially{
		      isArray = isArray,
		      rangeInit = translateCFG (env, rangeInit),
		      create = (translateCFG (env, argInit), strand, renameList(env, args)),
		      iters = iters
		    }
		end
	  fun transMethod (SrcIL.Method{name, stateIn, stateOut, body}) =
		DstIL.Method{
		    name = name,
		    stateIn = setBindings (DstIL.VB_STATE_VAR, renameList (env, stateIn)),
		    stateOut = renameList (env, stateOut),
		    body = translateCFG (env, body)
		  }
	  fun transStrand (SrcIL.Strand{name, params, state, stateInit, methods}) =
		DstIL.Strand{
		    name = name,
		    params = setBindings (DstIL.VB_PARAM, renameList (env, params)),
		    state = List.map (fn (isOut, x) => (isOut, rename env x)) state,
		    stateInit = translateCFG (env, stateInit),
		    methods = List.map transMethod methods
		  }
	  val prog = DstIL.Program{
		  globals = renameList (env, globals),
		  globalInit = translateCFG (env, globalInit),
		  initially = transInitially initially,
		  strands = List.map transStrand strands
		}
	  in
	    prog
	  end

  end

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