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