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-14 14:50:18 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     Array.unsafe_set l' i  (Array.unsafe_get 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 idx = i - a.offset in
  79     let len = Array.length a.line in
  80     if idx >= 0 && idx < len then
  81       Array.unsafe_get a.line idx
  82     else a.dummy
  83
  84   let dummy a = a.dummy
  85
  86   let iteri f a =
  87     let line = a.line in
  88     if a.offset == ~-1 then () else
  89       for i = 0 to Array.length line - 1 do
  90         let v = line.(i) in
  91           f (i+a.offset) v (v==a.dummy)
  92       done
  93
  94
  95 end
  96
  97 module N2 =
  98 struct
  99   type 'a t = 'a N1.t N1.t
 100   let create a =
 101     let dummy1 = N1.create a in
 102     N1.create dummy1
 103
 104   let add a i j v =
 105     let line = N1.find a i in
 106     if line == a.N1.dummy then
 107       let nline = N1.create line.N1.dummy in
 108       N1.add a i nline;
 109       N1.add nline j v
 110     else
 111       N1.add line j v
 112
 113
 114   let find a i j =
 115     let v = N1.find a i in
 116     if v == a.N1.dummy then v.N1.dummy
 117     else N1.find v j
 118
 119
 120   let dummy c = c.N1.dummy.N1.dummy
 121
 122   let iteri f a =
 123     let line = a.N1.line in
 124     if a.N1.offset == ~-1 then () else
 125       for i = 0 to Array.length line - 1 do
 126         N1.iteri (f i) line.(i)
 127       done
 128
 129
 130 end
 131
 132 module N3 =
 133 struct
 134   type 'a t = 'a N2.t N1.t
 135
 136   let create a =
 137     let dummy2 = N2.create a in
 138     N1.create dummy2
 139
 140   let add a i j k v =
 141     let line = N1.find a i in
 142     if line == a.N1.dummy then
 143       let nline =  N1.create line.N1.dummy in
 144       N1.add a i nline;
 145       N2.add nline j k v
 146     else
 147       N2.add line j k v
 148
 149   let find a i j k =
 150     let v = N1.find a i in
 151     if v == a.N1.dummy then N2.dummy v
 152     else N2.find v j k
 153
 154
 155   let dummy a = N2.dummy a.N1.dummy
 156   let iteri f a =
 157     let line = a.N1.line in
 158     if a.N1.offset == ~-1 then () else
 159       for i = 0 to Array.length line - 1 do
 160         N2.iteri (f i) line.(i)
 161       done
 162
 163 end
 164
 165 module N4 =
 166 struct
 167   type 'a t = 'a N3.t N1.t
 168
 169   let create a =
 170   let dummy3 = N3.create a in
 171   N1.create dummy3
 172
 173   let add a i j k l v =
 174     let line = N1.find a i in
 175     if line == N1.dummy a then
 176       let nline =  N3.create (N3.dummy line) in
 177       N1.add a i nline;
 178       N3.add nline j k l v
 179     else
 180       N3.add line j k l v
 181
 182   let find a i j k l =
 183     let v = N1.find a i in
 184     if v == (N1.dummy a) then N3.dummy v
 185     else N3.find v j k l
 186
 187
 188   let dummy a = N3.dummy (N1.dummy a)
 189   let iteri f a =
 190     N1.iteri (fun i v _ ->
 191       N3.iteri (fun j k l v2 b -> f i j k l v2 b) v ) a
 192
 193 end
 194
 195 module N5 =
 196 struct
 197   type 'a t = 'a N4.t N1.t
 198
 199   let create a =
 200     let dummy4 = N4.create a in
 201     N1.create dummy4
 202
 203   let add a i j k l m v =
 204     let line = N1.find a i in
 205     if line == (N1.dummy a) then
 206       let nline =  N4.create (N4.dummy line) in
 207       N1.add a i nline;
 208       N4.add nline j k l m v
 209     else
 210       N4.add line j k l m v
 211
 212   let find a i j k l m =
 213     let v = N1.find a i in
 214     if v == (N1.dummy a) then N4.dummy v
 215     else N4.find v j k l m
 216
 217
 218   let dummy a = N4.dummy (N1.dummy a)
 219   let iteri f a =
 220     N1.iteri (fun i v _ ->
 221       N4.iteri (fun j k l m v2 b -> f i j k l m v2 b) v
 222     ) a
 223 end
 224
 225 module N6 =
 226 struct
 227   type 'a t = 'a N5.t N1.t
 228
 229   let create a =
 230     let dummy5 = N5.create a in
 231     N1.create dummy5
 232
 233   let add a i j k l m n v =
 234     let line = N1.find a i in
 235     if line == N1.dummy a then
 236       let nline =  N5.create (N5.dummy line) in
 237       N1.add a i nline;
 238       N5.add nline j k l m n v
 239     else
 240       N5.add line j k l m n v
 241
 242   let find a i j k l m n =
 243     let v = N1.find a i in
 244     if v == N1.dummy a then N5.dummy v
 245     else N5.find v j k l m n
 246
 247
 248   let dummy a = N5.dummy (N1.dummy a)
 249   let iteri f a =
 250     N1.iteri (fun i v _  ->
 251       N5.iteri (fun j k l m n v2 b -> f i j k l m n v2 b) v
 252     ) a
 253 end