summaryrefslogtreecommitdiff
path: root/tactics/refine.ml
diff options
context:
space:
mode:
Diffstat (limited to 'tactics/refine.ml')
-rw-r--r--tactics/refine.ml19
1 files changed, 17 insertions, 2 deletions
diff --git a/tactics/refine.ml b/tactics/refine.ml
index cbca38d0..87769ccb 100644
--- a/tactics/refine.ml
+++ b/tactics/refine.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -267,6 +267,19 @@ let rec compute_metamap env sigma c = match kind_of_term c with
* Réalise le 3. ci-dessus
*)
+let ensure_products n =
+ let p = ref 0 in
+ let rec aux n gl =
+ if n = 0 then tclFAIL 0 (mt()) gl
+ else
+ tclTHEN
+ (tclORELSE intro (fun gl -> incr p; introf gl))
+ (aux (n-1)) gl in
+ tclORELSE
+ (aux n)
+ (* Now we know how many red are needed *)
+ (fun gl -> tclDO !p red_in_concl gl)
+
let rec tcc_aux subst (TH (c,mm,sgp) as _th) gl =
let c = substl subst c in
match (kind_of_term c,sgp) with
@@ -345,7 +358,9 @@ let rec tcc_aux subst (TH (c,mm,sgp) as _th) gl =
let fixes = array_map3 (fun f n c -> (out_name f,succ n,c)) fi ni ai in
let firsts,lasts = list_chop j (Array.to_list fixes) in
tclTHENS
- (mutual_fix (out_name fi.(j)) (succ ni.(j)) (firsts@List.tl lasts) j)
+ (tclTHEN
+ (ensure_products (succ ni.(j)))
+ (mutual_fix (out_name fi.(j)) (succ ni.(j)) (firsts@List.tl lasts) j))
(List.map (function
| None -> tclIDTAC
| Some th -> tcc_aux subst th) sgp)