1 (* Copyright (C
) 2003-2006 Henry Cejtin
, Matthew Fluet
, Suresh
2 * Jagannathan
, and Stephen Weeks
.
4 * MLton is released under a BSD
-style license
.
5 * See the file MLton
-LICENSE for details
.
8 structure MLtonFinalizable
: MLTON_FINALIZABLE
=
15 fun push (l
, x
) = l
:= x
:: !l
17 fun foreach (l
, f
) = app f l
20 datatype 'a t
= T
of {afters
: (unit
-> unit
) list ref
,
21 finalizers
: ('a
-> unit
) list ref
,
24 fun touch (T
{value
, ...}) = Primitive
.MLton
.Finalizable
.touch value
26 fun withValue (f
as T
{value
, ...}, g
) =
27 DynamicWind
.wind (fn () => g (!value
),
30 fun addFinalizer (T
{finalizers
, ...}, f
) =
31 List.push (finalizers
, f
)
35 val r
: {clean
: unit
-> unit
,
36 isAlive
: unit
-> bool} list ref
= ref
[]
38 List.foldl (fn (z
as {clean
: unit
-> unit
, isAlive
},
41 then (gotOne
, z
:: zs
)
42 else (clean (); (true, zs
)))
44 val _
= MLtonSignal
.handleGC (fn () => r
:= #
2 (clean (!r
)))
47 (Cleaner
.atExit
, fn () =>
50 (* Must clear r so that the handler doesn
't interfere
and so that
51 * all other references to the finalizers are dropped
.
56 val _
= MLtonGC
.collect ()
57 val (gotOne
, l
) = clean l
70 fun new (v
: 'a
): 'a t
=
73 val finalizers
= ref
[]
75 val f
= T
{afters
= afters
,
76 finalizers
= finalizers
,
78 val weak
= MLtonWeak
.new value
80 (List.foreach (!finalizers
, fn f
=> f v
)
81 ; List.foreach (!afters
, fn f
=> f ()))
82 fun isAlive () = isSome (MLtonWeak
.get weak
)
83 val _
= finalize
{clean
= clean
, isAlive
= isAlive
}
88 fun finalizeBefore (T
{afters
, ...}, f
) =
89 List.push (afters
, fn () => touch f
)