Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Created rewrite tactic #746

Merged
merged 8 commits into from
Jan 23, 2025
Merged
Show file tree
Hide file tree
Changes from 6 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
37 changes: 37 additions & 0 deletions apps/eltac/tests/test_rewrite.v
Original file line number Diff line number Diff line change
@@ -0,0 +1,37 @@
From elpi.apps Require Import eltac.rewrite.

Goal (forall x : nat, 1 + x = x + 1) ->
forall y, 2 * ((y+y) + 1) = ((y + y)+1) * 2.
Proof.
intro H.
intro x.
eltac.rewrite H.
eltac.rewrite PeanoNat.Nat.mul_comm.
exact eq_refl.
Defined.

Section Example_rewrite.
Variable A : Type.
Variable B : A -> Type.
Variable C : forall (a : A) (b : B a), Type.
Variable add : forall {a : A} {b : B a}, C a b -> C a b -> C a b.
Variable sym : forall {a : A} {b : B a} (c c' : C a b), add c c' = add c' c.

Goal forall (a : A) (b : B a) (x y : C a b),
add x y = add y x /\ add x y = add y x.
Proof.
intros a b x y.
eltac.rewrite @sym. (* @sym is a gref *)
(** [add y x = add y x /\ add y x = add y x] *)
easy.
Defined.

Goal forall (a : A) (b : B a) (x y : C a b),
add x y = add y x /\ add x y = add y x.
Proof.
intros a b x y.
eltac.rewrite sym. (* because of implicit arguments, this is sym _ _, which is a term *)
easy.
Defined.

End Example_rewrite.
50 changes: 50 additions & 0 deletions apps/eltac/theories/rewrite.v
Original file line number Diff line number Diff line change
@@ -0,0 +1,50 @@
From elpi Require Export elpi.

Elpi Tactic rewrite.
Elpi Accumulate lp:{{
% Second argument is a type of the form forall x1 x2 x3... P = Q.
% First argument is a term of that type.
% This tactic finds a subterm of the goal that Q unifies with
% and rewrites all instances of that subterm from right to left.
pred nested_forall i:term, i:term, o:goal, o:list sealed-goal.

% The copy predicate used below is discussed in the tutorial here:
% https://lpcic.github.io/coq-elpi/tutorial_coq_elpi_tactic.html#let-s-code-set-in-elpi

nested_forall Eqpf {{@eq lp:S lp:P lp:Q }} (goal _ _ GoalType _ _ as G) GL :-
% First, introduce a rule that causes "copy" to act as a function
% sending a type T to the same type, but with all
% subterms of T unifiable with Q to be replaced with a fresh constant x.
pi x\ (pi J\ copy J x :- coq.unify-leq Q J ok) =>
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This looks like a good introduction to the power of copy etc, thanks for providing it.

But this implementation of rewrite is known to be a "bad rewrite" since it is too smart, eg lets you rewrite with commutativity of addition on a goal like 2 * x = .. that has no addition in it. I recommend at least writing a comment about this, or write a more complex line that compares the key verbatim, see for
example

bind-list [app [C| AS] |VS] T R :- key C, !,
pi x\
(pi L X\ bind (app[C|L]) X :- get-option "unif:greedy" tt, unify-list-eq L AS, X = x, !) =>
(pi L X\ bind (app[C|L]) X :- not (get-option "unif:greedy" tt),unify-list-eq L AS, X = x) =>
bind-list VS T (R x).
or the ssreflect section in the Coq manual for keyd matching.

% Apply this copy function to the goal type.
(copy GoalType (A x),
% If the subterm Q did indeed appear in the goal,
% then pattern match on the given equality assumption P = Q,
% causing Q to be replaced with P everywhere.
if (occurs x (A x))
(refine (match
Eqpf
(fun _ S (a\
fun _ {{ @eq lp:S lp:P lp:Q }} (_\ A a )
))
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
(fun _ S (a\
fun _ {{ @eq lp:S lp:P lp:Q }} (_\ A a )
))
{{ fun a (e : @eq lp:S lp:P lp:Q) => lp:(A a) }}

Also shouldn't Q be a ?

% We only want to create one hole,
% the one corresponding to the
% contents of the (single) branch of the match.
[Hole_])
G GL
)
(coq.ltac.fail _ "Couldn't unify.")).

solve (goal Ctx _ _ _ [trm Eq] as G) GL :- (
% Eq is a direct Gallina term or a gref and we will infer its type
% from context
coq.typecheck Eq Ty ok;
% Eq is a reference to a declared variable in the context
std.mem Ctx (decl Eq _ Ty)),
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The LHS of ; should suffice since Ctx is loaded hence you are really running Ctx => coq.typecheck ... and that knows the type of proof variables.

coq.saturate Ty Eq Eq',
coq.typecheck Eq' Ty' ok,
nested_forall Eq' Ty' G GL.
}}.

Tactic Notation "eltac.rewrite" ident(T) := elpi rewrite ltac_term:(T).
Tactic Notation "eltac.rewrite" uconstr(T) := elpi rewrite ltac_term:(T).
1 change: 1 addition & 0 deletions apps/eltac/theories/tactics.v
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
From elpi.apps.eltac Require Export
intro
rewrite
constructor
assumption
discriminate
Expand Down
Loading