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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 512 - (download) (annotate)
Tue Feb 8 19:32:42 2011 UTC (9 years, 11 months ago) by jhr
File size: 5511 byte(s)
  Working on code generation 
(* codegen-fn.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Generic support for translating LowIL code to the target representation.  We
 * assume that the LowIL has first been run through the splitting pass to match
 * the target's vector widths.
 *)

functor CodeGenFn (T : TARGET) : sig

    val generate : LowIL.program -> T.program

  end = struct

    structure IL = LowIL
    structure V = LowIL.Var
    structure Op = LowOps
    structure Nd = LowIL.Node
    structure CFG = LowIL.Node

  (* a mapping from LowIL variables to target expressions.  Variables get
   * removed when the expressions are used as arguments.
   *)
    structure VDefTbl : sig
	type tbl

	val newTbl : unit -> tbl
	val getDefOf : tbl -> V.var -> T.exp
	val useDefOf : tbl -> V.var -> T.exp
	val setDefOf : tbl -> (V.var * T.exp) -> unit

	val clear : tbl -> unit

	val bind : tbl -> (V.var * T.exp) -> T.stm list

      (* force all pending expressions into variables *)
	val flush : tbl -> T.stm list

      end = struct

	type info = {
	    cnt : int ref,	(* count of oustanding uses (usually 1) *)
	    bind : T.exp
	  }

	type tbl = info V.Tbl.hash_table

	fun newTbl () = V.Tbl.mkTable (512, Fail "vtbl")

	fun getDefOf tbl x = (case V.Tbl.find tbl x
	       of NONE => ??
		| SOME{bind, cnt} => bind
	      (* end case *))

	fun useDefOf tbl x = (case V.Tbl.find tbl x
	       of NONE => ??
		| SOME{cnt=ref 1, bind} => (
		    ignore (V.Tbl.remove tbl x);
		    bind)
		| SOME{cnt, bind} =>  => (
		    cnt := !cnt - 1;
		    bind)
	      (* end case *))

	fun setDefOf tbl (x, exp) =
	      V.Tbl.insert tbl (x, {cnt = ref(V.useCount x), bind = exp})

	fun assign tbl (x, exp) = let
		    val lhs : T.local_var = ??
		    in
		      V.Tbl.insert tbl
			(x, {cnt = V.useCount x, bind = T.Expr.var lhs});
		      [T.Stmt.assign(lhs, exp)]
		    end

	fun bind tbl (x, exp) = (case V.useCount lhs
	       of 1 => (V.Tbl.insert tbl (x, {cnt = 1, bind = exp}); [])
		| n => let (* bind exp to a new target variable *)
		    val lhs : T.local_var = ??
		    in
		      V.Tbl.insert tbl (x, {cnt = n, bind = T.Expr.var lhs});
		      [T.Stmt.assign(lhs, exp)]
		    end
	      (* end case *))

      end (*  VDefTbl *)

(* FIXME: what about splitting code where the target width doesn't match the
 * source width?
 *)
    fun doRator (vtbl, lhs, rator, args) = let
	  val args' = List.map (VDefTbl.useDefOf vtbl) args
	  val rhs' = (case rator
(* ??? *)
		(* end case *))
	  in
	    VDefTbl.bind vtbl (lhs, rhs')
	  end

  (* translate a LowIL assignment to a list of zero or more target statements *)
    fun doAssign vtbl (lhs, rhs) = let
	  fun setDef rhs = (VTbl.setDefOf vtbl (lhs, rhs); [])
	  in
	    case rhs
	     of IL.VAR x => setDef (T.Expr.var(VDefTbl.useDefOf vtbl x))
	      | IL.LIT(Literal.Int n) => setDef (T.Expr.intLit n)
	      | IL.LIT(Literal.Bool b) => setDef (T.Expr.boolLit b)
	      | IL.LIT(Literal.Float f) => setDef (T.Expr.floatLit f)
	      | IL.LIT(Literal.String s) => setDef (T.Expr.stringLit s)
	      | IL.OP(rator, args) => doRator(vtbl, lhs, rator, args)
	      | IL.CONS args =>
		  VTbl.assign ctbl (lhs, T.Expr.vector (List.map (VDefTbl.useDefOf vtbl) args))
	    (* end case *)
	  end

    datatype open_if = T.stm list * IL.node -> stm

    fun gen (vtbl, cfg) = let
	  val doAssign = doAssign vtbl
	  fun doNode (vtbl, ifStk, stms, nd) = (case Nd.kind nd
		 of IL.NULL =>
		  | IL.ENTRY{succ} =>
		  | IL.JOIN{phis, succ, ...} =>
		  | IL.COND{cond, trueBranch, falseBranch, ...} => let
		      fun kThen (stms', _) = let
			    val thenBlk = T.Stmt.block (List.rev stms')
			    fun kElse (stms', succ) = let
				  val stm = T.Stmt.ifthenelse (
					VDefTbl.useDefOf vtbl cond,
					thenBlk,
					T.Stmt.block (List.rev stms'))
				  in
				    doNode (vtbl, ifStk, stm::stms, succ)
				  end
			    in
			      doNode (vtbl, kElse::ifStk, [], !falseBranch)
			    end
		      in
			doNode (vtbl, kThen::ifStk, [], !trueBranch)
		      end
		  | IL.COM {text, succ, ...} =>
		  | IL.ASSIGN{stm, succ, ...} =>
		  | IL.NEW{strand, args, succ, ...} =>
		  | IL.DIE _ =>
		  | IL.STABILIZE _ =>
		  | IL.EXIT _ =>
		(* end case *))
	  in
	  end

    fun gen (vtbl, stm) = let
	  val doAssign = doAssign vtbl
	  fun mkBlock [] = ?
	    | mkBlock [s] = s
	    | mkBlock stms = T.Stmt.block stms
	  fun doStmt (IL.STM{kind, next, ...}) = let
		val stms = (case kind
		       of IL.S_SIMPLE nd => doNode nd
			| IL.S_IF{cond, thenBranch, elseBranch} => let
			    val IL.ND{kind=IL.COND{cond, ...}, ...} = cond
			    val s1 = mkBlock(doStmt thenBranch)
			    val s2 = mkBlock(doStmt elseBranch)
			    in
(* FIXME: check for empty else branch *)
			      T.ifthenelse(VDefTbl.useDefOf vtbl cond, s1, s2)
			    end
			| IL.S_LOOP{hdr, cond, body} => raise Fail "LOOP not supported yet"
		      (* end case *))
		val rest = (case next
		       of NONE => VDefTbl.flush vtbl
			| SOME stm = doStmt stm
		      (* end case *))
		in
		  stms @ rest
		end
	  and doNode (IL.ND{kind, ...}) = (case kind
		 of IL.NULL => ??
		  | IL.ENTRY{succ} => nextNode succ
		  | IL.JOIN{succ, ...} =>
		  | IL.COND{cond, ...} =>
		  | IL.BLOCK{body, succ, ...} =>
		      List.app doAssign body @ nextNode succ
		  | IL.NEW{strand, args, ...} =>
		  | IL.DIE _ =>
		  | IL.STABILIZE _ =>
		  | IL.EXIT _ =>
		(* end case *))
	  and nextNode nd = if isFirst nd then [] else doNode nd
	  in
	    mkBlock (doStmt stm)
	  end

  end

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