Commit 5b224d9c authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

More uniform treatment of arguments of iApply, iPoseProof,

iSpecialize and iDestruct.

These tactics now all take an iTrm, which is a tuple consisting of
a.) a lemma or name of a hypotheses b.) arguments to instantiate
c.) a specialization pattern.
parent 5c1f62d7
......@@ -82,12 +82,12 @@ Lemma ress_split i i1 i2 Q R1 R2 P I :
ress P ({[i1]} ({[i2]} (I {[i]}))).
Proof.
iIntros {????} "(#HQ&#H1&#H2&HQR&H)"; iDestruct "H" as {Ψ} "[HPΨ HΨ]".
iDestruct (big_sepS_delete _ _ i) "HΨ" as "[#HΨi HΨ]"; first done.
iDestruct (big_sepS_delete _ _ i with "HΨ") as "[#HΨi HΨ]"; first done.
iExists (<[i1:=R1]> (<[i2:=R2]> Ψ)). iSplitL "HQR HPΨ".
- iPoseProof (saved_prop_agree i Q (Ψ i)) "#" as "Heq"; first by iSplit.
iNext. iRewrite "Heq" in "HQR". iIntros "HP". iSpecialize "HPΨ" "HP".
iDestruct (big_sepS_delete _ _ i) "HPΨ" as "[HΨ HPΨ]"; first done.
iDestruct "HQR" "HΨ" as "[HR1 HR2]".
- iPoseProof (saved_prop_agree i Q (Ψ i) with "#") as "Heq"; first by iSplit.
iNext. iRewrite "Heq" in "HQR". iIntros "HP". iSpecialize ("HPΨ" with "HP").
iDestruct (big_sepS_delete _ _ i with "HPΨ") as "[HΨ HPΨ]"; first done.
iDestruct ("HQR" with "HΨ") as "[HR1 HR2]".
rewrite !big_sepS_insert''; [|set_solver ..]. by iFrame "HR1 HR2".
- rewrite !big_sepS_insert'; [|set_solver ..]. by repeat iSplit.
Qed.
......@@ -102,8 +102,8 @@ Proof.
rewrite /newbarrier. wp_seq. iApply wp_pvs. wp_alloc l as "Hl".
iApply "HΦ".
iPvs (saved_prop_alloc (F:=idCF) _ P) as {γ} "#?".
iPvs (sts_alloc (barrier_inv l P) _ N (State Low {[ γ ]}))
"-" as {γ'} "[#? Hγ']"; eauto.
iPvs (sts_alloc (barrier_inv l P) _ N (State Low {[ γ ]}) with "-")
as {γ'} "[#? Hγ']"; eauto.
{ iNext. rewrite /barrier_inv /=. iFrame "Hl".
iExists (const P). rewrite !big_sepS_singleton /=.
iSplit; [|done]. by iIntros "> ?". }
......@@ -113,7 +113,7 @@ Proof.
sts_ownS γ' low_states {[Send]})%I as "[Hr Hs]" with "-".
{ iApply sts_ownS_op; eauto using i_states_closed, low_states_closed.
+ set_solver.
+ iApply sts_own_weaken "Hγ'";
+ iApply (sts_own_weaken with "Hγ'");
auto using sts.closed_op, i_states_closed, low_states_closed;
set_solver. }
iPvsIntro. rewrite /recv /send. iSplitL "Hr".
......@@ -132,7 +132,7 @@ Proof.
iSplit; [iPureIntro; by eauto using signal_step|].
iSplitR "HΦ"; [iNext|by iIntros "?"].
rewrite {2}/barrier_inv /ress /=; iFrame "Hl".
iDestruct "Hr" as {Ψ} "[? Hsp]"; iExists Ψ; iFrame "Hsp".
iDestruct "Hr" as {Ψ} "[Hr Hsp]"; iExists Ψ; iFrame "Hsp".
iIntros "> _"; by iApply "Hr".
Qed.
......@@ -149,20 +149,20 @@ Proof.
{ iNext. rewrite {2}/barrier_inv /=. by iFrame "Hl". }
iIntros "Hγ".
iPvsAssert (sts_ownS γ (i_states i) {[Change i]})%I as "Hγ" with "[Hγ]".
{ iApply sts_own_weaken "Hγ"; eauto using i_states_closed. }
wp_op=> ?; simplify_eq; wp_if. iApply "IH" "Hγ [HQR] HΦ". by iNext.
{ iApply (sts_own_weaken with "Hγ"); eauto using i_states_closed. }
wp_op=> ?; simplify_eq; wp_if. iApply ("IH" with "Hγ [HQR] HΦ"). by iNext.
- (* a High state: the comparison succeeds, and we perform a transition and
return to the client *)
iExists (State High (I {[ i ]})), ( : set token).
iSplit; [iPureIntro; by eauto using wait_step|].
iDestruct "Hr" as {Ψ} "[HΨ Hsp]".
iDestruct (big_sepS_delete _ _ i) "Hsp" as "[#HΨi Hsp]"; first done.
iDestruct (big_sepS_delete _ _ i with "Hsp") as "[#HΨi Hsp]"; first done.
iAssert ( Ψ i Π★{set (I {[i]})} Ψ)%I as "[HΨ HΨ']" with "[HΨ]".
{ iNext. iApply (big_sepS_delete _ _ i); first done. by iApply "HΨ". }
iSplitL "HΨ' Hl Hsp"; [iNext|].
+ rewrite {2}/barrier_inv /=; iFrame "Hl".
iExists Ψ; iFrame "Hsp". by iIntros "> _".
+ iPoseProof (saved_prop_agree i Q (Ψ i)) "#" as "Heq"; first by iSplit.
+ iPoseProof (saved_prop_agree i Q (Ψ i) with "#") as "Heq"; first by iSplit.
iIntros "_". wp_op=> ?; simplify_eq/=; wp_if.
iPvsIntro. iApply "HΦ". iApply "HQR". by iRewrite "Heq".
Qed.
......@@ -188,7 +188,8 @@ Proof.
sts_ownS γ (i_states i2) {[Change i2]})%I as "[Hγ1 Hγ2]" with "-".
{ iApply sts_ownS_op; eauto using i_states_closed, low_states_closed.
+ set_solver.
+ iApply sts_own_weaken "Hγ"; eauto using sts.closed_op, i_states_closed.
+ iApply (sts_own_weaken with "Hγ");
eauto using sts.closed_op, i_states_closed.
set_solver. }
iPvsIntro; iSplitL "Hγ1"; rewrite /recv /barrier_ctx.
+ iExists γ, P, R1, i1. iFrame "Hγ1 Hi1". repeat iSplit; auto.
......@@ -205,8 +206,7 @@ Proof.
iIntros "> HQ". by iApply "HP"; iApply "HP1".
Qed.
Lemma recv_mono l P1 P2 :
P1 P2 recv l P1 recv l P2.
Lemma recv_mono l P1 P2 : P1 P2 recv l P1 recv l P2.
Proof.
intros HP%entails_wand. apply wand_entails. rewrite HP. apply recv_weaken.
Qed.
......
......@@ -56,7 +56,7 @@ Proof.
iIntros {?} "(#Hh & HR & HΦ)". rewrite /newlock.
wp_seq. iApply wp_pvs. wp_alloc l as "Hl".
iPvs (own_alloc (Excl ())) as {γ} "Hγ"; first done.
iPvs (inv_alloc N _ (lock_inv γ l R)) "-[HΦ]" as "#?"; first done.
iPvs (inv_alloc N _ (lock_inv γ l R) with "-[HΦ]") as "#?"; first done.
{ iNext. iExists false. by iFrame "Hl HR". }
iPvsIntro. iApply "HΦ". iExists N, γ. by repeat iSplit.
Qed.
......@@ -72,7 +72,7 @@ Proof.
+ wp_if. by iApply "IH".
- wp_cas_suc. iDestruct "HR" as "[Hγ HR]". iSplitL "Hl".
+ iNext. iExists true. by iSplit.
+ wp_if. iPvsIntro. iApply "HΦ" "-[HR] HR". iExists N, γ. by repeat iSplit.
+ wp_if. iApply ("HΦ" with "-[HR] HR"). iExists N, γ. by repeat iSplit.
Qed.
Lemma release_spec R l (Φ : val iProp) :
......@@ -83,6 +83,6 @@ Proof.
iInv N as "Hinv". iDestruct "Hinv" as {b} "[Hl Hγ']"; destruct b.
- wp_store. iFrame "HΦ". iNext. iExists false. by iFrame "Hl HR Hγ".
- wp_store. iDestruct "Hγ'" as "[Hγ' _]".
iCombine "Hγ" "Hγ'" as "Hγ". by iDestruct own_valid "Hγ" as "%".
iCombine "Hγ" "Hγ'" as "Hγ". by iDestruct (own_valid with "Hγ") as "%".
Qed.
End proof.
......@@ -32,7 +32,7 @@ Proof.
iIntros {l} "Hl". wp_let. wp_proj. wp_focus (f2 _).
iApply wp_wand_l; iFrame "Hf2"; iIntros {v} "H2". wp_let.
wp_apply join_spec; iFrame "Hl". iIntros {w} "H1".
iSpecialize "HΦ" "-"; first by iSplitL "H1". by wp_let.
iSpecialize ("HΦ" with "* -"); first by iSplitL "H1". by wp_let.
Qed.
Lemma wp_par (Ψ1 Ψ2 : val iProp) (e1 e2 : expr []) (Φ : val iProp) :
......
......@@ -59,11 +59,11 @@ Proof.
iIntros {<-%of_to_val ?} "(#Hh&Hf&HΦ)". rewrite /spawn.
wp_let; wp_alloc l as "Hl"; wp_let.
iPvs (own_alloc (Excl ())) as {γ} "Hγ"; first done.
iPvs (inv_alloc N _ (spawn_inv γ l Ψ)) "[Hl]" as "#?"; first done.
iPvs (inv_alloc N _ (spawn_inv γ l Ψ) with "[Hl]") as "#?"; first done.
{ iNext. iExists (InjLV #0). iFrame "Hl". by iLeft. }
wp_apply wp_fork. iSplitR "Hf".
- wp_seq. iPvsIntro. iApply "HΦ"; rewrite /join_handle. iSplit; first done.
iExists γ. iFrame "Hγ"; by iSplit.
- wp_seq. iPvsIntro. iApply "HΦ"; rewrite /join_handle.
iSplit; first done. iExists γ. iFrame "Hγ"; by iSplit.
- wp_focus (f _). iApply wp_wand_l; iFrame "Hf"; iIntros {v} "Hv".
iInv N as "Hinv"; first wp_done; iDestruct "Hinv" as {v'} "[Hl _]".
wp_store. iSplit; [iNext|done].
......@@ -78,13 +78,13 @@ Proof.
iInv N as "Hinv"; iDestruct "Hinv" as {v} "[Hl Hinv]".
wp_load. iDestruct "Hinv" as "[%|Hinv]"; subst.
- iSplitL "Hl"; [iNext; iExists _; iFrame "Hl"; by iLeft|].
wp_case. wp_seq. iApply "IH" "Hγ Hv".
wp_case. wp_seq. iApply ("IH" with "Hγ Hv").
- iDestruct "Hinv" as {v'} "[% [HΨ|Hγ']]"; subst.
+ iSplitL "Hl Hγ".
{ iNext. iExists _; iFrame "Hl"; iRight.
iExists _; iSplit; [done|by iRight]. }
wp_case. wp_let. iPvsIntro. by iApply "Hv".
+ iCombine "Hγ" "Hγ'" as "Hγ". by iDestruct own_valid "Hγ" as "%".
+ iCombine "Hγ" "Hγ'" as "Hγ". iDestruct (own_valid with "Hγ") as %[].
Qed.
End proof.
......
......@@ -90,12 +90,6 @@ Tactic Notation "wp_apply" open_constr(lem) :=
wp_bind K; iApply lem; try iNext)
end.
Tactic Notation "wp_apply" open_constr(lem) constr(Hs) :=
match goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
wp_bind K; iApply lem Hs; try iNext)
end.
Tactic Notation "wp_alloc" ident(l) "as" constr(H) :=
match goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
......
......@@ -62,9 +62,9 @@ Lemma ht_vs E P P' Φ Φ' e :
((P ={E}=> P') {{ P' }} e @ E {{ Φ' }} v, Φ' v ={E}=> Φ v)
{{ P }} e @ E {{ Φ }}.
Proof.
iIntros "(#Hvs&#Hwp&#HΦ) ! HP". iPvs "Hvs" "HP" as "HP".
iIntros "(#Hvs&#Hwp&#HΦ) ! HP". iPvs ("Hvs" with "HP") as "HP".
iApply wp_pvs; iApply wp_wand_r; iSplitL; [by iApply "Hwp"|].
iIntros {v} "Hv". by iApply "HΦ" "!".
iIntros {v} "Hv". by iApply ("HΦ" with "!").
Qed.
Lemma ht_atomic E1 E2 P P' Φ Φ' e :
......@@ -73,9 +73,9 @@ Lemma ht_atomic E1 E2 P P' Φ Φ' e :
{{ P }} e @ E1 {{ Φ }}.
Proof.
iIntros {??} "(#Hvs&#Hwp&#HΦ) ! HP". iApply (wp_atomic _ E2); auto.
iPvs "Hvs" "HP" as "HP"; first set_solver. iPvsIntro.
iPvs ("Hvs" with "HP") as "HP"; first set_solver. iPvsIntro.
iApply wp_wand_r; iSplitL; [by iApply "Hwp"|].
iIntros {v} "Hv". by iApply "HΦ" "!".
iIntros {v} "Hv". by iApply ("HΦ" with "!").
Qed.
Lemma ht_bind `{LanguageCtx Λ K} E P Φ Φ' e :
......@@ -84,7 +84,7 @@ Lemma ht_bind `{LanguageCtx Λ K} E P Φ Φ' e :
Proof.
iIntros "(#Hwpe&#HwpK) ! HP". iApply wp_bind.
iApply wp_wand_r; iSplitL; [by iApply "Hwpe"|].
iIntros {v} "Hv". by iApply "HwpK" "!".
iIntros {v} "Hv". by iApply ("HwpK" with "!").
Qed.
Lemma ht_mask_weaken E1 E2 P Φ e :
......@@ -110,9 +110,8 @@ Proof.
iIntros {???} "[#Hvs1 [#Hvs2 #Hwp]] ! [HR HP]".
iApply (wp_frame_step_l E E1 E2); try done.
iSplitL "HR"; [|by iApply "Hwp"].
iPvs "Hvs1" "HR"; first by set_solver.
iPvsIntro. iNext.
by iPvs "Hvs2" "Hvs1"; first by set_solver.
iPvs ("Hvs1" with "HR"); first by set_solver.
iPvsIntro. iNext. by iApply "Hvs2".
Qed.
Lemma ht_frame_step_r E E1 E2 P R1 R2 R3 e Φ :
......
......@@ -31,13 +31,13 @@ Lemma ht_lift_step E1 E2
Proof.
iIntros {?? Hsafe Hstep} "#(#Hvs&HΦ&He2&Hef) ! HP".
iApply (wp_lift_step E1 E2 φ _ e1 σ1); auto.
iPvs "Hvs" "HP" as "[Hσ HP]"; first set_solver.
iPvs ("Hvs" with "HP") as "[Hσ HP]"; first set_solver.
iPvsIntro. iNext. iSplitL "Hσ"; [done|iIntros {e2 σ2 ef} "[#Hφ Hown]"].
iSpecialize "HΦ" {e2 σ2 ef} "! -". by iFrame "Hφ HP Hown".
iSpecialize ("HΦ" $! e2 σ2 ef with "! -"). by iFrame "Hφ HP Hown".
iPvs "HΦ" as "[H1 H2]"; first by set_solver.
iPvsIntro. iSplitL "H1".
- by iApply "He2" "!".
- destruct ef as [e|]; last done. by iApply "Hef" {_ _ (Some e)} "!".
- by iApply ("He2" with "!").
- destruct ef as [e|]; last done. by iApply ("Hef" $! _ _ (Some e) with "!").
Qed.
Lemma ht_lift_atomic_step
......@@ -74,8 +74,9 @@ Proof.
iIntros {? Hsafe Hstep} "[#He2 #Hef] ! HP".
iApply (wp_lift_pure_step E φ _ e1); auto.
iNext; iIntros {e2 ef Hφ}. iDestruct "HP" as "[HP HP']"; iSplitL "HP".
- iApply "He2" "!"; by iSplit.
- destruct ef as [e|]; last done. iApply "Hef" {_ (Some e)} "!"; by iSplit.
- iApply ("He2" with "!"); by iSplit.
- destruct ef as [e|]; last done.
iApply ("Hef" $! _ (Some e) with "!"); by iSplit.
Qed.
Lemma ht_lift_pure_det_step
......@@ -91,6 +92,6 @@ Proof.
iSplit; iIntros {e2' ef'}.
- iIntros "! [#He ?]"; iDestruct "He" as %[-> ->]. by iApply "He2".
- destruct ef' as [e'|]; last done.
iIntros "! [#He ?]"; iDestruct "He" as %[-> ->]. by iApply "Hef" "!".
iIntros "! [#He ?]"; iDestruct "He" as %[-> ->]. by iApply ("Hef" with "!").
Qed.
End lifting.
......@@ -65,7 +65,7 @@ Lemma vs_transitive E1 E2 E3 P Q R :
E2 E1 E3 ((P ={E1,E2}=> Q) (Q ={E2,E3}=> R)) (P ={E1,E3}=> R).
Proof.
iIntros {?} "#[HvsP HvsQ] ! HP".
iPvs "HvsP" "! HP" as "HQ"; first done. by iApply "HvsQ" "!".
iPvs ("HvsP" with "! HP") as "HQ"; first done. by iApply ("HvsQ" with "!").
Qed.
Lemma vs_transitive' E P Q R : ((P ={E}=> Q) (Q ={E}=> R)) (P ={E}=> R).
......@@ -95,7 +95,7 @@ Lemma vs_inv N E P Q R :
nclose N E (inv N R ( R P ={E nclose N}=> R Q)) (P ={E}=> Q).
Proof.
iIntros {?} "#[? Hvs] ! HP". eapply pvs_inv; eauto.
iIntros "HR". iApply "Hvs" "!". by iSplitL "HR".
iIntros "HR". iApply ("Hvs" with "!"). by iSplitL "HR".
Qed.
Lemma vs_alloc N P : P ={N}=> inv N P.
......
From iris.algebra Require Export upred.
From iris.algebra Require Import upred_big_op upred_tactics.
From iris.proofmode Require Export environments.
From iris.prelude Require Import stringmap.
From iris.prelude Require Import stringmap hlist.
Import uPred.
Local Notation "Γ !! j" := (env_lookup j Γ).
......@@ -287,16 +287,6 @@ Lemma tac_clear_spatial Δ Δ' Q :
envs_clear_spatial Δ = Δ' Δ' Q Δ Q.
Proof. intros <- ?. by rewrite envs_clear_spatial_sound // sep_elim_l. Qed.
Lemma tac_duplicate Δ Δ' i p j P Q :
envs_lookup i Δ = Some (p, P)
p = true
envs_simple_replace i true (Esnoc (Esnoc Enil i P) j P) Δ = Some Δ'
Δ' Q Δ Q.
Proof.
intros ? -> ??. rewrite envs_simple_replace_sound //; simpl.
by rewrite right_id idemp wand_elim_r.
Qed.
(** * False *)
Lemma tac_ex_falso Δ Q : Δ False Δ Q.
Proof. by rewrite -(False_elim Q). Qed.
......@@ -560,7 +550,7 @@ Proof.
by rewrite right_id {1}(persistentP P) always_and_sep_l wand_elim_r.
Qed.
(** Whenever posing [lem : True ⊢ Q] as [H} we want it to appear as [H : Q] and
(** Whenever posing [lem : True ⊢ Q] as [H] we want it to appear as [H : Q] and
not as [H : True -★ Q]. The class [ToPosedProof] is used to strip off the
[True]. Note that [to_posed_proof_True] is declared using a [Hint Extern] to
make sure it is not used while posing [lem : ?P ⊢ Q] with [?P] an evar. *)
......@@ -579,6 +569,18 @@ Proof.
by rewrite right_id -(to_pose_proof P1 P2 R) // always_const wand_True.
Qed.
Lemma tac_pose_proof_hyp Δ Δ' Δ'' i p j P Q :
envs_lookup_delete i Δ = Some (p, P, Δ')
envs_app p (Esnoc Enil j P) (if p then Δ else Δ') = Some Δ''
Δ'' Q Δ Q.
Proof.
intros [? ->]%envs_lookup_delete_Some ? <-. destruct p.
- rewrite envs_lookup_persistent_sound // envs_app_sound //; simpl.
by rewrite right_id wand_elim_r.
- rewrite envs_lookup_sound // envs_app_sound //; simpl.
by rewrite right_id wand_elim_r.
Qed.
Lemma tac_apply Δ Δ' i p R P1 P2 :
envs_lookup_delete i Δ = Some (p, R, Δ')%I ToWand R P1 P2
Δ' P1 Δ P2.
......@@ -826,13 +828,26 @@ Qed.
Lemma tac_forall_intro {A} Δ (Φ : A uPred M) : ( a, Δ Φ a) Δ ( a, Φ a).
Proof. apply forall_intro. Qed.
Lemma tac_forall_specialize {A} Δ Δ' i p (Φ : A uPred M) Q a :
envs_lookup i Δ = Some (p, a, Φ a)%I
envs_simple_replace i p (Esnoc Enil i (Φ a)) Δ = Some Δ'
Class ForallSpecialize {As} (xs : hlist As)
(P : uPred M) (Φ : himpl As (uPred M)) :=
forall_specialize : P happly Φ xs.
Arguments forall_specialize {_} _ _ _ {_}.
Global Instance forall_specialize_nil P : ForallSpecialize hnil P P | 100.
Proof. done. Qed.
Global Instance forall_specialize_cons A As x xs Φ (Ψ : A himpl As (uPred M)) :
( x, ForallSpecialize xs (Φ x) (Ψ x))
ForallSpecialize (hcons x xs) ( x : A, Φ x) Ψ.
Proof. rewrite /ForallSpecialize /= => <-. by rewrite (forall_elim x). Qed.
Lemma tac_forall_specialize {As} Δ Δ' i p P (Φ : himpl As (uPred M)) Q xs :
envs_lookup i Δ = Some (p, P) ForallSpecialize xs P Φ
envs_simple_replace i p (Esnoc Enil i (happly Φ xs)) Δ = Some Δ'
Δ' Q Δ Q.
Proof.
intros. rewrite envs_simple_replace_sound //; simpl.
destruct p; by rewrite /= right_id (forall_elim a) wand_elim_r.
intros. rewrite envs_simple_replace_sound //; simpl. destruct p.
- by rewrite right_id (forall_specialize _ P) wand_elim_r.
- by rewrite right_id (forall_specialize _ P) wand_elim_r.
Qed.
Lemma tac_forall_revert {A} Δ (Φ : A uPred M) :
......
......@@ -118,89 +118,44 @@ Tactic Notation "iPvsCore" constr(H) :=
end.
Tactic Notation "iPvs" open_constr(H) :=
iPoseProof H as (fun H => iPvsCore H; last iDestruct H as "?").
iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as "?").
Tactic Notation "iPvs" open_constr(H) "as" constr(pat) :=
iPoseProof H as (fun H => iPvsCore H; last iDestruct H as pat).
iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as pat).
Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1) "}"
constr(pat) :=
iPoseProof H as (fun H => iPvsCore H; last iDestruct H as { x1 } pat).
iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as { x1 } pat).
Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
simple_intropattern(x2) "}" constr(pat) :=
iPoseProof H as (fun H => iPvsCore H; last iDestruct H as { x1 x2 } pat).
iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as { x1 x2 } pat).
Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) "}" constr(pat) :=
iPoseProof H as (fun H => iPvsCore H; last iDestruct H as { x1 x2 x3 } pat).
iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as { x1 x2 x3 } pat).
Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) "}"
constr(pat) :=
iPoseProof H as (fun H =>
iDestructHelp H as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 x3 x4 } pat).
Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
simple_intropattern(x5) "}" constr(pat) :=
iPoseProof H as (fun H =>
iDestructHelp H as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 } pat).
Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
simple_intropattern(x5) simple_intropattern(x6) "}" constr(pat) :=
iPoseProof H as (fun H =>
iDestructHelp H as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 x6 } pat).
Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) "}"
constr(pat) :=
iPoseProof H as (fun H =>
iDestructHelp H as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 x6 x7 } pat).
Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
simple_intropattern(x8) "}" constr(pat) :=
iPoseProof H as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 x6 x7 x8 } pat).
Tactic Notation "iPvs" open_constr(lem) constr(Hs) :=
iPoseProof lem Hs as (fun H => iPvsCore H; last iDestruct H as "?").
Tactic Notation "iPvs" open_constr(lem) constr(Hs) "as" constr(pat) :=
iPoseProof lem Hs as (fun H => iPvsCore H; last iDestruct H as pat).
Tactic Notation "iPvs" open_constr(lem) constr(Hs) "as" "{"
simple_intropattern(x1) "}" constr(pat) :=
iPoseProof lem Hs as (fun H => iPvsCore H; last iDestruct H as { x1 } pat).
Tactic Notation "iPvs" open_constr(lem) constr(Hs) "as" "{"
simple_intropattern(x1) simple_intropattern(x2) "}" constr(pat) :=
iPoseProof lem Hs as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 } pat).
Tactic Notation "iPvs" open_constr(lem) constr(Hs) "as" "{"
simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3) "}"
constr(pat) :=
iPoseProof lem Hs as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 x3 } pat).
Tactic Notation "iPvs" open_constr(lem) constr(Hs) "as" "{"
simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
simple_intropattern(x4) "}" constr(pat) :=
iPoseProof lem Hs as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 x3 x4 } pat).
Tactic Notation "iPvs" open_constr(lem) constr(Hs) "as" "{"
simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
simple_intropattern(x4) simple_intropattern(x5) "}" constr(pat) :=
iPoseProof lem Hs as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 } pat).
Tactic Notation "iPvs" open_constr(lem) constr(Hs) "as" "{"
simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
simple_intropattern(x4) simple_intropattern(x5) simple_intropattern(x6) "}"
constr(pat) :=
iPoseProof lem Hs as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 x6 } pat).
Tactic Notation "iPvs" open_constr(lem) constr(Hs) "as" "{"
simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
simple_intropattern(x4) simple_intropattern(x5) simple_intropattern(x6)
simple_intropattern(x7) "}" constr(pat) :=
iPoseProof lem Hs as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 x6 x7 } pat).
Tactic Notation "iPvs" open_constr(lem) constr(Hs) "as" "{"
simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
simple_intropattern(x4) simple_intropattern(x5) simple_intropattern(x6)
simple_intropattern(x7) simple_intropattern(x8) "}" constr(pat) :=
iPoseProof lem Hs as (fun H =>
iDestructHelp H as (fun H =>
iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 x6 x7 x8 } pat).
Tactic Notation "iTimeless" constr(H) :=
......@@ -228,7 +183,7 @@ Tactic Notation "iPvsAssert" constr(Q) "as" constr(pat) "with" constr(Hs) :=
let H := iFresh in
let Hs := spec_pat.parse_one Hs in
lazymatch Hs with
| SSplit ?lr ?Hs =>
| SAssert ?lr ?Hs =>
eapply tac_pvs_assert with _ _ _ _ _ _ lr Hs H Q _;
[let P := match goal with |- FSASplit ?P _ _ _ _ => P end in
apply _ || fail "iPvsAssert: " P "not a pvs"
......
From iris.prelude Require Export strings.
Inductive spec_pat :=
| SSplit : bool list string spec_pat
| SAssert : bool list string spec_pat
| SPersistent : spec_pat
| SPure : spec_pat
| SAlways : spec_pat
| SName : string spec_pat.
| SName : string spec_pat
| SForall : spec_pat.
Module spec_pat.
Inductive token :=
......@@ -15,7 +16,8 @@ Inductive token :=
| TBracketR : token
| TPersistent : token
| TPure : token
| TAlways : token.
| TAlways : token
| TForall : token.
Fixpoint cons_name (kn : string) (k : list token) : list token :=
match kn with "" => k | _ => TName (string_rev kn) :: k end.
......@@ -29,29 +31,31 @@ Fixpoint tokenize_go (s : string) (k : list token) (kn : string) : list token :=
| String "#" s => tokenize_go s (TPersistent :: cons_name kn k) ""
| String "%" s => tokenize_go s (TPure :: cons_name kn k) ""
| String "!" s => tokenize_go s (TAlways :: cons_name kn k) ""
| String "*" s => tokenize_go s (TForall :: cons_name kn k) ""
| String a s => tokenize_go s k (String a kn)
end.
Definition tokenize (s : string) : list token := tokenize_go s [] "".
Fixpoint parse_go (ts : list token) (split : option (bool * list string))
Fixpoint parse_go (ts : list token) (g : option (bool * list string))
(k : list spec_pat) : option (list spec_pat) :=
match split with
match g with
| None =>
match ts with
| [] => Some (rev k)
| TName s :: ts => parse_go ts None (SName s :: k)
| TMinus :: TBracketL :: ts => parse_go ts (Some (true,[])) k
| TMinus :: ts => parse_go ts None (SSplit true [] :: k)
| TMinus :: ts => parse_go ts None (SAssert true [] :: k)
| TBracketL :: ts => parse_go ts (Some (false,[])) k
| TAlways :: ts => parse_go ts None (SAlways :: k)
| TPersistent :: ts => parse_go ts None (SPersistent :: k)
| TPure :: ts => parse_go ts None (SPure :: k)
| TForall :: ts => parse_go ts None (SForall :: k)
| _ => None
end
| Some (b, ss) =>
match ts with
| TName s :: ts => parse_go ts (Some (b,s :: ss)) k
| TBracketR :: ts => parse_go ts None (SSplit b (rev ss) :: k) <