[MLton-commit] r6395

[Matthew Fluet]

Fixed space-safety bug in pass to flatten refs into containing data structure.
----------------------------------------------------------------------

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

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

Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog	2008-02-13 22:30:53 UTC (rev 6394)
+++ mlton/trunk/doc/changelog	2008-02-13 22:55:28 UTC (rev 6395)
@@ -1,5 +1,10 @@
 Here are the changes from version 20070826 to version YYYYMMDD.
 
+* 2008-02-13
+   - Fixed space-safety bug in pass to flatten refs into containing
+     data structure. Thanks to Daniel Spoonhower for the bug report
+     and initial diagnosis and patch.
+
 * 2008-01-21
    - Fixed frontend to accept "op longvid" patterns and expressions.
      Thanks to Florian Weimer for the bug report.

Modified: mlton/trunk/mlton/ssa/ref-flatten.fun
===================================================================
--- mlton/trunk/mlton/ssa/ref-flatten.fun	2008-02-13 22:30:53 UTC (rev 6394)
+++ mlton/trunk/mlton/ssa/ref-flatten.fun	2008-02-13 22:55:28 UTC (rev 6395)
@@ -12,6 +12,9 @@
 
 type int = Int.t
 
+structure Graph = DirectedGraph
+structure Node = Graph.Node
+
 datatype z = datatype Exp.t
 datatype z = datatype Statement.t
 datatype z = datatype Transfer.t
@@ -694,6 +697,12 @@
        * large value and the container is not live in this block (we
        * approximate liveness), then don't allow the flattening to
        * happen.
+       *
+       * Vectors may be objects of unbounded size.
+       * Weak pointers may not be objects of unbounded size; weak
+       * pointers do not keep pointed-to object live.
+       * Instances of recursive datatypes may be objects of unbounded
+       * size.
        *)
       val {get = tyconSize: Tycon.t -> Size.t, ...} =
          Property.get (Tycon.plist, Property.initFun (fn _ => Size.new ()))
@@ -709,13 +718,15 @@
                            val () =
                               case Type.dest t of
                                  CPointer => ()
-                               | Datatype c => Size.<= (tyconSize c, s)
+                               | Datatype tc => Size.<= (tyconSize tc, s)
                                | IntInf => Size.makeTop s
-                               | Object {args, ...} =>
-                                    Prod.foreach (args, dependsOn)
+                               | Object {args, con, ...} =>
+                                    if ObjectCon.isVector con
+                                       then Size.makeTop s
+                                    else Prod.foreach (args, dependsOn)
                                | Real _ => ()
                                | Thread => Size.makeTop s
-                               | Weak t => dependsOn t
+                               | Weak _ => ()
                                | Word _ => ()
                         in
                            s
@@ -731,6 +742,70 @@
           in
              ()
           end)
+      (* Force (mutually) recursive datatypes to top. *)
+      val {get = nodeTycon: unit Node.t -> Tycon.t, 
+           set = setNodeTycon, ...} =
+         Property.getSetOnce 
+         (Node.plist, Property.initRaise ("nodeTycon", Node.layout))
+      val {get = tyconNode: Tycon.t -> unit Node.t, 
+           set = setTyconNode, ...} =
+         Property.getSetOnce 
+         (Tycon.plist, Property.initRaise ("tyconNode", Tycon.layout))
+      val graph = Graph.new ()
+      val () =
+         Vector.foreach
+         (datatypes, fn Datatype.T {tycon, ...} =>
+          let
+             val node = Graph.newNode graph
+             val () = setTyconNode (tycon, node)
+             val () = setNodeTycon (node, tycon)
+          in 
+             ()
+          end)
+      val () =
+         Vector.foreach
+         (datatypes, fn Datatype.T {cons, tycon} =>
+          let
+             val n = tyconNode tycon
+             fun dependsOn (t: Type.t): unit = 
+                let 
+                   datatype z = datatype Type.dest
+                   fun loop t =
+                      case Type.dest t of
+                         CPointer => ()
+                       | Datatype tc => 
+                            (ignore o Graph.addEdge)
+                            (graph, {from = n, to = tyconNode tc})
+                       | IntInf => ()
+                       | Object {args, ...} =>
+                            Prod.foreach (args, loop)
+                       | Real _ => ()
+                       | Thread => ()
+                       | Weak _ => ()
+                       | Word _ => ()
+                in 
+                   loop t
+                end
+             val () = Vector.foreach (cons, fn {args, ...} =>
+                                      Prod.foreach (args, dependsOn))
+          in
+             ()
+          end)
+      val () =
+         List.foreach
+         (Graph.stronglyConnectedComponents graph, fn ns =>
+          let
+             fun doit () =
+                List.foreach
+                (ns, fn n =>
+                 Size.makeTop (tyconSize (nodeTycon n)))
+          in
+             case ns of
+                [n] => if Node.hasEdge {from = n, to = n}
+                          then doit ()
+                       else ()
+              | _ => doit ()
+          end)
       fun typeIsLarge (t: Type.t): bool =
          Size.isTop (typeSize t)
       fun objectHasAnotherLarge (Object.Obj {args, ...}, {offset: int}) =