From: Kim Nguyễn Date: Wed, 13 Mar 2013 15:08:50 +0000 (+0100) Subject: Add a caching module. X-Git-Tag: v0.1~126 X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=commitdiff_plain;h=748057239bad98bebc0f38403f05c1feb3712e82 Add a caching module. --- diff --git a/src/utils.mlpack b/src/utils.mlpack index 8115b79..711e03f 100644 --- a/src/utils.mlpack +++ b/src/utils.mlpack @@ -1,3 +1,4 @@ +utils/Cache utils/Common_sig utils/FiniteCofinite utils/FiniteCofinite_sig @@ -5,8 +6,8 @@ utils/Hcons utils/Hcons_sig utils/Misc utils/Pretty -utils/Ptset_sig utils/Ptset +utils/Ptset_sig utils/QName utils/QNameSet utils/Uid diff --git a/src/utils/cache.ml b/src/utils/cache.ml new file mode 100644 index 0000000..a38fe0c --- /dev/null +++ b/src/utils/cache.ml @@ -0,0 +1,243 @@ +(***********************************************************************) +(* *) +(* 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 + l'.(i) <- l.(i); + done; + l' + +module N1 = +struct + type 'a t = { mutable line : 'a array; + dummy : 'a; + mutable offset : int; + } + let create n 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 offset = a.offset in + let len = Array.length a.line in + if i >= offset && i < offset + len then a.line.(i - offset) + 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 n a = + let dummy1 = N1.create 512 a in + { N1.line = Array.create n dummy1; + N1.offset = ~-1; + N1.dummy = dummy1; + } + + + let add a i j v = + let line = N1.find a i in + if line == a.N1.dummy then + let nline = N1.create 0 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 a.N1.dummy.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 n a = + let dummy1 = N2.create 512 a in + { N1.line = Array.create n dummy1; + N1.offset = ~-1; + N1.dummy = dummy1; + } + + let add a i j k v = + let line = N1.find a i in + if line == a.N1.dummy then + let nline = N1.create 0 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 a.N1.dummy + 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 n a = + let dummy1 = N3.create 512 a in + { N1.line = Array.create n dummy1; + N1.offset = ~-1; + N1.dummy = dummy1; + } + + let add a i j k l v = + let line = N1.find a i in + if line == a.N1.dummy then + let nline = N1.create 0 line.N1.dummy 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 == a.N1.dummy then N3.dummy a.N1.dummy + else N3.find v j k l + + + let dummy a = N3.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 + N3.iteri (f i) line.(i) + done + +end + +module N5 = +struct + type 'a t = 'a N4.t N1.t + + let create n a = + let dummy1 = N4.create 512 a in + { N1.line = Array.create n dummy1; + N1.offset = ~-1; + N1.dummy = dummy1; + } + + let add a i j k l m v = + let line = N1.find a i in + if line == a.N1.dummy then + let nline = N1.create 0 line.N1.dummy 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 == a.N1.dummy then N4.dummy a.N1.dummy + else N4.find v j k l m + + + let dummy a = N4.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 + N4.iteri (f i) line.(i) + done + +end diff --git a/src/utils/cache.mli b/src/utils/cache.mli new file mode 100644 index 0000000..dba9917 --- /dev/null +++ b/src/utils/cache.mli @@ -0,0 +1,71 @@ +(***********************************************************************) +(* *) +(* 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: +*) + +(** N-dimentional caches *) + +module N1 : +sig + + type 'a t + val create : int -> 'a -> 'a t + val find : 'a t -> int -> 'a + val add : 'a t -> int -> 'a -> unit + val dummy : 'a t -> 'a + val iteri : (int -> 'a -> bool -> unit) -> 'a t -> unit +end + +module N2: +sig + type 'a t + val create : int -> 'a -> 'a t + val find : 'a t -> int -> int -> 'a + val add : 'a t -> int -> int -> 'a -> unit + val dummy : 'a t -> 'a + val iteri : (int -> int -> 'a -> bool -> unit) -> 'a t -> unit +end + +module N3 : + sig + type 'a t + val create : int -> 'a -> 'a t + val find : 'a t -> int -> int -> int -> 'a + val add : 'a t -> int -> int -> int -> 'a -> unit + val dummy : 'a t -> 'a + val iteri : (int -> int -> int -> 'a -> bool -> unit) -> 'a t -> unit + end + +module N4 : + sig + type 'a t + val create : int -> 'a -> 'a t + val find : 'a t -> int -> int -> int -> int -> 'a + val add : 'a t -> int -> int -> int -> int -> 'a -> unit + val dummy : 'a t -> 'a + val iteri : (int -> int -> int -> int -> 'a -> bool -> unit) -> 'a t -> unit + end + +module N5 : + sig + type 'a t + val create : int -> 'a -> 'a t + val find : 'a t -> int -> int -> int -> int -> int -> 'a + val add : 'a t -> int -> int -> int -> int -> int -> 'a -> unit + val dummy : 'a t -> 'a + val iteri : (int -> int -> int -> int -> int -> 'a -> bool -> unit) -> 'a t -> unit + end