Skip to content

GitLab

Commit af80690d authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

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
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 178 additions and 134 deletions
algebra/agree.v
View file @ af80690d
......@@ -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.
......
algebra/dec_agree.v
View file @ af80690d
......@@ -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.
algebra/excl.v
View file @ af80690d
......@@ -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.
......
algebra/option.v
View file @ af80690d
......@@ -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.
......
algebra/upred.v
View file @ af80690d
This diff is collapsed.
program_logic/lifting.v
View file @ af80690d
......@@ -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.
......
program_logic/model.v
View file @ af80690d
......@@ -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.
......
program_logic/pviewshifts.v
View file @ af80690d
......@@ -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 (Ef∪Ef') σ) 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. *)
......
program_logic/resources.v
View file @ af80690d
......@@ -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.
......
program_logic/weakestpre.v
View file @ af80690d
......@@ -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 (rR⋅rf) 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