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   let iteri f a =
  61     let line = a.line in
  62     if a.offset == ~-1 then () else
  63       for i = 0 to Array.length line - 1 do
  64         let v = a.(i)
  65           f (i+a.offset) v (v==a.dummy)
  66       done
  67 *)
  68
  69 end
  70
  71
  72
  73 module Lvl2 =
  74 struct
  75   type 'a t = 'a Lvl1.t Lvl1.t
  76   let create n a =
  77     let dummy1 = Lvl1.create 0 a in
  78     { Lvl1.line = Array.create n dummy1;
  79       Lvl1.offset = ~-1;
  80       Lvl1.dummy = dummy1;
  81     }
  82
  83
  84   let add a i j v =
  85     let line = Lvl1.find a i in
  86     if line == a.Lvl1.dummy then
  87       let nline =  { line with Lvl1.offset = ~-1 } in
  88       Lvl1.add nline j v;
  89       Lvl1.add a i nline
  90     else
  91       Lvl1.add line j v
  92
  93   let find a i j =
  94     let v = Lvl1.find a i in
  95     if v == a.Lvl1.dummy then a.Lvl1.dummy.Lvl1.dummy
  96     else Lvl1.find v j
  97
  98
  99   let dummy c = c.Lvl1.dummy.Lvl1.dummy
 100
 101 end
 102
 103 module Lvl3 =
 104 struct
 105   type 'a t = 'a Lvl2.t Lvl1.t
 106
 107   let create n a =
 108   let dummy1 = Lvl2.create 0 a in
 109     { Lvl1.line = Array.create n dummy1;
 110       Lvl1.offset = ~-1;
 111       Lvl1.dummy = dummy1;
 112     }
 113
 114   let add a i j k v =
 115     let line = Lvl1.find a i in
 116     if line == a.Lvl1.dummy then
 117       let nline =  { line with Lvl1.offset = ~-1 } in
 118       Lvl2.add nline j k v;
 119       Lvl1.add a i nline
 120     else
 121       Lvl2.add line j k v
 122
 123   let find a i j k =
 124     let v = Lvl1.find a i in
 125     if v == a.Lvl1.dummy then Lvl2.dummy a.Lvl1.dummy
 126     else Lvl2.find v j k
 127
 128
 129   let dummy a = Lvl2.dummy a.Lvl1.dummy
 130
 131 end