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)