X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fcache.ml;h=e5ee4343e7b248fd56c328881dff932813dc67ab;hp=abd999e50e2f8a3c8b274f4aa6d8442bfd15575d;hb=4f265eb7d78b740292b5543d94f9f0fa40d206d5;hpb=b00bff88c7902e828804c06b7f9dc55222fdc84e diff --git a/src/cache.ml b/src/cache.ml index abd999e..e5ee434 100644 --- a/src/cache.ml +++ b/src/cache.ml @@ -13,38 +13,23 @@ (* *) (***********************************************************************) -(* - 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; + 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.make 0 a; dummy = a; offset = ~-1; - + level = level; } - - 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 create a = create_with_level 1 a let add a i v = if a.offset == ~-1 then a.offset <- i; @@ -56,7 +41,7 @@ struct 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 + let narray = Array.make nlen a.dummy in for j = 0 to len - 1 do narray.(j+pad) <- a.line.(j) done; @@ -66,7 +51,7 @@ struct 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 + let narray = Array.make nlen a.dummy in for j = 0 to len - 1 do narray.(j) <- a.line.(j); done; @@ -76,10 +61,12 @@ struct 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 + if idx < 0 then a.dummy + else + let len = Array.length a.line in + if idx < len then + Array.unsafe_get a.line idx + else a.dummy let dummy a = a.dummy @@ -91,20 +78,28 @@ struct 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 a = - let dummy1 = N1.create a in - N1.create dummy1 + 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 == a.N1.dummy then - let nline = N1.create line.N1.dummy 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 @@ -113,8 +108,8 @@ struct 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 + if v != a.N1.dummy then N1.find v j + else v.N1.dummy let dummy c = c.N1.dummy.N1.dummy @@ -126,6 +121,17 @@ struct 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 @@ -133,14 +139,17 @@ module N3 = struct type 'a t = 'a N2.t N1.t - let create a = - let dummy2 = N2.create a in - N1.create dummy2 + 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 = N1.create line.N1.dummy in + 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 @@ -148,8 +157,8 @@ struct 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 + if v != a.N1.dummy then N2.find v j k + else N2.dummy v let dummy a = N2.dummy a.N1.dummy @@ -160,20 +169,35 @@ struct 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 a = - let dummy3 = N3.create a in - N1.create dummy3 + 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 (N3.dummy line) in + 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 @@ -190,20 +214,35 @@ struct 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 a = - let dummy4 = N4.create a in - N1.create dummy4 + + 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 (N4.dummy line) in + 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 @@ -220,34 +259,50 @@ struct 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 + type 'a t = 'a N3.t N3.t let create a = - let dummy5 = N5.create a in - N1.create dummy5 + let dummy3 = N3.create a in + N3.create dummy3 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 + let line = N3.find a i j k in + if line == N3.dummy a then + let nline = N3.create (N3.dummy line) in + N3.add a i j k nline; + N3.add nline l m n v else - N5.add line j k l m n v + N3.add line 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 v = N3.find a i j k in + if v == N3.dummy a then N3.dummy v + else N3.find v l m n - let dummy a = N5.dummy (N1.dummy a) + let dummy a = N3.dummy (N3.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 + N3.iteri (fun i j k v _ -> + N3.iteri (fun l m n v2 b -> f i j k l m n v2 b) v ) a + + let stats a = assert false end