Project

General

Profile

Download (1.26 KB) Statistics
| Branch: | Tag: | Revision:
1
open Lustrec
2
open Basetypes
3
  
4
type ('a, 'b) t = Memo : ('a, 'b) Hashtbl.t -> ('a, 'b) t;;
5

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

    
8
let reset (Memo hashf) =
9
  begin
10
    Hashtbl.reset hashf
11
  end
12

    
13
let fold (Memo hashf) f e =
14
  begin
15
    Hashtbl.fold f hashf e
16
  end;;
17

    
18
let apply (Memo hashf) f =
19
  fun x ->
20
    try
21
      Log.report ~level:sf_level (fun fmt -> Format.fprintf fmt "lookup 1@.");
22
      Hashtbl.find hashf x
23
    with Not_found ->
24
      let res = f x in
25
      begin
26
	Log.report ~level:sf_level (fun fmt -> Format.fprintf fmt "hashing 1@.");
27
	Hashtbl.add hashf x res;
28
	res
29
      end;;
30

    
31
let apply2 (Memo hashf) f =
32
  fun x y ->
33
    try
34
      Log.report ~level:sf_level (fun fmt -> Format.fprintf fmt "lookup 2@.");
35
      Hashtbl.find hashf (x, y)
36
    with Not_found ->
37
      let res = f x y in
38
      begin
39
	Log.report ~level:sf_level (fun fmt -> Format.fprintf fmt "hashing 2@.");
40
	Hashtbl.add hashf (x, y) res;
41
	res
42
      end;;
43

    
44
let apply3 (Memo hashf) f =
45
  fun x y z ->
46
    try
47
      Log.report ~level:sf_level (fun fmt -> Format.fprintf fmt "lookup 3@.");
48
      Hashtbl.find hashf (x, y, z)
49
    with Not_found ->
50
      let res = f x y z in
51
      begin
52
	Log.report ~level:sf_level (fun fmt -> Format.fprintf fmt "hashing 3@.");
53
	Hashtbl.add hashf (x, y, z) res;
54
	res
55
      end;;
(8-8/10)