8 (* todo: gather stat of use per key, so when flush, try keep
9 * entries that are used above a certain threshold, and if after
10 * this step, there is still too much, then erase also those keys.
12 * todo: limit number of entries, and erase all (then better do a ltu)
14 * todo: another cache that behave as in lfs1,
15 * every 100 operation do a flush
17 * todo: choose between oassocb and oassoch ?
19 * Also take care that must often redefine all function in the original
20 * oassoc.ml because if some methods are not redefined, for instance
21 * #clear, then if do wrapper over a oassocdbm, then even if oassocdbm
22 * redefine #clear, it will not be called, but instead the default
23 * method will be called that internally will call another method.
24 * So better delegate all the methods and override even the method
25 * with a default definition.
27 * In the same way sometimes an exn can occur at weird time. When
28 * we add an element, sometimes this may raise an exn such as Out_of_memory,
29 * but as we dont add directly but only at flush time, the exn
30 * may happen far later the user added something in this oassoc.
31 * Also in the case of Out_of_memory, even if the entry is not
32 * added in the wrapped, it will still be present in the cache
33 * and so the next flush will still generate an exn that again
34 * may not be cached. So for the moment if Out_of_memory then
35 * do something special and erase the entry in the cache.
38 (* !!take care!!: this class has side effect, not a pure oassoc *)
39 (* can not make it pure, cos the assoc have side effect on the cache *)
40 class ['a
,'b
] oassoc_buffer max cached
=
42 inherit ['a
,'b
] oassoc
45 val cache
= ref (new oassocb
[])
46 val dirty
= ref (new osetb
Setb.empty
)
47 val wrapped
= ref cached
49 method private myflush
=
51 let has_a_raised = ref false in
55 wrapped
:= !wrapped#add
(k
, !cache#assoc k
)
57 pr2
"PBBBBBB: Out_of_memory in oassoc_buffer, but still empty cache";
60 dirty
:= (new osetb
Setb.empty
);
61 cache
:= (new oassocb
[]);
63 if !has_a_raised then raise Out_of_memory
66 method misc_op_hook2
= o#myflush
71 (* what happens in k is already present ? or if add multiple times
72 * the same k ? cache is a oassocb and so the previous binding is
73 * still there, but dirty is a set, and in myflush we iter based
74 * on dirty so we will flush only the last 'k' in the cache.
77 cache
:= !cache#add
(k
,v
);
78 dirty
:= !dirty#add k
;
80 if !counter
> max
then o#myflush
;
84 o#myflush
; (* bugfix: have to flush !!! *)
89 o#myflush
; (* bugfix: have to flush !!! *)
93 o#myflush
; (* bugfix: have to flush !!! *)
105 cache
:= !cache#del
(k
,v
);
106 (* TODO as for delkey, do a try over wrapped *)
107 wrapped
:= !wrapped#del
(k
,v
);
108 dirty
:= !dirty#del k
;
110 method mem e
= raise Todo
111 method null
= raise Todo
116 (* may launch Not_found, but this time, dont catch it *)
117 let v = !wrapped#assoc k
in
119 cache
:= !cache#add
(k
,v);
120 (* otherwise can use too much mem *)
122 if !counter
> max
then o#myflush
;
127 cache
:= !cache#delkey k
;
128 (* sometimes have not yet flushed, so may not be yet in, (could
129 * also flush in place of doing try).
131 * TODO would be better to see if was in cache (in case mean that
132 * perhaps not flushed and do try and in other case just cos del
133 * (without try) cos forcement flushed ou was an error *)
135 try wrapped
:= !wrapped#delkey k
138 dirty
:= !dirty#del k
;
145 class ['a,'b] oassoc_cache cache cached max =
147 inherit ['a,'b] oassoc
155 val data = Hashtbl.create 100
157 method empty = raise Todo
158 method add (k,v) = (Hashtbl.add data k v; o)
159 method iter f = cached#iter f
160 method view = raise Todo
162 method del (k,v) = (cache#del (k,v); cached#del (k,v); o)
163 method mem e = raise Todo
164 method null = raise Todo
166 method assoc k = Hashtbl.find data k
167 method delkey k = (cache#delkey (k,v); cached#del (k,v); o)