From 222f9323945f10eb6e7ee84331a7bf5a65c5cbff Mon Sep 17 00:00:00 2001
From: puech
Date: Fri, 29 Jul 2011 14:27:58 +0000
Subject: Coq_omega: replaced generic = on constr by eq_constr

Util: Added list_assoc_f

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@14350 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 lib/util.ml                | 4 ++++
 lib/util.mli               | 1 +
 plugins/omega/coq_omega.ml | 2 +-
 3 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/lib/util.ml b/lib/util.ml
index 6a69c58d20..94b1d37c25 100644
--- a/lib/util.ml
+++ b/lib/util.ml
@@ -824,6 +824,10 @@ let list_fold_map' f l e =
 
 let list_map_assoc f = List.map (fun (x,a) -> (x,f a))
 
+let rec list_assoc_f f a = function
+  | (x, e) :: xs -> if f a x then e else list_assoc_f f a xs
+  | [] -> raise Not_found
+
 (* Specification:
    - =p= is set equality (double inclusion)
    - f such that \forall l acc, (f l acc) =p= append (f l []) acc
diff --git a/lib/util.mli b/lib/util.mli
index 8606d830fb..8a26c9890f 100644
--- a/lib/util.mli
+++ b/lib/util.mli
@@ -212,6 +212,7 @@ val list_share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list
 val list_fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
 val list_fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
 val list_map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
+val list_assoc_f : ('a -> 'a -> bool) -> 'a -> ('a * 'b) list -> 'b
 
 (** A generic cartesian product: for any operator (**),
    [list_cartesian (**) [x1;x2] [y1;y2] = [x1**y1; x1**y2; x2**y1; x2**y1]],
diff --git a/plugins/omega/coq_omega.ml b/plugins/omega/coq_omega.ml
index 1d4d57132e..721ca30aaa 100644
--- a/plugins/omega/coq_omega.ml
+++ b/plugins/omega/coq_omega.ml
@@ -147,7 +147,7 @@ let tag_hypothesis,tag_of_hyp, hyp_of_tag =
 let hide_constr,find_constr,clear_tables,dump_tables =
   let l = ref ([]:(constr * (identifier * identifier * bool)) list) in
   (fun h id eg b -> l := (h,(id,eg,b)):: !l),
-  (fun h -> try List.assoc h !l with Not_found -> failwith "find_contr"),
+  (fun h -> try list_assoc_f eq_constr h !l with Not_found -> failwith "find_contr"),
   (fun () -> l := []),
   (fun () -> !l)
 
-- 
cgit v1.2.3