1

open Basetypes

2


3

type ('a, 'b) t = Memo : ('a, 'b) Hashtbl.t > ('a, 'b) t;;

4


5

let create () = Memo (Hashtbl.create 97);;

6


7

let reset (Memo hashf) =

8

begin

9

Hashtbl.reset hashf

10

end

11


12

let fold (Memo hashf) f e =

13

begin

14

Hashtbl.fold f hashf e

15

end;;

16


17

let apply (Memo hashf) f =

18

fun x >

19

try

20

Log.report ~level:sf_level (fun fmt > Format.fprintf fmt "lookup 1@.");

21

Hashtbl.find hashf x

22

with Not_found >

23

let res = f x in

24

begin

25

Log.report ~level:sf_level (fun fmt > Format.fprintf fmt "hashing 1@.");

26

Hashtbl.add hashf x res;

27

res

28

end;;

29


30

let apply2 (Memo hashf) f =

31

fun x y >

32

try

33

Log.report ~level:sf_level (fun fmt > Format.fprintf fmt "lookup 2@.");

34

Hashtbl.find hashf (x, y)

35

with Not_found >

36

let res = f x y in

37

begin

38

Log.report ~level:sf_level (fun fmt > Format.fprintf fmt "hashing 2@.");

39

Hashtbl.add hashf (x, y) res;

40

res

41

end;;

42


43

let apply3 (Memo hashf) f =

44

fun x y z >

45

try

46

Log.report ~level:sf_level (fun fmt > Format.fprintf fmt "lookup 3@.");

47

Hashtbl.find hashf (x, y, z)

48

with Not_found >

49

let res = f x y z in

50

begin

51

Log.report ~level:sf_level (fun fmt > Format.fprintf fmt "hashing 3@.");

52

Hashtbl.add hashf (x, y, z) res;

53

res

54

end;;
