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