Optimization pass: eliminate-replace

[Wesley W. Terpstra]

I am considering an optimization pass to run after refFlatten that turns:
  val y = !x
  val () = x := y
into a noop.

I think the best way to do this is run a DFS and tag refs with a serial number. A deref (!) records the serial number on the assigned variable and any reassignments of that variable. Finally, if a reference is written to (:=), check the variable to see if it is a load of this variable with identical serial number, if so, remove the assignment. If not, increase the serial number.

That way in
  val y = !x
  val () = x := !x + 1
  val z = !x
  val a = !x
  val () = x := z
  val () = x := a
  val () = x := y
the 2nd and 3rd assignments get eliminated, but not 1st and 4th.

This optimization is specifically a follow-up optimization to DeepFlatten. If DeepFlatten turned a ref tuple into a record, chances are that a lot of the fields are unmodified when it gets rewritten. In my particular application only 1-3 fields out of 21 or more get changed, so this would be a good speed-up for me at least.

Any comments?


_______________________________________________
MLton mailing list
MLton@...
http://mlton.org/mailman/listinfo/mlton

[Wesley W. Terpstra]

On Fri, Sep 25, 2009 at 10:26 PM, Wesley W. Terpstra <wesley@...> wrote:

I am considering an optimization pass to run after refFlatten that turns:
  val y = !x
  val () = x := y
into a noop.

So, attached is my first attempt. For my programs it seems to work and I get a 5% boost in network throughput, less than I'd hoped.

Unfortunately, I suspect that MLton.Signal.Handler.handler and MLton.Finalizable.addFinalizer will break my assumption that nothing can happen between the load and store. Since I implemented this as an SSA2 pass, it comes before limit-check and signal-check. As I understand it, these will insert checks that can cause side-effects at function entries and loop headers.

Function entries should be ok since I consider every Call to have side effects. Loop headers present a problem, however. I believe loop *footers* would not present a problem because those can't get between the def and use of an SSA2 variable.

To resolve this last problem I think my options are to either move it to a late RSSA pass or adjust the limit/signal check methods to create footers instead of headers (this seems preferable since it also simplifies potential future side-effect affected optimization passes). Am I on the right track?

[duplicate-store.patch]

---

