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/low-to-tree.sml
ViewVC logotype

View of /branches/pure-cfg/src/compiler/codegen/low-to-tree.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 529 - (download) (annotate)
Mon Feb 14 15:03:54 2011 UTC (10 years, 2 months ago) by jhr
File size: 4297 byte(s)
  Working on code generation
(* low-to-tree.sml
 *
 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *)

structure LowToTree : sig

    val translate : LowIL.program -> TreeIL.program

  end = struct

    structure IL = LowIL
    structure Ty = LowILTypes
    structure V = LowIL.Var
    structure Op = LowOps
    structure Nd = LowIL.Node
    structure CFG = LowIL.CFG
    structure T = TreeIL

  (* create new tree IL variables *)
    local
      val newVar (name, kind, ty) = V{
	      name = name,
	      stamp = Stamp.new(),
	      kind = kind,
	      ty = ty
	    }
      val cnt = ref 0
      fun genName prefix = let
	    val n = !cnt
	    in
	      cnt := n+1;
	      String.concat[prefix, "_", Int.toString n]
	    end
    in
    fun newGlobal x = newVar (V.name x, T.VK_Global, V.ty x)
    fun newLocal x = newVar (genName(V.name x), T.VK_Local, V.ty x)
    end

  (* a property to map global IL variables to tree IL variables *)
    local
      val {peekFn : IL.var -> T.var option, setFn, ...} = V.newProp (fn _ => raise Fail "global prop")
    in
    fun isGlobal x = (case peekFn x of NONE => false | _ => true)
    fun markGlobal (x, x') = setFn (x, x')
    fun toTreeGlobal x = (case peekFn x
	   of SOME x' => x'
	    | _ => raise Fail(concat["toTreeGlobal(", V.toString x, ")"])
	  (* end case *))
    end

  (* an environment for treeification *)
    fun env = E of {
	vdef : T.exp V.Map.map,
	locals : T.var list
      }

    fun addLocal (E{vdef, locals}, x) = E{vdef=vdef, locals=x::locals}

    fun insert (E{vdef, locals}, x, exp) = E{vdef=V.Map.insert(vdef, x, exp), locals=locals}

    fun lookup (E{vdef, ...}) x = (case V.Map.find(vdef, x)
	   of SOME exp => exp
	    | NONE => raise Fail(concat["LowIL variable ", V.toString x, " is not defined"])
	  (* end case *))

    fun bind (env, lhs, rhs) = (case peekGlobal lhs
	   of SOME x => (insert(env, lhs, T.E_Var x), [T.S_Assign(x, rhs)])
	    | NONE => if (V.useCount lhs = 1)
		then (insert(env, lhs, rhs), [])
		else let
		  val t = newLocal lhs
		  in
		    (insert(env, lhs, T.E_Var t), [T.S_Assign(t, rhs)])
		  end
	  (* end case *))

    fun setDef (env, lhs, rhs) = (case peekGlobal lhs
	   of SOME x => (insert(env, lhs, T.E_Var x), [T.S_Assign(x, rhs)])
	    | NONE => (insert(env, lhs, rhs), [])
	  (* end case *))

  (* translate a LowIL assignment to a list of zero or more target statements *)
    fun doAssign (env, lhs, rhs) = (case rhs
	   of IL.VAR x => setDef (lookup env x)
	    | IL.LIT lit => setDef (T.E_Lit lit)
	    | IL.OP(rator, args) =>
		bind (env, lhs, T.E_Op(rator, List.map (lookup env) args))
	    | IL.CONS args => let
	      (* we give cons expressions names, since not all targets support them inline *)
		val t = newLocal lhs
		val rhs = T.E_Cons(List.map (lookup env) args)
		in
		  (insert(env, lhs, T.E_Var t), [T.S_Assign(t, rhs)])
		end
	  (* end case *))

    fun gen (env, cfg) = let
	  fun doNode (env, ifCont, stms, nd) = (case Nd.kind nd
		 of IL.NULL => raise Fail "unexpected NULL"
		  | IL.ENTRY{succ} => doNode (env, ifCont, stms, !succ)
		  | IL.JOIN{phis, succ, ...} => ifCont (stms, Nd.kind nd)
		  | IL.COND{cond, trueBranch, falseBranch, ...} => let
		      fun kThen (stms', _) = let
			    val thenBlk = T.Stmt.block (List.rev stms')
			    fun kElse (stms', IL.JOIN{phis, succ, ...}) = let
				  val stm = T.Stmt.ifthenelse (
					lookup env cond,
					thenBlk,
					T.Stmt.block (List.rev stms'))
				  in
(* FIXME: what do we do about phis? *)
				    doNode (env, ifCont, stm::stms, !succ)
				  end
			    in
			      doNode (env, kElse, [], !falseBranch)
			    end
		      in
			doNode (env, kThen, [], !trueBranch)
		      end
		  | IL.COM {text, succ, ...} =>
		      doNode (env, ifCont, T.Stmt.comment text :: stms, !succ)
		  | IL.ASSIGN{stm, succ, ...} =>
		      doNode (env, ifCont, doAssign stm @ stms, !succ)
		  | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
		  | IL.DIE _ =>
		      T.Stmt.block (List.rev (T.Stmt.die() :: stms))
		  | IL.STABILIZE _ =>
		      T.Stmt.block (List.rev stms)
		  | IL.EXIT _ => T.Stmt.block (List.rev (T.Stmt.stabilize() :: stms))
		(* end case *))
	  in
	    doNode (vtbl, fn _ => raise Fail "bogus ifCont at JOIN node", [], CFG.entry cfg)
	  end

  end

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