(* 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