src/utils/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-13 18:17:13 CET by Kim Nguyen>
  18 *)
  19
  20 let realloc l old_size new_size dummy =
  21   let l' = Array.create new_size dummy in
  22   for i = 0 to (min old_size new_size) - 1 do
  23     l'.(i) <- l.(i);
  24   done;
  25   l'
  26
  27 module N1 =
  28 struct
  29   type 'a t = { mutable line : 'a array;
  30                 dummy : 'a;
  31                 mutable offset : int;
  32               }
  33   let create _ a = {
  34     line = Array.create 0 a;
  35     dummy = a;
  36     offset = ~-1;
  37
  38   }
  39
  40   let print fmt a =
  41     Format.fprintf fmt "{ offset=%i;\n dummy=_;line=%a \n}\n%!"
  42       a.offset
  43       (Pretty.print_array ~sep:", " (fun fmt x ->
  44         if x==a.dummy then
  45           Format.fprintf fmt "%s" "D"
  46         else
  47           Format.fprintf fmt "%s" "E")) a.line
  48
  49   let add a i v =
  50     if a.offset == ~-1 then a.offset <- i;
  51     let offset = a.offset in
  52     let len = Array.length a.line in
  53     if i >= offset && i < offset + len then
  54       a.line.(i - offset) <- v
  55     else
  56       if i < offset then begin (* bottom resize *)
  57         let pad = offset - i in
  58         let nlen = len + pad in
  59         let narray = Array.create nlen a.dummy in
  60         for j = 0 to len - 1 do
  61           narray.(j+pad) <- a.line.(j)
  62         done;
  63         a.offset <- i;
  64         a.line <- narray;
  65         narray.(0) <- v;
  66       end else begin (* top resize *)
  67         (* preventively allocate the space for the following elements *)
  68         let nlen = ((i - offset + 1) lsl 1) + 1 in
  69         let narray = Array.create nlen a.dummy in
  70         for j = 0 to len - 1 do
  71           narray.(j) <- a.line.(j);
  72         done;
  73         narray.(i - offset) <- v;
  74         a.line <- narray
  75       end
  76
  77   let find a i =
  78     let offset = a.offset in
  79     let len = Array.length a.line in
  80     if i >= offset && i < offset + len then a.line.(i - offset)
  81     else a.dummy
  82
  83   let dummy a = a.dummy
  84
  85   let iteri f a =
  86     let line = a.line in
  87     if a.offset == ~-1 then () else
  88       for i = 0 to Array.length line - 1 do
  89         let v = line.(i) in
  90           f (i+a.offset) v (v==a.dummy)
  91       done
  92
  93
  94 end
  95
  96
  97
  98 module N2 =
  99 struct
 100   type 'a t = 'a N1.t N1.t
 101   let create n a =
 102     let dummy1 = N1.create 512 a in
 103     { N1.line = Array.create n dummy1;
 104       N1.offset = ~-1;
 105       N1.dummy = dummy1;
 106     }
 107
 108
 109   let add a i j v =
 110     let line = N1.find a i in
 111     if line == a.N1.dummy then
 112       let nline = N1.create 0 line.N1.dummy in
 113       N1.add a i nline;
 114       N1.add nline j v
 115     else
 116       N1.add line j v
 117
 118
 119   let find a i j =
 120     let v = N1.find a i in
 121     if v == a.N1.dummy then a.N1.dummy.N1.dummy
 122     else N1.find v j
 123
 124
 125   let dummy c = c.N1.dummy.N1.dummy
 126
 127   let iteri f a =
 128     let line = a.N1.line in
 129     if a.N1.offset == ~-1 then () else
 130       for i = 0 to Array.length line - 1 do
 131         N1.iteri (f i) line.(i)
 132       done
 133
 134
 135 end
 136
 137 module N3 =
 138 struct
 139   type 'a t = 'a N2.t N1.t
 140
 141   let create n a =
 142   let dummy1 = N2.create 512 a in
 143     { N1.line = Array.create n dummy1;
 144       N1.offset = ~-1;
 145       N1.dummy = dummy1;
 146     }
 147
 148   let add a i j k v =
 149     let line = N1.find a i in
 150     if line == a.N1.dummy then
 151       let nline =  N1.create 0 line.N1.dummy in
 152       N1.add a i nline;
 153       N2.add nline j k v
 154     else
 155       N2.add line j k v
 156
 157   let find a i j k =
 158     let v = N1.find a i in
 159     if v == a.N1.dummy then N2.dummy a.N1.dummy
 160     else N2.find v j k
 161
 162
 163   let dummy a = N2.dummy a.N1.dummy
 164   let iteri f a =
 165     let line = a.N1.line in
 166     if a.N1.offset == ~-1 then () else
 167       for i = 0 to Array.length line - 1 do
 168         N2.iteri (f i) line.(i)
 169       done
 170
 171 end
 172
 173 module N4 =
 174 struct
 175   type 'a t = 'a N3.t N1.t
 176
 177   let create n a =
 178   let dummy1 = N3.create 512 a in
 179     { N1.line = Array.create n dummy1;
 180       N1.offset = ~-1;
 181       N1.dummy = dummy1;
 182     }
 183
 184   let add a i j k l v =
 185     let line = N1.find a i in
 186     if line == a.N1.dummy then
 187       let nline =  N1.create 0 line.N1.dummy in
 188       N1.add a i nline;
 189       N3.add nline j k l v
 190     else
 191       N3.add line j k l v
 192
 193   let find a i j k l =
 194     let v = N1.find a i in
 195     if v == a.N1.dummy then N3.dummy a.N1.dummy
 196     else N3.find v j k l
 197
 198
 199   let dummy a = N3.dummy a.N1.dummy
 200   let iteri f a =
 201     let line = a.N1.line in
 202     if a.N1.offset == ~-1 then () else
 203       for i = 0 to Array.length line - 1 do
 204         N3.iteri (f i) line.(i)
 205       done
 206
 207 end
 208
 209 module N5 =
 210 struct
 211   type 'a t = 'a N4.t N1.t
 212
 213   let create n a =
 214   let dummy1 = N4.create 512 a in
 215     { N1.line = Array.create n dummy1;
 216       N1.offset = ~-1;
 217       N1.dummy = dummy1;
 218     }
 219
 220   let add a i j k l m v =
 221     let line = N1.find a i in
 222     if line == a.N1.dummy then
 223       let nline =  N1.create 0 line.N1.dummy in
 224       N1.add a i nline;
 225       N4.add nline j k l m v
 226     else
 227       N4.add line j k l m v
 228
 229   let find a i j k l m =
 230     let v = N1.find a i in
 231     if v == a.N1.dummy then N4.dummy a.N1.dummy
 232     else N4.find v j k l m
 233
 234
 235   let dummy a = N4.dummy a.N1.dummy
 236   let iteri f a =
 237     let line = a.N1.line in
 238     if a.N1.offset == ~-1 then () else
 239       for i = 0 to Array.length line - 1 do
 240         N4.iteri (f i) line.(i)
 241       done
 242
 243 end
 244
 245 module N6 =
 246 struct
 247   type 'a t = 'a N3.t N3.t
 248
 249   let create _n a =
 250          let dummy1 = N3.create 512 a in
 251          N3.create 512 dummy1
 252
 253   let add a i j k l m n v =
 254     let line = N3.find a i j k in
 255     if line == N3.dummy a then
 256       let nline =  N3.create 0 (N3.dummy line) in
 257       N3.add a i j k nline;
 258       N3.add nline l m n v
 259     else
 260       N3.add line l m n v
 261
 262   let find a i j k l m n =
 263     let v = N3.find a i j k in
 264     if v == N3.dummy a then N3.dummy (N3.dummy a)
 265     else N3.find v l m n
 266
 267
 268   let dummy a = N3.dummy (N3.dummy a)
 269   let iteri _f _a = assert false
 270 end