summaryrefslogtreecommitdiff
path: root/lib/util.ml
diff options
context:
space:
mode:
authorGravatar Stephane Glondu <steph@glondu.net>2009-02-19 13:13:14 +0100
committerGravatar Stephane Glondu <steph@glondu.net>2009-02-19 13:13:14 +0100
commita0a94c1340a63cdb824507b973393882666ba52a (patch)
tree73aa4eb32cbd176379bc91b21c184e2a6882bfe3 /lib/util.ml
parentcfbfe13f5b515ae2e3c6cdd97e2ccee03bc26e56 (diff)
Imported Upstream version 8.2-1+dfsgupstream/8.2-1+dfsg
Diffstat (limited to 'lib/util.ml')
-rw-r--r--lib/util.ml35
1 files changed, 34 insertions, 1 deletions
diff --git a/lib/util.ml b/lib/util.ml
index a73a5558..a8a99c0b 100644
--- a/lib/util.ml
+++ b/lib/util.ml
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(***********************************************************************)
-(* $Id: util.ml 11845 2009-01-22 18:55:08Z letouzey $ *)
+(* $Id: util.ml 11897 2009-02-09 19:28:02Z barras $ *)
open Pp
@@ -1354,6 +1354,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