src/cache.ml

   1
   2 let realloc l old_size new_size dummy =
   3   let l' = Array.create new_size dummy in
   4   for i = 0 to (min old_size new_size) - 1 do
   5     l'.(i) <- l.(i);
   6   done;
   7   l'
   8
   9 module Lvl1 =
  10 struct
  11   type 'a t = { mutable line : 'a array;
  12                 dummy : 'a;
  13                 mutable offset : int;
  14               }
  15   let create n a = {
  16     line = Array.create 0 a;
  17     dummy = a;
  18     offset = ~-1;
  19
  20   }
  21
  22   let print fmt a =
  23     Format.fprintf fmt "{ offset=%i;\n dummy=_;line=%a \n}\n%!"
  24       a.offset
  25       (Pretty.print_array ~sep:", " (fun fmt x ->
  26         if x==a.dummy then
  27           Format.fprintf fmt "%s" "D"
  28         else
  29           Format.fprintf fmt "%s" "E")) a.line
  30
  31   let add a i v =
  32     if a.offset == ~-1 then a.offset <- i;
  33     let offset = a.offset in
  34     let len = Array.length a.line in
  35     if i >= offset && i < offset + len then
  36       a.line.(i - offset) <- v
  37     else
  38       if i < offset then begin (* bottom resize *)
  39         let pad = offset - i in
  40         let nlen = len + pad in
  41         let narray = Array.create nlen a.dummy in
  42         for j = 0 to len - 1 do
  43           narray.(j+pad) <- a.line.(j)
  44         done;
  45         a.offset <- i;
  46         a.line <- narray;
  47         narray.(0) <- v;
  48       end else begin (* top resize *)
  49         (* preventively allocate the space for the following elements *)
  50         let nlen = ((i - offset + 1) lsl 1) + 1 in
  51         let narray = Array.create nlen a.dummy in
  52         for j = 0 to len - 1 do
  53           narray.(j) <- a.line.(j);
  54         done;
  55         narray.(i - offset) <- v;
  56         a.line <- narray
  57       end
  58
  59   let find a i =
  60     let offset = a.offset in
  61     let len = Array.length a.line in
  62     if i >= offset && i < offset + len then a.line.(i - offset)
  63     else a.dummy
  64
  65   let dummy a = a.dummy
  66
  67   let iteri f a =
  68     let line = a.line in
  69     if a.offset == ~-1 then () else
  70       for i = 0 to Array.length line - 1 do
  71         let v = line.(i) in
  72           f (i+a.offset) v (v==a.dummy)
  73       done
  74
  75
  76 end
  77
  78
  79
  80 module Lvl2 =
  81 struct
  82   type 'a t = 'a Lvl1.t Lvl1.t
  83   let create n a =
  84     let dummy1 = Lvl1.create 0 a in
  85     { Lvl1.line = Array.create n dummy1;
  86       Lvl1.offset = ~-1;
  87       Lvl1.dummy = dummy1;
  88     }
  89
  90
  91   let add a i j v =
  92     let line = Lvl1.find a i in
  93     if line == a.Lvl1.dummy then
  94       let nline = Lvl1.create 0 line.Lvl1.dummy in
  95       Lvl1.add a i nline;
  96       Lvl1.add nline j v
  97     else
  98       Lvl1.add line j v
  99
 100
 101   let find a i j =
 102     let v = Lvl1.find a i in
 103     if v == a.Lvl1.dummy then a.Lvl1.dummy.Lvl1.dummy
 104     else Lvl1.find v j
 105
 106
 107   let dummy c = c.Lvl1.dummy.Lvl1.dummy
 108
 109   let iteri f a =
 110     let line = a.Lvl1.line in
 111     if a.Lvl1.offset == ~-1 then () else
 112       for i = 0 to Array.length line - 1 do
 113         Lvl1.iteri (f i) line.(i)
 114       done
 115
 116
 117 end
 118
 119 module Lvl3 =
 120 struct
 121   type 'a t = 'a Lvl2.t Lvl1.t
 122
 123   let create n a =
 124   let dummy1 = Lvl2.create 512 a in
 125     { Lvl1.line = Array.create n dummy1;
 126       Lvl1.offset = ~-1;
 127       Lvl1.dummy = dummy1;
 128     }
 129
 130   let add a i j k v =
 131     let line = Lvl1.find a i in
 132     if line == a.Lvl1.dummy then
 133       let nline =  { line with Lvl1.offset = ~-1 } in
 134       Lvl2.add nline j k v;
 135       Lvl1.add a i nline
 136     else
 137       Lvl2.add line j k v
 138
 139   let find a i j k =
 140     let v = Lvl1.find a i in
 141     if v == a.Lvl1.dummy then Lvl2.dummy a.Lvl1.dummy
 142     else Lvl2.find v j k
 143
 144
 145   let dummy a = Lvl2.dummy a.Lvl1.dummy
 146   let iteri f a =
 147     let line = a.Lvl1.line in
 148     if a.Lvl1.offset == ~-1 then () else
 149       for i = 0 to Array.length line - 1 do
 150         Lvl2.iteri (f i) line.(i)
 151       done
 152
 153 end