[MLton-commit] r7378

[Matthew Fluet]

Fix another (latent) performance bug in simplifyTypes.

Although not observed in practice, this is another case where a
structural walk over the entire type may repeatedly visit the same
tuple node with no additional effect.  As before, replace the looping
implementation with a memoizing implementation (which visits each type
exactly once).  It is possible to observe the performance bug by
performing a second simplifyTypes optimization pass immediately after
the first, with the source program that demonstrated the performance
bug fixed in r7377.
----------------------------------------------------------------------

U   mlton/trunk/mlton/ssa/simplify-types.fun

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

Modified: mlton/trunk/mlton/ssa/simplify-types.fun
===================================================================
--- mlton/trunk/mlton/ssa/simplify-types.fun	2009-12-10 03:08:45 UTC (rev 7377)
+++ mlton/trunk/mlton/ssa/simplify-types.fun	2009-12-11 14:15:54 UTC (rev 7378)
@@ -214,45 +214,34 @@
           end)
       (* Build the dependents for each tycon. *)
       val _ =
-         let
-            val _ =
-               Vector.foreach
-               (datatypes, fn Datatype.T {tycon, cons} =>
-                let
-                   val {get = isDependent, set = setDependent, destroy} =
-                      Property.destGetSet (Tycon.plist, Property.initConst false)
-                   fun setTypeDependents t =
-                      let
-                         datatype z = datatype Type.dest
-                      in
-                         case Type.dest t of
-                            Array t => setTypeDependents t
-                          | CPointer => ()
-                          | Datatype tycon' =>
-                               if isDependent tycon'
-                                  then ()
-                               else (setDependent (tycon', true)
-                                     ; List.push (#dependents
-                                                  (tyconInfo tycon'),
-                                                  tycon))
-                          | IntInf => ()
-                          | Real _ => ()
-                          | Ref t => setTypeDependents t
-                          | Thread => ()
-                          | Tuple ts => Vector.foreach (ts, setTypeDependents)
-                          | Vector t => setTypeDependents t
-                          | Weak t => setTypeDependents t
-                          | Word _ => ()
-                      end
-                   val _ =
-                      Vector.foreach (cons, fn {args, ...} =>
-                                      Vector.foreach (args, setTypeDependents))
-                   val _ = destroy ()
-                in ()
-                end)
-         in ()
-         end
-
+         Vector.foreach
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          let
+             datatype z = datatype Type.dest
+             val {get = setTypeDependents, destroy = destroyTypeDependents} =
+                Property.destGet
+                (Type.plist,
+                 Property.initRec
+                 (fn (t, setTypeDependents) =>
+                  case Type.dest t of
+                     Array t => setTypeDependents t
+                   | CPointer => ()
+                   | Datatype tycon' =>
+                        List.push (#dependents (tyconInfo tycon'), tycon)
+                   | IntInf => ()
+                   | Real _ => ()
+                   | Ref t => setTypeDependents t
+                   | Thread => ()
+                   | Tuple ts => Vector.foreach (ts, setTypeDependents)
+                   | Vector t => setTypeDependents t
+                   | Weak t => setTypeDependents t
+                   | Word _ => ()))
+             val _ =
+                Vector.foreach (cons, fn {args, ...} =>
+                                Vector.foreach (args, setTypeDependents))
+             val _ = destroyTypeDependents ()
+          in ()
+          end)
       (* diagnostic *)
       val _ =
          Control.diagnostics