Commit faf2018e authored by Ralf Jung's avatar Ralf Jung
Browse files

make u_strip_later more clever; also use it for wp_strip_later

parent 6428df91
......@@ -61,7 +61,7 @@ Section LiftingTests.
Lemma Pred_spec n E Φ : Φ (LitV (n - 1)) || Pred 'n @ E {{ Φ }}.
Proof.
wp_lam>; apply later_mono; wp_op=> ?; wp_if.
wp_lam. wp_op=> ?; wp_if.
- wp_op. wp_op.
(* TODO: Can we use the wp tactic again here? It seems that the tactic fails if there
are goals being generated. That should not be the case. *)
......
From heap_lang Require Export tactics substitution.
Import uPred.
(* TODO: The next 6 tactics are not wp-specific at all. They should move elsewhere. *)
(* TODO: The next 5 tactics are not wp-specific at all. They should move elsewhere. *)
Ltac revert_intros tac :=
lazymatch goal with
| |- _, _ => let H := fresh in intro H; revert_intros tac; revert H
| |- _ => tac
end.
Ltac wp_strip_later :=
let rec go :=
lazymatch goal with
| |- _ (_ _) => apply sep_mono; go
| |- _ _ => apply later_intro
| |- _ _ => reflexivity
end
in revert_intros ltac:(etrans; [|go]).
(** Assumes a goal of the shape P Q.
Will get rid of in P below , and . *)
(** Assumes a goal of the shape P Q. Alterantively, if Q
is built of , , with in all branches; that will work, too.
Will turn this goal into P Q and strip in P below , , . *)
Ltac u_strip_later :=
let rec strip :=
match goal with
lazymatch goal with
| |- (_ _) _ =>
etrans; last (eapply equiv_spec, later_sep);
apply sep_mono; strip
......@@ -34,7 +27,25 @@ Ltac u_strip_later :=
| |- _ _ => apply later_mono; reflexivity
| |- _ _ => apply later_intro; reflexivity
end
in etrans; last eapply later_mono; first solve [ strip ].
in let rec shape_Q :=
lazymatch goal with
| |- _ (_ _) =>
(* Force the later on the LHS to be top-level, matching laters
below on the RHS *)
etrans; first (apply equiv_spec; symmetry; apply later_sep; reflexivity);
(* Match the arm recursively *)
apply sep_mono; shape_Q
| |- _ (_ _) =>
etrans; first (apply equiv_spec; symmetry; apply later_and; reflexivity);
apply sep_mono; shape_Q
| |- _ (_ _) =>
etrans; first (apply equiv_spec; symmetry; apply later_or; reflexivity);
apply sep_mono; shape_Q
| |- _ _ => apply later_mono; reflexivity
(* We fail if we don't find laters in all branches. *)
end
in revert_intros ltac:(etrans; [|shape_Q];
etrans; last eapply later_mono; first solve [ strip ]).
(* ssreflect-locks the part after the *)
(* FIXME: I tried doing a lazymatch to only apply the tactic if the goal has shape ,
......@@ -47,28 +58,31 @@ Ltac u_lock_goal := revert_intros ltac:(apply uPred_lock_conclusion).
Ltac u_revert_all :=
lazymatch goal with
| |- _, _ => let H := fresh in intro H; u_revert_all;
(* TODO: Really, we should distinguish based on whether this is a
dependent function type or not. Right now, we distinguish based
on the sort of the argument, which is suboptimal. *)
first [ apply (const_intro_impl _ _ _ H); clear H
| revert H; apply forall_elim']
(* TODO: Really, we should distinguish based on whether this is a
dependent function type or not. Right now, we distinguish based
on the sort of the argument, which is suboptimal. *)
first [ apply (const_intro_impl _ _ _ H); clear H
| revert H; apply forall_elim']
| |- ?C _ => trans (True C)%I;
first (rewrite [(True C)%I]left_id; reflexivity);
apply wand_elim_l'
first (rewrite [(True C)%I]left_id; reflexivity);
apply wand_elim_l'
end.
(** This starts on a goal of the form ..., ?0... ?1 ?2.
It applies löb where all the Coq assumptions have been turned into logical
assumptions, then moves all the Coq assumptions back out to the context,
applies [tac] on the goal (now of the form _ _), and then reverts the Coq
assumption so that we end up with the same shape as where we started. *)
applies [tac ()] on the goal (now of the form _ _), and then reverts the
Coq assumption so that we end up with the same shape as where we started.
[tac] is a thunk because I found no other way to prevent Coq from expandig
matches too early.*)
Ltac u_löb tac :=
u_lock_goal; u_revert_all;
(* We now have a goal for the form True P, with the "original" conclusion
being locked. *)
apply löb_strong; etransitivity;
first (apply equiv_spec; symmetry; apply (left_id _ _ _); reflexivity);
(* Now introduce again all the things that we reverted, and at the bottom, do the work *)
(* Now introduce again all the things that we reverted, and at the bottom,
do the work *)
let rec go :=
lazymatch goal with
| |- _ ( _, _) => apply forall_intro;
......@@ -76,13 +90,21 @@ Ltac u_löb tac :=
| |- _ ( _ _) => apply impl_intro_l, const_elim_l;
let H := fresh in intro H; go; revert H
| |- ?R (?L - locked _) => apply wand_intro_l;
(* TODO: Do sth. more robust than rewriting. *)
trans ( L R)%I; first (apply sep_mono_l, later_intro; reflexivity);
trans ( (L R))%I; first (apply equiv_spec, later_sep; reflexivity );
unlock; tac
unlock; tac ()
end
in go.
(** wp-specific helper tactics *)
(* First try to productively strip off laters; if that fails, at least
cosmetically get rid of laters in the conclusion. *)
Ltac wp_strip_later :=
let rec go :=
lazymatch goal with
| |- _ (_ _) => apply sep_mono; go
| |- _ _ => apply later_intro
| |- _ _ => reflexivity
end
in revert_intros ltac:(first [ u_strip_later | etrans; [|go] ] ).
Ltac wp_bind K :=
lazymatch eval hnf in K with
| [] => idtac
......@@ -101,16 +123,16 @@ Ltac wp_finish :=
| _ => idtac
end in simpl; revert_intros go.
Tactic Notation "wp_rec" :=
u_löb ltac:((* Find the redex and apply wp_rec *)
match goal with
Tactic Notation "wp_rec" ">" :=
u_löb ltac:(fun _ => (* Find the redex and apply wp_rec *)
lazymatch goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
match eval cbv in e' with
| App (Rec _ _ _) _ =>
wp_bind K; etrans; [|eapply wp_rec; reflexivity]; wp_finish
end)
end;
apply later_mono).
end).
Tactic Notation "wp_rec" := wp_rec>; wp_strip_later.
Tactic Notation "wp_lam" ">" :=
match goal with
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment