Commit 813d3206 authored by Rodolphe Lepigre's avatar Rodolphe Lepigre
Browse files

Refactor the [int] type to use [val_to_Z]..

parent 3355a9ac
Pipeline #45123 passed with stage
in 24 minutes and 49 seconds
...@@ -21,16 +21,16 @@ Section type. ...@@ -21,16 +21,16 @@ Section type.
iDestruct ("HT" with "Hty2") as (Hv2) "HT". iDestruct ("HT" with "Hty2") as (Hv2) "HT".
iIntros (Φ) "HΦ". iIntros (Φ) "HΦ".
iDestruct ("HT" with "[] []" ) as (??) "HT". iDestruct ("HT" with "[] []" ) as (??) "HT".
1-2: iPureIntro; by apply: val_of_Z_in_range. 1-2: iPureIntro; by apply: val_to_Z_in_range.
have /val_of_Z_is_some[v Hv] : ((n1 + n2) `mod` int_modulus it1) it1 by apply int_modulus_mod_in_range. have /val_of_Z_is_some[v Hv] : ((n1 + n2) `mod` int_modulus it1) it1 by apply int_modulus_mod_in_range.
move: Hv1 Hv2 => /val_to_of_int Hv1 /val_to_of_int Hv2. subst it2. subst it2.
iApply (wp_binop_det v). iSplit. iApply (wp_binop_det v). iSplit.
- iIntros (σ v') "_ !%". split. - iIntros (σ v') "_ !%". split.
+ inversion 1; simplify_eq/=. + inversion 1; simplify_eq/=.
by destruct it1 as [? []]; simplify_eq/=. by destruct it1 as [? []]; simplify_eq/=.
+ move => ->. econstructor => //. + move => ->. econstructor => //.
by destruct it1 as [? []]; simplify_eq/=. by destruct it1 as [? []]; simplify_eq/=.
- iIntros "!>". iApply "HΦ"; last done. by iPureIntro. - iIntros "!>". iApply "HΦ"; last done. iPureIntro. by apply val_to_of_int.
Qed. Qed.
Global Instance macro_wrapping_add_inst it1 it2 e1 e2 : Global Instance macro_wrapping_add_inst it1 it2 e1 e2 :
......
...@@ -161,8 +161,6 @@ Section proofs. ...@@ -161,8 +161,6 @@ Section proofs.
iApply (wp_cas_suc _ _ _ v2 v4 next next _ _ _ u16 _ _ with "Hnext Hticket") => //. iApply (wp_cas_suc _ _ _ v2 v4 next next _ _ _ u16 _ _ with "Hnext Hticket") => //.
{ by rewrite val_to_of_loc. } { by rewrite val_to_of_loc. }
{ by rewrite val_to_of_loc. } { by rewrite val_to_of_loc. }
{ by apply val_to_of_int. }
{ by apply val_to_of_int. }
{ cbv. lia. } { cbv. lia. }
iNext. iIntros "??". iApply ("HΦ" $! _ (t2mt (true @ boolean bool_it))%I) => //. iNext. iIntros "??". iApply ("HΦ" $! _ (t2mt (true @ boolean bool_it))%I) => //.
repeat liRStep; liShow. repeat liRStep; liShow.
...@@ -210,8 +208,6 @@ Section proofs. ...@@ -210,8 +208,6 @@ Section proofs.
iApply (wp_cas_fail _ _ _ v2 v4 next i _ _ _ u16 _ _ with "Hnext Hticket") => //. iApply (wp_cas_fail _ _ _ v2 v4 next i _ _ _ u16 _ _ with "Hnext Hticket") => //.
{ by rewrite val_to_of_loc. } { by rewrite val_to_of_loc. }
{ by rewrite val_to_of_loc. } { by rewrite val_to_of_loc. }
{ by apply val_to_of_int. }
{ by apply val_to_of_int. }
{ cbv. lia. } { cbv. lia. }
iNext. iIntros "??". iApply ("HΦ" $! _ (t2mt (false @ boolean bool_it))%I) => //. iNext. iIntros "??". iApply ("HΦ" $! _ (t2mt (false @ boolean bool_it))%I) => //.
repeat liRStep; liShow. repeat liRStep; liShow.
...@@ -280,8 +276,6 @@ Section proofs. ...@@ -280,8 +276,6 @@ Section proofs.
iApply (wp_cas_suc _ _ _ v2 v4 next next _ _ _ u16 _ _ with "Hnext Hticket") => //. iApply (wp_cas_suc _ _ _ v2 v4 next next _ _ _ u16 _ _ with "Hnext Hticket") => //.
{ by rewrite val_to_of_loc. } { by rewrite val_to_of_loc. }
{ by rewrite val_to_of_loc. } { by rewrite val_to_of_loc. }
{ by apply val_to_of_int. }
{ by apply val_to_of_int. }
{ cbv. lia. } { cbv. lia. }
iNext. iIntros "??". iApply ("HΦ" $! _ (t2mt (true @ boolean bool_it))%I) => //. iNext. iIntros "??". iApply ("HΦ" $! _ (t2mt (true @ boolean bool_it))%I) => //.
iRename select (p at{struct_hyp_spinlock} _ _)%I into "Hnext". iRename select (p at{struct_hyp_spinlock} _ _)%I into "Hnext".
...@@ -320,8 +314,6 @@ Section proofs. ...@@ -320,8 +314,6 @@ Section proofs.
iApply (wp_cas_fail _ _ _ v2 v4 next i _ _ _ u16 _ _ with "Hnext Hticket") => //. iApply (wp_cas_fail _ _ _ v2 v4 next i _ _ _ u16 _ _ with "Hnext Hticket") => //.
{ by rewrite val_to_of_loc. } { by rewrite val_to_of_loc. }
{ by rewrite val_to_of_loc. } { by rewrite val_to_of_loc. }
{ by apply val_to_of_int. }
{ by apply val_to_of_int. }
{ cbv. lia. } { cbv. lia. }
iNext. iIntros "??". iApply ("HΦ" $! _ (t2mt (false @ boolean bool_it))%I) => //. iNext. iIntros "??". iApply ("HΦ" $! _ (t2mt (false @ boolean bool_it))%I) => //.
iRename select (p at{struct_hyp_spinlock} _ _)%I into "Hnext". iRename select (p at{struct_hyp_spinlock} _ _)%I into "Hnext".
...@@ -382,7 +374,7 @@ Section proofs. ...@@ -382,7 +374,7 @@ Section proofs.
iDestruct "Hcases" as "[[Hticket' %] | Htok]". iDestruct "Hcases" as "[[Hticket' %] | Htok]".
{ iExFalso. by iApply (ticket_non_duplicable with "Hticket Hticket'"). } { iExFalso. by iApply (ticket_non_duplicable with "Hticket Hticket'"). }
iAssert (owner u16)%I as %[??]. iAssert (owner u16)%I as %[??].
{ rewrite /ty_own_val /=. by iDestruct "Hv" as %Hv%val_of_Z_in_range. } { rewrite /ty_own_val /=. by iDestruct "Hv" as %Hv%val_to_Z_in_range. }
iAssert (owner < next)%I as %?. iAssert (owner < next)%I as %?.
{ destruct (decide (owner < next)); first done. iExFalso. { destruct (decide (owner < next)); first done. iExFalso.
iDestruct (ty_size_eq with "Hv") as %?. iDestruct (ty_size_eq with "Hv") as %?.
...@@ -484,7 +476,7 @@ Section proofs. ...@@ -484,7 +476,7 @@ Section proofs.
(* Learn that [next'] actually is [max_int u16]. *) (* Learn that [next'] actually is [max_int u16]. *)
iAssert next' = max_int u16%I as %->. iAssert next' = max_int u16%I as %->.
{ iDestruct (ty_deref with "Hnext") as (w) "[_ H]". iDestruct "H" as %Hnext. { iDestruct (ty_deref with "Hnext") as (w) "[_ H]". iDestruct "H" as %Hnext.
iPureIntro. apply val_of_Z_in_range in Hnext as [??]. lia. } iPureIntro. apply val_to_Z_in_range in Hnext as [??]. lia. }
(* We perform the write and close the invariant. *) (* We perform the write and close the invariant. *)
iDestruct (ty_aligned with "Howner") as %?. iDestruct (ty_aligned with "Howner") as %?.
iDestruct (ty_deref with "Howner") as (v') "[Hl Hv]". iDestruct (ty_deref with "Howner") as (v') "[Hl Hv]".
...@@ -511,7 +503,7 @@ Section proofs. ...@@ -511,7 +503,7 @@ Section proofs.
iAssert owner' = 0%I as %->. iAssert owner' = 0%I as %->.
{ destruct (decide (owner' = 0)) => //. iExFalso. { destruct (decide (owner' = 0)) => //. iExFalso.
iDestruct (ty_deref with "Howner") as (?) "[? Hv]". iDestruct (ty_deref with "Howner") as (?) "[? Hv]".
iDestruct "Hv" as %Howner%val_of_Z_in_range. destruct Howner as [Howner ?]. iDestruct "Hv" as %Howner%val_to_Z_in_range. destruct Howner as [Howner ?].
iDestruct (overlaping_ticket_ranges with "[] Htk Htr1") as "$". iDestruct (overlaping_ticket_ranges with "[] Htk Htr1") as "$".
iPureIntro. exists 0. split; apply elem_of_seqZ; try done. iPureIntro. exists 0. split; apply elem_of_seqZ; try done.
split => //. rewrite /min_int /= in Howner. lia. } split => //. rewrite /min_int /= in Howner. lia. }
...@@ -558,7 +550,7 @@ Section proofs. ...@@ -558,7 +550,7 @@ Section proofs.
iDestruct (ty_aligned with "Howner") as %?. iDestruct (ty_aligned with "Howner") as %?.
iDestruct (ty_deref with "Howner") as (v') "[Hl Hv]". iDestruct (ty_deref with "Howner") as (v') "[Hl Hv]".
iDestruct (ty_size_eq with "Hv") as %?. iDestruct (ty_size_eq with "Hv") as %?.
iDestruct "Hv" as %?%val_of_Z_in_range. iDestruct "Hv" as %?%val_to_Z_in_range.
iSplitL "Hl". { iExists _. by iFrame "Hl". } iSplitL "Hl". { iExists _. by iFrame "Hl". }
iIntros "!> Hl". iIntros "!> Hl".
iMod "Hclose" as "_". iMod ("Hclose_inv" with "[Htok H● H◯ Hticket Hnext Hl Htk1 Htk2]") as "_". iMod "Hclose" as "_". iMod ("Hclose_inv" with "[Htok H● H◯ Hticket Hnext Hl Htk1 Htk2]") as "_".
...@@ -568,8 +560,8 @@ Section proofs. ...@@ -568,8 +560,8 @@ Section proofs.
iSplit. { iPureIntro. by lia. } iSplit. { iPureIntro. by lia. }
iDestruct ((ty_ref (t := (owner + 1) @ int u16)) with "[] Hl []") as "$" => //. iDestruct ((ty_ref (t := (owner + 1) @ int u16)) with "[] Hl []") as "$" => //.
{ iPureIntro. rewrite /i2v. { iPureIntro. rewrite /i2v.
destruct (val_of_Z (owner + 1) u16) eqn:Heq => //. exfalso. destruct (val_of_Z (owner + 1)) eqn:Heq => /=; first by apply val_to_of_int.
assert (owner + 1 u16) as Hu16%val_of_Z_is_some by (split; lia). exfalso. assert (owner + 1 u16) as Hu16%val_of_Z_is_some by (split; lia).
destruct Hu16 as [??]. by simplify_eq. } destruct Hu16 as [??]. by simplify_eq. }
iRight. iFrame "Htok". by iExists _. } iRight. iFrame "Htok". by iExists _. }
iModIntro. iModIntro.
......
...@@ -23,3 +23,10 @@ Proof. ...@@ -23,3 +23,10 @@ Proof.
- left. assert (H1 = H2) as ->; [|done]. apply proof_irrel. - left. assert (H1 = H2) as ->; [|done]. apply proof_irrel.
- right. naive_solver. - right. naive_solver.
Qed. Qed.
Lemma byte_eq (b1 b2 : byte) :
b1 = b2 b1.(byte_val) = b2.(byte_val).
Proof.
destruct b1, b2. split; simpl; [ naive_solver|].
intros. subst. f_equal. apply proof_irrel.
Qed.
...@@ -123,3 +123,19 @@ Proof. ...@@ -123,3 +123,19 @@ Proof.
destruct it as [? []] => //. destruct it as [? []] => //.
split; unfold min_int, max_int => /=; lia. split; unfold min_int, max_int => /=; lia.
Qed. Qed.
Lemma elem_of_int_type_0_to_127 (n : Z) (it : int_type):
0 n 127 n it.
Proof.
move => [??]. rewrite /elem_of /int_elem_of_it.
have ? := min_int_le_0 it.
have ? := max_int_ge_127 it.
lia.
Qed.
Lemma Z_of_bool_elem_of_int_type (b : bool) (it : int_type):
Z_of_bool b it.
Proof.
apply elem_of_int_type_0_to_127.
destruct b => /=; lia.
Qed.
...@@ -138,6 +138,41 @@ Lemma val_of_Z_in_range it z v: ...@@ -138,6 +138,41 @@ Lemma val_of_Z_in_range it z v:
val_of_Z z it = Some v z it. val_of_Z z it = Some v z it.
Proof. rewrite /val_of_Z. case_bool_decide; by eauto. Qed. Proof. rewrite /val_of_Z. case_bool_decide; by eauto. Qed.
Lemma val_to_Z_go_in_range v n:
val_to_Z_go v = Some n 0 n < 2 ^ (length v * bits_per_byte).
Proof.
elim: v n => /=.
- move => n [] <-. split; first lia.
apply Z.pow_pos_nonneg; lia.
- move => ? v IH n. case_match => //.
destruct (val_to_Z_go v) => /=; last done.
move => [] <-. move: (IH z eq_refl).
move: (byte_constr b). rewrite /byte_modulus /bits_per_byte.
move => [??] [??]. split; first lia.
have ->: S (length v) * 8 = 8 + length v * 8 by lia.
rewrite Z.pow_add_r; lia.
Qed.
Lemma val_to_Z_in_range v it n:
val_to_Z v it = Some n n it.
Proof.
rewrite /val_to_Z. case_decide as Hlen; last done.
destruct (val_to_Z_go v) eqn:Heq => /=; last done.
move: Heq => /val_to_Z_go_in_range.
rewrite Hlen /elem_of /int_elem_of_it /max_int /min_int.
rewrite /int_half_modulus /int_modulus /bits_per_int.
destruct (it_signed it) eqn:Hsigned => /=.
- case_decide => /=.
+ move => [??] [] ?. simplify_eq.
assert (2 ^ (bytes_per_int it * bits_per_byte) =
2 * 2 ^ (bytes_per_int it * bits_per_byte - 1)) as Heq.
{ rewrite Z.sub_1_r. rewrite Z_pow_pred_r => //. rewrite /bits_per_byte.
have ? := bytes_per_int_gt_0 it. lia. }
rewrite Heq. lia.
+ move => [??] [] ?. lia.
- move => [??] [] ?. lia.
Qed.
Lemma val_to_of_int z it v: Lemma val_to_of_int z it v:
val_of_Z z it = Some v val_to_Z v it = Some z. val_of_Z z it = Some v val_to_Z v it = Some z.
Proof. Proof.
...@@ -185,6 +220,47 @@ Lemma i2v_bool_Some b it: ...@@ -185,6 +220,47 @@ Lemma i2v_bool_Some b it:
val_to_Z (i2v (Z_of_bool b) it) it = Some (Z_of_bool b). val_to_Z (i2v (Z_of_bool b) it) it = Some (Z_of_bool b).
Proof. apply val_to_of_int. apply val_of_Z_bool. Qed. Proof. apply val_to_of_int. apply val_of_Z_bool. Qed.
Lemma val_to_Z_go_Some_inj v1 v2 n:
length v1 = length v2
val_to_Z_go v1 = Some n
val_to_Z_go v2 = Some n
v1 = v2.
Proof.
elim: v1 v2 n; first by destruct v2.
move => b1 v1 IH [] b2 v2 // n /= [] Hlen.
destruct b1 as [b1|?|] => //. destruct b2 as [b2|?|] => //.
destruct (val_to_Z_go v1) as [n1|] eqn:Hn1 => //.
destruct (val_to_Z_go v2) as [n2|] eqn:Hn2 => //.
move => /= [] <- [] Heq.
assert (n1 = n2 byte_val b1 = byte_val b2) as [??].
{ move: Heq. clear.
have H1 := byte_constr b1.
have H2 := byte_constr b2.
move: H1 H2. rewrite /byte_modulus. lia. }
simplify_eq. f_equal; last by eapply IH. f_equal.
by apply byte_eq.
Qed.
Lemma val_to_Z_Some_inj v1 v2 it n:
val_to_Z v1 it = Some n
val_to_Z v2 it = Some n
v1 = v2.
Proof.
rewrite /val_to_Z.
case_decide as Hlen1; last done.
case_decide as Hlen2; last done.
destruct (val_to_Z_go v1) as [n1|] eqn:Hn1 => //=.
destruct (val_to_Z_go v2) as [n2|] eqn:Hn2 => //=.
move: (Hn1) => /val_to_Z_go_in_range [Hb1 HB1]; rewrite Hlen1 in HB1.
move: (Hn2) => /val_to_Z_go_in_range [Hb2 HB2]; rewrite Hlen2 in HB2.
have Hlen: length v1 = length v2 by rewrite Hlen1 Hlen2.
move => <- Heq_if. eapply val_to_Z_go_Some_inj => //.
rewrite Hn2; f_equal. move: Heq_if.
rewrite /int_modulus /int_half_modulus /bits_per_int.
destruct (it_signed it) => /=; last naive_solver.
repeat case_bool_decide => /=; naive_solver lia.
Qed.
Arguments val_to_Z : simpl never. Arguments val_to_Z : simpl never.
Arguments val_of_Z : simpl never. Arguments val_of_Z : simpl never.
Typeclasses Opaque val_to_Z val_of_Z val_of_bool. Typeclasses Opaque val_to_Z val_of_Z val_of_bool.
...@@ -222,7 +222,7 @@ Section array. ...@@ -222,7 +222,7 @@ Section array.
iDestruct ("HP" with "Hv") as (Hv) "HP". iDestruct ("HP" with "Hv") as (Hv) "HP".
iDestruct "HP" as (? Hlen) "HP". iDestruct "HP" as (? Hlen) "HP".
have [|ty ?]:= lookup_lt_is_Some_2 tys (Z.to_nat i). lia. have [|ty ?]:= lookup_lt_is_Some_2 tys (Z.to_nat i). lia.
iApply wp_ptr_offset => //. by apply val_to_of_loc. by apply val_to_of_int. iApply wp_ptr_offset => //. by apply val_to_of_loc.
iIntros "!#". iExists _. iSplit => //. iIntros "!#". iExists _. iSplit => //.
iDestruct (big_sepL_insert_acc with "Hl") as "[Hl Hc]" => //. rewrite Z2Nat.id//. iDestruct (big_sepL_insert_acc with "Hl") as "[Hl Hc]" => //. rewrite Z2Nat.id//.
iApply ("HP" $! ty with "[//] Hl"). iIntros (l' ty2 β2 typ R) "Hl' Htyp HT". iApply ("HP" $! ty with "[//] Hl"). iIntros (l' ty2 β2 typ R) "Hl' Htyp HT".
......
...@@ -7,34 +7,36 @@ Section atomic_bool. ...@@ -7,34 +7,36 @@ Section atomic_bool.
Context `{!typeG Σ}. Context `{!typeG Σ}.
Program Definition atomic_bool (it : int_type) (PT PF : iProp Σ) : type := {| Program Definition atomic_bool (it : int_type) (PT PF : iProp Σ) : type := {|
ty_own β l := (match β return _ with ty_own β l :=
| Own => b, l ◁ₗ b @ boolean it if b then PT else PF match β return _ with
| Shr => l `has_layout_loc` it | Own => b, l ◁ₗ b @ boolean it if b then PT else PF
inv atomic_boolN ( b, l i2v (Z_of_bool b) it if b then PT else PF) | Shr => l `has_layout_loc` it
end)%I inv atomic_boolN ( b, l i2v (Z_of_bool b) it if b then PT else PF)
|}. end;
|}%I.
Next Obligation. Next Obligation.
iIntros (PT PF l E HE) => /=. iDestruct 1 as (b) "[Hb Hown]". iIntros "%it %PT %PF %l %E %HE (%b&Hb&Hown)".
iDestruct (ty_aligned with "Hb") as %?. iSplitR => //. iDestruct (ty_aligned with "Hb") as %?. iSplitR => //.
iApply inv_alloc. iIntros "!#". iExists b. iFrame. iApply inv_alloc. iNext. iExists b. iFrame.
iDestruct (ty_deref with "Hb") as (v) "[Hl Hb]". iDestruct (ty_deref with "Hb") as "(%v&Hl&Hb)".
(* TODO: don't unfold here *) by iDestruct (boolean_own_val_eq with "Hb") as %<-.
rewrite /i2v. by iDestruct "Hb" as %->.
Qed. Qed.
Global Program Instance movable_atomic_bool it PT PF : Movable (atomic_bool it PT PF) := {| Global Program Instance movable_atomic_bool it PT PF : Movable (atomic_bool it PT PF) := {|
ty_layout := it_layout it; ty_layout := it_layout it;
ty_own_val v := b, v ◁ᵥ b @ boolean it if b then PT else PF; ty_own_val v := b, v ◁ᵥ b @ boolean it if b then PT else PF;
|}%I. |}%I.
Next Obligation. iIntros (it PT PF l). iDestruct 1 as (?) "[Hb _]". by iApply (ty_aligned with "Hb"). Qed. Next Obligation. iIntros (????) "[% [Hb _]]". by iApply (ty_aligned with "Hb"). Qed.
Next Obligation. iIntros (it PT PF v). iDestruct 1 as (?) "[Hb _]". by iApply (ty_size_eq with "Hb"). Qed. Next Obligation. iIntros (????) "[% [Hb _]]". by iApply (ty_size_eq with "Hb"). Qed.
Next Obligation. Next Obligation.
iIntros (it PT PF v). iDestruct 1 as (?) "[Hb ?]". iIntros (????) "[% [Hb ?]]".
iDestruct (ty_deref with "Hb") as (?) "[? ?]". eauto with iFrame. iDestruct (ty_deref with "Hb") as (?) "[? ?]".
eauto with iFrame.
Qed. Qed.
Next Obligation. Next Obligation.
iIntros (it PT PF l v ?) "Hl". iDestruct 1 as (?) "[Hb ?]". iIntros (??????) "Hl [%b [Hb ?]]".
iDestruct (ty_ref with "[] Hl Hb") as "?" => //. iExists _. iFrame. iDestruct (ty_ref with "[] Hl Hb") as "?" => //.
iExists b. iFrame.
Qed. Qed.
End atomic_bool. End atomic_bool.
...@@ -57,29 +59,35 @@ Section programs. ...@@ -57,29 +59,35 @@ Section programs.
λ T, i2p (subsume_atomic_bool_own_int l n it PT PF T). λ T, i2p (subsume_atomic_bool_own_int l n it PT PF T).
Lemma type_read_atomic_bool l β it PT PF T: Lemma type_read_atomic_bool l β it PT PF T:
( b v, destruct_hint (DHintDestruct bool b) tt ((if b then PT else PF) - (if b then PT else PF) T v (atomic_bool it PT PF) (t2mt (b @ boolean it)))) - ( b v,
destruct_hint (DHintDestruct bool b) tt (
(if b then PT else PF) -
(if b then PT else PF)
T v (atomic_bool it PT PF) (t2mt (b @ boolean it))
)
) -
typed_read_end true l β (atomic_bool it PT PF) it T. typed_read_end true l β (atomic_bool it PT PF) it T.
Proof. Proof.
iIntros "HT Hl". unfold destruct_hint. unfold destruct_hint. iIntros "HT Hl". destruct β.
destruct β. - iDestruct "Hl" as "[%b [Hl Hif]]".
- iDestruct "Hl" as (b) "[Hl Hif]".
iApply fupd_mask_intro => //. iIntros "Hclose". iApply fupd_mask_intro => //. iIntros "Hclose".
iDestruct (ty_aligned with "Hl") as %?. iDestruct (ty_aligned with "Hl") as %?.
iDestruct (ty_deref with "Hl") as (v) "[Hl #Hv]". iDestruct (ty_deref with "Hl") as (v) "[Hl #Hv]".
iDestruct (ty_size_eq with "Hv") as %?. iDestruct (ty_size_eq with "Hv") as %?.
iExists _, _, _, (t2mt (b @ boolean it)). iFrame "∗Hv". do 2 iSplitR => //=. iExists _, _, _, (t2mt (b @ boolean it)).
iFrame "∗Hv". do 2 iSplitR => //=.
iIntros "!# Hl". iMod "Hclose". iModIntro. iIntros "!# Hl". iMod "Hclose". iModIntro.
iDestruct ("HT" with "Hif") as "[Hif $]". iDestruct ("HT" with "Hif") as "[Hif $]".
iExists b. iFrame. iExists b. iFrame. by iApply (ty_ref with "[] Hl Hv").
by iApply (ty_ref with "[] Hl Hv").
- iDestruct "Hl" as (Hly) "#Hinv". - iDestruct "Hl" as (Hly) "#Hinv".
iInv "Hinv" as (b) "[>Hl Hif]" "Hclose". iInv "Hinv" as (b) "[>Hl Hif]" "Hclose".
iApply fupd_mask_intro. set_solver. iIntros "Hclose2". iApply fupd_mask_intro. set_solver. iIntros "Hclose2".
iExists _, _, _, (t2mt (b @ boolean it)). iFrame. iExists _, _, _, (t2mt (b @ boolean it)). iFrame.
rewrite /has_layout_val i2v_bool_length. rewrite /has_layout_val i2v_bool_length.
do 2 iSplitR => //=. iSplitR => //. { by rewrite /ty_own_val/= val_of_Z_bool. } do 2 iSplitR => //=. iSplitR; first by iApply boolean_own_val_eq.
iIntros "!# Hl". iDestruct ("HT" with "Hif") as "[Hif $]". iIntros "!# Hl". iDestruct ("HT" with "Hif") as "[Hif $]".
iMod "Hclose2" as "_". iMod ("Hclose" with "[-]"). { iExists _. by iFrame. } iMod "Hclose2" as "_".
iMod ("Hclose" with "[-]"). { iExists _. by iFrame. }
iModIntro. by iSplitR. iModIntro. by iSplitR.
Qed. Qed.
Global Instance type_read_atomic_bool_inst l β it PT PF: Global Instance type_read_atomic_bool_inst l β it PT PF:
...@@ -87,13 +95,19 @@ Section programs. ...@@ -87,13 +95,19 @@ Section programs.
λ T, i2p (type_read_atomic_bool l β it PT PF T). λ T, i2p (type_read_atomic_bool l β it PT PF T).
Lemma type_write_atomic_bool l β it PT PF v ty `{!Movable ty} T: Lemma type_write_atomic_bool l β it PT PF v ty `{!Movable ty} T:
( b, subsume (v ◁ᵥ ty) (v ◁ᵥ b @ boolean it) (ty.(ty_layout) = it (if b then PT else PF) T (atomic_bool it PT PF))) - ( b,
subsume (v ◁ᵥ ty) (v ◁ᵥ b @ boolean it) (
ty.(ty_layout) = it
(if b then PT else PF)
T (atomic_bool it PT PF)
)
) -
typed_write_end true v ty l β (atomic_bool it PT PF) T. typed_write_end true v ty l β (atomic_bool it PT PF) T.
Proof. Proof.
iIntros "HT Hl Hv". iDestruct "HT" as (bnew) "Hsub". iIntros "[%bnew Hsub] Hl Hv".
iDestruct ("Hsub" with "Hv") as "(Hnew&->&Hif'&HT)". iDestruct ("Hsub" with "Hv") as "(Hnew&->&Hif_new&HT)".
destruct β. destruct β.
- iDestruct "Hl" as (bold) "[Hl Hif]". - iDestruct "Hl" as "[%bold [Hl Hif_old]]".
iApply fupd_mask_intro => //. iIntros "Hc". iApply fupd_mask_intro => //. iIntros "Hc".
iDestruct (ty_aligned with "Hl") as %?. iDestruct (ty_aligned with "Hl") as %?.
iDestruct (ty_deref with "Hl") as (vb) "[Hmt Hold]". iDestruct (ty_deref with "Hl") as (vb) "[Hmt Hold]".
...@@ -104,12 +118,13 @@ Section programs. ...@@ -104,12 +118,13 @@ Section programs.
iApply (@ty_ref with "[] Hl") => //. done. iApply (@ty_ref with "[] Hl") => //. done.
- iDestruct "Hl" as (?) "#Hinv". - iDestruct "Hl" as (?) "#Hinv".
iInv "Hinv" as (b) "[>Hmt Hif]" "Hc". iInv "Hinv" as (b) "[>Hmt Hif]" "Hc".
iApply fupd_mask_intro; first solve_ndisj. iIntros "Hc2". iApply fupd_mask_intro; first solve_ndisj.
iSplitL "Hmt". iIntros "Hc2". iSplitL "Hmt".
{ iExists _; iFrame; iPureIntro; split => //. apply i2v_bool_length. } { iExists _; iFrame; iPureIntro; split => //. apply i2v_bool_length. }
iIntros "!# Hl". iMod "Hc2". iIntros "!# Hl". iMod "Hc2".
iMod ("Hc" with "[Hif' Hl Hnew]"). iDestruct (boolean_own_val_eq with "Hnew") as %->.
{ iModIntro. iExists bnew. iFrame. rewrite /i2v. by iDestruct "Hnew" as %->. } iMod ("Hc" with "[Hif_new Hl]").
{ iModIntro. iExists bnew. iFrame. }
iModIntro. iExists _. iFrame. by iSplit. iModIntro. iExists _. iFrame. by iSplit.
Qed. Qed.
Global Instance type_write_atomic_bool_inst l β it PT PF v ty `{!Movable ty}: Global Instance type_write_atomic_bool_inst l β it PT PF v ty `{!Movable ty}:
...@@ -117,37 +132,51 @@ Section programs. ...@@ -117,37 +132,51 @@ Section programs.
λ T, i2p (type_write_atomic_bool l β it PT PF v ty T). λ T, i2p (type_write_atomic_bool l β it PT PF v ty T).
Lemma type_cas_atomic_bool (l : loc) β it PT PF lexp Pexp vnew Pnew T: Lemma type_cas_atomic_bool (l : loc) β it PT PF lexp Pexp vnew Pnew T:
( bexp bnew, subsume Pexp (lexp ◁ₗ bexp @ boolean it) ( ( bexp bnew,
subsume Pnew (vnew ◁ᵥ bnew @ boolean it) ( bytes_per_int it bytes_per_addr%nat ( subsume Pexp (lexp ◁ₗ bexp @ boolean it) (
((if bexp then PT else PF) - (if bnew then PT else PF) ( subsume Pnew (vnew ◁ᵥ bnew @ boolean it) (
l ◁ₗ{β} atomic_bool it PT PF - lexp ◁ₗ bexp @ boolean it - bytes_per_int it bytes_per_addr%nat (
T (val_of_bool true) (t2mt (true @ boolean bool_it)))) ((if bexp then PT else PF) -
(l ◁ₗ{β} atomic_bool it PT PF - lexp ◁ₗ negb bexp @ boolean it - (if bnew then PT else PF) (
T (val_of_bool false) (t2mt (false @ boolean bool_it))) l ◁ₗ{β} atomic_bool it PT PF - lexp ◁ₗ bexp @ boolean it -
)))) - T (val_of_bool true) (t2mt (true @ boolean bool_it))))
(l ◁ₗ{β} atomic_bool it PT PF -
lexp ◁ₗ negb bexp @ boolean it -
T (val_of_bool false) (t2mt (false @ boolean bool_it)))
)
)
)
) -
typed_cas