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