From: Kim Nguyễn Date: Thu, 14 Mar 2013 12:52:31 +0000 (+0100) Subject: Write the caching module in a more systematic way. X-Git-Tag: v0.1~119 X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=commitdiff_plain;h=3b653edd20248b66a005637c2b1e217042cef62b Write the caching module in a more systematic way. --- diff --git a/_tags b/_tags index 40f25e4..f500328 100644 --- a/_tags +++ b/_tags @@ -9,7 +9,7 @@ true: package(ulex), \ #compilation options -true: inline(100), unsafe(true) +true: inline(1000), unsafe(true) #project source tree diff --git a/src/auto/eval.ml b/src/auto/eval.ml index 71adf56..a5b30f1 100644 --- a/src/auto/eval.ml +++ b/src/auto/eval.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) INCLUDE "utils.ml" @@ -174,7 +174,7 @@ module Make (T : Tree.Sig.S) : loop node [] let eval auto tree node = - let cache = Cache.N1.create (T.size tree) StateSet.empty in + let cache = Cache.N1.create StateSet.empty in let redo = ref true in let iter = ref 0 in let dummy2 = Ata.TransList.cons @@ -182,8 +182,8 @@ module Make (T : Tree.Sig.S) : Ata.TransList.nil in let dummy6 = (dummy2, StateSet.empty) in - let trans_cache6 = Cache.N6.create 17 dummy6 in - let trans_cache2 = Cache.N2.create 17 dummy2 in + let trans_cache6 = Cache.N6.create dummy6 in + let trans_cache2 = Cache.N2.create dummy2 in let () = at_exit (fun () -> let num_phi = ref 0 in let num_trans = ref 0 in diff --git a/src/utils/cache.ml b/src/utils/cache.ml index 7ba67d5..abd999e 100644 --- a/src/utils/cache.ml +++ b/src/utils/cache.ml @@ -14,13 +14,13 @@ (***********************************************************************) (* - Time-stamp: + 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); + Array.unsafe_set l' i (Array.unsafe_get l i); done; l' @@ -30,7 +30,7 @@ struct dummy : 'a; mutable offset : int; } - let create _ a = { + let create a = { line = Array.create 0 a; dummy = a; offset = ~-1; @@ -75,9 +75,10 @@ struct end let find a i = - let offset = a.offset in + let idx = i - a.offset in let len = Array.length a.line in - if i >= offset && i < offset + len then a.line.(i - offset) + if idx >= 0 && idx < len then + Array.unsafe_get a.line idx else a.dummy let dummy a = a.dummy @@ -93,23 +94,17 @@ struct 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 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 0 line.N1.dummy in + let nline = N1.create line.N1.dummy in N1.add a i nline; N1.add nline j v else @@ -118,7 +113,7 @@ struct let find a i j = let v = N1.find a i in - if v == a.N1.dummy then a.N1.dummy.N1.dummy + if v == a.N1.dummy then v.N1.dummy else N1.find v j @@ -138,17 +133,14 @@ 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 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 0 line.N1.dummy in + let nline = N1.create line.N1.dummy in N1.add a i nline; N2.add nline j k v else @@ -156,7 +148,7 @@ struct let find a i j k = let v = N1.find a i in - if v == a.N1.dummy then N2.dummy a.N1.dummy + if v == a.N1.dummy then N2.dummy v else N2.find v j k @@ -174,17 +166,14 @@ 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 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 == a.N1.dummy then - let nline = N1.create 0 line.N1.dummy 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 @@ -192,17 +181,14 @@ struct 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 + if v == (N1.dummy a) then N3.dummy v else N3.find v j k l - let dummy a = N3.dummy a.N1.dummy + let dummy a = N3.dummy (N1.dummy a) 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 + N1.iteri (fun i v _ -> + N3.iteri (fun j k l v2 b -> f i j k l v2 b) v ) a end @@ -210,17 +196,14 @@ 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 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 == a.N1.dummy then - let nline = N1.create 0 line.N1.dummy 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 @@ -228,43 +211,43 @@ struct 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 + if v == (N1.dummy a) then N4.dummy v else N4.find v j k l m - let dummy a = N4.dummy a.N1.dummy + let dummy a = N4.dummy (N1.dummy a) 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 - + 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 N3.t N3.t + type 'a t = 'a N5.t N1.t - let create _n a = - let dummy1 = N3.create 512 a in - N3.create 512 dummy1 + let create a = + let dummy5 = N5.create a in + N1.create dummy5 let add a i 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 0 (N3.dummy line) in - N3.add a i j k nline; - N3.add nline 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 - N3.add line l m n v + N5.add line j k l m n v let find a i j k l m n = - let v = N3.find a i j k in - if v == N3.dummy a then N3.dummy (N3.dummy a) - else N3.find v 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 = N3.dummy (N3.dummy a) - let iteri _f _a = assert false + 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 diff --git a/src/utils/cache.mli b/src/utils/cache.mli index d6c0ebb..1211935 100644 --- a/src/utils/cache.mli +++ b/src/utils/cache.mli @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) (** N-dimentional caches *) @@ -23,7 +23,7 @@ module N1 : sig type 'a t - val create : int -> 'a -> 'a t + val create : 'a -> 'a t val find : 'a t -> int -> 'a val add : 'a t -> int -> 'a -> unit val dummy : 'a t -> 'a @@ -33,7 +33,7 @@ end module N2: sig type 'a t - val create : int -> 'a -> 'a t + val create : 'a -> 'a t val find : 'a t -> int -> int -> 'a val add : 'a t -> int -> int -> 'a -> unit val dummy : 'a t -> 'a @@ -43,7 +43,7 @@ end module N3 : sig type 'a t - val create : int -> 'a -> 'a t + val create : '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 @@ -53,7 +53,7 @@ module N3 : module N4 : sig type 'a t - val create : int -> 'a -> 'a t + val create : '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 @@ -63,7 +63,7 @@ module N4 : module N5 : sig type 'a t - val create : int -> 'a -> 'a t + val create : '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 @@ -73,7 +73,7 @@ module N5 : module N6 : sig type 'a t - val create : int -> 'a -> 'a t + val create : 'a -> 'a t val find : 'a t -> int -> int -> int -> int -> int -> int -> 'a val add : 'a t -> int -> int -> int -> int -> int -> int -> 'a -> unit val dummy : 'a t -> 'a