X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fcache.ml;fp=src%2Fcache.ml;h=f9b7457d827c1ad77163215ae000df116cae3466;hp=0000000000000000000000000000000000000000;hb=974dacbf4f625bfd8ea83db69d6b346050141fea;hpb=7e8fa6a1fcb2f6ea9e3639e8a3f0d199836796a5 diff --git a/src/cache.ml b/src/cache.ml new file mode 100644 index 0000000..f9b7457 --- /dev/null +++ b/src/cache.ml @@ -0,0 +1,323 @@ +(***********************************************************************) +(* *) +(* 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: +*) + +module N1 = +struct + type 'a t = { + mutable line : 'a array; + dummy : 'a; + mutable offset : int; + level : int; + } + type 'a index = int -> 'a + let level a = a.level + let create_with_level level a = { + line = Array.create 0 a; + dummy = a; + offset = ~-1; + level = level; + } + let create a = create_with_level 1 a + + 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 + + let stats a = + let d = dummy a in + let len = Array.length a.line in + let used = Array.fold_left (fun acc i -> + if i != d then acc+1 else acc) 0 a.line + in + len, used +end + +module N2 = +struct + type 'a t = 'a N1.t N1.t + let create_with_level level a = + let dummy1 = N1.create_with_level (level+1) a in + N1.create_with_level level dummy1 + + let create a = create_with_level 1 a + + let add a i j v = + let line = N1.find a i in + if line == N1.dummy a then + let nline = N1.create_with_level (a.N1.level+1) (N1.dummy line) 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 + + let stats a = + let d = a.N1.dummy in + let len, used = + Array.fold_left (fun ((alen,aused) as acc) i -> + if i != d then + let l, u = N1.stats i in + (alen+l, aused+u) + else + acc) (0, 0) a.N1.line + in + len, used + +end + +module N3 = +struct + type 'a t = 'a N2.t N1.t + + let create_with_level level a = + let dummy2 = N2.create_with_level (level+1) a in + N1.create_with_level (level) dummy2 + + let create a = create_with_level 1 a + + + let add a i j k v = + let line = N1.find a i in + if line == a.N1.dummy then + let nline = N2.create_with_level (a.N1.level+1) (N2.dummy line) 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 + + let stats a = + let d = a.N1.dummy in + let len, used = + Array.fold_left (fun ((alen,aused) as acc) i -> + if i != d then + let l, u = N2.stats i in + (alen+l, aused+u) + else + acc) (0, 0) a.N1.line + in + len, used + +end + +module N4 = +struct + type 'a t = 'a N3.t N1.t + + let create_with_level level a = + let dummy3 = N3.create_with_level (level+1) a in + N1.create_with_level (level) dummy3 + + let create a = create_with_level 1 a + + + 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_with_level (a.N1.level+1) (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 + + let stats a = + let d = a.N1.dummy in + let len, used = + Array.fold_left (fun ((alen,aused) as acc) i -> + if i != d then + let l, u = N3.stats i in + (alen+l, aused+u) + else + acc) (0, 0) a.N1.line + in + len, used + +end + +module N5 = +struct + type 'a t = 'a N4.t N1.t + + + let create_with_level level a = + let dummy4 = N4.create_with_level (level+1) a in + N1.create_with_level level dummy4 + + let create a = create_with_level 1 a + + 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_with_level (a.N1.level+1) (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 + + + let stats a = + let d = a.N1.dummy in + let len, used = + Array.fold_left (fun ((alen,aused) as acc) i -> + if i != d then + let l, u = N4.stats i in + (alen+l, aused+u) + else + acc) (0, 0) a.N1.line + in + len, used + +end + +module N6 = +struct + type 'a t = 'a N5.t N1.t + + let create_with_level level a = + let dummy5 = N5.create_with_level (level+1) a in + N1.create_with_level (level) dummy5 + + let create a = create_with_level 1 a + + 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_with_level (a.N1.level+1) (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 + + let stats a = + let d = a.N1.dummy in + let len, used = + Array.fold_left (fun ((alen,aused) as acc) i -> + if i != d then + let l, u = N5.stats i in + (alen+l, aused+u) + else + acc) (0, 0) a.N1.line + in + len, used + +end