memoized is_ground_env

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@11893 85f007b7-540e-0410-9357-904b9bb8a0f7

2 files changed, 48 insertions, 0 deletions

diff --git a/lib/util.ml b/lib/util.ml
index 172d8d9113..57fea38084 100644
--- a/lib/util.ml
+++ b/lib/util.ml
@@ -1359,6 +1359,39 @@ let pr_located pr (loc,x) =
 
 let surround p = hov 1 (str"(" ++ p ++ str")")
 
+(*s Memoization *)
+
+let memo1_eq eq f =
+  let m = ref None in
+  fun x ->
+    match !m with
+        Some(x',y') when eq x x' -> y'
+      | _ -> let y = f x in m := Some(x,y); y
+
+let memo1_1 f = memo1_eq (==) f
+let memo1_2 f =
+  let f' =
+    memo1_eq (fun (x,y) (x',y') -> x==x' && y==y') (fun (x,y) -> f x y) in
+  (fun x y -> f'(x,y))
+
+(* Memorizes the last n distinct calls to f. Since there is no hash,
+   Efficient only for small n. *)
+let memon_eq eq n f =
+  let cache = ref [] in (* the cache: a stack *)
+  let m = ref 0 in      (* usage of the cache *)
+  let rec find x = function
+    | (x',y')::l when eq x x' -> y', l (* cell is moved to the top *)
+    | [] -> (* we assume n>0, so creating one memo cell is OK *)
+        incr m; (f x, [])
+    | [_] when !m>=n -> f x,[] (* cache is full: dispose of last cell *)
+    | p::l (* not(eq x (fst p)) *) -> let (y,l') = find x l in (y, p::l')
+  in
+  (fun x ->
+    let (y,l) = find x !cache in
+    cache := (x,y)::l;
+    y)
+
+
 (*s Size of ocaml values. *)
 
 module Size = struct
diff --git a/lib/util.mli b/lib/util.mli
index 023b8a15ee..1be7f807a2 100644
--- a/lib/util.mli
+++ b/lib/util.mli
@@ -298,6 +298,21 @@ val pr_located : ('a -> std_ppcmds) -> 'a located -> std_ppcmds
 val pr_sequence : ('a -> std_ppcmds) -> 'a list -> std_ppcmds
 val surround : std_ppcmds -> std_ppcmds
 
+(*s Memoization. *)
+
+(* General comments on memoization:
+   - cache is created whenever the function is supplied (because of
+      ML's polymorphic value restriction).
+   - cache is never flushed (unless the memoized fun is GC'd)
+ *)
+(* One cell memory: memorizes only the last call *)
+val memo1_1 : ('a -> 'b) -> ('a -> 'b)
+val memo1_2 : ('a -> 'b -> 'c) -> ('a -> 'b -> 'c)
+(* with custom equality (used to deal with various arities) *)
+val memo1_eq : ('a -> 'a -> bool) -> ('a -> 'b) -> ('a -> 'b)
+
+(* Memorizes the last [n] distinct calls. Efficient only for small [n]. *)
+val memon_eq : ('a -> 'a -> bool) -> int -> ('a -> 'b) -> ('a -> 'b)
 
 (*s Size of an ocaml value (in words, bytes and kilobytes). *)