[MLton-devel] cvs commit: finalization at exit

[Stephen Weeks]

sweeks      03/05/14 21:00:57

  Modified:    basis-library/mlton finalize.sml
  Added:       regression finalize.2.ok finalize.2.sml
  Log:
  Added code to the basis library to call all finalizers (whose object
  has disappeared) at exit, looping until no more finalizers can be
  called.
  
  Added regression test finalize.2.sml, which gives the worst case
  scenario requiring one GC per finalizer called.

Revision  Changes    Path
1.2       +28 -7     mlton/basis-library/mlton/finalize.sml

Index: finalize.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/finalize.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- finalize.sml	12 May 2003 08:40:50 -0000	1.1
+++ finalize.sml	15 May 2003 04:00:57 -0000	1.2
@@ -5,14 +5,35 @@
    let
       val r: {clean: unit -> unit,
 	      isAlive: unit -> bool} list ref = ref []
+      fun clean l =
+	 List.foldl (fn (z as {clean, isAlive}, (gotOne, zs)) =>
+		     if isAlive ()
+			then (gotOne, z :: zs)
+		     else (clean (); (true, zs)))
+	 (false, []) l
+      val exiting = ref false
+      val _ = MLtonSignal.handleGC (fn () => r := #2 (clean (!r)))
       val _ =
-	 MLtonSignal.handleGC
-	 (fn () =>
-	  r := (List.foldl (fn (z as {clean, isAlive}, ac) =>
-			    if isAlive ()
-			       then z :: ac
-			    else (clean (); ac))
-		[] (!r)))
+	 Cleaner.addNew
+	 (Cleaner.atExit, fn () =>
+	  let
+	     val l = !r
+	     (* Must clear r so that the handler doesn't interfere and so that
+	      * all other references to the finalizers are dropped.
+	      *)
+	     val _ = r := []
+	     fun loop l =
+		let
+		   val _ = MLtonGC.collect ()
+		   val (gotOne, l) = clean l
+		in
+		   if gotOne
+		      then loop l
+		   else ()
+		end
+	  in
+	     loop l
+	  end)
    in
       fn z => r := z :: !r
    end



1.1                  mlton/regression/finalize.2.ok

Index: finalize.2.ok
===================================================================
2
3
4
5
6
7
8
9
10
13



1.1                  mlton/regression/finalize.2.sml

Index: finalize.2.sml
===================================================================
structure F = MLton.Finalize

fun loop (n, r) =
   if n = 0
      then r
   else
      let
	 val r' = ref n
	 val _ = F.finalize (r', fn () =>
			     print (concat [Int.toString (!r), "\n"]))
      in
	 loop (n - 1, r')
      end

val r = loop (10, ref 13)






-------------------------------------------------------
Enterprise Linux Forum Conference & Expo, June 4-6, 2003, Santa Clara
The only event dedicated to issues related to Linux enterprise solutions
www.enterpriselinuxforum.com

_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel