aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorfilliatr2001-02-26 08:35:18 +0000
committerfilliatr2001-02-26 08:35:18 +0000
commita91efb9e59401b6e4031cb0d115d218487cc46b9 (patch)
treee390e0b447a9687787b765ec06f184b22cf5d501
parent94720fb86d88f66ed7ac6bc47bfc14e8bcd876ca (diff)
Abstract: on échoue si le but contient des existentielles
(corrige un ug de EAuto with zarith) git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@1403 85f007b7-540e-0410-9357-904b9bb8a0f7
-rw-r--r--tactics/tactics.ml23
1 files changed, 13 insertions, 10 deletions
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 08e35f50e2..c92d80641a 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -1689,15 +1689,17 @@ let abstract_subproof name tac gls =
let env = Global.env() in
let current_sign = Global.named_context()
and global_sign = pf_hyps gls in
- let sign = List.fold_right
- (fun (id,_,_ as d) s ->
- if mem_named_context id current_sign then s else add_named_decl d s)
- global_sign empty_named_context
+ let sign =
+ List.fold_right
+ (fun (id,_,_ as d) s ->
+ if mem_named_context id current_sign then s else add_named_decl d s)
+ global_sign empty_named_context
in
- let na = next_global_ident_away name
- (ids_of_named_context global_sign) in
- let concl = List.fold_left (fun t d -> mkNamedProd_or_LetIn d t)
- (pf_concl gls) sign in
+ let na = next_global_ident_away name (ids_of_named_context global_sign) in
+ let concl =
+ List.fold_left (fun t d -> mkNamedProd_or_LetIn d t) (pf_concl gls) sign
+ in
+ if occur_existential concl then error "Cannot abstract with existentials";
let lemme =
start_proof na Declare.NeverDischarge current_sign concl;
let _,(const,strength) =
@@ -1712,8 +1714,9 @@ let abstract_subproof name tac gls =
let newenv = Global.env() in
Declare.constr_of_reference Evd.empty newenv (ConstRef sp)
in
- exact_no_check (applist (lemme,
- List.map mkVar (List.rev (ids_of_named_context sign))))
+ exact_no_check
+ (applist (lemme,
+ List.map mkVar (List.rev (ids_of_named_context sign))))
gls
let tclABSTRACT name_op tac gls =