src/cache.ml

   1 INCLUDE "trace.ml"
   2
   3 let realloc l old_size new_size dummy =
   4   let l' = Array.create new_size dummy in
   5   for i = 0 to (min old_size new_size) - 1 do
   6     l'.(i) <- l.(i);
   7   done;
   8   l'
   9
  10 module Lvl1 =
  11 struct
  12   type 'a t = { mutable line : 'a array;
  13                 dummy : 'a;
  14                 mutable offset : int;
  15               }
  16   let create n a = {
  17     line = Array.create 0 a;
  18     dummy = a;
  19     offset = ~-1;
  20
  21   }
  22
  23
  24   let add a i v =
  25     if a.offset == ~-1 then a.offset <- i;
  26     let offset = a.offset in
  27     let len = Array.length a.line in
  28     if i >= offset && i < offset + len then
  29       a.line.(i - offset) <- v
  30     else
  31       if i < offset then begin (* bottom resize *)
  32         let pad = offset - i in
  33         let nlen = len + pad in
  34         let narray = Array.create nlen a.dummy in
  35         for j = 0 to len - 1 do
  36           narray.(j+pad) <- a.line.(j)
  37         done;
  38         a.offset <- i;
  39         a.line <- narray;
  40         narray.(0) <- v;
  41       end else begin (* top resize *)
  42         (* preventively allocate the space for the following elements *)
  43         let nlen = ((i - offset + 1) lsl 1) + 1 in
  44         let narray = Array.create nlen a.dummy in
  45         for j = 0 to len - 1 do
  46           narray.(j) <- a.line.(j);
  47         done;
  48         narray.(i - offset + 1) <- v;
  49         a.line <- narray
  50       end
  51
  52   let find a i =
  53     let offset = a.offset in
  54     let len = Array.length a.line in
  55     if i >= offset && i < offset + len then a.line.(i - offset)
  56     else a.dummy
  57
  58   let dummy a = a.dummy
  59
  60 end
  61
  62
  63
  64 module Lvl2 =
  65 struct
  66   type 'a t = 'a Lvl1.t Lvl1.t
  67   let create n a =
  68     let dummy1 = Lvl1.create 0 a in
  69     { Lvl1.line = Array.create n dummy1;
  70       Lvl1.offset = ~-1;
  71       Lvl1.dummy = dummy1;
  72     }
  73
  74
  75   let add a i j v =
  76     let line = Lvl1.find a i in
  77     if line == a.Lvl1.dummy then
  78       let nline =  { line with Lvl1.offset = ~-1 } in
  79       Lvl1.add nline j v;
  80       Lvl1.add a i nline
  81     else
  82       Lvl1.add line j v
  83
  84   let find a i j =
  85     let v = Lvl1.find a i in
  86     if v == a.Lvl1.dummy then a.Lvl1.dummy.Lvl1.dummy
  87     else Lvl1.find v j
  88
  89
  90   let dummy c = c.Lvl1.dummy.Lvl1.dummy
  91
  92 end
  93
  94 module Lvl3 =
  95 struct
  96   type 'a t = 'a Lvl2.t Lvl1.t
  97
  98   let create n a =
  99   let dummy1 = Lvl2.create 0 a in
 100     { Lvl1.line = Array.create n dummy1;
 101       Lvl1.offset = ~-1;
 102       Lvl1.dummy = dummy1;
 103     }
 104
 105   let add a i j k v =
 106     let line = Lvl1.find a i in
 107     if line == a.Lvl1.dummy then
 108       let nline =  { line with Lvl1.offset = ~-1 } in
 109       Lvl2.add nline j k v;
 110       Lvl1.add a i nline
 111     else
 112       Lvl2.add line j k v
 113
 114   let find a i j k =
 115     let v = Lvl1.find a i in
 116     if v == a.Lvl1.dummy then Lvl2.dummy a.Lvl1.dummy
 117     else Lvl2.find v j k
 118
 119
 120   let dummy a = Lvl2.dummy a.Lvl1.dummy
 121
 122 end