Commit | Line | Data |
---|---|---|
0708f913 C |
1 | open Common |
2 | ||
3 | open Oassoc | |
4 | ||
5 | open Oassocb | |
6 | open Osetb | |
7 | ||
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. | |
ae4735db C |
11 | * |
12 | * todo: limit number of entries, and erase all (then better do a ltu) | |
13 | * | |
14 | * todo: another cache that behave as in lfs1, | |
15 | * every 100 operation do a flush | |
16 | * | |
17 | * todo: choose between oassocb and oassoch ? | |
18 | * | |
0708f913 | 19 | * Also take care that must often redefine all function in the original |
ae4735db | 20 | * oassoc.ml because if some methods are not redefined, for instance |
0708f913 C |
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. | |
ae4735db | 26 | * |
0708f913 C |
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. | |
ae4735db | 31 | * Also in the case of Out_of_memory, even if the entry is not |
0708f913 C |
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. | |
36 | *) | |
37 | ||
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 *) | |
ae4735db | 40 | class ['a,'b] oassoc_buffer max cached = |
0708f913 C |
41 | object(o) |
42 | inherit ['a,'b] oassoc | |
43 | ||
44 | val counter = ref 0 | |
ae4735db | 45 | val cache = ref (new oassocb []) |
0708f913 C |
46 | val dirty = ref (new osetb Setb.empty) |
47 | val wrapped = ref cached | |
48 | ||
ae4735db | 49 | method private myflush = |
0708f913 | 50 | |
ae4735db | 51 | let has_a_raised = ref false in |
0708f913 | 52 | |
ae4735db C |
53 | !dirty#iter (fun k -> |
54 | try | |
0708f913 | 55 | wrapped := !wrapped#add (k, !cache#assoc k) |
ae4735db | 56 | with Out_of_memory -> |
0708f913 C |
57 | pr2 "PBBBBBB: Out_of_memory in oassoc_buffer, but still empty cache"; |
58 | has_a_raised := true; | |
59 | ); | |
60 | dirty := (new osetb Setb.empty); | |
61 | cache := (new oassocb []); | |
62 | counter := 0; | |
63 | if !has_a_raised then raise Out_of_memory | |
64 | ||
ae4735db | 65 | |
0708f913 | 66 | method misc_op_hook2 = o#myflush |
ae4735db C |
67 | |
68 | method empty = | |
0708f913 | 69 | raise Todo |
ae4735db | 70 | |
0708f913 C |
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 | |
ae4735db | 73 | * still there, but dirty is a set, and in myflush we iter based |
0708f913 C |
74 | * on dirty so we will flush only the last 'k' in the cache. |
75 | *) | |
ae4735db | 76 | method add (k,v) = |
0708f913 C |
77 | cache := !cache#add (k,v); |
78 | dirty := !dirty#add k; | |
79 | incr counter; | |
80 | if !counter > max then o#myflush; | |
81 | o | |
82 | ||
ae4735db | 83 | method iter f = |
0708f913 C |
84 | o#myflush; (* bugfix: have to flush !!! *) |
85 | !wrapped#iter f | |
86 | ||
87 | ||
ae4735db | 88 | method keys = |
0708f913 C |
89 | o#myflush; (* bugfix: have to flush !!! *) |
90 | !wrapped#keys | |
91 | ||
ae4735db | 92 | method clear = |
0708f913 C |
93 | o#myflush; (* bugfix: have to flush !!! *) |
94 | !wrapped#clear | |
95 | ||
96 | ||
ae4735db | 97 | method length = |
0708f913 C |
98 | o#myflush; |
99 | !wrapped#length | |
100 | ||
ae4735db | 101 | method view = |
0708f913 C |
102 | raise Todo |
103 | ||
ae4735db C |
104 | method del (k,v) = |
105 | cache := !cache#del (k,v); | |
0708f913 | 106 | (* TODO as for delkey, do a try over wrapped *) |
ae4735db | 107 | wrapped := !wrapped#del (k,v); |
0708f913 C |
108 | dirty := !dirty#del k; |
109 | o | |
110 | method mem e = raise Todo | |
111 | method null = raise Todo | |
112 | ||
ae4735db C |
113 | method assoc k = |
114 | try !cache#assoc k | |
115 | with Not_found -> | |
0708f913 | 116 | (* may launch Not_found, but this time, dont catch it *) |
ae4735db | 117 | let v = !wrapped#assoc k in |
0708f913 C |
118 | begin |
119 | cache := !cache#add (k,v); | |
120 | (* otherwise can use too much mem *) | |
121 | incr counter; | |
122 | if !counter > max then o#myflush; | |
123 | v | |
124 | end | |
ae4735db C |
125 | |
126 | method delkey k = | |
127 | cache := !cache#delkey k; | |
0708f913 C |
128 | (* sometimes have not yet flushed, so may not be yet in, (could |
129 | * also flush in place of doing try). | |
ae4735db | 130 | * |
0708f913 C |
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 *) | |
ae4735db C |
134 | begin |
135 | try wrapped := !wrapped#delkey k | |
0708f913 C |
136 | with Not_found -> () |
137 | end; | |
138 | dirty := !dirty#del k; | |
139 | o | |
140 | ||
ae4735db | 141 | end |
0708f913 C |
142 | |
143 | ||
144 | (* | |
ae4735db C |
145 | class ['a,'b] oassoc_cache cache cached max = |
146 | object(o) | |
147 | inherit ['a,'b] oassoc | |
148 | ||
149 | val full = ref 0 | |
150 | val max = max | |
151 | val cache = cache | |
152 | val cached = cached | |
153 | val lru = TODO | |
154 | ||
155 | val data = Hashtbl.create 100 | |
156 | ||
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 | |
161 | ||
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 | |
165 | ||
166 | method assoc k = Hashtbl.find data k | |
167 | method delkey k = (cache#delkey (k,v); cached#del (k,v); o) | |
168 | end | |
0708f913 C |
169 | *) |
170 | ||
171 |