[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