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

SCM Repository

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

View of /branches/pure-cfg/src/compiler/IL/value-numbering-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 740 - (download) (annotate)
Mon Apr 4 02:07:42 2011 UTC (10 years, 2 months ago) by jhr
File size: 4661 byte(s)
  Working on value-numbering optimization
(* 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 HC = HashCons

    datatype exp = E of {
	uid : word,		(* unique ID *)
	hash : word,		(* hash value *)
	term : exp_node
      }

    and exp_node
      = VAR of IL.var
      | LIT of Literal.literal
      | OP of Op.rator * exp list
      | APPLY of ILBasis.name * exp list
      | CONS of exp list

    fun hashArgs (args, base) =
	  List.foldl (fn (E{uid, ...}, h) => uid+h) base args

    fun hashNode (VAR x) = IL.Var.hash x
      | hashNode (LIT l) = Literal.hash l
      | hashNode (OP(rator, args)) = hashArgs (IL.Op.hash rator, args)
      | hashNode (APPLY(f, args)) = hashArgs (ILBasis.hash f, args)
      | hashNode (CONS args) = hashArgs (0w49, args)

    fun sameNode (VAR x, VAR y) = IL.Var.same(x, y)
      | sameNode (LIT l1, LIT l2) = Literal.same(l1, l2)
      | sameNode (OP(rator1, args1), OP(rator2, args2)) =
      | sameNode (APPLY(f1, args1), APPLY(f2, args2)) =
      | sameNode (CONS args1, CONS args2) =

    structure Tbl = HashTableFn (
      struct
	type hash_key = (word * exp_node)
	fun hashVal (h, _) = h
	fun sameKey ((_, e1), (_, e2)) = sameNode(e1, e2)
      end)

  (* hashConsExp : unit -> exp_node -> exp
   * returns the hash-consed representation of an expression.
   *)
    fun hashConsExp () = let
	  val uidCnt = ref 0w0
	  val tbl = Tbl.mkTable (1024, raise Fail "Value Table")
	  val find = Tbl.find tbl
	  val insert = Tbl.insert tbl
	  fun mk e = let
		val h = hashNode e
		val key = (h, e)
		in
		  case find key
		   of SOME exp => exp
		    | NONE => let
			val uid = !uidCnt
			val exp = E{uid=uid, hash=h, term=e}
			in
			  insert (key, exp);
			  exp
			end
		  (* end case *)
		end
	  in
	    mk
	  end

    local

      fun compareExp (E{uid=a, ...}, E{uid=b, ...}) = Word.compare(a, b)

      structure ValueSet = RedBlackSetFn (
	struct
	  type ord_key = exp
	  val compare = compareExp
	end)
      structure ValueMap = RedBlackMapFn (
	struct
	  type ord_key = exp
	  val compare = compareExp
	end)

    (* 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 : IL.var -> exp =getExp, setFn=setExp, clrFn=clrExp, ...} =
	    IL.Var.newProp (fn x => raise Fail "getExp")

      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
  (* map variables to their hash-consed definition *)
    fun varToExp x = getExp(getVN x)
    fun bindVarToExp (E{avail}, x, e) = (
	  setVN(x, x); setExp(x, e);
	  E{avail=ValueMap.insert(avail, e, x))
    fun expToVN (E{avail}, e) = ValueMap.find(avail, e)
    end (* local *)

    fun rewrite nd = (case IL.Node.kind nd
	  (* end case *))

    fun transform prog = let
	  val hashConsExp = hashConsExp()
	  fun varsToExp (env, xs) = List.map (fn x => varToExp(env, x)) xs
	(* convert an SSA RHS into a hash-consed expression *)
	  fun mkExp (env, rhs) = (case rhs
		 of IL.VAR x => varToExp(env, x)
		  | IL.LIT l => hashConsExp(LIT l)
		  | IL.OP(rator, args) => hashConsExp(OP(rator, varsToExp(env args)))
		  | IL.APPLY(f, args) => hashConsExp(APPLY(f, varsToExp(env args)))
		  | IL.CONS args => hashConsExp(CONS(varsToExp(env args)))
		(* end case *))
	  fun vn (env, nd) = let
		val env = (case IL.Node.kind nd
		       of IL.JOIN{succ, ...} =>
			| IL.ASSIGN{stm=(y, rhs), succ, ...} => let
			    val exp = mkExp(env, rhs)
			    in
			      case expToVN(env, exp)
			       of SOME x => (* y is redundant, so map it to x *)
				| NONE => bindVarToExp(env, y, exp)
			      (* end case *)
			    end
			| _ => env
		      (* end case *))
		in
		  List.app (fn nd => vn (env, nd)) (D.children nd)
		end
	(* value number a CFG *)
	  fun vnCFG (env, cfg) = (
		D.computeTree cfg;
		vn (env, IL.CFG.entryNode cfg);
		D.clear cfg)
	  in
	  end 

  end

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