Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | signature CLIST = |
2 | sig | |
3 | type t | |
4 | ||
5 | val cons: int * t -> t | |
6 | val sing: int -> t | |
7 | val sum: t -> int | |
8 | end | |
9 | ||
10 | functor CList (structure F: MLTON_FINALIZABLE | |
11 | structure P: MLTON_POINTER | |
12 | structure Prim: | |
13 | sig | |
14 | val cons: int * P.t -> P.t | |
15 | val free: P.t -> unit | |
16 | val sing: int -> P.t | |
17 | val sum: P.t -> int | |
18 | end): CLIST = | |
19 | struct | |
20 | type t = P.t F.t | |
21 | ||
22 | fun cons (n: int, l: t) = | |
23 | F.withValue | |
24 | (l, fn w' => | |
25 | let | |
26 | val c = F.new (Prim.cons (n, w')) | |
27 | val _ = F.addFinalizer (c, Prim.free) | |
28 | val _ = F.finalizeBefore (c, l) | |
29 | in | |
30 | c | |
31 | end) | |
32 | ||
33 | fun sing n = | |
34 | let | |
35 | val c = F.new (Prim.sing n) | |
36 | val _ = F.addFinalizer (c, Prim.free) | |
37 | in | |
38 | c | |
39 | end | |
40 | ||
41 | fun sum c = F.withValue (c, Prim.sum) | |
42 | end | |
43 | ||
44 | functor Test (structure CList: CLIST | |
45 | structure MLton: sig | |
46 | structure GC: | |
47 | sig | |
48 | val collect: unit -> unit | |
49 | end | |
50 | end) = | |
51 | struct | |
52 | fun f n = | |
53 | if n = 1 | |
54 | then () | |
55 | else | |
56 | let | |
57 | val a = Array.tabulate (n, fn i => i) | |
58 | val _ = Array.sub (a, 0) + Array.sub (a, 1) | |
59 | in | |
60 | f (n - 1) | |
61 | end | |
62 | ||
63 | val l = CList.sing 2 | |
64 | val l = CList.cons (2,l) | |
65 | val l = CList.cons (2,l) | |
66 | val l = CList.cons (2,l) | |
67 | val l = CList.cons (2,l) | |
68 | val l = CList.cons (2,l) | |
69 | val l = CList.cons (2,l) | |
70 | val _ = MLton.GC.collect () | |
71 | val _ = f 100 | |
72 | val _ = print (concat ["listSum(l) = ", | |
73 | Int.toString (CList.sum l), | |
74 | "\n"]) | |
75 | val _ = MLton.GC.collect () | |
76 | val _ = f 100 | |
77 | end | |
78 | ||
79 | structure CList = | |
80 | CList (structure F = MLton.Finalizable | |
81 | structure P = MLton.Pointer | |
82 | structure Prim = | |
83 | struct | |
84 | val cons = _import "listCons": int * P.t -> P.t; | |
85 | val free = _import "listFree": P.t -> unit; | |
86 | val sing = _import "listSing": int -> P.t; | |
87 | val sum = _import "listSum": P.t -> int; | |
88 | end) | |
89 | ||
90 | structure S = Test (structure CList = CList | |
91 | structure MLton = MLton) |