Source file `oassoc_buffer.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
open Common

open Oassoc

open Oassocb
open Osetb

(* Take care that must often redefine all function in the original
 * oassoc.ml because if some methods are not redefined, for instance 
 * #clear, then if do wrapper over a oassocdbm, then even if oassocdbm
 * redefine #clear, it will not be called, but instead the default
 * method will be called that internally will call another method.
 * So better delegate all the methods and override even the method
 * with a default definition.
 * 
 * In the same way sometimes an exn can occur at weird time. When
 * we add an element, sometimes this may raise an exn such as Out_of_memory,
 * but as we dont add directly but only at flush time, the exn
 * may happen far later the user added something in this oassoc.
 * Also in the case of Out_of_memory, even if the entry is not 
 * added in the wrapped, it will still be present in the cache
 * and so the next flush will still generate an exn that again
 * may not be cached. So for the moment if Out_of_memory then
 * do something special and erase the entry in the cache.
 * 
 * Cf also oassoc_cache.ml which can be even more efficient.
 *)

(* !!take care!!: this class has side effect, not a pure oassoc *)
(* can not make it pure, cos the assoc have side effect on the cache *)
class ['a,'b] oassoc_buffer   max cached = 
object(o)
  inherit ['a,'b] oassoc

  val counter = ref 0
  val cache = ref (new oassocb []) 
  val dirty = ref (new osetb Set_.empty)
  val wrapped = ref cached

  method private myflush = 

    let has_a_raised = ref false in 

    !dirty#iter (fun k -> 
      try 
        wrapped := !wrapped#add (k, !cache#assoc k)
      with Out_of_memory -> 
        pr2 "PBBBBBB: Out_of_memory in oassoc_buffer, but still empty cache";
        has_a_raised := true;
    );
    dirty := (new osetb Set_.empty);
    cache := (new oassocb []);
    counter := 0;
    if !has_a_raised then raise Out_of_memory

      
  method misc_op_hook2 = o#myflush
        
  method empty = 
    raise Todo
      
  (* what happens in k is already present ? or if add multiple times
   * the same k ? cache is a oassocb and so the previous binding is
   * still there, but dirty is a set, and in myflush we iter based 
   * on dirty so we will flush only the last 'k' in the cache.
   *)
  method add (k,v) = 
    cache := !cache#add (k,v);
    dirty := !dirty#add k;
    incr counter;
    if !counter > max then o#myflush;
    o

  method iter f = 
    o#myflush; (* bugfix: have to flush !!! *)
    !wrapped#iter f


  method keys = 
    o#myflush; (* bugfix: have to flush !!! *)
    !wrapped#keys

  method clear = 
    o#myflush; (* bugfix: have to flush !!! *)
    !wrapped#clear


  method length = 
    o#myflush;
    !wrapped#length

  method view = 
    raise Todo

  method del (k,v) = 
    cache := !cache#del (k,v); 
    (* TODO as for delkey, do a try over wrapped *)
    wrapped := !wrapped#del (k,v); 
    dirty := !dirty#del k;
    o
  method mem e = raise Todo
  method null = raise Todo

  method assoc k = 
    try !cache#assoc k 
    with Not_found -> 
      (* may launch Not_found, but this time, dont catch it *)
      let v = !wrapped#assoc k in 
      begin
        cache := !cache#add (k,v);
        (* otherwise can use too much mem *)
        incr counter;
        if !counter > max then o#myflush;
        v
      end
          
  method delkey k = 
    cache := !cache#delkey k; 
    (* sometimes have not yet flushed, so may not be yet in, (could
     * also flush in place of doing try).
     * 
     * TODO would be better to see if was in cache (in case mean that
     * perhaps not flushed and do try and in other case just cos del
     * (without try) cos forcement flushed ou was an error *)
    begin 
      try wrapped := !wrapped#delkey k 
      with Not_found -> ()
    end;
    dirty := !dirty#del k;
    o

end