[MLton-commit] r7380

Matthew Fluet fluet at mlton.org
Fri Dec 11 11:51:42 PST 2009


Mark (mutually) recursive tycons as large before computing fixpoint.

This avoids building up potentially long chains of Size.<= constraints
that are later all forced to top by a (mutually) recursive tycon being
marked as large.
----------------------------------------------------------------------

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

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

Modified: mlton/trunk/mlton/ssa/ref-flatten.fun
===================================================================
--- mlton/trunk/mlton/ssa/ref-flatten.fun	2009-12-11 19:51:35 UTC (rev 7379)
+++ mlton/trunk/mlton/ssa/ref-flatten.fun	2009-12-11 19:51:40 UTC (rev 7380)
@@ -705,42 +705,6 @@
        *)
       val {get = tyconSize: Tycon.t -> Size.t, ...} =
          Property.get (Tycon.plist, Property.initFun (fn _ => Size.new ()))
-      val {get = typeSize: Type.t -> Size.t, ...} =
-         Property.get (Type.plist,
-                       Property.initRec
-                       (fn (t, typeSize) =>
-                        let
-                           val s = Size.new ()
-                           fun dependsOn (t: Type.t): unit =
-                              Size.<= (typeSize t, s)
-                           datatype z = datatype Type.dest
-                           val () =
-                              case Type.dest t of
-                                 CPointer => ()
-                               | Datatype tc => Size.<= (tyconSize tc, s)
-                               | IntInf => Size.makeTop s
-                               | Object {args, con, ...} =>
-                                    if ObjectCon.isVector con
-                                       then Size.makeTop s
-                                    else Prod.foreach (args, dependsOn)
-                               | Real _ => ()
-                               | Thread => Size.makeTop s
-                               | Weak _ => ()
-                               | Word _ => ()
-                        in
-                           s
-                        end))
-      val () =
-         Vector.foreach
-         (datatypes, fn Datatype.T {cons, tycon} =>
-          let
-             val s = tyconSize tycon
-             fun dependsOn (t: Type.t): unit = Size.<= (typeSize t, s)
-             val () = Vector.foreach (cons, fn {args, ...} =>
-                                      Prod.foreach (args, dependsOn))
-          in
-             ()
-          end)
       (* Force (mutually) recursive datatypes to top. *)
       val {get = nodeTycon: unit Node.t -> Tycon.t, 
            set = setNodeTycon, ...} =
@@ -800,6 +764,42 @@
                        else ()
               | _ => doit ()
           end)
+      val {get = typeSize: Type.t -> Size.t, ...} =
+         Property.get (Type.plist,
+                       Property.initRec
+                       (fn (t, typeSize) =>
+                        let
+                           val s = Size.new ()
+                           fun dependsOn (t: Type.t): unit =
+                              Size.<= (typeSize t, s)
+                           datatype z = datatype Type.dest
+                           val () =
+                              case Type.dest t of
+                                 CPointer => ()
+                               | Datatype tc => Size.<= (tyconSize tc, s)
+                               | IntInf => Size.makeTop s
+                               | Object {args, con, ...} =>
+                                    if ObjectCon.isVector con
+                                       then Size.makeTop s
+                                    else Prod.foreach (args, dependsOn)
+                               | Real _ => ()
+                               | Thread => Size.makeTop s
+                               | Weak _ => ()
+                               | Word _ => ()
+                        in
+                           s
+                        end))
+      val () =
+         Vector.foreach
+         (datatypes, fn Datatype.T {cons, tycon} =>
+          let
+             val s = tyconSize tycon
+             fun dependsOn (t: Type.t): unit = Size.<= (typeSize t, s)
+             val () = Vector.foreach (cons, fn {args, ...} =>
+                                      Prod.foreach (args, dependsOn))
+          in
+             ()
+          end)
       fun typeIsLarge (t: Type.t): bool =
          Size.isTop (typeSize t)
       fun objectHasAnotherLarge (Object.Obj {args, ...}, {offset: int}) =




More information about the MLton-commit mailing list