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

SCM Repository

[diderot] View of /branches/lamont_dev/src/compiler/translate/translate.sml
ViewVC logotype

View of /branches/lamont_dev/src/compiler/translate/translate.sml

Parent Directory Parent Directory | Revision Log Revision Log

Revision 192 - (download) (annotate)
Mon Aug 2 16:23:42 2010 UTC (9 years, 3 months ago) by jhr
Original Path: trunk/src/compiler/translate/translate.sml
File size: 3770 byte(s)
  Working on translation to IL
(* translate.sml
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
 * All rights reserved.
 * Translate Simple-AST code into the IL representation.

structure Translate : sig

    val translate : Simple.program -> HighIL.program

  end = struct

    structure S = Simple
    structure VMap = Var.Map
    structure VSet = Var.Set
    structure IL = HighIL

    fun lookup env x = (case VMap.find x
	   of SOME x' => x'
	    | NONE => raise Fail(concat[
		  "no binding for ", Var.toString x, " in environment"
	  (* end case *))

  (* create a new instance of a variable *)
    fun newVar x = IL.newVar (Var.nameOf x)

  (* expression translation *)
    fun cvtExpr (env, lhs, exp) = (case exp
	   of S.E_Var x => [(lhs, IL.VAR(lookup env x))]
	    | S.E_Lit lit => [(lhs, IL.LIT lit)]
	    | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
	    | S.E_Apply(f, tyArgs, args, ty) => let
		val args' = List.map (lookup env) args
		  TranslateBasis.translate (lhs, f, tyArgs, args')
	    | S.E_Cons args => [(lhs, IL.CONS(List.map (lookup env) args))]
	  (* end case *))

  (* convert a Simple AST block to an IL statement.  We return the statement that represents the
   * block, plus the environment mapping Simple AST variables to their current SSA representations
   * and the set of Simple AST variables that were assigned to in the block.
    fun cvtBlock (env, S.Block stms) = let
	  fun toBlock (env, assigned, [], assignments) =
		(IL.mkBLOCK{succ=IL.dummy, body=List.rev assignments}, env, assigned)
	    | toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let
		val x' = newVar x
		val stms = cvtExp(env, x', e)
		val assigned = VSet.add(assigned, x)
		val env = VMap.insert(env, x, x')
		  cvt (env, assigned, rest, stms@assignments)
	    | toBlock (env, assigned, stms, assignments) = let
		val (succ, env, assigned) = toStmt (env, assigned, stms)
		val blk = IL.mkBLOCK{succ=succ, body=List.rev assignments}
		  IL.addPred (succ, blk);
		  (blk, env, assigned)
	  and toStmt (env, assigned, []) =
		(IL.mkBLOCK{succ=IL.dummy, body=[]}, env, assigned)
	    | toStmt (env, assigned, stms as stmt::rest) = (case stm
		 of S.S_Assign => toBlock (env, assigned, stms)
		  | S.S_IfThenElse(x, b1, b2) => let
		      val x' = lookup env x
		      val (s1, env1, assigned1) = block(env, b1)
		      val (s2, env2, assigned2) = block(env, b2)
		      val assigned = VSet.union(assigned1, assigned2)
		      val (env, phis) = let
			    fun mkPhi (x, (env, phis) = let
				  val x1 = lookup(env1, x)
				  val x2 = lookup(env2, x)
				  val x' = newVar x
				    (VMap.insert(env, x, x'), (x', [x1, x2])::phis)
			      VSet.foldl mkPhi (env, []) assigned
		      val stm = IL.mkIF{cond=x', thenBranch=s1, elseBranch=s2}
			case rest
			 of [] => (stm, env, assigned)
			  | _ => let
			      val (join, env, assigned) = toStmt (env, assigned, rest)
				IL.addPred (join, stm);
				IL.setSucc (stm, join);
				(stm, env, assigned)
			(* end case *)
		  | S.S_New(name, xs) => let
		      val xs' = List.map (lookup env) xs
			case rest
			 of [] => (IL.mkNEW{actor=name, args=xs', succ=IL.dummy}, env, assigned)
			  | _ => let
			      val (succ, env, assigned) = toStmt (env, assigned, rest)
			      val stm = IL.mkNEW{actor=name, args=xs', succ=succ}
				IL.addPred (succ, stm);
				(stm, env, assigned)
		  | S.S_Die => (IL.mkDIE(), assigned, stms)
		  | S.S_Stabilize => (IL.mkSTABILIZE(), assigned, stms)
		(* end case *))
	    toStmt (env, VSet.empty, stms)

    fun translate (S.Program{globals, globaInit, actors}) = ??


ViewVC Help
Powered by ViewVC 1.0.0