feat(library/tactic): add 'subtvars' tactic
This commit is contained in:
parent
ab58e538a4
commit
d0987eb3ac
7 changed files with 120 additions and 1 deletions
|
@ -116,6 +116,7 @@ definition right : tactic := builtin
|
|||
definition injection (e : expr) (ids : opt_identifier_list) : tactic := builtin
|
||||
|
||||
definition subst (ids : identifier_list) : tactic := builtin
|
||||
definition substvars : tactic := builtin
|
||||
|
||||
definition reflexivity : tactic := builtin
|
||||
definition symmetry : tactic := builtin
|
||||
|
|
|
@ -116,6 +116,7 @@ definition right : tactic := builtin
|
|||
definition injection (e : expr) (ids : opt_identifier_list) : tactic := builtin
|
||||
|
||||
definition subst (ids : identifier_list) : tactic := builtin
|
||||
definition substvars : tactic := builtin
|
||||
|
||||
definition reflexivity : tactic := builtin
|
||||
definition symmetry : tactic := builtin
|
||||
|
|
|
@ -139,7 +139,8 @@
|
|||
"generalize" "generalizes" "clear" "clears" "revert" "reverts" "back" "beta" "done" "exact" "rexact"
|
||||
"refine" "repeat" "whnf" "rotate" "rotate_left" "rotate_right" "inversion" "cases" "rewrite" "esimp"
|
||||
"unfold" "change" "check_expr" "contradiction" "exfalso" "split" "existsi" "constructor" "left" "right"
|
||||
"injection" "congruence" "reflexivity" "symmetry" "transitivity" "state" "induction" "induction_using"))
|
||||
"injection" "congruence" "reflexivity" "symmetry" "transitivity" "state" "induction" "induction_using"
|
||||
"substvars"))
|
||||
word-end)
|
||||
(1 'font-lock-constant-face))
|
||||
;; Types
|
||||
|
|
|
@ -181,6 +181,44 @@ tactic mk_subst_tactic(list<name> const & ids) {
|
|||
return tactic(fn);
|
||||
}
|
||||
|
||||
tactic mk_subst_vars_tactic(bool first, unsigned start) {
|
||||
auto fn = [=](environment const & env, io_state const & ios, proof_state const & s) {
|
||||
goals const & gs = s.get_goals();
|
||||
if (empty(gs)) {
|
||||
if (first)
|
||||
return proof_state_seq();
|
||||
else
|
||||
return proof_state_seq(s);
|
||||
}
|
||||
goal const & g = head(gs);
|
||||
|
||||
auto apply_rewrite = [&](expr const & H, bool symm, unsigned i) {
|
||||
tactic tac = orelse(then(mk_subst_tactic_core(mlocal_name(H), symm), mk_subst_vars_tactic(false, 0)),
|
||||
mk_subst_vars_tactic(false, i+1));
|
||||
return tac(env, ios, s);
|
||||
};
|
||||
|
||||
buffer<expr> hyps;
|
||||
g.get_hyps(hyps);
|
||||
for (unsigned i = start; i < hyps.size(); i++) {
|
||||
expr const & h = hyps[i];
|
||||
expr lhs, rhs;
|
||||
if (is_eq(mlocal_type(h), lhs, rhs)) {
|
||||
if (is_local(rhs)) {
|
||||
return apply_rewrite(h, true, i);
|
||||
} else if (is_local(lhs)) {
|
||||
return apply_rewrite(h, false, i);
|
||||
}
|
||||
}
|
||||
}
|
||||
if (first)
|
||||
return proof_state_seq();
|
||||
else
|
||||
return proof_state_seq(s);
|
||||
};
|
||||
return tactic(fn);
|
||||
}
|
||||
|
||||
void initialize_subst_tactic() {
|
||||
register_tac(name{"tactic", "subst"},
|
||||
[](type_checker &, elaborate_fn const & elab, expr const & e, pos_info_provider const *) {
|
||||
|
@ -188,6 +226,10 @@ void initialize_subst_tactic() {
|
|||
get_tactic_id_list_elements(app_arg(e), ns, "invalid 'subst' tactic, list of identifiers expected");
|
||||
return then(mk_subst_tactic(to_list(ns)), try_tactic(refl_tactic(elab)));
|
||||
});
|
||||
register_tac(name{"tactic", "substvars"},
|
||||
[](type_checker &, elaborate_fn const & elab, expr const &, pos_info_provider const *) {
|
||||
return then(mk_subst_vars_tactic(true, 0), try_tactic(refl_tactic(elab)));
|
||||
});
|
||||
}
|
||||
void finalize_subst_tactic() {
|
||||
}
|
||||
|
|
52
tests/lean/hott/substvars1.hlean
Normal file
52
tests/lean/hott/substvars1.hlean
Normal file
|
@ -0,0 +1,52 @@
|
|||
open nat
|
||||
|
||||
example (A B : Type) (a : A) (b : B) (h₁ : A = B) (h₂ : eq.rec_on h₁ a = b) : b = eq.rec_on h₁ a :=
|
||||
begin
|
||||
substvars
|
||||
end
|
||||
|
||||
example (A B : Type) (a : A) (b : B) (h₁ : A = B) (h₂ : eq.rec_on h₁ a = b) : b = eq.rec_on h₁ a :=
|
||||
begin
|
||||
substvars
|
||||
end
|
||||
|
||||
example (a b c : nat) (a0 : a = 0) (b1 : b = 1 + a) (ab : a = b) : empty :=
|
||||
begin
|
||||
substvars,
|
||||
contradiction
|
||||
end
|
||||
|
||||
example (a : nat) : a = 0 → a = 1 → empty :=
|
||||
begin
|
||||
intro a0 a1,
|
||||
substvars,
|
||||
contradiction
|
||||
end
|
||||
|
||||
example (a b c : nat) : a = 0 → b = 1 + a → a = b → empty :=
|
||||
begin
|
||||
intro a0 b1 ab,
|
||||
substvars,
|
||||
state,
|
||||
contradiction
|
||||
end
|
||||
example (a b c : nat) : a = 0 → b = 1 + a → a = b → empty :=
|
||||
begin
|
||||
intro a0 b1 ab,
|
||||
substvars,
|
||||
contradiction
|
||||
end
|
||||
|
||||
example (a b c : nat) : a = 0 → 1 + a = b → a = b → empty :=
|
||||
begin
|
||||
intro a0 b1 ab,
|
||||
substvars,
|
||||
contradiction
|
||||
end
|
||||
|
||||
example (a b c : nat) : a = 0 → 1 + a = b → a = b → empty :=
|
||||
begin
|
||||
intros,
|
||||
substvars,
|
||||
contradiction
|
||||
end
|
14
tests/lean/substvars2.hlean
Normal file
14
tests/lean/substvars2.hlean
Normal file
|
@ -0,0 +1,14 @@
|
|||
inductive list (A : Type) :=
|
||||
| nil : list A
|
||||
| cons : A → list A → list A
|
||||
|
||||
open nat prod
|
||||
|
||||
example (A B : Type) (d c : nat) (h₀ : c = 0) (a : A) (b : list B) (h₁ : A = list B) (h₂ : eq.rec_on h₁ a = @list.nil B) (h₃ : d = c) (h₄ : d + 1 = d + 2)
|
||||
: b = eq.rec_on h₁ a × c = 1:=
|
||||
begin
|
||||
substvars,
|
||||
state,
|
||||
injection h₄,
|
||||
contradiction
|
||||
end
|
8
tests/lean/substvars2.hlean.expected.out
Normal file
8
tests/lean/substvars2.hlean.expected.out
Normal file
|
@ -0,0 +1,8 @@
|
|||
substvars2.hlean:11:2: proof state
|
||||
A B : Type,
|
||||
a : A,
|
||||
b : list B,
|
||||
h₁ : A = list B,
|
||||
h₂ : eq.rec_on h₁ a = list.nil B,
|
||||
h₄ : 0 + 1 = 0 + 2
|
||||
⊢ b = eq.rec_on h₁ a × 0 = 1
|
Loading…
Reference in a new issue