-(*
- This module defines a wrapper builder which given a function
- and creates its memoized version. The hashtable used to memoize
- results is given as argument of the module, the keys of the table
- are the argument of the function we want to wrap.
- The tricky part is to do this also for recursive function where
- each call can be memoized.
-
- See the technical report:
-
- "That About Wraps it Up: Using FIX to Handle Errors Without
- Exceptions, and Other Programming Tricks"
-
- Bruce J. McAdam
-
- http://www.lfcs.inf.ed.ac.uk/reports/97/ECS-LFCS-97-375/
-
- we give two wrapper builders:
- - make , which builds a new function, memoized only at toplevel. The only
- penalty here is the single look-up, which is supposed to be negligeble w.r.t
- the actual computation (other wise there is little point in memoizing)
-
- - make_rec which acts as a fixpoint combinator and memoized each recursive call
- of the function. The penalty is twofold:
- 1) a look-up for every recursive call.
- 2) the function has to be written in CPS, and is therefore compiled less
- efficiently than its recursive non memoized function.
-
- Again, it is assumed that the same expensive computation will occur many time
- to amortise these penalties.
-
-*)
-
-INCLUDE "utils.ml"
-
-
-module Make ( H : Hashtbl.S ) =
-struct
-
-
- let make f =
- let tbl = H.create BIG_H_SIZE in
- fun arg ->
- try
- H.find tbl arg
- with Not_found ->
- let r = f arg in H.add tbl arg r;r
-
-
- type 'a fix = Fix of ('a fix -> 'a)
-
- let make_rec f =
- let tbl = H.create BIG_H_SIZE in
- let unboxed =
- function ((Fix f')as fix) ->
- f (fun arg ->
- try
- H.find tbl arg
- with
- Not_found -> let r = f' fix arg
- in H.add tbl arg r;r)
- in unboxed (Fix unboxed)
-
-end
-;;