| 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 | |