[MLton-commit] r7379

[Matthew Fluet]

Fix performance bug in refFlatten.

In computing the set of (mutually) recursive datatypes, a dependency
graph is constructed with nodes corresponding to tycons and edges
corresponding to use of (another) tycon in the constructors of a
tycon.  Similar to r7377 and r7378, this is a case where a structural
walk over an entire type may repeatedly visit the same object node
with no additional effect.  As before, replace the looping
implementation with a memoizing implementation (which visits each type
exactly once).
----------------------------------------------------------------------

U   mlton/trunk/doc/changelog
U   mlton/trunk/mlton/ssa/ref-flatten.fun

----------------------------------------------------------------------

Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog	2009-12-11 14:15:54 UTC (rev 7378)
+++ mlton/trunk/doc/changelog	2009-12-11 19:51:35 UTC (rev 7379)
@@ -62,7 +62,10 @@
     * Eliminated top-level 'type int = Int.int' in output.
     * Include (*#line line:col "file.grm" *) directives in output.
 
-* 2009-12-9
+* 2009-12-11
+  - Fixed performance bug in ref flatten SSA2 optimization.
+
+* 2009-12-09
   - Fixed performance bug in simplify types SSA optimization.
 
 * 2009-12-02

Modified: mlton/trunk/mlton/ssa/ref-flatten.fun
===================================================================
--- mlton/trunk/mlton/ssa/ref-flatten.fun	2009-12-11 14:15:54 UTC (rev 7378)
+++ mlton/trunk/mlton/ssa/ref-flatten.fun	2009-12-11 19:51:35 UTC (rev 7379)
@@ -766,35 +766,22 @@
          (datatypes, fn Datatype.T {cons, tycon} =>
           let
              val n = tyconNode tycon
-             fun dependsOn (t: Type.t): unit = 
-                let 
-                   datatype z = datatype Type.dest
-                   fun loop t =
-                      case Type.dest t of
-                         CPointer => ()
-                       | Datatype tc => 
-                            let
-                               val m = tyconNode tc
-                               val e = {from = n, to = m}
-                            in
-                               (* Avoid redundant edges. *)
-                               if Node.hasEdge e then ()
-                               else 
-                                  (ignore o Graph.addEdge)
-                                  (graph, {from = n, to = tyconNode tc})
-                            end
-                       | IntInf => ()
-                       | Object {args, ...} =>
-                            Prod.foreach (args, loop)
-                       | Real _ => ()
-                       | Thread => ()
-                       | Weak _ => ()
-                       | Word _ => ()
-                in 
-                   loop t
-                end
+             datatype z = datatype Type.dest
+             val {get = dependsOn, destroy = destroyDependsOn} =
+                Property.destGet
+                (Type.plist,
+                 Property.initRec
+                 (fn (t, dependsOn) =>
+                  case Type.dest t of
+                     Datatype tc =>
+                        (ignore o Graph.addEdge)
+                        (graph, {from = n, to = tyconNode tc})
+                   | Object {args, ...} =>
+                        Prod.foreach (args, dependsOn)
+                   | _ => ()))
              val () = Vector.foreach (cons, fn {args, ...} =>
                                       Prod.foreach (args, dependsOn))
+             val () = destroyDependsOn ()
           in
              ()
           end)