Commit af80690d authored by Robbert Krebbers's avatar Robbert Krebbers

Define uPred_{equiv,dist,entails} as an inductive.

This better seals off their definition. Although it did not give
much of a speedup, I think it is conceptually nicer.
parent bcfc00b8
Pipeline #110 passed with stage
......@@ -132,9 +132,9 @@ Proof. intros [??]; split; naive_solver eauto using agree_valid_le. Qed.
(** Internalized properties *)
Lemma agree_equivI {M} a b : (to_agree a to_agree b)%I (a b : uPred M)%I.
Proof. split. by intros [? Hv]; apply (Hv n). apply: to_agree_ne. Qed.
Proof. do 2 split. by intros [? Hv]; apply (Hv n). apply: to_agree_ne. Qed.
Lemma agree_validI {M} x y : (x y) (x y : uPred M).
Proof. by intros r n _ ?; apply: agree_op_inv. Qed.
Proof. split=> r n _ ?; by apply: agree_op_inv. Qed.
End agree.
Arguments agreeC : clear implicits.
......
......@@ -60,8 +60,8 @@ Proof.
Qed.
Lemma dec_agree_equivI {M} a b : (DecAgree a DecAgree b)%I (a = b : uPred M)%I.
Proof. split. by case. by destruct 1. Qed.
Proof. do 2 split. by case. by destruct 1. Qed.
Lemma dec_agree_validI {M} (x y : dec_agreeRA) : (x y) (x = y : uPred M).
Proof. intros r n _ ?. by apply: dec_agree_op_inv. Qed.
Proof. split=> r n _ ?. by apply: dec_agree_op_inv. Qed.
End dec_agree.
......@@ -145,7 +145,7 @@ Lemma excl_equivI {M} (x y : excl A) :
| ExclUnit, ExclUnit | ExclBot, ExclBot => True
| _, _ => False
end : uPred M)%I.
Proof. split. by destruct 1. by destruct x, y; try constructor. Qed.
Proof. do 2 split. by destruct 1. by destruct x, y; try constructor. Qed.
Lemma excl_validI {M} (x : excl A) :
( x)%I (if x is ExclBot then False else True : uPred M)%I.
Proof. by destruct x. Qed.
......
......@@ -138,7 +138,7 @@ Lemma option_equivI {M} (x y : option A) :
(x y)%I (match x, y with
| Some a, Some b => a b | None, None => True | _, _ => False
end : uPred M)%I.
Proof. split. by destruct 1. by destruct x, y; try constructor. Qed.
Proof. do 2 split. by destruct 1. by destruct x, y; try constructor. Qed.
Lemma option_validI {M} (x : option A) :
( x)%I (match x with Some a => a | None => True end : uPred M)%I.
Proof. by destruct x. Qed.
......
This diff is collapsed.
......@@ -27,7 +27,7 @@ Lemma wp_lift_step E1 E2
( φ e2 σ2 ef ownP σ2) - |={E1,E2}=> || e2 @ E2 {{ Φ }} wp_fork ef)
|| e1 @ E2 {{ Φ }}.
Proof.
intros ? He Hsafe Hstep n r ? Hvs; constructor; auto.
intros ? He Hsafe Hstep; split=> n r ? Hvs; constructor; auto.
intros rf k Ef σ1' ???; destruct (Hvs rf (S k) Ef σ1')
as (r'&(r1&r2&?&?&Hwp)&Hws); auto; clear Hvs; cofe_subst r'.
destruct (wsat_update_pst k (E1 Ef) σ1 σ1' r1 (r2 rf)) as [-> Hws'].
......@@ -36,7 +36,7 @@ Proof.
constructor; [done|intros e2 σ2 ef ?; specialize (Hws' σ2)].
destruct (λ H1 H2 H3, Hwp e2 σ2 ef k (update_pst σ2 r1) H1 H2 H3 rf k Ef σ2)
as (r'&(r1'&r2'&?&?&?)&?); auto; cofe_subst r'.
{ split. destruct k; try eapply Hstep; eauto. apply ownP_spec; auto. }
{ split. by eapply Hstep. apply ownP_spec; auto. }
{ rewrite (comm _ r2) -assoc; eauto using wsat_le. }
by exists r1', r2'; split_and?; [| |by intros ? ->].
Qed.
......@@ -47,7 +47,7 @@ Lemma wp_lift_pure_step E (φ : expr Λ → option (expr Λ) → Prop) Φ e1 :
( σ1 e2 σ2 ef, prim_step e1 σ1 e2 σ2 ef σ1 = σ2 φ e2 ef)
( e2 ef, φ e2 ef || e2 @ E {{ Φ }} wp_fork ef) || e1 @ E {{ Φ }}.
Proof.
intros He Hsafe Hstep n r ? Hwp; constructor; auto.
intros He Hsafe Hstep; split=> n r ? Hwp; constructor; auto.
intros rf k Ef σ1 ???; split; [done|]. destruct n as [|n]; first lia.
intros e2 σ2 ef ?; destruct (Hstep σ1 e2 σ2 ef); auto; subst.
destruct (Hwp e2 ef k r) as (r1&r2&Hr&?&?); auto.
......
......@@ -24,8 +24,9 @@ Proof.
rewrite -uPred_map_compose. apply uPred_map_ext=>{P} r /=.
rewrite -res_map_compose. apply res_map_ext=>{r} r /=.
by rewrite -later_map_compose.
- intros A1 A2 B1 B2 n f f' Hf P n' [???].
apply upredC_map_ne, resC_map_ne, laterC_map_contractive=>i. by apply Hf.
- intros A1 A2 B1 B2 n f f' Hf P; split=> n' -[???].
apply upredC_map_ne, resC_map_ne, laterC_map_contractive.
by intros i ?; apply Hf.
Qed.
End iProp.
......
......@@ -42,7 +42,7 @@ Transparent uPred_holds.
Global Instance pvs_ne E1 E2 n : Proper (dist n ==> dist n) (@pvs Λ Σ E1 E2).
Proof.
intros P Q HPQ r1 n' ??; simpl; split; intros HP rf k Ef σ ???;
intros P Q HPQ; split=> n' r1 ??; simpl; split; intros HP rf k Ef σ ???;
destruct (HP rf k Ef σ) as (r2&?&?); auto;
exists r2; split_and?; auto; apply HPQ; eauto.
Qed.
......@@ -51,36 +51,38 @@ Proof. apply ne_proper, _. Qed.
Lemma pvs_intro E P : P |={E}=> P.
Proof.
intros n r ? HP rf k Ef σ ???; exists r; split; last done.
split=> n r ? HP rf k Ef σ ???; exists r; split; last done.
apply uPred_weaken with n r; eauto.
Qed.
Lemma pvs_mono E1 E2 P Q : P Q (|={E1,E2}=> P) (|={E1,E2}=> Q).
Proof.
intros HPQ n r ? HP rf k Ef σ ???.
destruct (HP rf k Ef σ) as (r2&?&?); eauto; exists r2; eauto.
intros HPQ; split=> n r ? HP rf k Ef σ ???.
destruct (HP rf k Ef σ) as (r2&?&?); eauto.
exists r2; eauto using uPred_in_entails.
Qed.
Lemma pvs_timeless E P : TimelessP P ( P) (|={E}=> P).
Proof.
rewrite uPred.timelessP_spec=> HP [|n] r ? HP' rf k Ef σ ???; first lia.
rewrite uPred.timelessP_spec=> HP.
split=>-[|n] r ? HP' rf k Ef σ ???; first lia.
exists r; split; last done.
apply HP, uPred_weaken with n r; eauto using cmra_validN_le.
Qed.
Lemma pvs_trans E1 E2 E3 P :
E2 E1 E3 (|={E1,E2}=> |={E2,E3}=> P) (|={E1,E3}=> P).
Proof.
intros ? n r1 ? HP1 rf k Ef σ ???.
intros ?; split=> n r1 ? HP1 rf k Ef σ ???.
destruct (HP1 rf k Ef σ) as (r2&HP2&?); auto.
Qed.
Lemma pvs_mask_frame E1 E2 Ef P :
Ef (E1 E2) = (|={E1,E2}=> P) (|={E1 Ef,E2 Ef}=> P).
Proof.
intros ? n r ? HP rf k Ef' σ ???.
intros ?; split=> n r ? HP rf k Ef' σ ???.
destruct (HP rf k (EfEf') σ) as (r'&?&?); rewrite ?(assoc_L _); eauto.
by exists r'; rewrite -(assoc_L _).
Qed.
Lemma pvs_frame_r E1 E2 P Q : ((|={E1,E2}=> P) Q) (|={E1,E2}=> P Q).
Proof.
intros n r ? (r1&r2&Hr&HP&?) rf k Ef σ ???.
split; intros n r ? (r1&r2&Hr&HP&?) rf k Ef σ ???.
destruct (HP (r2 rf) k Ef σ) as (r'&?&?); eauto.
{ by rewrite assoc -(dist_le _ _ _ _ Hr); last lia. }
exists (r' r2); split; last by rewrite -assoc.
......@@ -88,7 +90,7 @@ Proof.
Qed.
Lemma pvs_openI i P : ownI i P (|={{[i]},}=> P).
Proof.
intros [|n] r ? Hinv rf [|k] Ef σ ???; try lia.
split=> -[|n] r ? Hinv rf [|k] Ef σ ???; try lia.
apply ownI_spec in Hinv; last auto.
destruct (wsat_open k Ef σ (r rf) i P) as (rP&?&?); auto.
{ rewrite lookup_wld_op_l ?Hinv; eauto; apply dist_le with (S n); eauto. }
......@@ -97,7 +99,8 @@ Proof.
Qed.
Lemma pvs_closeI i P : (ownI i P P) (|={,{[i]}}=> True).
Proof.
intros [|n] r ? [? HP] rf [|k] Ef σ ? HE ?; try lia; exists ; split; [done|].
split=> -[|n] r ? [? HP] rf [|k] Ef σ ? HE ?; try lia.
exists ; split; [done|].
rewrite left_id; apply wsat_close with P r.
- apply ownI_spec, uPred_weaken with (S n) r; auto.
- set_solver +HE.
......@@ -107,7 +110,8 @@ Qed.
Lemma pvs_ownG_updateP E m (P : iGst Λ Σ Prop) :
m ~~>: P ownG m (|={E}=> m', P m' ownG m').
Proof.
intros Hup%option_updateP' [|n] r ? Hinv%ownG_spec rf [|k] Ef σ ???; try lia.
intros Hup%option_updateP'.
split=> -[|n] r ? /ownG_spec Hinv rf [|k] Ef σ ???; try lia.
destruct (wsat_update_gst k (E Ef) σ r rf (Some m) P) as (m'&?&?); eauto.
{ apply cmra_includedN_le with (S n); auto. }
by exists (update_gst m' r); split; [exists m'; split; [|apply ownG_spec]|].
......@@ -116,7 +120,7 @@ Lemma pvs_ownG_updateP_empty `{Empty (iGst Λ Σ), !CMRAIdentity (iGst Λ Σ)}
E (P : iGst Λ Σ Prop) :
~~>: P True (|={E}=> m', P m' ownG m').
Proof.
intros Hup [|n] r ? _ rf [|k] Ef σ ???; try lia.
intros Hup; split=> -[|n] r ? _ rf [|k] Ef σ ???; try lia.
destruct (wsat_update_gst k (E Ef) σ r rf P) as (m'&?&?); eauto.
{ apply cmra_empty_leastN. }
{ apply cmra_updateP_compose_l with (Some ), option_updateP with P;
......@@ -125,7 +129,7 @@ Proof.
Qed.
Lemma pvs_allocI E P : ¬set_finite E P (|={E}=> i, (i E) ownI i P).
Proof.
intros ? [|n] r ? HP rf [|k] Ef σ ???; try lia.
intros ?; split=> -[|n] r ? HP rf [|k] Ef σ ???; try lia.
destruct (wsat_alloc k E Ef σ rf P r) as (i&?&?&?); auto.
{ apply uPred_weaken with n r; eauto. }
exists (Res {[ i := to_agree (Next (iProp_unfold P)) ]} ).
......@@ -137,6 +141,9 @@ Opaque uPred_holds.
Import uPred.
Global Instance pvs_mono' E1 E2 : Proper (() ==> ()) (@pvs Λ Σ E1 E2).
Proof. intros P Q; apply pvs_mono. Qed.
Global Instance pvs_flip_mono' E1 E2 :
Proper (flip () ==> flip ()) (@pvs Λ Σ E1 E2).
Proof. intros P Q; apply pvs_mono. Qed.
Lemma pvs_trans' E P : (|={E}=> |={E}=> P) (|={E}=> P).
Proof. apply pvs_trans; set_solver. Qed.
Lemma pvs_strip_pvs E P Q : P (|={E}=> Q) (|={E}=> P) (|={E}=> Q).
......@@ -194,7 +201,6 @@ Proof.
intros; rewrite (pvs_ownG_updateP E _ (m' =)); last by apply cmra_update_updateP.
by apply pvs_mono, uPred.exist_elim=> m''; apply uPred.const_elim_l=> ->.
Qed.
End pvs.
(** * Frame Shift Assertions. *)
......
......@@ -162,7 +162,7 @@ Proof. by intros ? ? [???]; constructor; apply: timeless. Qed.
(** Internalized properties *)
Lemma res_equivI {M} r1 r2 :
(r1 r2)%I (wld r1 wld r2 pst r1 pst r2 gst r1 gst r2: uPred M)%I.
Proof. split. by destruct 1. by intros (?&?&?); constructor. Qed.
Proof. do 2 split. by destruct 1. by intros (?&?&?); constructor. Qed.
Lemma res_validI {M} r : ( r)%I ( wld r pst r gst r : uPred M)%I.
Proof. done. Qed.
End res.
......
......@@ -71,7 +71,7 @@ Global Instance wp_ne E e n :
Proof.
cut ( Φ Ψ, ( v, Φ v {n} Ψ v)
n' r, n' n {n'} r wp E e Φ n' r wp E e Ψ n' r).
{ by intros help Φ Ψ HΦΨ; split; apply help. }
{ intros help Φ Ψ HΦΨ. by do 2 split; apply help. }
intros Φ Ψ HΦΨ n' r; revert e r.
induction n' as [n' IH] using lt_wf_ind=> e r.
destruct 3 as [n' r v HpvsQ|n' r e1 ? Hgo].
......@@ -90,7 +90,8 @@ Qed.
Lemma wp_mask_frame_mono E1 E2 e Φ Ψ :
E1 E2 ( v, Φ v Ψ v) || e @ E1 {{ Φ }} || e @ E2 {{ Ψ }}.
Proof.
intros HE HΦ n r; revert e r; induction n as [n IH] using lt_wf_ind=> e r.
intros HE HΦ; split=> n r.
revert e r; induction n as [n IH] using lt_wf_ind=> e r.
destruct 2 as [n' r v HpvsQ|n' r e1 ? Hgo].
{ constructor; eapply pvs_mask_frame_mono, HpvsQ; eauto. }
constructor; [done|]=> rf k Ef σ1 ???.
......@@ -114,20 +115,20 @@ Lemma wp_step_inv E Ef Φ e k n σ r rf :
Proof. intros He; destruct 3; [by rewrite ?to_of_val in He|eauto]. Qed.
Lemma wp_value' E Φ v : Φ v || of_val v @ E {{ Φ }}.
Proof. by constructor; apply pvs_intro. Qed.
Proof. split=> n r; constructor; by apply pvs_intro. Qed.
Lemma pvs_wp E e Φ : (|={E}=> || e @ E {{ Φ }}) || e @ E {{ Φ }}.
Proof.
intros n r ? Hvs.
split=> n r ? Hvs.
destruct (to_val e) as [v|] eqn:He; [apply of_to_val in He; subst|].
{ constructor; eapply pvs_trans', pvs_mono, Hvs; eauto.
intros ???; apply wp_value_inv. }
split=> ???; apply wp_value_inv. }
constructor; [done|]=> rf k Ef σ1 ???.
destruct (Hvs rf (S k) Ef σ1) as (r'&Hwp&?); auto.
eapply wp_step_inv with (S k) r'; eauto.
Qed.
Lemma wp_pvs E e Φ : || e @ E {{ λ v, |={E}=> Φ v }} || e @ E {{ Φ }}.
Proof.
intros n r; revert e r; induction n as [n IH] using lt_wf_ind=> e r Hr HΦ.
split=> n r; revert e r; induction n as [n IH] using lt_wf_ind=> e r Hr HΦ.
destruct (to_val e) as [v|] eqn:He; [apply of_to_val in He; subst|].
{ constructor; apply pvs_trans', (wp_value_inv _ (pvs E E Φ)); auto. }
constructor; [done|]=> rf k Ef σ1 ???.
......@@ -140,7 +141,7 @@ Lemma wp_atomic E1 E2 e Φ :
E2 E1 atomic e
(|={E1,E2}=> || e @ E2 {{ λ v, |={E2,E1}=> Φ v }}) || e @ E1 {{ Φ }}.
Proof.
intros ? He n r ? Hvs; constructor; eauto using atomic_not_val.
intros ? He; split=> n r ? Hvs; constructor; eauto using atomic_not_val.
intros rf k Ef σ1 ???.
destruct (Hvs rf (S k) Ef σ1) as (r'&Hwp&?); auto.
destruct (wp_step_inv E2 Ef (pvs E2 E1 Φ) e k (S k) σ1 r' rf)
......@@ -157,7 +158,7 @@ Proof.
Qed.
Lemma wp_frame_r E e Φ R : (|| e @ E {{ Φ }} R) || e @ E {{ λ v, Φ v R }}.
Proof.
intros n r' Hvalid (r&rR&Hr&Hwp&?); revert Hvalid.
split; intros n r' Hvalid (r&rR&Hr&Hwp&?); revert Hvalid.
rewrite Hr; clear Hr; revert e r Hwp.
induction n as [n IH] using lt_wf_ind; intros e r1.
destruct 1 as [|n r e ? Hgo]=>?.
......@@ -175,7 +176,8 @@ Qed.
Lemma wp_frame_later_r E e Φ R :
to_val e = None (|| e @ E {{ Φ }} R) || e @ E {{ λ v, Φ v R }}.
Proof.
intros He n r' Hvalid (r&rR&Hr&Hwp&?); revert Hvalid; rewrite Hr; clear Hr.
intros He; split; intros n r' Hvalid (r&rR&Hr&Hwp&?).
revert Hvalid; rewrite Hr; clear Hr.
destruct Hwp as [|n r e ? Hgo]; [by rewrite to_of_val in He|].
constructor; [done|]=>rf k Ef σ1 ???; destruct n as [|n]; first omega.
destruct (Hgo (rRrf) k Ef σ1) as [Hsafe Hstep];rewrite ?assoc;auto.
......@@ -189,7 +191,7 @@ Qed.
Lemma wp_bind `{LanguageCtx Λ K} E e Φ :
|| e @ E {{ λ v, || K (of_val v) @ E {{ Φ }} }} || K e @ E {{ Φ }}.
Proof.
intros n r; revert e r; induction n as [n IH] using lt_wf_ind=> e r ?.
split=> n r; revert e r; induction n as [n IH] using lt_wf_ind=> e r ?.
destruct 1 as [|n r e ? Hgo]; [by apply pvs_wp|].
constructor; auto using fill_not_val=> rf k Ef σ1 ???.
destruct (Hgo rf k Ef σ1) as [Hsafe Hstep]; auto.
......
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