src/cache.ml

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