(* 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 (env, x)
of SOME x' => x'
| NONE => raise Fail(concat[
"no binding for ", Var.uniqueNameOf x, " in environment"
])
(* end case *))
(* create a new instance of a variable *)
fun newVar x = IL.Var.new (Var.nameOf x)
(* expression translation *)
fun cvtExp (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
in
TranslateBasis.translate (lhs, f, tyArgs, args')
end
| S.E_Cons args => [(lhs, IL.CONS(List.map (lookup env) args))]
| S.E_Input(_, name, NONE) => [(lhs, IL.OP(HighOps.Input name, []))]
| S.E_Input(_, name, SOME dflt) =>
[(lhs, IL.OP(HighOps.InputWithDefault name, [lookup env dflt]))]
| S.E_Field fld => [(lhs, IL.OP(HighOps.Field fld, []))]
| S.E_LoadImage info => [(lhs, IL.OP(HighOps.LoadImage info, []))]
(* 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, optExit) = let
fun toBlock (env, assigned, [], assignments) = let
val stm = IL.Stmt.mkBLOCK(List.rev assignments, optExit)
in
(stm, IL.Stmt.tail stm, env, assigned)
end
| 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')
in
toBlock (env, assigned, rest, stms@assignments)
end
| toBlock (env, assigned, stms, assignments) = let
val (next, last, env, assigned) = toStmt (env, assigned, stms)
val blk = IL.Stmt.mkBLOCK(List.rev assignments, SOME next)
in
IL.Node.addEdge (IL.Stmt.tail blk, IL.Stmt.entry next);
(blk, last, env, assigned)
end
and toStmt (env, assigned, []) = let
(* this case only occurs for the empty else arm of an if-then-else statement *)
val stm = IL.Stmt.mkBLOCK([], optExit)
in
(stm, IL.Stmt.tail stm, env, assigned)
end
| toStmt (env, assigned, stms as stm::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, last1, env1, assigned1) = cvtBlock(env, b1, NONE)
val (s2, last2, env2, assigned2) = cvtBlock(env, b2, NONE)
val assigned = VSet.union(assigned1, assigned2)
(* PROBLEM: what about variables that are assigned for the first time in one branch
* and not the other? This situation should only occur for variables who's scope is
* the branch of the if. Short-term solution is to ignore variables that are defined
* in only one branch.
*)
val (env, phis) = let
fun mkPhi (x, (env, phis)) = (
case (VMap.find(env1, x), VMap.find(env2, x))
of (SOME x1, SOME x2) => let
val x' = newVar x
in
(VMap.insert(env, x, x'), (x', [x1, x2])::phis)
end
| _ => (env, phis)
(* end case *))
in
VSet.foldl mkPhi (env, []) assigned
end
in
case rest
of [] => let
val join = IL.Stmt.mkJOIN (phis, optExit)
val joinNd = IL.Stmt.entry join
val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)
in
IL.Node.addEdge (last2, joinNd);
IL.Node.addEdge (last1, joinNd);
(stm, joinNd, env, assigned)
end
| _ => let
val (next, last, env, assigned) = toStmt (env, assigned, rest)
val join = IL.Stmt.mkJOIN (phis, SOME next)
val joinNd = IL.Stmt.entry join
val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)
in
IL.Node.addEdge (last2, joinNd);
IL.Node.addEdge (last1, joinNd);
IL.Node.addEdge (joinNd, IL.Stmt.entry next);
(stm, last, env, assigned)
end
(* end case *)
end
| S.S_New(name, xs) => let
val xs' = List.map (lookup env) xs
in
case rest
of [] => let
val stm = IL.Stmt.mkNEW(name, xs', optExit)
in
(stm, IL.Stmt.tail stm, env, assigned)
end
| _ => let
val (next, last, env, assigned) = toStmt (env, assigned, rest)
val stm = IL.Stmt.mkNEW(name, xs', SOME next)
in
IL.Node.addEdge (IL.Stmt.tail stm, IL.Stmt.entry next);
(stm, last, env, assigned)
end
end
| S.S_Die => let
val stm = IL.Stmt.mkDIE()
in
(stm, IL.Stmt.tail stm, env, assigned)
end
| S.S_Stabilize => let
val stm = IL.Stmt.mkSTABILIZE()
in
(stm, IL.Stmt.tail stm, env, assigned)
end
(* end case *))
in
toStmt (env, VSet.empty, stms)
end
fun cvtTopLevelBlock (env, blk) = let
val exit = IL.Stmt.mkEXIT ()
val (stm, last, env, assigned) = cvtBlock (env, blk, SOME exit)
val entry = IL.Stmt.mkENTRY (SOME stm)
in
IL.Node.addEdge (IL.Stmt.tail entry, IL.Stmt.entry stm);
(* NOTE: this could fail if all control paths end in DIE or STABILIZE, so we
* wrap it in a handler
*)
IL.Node.addEdge (last, IL.Stmt.entry exit) handle _ => ();
(entry, env)
end
(* generate fresh SSA variables and add them to the environment *)
fun freshVars (env, xs) = let
fun cvtVar (x, (env, xs)) = let
val x' = newVar x
in
(VMap.insert(env, x, x'), x'::xs)
end
val (env, xs) = List.foldl cvtVar (env, []) xs
in
(env, List.rev xs)
end
fun translate (S.Program{globals, globalInit, actors}) = let
val (globalInit, env) = cvtTopLevelBlock (VMap.empty, globalInit)
(* get the SSA names for the globals and a reduced environment that just defines
* the globals.
*)
val (env, globs) = let
val lookup = lookup env
fun cvtVar (x, (env, globs)) = let
val x' = lookup x
in
(VMap.insert(env, x, x'), x'::globs)
end
val (env, globs) = List.foldl cvtVar (VMap.empty, []) globals
in
(env, List.rev globs)
end
fun cvtActor (S.Actor{name, params, state, stateInit, methods}) = let
val (env, params) = let
fun cvtParam (x, (env, xs)) = let
val x' = newVar x
in
(VMap.insert(env, x, x'), x'::xs)
end
val (env, params) = List.foldl cvtParam (env, []) params
in
(env, List.rev params)
end
val (stateInit, env) = cvtTopLevelBlock (env, stateInit)
val state' = List.map (lookup env) state
fun cvtMethod (S.Method(name, blk)) = let
(* allocate fresh variables for the state variables *)
val (env, stateIn) = freshVars (env, state)
val (body, env) = cvtTopLevelBlock (env, blk)
val stateOut = List.map (lookup env) state
in
IL.Method{name=name, stateIn=stateIn, stateOut=stateOut, body=body}
end
in
IL.Actor{
name = name,
params = params,
state = state',
stateInit = stateInit,
methods = List.map cvtMethod methods
}
end
in
IL.Program{
globals = globs,
globalInit = globalInit,
actors = List.map cvtActor actors
}
end
end