103 lines
3.9 KiB
Text
103 lines
3.9 KiB
Text
/- In this example, we demonstrate how to add tracing to
|
||
the tactic implemented in the file back.lean.
|
||
We also use quotations to build terms. -/
|
||
open list expr tactic
|
||
|
||
universe variable u
|
||
|
||
/- We change the implicit arguments of in_tail and in_head.
|
||
The goal is to allow us to create in_tail and in_head application using
|
||
quotation without having information about the expected type. -/
|
||
lemma in_tail {α : Type u} {a : α} (b : α) {l : list α} : a ∈ l → a ∈ b::l :=
|
||
mem_cons_of_mem _
|
||
|
||
lemma in_head {α : Type u} (a : α) (l : list α) : a ∈ a::l :=
|
||
mem_cons_self _ _
|
||
|
||
lemma in_left {α : Type u} {a : α} {l : list α} (r : list α) : a ∈ l → a ∈ l ++ r :=
|
||
mem_append_left _
|
||
|
||
lemma in_right {α : Type u} {a : α} (l : list α) {r : list α} : a ∈ r → a ∈ l ++ r :=
|
||
mem_append_right _
|
||
|
||
meta def match_cons (e : expr) : tactic (expr × expr) :=
|
||
do [_, h, t] ← match_app_of e `list.cons | failed, return (h, t)
|
||
|
||
meta def match_append (e : expr) : tactic (expr × expr) :=
|
||
do [_, _, l, r] ← match_app_of e `has_append.append | failed, return (l, r)
|
||
|
||
/- The command `declare_trace` add a new trace.search_mem_list to Lean -/
|
||
declare_trace search_mem_list
|
||
|
||
/- The tactic (search_mem_list a e) tries to build a proof-term for (a ∈ e). -/
|
||
meta def search_mem_list : expr → expr → tactic expr
|
||
| a e :=
|
||
/- The tactic (when_tracing id tac) executes the tactic `tac` if
|
||
the option trace.id is set to true. -/
|
||
when_tracing `search_mem_list (do
|
||
/- The tactic (pp e) pretty-prints the given expression.
|
||
It returns the formatting object for `e`. It will
|
||
format it with respect to the local context and environment associated
|
||
with the main goal. -/
|
||
a_fmt ← pp a,
|
||
e_fmt ← pp e,
|
||
trace (to_fmt "search " ++ a_fmt ++ to_fmt " in " ++ e_fmt))
|
||
>>
|
||
(do m ← mk_app `has_mem.mem [a, e], find_assumption m)
|
||
<|>
|
||
/-
|
||
A quoted term `(t) is a pre-term. The tactic to_expr elaborates a pre-term
|
||
with respect to the current main goal. The notation %%t is an anti-quotation.
|
||
-/
|
||
(do (l, r) ← match_append e, h ← search_mem_list a l, to_expr ``(in_left %%r %%h))
|
||
<|>
|
||
(do (l, r) ← match_append e, h ← search_mem_list a r, to_expr ``(in_right %%l %%h))
|
||
<|>
|
||
(do (b, t) ← match_cons e, is_def_eq a b, to_expr ``(in_head %%b %%t))
|
||
<|>
|
||
(do (b, t) ← match_cons e, h ← search_mem_list a t, to_expr ``(in_tail %%b %%h))
|
||
|
||
/- The tactic mk_mem_list tries to close the current goal using search_mem_list
|
||
if it is of the form (a ∈ e).
|
||
We can view mk_mem_list as an "overloaded lemma" as described by Gonthier et al.
|
||
in the paper "How to make ad hoc proof automation less ad hoc"
|
||
-/
|
||
meta def mk_mem_list : tactic unit :=
|
||
do t ← target,
|
||
[_, _, _, a, e] ← match_app_of t `has_mem.mem | failed,
|
||
search_mem_list a e >>= exact
|
||
|
||
example (a b c : nat) : a ∈ [b, c] ++ [b, a, b] :=
|
||
by mk_mem_list
|
||
|
||
example (a b c : nat) : a ∈ [b, c] ++ [b, a+0, b] :=
|
||
by mk_mem_list
|
||
|
||
/- We can enable/disable the tracing messages
|
||
using the set_option command.
|
||
Later, we demonstrate how to use the Lean debugger and VM monitor. -/
|
||
set_option trace.search_mem_list true
|
||
|
||
example (a b c : nat) : a ∈ [b, c] ++ [b, c, c] ++ [b, a+0, b] :=
|
||
by mk_mem_list
|
||
|
||
set_option trace.search_mem_list false
|
||
|
||
example (a b c : nat) (l : list nat) : a ∈ l → a ∈ [b, c] ++ b::l :=
|
||
by tactic.intros >> mk_mem_list
|
||
|
||
example (a b c : nat) (l : list nat) : a ∈ l → a ∈ b::b::c::l ++ [c, c, b] :=
|
||
by tactic.intros >> mk_mem_list
|
||
|
||
/- We can use mk_mem_list nested in our proofs -/
|
||
example (a b c : nat) (l₁ l₂ : list nat) : (a ∈ l₁ ∨ a ∈ l₂) → a ∈ b::l₂ ∨ a ∈ b::c::l₁ ++ [b, c]
|
||
| (or.inl h) := or.inr (by mk_mem_list)
|
||
| (or.inr r) := or.inl (by mk_mem_list)
|
||
|
||
/- We can prove the same theorem using just tactics. -/
|
||
example (a b c : nat) (l₁ l₂ : list nat) : (a ∈ l₁ ∨ a ∈ l₂) → a ∈ b::l₂ ∨ a ∈ b::c::l₁ ++ [b, c] :=
|
||
begin
|
||
intro h, cases h,
|
||
{apply or.inr, mk_mem_list},
|
||
{apply or.inl, mk_mem_list}
|
||
end
|