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

SCM Repository

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

View of /trunk/src/compiler/high-il/high-opt.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1116 - (download) (annotate)
Thu May 5 04:49:02 2011 UTC (8 years, 5 months ago) by jhr
File size: 7154 byte(s)
  more merging of pure-cfg changes back into trunk
(* 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 cntProbeAdd		= ST.newCounter "high-opt:probe-add"
    val cntProbeSub		= ST.newCounter "high-opt:probe-sub"
    val cntProbeScale		= ST.newCounter "high-opt:probe-scale"
    val cntProbeNeg		= ST.newCounter "high-opt:probe-neg"
    val cntDiffField		= ST.newCounter "high-opt:diff-field"
    val cntDiffAdd		= ST.newCounter "high-opt:diff-add"
    val cntDiffScale		= ST.newCounter "high-opt:diff-scale"
    val cntDiffNeg		= ST.newCounter "high-opt:diff-neg"
    val cntUnused		= ST.newCounter "high-opt:unused"
    val firstCounter            = cntProbeAdd
    val lastCounter             = cntUnused

    structure UnusedElim = UnusedElimFn (
	structure IL = IL
	val cntUnused = cntUnused)

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

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

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

  (* optimize the rhs of an assignment, returning NONE if there is no change *)
    fun doRHS (lhs, IL.OP rhs) = (case rhs
	   of (Op.Probe(domTy, rngTy), [f, pos]) => (case getRHS f
		 of SOME(Op.Field _, _) => NONE (* direct probe does not need rewrite *)
		  | SOME(Op.AddField, [f', g']) => let
		    (* rewrite to (f@pos) + (g@pos) *)
		      val lhs1 = IL.Var.copy lhs
		      val lhs2 = IL.Var.copy lhs
		      in
			ST.tick cntProbeAdd;
			decUse f;
			incUse lhs1; incUse f'; incUse lhs2; incUse g'; incUse pos;
			SOME[
			    (lhs1, IL.OP(Op.Probe(domTy, rngTy), [f', pos])),
			    (lhs2, IL.OP(Op.Probe(domTy, rngTy), [g', pos])),
			    (lhs, IL.OP(Op.Add rngTy, [lhs1, lhs2]))
			  ]
		      end
		  | SOME(Op.SubField, [f', g']) => let
		    (* rewrite to (f@pos) - (g@pos) *)
		      val lhs1 = IL.Var.copy lhs
		      val lhs2 = IL.Var.copy lhs
		      in
			ST.tick cntProbeSub;
			decUse f;
			incUse lhs1; incUse f'; incUse lhs2; incUse g'; incUse pos;
			SOME[
			    (lhs1, IL.OP(Op.Probe(domTy, rngTy), [f', pos])),
			    (lhs2, IL.OP(Op.Probe(domTy, rngTy), [g', pos])),
			    (lhs, IL.OP(Op.Sub rngTy, [lhs1, lhs2]))
			  ]
		      end
		  | SOME(Op.ScaleField, [s, f']) => let
		    (* rewrite to s*(f'@pos) *)
		      val lhs' = IL.Var.copy lhs
		      in
			ST.tick cntProbeScale;
			decUse f;
			incUse lhs'; incUse f'; incUse s;
			SOME[
			    (lhs', IL.OP(Op.Probe(domTy, rngTy), [f', pos])),
			    (lhs, IL.OP(Op.Scale rngTy, [s, lhs']))
			  ]
		      end
		  | SOME(Op.NegField, [f']) => let
		    (* rewrite to -(f'@pos) *)
		      val lhs' = IL.Var.copy lhs
		      in
			ST.tick cntProbeNeg;
			decUse f;
			incUse lhs'; incUse f';
			SOME[
			    (lhs', IL.OP(Op.Probe(domTy, rngTy), [f', pos])),
			    (lhs, IL.OP(Op.Neg rngTy, [lhs']))
			  ]
		      end
		  | _ => raise Fail(concat[
			"bogus field binding ", V.toString f, " = ", IL.vbToString(V.binding f)
		      ])
		(* end case *))
	    | (Op.DiffField, [f]) => (case (getRHS f)
		 of SOME(Op.Field dim, [v, h]) => (case getRHS h
		       of SOME(Op.Kernel(kernel, k), []) => let
			    val h' = IL.Var.copy h
			    in
			      ST.tick cntDiffField;
			      decUse f;
			      incUse h'; incUse v;
			      SOME[
				  (h', IL.OP(Op.Kernel(kernel, k+1), [])),
				  (lhs, IL.OP(Op.Field dim, [v, h']))
				]
			    end
			| _ => raise Fail(concat[
			      "bogus kernel binding ", V.toString h, " = ", IL.vbToString(V.binding h)
			    ])
		      (* end case *))
		  | SOME(Op.AddField, [f, g]) => raise Fail "Diff(f+g)"
		  | SOME(Op.SubField, [f, g]) => raise Fail "Diff(f-g)"
		  | SOME(Op.ScaleField, [s, f']) => let
		    (* rewrite to s*(D f) *)
		      val lhs' = IL.Var.copy lhs
		      in
			ST.tick cntDiffScale;
			decUse f;
			incUse lhs'; incUse f'; incUse s;
			SOME[
			    (lhs', IL.OP(Op.DiffField, [f'])),
			    (lhs, IL.OP(Op.ScaleField, [s, lhs']))
			  ]
		      end
		  | SOME(Op.NegField, [f']) => let
		    (* rewrite to -(D f') *)
		      val lhs' = IL.Var.copy lhs
		      in
			ST.tick cntDiffNeg;
			decUse f;
			incUse lhs'; incUse f';
			SOME[
			    (lhs', IL.OP(Op.DiffField, [f'])),
			    (lhs, IL.OP(Op.NegField, [lhs']))
			  ]
		      end
		  | _ => NONE
		(* end case *))
	    | _ => NONE
	  (* end case *))
      | doRHS _ = NONE

  (* simplify expressions *)
    fun simplify (nd as IL.ND{kind=IL.ASSIGN{stm=(y, rhs), ...}, ...}) =
	  if (useCount y = 0)
	    then () (* skip unused assignments *)
	    else (case doRHS(y, rhs)
	       of SOME[] => IL.CFG.deleteNode nd
		| SOME assigns => (
		    List.app (fn (y, rhs) => V.setBinding(y, IL.VB_RHS rhs)) assigns;
		    IL.CFG.replaceNodeWithCFG (nd, IL.CFG.mkBlock assigns))
		| NONE => ()
	      (* end case *))
      | simplify _ = ()

  (* 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.APPLY(_, 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 = let
	  fun loop n = let
		val () = f ()
		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{globalInit, initially, strands}) = let
	  fun doCFG cfg = (
		loopToFixPt (fn () => IL.CFG.apply simplify cfg);
		loopToFixPt (fn () => ignore(UnusedElim.reduce cfg)))
	  fun doMethod (IL.Method{body, ...}) = doCFG body
	  fun doStrand (IL.Strand{stateInit, methods, ...}) = (
		doCFG stateInit;
		List.app doMethod methods)
	  fun optPass () = (
		doCFG globalInit;
		List.app doStrand strands)
	  in
	    loopToFixPt optPass;
(* FIXME: after optimization, we should filter out any globals that are now unused *)
	    IL.Program{
		globalInit = globalInit,
		initially = initially,	(* FIXME: we should optimize this code *)
		strands = strands
	      }
	  end

  end

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