[MLton] Registering roots in the FFI

[Jens Axel Søgaard]

Stephen Weeks wrote:
>>Since globals are treated as roots by the garbage collector,
>>I can use global reference cells to prevent the garbage
>>collector to free needed values.
> 
> Possibly.  You need to worry about MLton's optimizer being clever
> enough to notice that a ref cell's contents are unused and then
> removing the contents, or even the ref cell.

I decided to try the "Register in roots in ML"-approach. The initial
experiments on int arrays seemed to work, so now I am trying to
generalize to other types as well.

For each type t there are three functions:

   registerRoot : t -> int
   getRoot : int -> t
   unregisterRoot : int -> unit

Since there are 17 basic types, and one can have arrays, vectors and
references of the basic types, and for each combination there are 3
functions to export. This amounts to 153 functions.

The question is whether there is a better way to organize the code
than the following? Specifically is there a smater way of handling
the exporting?

(* root.sig *)

signature ROOT_TYPE =
   sig
     type t
   end

signature ROOT =
   sig
     type t

     exception RootNotFound;

     val getRoot: int -> t
     val registerRoot: t -> int
     val unregisterRoot: int -> unit
   end

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

(* root.fun *)

functor Root (R: ROOT_TYPE): ROOT =
struct
type t = R.t;
exception RootNotFound;
val roots = ref [];    (* association list of integer*root pairs *)
val nextRoot = ref 0;

val getRoot =
      fn i => let
                val rec loop = fn nil          =>  raise RootNotFound
                                | (j,r)::more  =>  if i=j then r else (loop more)
              in
                loop (!roots)
              end;

val registerRoot =
       fn r => (roots := (!nextRoot,r)::(!roots);
                nextRoot := !nextRoot+1;
                !nextRoot-1);

val unregisterRoot =
       fn i => roots := let val rec loop =
                                      fn []          => raise RootNotFound
                                       | (j,r)::more => if i=j
                                                        then more
                                                        else (j,r)::(loop more)
                        in
                          loop (!roots)
                        end;
end

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

(* test.sml for now *)

structure BoolArrayRoots = Root(struct type t = bool array end);
structure CharArrayRoots = Root(struct type t = char array end);
structure Int8ArrayRoots = Root(struct type t = Int8.int array end);
structure Int16ArrayRoots = Root(struct type t = Int16.int array end);
structure Int32ArrayRoots = Root(struct type t = Int32.int array end);
structure Int64ArrayRoots = Root(struct type t = Int64.int array end);
structure IntArrayRoots = Root(struct type t = int array end);
structure PointerArrayRoots = Root(struct type t = MLton.Pointer.t array end);
structure Real32ArrayRoots = Root(struct type t = Real32.real array end);
structure Real64ArrayRoots = Root(struct type t = Real64.real array end);
structure RealArrayRoots = Root(struct type t = Real64.real array end);
structure StringArrayRoots = Root(struct type t = string array end);
structure Word8ArrayRoots = Root(struct type t = Word8.word array end);
structure Word16ArrayRoots = Root(struct type t = Word16.word array end);
structure Word32ArrayRoots = Root(struct type t = Word32.word array end);
structure Word64ArrayRoots = Root(struct type t = Word64.word array end);
structure WordArrayRoots = Root(struct type t = word array end);

(* here comes vectors and references to the same types *)

val _ = _export "registerRoot_BoolArray": bool Array.array -> int; BoolArrayRoots.registerRoot;
val _ = _export "unregisterRoot_BoolArray": int -> unit; BoolArrayRoots.unregisterRoot;
val _ = _export "getRoot_BoolArray": int -> bool Array.array; BoolArrayRoots.getRoot;


-- 
Jens Axel Søgaard