commons/oassoc_buffer.ml

   1 open Common
   2
   3 open Oassoc
   4
   5 open Oassocb
   6 open Osetb
   7
   8 (* todo: limit number of entries, and erase all (then better do a ltu)
   9  * todo: another cache that behave as in lfs1,
  10  * every 100 operation do a flush
  11  *
  12  * todo: choose between oassocb and oassoch ?
  13  *)
  14
  15 (* !!take care!!: this class has side effect, not a pure oassoc *)
  16 (* can not make it pure, cos the assoc have side effect on the cache *)
  17 class ['a,'b] oassoc_buffer   max cached =
  18 object(o)
  19   inherit ['a,'b] oassoc
  20
  21   val counter = ref 0
  22   val cache = ref (new oassocb [])
  23   val dirty = ref (new osetb Setb.empty)
  24   val wrapped = ref cached
  25
  26   method private myflush =
  27     !dirty#iter (fun k ->
  28       wrapped := !wrapped#add (k, !cache#assoc k)
  29     );
  30     dirty := (new osetb Setb.empty);
  31     cache := (new oassocb []);
  32     counter := 0;
  33
  34   method misc_op_hook2 = o#myflush
  35
  36   method empty =
  37     raise Todo
  38   method add (k,v) =
  39     cache := !cache#add (k,v);
  40     dirty := !dirty#add k;
  41     incr counter;
  42     if !counter > max then o#myflush;
  43     o
  44
  45   method iter f =
  46     o#myflush; (* bugfix: have to flush !!! *)
  47     !wrapped#iter f
  48
  49
  50   method length =
  51     o#myflush;
  52     !wrapped#length
  53
  54   method view =
  55     raise Todo
  56
  57   method del (k,v) =
  58     cache := !cache#del (k,v);
  59     (* TODO as for delkey, do a try over wrapped *)
  60     wrapped := !wrapped#del (k,v);
  61     dirty := !dirty#del k;
  62     o
  63   method mem e = raise Todo
  64   method null = raise Todo
  65
  66   method assoc k =
  67     try !cache#assoc k
  68     with Not_found ->
  69       (* may launch Not_found, but this time, dont catch it *)
  70       let v = !wrapped#assoc k in
  71       begin
  72         cache := !cache#add (k,v);
  73         (* otherwise can use too much mem *)
  74         incr counter;
  75         if !counter > max then o#myflush;
  76         v
  77       end
  78
  79   method delkey k =
  80     cache := !cache#delkey k;
  81     (* sometimes have not yet flushed, so may not be yet in, (could
  82      * also flush in place of doing try).
  83      *
  84      * TODO would be better to see if was in cache (in case mean that
  85      * perhaps not flushed and do try and in other case just cos del
  86      * (without try) cos forcement flushed ou was an error *)
  87     begin
  88       try wrapped := !wrapped#delkey k
  89       with Not_found -> ()
  90     end;
  91     dirty := !dirty#del k;
  92     o
  93
  94 end
  95
  96
  97 (*
  98 class ['a,'b] oassoc_cache cache cached max =
  99   object(o)
 100     inherit ['a,'b] oassoc
 101
 102     val full = ref 0
 103     val max = max
 104     val cache = cache
 105     val cached = cached
 106     val lru = TODO
 107
 108     val data = Hashtbl.create 100
 109
 110     method empty = raise Todo
 111     method add (k,v) = (Hashtbl.add data k v; o)
 112     method iter f = cached#iter f
 113     method view = raise Todo
 114
 115     method del (k,v) = (cache#del (k,v); cached#del (k,v); o)
 116     method mem e = raise Todo
 117     method null = raise Todo
 118
 119     method assoc k = Hashtbl.find data k
 120     method delkey k = (cache#delkey (k,v); cached#del (k,v); o)
 121 end
 122 *)
 123
 124