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

SCM Repository

[diderot] View of /trunk/src/compiler/IL/value-numbering-fn.sml
ViewVC logotype

View of /trunk/src/compiler/IL/value-numbering-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2356 - (download) (annotate)
Sun Apr 7 14:45:25 2013 UTC (6 years, 6 months ago) by jhr
File size: 17100 byte(s)
  Merging in bug fixes and language enhancements from the vis12 branch (via staging).
  Features include type promotion, the curl and colon operator, transpose, and functions.
(* 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

    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 = getExp(getVN x)
    fun bindVarToExp (ENV{avail}, x, e) = (
(*DEBUG**Log.msg(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) = 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
        (* 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))
                (* 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 exp = mkExp(env, rhs)
                            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

    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

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