Commit 2d9c5f33 authored by Robbert Krebbers's avatar Robbert Krebbers

Seal off all definitions in uPred.

The performance gain seems neglectable, unfortunatelly...
parent 52d7d275
Pipeline #155 passed with stage
......@@ -134,9 +134,11 @@ 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. do 2 split. by intros [? Hv]; apply (Hv n). apply: to_agree_ne. Qed.
Proof.
uPred.unseal. 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. split=> r n _ ?; by apply: agree_op_inv. Qed.
Proof. uPred.unseal; split=> r n _ ?; by apply: agree_op_inv. Qed.
End agree.
Arguments agreeC : clear implicits.
......
......@@ -151,14 +151,14 @@ Qed.
(** Internalized properties *)
Lemma auth_equivI {M} (x y : auth A) :
(x y)%I (authoritative x authoritative y own x own y : uPred M)%I.
Proof. done. Qed.
Proof. by uPred.unseal. Qed.
Lemma auth_validI {M} (x : auth A) :
( x)%I (match authoritative x with
| Excl a => ( b, a own x b) a
| ExclUnit => own x
| ExclBot => False
end : uPred M)%I.
Proof. by destruct x as [[]]. Qed.
Proof. uPred.unseal. by destruct x as [[]]. Qed.
(** The notations ◯ and ● only work for CMRAs with an empty element. So, in
what follows, we assume we have an empty element. *)
......
......@@ -146,10 +146,12 @@ Lemma excl_equivI {M} (x y : excl A) :
| ExclUnit, ExclUnit | ExclBot, ExclBot => True
| _, _ => False
end : uPred M)%I.
Proof. do 2 split. by destruct 1. by destruct x, y; try constructor. Qed.
Proof.
uPred.unseal. 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.
Proof. uPred.unseal. by destruct x. Qed.
(** ** Local updates *)
Global Instance excl_local_update b :
......
......@@ -171,9 +171,9 @@ Proof. split; [apply _|]. intros m ? i. by apply: cmra_discrete_valid. Qed.
(** Internalized properties *)
Lemma map_equivI {M} m1 m2 : (m1 m2)%I ( i, m1 !! i m2 !! i : uPred M)%I.
Proof. done. Qed.
Proof. by uPred.unseal. Qed.
Lemma map_validI {M} m : ( m)%I ( i, (m !! i) : uPred M)%I.
Proof. done. Qed.
Proof. by uPred.unseal. Qed.
End cmra.
Arguments mapRA _ {_ _} _.
......
......@@ -171,9 +171,9 @@ Section iprod_cmra.
(** Internalized properties *)
Lemma iprod_equivI {M} g1 g2 : (g1 g2)%I ( i, g1 i g2 i : uPred M)%I.
Proof. done. Qed.
Proof. by uPred.unseal. Qed.
Lemma iprod_validI {M} g : ( g)%I ( i, g i : uPred M)%I.
Proof. done. Qed.
Proof. by uPred.unseal. Qed.
(** Properties of iprod_insert. *)
Context `{ x x' : A, Decision (x = x')}.
......
......@@ -140,10 +140,12 @@ 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. do 2 split. by destruct 1. by destruct x, y; try constructor. Qed.
Proof.
uPred.unseal. 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.
Proof. uPred.unseal. by destruct x. Qed.
(** Updates *)
Lemma option_updateP (P : A Prop) (Q : option A Prop) x :
......
This diff is collapsed.
......@@ -62,8 +62,8 @@ Proof.
intros Hht ????; apply (nsteps_wptp [Φ] k n ([e1],σ1) (t2,σ2) [r1]);
rewrite /big_op ?right_id; auto.
constructor; last constructor.
apply Hht with (k + n) r1; eauto using cmra_included_unit.
eapply uPred.const_intro; eauto.
move: Hht; rewrite /ht; uPred.unseal=> Hht.
apply Hht with (k + n) r1; by eauto using cmra_included_unit.
Qed.
Lemma ht_adequacy_own Φ e1 t2 σ1 m σ2 :
m
......@@ -74,9 +74,9 @@ Proof.
intros Hv ? [k ?]%rtc_nsteps.
eapply ht_adequacy_steps with (r1 := (Res (Excl σ1) (Some m))); eauto; [|].
{ by rewrite Nat.add_comm; apply wsat_init, cmra_valid_validN. }
exists (Res (Excl σ1) ), (Res (Some m)); split_and?.
uPred.unseal; exists (Res (Excl σ1) ), (Res (Some m)); split_and?.
- by rewrite Res_op ?left_id ?right_id.
- by rewrite /uPred_holds /=.
- rewrite /ownP; uPred.unseal; rewrite /uPred_holds //=.
- by apply ownG_spec.
Qed.
Theorem ht_adequacy_result E φ e v t2 σ1 m σ2 :
......@@ -90,8 +90,8 @@ Proof.
as (rs2&Qs&Hwptp&?); auto.
{ by rewrite -(ht_mask_weaken E ). }
inversion Hwptp as [|?? r ?? rs Hwp _]; clear Hwptp; subst.
apply wp_value_inv in Hwp; destruct (Hwp (big_op rs) 2 σ2) as [r' []]; auto.
by rewrite right_id_L.
move: Hwp. uPred.unseal=> /wp_value_inv Hwp.
destruct (Hwp (big_op rs) 2 σ2) as [r' []]; rewrite ?right_id_L; auto.
Qed.
Lemma ht_adequacy_reducible E Φ e1 e2 t2 σ1 m σ2 :
m
......
......@@ -102,7 +102,7 @@ Proof.
first (eapply map_updateP_alloc_strong', cmra_transport_valid, Ha);
naive_solver.
- apply exist_elim=>m; apply const_elim_l=>-[γ [Hfresh ->]].
by rewrite -(exist_intro γ) const_equiv.
by rewrite -(exist_intro γ) const_equiv // left_id.
Qed.
Lemma own_alloc a E : a True (|={E}=> γ, own γ a).
Proof.
......
......@@ -16,7 +16,7 @@ Implicit Types P Q : iProp Λ Σ.
Implicit Types Φ : val Λ iProp Λ Σ.
Transparent uPred_holds.
Notation wp_fork ef := (default True ef (flip (wp ) (λ _, True)))%I.
Notation wp_fork ef := (default True ef (flip (wp ) (λ _, True)))%I.
Lemma wp_lift_step E1 E2
(φ : expr Λ state Λ option (expr Λ) Prop) Φ e1 σ1 :
......@@ -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; split=> n r ? Hvs; constructor; auto.
intros ? He Hsafe Hstep. uPred.unseal; 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'].
......@@ -38,7 +38,7 @@ Proof.
as (r'&(r1'&r2'&?&?&?)&?); auto; cofe_subst r'.
{ split. by eapply Hstep. apply ownP_spec; auto. }
{ rewrite (comm _ r2) -assoc; eauto using wsat_le. }
by exists r1', r2'; split_and?; [| |by intros ? ->].
exists r1', r2'; split_and?; try done. by uPred.unseal; intros ? ->.
Qed.
Lemma wp_lift_pure_step E (φ : expr Λ option (expr Λ) Prop) Φ e1 :
......@@ -47,11 +47,13 @@ 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; split=> n r ? Hwp; constructor; auto.
intros He Hsafe Hstep; uPred.unseal; 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.
exists r1,r2; split_and?; [rewrite -Hr| |by intros ? ->]; eauto using wsat_le.
exists r1,r2; split_and?; try done.
- rewrite -Hr; eauto using wsat_le.
- uPred.unseal; by intros ? ->.
Qed.
(** Derived lifting lemmas. *)
......
......@@ -75,7 +75,8 @@ Lemma ownI_spec n r i P :
{n} r
(ownI i P) n r wld r !! i {n} Some (to_agree (Next (iProp_unfold P))).
Proof.
intros [??]; rewrite /uPred_holds/=res_includedN/=singleton_includedN; split.
intros (?&?&?). rewrite /ownI; uPred.unseal.
rewrite /uPred_holds/=res_includedN/=singleton_includedN; split.
- intros [(P'&Hi&HP) _]; rewrite Hi.
by apply Some_dist, symmetry, agree_valid_includedN,
(cmra_included_includedN _ P'),HP; apply map_lookup_validN with (wld r) i.
......@@ -83,11 +84,13 @@ Proof.
Qed.
Lemma ownP_spec n r σ : {n} r (ownP σ) n r pst r Excl σ.
Proof.
intros (?&?&?); rewrite /uPred_holds /= res_includedN /= Excl_includedN //.
intros (?&?&?). rewrite /ownP; uPred.unseal.
rewrite /uPred_holds /= res_includedN /= Excl_includedN //.
rewrite (timeless_iff n). naive_solver (apply cmra_empty_leastN).
Qed.
Lemma ownG_spec n r m : (ownG m) n r Some m {n} gst r.
Proof.
rewrite /ownG; uPred.unseal.
rewrite /uPred_holds /= res_includedN; naive_solver (apply cmra_empty_leastN).
Qed.
End ownership.
......@@ -63,7 +63,7 @@ Qed.
Lemma pvs_timeless E P : TimelessP P ( P) (|={E}=> P).
Proof.
rewrite uPred.timelessP_spec=> HP.
split=>-[|n] r ? HP' rf k Ef σ ???; first lia.
uPred.unseal; 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.
......@@ -82,7 +82,7 @@ Proof.
Qed.
Lemma pvs_frame_r E1 E2 P Q : ((|={E1,E2}=> P) Q) (|={E1,E2}=> P Q).
Proof.
split; intros n r ? (r1&r2&Hr&HP&?) rf k Ef σ ???.
uPred.unseal; 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.
......@@ -90,7 +90,7 @@ Proof.
Qed.
Lemma pvs_openI i P : ownI i P (|={{[i]},}=> P).
Proof.
split=> -[|n] r ? Hinv rf [|k] Ef σ ???; try lia.
uPred.unseal; 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. }
......@@ -99,7 +99,7 @@ Proof.
Qed.
Lemma pvs_closeI i P : (ownI i P P) (|={,{[i]}}=> True).
Proof.
split=> -[|n] r ? [? HP] rf [|k] Ef σ ? HE ?; try lia.
uPred.unseal; 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.
......@@ -111,7 +111,7 @@ Lemma pvs_ownG_updateP E m (P : iGst Λ Σ → Prop) :
m ~~>: P ownG m (|={E}=> m', P m' ownG m').
Proof.
intros Hup%option_updateP'.
split=> -[|n] r ? /ownG_spec Hinv rf [|k] Ef σ ???; try lia.
uPred.unseal; 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]|].
......@@ -120,20 +120,21 @@ Lemma pvs_ownG_updateP_empty `{Empty (iGst Λ Σ), !CMRAIdentity (iGst Λ Σ)}
E (P : iGst Λ Σ Prop) :
~~>: P True (|={E}=> m', P m' ownG m').
Proof.
intros Hup; split=> -[|n] r ? _ rf [|k] Ef σ ???; try lia.
intros Hup; uPred.unseal; 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;
auto using option_update_None. }
by exists (update_gst m' r); split; [exists m'; split; [|apply ownG_spec]|].
exists (update_gst m' r); by split; [exists m'; split; [|apply ownG_spec]|].
Qed.
Lemma pvs_allocI E P : ¬set_finite E P (|={E}=> i, (i E) ownI i P).
Proof.
intros ?; split=> -[|n] r ? HP rf [|k] Ef σ ???; try lia.
intros ?; rewrite /ownI; uPred.unseal.
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)) ]} ).
by split; [by exists i; split; rewrite /uPred_holds /=|].
split; [|done]. by exists i; split; rewrite /uPred_holds /=.
Qed.
(** * Derived rules *)
......
......@@ -162,9 +162,11 @@ 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. do 2 split. by destruct 1. by intros (?&?&?); constructor. Qed.
Proof.
uPred.unseal. do 2 split. by destruct 1. by intros (?&?&?); by constructor.
Qed.
Lemma res_validI {M} r : ( r)%I ( wld r pst r gst r : uPred M)%I.
Proof. done. Qed.
Proof. by uPred.unseal. Qed.
End res.
Arguments resC : clear implicits.
......
......@@ -179,7 +179,7 @@ Section sts.
(sts_own γ s' T' - Ψ x)))
P fsa E Ψ.
Proof.
rewrite sts_own_eq. intros. eapply sts_fsaS; try done; []. (* FIXME: slow *)
rewrite sts_own_eq. intros. eapply sts_fsaS; try done; [].
by rewrite sts_ownS_eq sts_own_eq.
Qed.
End sts.
......@@ -158,11 +158,12 @@ Proof.
Qed.
Lemma wp_frame_r E e Φ R : (|| e @ E {{ Φ }} R) || e @ E {{ λ v, Φ v R }}.
Proof.
split; intros n r' Hvalid (r&rR&Hr&Hwp&?); revert Hvalid.
uPred.unseal; 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]=>?.
{ constructor; apply pvs_frame_r; auto. exists r, rR; eauto. }
{ constructor. rewrite -uPred_sep_eq; apply pvs_frame_r; auto.
uPred.unseal; exists r, rR; eauto. }
constructor; [done|]=> rf k Ef σ1 ???.
destruct (Hgo (rRrf) k Ef σ1) as [Hsafe Hstep]; auto.
{ by rewrite assoc. }
......@@ -176,7 +177,7 @@ Qed.
Lemma wp_frame_later_r E e Φ R :
to_val e = None (|| e @ E {{ Φ }} R) || e @ E {{ λ v, Φ v R }}.
Proof.
intros He; split; intros n r' Hvalid (r&rR&Hr&Hwp&?).
intros He; uPred.unseal; 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.
......@@ -185,7 +186,8 @@ Proof.
destruct (Hstep e2 σ2 ef) as (r2&r2'&?&?&?); auto.
exists (r2 rR), r2'; split_and?; auto.
- by rewrite -(assoc _ r2) (comm _ rR) !assoc -(assoc _ _ rR).
- apply wp_frame_r; [auto|exists r2, rR; split_and?; auto].
- rewrite -uPred_sep_eq.
apply wp_frame_r; [auto|uPred.unseal; exists r2, rR; split_and?; auto].
eapply uPred_weaken with n rR; eauto.
Qed.
Lemma wp_bind `{LanguageCtx Λ K} E e Φ :
......
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