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. | |
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 | * | |
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. | |
26 | * | |
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. | |
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 *) | |
40 | class ['a,'b] oassoc_buffer max cached = | |
41 | object(o) | |
42 | inherit ['a,'b] oassoc | |
43 | ||
44 | val counter = ref 0 | |
45 | val cache = ref (new oassocb []) | |
46 | val dirty = ref (new osetb Setb.empty) | |
47 | val wrapped = ref cached | |
48 | ||
49 | method private myflush = | |
50 | ||
51 | let has_a_raised = ref false in | |
52 | ||
53 | !dirty#iter (fun k -> | |
54 | try | |
55 | wrapped := !wrapped#add (k, !cache#assoc k) | |
56 | with Out_of_memory -> | |
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 | ||
65 | ||
66 | method misc_op_hook2 = o#myflush | |
67 | ||
68 | method empty = | |
69 | raise Todo | |
70 | ||
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. | |
75 | *) | |
76 | method add (k,v) = | |
77 | cache := !cache#add (k,v); | |
78 | dirty := !dirty#add k; | |
79 | incr counter; | |
80 | if !counter > max then o#myflush; | |
81 | o | |
82 | ||
83 | method iter f = | |
84 | o#myflush; (* bugfix: have to flush !!! *) | |
85 | !wrapped#iter f | |
86 | ||
87 | ||
88 | method keys = | |
89 | o#myflush; (* bugfix: have to flush !!! *) | |
90 | !wrapped#keys | |
91 | ||
92 | method clear = | |
93 | o#myflush; (* bugfix: have to flush !!! *) | |
94 | !wrapped#clear | |
95 | ||
96 | ||
97 | method length = | |
98 | o#myflush; | |
99 | !wrapped#length | |
100 | ||
101 | method view = | |
102 | raise Todo | |
103 | ||
104 | method del (k,v) = | |
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; | |
109 | o | |
110 | method mem e = raise Todo | |
111 | method null = raise Todo | |
112 | ||
113 | method assoc k = | |
114 | try !cache#assoc k | |
115 | with Not_found -> | |
116 | (* may launch Not_found, but this time, dont catch it *) | |
117 | let v = !wrapped#assoc k in | |
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 | |
125 | ||
126 | method delkey k = | |
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). | |
130 | * | |
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 *) | |
134 | begin | |
135 | try wrapped := !wrapped#delkey k | |
136 | with Not_found -> () | |
137 | end; | |
138 | dirty := !dirty#del k; | |
139 | o | |
140 | ||
141 | end | |
142 | ||
143 | ||
144 | (* | |
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 | |
169 | *) | |
170 | ||
171 |