aboutsummaryrefslogtreecommitdiffhomepage
path: root/plugins
diff options
context:
space:
mode:
Diffstat (limited to 'plugins')
-rw-r--r--plugins/decl_mode/decl_proof_instr.ml16
-rw-r--r--plugins/firstorder/rules.ml4
-rw-r--r--plugins/funind/functional_principles_proofs.ml5
-rw-r--r--plugins/funind/invfun.ml1
-rw-r--r--plugins/funind/recdef.ml14
-rw-r--r--plugins/omega/coq_omega.ml28
6 files changed, 42 insertions, 26 deletions
diff --git a/plugins/decl_mode/decl_proof_instr.ml b/plugins/decl_mode/decl_proof_instr.ml
index 090b293f5..4f2270313 100644
--- a/plugins/decl_mode/decl_proof_instr.ml
+++ b/plugins/decl_mode/decl_proof_instr.ml
@@ -34,6 +34,22 @@ open Context.Named.Declaration
(* Strictness option *)
+let clear ids { it = goal; sigma } =
+ let ids = List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty ids in
+ let env = Goal.V82.env sigma goal in
+ let sign = Goal.V82.hyps sigma goal in
+ let cl = Goal.V82.concl sigma goal in
+ let evdref = ref (Evd.clear_metas sigma) in
+ let (hyps, concl) =
+ try Evarutil.clear_hyps_in_evi env evdref sign cl ids
+ with Evarutil.ClearDependencyError (id, _) ->
+ errorlabstrm "" (str "Cannot clear " ++ pr_id id)
+ in
+ let sigma = !evdref in
+ let (gl,ev,sigma) = Goal.V82.mk_goal sigma hyps concl (Goal.V82.extra sigma goal) in
+ let sigma = Goal.V82.partial_solution_to sigma goal gl ev in
+ { it = [gl]; sigma }
+
let get_its_info gls = get_info gls.sigma gls.it
let get_strictness,set_strictness =
diff --git a/plugins/firstorder/rules.ml b/plugins/firstorder/rules.ml
index c05015c53..f19cdd2cc 100644
--- a/plugins/firstorder/rules.ml
+++ b/plugins/firstorder/rules.ml
@@ -52,7 +52,7 @@ let basename_of_global=function
| _->assert false
let clear_global=function
- VarRef id->clear [id]
+ VarRef id-> Proofview.V82.of_tactic (clear [id])
| _->tclIDTAC
(* connection rules *)
@@ -192,7 +192,7 @@ let ll_forall_tac prod backtrack id continue seq=
(fun gls->
let id0=pf_nth_hyp_id gls 1 in
let term=mkApp(idc,[|mkVar(id0)|]) in
- tclTHEN (generalize [term]) (clear [id0]) gls));
+ tclTHEN (generalize [term]) (Proofview.V82.of_tactic (clear [id0])) gls));
clear_global id;
Proofview.V82.of_tactic intro;
tclCOMPLETE (wrap 1 false continue (deepen seq))];
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index 839586528..fdb112ba0 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -127,8 +127,7 @@ let finish_proof dynamic_infos g =
let refine c =
Tacmach.refine c
-let thin l =
- Tacmach.thin_no_check l
+let thin l = Proofview.V82.of_tactic (Tactics.clear l)
let eq_constr u v = eq_constr_nounivs u v
@@ -1565,7 +1564,7 @@ let prove_principle_for_gen
Nameops.out_name (fresh_id (Name (Id.of_string ("Acc_"^(Id.to_string rec_arg_id)))))
in
let revert l =
- tclTHEN (Tactics.generalize (List.map mkVar l)) (clear l)
+ tclTHEN (Tactics.generalize (List.map mkVar l)) (Proofview.V82.of_tactic (clear l))
in
let fix_id = Nameops.out_name (fresh_id (Name hrec_id)) in
let prove_rec_arg_acc g =
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index 6a5a5ad53..fde1b7e70 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -94,6 +94,7 @@ let nf_zeta =
Environ.empty_env
Evd.empty
+let thin ids gl = Proofview.V82.of_tactic (Tactics.clear ids) gl
(* (\* [id_to_constr id] finds the term associated to [id] in the global environment *\) *)
(* let id_to_constr id = *)
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index e98ac5fb5..ac81366bb 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -267,8 +267,8 @@ let observe_tclTHENLIST s tacl =
let tclUSER tac is_mes l g =
let clear_tac =
match l with
- | None -> clear []
- | Some l -> tclMAP (fun id -> tclTRY (clear [id])) (List.rev l)
+ | None -> tclIDTAC
+ | Some l -> tclMAP (fun id -> tclTRY (Proofview.V82.of_tactic (clear [id]))) (List.rev l)
in
observe_tclTHENLIST (str "tclUSER1")
[
@@ -399,7 +399,7 @@ let treat_case forbid_new_ids to_intros finalize_tac nb_lam e infos : tactic =
Proofview.V82.of_tactic (intro_using teq_id);
onLastHypId (fun heq ->
observe_tclTHENLIST (str "treat_case2")[
- thin to_intros;
+ Proofview.V82.of_tactic (clear to_intros);
h_intros to_intros;
(fun g' ->
let ty_teq = pf_unsafe_type_of g' (mkVar heq) in
@@ -560,7 +560,7 @@ let rec destruct_bounds_aux infos (bound,hyple,rechyps) lbounds g =
Proofview.V82.of_tactic (simplest_elim(mkApp(delayed_force lt_n_O,[|s_max|])));
Proofview.V82.of_tactic default_full_auto];
observe_tclTHENLIST (str "destruct_bounds_aux2")[
- observe_tac (str "clearing k ") (clear [id]);
+ observe_tac (str "clearing k ") (Proofview.V82.of_tactic (clear [id]));
h_intros [k;h';def];
observe_tac (str "simple_iter") (Proofview.V82.of_tactic (simpl_iter Locusops.onConcl));
observe_tac (str "unfold functional")
@@ -589,7 +589,7 @@ let rec destruct_bounds_aux infos (bound,hyple,rechyps) lbounds g =
| (_,v_bound)::l ->
observe_tclTHENLIST (str "destruct_bounds_aux3")[
Proofview.V82.of_tactic (simplest_elim (mkVar v_bound));
- clear [v_bound];
+ Proofview.V82.of_tactic (clear [v_bound]);
tclDO 2 (Proofview.V82.of_tactic intro);
onNthHypId 1
(fun p_hyp ->
@@ -948,7 +948,7 @@ let rec destruct_hex expr_info acc l =
| (v,hex)::l ->
observe_tclTHENLIST (str "destruct_hex")[
Proofview.V82.of_tactic (simplest_case (mkVar hex));
- clear [hex];
+ Proofview.V82.of_tactic (clear [hex]);
tclDO 2 (Proofview.V82.of_tactic intro);
onNthHypId 1 (fun hp ->
onNthHypId 2 (fun p ->
@@ -1116,7 +1116,7 @@ let termination_proof_header is_mes input_type ids args_id relation
[observe_tac (str "generalize")
(onNLastHypsId (nargs+1)
(tclMAP (fun id ->
- tclTHEN (Tactics.generalize [mkVar id]) (clear [id]))
+ tclTHEN (Tactics.generalize [mkVar id]) (Proofview.V82.of_tactic (clear [id])))
))
;
observe_tac (str "fix") (fix (Some hrec) (nargs+1));
diff --git a/plugins/omega/coq_omega.ml b/plugins/omega/coq_omega.ml
index 1f420cf6a..fc5054080 100644
--- a/plugins/omega/coq_omega.ml
+++ b/plugins/omega/coq_omega.ml
@@ -1122,7 +1122,7 @@ let replay_history tactic_normalisation =
Proofview.V82.tactic (generalize_tac
[mkApp (Lazy.force coq_OMEGA1,
[| eq1; rhs; mkVar aux; mkVar id |])]);
- Proofview.V82.tactic (clear [aux;id]);
+ (clear [aux;id]);
(intros_using [id]);
(cut (mk_gt kk dd)) ])
[ Tacticals.New.tclTHENS
@@ -1132,7 +1132,7 @@ let replay_history tactic_normalisation =
(Proofview.V82.tactic (generalize_tac
[mkApp (Lazy.force coq_Zmult_le_approx,
[| kk;eq2;dd;mkVar aux1;mkVar aux2; mkVar id |])]));
- Proofview.V82.tactic (clear [aux1;aux2;id]);
+ (clear [aux1;aux2;id]);
(intros_using [id]);
(loop l) ];
Tacticals.New.tclTHENLIST [
@@ -1160,7 +1160,7 @@ let replay_history tactic_normalisation =
Proofview.V82.tactic (generalize_tac
[mkApp (Lazy.force coq_OMEGA4,
[| dd;kk;eq2;mkVar aux1; mkVar aux2 |])]);
- Proofview.V82.tactic (clear [aux1;aux2]);
+ (clear [aux1;aux2]);
unfold sp_not;
(intros_using [aux]);
Proofview.V82.tactic (resolve_id aux);
@@ -1190,7 +1190,7 @@ let replay_history tactic_normalisation =
Proofview.V82.tactic (generalize_tac
[mkApp (Lazy.force coq_OMEGA18,
[| eq1;eq2;kk;mkVar aux1; mkVar id |])]);
- Proofview.V82.tactic (clear [aux1;id]);
+ (clear [aux1;id]);
(intros_using [id]);
(loop l) ];
Tacticals.New.tclTHEN (Proofview.V82.tactic (mk_then tac)) reflexivity ]
@@ -1205,7 +1205,7 @@ let replay_history tactic_normalisation =
Proofview.V82.tactic (generalize_tac
[mkApp (Lazy.force coq_OMEGA3,
[| eq1; eq2; kk; mkVar aux2; mkVar aux1;mkVar id|])]);
- Proofview.V82.tactic (clear [aux1;aux2;id]);
+ (clear [aux1;aux2;id]);
(intros_using [id]);
(loop l) ];
Tacticals.New.tclTHENLIST [
@@ -1231,7 +1231,7 @@ let replay_history tactic_normalisation =
(intros_using [aux]);
Proofview.V82.tactic (generalize_tac [mkApp (Lazy.force coq_OMEGA8,
[| eq1;eq2;mkVar id1;mkVar id2; mkVar aux|])]);
- Proofview.V82.tactic (clear [id1;id2;aux]);
+ (clear [id1;id2;aux]);
(intros_using [id]);
(loop l) ];
Tacticals.New.tclTHEN (Proofview.V82.tactic (mk_then tac)) reflexivity]
@@ -1263,13 +1263,13 @@ let replay_history tactic_normalisation =
[Tacticals.New.tclTHENLIST [
(intros_using [aux]);
(elim_id aux);
- Proofview.V82.tactic (clear [aux]);
+ (clear [aux]);
(intros_using [vid; aux]);
Proofview.V82.tactic (generalize_tac
[mkApp (Lazy.force coq_OMEGA9,
[| mkVar vid;eq2;eq1;mm; mkVar id2;mkVar aux |])]);
Proofview.V82.tactic (mk_then tac);
- Proofview.V82.tactic (clear [aux]);
+ (clear [aux]);
(intros_using [id]);
(loop l) ];
Tacticals.New.tclTHEN (exists_tac eq1) reflexivity ]
@@ -1325,7 +1325,7 @@ let replay_history tactic_normalisation =
eq1;eq2;kk1;kk2;
mkVar aux1;mkVar aux2;
mkVar id1;mkVar id2 |])]);
- Proofview.V82.tactic (clear [aux1;aux2]);
+ (clear [aux1;aux2]);
Proofview.V82.tactic (mk_then tac);
(intros_using [id]);
(loop l) ];
@@ -1367,7 +1367,7 @@ let normalize_equation id flag theorem pos t t1 t2 (tactic,defs) =
let shift_left =
tclTHEN
(generalize_tac [mkApp (theorem, [| t1; t2; mkVar id |]) ])
- (tclTRY (clear [id]))
+ (tclTRY (Proofview.V82.of_tactic (clear [id])))
in
if not (List.is_empty tac) then
let id' = new_identifier () in
@@ -1412,7 +1412,7 @@ let destructure_omega gl tac_def (id,c) =
let reintroduce id =
(* [id] cannot be cleared if dependent: protect it by a try *)
- Tacticals.New.tclTHEN (Proofview.V82.tactic (tclTRY (clear [id]))) (intro_using id)
+ Tacticals.New.tclTHEN (Tacticals.New.tclTRY (clear [id])) (intro_using id)
open Proofview.Notations
@@ -1435,7 +1435,7 @@ let coq_omega =
(simplest_elim (applist (Lazy.force coq_intro_Z, [t])));
(intros_using [v; id]);
(elim_id id);
- Proofview.V82.tactic (clear [id]);
+ (clear [id]);
(intros_using [th;id]);
tac ]),
{kind = INEQ;
@@ -1674,7 +1674,7 @@ let onClearedName id tac =
(* We cannot ensure that hyps can be cleared (because of dependencies), *)
(* so renaming may be necessary *)
Tacticals.New.tclTHEN
- (Proofview.V82.tactic (tclTRY (clear [id])))
+ (Tacticals.New.tclTRY (clear [id]))
(Proofview.Goal.nf_enter { enter = begin fun gl ->
let id = Tacmach.New.of_old (fresh_id [] id) gl in
Tacticals.New.tclTHEN (introduction id) (tac id)
@@ -1682,7 +1682,7 @@ let onClearedName id tac =
let onClearedName2 id tac =
Tacticals.New.tclTHEN
- (Proofview.V82.tactic (tclTRY (clear [id])))
+ (Tacticals.New.tclTRY (clear [id]))
(Proofview.Goal.nf_enter { enter = begin fun gl ->
let id1 = Tacmach.New.of_old (fresh_id [] (add_suffix id "_left")) gl in
let id2 = Tacmach.New.of_old (fresh_id [] (add_suffix id "_right")) gl in
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-16 08:17:46 +0000