(* value-numbering-fn.sml
*
* COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
* All rights reserved.
*
* This file contains an implementation of the hash-based value numbering
* algorithm described in
*
* Value Numbering
* by Preston Briggs, Keith Cooper, and Taylor Simpson
* CRPC-TR94517-S
* November 1994
*)
functor ValueNumberingFn (D : DOMINANCE_TREE) : sig
structure IL : SSA
val transform : IL.program -> IL.program
end = struct
structure IL = D.IL
structure E = ExprFn (IL)
structure ValueMap = E.Map
structure ST = Stats
structure HE=hashEin
structure PE=Printer
type expr = E.expr
(********** Counters for statistics **********)
val cntMeaninglessPhi = ST.newCounter (IL.ilName ^ ":meaningless-phi")
val cntRedundantPhi = ST.newCounter (IL.ilName ^ ":redundant-phi")
val cntRedundantAssign = ST.newCounter (IL.ilName ^ ":redundant-assign")
(* adjust a variable's use count *)
fun incUse (IL.V{useCnt, ...}) = (useCnt := !useCnt + 1)
fun decUse (IL.V{useCnt, ...}) = (useCnt := !useCnt - 1)
local
(* property for mapping variables to their value number (VN), which is represented as a
* SSA variable. If their VN is different from themselves, then they are redundant.
*)
val {getFn=getVN, setFn=setVN, clrFn=clrVN, ...} = IL.Var.newProp (fn x => x)
(* property for mapping value numbers to hash-consed expressions. *)
val {getFn=getExp : IL.var -> expr, setFn=setExp, clrFn=clrExp, ...} =
IL.Var.newProp (fn x => raise Fail(concat["getExp(", IL.Var.toString x, ")"]))
datatype env = ENV of {
avail : IL.var ValueMap.map (* map from expressions to their value numbers, which *)
(* are represented as SSA vars. The domain are those *)
(* expressions that are available. *)
}
in
val emptyEnv = ENV{avail = ValueMap.empty}
(* map variables to their hash-consed definition *)
val getVN = getVN
val setVN = setVN
fun varToExp x = ((*print "\n VarToExp"; print(IL.Var.toString x);*)getExp(getVN x))
fun bindVarToExp (ENV{avail}, x, e) = (
(*DEBUG**Log.msg()*)
(*print (concat["** bindVarToExp: ", IL.Var.toString x, " --> ", E.toString e, "\n"]);*)
setVN(x, x); setExp(x, e);
ENV{avail = ValueMap.insert(avail, e, x)})
fun expToVN (ENV{avail}, e) = ValueMap.find(avail, e)
(* rename a variable if it's value number is different than itself *)
fun rename x = let
val x' = getVN x
in
if IL.Var.same(x, x')
then x
else (
(*DEBUG**Log.msg(concat["** rename ", IL.Var.toString x, " to ", IL.Var.toString x', "\n"]);*)
decUse x; incUse x';
x')
end
(* does a variable change; i.e., get replaced by another variable? *)
fun changed x = not(IL.Var.same(x, getVN x))
(* clear the properties of a variable *)
fun clearVar x = (clrVN x; clrExp x)
(* clear the properties from the variables of a node *)
fun clearNode nd = List.app clearVar (IL.Node.defs nd)
end (* local *)
fun rewriteCFG cfg = let
(* in case the exit node get rewritten, we need to reset it *)
val exitNd = ref(IL.CFG.exit cfg)
(* rewrite or delete a node, if necessary. Note that we have already rewritten the JOIN nodes *)
fun doNode nd = (case IL.Node.kind nd
of IL.COND{pred, cond, trueBranch, falseBranch} =>
if changed cond
then let
val newNd = IL.Node.mkCOND {
cond = rename cond,
trueBranch = !trueBranch,
falseBranch = !falseBranch
}
in
IL.Node.replaceInEdge {src = !pred, oldDst = nd, dst = newNd};
IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !trueBranch};
IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !falseBranch}
end
else ()
| IL.ASSIGN{stm=(y, rhs), succ, ...} =>
if changed y
then (
(* deleting redundant assignment *)
IL.RHS.app decUse rhs;
IL.CFG.deleteNode nd)
else if (List.exists changed (IL.RHS.vars rhs))
(* rewrite node to rename variables *)
then IL.CFG.replaceNode(nd, IL.Node.mkASSIGN(y, IL.RHS.map rename rhs))
else ()
| IL.MASSIGN{stm=([], rator, xs), succ, ...} =>
if (List.exists changed xs)
(* rewrite node to rename variables *)
then IL.CFG.replaceNode(nd, IL.Node.mkMASSIGN([], rator, List.map rename xs))
else ()
| IL.MASSIGN{stm=(ys, rator, xs), succ, ...} =>
if List.all changed ys
then (
(* deleting redundant assignment *)
List.app decUse xs;
IL.CFG.deleteNode nd)
else if (List.exists changed xs)
(* rewrite node to rename variables *)
then IL.CFG.replaceNode(nd, IL.Node.mkMASSIGN(ys, rator, List.map rename xs))
else ()
| IL.NEW{strand, args, ...} =>
if List.exists changed args
then IL.CFG.replaceNode(nd, IL.Node.mkNEW{
strand=strand, args=List.map rename args
})
else ()
| IL.SAVE{lhs, rhs, ...} =>
if changed rhs
then IL.CFG.replaceNode(nd, IL.Node.mkSAVE(lhs, rename rhs))
else ()
| IL.EXIT{kind, live, ...} =>
if List.exists changed live
then let
val newNd = IL.Node.mkEXIT(kind, List.map rename live)
in
if IL.Node.same(nd, !exitNd)
then exitNd := newNd
else ();
IL.CFG.replaceNode (nd, newNd)
end
else ()
| _ => ()
(* end case *))
val _ = List.app doNode (IL.CFG.sort cfg)
val cfg = IL.CFG{entry = IL.CFG.entry cfg, exit = !exitNd}
in
IL.CFG.apply clearNode cfg;
cfg
end
fun transformCFG (liveIn, renameIn, cfg) =(* cfg HERE *)let
val tbl = E.new()
val mkSTATE = E.mkSTATE tbl
val mkVAR = E.mkVAR tbl
val mkLIT = E.mkLIT tbl
val mkOP = E.mkOP tbl
val mkMULTIOP = E.mkMULTIOP tbl
val mkAPPLY = E.mkAPPLY tbl
val mkCONS = E.mkCONS tbl
val mkPHI = E.mkPHI tbl
val mkEinOP = E.mkEinOP tbl
(* convert a list of variables to a list of expressions *)
fun varsToExp (env, xs) = (List.map varToExp xs)
(* convert an SSA RHS into a hash-consed expression *)
fun mkExp (env, rhs) = (case rhs
of IL.STATE x => mkSTATE x
| IL.VAR x => varToExp x
| IL.LIT l => mkLIT l
| IL.OP(rator, args) =>( mkOP(rator, varsToExp(env, args)))
| IL.APPLY(f, args) =>(mkAPPLY(f, varsToExp(env, args)))
| IL.CONS(ty, args) => ( mkCONS(ty, varsToExp(env, args)))
| IL.EINAPP(exp,args)=> ((*print "\n\n\n EINAPP \n";print(PE.printerE(exp));*)mkEinOP(exp, varsToExp(env,args)))
(* end case *))
(* walk the dominator tree computing value numbers *)
fun vn (env, nd) = let
val env = (case IL.Node.kind nd
of IL.JOIN{succ, phis, ...} => let
fun doPhi ((y, xs), (env, phis)) = let
val vn::vns = List.map getVN xs
in
if List.all (fn vn' => IL.Var.same(vn, vn')) vns
then ((* a meaningless phi node; map y to vn *)
(* DEBUG Log.msg(concat["** meaningless phi node: ", IL.phiToString (y, xs), "\n"]);*)
ST.tick cntMeaninglessPhi;
List.map decUse xs;
setVN(y, vn);
(env, phis))
else let
val exp = mkPHI(varsToExp(env, xs))
in
case expToVN(env, exp)
of SOME vn' => ((* a redundant phi node *)
(* DEBUG Log.msg(concat["** redundant phi node: ", IL.phiToString (y, xs), "\n"]);*)
ST.tick cntRedundantPhi;
List.map decUse xs;
setVN(y, vn');
(env, phis))
| NONE => let
val xs = List.map rename xs
in
(bindVarToExp(env, y, exp), (y, xs)::phis)
end
(* end case *)
end
end
val (env, remainingPhis) = List.foldl doPhi (env, []) (!phis)
in
phis := List.rev remainingPhis;
env
end
| IL.ASSIGN{stm=(y, rhs), succ, ...} => let
(*val tester=print(String.concat["\n\n START \n ",IL.Var.toString y])*)
val exp = mkExp(env, rhs)
(* val tester=print(String.concat["\n END \n\n "])*)
in
case expToVN(env, exp)
of SOME vn => ((* y is redundant, so map it to vn *)
(* DEBUG ** Log.msg(concat["** redundant assignment: ", IL.assignToString (y, rhs),*)
(* DEBUG **"; VN[", IL.Var.toString y, "] = ", IL.Var.toString vn, "\n"]);*)
ST.tick cntRedundantAssign;
setVN(y, vn);
env)
| NONE => bindVarToExp(env, y, exp)
(* end case *)
end
| IL.MASSIGN{stm=(ys, rator, xs), succ, ...} => let
val xs = varsToExp(env, xs)
fun mkExps (env, _, []) = env
| mkExps (env, i, y::ys) = let
val exp = mkMULTIOP(i, rator, xs)
in
case expToVN(env, exp)
of SOME vn => ((* y is redundant, so map it to vn *)
ST.tick cntRedundantAssign;
setVN(y, vn);
mkExps (env, i+1, ys))
| NONE => mkExps (bindVarToExp(env, y, exp), i+1, ys)
(* end case *)
end
in
mkExps (env, 0, ys)
end
| _ => env
(* end case *))
in
List.app (fn nd => vn (env, nd)) (D.children nd)
end
(* define the initial environment by mapping the liveIn variables to themselves *)
val env = List.foldl (fn (x, env) => bindVarToExp(env, x, mkVAR x)) emptyEnv liveIn
(* set the VN of the incoming renamed variables accordingly *)
val _ = List.app setVN renameIn
in
D.computeTree cfg;
(* compute value numbers over the dominance tree *)
vn (env, IL.CFG.entry cfg);
D.clear cfg;
(* delete and rewrite nodes as necessary *)
rewriteCFG cfg before
(List.app clearVar liveIn; List.app (clearVar o #1) renameIn)
end
(*here *)
fun transformCFG' (liveIn, renameIn, cfg) = let
val origLiveOut = IL.CFG.liveAtExit cfg
val cfg = transformCFG (liveIn, renameIn, cfg)
val liveOut = IL.CFG.liveAtExit cfg
(* compute a mapping from the original liveOut variables to their new names *)
val rename = let
fun findDups (x, x', rename) =
if IL.Var.same(x, x')
then rename
else IL.Var.Map.insert(rename, x, x')
in
ListPair.foldl findDups IL.Var.Map.empty (origLiveOut, liveOut)
end
(* filter out duplicate names from the liveOut list *)
val foundDup = ref false
val liveOut' = let
fun f (x, ys) = if List.exists (fn y => IL.Var.same(x, y)) ys
then (foundDup := true; ys)
else x::ys
in
List.foldr f [] liveOut
end
(* if there were any duplicates, then rewrite the exit node *)
val cfg = if !foundDup
then IL.CFG.updateExit(cfg, fn _ => liveOut')
else cfg
in
{cfg = cfg, rename = IL.Var.Map.foldli (fn (x, y, l) => (x, y)::l) renameIn rename}
end
fun transform prog = let
val IL.Program{props, globalInit, initially, strands} = prog
val {cfg=globalInit, rename} = transformCFG' ([], [], globalInit)
val globals = IL.CFG.liveAtExit globalInit
(* transform the strand initialization code *)
val initially = if List.null rename
then initially
else let
val IL.Initially{isArray, rangeInit, iters, create} = initially
(* first process the range initialization code *)
val {cfg=rangeInit, rename} = transformCFG' (globals, rename, rangeInit)
val live = IL.CFG.liveAtExit rangeInit @ globals
(* create a function for renaming variables *)
fun mkRenameFn rename = let
val vMap = List.foldl IL.Var.Map.insert' IL.Var.Map.empty rename
fun renameVar x = (case IL.Var.Map.find (vMap, x)
of NONE => x
| SOME x' => x'
(* end case *))
in
renameVar
end
(* rename the bounds of the iterators *)
val iters = let
val renameVar = mkRenameFn rename
in
List.map (fn (x, lo, hi) => (x, renameVar lo, renameVar hi)) iters
end
(* add the iteration variables to the live list *)
val live = List.foldl (fn ((x, _, _), lv) => x::lv) live iters
(* process the body *)
val (cfg, strand, args) = create
val {cfg, rename} = transformCFG' (live, rename, cfg)
val create = (cfg, strand, List.map (mkRenameFn rename) args)
in
IL.Initially{
isArray = isArray, rangeInit = rangeInit,
iters = iters, create= create
}
end
(* transform a strand *)
fun transformStrand (IL.Strand{name, params, state, stateInit, methods}) = let
val liveIn = params @ globals
val stateInit = transformCFG (liveIn, rename, stateInit)
(* FIXME: what if a state variable becomes redundant? *)
fun transformMeth (IL.Method{name, body}) = let
val body = transformCFG (liveIn, rename, body)
in
IL.Method{name=name, body=body}
end
in
IL.Strand{
name = name,
params = params,
state = state,
stateInit = stateInit,
methods = List.map transformMeth methods
}
end
val strands = List.map transformStrand strands
in
IL.Program{
props = props,
globalInit = globalInit,
initially = initially,
strands = strands
}
end
end