Index: mlton/ssa/duplicate-store.fun
===================================================================
--- mlton/ssa/duplicate-store.fun (revision 0)
+++ mlton/ssa/duplicate-store.fun (revision 0)
@@ -0,0 +1,163 @@
+(* Copyright (C) 2009 Wesley W. Terpstra.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+functor DuplicateStore (S: DUPLICATE_STORE_STRUCTS): DUPLICATE_STORE =
+struct
+
+open S
+
+(* This pass looks for expressions which reassign a ref cell with itself.
+ * Expressions like, 'x := !x' can result from DeepFlatten or inlining.
+ * Obviously, we have to be very careful, especially due to aliasing.
+ *
+ * The rule is that 'x := y' can be eliminated if 'y = !x' and there are
+ * no (useful) intervening assignments to the type of x or side effects.
+ * This guarantees that the value of 'x' cannot have changed.
+ * Side effects can come from Calls or PrimApps.
+ *
+ * To track potential changes, we associate to every type a serial# array.
+ * Each element in the array corresponds to an element in the mutable tuple.
+ * Whenever an element is assigned, the relevant serial# is increased.
+ * Whenever a tuple is dereferenced, we record the serial# it loaded.
+ * Stores of the same serial# to the same memory location are then eliminated.
+ *)
+
+datatype z = datatype Statement.t
+datatype z = datatype Exp.t
+
+fun makeSerials typ =
+   case Type.dest typ of
+      Type.Object { args, con=_ } => Array.new (Prod.length args, 0)
+    | _ => Array.new (1, 0)
+
+val { get=serials : Type.t -> int array, ... } =
+   Property.get (Type.plist, Property.initFun makeSerials)
+
+val { get=typ : Var.t -> Type.t, set=setTyp, ... } =
+   Property.getSetOnce (Var.plist, Property.initRaise ("varTypInfo", Var.layout))
+
+type tupleInfo = { base:Var.t Base.t, offset:int, call:int, serial:int }
+val { get=synonyms : Var.t -> tupleInfo list, set=setSynonyms, ... } =
+   Property.getSet (Var.plist, Property.initConst [])
+
+fun baseTy base =
+   case base of
+      Base.Object var => typ var
+    | Base.VectorSub {index=_, vector} => typ vector
+
+val baseEquals = fn
+   (Base.Object a, Base.Object b) => Var.equals (a, b)
+ | (Base.VectorSub {index=ai, vector=av},
+    Base.VectorSub {index=bi, vector=bv}) => Var.equals (ai, bi) andalso
+                                             Var.equals (av, bv)
+ | _ => false
+
+val call' = ref 0
+
+fun keepUpdate statement =
+   case statement of
+      Bind {exp=Select {base, offset}, ty=_, var} =>
+         let
+            val tupleTy = baseTy base
+            val serials = serials tupleTy
+            val serial = Array.sub (serials, offset)
+            val tuple = {base=base, offset=offset, serial=serial, call= !call'}
+            val () = Option.app (var, fn v => setSynonyms (v, [tuple]))
+         in
+            true
+         end
+    | Bind {exp=PrimApp {args=_, prim}, ... } =>
+         if Prim.maySideEffect prim then (call' := !call' + 1; true) else true
+    | Update {base=base', offset=offset', value} =>
+         let
+            val tupleTy' = baseTy base'
+            val serials' = serials tupleTy'
+            val serial' = Array.sub (serials', offset')
+            
+            (* An assignment is useless if the value matches the contents *)
+            fun equal {base, offset, serial, call} =
+               baseEquals (base', base) andalso
+               offset' = offset andalso
+               serial' = serial andalso
+               !call' = call
+            
+            val synonyms = synonyms value
+            val tuple = {base=base', offset=offset', serial=serial'+1,call= !call'}
+            fun newName () = setSynonyms (value, tuple :: synonyms)
+            fun inc () = Array.update (serials', offset', serial'+1)
+         in
+            if List.exists (synonyms, equal) then false else
+            (inc (); newName (); true)
+         end
+    | _ => true
+
+fun reverseSerial statement =
+   case statement of
+      Bind {exp=PrimApp {args=_, prim}, ... } =>
+         if Prim.maySideEffect prim then call' := !call' - 1 else ()
+    | Update {base, offset, value=_} =>
+         let
+            val tupleTy = baseTy base
+            val serials = serials tupleTy
+            val serial = Array.sub (serials, offset)
+         in
+            Array.update (serials, offset, serial-1)
+         end
+    | _ => ()
+
+fun transformFunction (f: Function.t): Function.t =
+   let
+      val {args, blocks=_, mayInline, name, raises, returns, start } =
+         Function.dest f
+      
+      val blocks = ref []
+      fun markBlock block =
+         let
+            val Block.T {args, label, statements, transfer} = block
+            val statements = Vector.keepAll (statements, keepUpdate)
+            val block =
+               Block.T {args = args,
+                        label = label,
+                        statements = statements,
+                        transfer = transfer}
+            val () = List.push (blocks, block)
+            val sideEffects =
+               case transfer of
+                  Transfer.Call _ => true | _ => false
+            val () = if sideEffects then call' := !call' + 1 else ()
+         in
+            (* Decrement the serial# to stay correct for other branches *)
+            fn () => (if sideEffects then call' := !call' - 1 else ()
+                      ; Vector.foreachr (statements, reverseSerial))
+         end
+      
+      val () = Function.dfs (f, markBlock)
+   in
+      Function.new {args = args,
+                    blocks = Vector.fromList (!blocks),
+                    mayInline = mayInline,
+                    name = name,
+                    raises = raises,
+                    returns = returns,
+                    start = start}
+   end
+
+fun duplicateStore program =
+   let
+      val Program.T { datatypes, functions, globals, main } = program
+      val () = Program.foreachVar (program, setTyp)
+      val functions = List.revMap (functions, transformFunction)
+      val program =
+         Program.T {datatypes = datatypes,
+                    functions = functions,
+                    globals = globals,
+                    main = main}
+      val () = Program.clear program
+   in
+      shrink program
+   end
+
+end
Index: mlton/ssa/simplify2.fun
===================================================================
--- mlton/ssa/simplify2.fun (revision 7233)
+++ mlton/ssa/simplify2.fun (working copy)
@@ -17,6 +17,7 @@
 (* structure ConstantPropagation = ConstantPropagation (S) *)
 (* structure Contify = Contify (S) *)
 structure DeepFlatten = DeepFlatten (S)
+structure DuplicateStore = DuplicateStore(S)
 (* structure Flatten = Flatten (S) *)
 (* structure Inline = Inline (S) *)
 (* structure IntroduceLoops = IntroduceLoops (S) *)
@@ -39,6 +40,7 @@
 
 val ssa2PassesDefault =
    {name = "deepFlatten", doit = DeepFlatten.flatten} ::
+   {name = "duplicateStore", doit = DuplicateStore.duplicateStore} ::
    {name = "refFlatten", doit = RefFlatten.flatten} ::
    {name = "removeUnused5", doit = RemoveUnused2.remove} ::
    {name = "zone", doit = Zone.zone} ::
@@ -67,6 +69,7 @@
                 ("deepFlatten", DeepFlatten.flatten),
                 ("dropProfile", Profile2.dropProfile),
                 ("refFlatten", RefFlatten.flatten),
+                ("duplicateStore", DuplicateStore.duplicateStore),
                 ("removeUnused", RemoveUnused2.remove),
                 ("zone", Zone.zone),
                 ("eliminateDeadBlocks",S.eliminateDeadBlocks),
Index: mlton/ssa/sources.cm
===================================================================
--- mlton/ssa/sources.cm (revision 7233)
+++ mlton/ssa/sources.cm (working copy)
@@ -75,6 +75,8 @@
 contify.fun
 deep-flatten.sig
 deep-flatten.fun
+duplicate-store.sig
+duplicate-store.fun
 flatten.sig
 flatten.fun
 inline.sig
Index: mlton/ssa/sources.mlb
===================================================================
--- mlton/ssa/sources.mlb (revision 7233)
+++ mlton/ssa/sources.mlb (working copy)
@@ -62,6 +62,8 @@
    contify.fun
    deep-flatten.sig
    deep-flatten.fun
+   duplicate-store.sig
+   duplicate-store.fun
    flatten.sig
    flatten.fun
    inline.sig
Index: mlton/ssa/duplicate-store.sig
===================================================================
--- mlton/ssa/duplicate-store.sig (revision 0)
+++ mlton/ssa/duplicate-store.sig (revision 0)
@@ -0,0 +1,17 @@
+(* Copyright (C) 2009 Wesley W. Terpstra.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+signature DUPLICATE_STORE_STRUCTS =
+   sig
+      include SHRINK2
+   end
+
+signature DUPLICATE_STORE =
+   sig
+      include DUPLICATE_STORE_STRUCTS
+
+      val duplicateStore: Program.t -> Program.t
+   end

---

_______________________________________________
MLton mailing list
MLton@...
http://mlton.org/mailman/listinfo/mlton