signature MLTON_FINALIZABLE =
   sig
      type 'a t

      val addFinalizer: 'a t * ('a -> unit) -> unit
      val finalizeBefore: 'a t * 'b t -> unit
      val new: 'a -> 'a t
      val touch: 'a t -> unit
      val withValue: 'a t * ('a -> 'b) -> 'b
   end

A finalizable value is a value to which finalizers can be attached. A finalizer is a function that runs after a garbage collection determines that the value to which it is attached is unreachable. Reachability is the same as with weak pointers. The finalizer is treated like a signal handler, in that it runs asynchronously in a separate thread, with signals blocked, and will not interrupt a critical section (see MLtonThread).

• addFinalizer (v, f)

adds f as a finalizer to v. This means that sometime after the last call to withValue on v completes and v becomes unreachable, f will be called with the value of v.

• finalizeBefore (v1, v2)

ensures that v1 will be finalized before v2. A cycle of values v = v1, ..., vn = v with finalizeBefore (vi, vi+1) will result in none of the vi being finalized.

• new x

creates a new finalizable value, v, with value x. The finalizers of v will run sometime after the last call to withValue on v when the garbage collector determines that v is unreachable.

• touch v

ensures that v's finalizers will not run before the call to touch.

• withValue (v, f)

returns the result of applying f to the value of v and ensures that v's finalizers will not run before f completes. The call to f is a nontail call.

Example

Suppose that finalizable.sml contains the following.

signature CLIST =
   sig
      type t

      val cons: int * t -> t
      val sing: int -> t
      val sum: t -> int
   end

functor CList (structure F: MLTON_FINALIZABLE
               structure Prim:
                  sig
                     val cons: int * Word32.word -> Word32.word
                     val free: Word32.word -> unit
                     val sing: int -> Word32.word
                     val sum: Word32.word -> int
                  end): CLIST =
   struct
      type t = Word32.word F.t

      fun cons (n: int, l: t) =
         F.withValue
         (l, fn w' =>
          let
             val c = F.new (Prim.cons (n, w'))
             val _ = F.addFinalizer (c, Prim.free)
             val _ = F.finalizeBefore (c, l)
          in
             c
          end)
      
      fun sing n =
         let
            val c = F.new (Prim.sing n)
            val _ = F.addFinalizer (c, Prim.free)
         in
            c
         end

      fun sum c = F.withValue (c, Prim.sum)
   end

functor Test (structure CList: CLIST
              structure MLton: sig
                                  structure GC:
                                     sig
                                        val collect: unit -> unit
                                     end
                               end) =
   struct
      fun f n =
         if n = 1
            then ()
         else
            let
               val a = Array.tabulate (n, fn i => i)
               val _ = Array.sub (a, 0) + Array.sub (a, 1)
            in
               f (n - 1)
            end
            
      val l = CList.sing 2
      val l = CList.cons (2,l)
      val l = CList.cons (2,l)
      val l = CList.cons (2,l)
      val l = CList.cons (2,l)
      val l = CList.cons (2,l)
      val l = CList.cons (2,l)
      val _ = MLton.GC.collect ()
      val _ = f 100
      val _ = print (concat ["listSum(l) = ",
                             Int.toString (CList.sum l),
                             "\n"])
      val _ = MLton.GC.collect ()
      val _ = f 100
   end

structure CList =
   CList (structure F = MLton.Finalizable
          structure Prim =
             struct
                val cons = _import "listCons": int * Word32.word -> Word32.word;
                val free = _import "listFree": Word32.word -> unit;
                val sing = _import "listSing": int -> Word32.word;
                val sum = _import "listSum": Word32.word -> int;
             end)

structure S = Test (structure CList = CList
                    structure MLton = MLton)

Suppose that cons.c contains the following.

#include <stdio.h>

typedef unsigned int uint;

typedef struct Cons {
        struct Cons *next;
        int value;
} *Cons;

Cons listCons (int n, Cons c) {
        Cons res;

        res = (Cons) malloc (sizeof(*res));
        fprintf (stderr, "0x%08x = listCons (%d)\n", (uint)res, n);
        res->next = c;
        res->value = n;
        return res;
}

Cons listSing (int n) {
        Cons res;

        res = (Cons) malloc (sizeof(*res));
        fprintf (stderr, "0x%08x = listSing (%d)\n", (uint)res, n);
        res->next = NULL;
        res->value = n;
        return res;
}

void listFree (Cons p) {
        fprintf (stderr, "listFree (0x%08x)\n", (uint)p);
        free (p);
}

int listSum (Cons c) {
        int res;

        fprintf (stderr, "listSum\n");
        res = 0;
        for (; c != NULL; c = c->next)
                res += c->value;
        return res;
}

We can compile these to create an executable with

% mlton -default-ann 'allowFFI true' finalizable.sml cons.c

Running this executable will create output like the following.

% finalizable
0x08072890 = listSing (2)
0x080728a0 = listCons (2)
0x080728b0 = listCons (2)
0x080728c0 = listCons (2)
0x080728d0 = listCons (2)
0x080728e0 = listCons (2)
0x080728f0 = listCons (2)
listSum
listSum(l) = 14
listFree (0x080728f0)
listFree (0x080728e0)
listFree (0x080728d0)
listFree (0x080728c0)
listFree (0x080728b0)
listFree (0x080728a0)
listFree (0x08072890)

Synchronous Finalizers

Finalizers in MLton are asynchronous. That is, they run at an unspecified time, interrupting the user program. It is also possible, and sometimes useful, to have synchronous finalizers, where the user program explicitly decides when to run enabled finalizers. We have considered this in MLton, and it seems possible, but there are some unresolved design issues. See the thread at

• http://mlton.org/pipermail/mlton/2004-September/016570.html

Also see Boehm03.