src/cache.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                               TAToo                                 *)
   4 (*                                                                     *)
   5 (*                     Kim Nguyen, LRI UMR8623                         *)
   6 (*                   Université Paris-Sud & CNRS                       *)
   7 (*                                                                     *)
   8 (*  Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
   9 (*  Recherche Scientifique. All rights reserved.  This file is         *)
  10 (*  distributed under the terms of the GNU Lesser General Public       *)
  11 (*  License, with the special exception on linking described in file   *)
  12 (*  ../LICENSE.                                                        *)
  13 (*                                                                     *)
  14 (***********************************************************************)
  15
  16 (*
  17   Time-stamp: <Last modified on 2013-03-18 22:41:45 CET by Kim Nguyen>
  18 *)
  19
  20 module N1 =
  21 struct
  22   type 'a t = {
  23     mutable line : 'a array;
  24     dummy : 'a;
  25     mutable offset : int;
  26     level : int;
  27   }
  28   type 'a index = int -> 'a
  29   let level a = a.level
  30   let create_with_level level a = {
  31     line = Array.create 0 a;
  32     dummy = a;
  33     offset = ~-1;
  34     level = level;
  35   }
  36   let create a = create_with_level 1 a
  37
  38   let add a i v =
  39     if a.offset == ~-1 then a.offset <- i;
  40     let offset = a.offset in
  41     let len = Array.length a.line in
  42     if i >= offset && i < offset + len then
  43       a.line.(i - offset) <- v
  44     else
  45       if i < offset then begin (* bottom resize *)
  46         let pad = offset - i in
  47         let nlen = len + pad in
  48         let narray = Array.create nlen a.dummy in
  49         for j = 0 to len - 1 do
  50           narray.(j+pad) <- a.line.(j)
  51         done;
  52         a.offset <- i;
  53         a.line <- narray;
  54         narray.(0) <- v;
  55       end else begin (* top resize *)
  56         (* preventively allocate the space for the following elements *)
  57         let nlen = ((i - offset + 1) lsl 1) + 1 in
  58         let narray = Array.create nlen a.dummy in
  59         for j = 0 to len - 1 do
  60           narray.(j) <- a.line.(j);
  61         done;
  62         narray.(i - offset) <- v;
  63         a.line <- narray
  64       end
  65
  66   let find a i =
  67     let idx = i - a.offset in
  68     let len = Array.length a.line in
  69     if idx >= 0 && idx < len then
  70       Array.unsafe_get a.line idx
  71     else a.dummy
  72
  73   let dummy a = a.dummy
  74
  75   let iteri f a =
  76     let line = a.line in
  77     if a.offset == ~-1 then () else
  78       for i = 0 to Array.length line - 1 do
  79         let v = line.(i) in
  80           f (i+a.offset) v (v==a.dummy)
  81       done
  82
  83   let stats a =
  84     let d = dummy a in
  85     let len = Array.length a.line in
  86     let used = Array.fold_left (fun acc i ->
  87       if i != d then acc+1 else acc) 0 a.line
  88     in
  89     len, used
  90 end
  91
  92 module N2 =
  93 struct
  94   type 'a t = 'a N1.t N1.t
  95   let create_with_level level a =
  96     let dummy1 = N1.create_with_level (level+1) a in
  97     N1.create_with_level level dummy1
  98
  99   let create a = create_with_level 1 a
 100
 101   let add a i j v =
 102     let line = N1.find a i in
 103     if line == N1.dummy a then
 104       let nline = N1.create_with_level (a.N1.level+1) (N1.dummy line) in
 105       N1.add a i nline;
 106       N1.add nline j v
 107     else
 108       N1.add line j v
 109
 110
 111   let find a i j =
 112     let v = N1.find a i in
 113     if v == a.N1.dummy then v.N1.dummy
 114     else N1.find v j
 115
 116
 117   let dummy c = c.N1.dummy.N1.dummy
 118
 119   let iteri f a =
 120     let line = a.N1.line in
 121     if a.N1.offset == ~-1 then () else
 122       for i = 0 to Array.length line - 1 do
 123         N1.iteri (f i) line.(i)
 124       done
 125
 126   let stats a =
 127     let d = a.N1.dummy in
 128     let len, used =
 129       Array.fold_left (fun ((alen,aused) as acc) i ->
 130         if i != d then
 131           let l, u = N1.stats i in
 132           (alen+l, aused+u)
 133         else
 134           acc) (0, 0) a.N1.line
 135     in
 136     len, used
 137
 138 end
 139
 140 module N3 =
 141 struct
 142   type 'a t = 'a N2.t N1.t
 143
 144   let create_with_level level a =
 145     let dummy2 = N2.create_with_level (level+1) a in
 146     N1.create_with_level (level) dummy2
 147
 148   let create a = create_with_level 1 a
 149
 150
 151   let add a i j k v =
 152     let line = N1.find a i in
 153     if line == a.N1.dummy then
 154       let nline = N2.create_with_level (a.N1.level+1) (N2.dummy line) in
 155       N1.add a i nline;
 156       N2.add nline j k v
 157     else
 158       N2.add line j k v
 159
 160   let find a i j k =
 161     let v = N1.find a i in
 162     if v == a.N1.dummy then N2.dummy v
 163     else N2.find v j k
 164
 165
 166   let dummy a = N2.dummy a.N1.dummy
 167   let iteri f a =
 168     let line = a.N1.line in
 169     if a.N1.offset == ~-1 then () else
 170       for i = 0 to Array.length line - 1 do
 171         N2.iteri (f i) line.(i)
 172       done
 173
 174   let stats a =
 175     let d = a.N1.dummy in
 176     let len, used =
 177       Array.fold_left (fun ((alen,aused) as acc) i ->
 178         if i != d then
 179           let l, u = N2.stats i in
 180           (alen+l, aused+u)
 181         else
 182           acc) (0, 0) a.N1.line
 183     in
 184     len, used
 185
 186 end
 187
 188 module N4 =
 189 struct
 190   type 'a t = 'a N3.t N1.t
 191
 192   let create_with_level level a =
 193     let dummy3 = N3.create_with_level (level+1) a in
 194     N1.create_with_level (level) dummy3
 195
 196   let create a = create_with_level 1 a
 197
 198
 199   let add a i j k l v =
 200     let line = N1.find a i in
 201     if line == N1.dummy a then
 202       let nline =  N3.create_with_level (a.N1.level+1) (N3.dummy line) in
 203       N1.add a i nline;
 204       N3.add nline j k l v
 205     else
 206       N3.add line j k l v
 207
 208   let find a i j k l =
 209     let v = N1.find a i in
 210     if v == (N1.dummy a) then N3.dummy v
 211     else N3.find v j k l
 212
 213
 214   let dummy a = N3.dummy (N1.dummy a)
 215   let iteri f a =
 216     N1.iteri (fun i v _ ->
 217       N3.iteri (fun j k l v2 b -> f i j k l v2 b) v ) a
 218
 219   let stats a =
 220     let d = a.N1.dummy in
 221     let len, used =
 222       Array.fold_left (fun ((alen,aused) as acc) i ->
 223         if i != d then
 224           let l, u = N3.stats i in
 225           (alen+l, aused+u)
 226         else
 227           acc) (0, 0) a.N1.line
 228     in
 229     len, used
 230
 231 end
 232
 233 module N5 =
 234 struct
 235   type 'a t = 'a N4.t N1.t
 236
 237
 238   let create_with_level level a =
 239     let dummy4 = N4.create_with_level (level+1) a in
 240     N1.create_with_level level dummy4
 241
 242   let create a = create_with_level 1 a
 243
 244   let add a i j k l m v =
 245     let line = N1.find a i in
 246     if line == (N1.dummy a) then
 247       let nline =  N4.create_with_level (a.N1.level+1) (N4.dummy line) in
 248       N1.add a i nline;
 249       N4.add nline j k l m v
 250     else
 251       N4.add line j k l m v
 252
 253   let find a i j k l m =
 254     let v = N1.find a i in
 255     if v == (N1.dummy a) then N4.dummy v
 256     else N4.find v j k l m
 257
 258
 259   let dummy a = N4.dummy (N1.dummy a)
 260   let iteri f a =
 261     N1.iteri (fun i v _ ->
 262       N4.iteri (fun j k l m v2 b -> f i j k l m v2 b) v
 263     ) a
 264
 265
 266   let stats a =
 267     let d = a.N1.dummy in
 268     let len, used =
 269       Array.fold_left (fun ((alen,aused) as acc) i ->
 270         if i != d then
 271           let l, u = N4.stats i in
 272           (alen+l, aused+u)
 273         else
 274           acc) (0, 0) a.N1.line
 275     in
 276     len, used
 277
 278 end
 279
 280 module N6 =
 281 struct
 282   type 'a t = 'a N5.t N1.t
 283
 284   let create_with_level level a =
 285     let dummy5 = N5.create_with_level (level+1) a in
 286     N1.create_with_level (level) dummy5
 287
 288   let create a = create_with_level 1 a
 289
 290   let add a i j k l m n v =
 291     let line = N1.find a i in
 292     if line == N1.dummy a then
 293       let nline = N5.create_with_level (a.N1.level+1) (N5.dummy line) in
 294       N1.add a i nline;
 295       N5.add nline j k l m n v
 296     else
 297       N5.add line j k l m n v
 298
 299   let find a i j k l m n =
 300     let v = N1.find a i in
 301     if v == N1.dummy a then N5.dummy v
 302     else N5.find v j k l m n
 303
 304
 305   let dummy a = N5.dummy (N1.dummy a)
 306   let iteri f a =
 307     N1.iteri (fun i v _  ->
 308       N5.iteri (fun j k l m n v2 b -> f i j k l m n v2 b) v
 309     ) a
 310
 311   let stats a =
 312     let d = a.N1.dummy in
 313     let len, used =
 314       Array.fold_left (fun ((alen,aused) as acc) i ->
 315         if i != d then
 316           let l, u = N5.stats i in
 317           (alen+l, aused+u)
 318         else
 319           acc) (0, 0) a.N1.line
 320     in
 321     len, used
 322
 323 end