```  1 (* For the moment, we hold the lock while the client function [f] is busy. In
2    a concurrent implementation, we might wish to hold the lock only during a
3    short period. We could release the lock before invoking [f], and acquire it
4    again when [f] is done (suggestion by Guillaume Melquiond). Some thought
5    would be required if we wish to guarantee that [f] is invoked at most once
6    for every input. TEMPORARY *)
7
8 open lock (* new, acquire, release *)
9 open hashtable (* table, create, find, add *)
10
11 (* The simple memoizing combinator. *)
12
13 (* A lock is used to protect the hash table and to allow its use in a
14    duplicable object (the memoized function). *)
15
16 val memoize
17   [a, b, s : perm]
18   duplicable a => duplicable b =>
19   (hash: a -> int, eq: (a, a) -> bool, f: (a | s) -> b)
20   : (a | s) -> b =
21
22   (* Create the internal hash table. *)
23   let t = create (11, hash, eq) in
24   (* Create a lock which (at runtime) prevents re-entrant calls
25      into the memoized function and (at type-checking time) allows
26      us to hide the existence of the hash table. *)
27   let l : lock (t @ table a b) = new () in
28
29   (* Now, construct the memoized function. *)
30   fun (x: a | s) : b =
31     (* Acquire the lock. This yields the permission [t @ table a b]. *)
32     acquire l;
33     (* Find [y] in the table, if it is there already, or compute [y]
34        and store it in the table for potential later re-use. *)
35     let y =
36       match find (x, t) with
37       | Some { contents = y } ->
38           y
39       | None ->
40           let y = f x in
41           assert held l;
43           y
44       end
45     in
46     (* Release the lock. This consumes [t @ table a b]. *)
47     release l;
48     (* Return [y]. *)
49     y
50
51 (* The recursive memoizing combinator. *)
52
53 (* A technician would say that, by requiring [f] to be polymorphic in [p], we
54    are manually building in an application of the second-order frame rule.
55    This allows us to pass the permission [t @ table a b], disguised as an
56    abstract permission [p], to the function [f], which itself passes it on to
57    [self]. This allows us not to release and re-acquire the lock at every
58    recursive invocation. Incidentally, it guarantees that [f] cannot store
59    [self] and invoke it at a later time. *)
60
61 val fix
62   [a, b]
63   duplicable a => duplicable b =>
64   (
65     hash: a -> int,
66     eq: (a, a) -> bool,
67     f: [p : perm] ((a | p) -> b, a | p) -> b
68   )
69   : a -> b =
70
71   (* Create the internal hash table and lock. *)
72   let t = create [a, b] (11, hash, eq) in
73   let l : lock (t @ table a b) = new () in
74
75   (* For the sake of efficiency, we prefer not to release and re-acquire
76      the lock at every recursive invocation. Thus, the recursive function
77      that we define below assumes that the lock is held -- hence, the
78      table is available. *)
79
80   (* Construct the recursive function. *)
81   let rec memoized (x: a | t @ table a b) : b =
82     match find (x, t) with
83     | Some { contents = y } ->
84         y
85     | None ->
86         let y = f (memoized, x) in
88         y
89     end
90   in
91
92   (* Now, construct the final memoized function. *)
93   fun (x: a) : b =
94     (* Acquire the lock. This yields the permission [t @ table a b]. *)
95     acquire l;
96     (* Invoke the recursive computation. *)
97     let y = memoized x in
98     (* Release the lock. This consumes [t @ table a b]. *)
99     release l;
100     (* Return [y]. *)
101     y
102
103 (* TEMPORARY once the bug is fixed, we might wish [fix] to have type
104
105 val fix
106   [a, b, s : perm]
107   duplicable a => duplicable b =>
108   (
109     hash: a -> int,
110     eq: (a, a) -> bool,
111     f: [p : perm] ((a | p * s) -> b, a | p * s) -> b
112   )
113   : (a | s) -> b =
114
115 This requires adding *s to memoized,
116 adding |s to the final anonymous function. *)
117
118 (*
119 Local Variables:
120 compile-command: "../mezzo memoize.mz"
121 End:
122 *)
```