[MLton-commit] r6524

[Matthew Fluet]

Use a property to check well-formedness of a type at most once.

Since types are shared and there are no non-trivial scoping
constraints, it is much more efficient to cache the result of the
well-formedness test using a property than to repeatedly traveres the
type at each use.

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

U   mlton/trunk/mlton/ssa/type-check.fun

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

Modified: mlton/trunk/mlton/ssa/type-check.fun
===================================================================
--- mlton/trunk/mlton/ssa/type-check.fun	2008-04-03 14:27:55 UTC (rev 6523)
+++ mlton/trunk/mlton/ssa/type-check.fun	2008-04-03 14:28:00 UTC (rev 6524)
@@ -56,25 +56,29 @@
       val (bindLabel, getLabel, unbindLabel) = make (Label.layout, Label.plist)
       val (bindFunc, getFunc, _) = make (Func.layout, Func.plist)
 
-      fun loopType ty =
-         let
-            datatype z = datatype Type.dest
-            val _ =
-               case Type.dest ty of
-                  Array ty => loopType ty
-                | CPointer => ()
-                | Datatype tycon => getTycon tycon
-                | IntInf => ()
-                | Real _ => ()
-                | Ref ty => loopType ty
-                | Thread => ()
-                | Tuple tys => Vector.foreach (tys, loopType)
-                | Vector ty => loopType ty
-                | Weak ty => loopType ty
-                | Word _ => ()
-         in
-            ()
-         end
+      val {destroy = destroyLoopType, get = loopType, ...} =
+         Property.destGet
+         (Type.plist, 
+          Property.initRec 
+          (fn (ty, loopType) =>
+           let
+              datatype z = datatype Type.dest
+              val _ =
+                 case Type.dest ty of
+                    Array ty => loopType ty
+                  | CPointer => ()
+                  | Datatype tycon => getTycon tycon
+                  | IntInf => ()
+                  | Real _ => ()
+                  | Ref ty => loopType ty
+                  | Thread => ()
+                  | Tuple tys => Vector.foreach (tys, loopType)
+                  | Vector ty => loopType ty
+                  | Weak ty => loopType ty
+                  | Word _ => ()
+           in
+              ()
+           end))
       fun loopTypes tys = Vector.foreach (tys, loopType)
       (* Redefine bindCon and bindVar to check well-formedness of types. *)
       val bindCon = fn (con, args, i) => (loopTypes args; bindCon (con, i))
@@ -218,6 +222,7 @@
       val _ = getFunc main
       val _ = List.foreach (functions, loopFunc)
       val _ = Program.clearTop program
+      val _ = destroyLoopType ()
    in
       ()
    end