Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / tools / stateflow / src / semantics / CPS / memo.ml @ 2de7fa82

History | View | Annotate | Download (1.2 KB)

1

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

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

    
6
let reset (Memo hashf) =
7
  begin
8
    Hashtbl.reset hashf
9
  end
10

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

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

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

    
42
let apply3 (Memo hashf) f =
43
  fun x y z ->
44
    try
45
      Log.log ~debug:false (fun fmt -> Format.fprintf fmt "lookup 3@.");
46
      Hashtbl.find hashf (x, y, z)
47
    with Not_found ->
48
      let res = f x y z in
49
      begin
50
	Log.log ~debug:false (fun fmt -> Format.fprintf fmt "hashing 3@.");
51
	Hashtbl.add hashf (x, y, z) res;
52
	res
53
      end;;