Add a caching module.
authorKim Nguyễn <kn@lri.fr>
Wed, 13 Mar 2013 15:08:50 +0000 (16:08 +0100)
committerKim Nguyễn <kn@lri.fr>
Wed, 13 Mar 2013 15:08:50 +0000 (16:08 +0100)
src/utils.mlpack
src/utils/cache.ml [new file with mode: 0644]
src/utils/cache.mli [new file with mode: 0644]

index 8115b79..711e03f 100644 (file)
@@ -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 (file)
index 0000000..a38fe0c
--- /dev/null
@@ -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: <Last modified on 2013-03-13 16:02:03 CET by Kim Nguyen>
+*)
+
+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 (file)
index 0000000..dba9917
--- /dev/null
@@ -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: <Last modified on 2013-03-13 16:01:55 CET by Kim Nguyen>
+*)
+
+(** 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