lustrec / src / tools / stateflow / semantics / memo.ml @ 93119c3f
History  View  Annotate  Download (1.25 KB)
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;; 