feat(library/tactic): add 'subtvars' tactic

hott/init/tactic.hlean

@@ -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

library/init/tactic.lean

@@ -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

src/emacs/lean-syntax.el

@@ -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

src/library/tactic/subst_tactic.cpp

@@ -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() {
 }

tests/lean/hott/substvars1.hlean

@@ -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

tests/lean/substvars2.hlean

@@ -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

tests/lean/substvars2.hlean.expected.out

@@ -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