From a22219b5eec49a731921fda7e5f8711b45725531 Mon Sep 17 00:00:00 2001
From: msozeau <msozeau@85f007b7-540e-0410-9357-904b9bb8a0f7>
Date: Mon, 8 Jun 2009 17:24:53 +0000
Subject: Do a fixpoint on the result of typeclass search to force the
 resolution of generated evars, not doing any backtracking yet.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12175 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 tactics/class_tactics.ml4 | 19 +++++++++++--------
 1 file changed, 11 insertions(+), 8 deletions(-)

(limited to 'tactics')

diff --git a/tactics/class_tactics.ml4 b/tactics/class_tactics.ml4
index 78ef3c6fc..6fdd8c282 100644
--- a/tactics/class_tactics.ml4
+++ b/tactics/class_tactics.ml4
@@ -217,7 +217,7 @@ type 'a tac = { skft : 'ans. ('a,'ans) sk -> 'ans fk -> autogoal sigma -> 'ans }
 type auto_result = autogoal list sigma * validation
 
 type atac = auto_result tac
-  
+
 let lift_tactic tac (f : goal list sigma -> autoinfo -> autogoal list sigma) : 'a tac =
   { skft = fun sk fk {it = gl,hints; sigma=s} ->
     let res = try Some (tac {it=gl; sigma=s}) with e when catchable e -> None in
@@ -326,6 +326,7 @@ let run_list_tac (t : 'a tac) p goals (gl : autogoal list sigma) : auto_result o
 let rec fix (t : 'a tac) : 'a tac = 
   then_tac t { skft = fun sk fk -> (fix t).skft sk fk }
 
+  
 (* A special one for getting everything into a dnet. *)
 
 let is_transparent_gr (ids, csts) = function
@@ -357,10 +358,10 @@ let make_autogoals ?(st=full_transparent_state) gs evm' =
   { it = list_map_i (fun i g -> 
     let (gl, auto) = make_autogoal ~st {it = snd g; sigma = evm'} in
       (gl, { auto with auto_depth = [i]})) 1 gs; sigma = evm' }
-    
+
 let run_on_evars ?(st=full_transparent_state) p evm tac =
   match evars_to_goals p evm with
-  | None -> raise Not_found
+  | None -> None
   | Some (goals, evm') ->
       match run_list_tac tac p goals (make_autogoals ~st goals evm') with
       | None -> raise Not_found
@@ -379,13 +380,15 @@ let eauto hints g =
 
 let real_eauto st hints p evd =
   let tac = fix (hints_tac hints) in
-    run_on_evars ~st p evd tac
-      
+  let rec aux evd =
+    match run_on_evars ~st p evd tac with
+    | None -> evd
+    | Some evd' -> aux evd'
+  in aux evd
+
 let resolve_all_evars_once debug (mode, depth) p evd =
   let db = searchtable_map typeclasses_db in
-    match real_eauto (Hint_db.transparent_state db) [db] p evd with
-    | None -> raise Not_found
-    | Some res -> res
+    real_eauto (Hint_db.transparent_state db) [db] p evd
 
 exception FoundTerm of constr
 
-- 
cgit v1.2.3