feat(library/init/meta): improve dsimp tactic notation

This commit is contained in:
Leonardo de Moura 2017-01-09 17:31:12 -08:00
parent 5d750ba0a4
commit b1c1d2dfa4
3 changed files with 97 additions and 11 deletions

View file

@ -391,13 +391,13 @@ meta def simp_using_hs (hs : opt_qexpr_list) (attr_names : with_ident_list) (ids
do ctx ← collect_ctx_simps,
simp_core default_simplify_config ctx hs attr_names ids []
private meta def dsimp_hyps : location → tactic unit
private meta def dsimp_hyps (s : simp_lemmas) : location → tactic unit
| [] := skip
| (h::hs) := get_local h >>= dsimp_at
| (h::hs) := get_local h >>= dsimp_at_core s
meta def dsimp : location → tactic unit
| [] := tactic.dsimp
| hs := dsimp_hyps hs
meta def dsimp (es : opt_qexpr_list) (attr_names : with_ident_list) (ids : without_ident_list) : location → tactic unit
| [] := do s ← mk_simp_set attr_names es ids, tactic.dsimp_core s
| hs := do s ← mk_simp_set attr_names es ids, dsimp_hyps s hs
meta def reflexivity : tactic unit :=
tactic.reflexivity

View file

@ -224,18 +224,22 @@ simplify_goal default_simplify_config hs >> try triv
meta def ctx_simp : tactic unit :=
simplify_goal {default_simplify_config with contextual := tt} [] >> try triv >> try (reflexivity_core reducible)
meta def dsimp : tactic unit :=
do S ← simp_lemmas.mk_default,
target >>= S^.dsimplify >>= change
meta def dsimp_core (s : simp_lemmas) : tactic unit :=
target >>= s^.dsimplify >>= change
meta def dsimp_at (h : expr) : tactic unit :=
meta def dsimp : tactic unit :=
simp_lemmas.mk_default >>= dsimp_core
meta def dsimp_at_core (s : simp_lemmas) (h : expr) : tactic unit :=
do num_reverted : ← revert h,
(expr.pi n bi d b : expr) ← target | failed,
S ← simp_lemmas.mk_default,
h_simp ← S^.dsimplify d,
h_simp ← s^.dsimplify d,
change $ expr.pi n bi h_simp b,
intron num_reverted
meta def dsimp_at (h : expr) : tactic unit :=
do s ← simp_lemmas.mk_default, dsimp_at_core s h
private meta def is_equation : expr → bool
| (expr.pi n bi d b) := is_equation b
| e := match (expr.is_eq e) with (some a) := tt | none := ff end

View file

@ -0,0 +1,82 @@
def f : nat → nat
| 0 := 10
| (n+1) := 20 + n
open list tactic
meta def check_expr (p : pexpr) (t : expr) : tactic unit :=
do e ← to_expr p, guard (t = e)
meta def check_target (p : pexpr) : tactic unit :=
do t ← target, check_expr p t
example (a b c : nat) : head (map f [1, 2, 3]) = 20 :=
begin
dsimp [map],
check_target `(head [f 1, f 2, f 3] = 20),
dsimp [f],
check_target `(head [20 + 0, 20 + 1, 20 + 2] = 20),
dsimp [head],
check_target `(20 + 0 = 20),
reflexivity
end
example (a b c : nat) : head (map f [1, 2, 3]) = 20 :=
begin
dsimp [map, f, head],
check_target `(20 + 0 = 20),
reflexivity
end
@[simp] lemma succ_zero_eq_one : nat.succ 0 = 1 :=
rfl
def g : nat × nat → nat
| (a, b) := a + b
lemma gax (x y) : g (x, y) = x + y :=
rfl
attribute [simp] gax
example (a b c : nat) : g (f 1, f 2) = 41 :=
begin
dsimp,
check_target `(f 1 + f 2 = 41),
dsimp [f],
reflexivity
end
example (a b c : nat) : g (f 1, f 2) = 41 :=
begin
dsimp [f],
check_target `(20 + 0 + (20 + 1) = 41),
reflexivity
end
example (a b c : nat) : g (f 1, f 2) = 41 :=
begin
dsimp [f] without gax,
check_target `(g (20 + 0, 20 + 1) = 41),
dsimp [g],
check_target `(20 + 0 + (20 + 1) = 41),
reflexivity
end
local attribute [-simp] gax
example (a b c : nat) : g (f 1, f 2) = 41 :=
begin
dsimp [f],
check_target `(g (20 + 0, 20 + 1) = 41),
dsimp [gax],
check_target `(20 + 0 + (20 + 1) = 41),
reflexivity
end
example (a b c : nat) : g (f 1, f 2) = 41 :=
begin
dsimp [f, gax],
check_target `(20 + 0 + (20 + 1) = 41),
reflexivity
end