X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fcache.ml;fp=src%2Fcache.ml;h=abd999e50e2f8a3c8b274f4aa6d8442bfd15575d;hp=0000000000000000000000000000000000000000;hb=b00bff88c7902e828804c06b7f9dc55222fdc84e;hpb=03b6a364e7240ca827585e7baff225a0aaa33bc6 diff --git a/src/cache.ml b/src/cache.ml new file mode 100644 index 0000000..abd999e --- /dev/null +++ b/src/cache.ml @@ -0,0 +1,253 @@ +(***********************************************************************) +(* *) +(* TAToo *) +(* *) +(* Kim Nguyen, LRI UMR8623 *) +(* Université Paris-Sud & CNRS *) +(* *) +(* Copyright 2010-2013 Université Paris-Sud and Centre National de la *) +(* Recherche Scientifique. All rights reserved. This file is *) +(* distributed under the terms of the GNU Lesser General Public *) +(* License, with the special exception on linking described in file *) +(* ../LICENSE. *) +(* *) +(***********************************************************************) + +(* + Time-stamp: +*) + +let realloc l old_size new_size dummy = + let l' = Array.create new_size dummy in + for i = 0 to (min old_size new_size) - 1 do + Array.unsafe_set l' i (Array.unsafe_get l i); + done; + l' + +module N1 = +struct + type 'a t = { mutable line : 'a array; + dummy : 'a; + mutable offset : int; + } + let create a = { + line = Array.create 0 a; + dummy = a; + offset = ~-1; + + } + + let print fmt a = + Format.fprintf fmt "{ offset=%i;\n dummy=_;line=%a \n}\n%!" + a.offset + (Pretty.print_array ~sep:", " (fun fmt x -> + if x==a.dummy then + Format.fprintf fmt "%s" "D" + else + Format.fprintf fmt "%s" "E")) a.line + + let add a i v = + if a.offset == ~-1 then a.offset <- i; + let offset = a.offset in + let len = Array.length a.line in + if i >= offset && i < offset + len then + a.line.(i - offset) <- v + else + if i < offset then begin (* bottom resize *) + let pad = offset - i in + let nlen = len + pad in + let narray = Array.create nlen a.dummy in + for j = 0 to len - 1 do + narray.(j+pad) <- a.line.(j) + done; + a.offset <- i; + a.line <- narray; + narray.(0) <- v; + end else begin (* top resize *) + (* preventively allocate the space for the following elements *) + let nlen = ((i - offset + 1) lsl 1) + 1 in + let narray = Array.create nlen a.dummy in + for j = 0 to len - 1 do + narray.(j) <- a.line.(j); + done; + narray.(i - offset) <- v; + a.line <- narray + end + + let find a i = + let idx = i - a.offset in + let len = Array.length a.line in + if idx >= 0 && idx < len then + Array.unsafe_get a.line idx + else a.dummy + + let dummy a = a.dummy + + let iteri f a = + let line = a.line in + if a.offset == ~-1 then () else + for i = 0 to Array.length line - 1 do + let v = line.(i) in + f (i+a.offset) v (v==a.dummy) + done + + +end + +module N2 = +struct + type 'a t = 'a N1.t N1.t + let create a = + let dummy1 = N1.create a in + N1.create dummy1 + + let add a i j v = + let line = N1.find a i in + if line == a.N1.dummy then + let nline = N1.create line.N1.dummy in + N1.add a i nline; + N1.add nline j v + else + N1.add line j v + + + let find a i j = + let v = N1.find a i in + if v == a.N1.dummy then v.N1.dummy + else N1.find v j + + + let dummy c = c.N1.dummy.N1.dummy + + let iteri f a = + let line = a.N1.line in + if a.N1.offset == ~-1 then () else + for i = 0 to Array.length line - 1 do + N1.iteri (f i) line.(i) + done + + +end + +module N3 = +struct + type 'a t = 'a N2.t N1.t + + let create a = + let dummy2 = N2.create a in + N1.create dummy2 + + let add a i j k v = + let line = N1.find a i in + if line == a.N1.dummy then + let nline = N1.create line.N1.dummy in + N1.add a i nline; + N2.add nline j k v + else + N2.add line j k v + + let find a i j k = + let v = N1.find a i in + if v == a.N1.dummy then N2.dummy v + else N2.find v j k + + + let dummy a = N2.dummy a.N1.dummy + let iteri f a = + let line = a.N1.line in + if a.N1.offset == ~-1 then () else + for i = 0 to Array.length line - 1 do + N2.iteri (f i) line.(i) + done + +end + +module N4 = +struct + type 'a t = 'a N3.t N1.t + + let create a = + let dummy3 = N3.create a in + N1.create dummy3 + + let add a i j k l v = + let line = N1.find a i in + if line == N1.dummy a then + let nline = N3.create (N3.dummy line) in + N1.add a i nline; + N3.add nline j k l v + else + N3.add line j k l v + + let find a i j k l = + let v = N1.find a i in + if v == (N1.dummy a) then N3.dummy v + else N3.find v j k l + + + let dummy a = N3.dummy (N1.dummy a) + let iteri f a = + N1.iteri (fun i v _ -> + N3.iteri (fun j k l v2 b -> f i j k l v2 b) v ) a + +end + +module N5 = +struct + type 'a t = 'a N4.t N1.t + + let create a = + let dummy4 = N4.create a in + N1.create dummy4 + + let add a i j k l m v = + let line = N1.find a i in + if line == (N1.dummy a) then + let nline = N4.create (N4.dummy line) in + N1.add a i nline; + N4.add nline j k l m v + else + N4.add line j k l m v + + let find a i j k l m = + let v = N1.find a i in + if v == (N1.dummy a) then N4.dummy v + else N4.find v j k l m + + + let dummy a = N4.dummy (N1.dummy a) + let iteri f a = + N1.iteri (fun i v _ -> + N4.iteri (fun j k l m v2 b -> f i j k l m v2 b) v + ) a +end + +module N6 = +struct + type 'a t = 'a N5.t N1.t + + let create a = + let dummy5 = N5.create a in + N1.create dummy5 + + let add a i j k l m n v = + let line = N1.find a i in + if line == N1.dummy a then + let nline = N5.create (N5.dummy line) in + N1.add a i nline; + N5.add nline j k l m n v + else + N5.add line j k l m n v + + let find a i j k l m n = + let v = N1.find a i in + if v == N1.dummy a then N5.dummy v + else N5.find v j k l m n + + + let dummy a = N5.dummy (N1.dummy a) + let iteri f a = + N1.iteri (fun i v _ -> + N5.iteri (fun j k l m n v2 b -> f i j k l m n v2 b) v + ) a +end