[MLton-commit] r7377

[Matthew Fluet]

Fix performance bug in simplifyTypes.

A source program that has many (apparently) Transparent tycons, which
are replaced by deeply nested tuple types, could spend an inordinate
amount of time determining whether an (apparently) Transparent tycon
contains a use of its own type, presumably by repeatedly searching
through tuple component types.  Since the containsTycon function is a
pure function on the structure of SSA types (given the current state
of the tyconReplacement mapping), we replace the looping containsTycon
implementation with a memoizing implementation.
----------------------------------------------------------------------

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

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

Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog	2009-12-10 03:08:42 UTC (rev 7376)
+++ mlton/trunk/doc/changelog	2009-12-10 03:08:45 UTC (rev 7377)
@@ -62,6 +62,9 @@
     * Eliminated top-level 'type int = Int.int' in output.
     * Include (*#line line:col "file.grm" *) directives in output.
 
+* 2009-12-9
+  - Fixed performance bug in simplify types SSA optimization.
+
 * 2009-12-02
   - Fixed bug in amd64 codegen register allocation of indirect C calls.
 

Modified: mlton/trunk/mlton/ssa/simplify-types.fun
===================================================================
--- mlton/trunk/mlton/ssa/simplify-types.fun	2009-12-10 03:08:42 UTC (rev 7376)
+++ mlton/trunk/mlton/ssa/simplify-types.fun	2009-12-10 03:08:45 UTC (rev 7377)
@@ -409,19 +409,25 @@
       fun containsTycon (ty: Type.t, tyc: Tycon.t): bool =
          let
             datatype z = datatype Type.dest
-            fun loop t =
-               case Type.dest t of
-                  Array t => loop t
-                | Datatype tyc' =>
-                     (case tyconReplacement tyc' of
-                         NONE => Tycon.equals (tyc, tyc')
-                       | SOME t => loop t)
-                | Tuple ts => Vector.exists (ts, loop)
-                | Ref t => loop t
-                | Vector t => loop t
-                | Weak t => loop t
-                | _ => false
-         in loop ty
+            val {get = containsTycon, destroy = destroyContainsTycon} =
+               Property.destGet
+               (Type.plist,
+                Property.initRec
+                (fn (t, containsTycon) =>
+                 case Type.dest t of
+                    Array t => containsTycon t
+                  | Datatype tyc' =>
+                       (case tyconReplacement tyc' of
+                           NONE => Tycon.equals (tyc, tyc')
+                         | SOME t => containsTycon t)
+                  | Tuple ts => Vector.exists (ts, containsTycon)
+                  | Ref t => containsTycon t
+                  | Vector t => containsTycon t
+                  | Weak t => containsTycon t
+                  | _ => false))
+            val res = containsTycon ty
+            val () = destroyContainsTycon ()
+         in res
          end
       (* Keep the circular transparent tycons, ditch the rest. *)
       val datatypes =