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 module N1 =
  17 struct
  18   type 'a t = {
  19     mutable line : 'a array;
  20     dummy : 'a;
  21     mutable offset : int;
  22     level : int;
  23   }
  24   type 'a index = int -> 'a
  25   let level a = a.level
  26   let create_with_level level a = {
  27     line = Array.create 0 a;
  28     dummy = a;
  29     offset = ~-1;
  30     level = level;
  31   }
  32   let create a = create_with_level 1 a
  33
  34   let add a i v =
  35     if a.offset == ~-1 then a.offset <- i;
  36     let offset = a.offset in
  37     let len = Array.length a.line in
  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
  62   let find a i =
  63     let idx = i - a.offset in
  64     let len = Array.length a.line in
  65     if idx >= 0 && idx < len then
  66       Array.unsafe_get a.line idx
  67     else a.dummy
  68
  69   let dummy a = a.dummy
  70
  71   let iteri f a =
  72     let line = a.line in
  73     if a.offset == ~-1 then () else
  74       for i = 0 to Array.length line - 1 do
  75         let v = line.(i) in
  76           f (i+a.offset) v (v==a.dummy)
  77       done
  78
  79   let stats a =
  80     let d = dummy a in
  81     let len = Array.length a.line in
  82     let used = Array.fold_left (fun acc i ->
  83       if i != d then acc+1 else acc) 0 a.line
  84     in
  85     len, used
  86 end
  87
  88 module N2 =
  89 struct
  90   type 'a t = 'a N1.t N1.t
  91   let create_with_level level a =
  92     let dummy1 = N1.create_with_level (level+1) a in
  93     N1.create_with_level level dummy1
  94
  95   let create a = create_with_level 1 a
  96
  97   let add a i j v =
  98     let line = N1.find a i in
  99     if line == N1.dummy a then
 100       let nline = N1.create_with_level (a.N1.level+1) (N1.dummy line) in
 101       N1.add a i nline;
 102       N1.add nline j v
 103     else
 104       N1.add line j v
 105
 106
 107   let find a i j =
 108     let v = N1.find a i in
 109     if v == a.N1.dummy then v.N1.dummy
 110     else N1.find v j
 111
 112
 113   let dummy c = c.N1.dummy.N1.dummy
 114
 115   let iteri f a =
 116     let line = a.N1.line in
 117     if a.N1.offset == ~-1 then () else
 118       for i = 0 to Array.length line - 1 do
 119         N1.iteri (f i) line.(i)
 120       done
 121
 122   let stats a =
 123     let d = a.N1.dummy in
 124     let len, used =
 125       Array.fold_left (fun ((alen,aused) as acc) i ->
 126         if i != d then
 127           let l, u = N1.stats i in
 128           (alen+l, aused+u)
 129         else
 130           acc) (0, 0) a.N1.line
 131     in
 132     len, used
 133
 134 end
 135
 136 module N3 =
 137 struct
 138   type 'a t = 'a N2.t N1.t
 139
 140   let create_with_level level a =
 141     let dummy2 = N2.create_with_level (level+1) a in
 142     N1.create_with_level (level) dummy2
 143
 144   let create a = create_with_level 1 a
 145
 146
 147   let add a i j k v =
 148     let line = N1.find a i in
 149     if line == a.N1.dummy then
 150       let nline = N2.create_with_level (a.N1.level+1) (N2.dummy line) in
 151       N1.add a i nline;
 152       N2.add nline j k v
 153     else
 154       N2.add line j k v
 155
 156   let find a i j k =
 157     let v = N1.find a i in
 158     if v == a.N1.dummy then N2.dummy v
 159     else N2.find v j k
 160
 161
 162   let dummy a = N2.dummy a.N1.dummy
 163   let iteri f a =
 164     let line = a.N1.line in
 165     if a.N1.offset == ~-1 then () else
 166       for i = 0 to Array.length line - 1 do
 167         N2.iteri (f i) line.(i)
 168       done
 169
 170   let stats a =
 171     let d = a.N1.dummy in
 172     let len, used =
 173       Array.fold_left (fun ((alen,aused) as acc) i ->
 174         if i != d then
 175           let l, u = N2.stats i in
 176           (alen+l, aused+u)
 177         else
 178           acc) (0, 0) a.N1.line
 179     in
 180     len, used
 181
 182 end
 183
 184 module N4 =
 185 struct
 186   type 'a t = 'a N3.t N1.t
 187
 188   let create_with_level level a =
 189     let dummy3 = N3.create_with_level (level+1) a in
 190     N1.create_with_level (level) dummy3
 191
 192   let create a = create_with_level 1 a
 193
 194
 195   let add a i j k l v =
 196     let line = N1.find a i in
 197     if line == N1.dummy a then
 198       let nline =  N3.create_with_level (a.N1.level+1) (N3.dummy line) in
 199       N1.add a i nline;
 200       N3.add nline j k l v
 201     else
 202       N3.add line j k l v
 203
 204   let find a i j k l =
 205     let v = N1.find a i in
 206     if v == (N1.dummy a) then N3.dummy v
 207     else N3.find v j k l
 208
 209
 210   let dummy a = N3.dummy (N1.dummy a)
 211   let iteri f a =
 212     N1.iteri (fun i v _ ->
 213       N3.iteri (fun j k l v2 b -> f i j k l v2 b) v ) a
 214
 215   let stats a =
 216     let d = a.N1.dummy in
 217     let len, used =
 218       Array.fold_left (fun ((alen,aused) as acc) i ->
 219         if i != d then
 220           let l, u = N3.stats i in
 221           (alen+l, aused+u)
 222         else
 223           acc) (0, 0) a.N1.line
 224     in
 225     len, used
 226
 227 end
 228
 229 module N5 =
 230 struct
 231   type 'a t = 'a N4.t N1.t
 232
 233
 234   let create_with_level level a =
 235     let dummy4 = N4.create_with_level (level+1) a in
 236     N1.create_with_level level dummy4
 237
 238   let create a = create_with_level 1 a
 239
 240   let add a i j k l m v =
 241     let line = N1.find a i in
 242     if line == (N1.dummy a) then
 243       let nline =  N4.create_with_level (a.N1.level+1) (N4.dummy line) in
 244       N1.add a i nline;
 245       N4.add nline j k l m v
 246     else
 247       N4.add line j k l m v
 248
 249   let find a i j k l m =
 250     let v = N1.find a i in
 251     if v == (N1.dummy a) then N4.dummy v
 252     else N4.find v j k l m
 253
 254
 255   let dummy a = N4.dummy (N1.dummy a)
 256   let iteri f a =
 257     N1.iteri (fun i v _ ->
 258       N4.iteri (fun j k l m v2 b -> f i j k l m v2 b) v
 259     ) a
 260
 261
 262   let stats a =
 263     let d = a.N1.dummy in
 264     let len, used =
 265       Array.fold_left (fun ((alen,aused) as acc) i ->
 266         if i != d then
 267           let l, u = N4.stats i in
 268           (alen+l, aused+u)
 269         else
 270           acc) (0, 0) a.N1.line
 271     in
 272     len, used
 273
 274 end
 275
 276 module N6 =
 277 struct
 278   type 'a t = 'a N5.t N1.t
 279
 280   let create_with_level level a =
 281     let dummy5 = N5.create_with_level (level+1) a in
 282     N1.create_with_level (level) dummy5
 283
 284   let create a = create_with_level 1 a
 285
 286   let add a i j k l m n v =
 287     let line = N1.find a i in
 288     if line == N1.dummy a then
 289       let nline = N5.create_with_level (a.N1.level+1) (N5.dummy line) in
 290       N1.add a i nline;
 291       N5.add nline j k l m n v
 292     else
 293       N5.add line j k l m n v
 294
 295   let find a i j k l m n =
 296     let v = N1.find a i in
 297     if v == N1.dummy a then N5.dummy v
 298     else N5.find v j k l m n
 299
 300
 301   let dummy a = N5.dummy (N1.dummy a)
 302   let iteri f a =
 303     N1.iteri (fun i v _  ->
 304       N5.iteri (fun j k l m n v2 b -> f i j k l m n v2 b) v
 305     ) a
 306
 307   let stats a =
 308     let d = a.N1.dummy in
 309     let len, used =
 310       Array.fold_left (fun ((alen,aused) as acc) i ->
 311         if i != d then
 312           let l, u = N5.stats i in
 313           (alen+l, aused+u)
 314         else
 315           acc) (0, 0) a.N1.line
 316     in
 317     len, used
 318
 319 end