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

SCM Repository

[diderot] View of /branches/pure-cfg/src/compiler/high-il/high-opt.sml
ViewVC logotype

View of /branches/pure-cfg/src/compiler/high-il/high-opt.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 508 - (download) (annotate)
Sun Feb 6 18:55:04 2011 UTC (8 years, 8 months ago) by jhr
File size: 4377 byte(s)
  Debugging new IL
(* high-opt.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Optimization of the HighIL representation of Diderot terms.  The main
 * task of this phase is to statically resolve field definitions.
 *)

structure HighOptimizer : sig

    val optimize : HighIL.program -> HighIL.program

  end = struct

    structure IL = HighIL
    structure Op = HighOps
    structure V = IL.Var
    structure ST = Stats
    structure F = FieldDef

  (********** Counters for statistics **********)
    val cntConstConvolve	= ST.newCounter "high-opt:const-convolve"
    val cntConstField		= ST.newCounter "high-opt:const-field"
    val cntConstDiff		= ST.newCounter "high-opt:const-diff"
    val cntUnused		= ST.newCounter "high-opt:unused"
    val firstCounter            = cntConstConvolve
    val lastCounter             = cntUnused

    fun useCount (IL.V{useCnt, ...}) = !useCnt

  (* decrement a variable's use count *)
    fun decUse (IL.V{useCnt, ...}) = (useCnt := !useCnt - 1)

    fun getRHS x = (case V.binding x
	   of IL.VB_RHS(IL.OP arg) => SOME arg
	    | _ => NONE
	  (* end case *))

  (* optimize the rhs of an assignment, returning NONE if there is no change *)
    fun doRHS rhs = (case rhs
	   of IL.OP(Op.Convolve, [v, h]) => (case (getRHS v, getRHS h)
		 of (SOME(Op.LoadImage v', []), SOME(Op.Kernel h', [])) => (
		      ST.tick cntConstConvolve;
		      decUse v; decUse h;
		      SOME(IL.OP(Op.Field(F.convolve(v', h')), [])))
		  | _ => raise Fail "non-constant Convolve"
		(* end case *))
	    | IL.OP(Op.AddField, [f, g]) => (case (getRHS f, getRHS g)
		 of (SOME(Op.Field f', []), SOME(Op.Field g', [])) => (
		      ST.tick cntConstField;
		      decUse f; decUse g;
		      SOME(IL.OP(Op.Field(F.SUM(f', g')), [])))
		  | _ => NONE
		(* end case *))
	    | IL.OP(Op.NegField, [f]) => (case (getRHS f)
		 of SOME(Op.Field f', []) => (
		      ST.tick cntConstField;
		      decUse f;
		      SOME(IL.OP(Op.Field(F.neg f'), [])))
		  | _ => NONE
		(* end case *))
	    | IL.OP(Op.DiffField, [f]) => (case (getRHS f)
		 of SOME(Op.Field f', []) => (
		      ST.tick cntConstDiff;
		      decUse f;
		      SOME(IL.OP(Op.Field(F.diff f'), [])))
		  | _ => raise Fail "non-constant DiffField"
		(* end case *))
	    | _ => NONE
	  (* end case *))

  (* simplify expressions *)
    local
      fun doAssign (y, rhs) = (case doRHS rhs
	     of SOME rhs' => (V.setBinding(y, IL.VB_RHS rhs'); (y, rhs'))
	      | NONE => (y, rhs)
	    (* end case *))
    in
    fun simplify (nd as IL.ND{kind=IL.ASSIGN{stm=(y, rhs), ...}, ...}) = (case doRHS rhs
	   of SOME rhs' => (
		V.setBinding(y, IL.VB_RHS rhs');
		IL.CFG.replaceNode (nd, IL.Node.mkASSIGN(y, rhs')))
	    | NONE => ()
	  (* end case *))
      | simplify _ = ()
    end (* local *)

  (* reduce the code by removing variables with use counts of 0 *)
    local
      fun checkVar (y, _) = (useCount y > 0) orelse (ST.tick cntUnused; false)
    in
    fun reduce (nd as IL.ND{kind, ...}) = (case kind
	   of IL.JOIN{phis, ...} => let
		fun doVar (y, xs) = if (useCount y = 0)
		      then (
			ST.tick cntUnused;
			List.app decUse xs;
			false)
		      else true
		in
		  phis := List.filter doVar (!phis)
		end
	    | IL.ASSIGN{stm=(y, rhs), ...} =>
		if (useCount y = 0)
		  then (
		    ST.tick cntUnused;
		    case rhs
		     of IL.VAR x => decUse x
		      | IL.LIT _ => ()
		      | IL.OP(_, xs) => List.app decUse xs
		      | IL.CONS xs => List.app decUse xs
		    (* end case *);
		    IL.CFG.deleteNode nd)
		  else ()
	    | _ => ()
	  (* end case *))
    end (* local *)

    fun loopToFixPt f cfg = let
	  fun loop n = let
		val () = IL.CFG.apply f cfg
		val n' = Stats.sum{from=firstCounter, to=lastCounter}
		in
		  if (n = n') then () else loop n'
		end
	  in
	    loop (Stats.sum{from=firstCounter, to=lastCounter})
	  end

    fun optimize (prog as IL.Program{globals, globalInit, strands}) = let
	  fun doCFG cfg = (
		loopToFixPt simplify cfg;
		loopToFixPt reduce cfg)
	  val globInitNodes = doCFG globalInit
	  fun doMethod (IL.Method{body, ...}) = doCFG body
	  fun doStrand (IL.Strand{stateInit, methods, ...}) = (
		doCFG stateInit;
		List.app doMethod methods)
	  val _ = List.app doStrand strands
	  in
	    IL.Program{
		globals = globals,
		globalInit = globalInit,
		strands = strands
	      }
	  end

  end

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