feat(library/init/meta/converter/interactive): add support for rw at conv tactical

This commit is contained in:
Leonardo de Moura 2017-06-30 12:41:35 -07:00
parent f7fe2a775c
commit 6208934134
4 changed files with 41 additions and 2 deletions

View file

@ -25,6 +25,7 @@ master branch (aka work in progress branch)
Examples:
- `conv at h in (f _ _) { simp }` applies `simp` to first subterm matching `f _ _` at hypothesis `h`.
- `conv in (_ = _) { to_lhs, whnf }` replace the left-hand-side of the equality in target with its weak-head-normal-form.
- `conv at h in (0 + _) { rw [zero_add] }`
*Changes*

View file

@ -98,6 +98,31 @@ do s ← tactic.mk_simp_set no_dflt attr_names hs ids,
meta def guard_lhs (p : parse texpr) : tactic unit :=
do t ← lhs, tactic.interactive.guard_expr_eq t p
section rw
open tactic.interactive (rw_rules rw_rule get_rule_eqn_lemmas to_expr')
open tactic (rewrite_cfg)
private meta def rw_lhs (h : expr) (cfg : rewrite_cfg) : conv unit :=
do l ← conv.lhs,
(new_lhs, prf, _) ← tactic.rewrite h l cfg,
update_lhs new_lhs prf
private meta def rw_core (rs : list rw_rule) (cfg : rewrite_cfg) : conv unit :=
rs.mfor' $ λ r, do
save_info r.pos,
eq_lemmas ← get_rule_eqn_lemmas r,
orelse'
(do h ← to_expr' r.rule, rw_lhs h {cfg with symm := r.symm})
(eq_lemmas.mfirst $ λ n, do e ← tactic.mk_const n, rw_lhs e {cfg with symm := r.symm})
(eq_lemmas.empty)
meta def rewrite (q : parse rw_rules) (cfg : rewrite_cfg := {}) : conv unit :=
rw_core q.rules cfg
meta def rw (q : parse rw_rules) (cfg : rewrite_cfg := {}) : conv unit :=
rw_core q.rules cfg
end rw
end interactive
end conv

View file

@ -279,7 +279,7 @@ do {
This is not an optimization, by skipping the elaborator we make sure that no unwanted resolution is used.
Example: the elaborator will force any unassigned ?A that must have be an instance of (has_one ?A) to nat.
Remark: another benefit is that auxiliary temporary metavariables do not appear in error messages. -/
private meta def to_expr' (p : pexpr) : tactic expr :=
meta def to_expr' (p : pexpr) : tactic expr :=
match p with
| (const c []) := do new_e ← resolve_name' c, save_type_info new_e p, return new_e
| (local_const c _ _ _) := do new_e ← resolve_name' c, save_type_info new_e p, return new_e
@ -294,7 +294,7 @@ meta structure rw_rule :=
meta instance rw_rule.reflect : has_reflect rw_rule :=
λ ⟨p, s, r⟩, `(_)
private meta def get_rule_eqn_lemmas (r : rw_rule) : tactic (list name) :=
meta def get_rule_eqn_lemmas (r : rw_rule) : tactic (list name) :=
let aux (n : name) : tactic (list name) := do {
p ← resolve_name n,
-- unpack local refs

View file

@ -62,3 +62,16 @@ begin
},
assumption
end
example (x y : nat) (f : nat → nat) (h : f (0 + x + y) = 0 + y) : f (x + y) = 0 + y :=
begin
-- use conv to rewrite subterm of a hypothesis
conv at h in (0 + _) { rw [zero_add] },
assumption
end
example (x : nat) (f : nat → nat) (h₁ : x = 0) (h₂ : ∀ x, f x = x + x) : f x = x :=
begin
conv { to_rhs, rw [h₁, -add_zero 0, -h₁], },
exact h₂ x
end