Commit 4aba43b3 authored by Hai Dang's avatar Hai Dang

add retag for immut ref

parent dbba1a31
From stbor.lang Require Export defs steps_foreach steps_list steps_wf. From stbor.lang Require Export defs steps_foreach steps_list steps_wf steps_progress.
Set Default Proof Using "Type". Set Default Proof Using "Type".
(* FIXME; should not require [Unique] *) Definition tag_on_top (stks: stacks) l t pm : Prop :=
Definition tag_on_top (stks: stacks) l tag : Prop := prot, (stks !! l) = head = Some (mkItem pm (Tagged t) prot).
prot, (stks !! l) = head = Some (mkItem Unique (Tagged tag) prot).
(** Active protector preserving *) (** Active protector preserving *)
Definition active_preserving (cids: call_id_stack) (stk stk': stack) := Definition active_preserving (cids: call_id_stack) (stk stk': stack) :=
...@@ -690,9 +689,9 @@ Qed. ...@@ -690,9 +689,9 @@ Qed.
(** Tag-on-top *) (** Tag-on-top *)
Lemma tag_on_top_write σ l tg stks : Lemma tag_on_top_write σ l tg stks :
tag_on_top σ.(sst) l tg tag_on_top σ.(sst) l tg Unique
memory_written (sst σ) (scs σ) l (Tagged tg) 1 = Some stks memory_written (sst σ) (scs σ) l (Tagged tg) 1 = Some stks
tag_on_top stks l tg. tag_on_top stks l tg Unique.
Proof. Proof.
rewrite /memory_written /tag_on_top /= shift_loc_0. rewrite /memory_written /tag_on_top /= shift_loc_0.
destruct (sst σ !! l) eqn:Hlk; last done. simpl. destruct (sst σ !! l) eqn:Hlk; last done. simpl.
...@@ -704,39 +703,65 @@ Proof. ...@@ -704,39 +703,65 @@ Proof.
simpl. done. simpl. done.
Qed. Qed.
Lemma tag_on_top_grant_unique stk old it cids stk' Lemma tag_on_top_grant_uniq_SRO stk old it cids stk'
(UNIQ: it.(perm) = Unique) : (UNIQ: it.(perm) = Unique it.(perm) = SharedReadOnly) :
grant stk old it cids = Some stk' is_stack_head it stk'. grant stk old it cids = Some stk' is_stack_head it stk'.
Proof. Proof.
rewrite /grant. rewrite /grant.
case find_granting as [gip|]; [|done]. case find_granting as [gip|]; [|done].
rewrite /= UNIQ /=. case access1 => [[n1 stk1]/=|//]. destruct UNIQ as [UNIQ|UNIQ];
destruct stk1; [|case decide => ?]; intros; simplify_eq; by eexists. rewrite /= UNIQ /=; (case access1 => [[n1 stk1]/=|//]);
(destruct stk1; [|case decide => ?]; intros; simplify_eq; by eexists).
Qed. Qed.
Lemma tag_on_top_reborrowN_uniq α cids l n to tn α' pro : Lemma tag_on_top_reborrowN_uniq_SRO α cids l n to tn pm α' pro
reborrowN α cids l n to (Tagged tn) Unique pro = Some α' (UNIQ: pm = Unique pm = SharedReadOnly) :
i, (i < n)%nat tag_on_top α' (l + i) tn. reborrowN α cids l n to (Tagged tn) pm pro = Some α'
i, (i < n)%nat tag_on_top α' (l + i) tn pm.
Proof. Proof.
intros RB i Lt. intros RB i Lt.
destruct (for_each_lookup_case_2 _ _ _ _ _ RB) as [EQ _]. destruct (for_each_lookup_case_2 _ _ _ _ _ RB) as [EQ _].
specialize (EQ _ Lt) as (stk & stk' & Eq & Eq' & GR). specialize (EQ _ Lt) as (stk & stk' & Eq & Eq' & GR).
apply tag_on_top_grant_unique in GR as [stk1 Eq1]; [|done]. apply tag_on_top_grant_uniq_SRO in GR as [stk1 Eq1]; [|done].
rewrite /tag_on_top Eq' Eq1 /=. by eexists. rewrite /tag_on_top Eq' Eq1 /=. by eexists.
Qed. Qed.
Lemma tag_on_top_retag_ref_uniq α cids nxtp l old T pro tn α' nxtp' : Lemma tag_on_top_retag_ref_uniq α cids nxtp l old T pro tn α' nxtp' :
retag_ref α cids nxtp l old T (UniqueRef false) pro retag_ref α cids nxtp l old T (UniqueRef false) pro
= Some (Tagged tn, α', nxtp') = Some (Tagged tn, α', nxtp')
i, (i < tsize T)%nat tag_on_top α' (l + i) tn. i, (i < tsize T)%nat tag_on_top α' (l + i) tn Unique.
Proof. Proof.
intros RT i. destruct (tsize T) as [|n] eqn:Eqsz; [lia|]. intros RT i. destruct (tsize T) as [|n] eqn:Eqsz; [lia|].
rewrite -Eqsz. rewrite -Eqsz.
move : RT. rewrite /retag_ref {1}Eqsz /=. move : RT. rewrite /retag_ref {1}Eqsz /=.
case reborrowN as [α1|] eqn:RB; [|done]. simpl. intros ?. simplify_eq. case reborrowN as [α1|] eqn:RB; [|done]. simpl. intros ?. simplify_eq.
eapply tag_on_top_reborrowN_uniq; eauto. eapply tag_on_top_reborrowN_uniq_SRO; eauto.
Qed. Qed.
Lemma tag_on_top_retag_ref_shr α cids nxtp l old T pro tn α' nxtp'
(FRZ: is_freeze T) :
retag_ref α cids nxtp l old T SharedRef pro
= Some (Tagged tn, α', nxtp')
i, (i < tsize T)%nat tag_on_top α' (l + i) tn SharedReadOnly.
Proof.
intros RT i. destruct (tsize T) as [|n] eqn:Eqsz; [lia|].
rewrite -Eqsz.
move : RT. rewrite /retag_ref {1}Eqsz /= visit_freeze_sensitive_is_freeze //.
case reborrowN as [α1|] eqn:RB; [|done]. simpl. intros ?. simplify_eq.
eapply tag_on_top_reborrowN_uniq_SRO; eauto.
Qed.
Lemma tag_on_top_shr_active_SRO α l t :
tag_on_top α l t SharedReadOnly
stk, α !! l = Some stk t active_SRO stk.
Proof.
intros [pro Eq]. destruct (α !! l) as [stk|]; [|done].
simpl in Eq. destruct stk as [|it stk']; [done|].
simpl in Eq. simplify_eq. eexists. split; [done|].
rewrite /= elem_of_union elem_of_singleton. by left.
Qed.
(* retag *)
Lemma retag_nxtp_change α cids c nxtp l otag ntag rk pk T α' nxtp' Lemma retag_nxtp_change α cids c nxtp l otag ntag rk pk T α' nxtp'
(TS: (O < tsize T)%nat) (TS: (O < tsize T)%nat)
(RK: match pk with | RawPtr _ => rk = RawRt | _ => True end) : (RK: match pk with | RawPtr _ => rk = RawRt | _ => True end) :
......
...@@ -113,7 +113,7 @@ Proof. ...@@ -113,7 +113,7 @@ Proof.
- rewrite ACC1 in Eqss. simplify_eq. rewrite insert_id //. by inversion 1. } - rewrite ACC1 in Eqss. simplify_eq. rewrite insert_id //. by inversion 1. }
subst α'. rewrite Eqstk in Eqstk'. symmetry in Eqstk'. simplify_eq. subst α'. rewrite Eqstk in Eqstk'. symmetry in Eqstk'. simplify_eq.
have TOT: tag_on_top σt.(sst) l t. have TOT: tag_on_top σt.(sst) l t Unique.
{ destruct HDi as [stk' Eqstk']. { destruct HDi as [stk' Eqstk'].
rewrite /tag_on_top Eqstk Eqstk' /= -Eqpit -Eqti. destruct it. by eexists. } rewrite /tag_on_top Eqstk Eqstk' /= -Eqpit -Eqti. destruct it. by eexists. }
......
...@@ -915,7 +915,7 @@ Lemma sim_body_write_unique_local_1 fs ft r r' n l t k T vs vt h0 σs σt Φ : ...@@ -915,7 +915,7 @@ Lemma sim_body_write_unique_local_1 fs ft r r' n l t k T vs vt h0 σs σt Φ :
( ss st, vs = [ss] vt = [st] ( ss st, vs = [ss] vt = [st]
let σs' := mkState (<[l := ss]> σs.(shp)) σs.(sst) σs.(scs) σs.(snp) σs.(snc) in let σs' := mkState (<[l := ss]> σs.(shp)) σs.(sst) σs.(scs) σs.(snp) σs.(snc) in
let σt' := mkState (<[l := st]> σt.(shp)) σt.(sst) σt.(scs) σt.(snp) σt.(snc) in let σt' := mkState (<[l := st]> σt.(shp)) σt.(sst) σt.(scs) σt.(snp) σt.(snc) in
tag_on_top σt'.(sst) l t tag_on_top σt'.(sst) l t Unique
Φ (r' res_tag t k (<[l := (ss,st)]>h0)) n (ValR [%S]) σs' (ValR [%S]) σt') Φ (r' res_tag t k (<[l := (ss,st)]>h0)) n (ValR [%S]) σs' (ValR [%S]) σt')
r {n,fs,ft} r {n,fs,ft}
(Place l (Tagged t) T <- #vs, σs) (Place l (Tagged t) T <- #vt, σt) : Φ. (Place l (Tagged t) T <- #vs, σs) (Place l (Tagged t) T <- #vt, σt) : Φ.
...@@ -1004,7 +1004,7 @@ Proof. ...@@ -1004,7 +1004,7 @@ Proof.
- rewrite ACC1 in Eqss. simplify_eq. rewrite insert_id //. by inversion 1. } - rewrite ACC1 in Eqss. simplify_eq. rewrite insert_id //. by inversion 1. }
subst α'. rewrite Eqstk in Eqstk'. symmetry in Eqstk'. simplify_eq. subst α'. rewrite Eqstk in Eqstk'. symmetry in Eqstk'. simplify_eq.
have TOT: tag_on_top σt.(sst) l t. have TOT: tag_on_top σt.(sst) l t Unique.
{ destruct HDi as [stk' Eqstk']. { destruct HDi as [stk' Eqstk'].
rewrite /tag_on_top Eqstk Eqstk' /= -Eqpit -Eqti. destruct it. by eexists. } rewrite /tag_on_top Eqstk Eqstk' /= -Eqpit -Eqti. destruct it. by eexists. }
...@@ -1184,7 +1184,7 @@ Lemma sim_body_write_unique_1 ...@@ -1184,7 +1184,7 @@ Lemma sim_body_write_unique_1
r' r'' rs r' r'' rs
(let σs' := mkState (write_mem l [s] σs.(shp)) σs.(sst) σs.(scs) σs.(snp) σs.(snc) in (let σs' := mkState (write_mem l [s] σs.(shp)) σs.(sst) σs.(scs) σs.(snp) σs.(snc) in
let σt' := mkState (write_mem l [s] σt.(shp)) σt.(sst) σt.(scs) σt.(snp) σt.(snc) in let σt' := mkState (write_mem l [s] σt.(shp)) σt.(sst) σt.(scs) σt.(snp) σt.(snc) in
tag_on_top σt'.(sst) l tg tag_on_top σt'.(sst) l tg Unique
Φ (r' res_tag tg tkUnique (<[l:=(s,s)]> h)) n (ValR []%S) σs' (ValR []%S) σt') Φ (r' res_tag tg tkUnique (<[l:=(s,s)]> h)) n (ValR []%S) σs' (ValR []%S) σt')
r {n,fs,ft} r {n,fs,ft}
(Place l (Tagged tg) T <- #[s], σs) (Place l (Tagged tg) T <- #[s], σt) : Φ. (Place l (Tagged tg) T <- #[s], σs) (Place l (Tagged tg) T <- #[s], σt) : Φ.
...@@ -1407,9 +1407,12 @@ Proof. ...@@ -1407,9 +1407,12 @@ Proof.
- by apply IH. - by apply IH.
Qed. Qed.
Lemma sim_body_retag_mut_ref_default fs ft r n ptr T σs σt Φ :
Lemma sim_body_retag_ref_default fs ft mut r n ptr T σs σt Φ :
(0 < tsize T)%nat (0 < tsize T)%nat
let pk : pointer_kind := (RefPtr Mutable) in let pk : pointer_kind := (RefPtr mut) in
let pm := match mut with Mutable => Unique | Immutable => SharedReadOnly end in
(if mut is Immutable then is_freeze T else True)
(* Ptr(l,otg) comes from the arguments, so [otg] must be a public tag. *) (* Ptr(l,otg) comes from the arguments, so [otg] must be a public tag. *)
arel r ptr ptr arel r ptr ptr
( l told tnew hplt c cids α' nxtp', ( l told tnew hplt c cids α' nxtp',
...@@ -1421,16 +1424,17 @@ Lemma sim_body_retag_mut_ref_default fs ft r n ptr T σs σt Φ : ...@@ -1421,16 +1424,17 @@ Lemma sim_body_retag_mut_ref_default fs ft r n ptr T σs σt Φ :
stack for each [l + i]. stack for each [l + i].
TODO: we can also specify that [hplt] knows the values of [l + i]'s. *) TODO: we can also specify that [hplt] knows the values of [l + i]'s. *)
( i: nat, (i < tsize T)%nat ( i: nat, (i < tsize T)%nat
is_Some $ hplt !! (l + i) tag_on_top α' (l + i) tnew) is_Some $ hplt !! (l + i) tag_on_top α' (l + i) tnew pm)
let σs' := mkState σs.(shp) α' σs.(scs) nxtp' σs.(snc) in let σs' := mkState σs.(shp) α' σs.(scs) nxtp' σs.(snc) in
let σt' := mkState σt.(shp) α' σt.(scs) nxtp' σt.(snc) in let σt' := mkState σt.(shp) α' σt.(scs) nxtp' σt.(snc) in
let s_new := ScPtr l (Tagged tnew) in let s_new := ScPtr l (Tagged tnew) in
Φ (r res_tag tnew tkUnique hplt) n (ValR [s_new]) σs' (ValR [s_new]) σt') let tk := match mut with Mutable => tkUnique | Immutable => tkPub end in
Φ (r res_tag tnew tk hplt) n (ValR [s_new]) σs' (ValR [s_new]) σt')
r {n,fs,ft} r {n,fs,ft}
(Retag #[ptr] pk T Default, σs) (Retag #[ptr] pk T Default, σs)
(Retag #[ptr] pk T Default, σt) : Φ. (Retag #[ptr] pk T Default, σt) : Φ.
Proof. Proof.
intros NZST pk AREL POST. pfold. intros NT. intros. intros NZST pk pm FRZ AREL POST. pfold. intros NT. intros.
have WSAT1 := WSAT. (* back up *) have WSAT1 := WSAT. (* back up *)
destruct WSAT as (WFS & WFT & VALID & PINV & CINV & SREL). destruct WSAT as (WFS & WFT & VALID & PINV & CINV & SREL).
...@@ -1479,17 +1483,18 @@ Proof. ...@@ -1479,17 +1483,18 @@ Proof.
set tnew := σt.(snp). set tnew := σt.(snp).
set hplt : heaplet := write_hpl l (combine vs vt) . set hplt : heaplet := write_hpl l (combine vs vt) .
set r' : resUR := r res_tag tnew tkUnique hplt. set tk := match mut with Mutable => tkUnique | Immutable => tkPub end.
set r' : resUR := r res_tag tnew tk hplt.
have HNP := wsat_tmap_nxtp _ _ _ WSAT1. have HNP := wsat_tmap_nxtp _ _ _ WSAT1.
have VALID': (r_f r res_tag tnew tkUnique hplt). have VALID': (r_f r res_tag tnew tk hplt).
{ apply (local_update_discrete_valid_frame (r_f r) ε); { apply (local_update_discrete_valid_frame (r_f r) ε);
[by rewrite right_id|]. rewrite right_id. [by rewrite right_id|]. rewrite right_id.
by apply res_tag_alloc_local_update. } by apply res_tag_alloc_local_update. }
have Eqc': (r_f r res_tag tnew tkUnique hplt).(rcm) (r_f r).(rcm) have Eqc': (r_f r res_tag tnew tk hplt).(rcm) (r_f r).(rcm)
by rewrite /= right_id. by rewrite /= right_id.
have HLt: t kh, (r_f r).(rtm) !! t Some kh have HLt: t kh, (r_f r).(rtm) !! t Some kh
(r_f r res_tag tnew tkUnique hplt).(rtm) !! t Some kh. (r_f r res_tag tnew tk hplt).(rtm) !! t Some kh.
{ intros t kh Eqt. { intros t kh Eqt.
rewrite lookup_op res_tag_lookup_ne. rewrite lookup_op res_tag_lookup_ne.
- by rewrite right_id. - by rewrite right_id.
...@@ -1527,16 +1532,26 @@ Proof. ...@@ -1527,16 +1532,26 @@ Proof.
rewrite EqlT in Lti. rewrite EqlT in Lti.
specialize (Eqshp _ Lti). rewrite Eqvs1 in Eqshp. specialize (Eqshp _ Lti). rewrite Eqvs1 in Eqshp.
specialize (Eqthp _ Lti). rewrite Eqvt1 in Eqthp. specialize (Eqthp _ Lti). rewrite Eqvt1 in Eqthp.
intros (stk' & pm & pro & Eqstk' & In' & NDIS). simpl in Eqstk'. destruct mut.
do 2 (split; [done|]). * intros (stk' & pm' & pro & Eqstk' & In' & NDIS). simpl in Eqstk'.
exists stk'. split; [done|]. do 2 (split; [done|]).
have EqRT': exists stk'. split; [done|].
retag_ref σt.(sst) σt.(scs) σt.(snp) l otg T (UniqueRef false) None = have EqRT':
Some (Tagged tnew, α', S tnew) by done. retag_ref σt.(sst) σt.(scs) σt.(snp) l otg T (UniqueRef false) None =
destruct (tag_on_top_retag_ref_uniq _ _ _ _ _ _ _ _ _ _ EqRT' _ Lti) Some (Tagged tnew, α', S tnew) by done.
as [pro1 Eqstk1]. rewrite Eqstk' /= in Eqstk1. destruct (tag_on_top_retag_ref_uniq _ _ _ _ _ _ _ _ _ _ EqRT' _ Lti)
clear -Eqstk1. destruct stk' as [|? stk1]; [done|]. as [pro1 Eqstk1]. rewrite Eqstk' /= in Eqstk1.
simpl in Eqstk1. simplify_eq. by exists pro1, stk1. clear -Eqstk1. destruct stk' as [|? stk1]; [done|].
simpl in Eqstk1. simplify_eq. by exists pro1, stk1.
* intros (stk' & pm' & pro & Eqstk' & In' & NDIS). simpl in Eqstk'.
do 2 (split; [done|]).
exists stk'. split; [done|].
have EqRT':
retag_ref σt.(sst) σt.(scs) σt.(snp) l otg T SharedRef None =
Some (Tagged tnew, α', S tnew) by done.
have HTOP := (tag_on_top_retag_ref_shr _ _ _ _ _ _ _ _ _ _ FRZ EqRT' _ Lti).
clear -HTOP Eqstk'.
apply tag_on_top_shr_active_SRO in HTOP as (?&?&?). by simplify_eq.
+ rewrite res_tag_lookup_ne; [|done]. + rewrite res_tag_lookup_ne; [|done].
rewrite right_id => Eqt. rewrite right_id => Eqt.
(* TODO: duplicate proof with retag_public *) (* TODO: duplicate proof with retag_public *)
...@@ -1553,7 +1568,7 @@ Proof. ...@@ -1553,7 +1568,7 @@ Proof.
apply tagKindR_local_exclusive_r. } apply tagKindR_local_exclusive_r. }
move : NEq Eqstk. move : NEq Eqstk.
by eapply retag_Some_local. by eapply retag_Some_local.
* destruct PRE as (stk' & pm & pro & Eqstk' & In' & ND). * destruct PRE as (stk' & pm' & pro & Eqstk' & In' & ND).
destruct (retag_item_in _ _ _ _ _ _ _ _ _ _ _ _ EqRT _ _ t' _ Eqstk' In') destruct (retag_item_in _ _ _ _ _ _ _ _ _ _ _ _ EqRT _ _ t' _ Eqstk' In')
as (stk & Eqstk & In); [done..|]. as (stk & Eqstk & In); [done..|].
destruct PINV as (Eqss & Eqst & HP); [simpl; naive_solver|]. destruct PINV as (Eqss & Eqst & HP); [simpl; naive_solver|].
...@@ -1562,11 +1577,11 @@ Proof. ...@@ -1562,11 +1577,11 @@ Proof.
destruct HP as (stk1 & Eqstk1 & opro1 & HTOP). destruct HP as (stk1 & Eqstk1 & opro1 & HTOP).
rewrite Eqstk1 in Eqstk. simplify_eq. rewrite Eqstk1 in Eqstk. simplify_eq.
have ND2 := proj2 (state_wf_stack_item _ WFT _ _ Eqstk1). have ND2 := proj2 (state_wf_stack_item _ WFT _ _ Eqstk1).
assert (opro1 = pro pm = Unique) as []. assert (opro1 = pro pm' = Unique) as [].
{ have In1 : mkItem Unique (Tagged t') opro1 stk. { have In1 : mkItem Unique (Tagged t') opro1 stk.
{ destruct HTOP as [? HTOP]. rewrite HTOP. by left. } { destruct HTOP as [? HTOP]. rewrite HTOP. by left. }
have EQ := stack_item_tagged_NoDup_eq _ _ _ t' ND2 In1 In eq_refl eq_refl. have EQ := stack_item_tagged_NoDup_eq _ _ _ t' ND2 In1 In eq_refl eq_refl.
by simplify_eq. } subst opro1 pm. exists pro. by simplify_eq. } subst opro1 pm'. exists pro.
have NEq: Tagged t' otg. have NEq: Tagged t' otg.
{ intros ?. subst otg. simpl in AREL. { intros ?. subst otg. simpl in AREL.
destruct AREL as (_ & _ & ht & Eqh'). destruct AREL as (_ & _ & ht & Eqh').
...@@ -1575,7 +1590,7 @@ Proof. ...@@ -1575,7 +1590,7 @@ Proof.
move : HTOP. move : HTOP.
by apply (retag_item_head_preserving _ _ _ _ _ _ _ _ _ _ _ _ EqRT by apply (retag_item_head_preserving _ _ _ _ _ _ _ _ _ _ _ _ EqRT
_ _ _ _ _ ND2 Eqstk1 Eqstk' NEq In'). _ _ _ _ _ ND2 Eqstk1 Eqstk' NEq In').
* destruct PRE as (stk' & pm & pro & Eqstk' & In' & ND). * destruct PRE as (stk' & pm' & pro & Eqstk' & In' & ND).
destruct (retag_item_in _ _ _ _ _ _ _ _ _ _ _ _ EqRT _ _ t' _ Eqstk' In') destruct (retag_item_in _ _ _ _ _ _ _ _ _ _ _ _ EqRT _ _ t' _ Eqstk' In')
as (stk & Eqstk & In); [done..|]. as (stk & Eqstk & In); [done..|].
destruct PINV as (Eqss & Eqst & HP); [simpl; naive_solver|]. destruct PINV as (Eqss & Eqst & HP); [simpl; naive_solver|].
...@@ -1594,10 +1609,10 @@ Proof. ...@@ -1594,10 +1609,10 @@ Proof.
intros tc L EqL. specialize (CINV _ _ EqL) as [Ltp CINV]. intros tc L EqL. specialize (CINV _ _ EqL) as [Ltp CINV].
split; [by simpl; lia|]. split; [by simpl; lia|].
intros l1 InL. simpl. intros l1 InL. simpl.
specialize (CINV _ InL) as (stk & pm & Eqstk & In & NDIS). specialize (CINV _ InL) as (stk & pm' & Eqstk & In & NDIS).
destruct (retag_item_active_preserving _ _ _ _ _ _ _ _ _ _ _ _ EqRT destruct (retag_item_active_preserving _ _ _ _ _ _ _ _ _ _ _ _ EqRT
_ _ _ _ _ Eqstk Ltc In) as (stk' & Eqstk' & In'). _ _ _ _ _ Eqstk Ltc In) as (stk' & Eqstk' & In').
by exists stk', pm. by exists stk', pm'.
- (* TODO: duplicate proof with retag_public *) - (* TODO: duplicate proof with retag_public *)
rewrite cmra_assoc. do 4 (split; [done|]). rewrite cmra_assoc. do 4 (split; [done|]).
move => l' /PUBP [PB|PV]. move => l' /PUBP [PB|PV].
...@@ -1611,9 +1626,13 @@ Proof. ...@@ -1611,9 +1626,13 @@ Proof.
intros i Lti. split. intros i Lti. split.
- clear -Lti EqlT. - clear -Lti EqlT.
apply write_hpl_is_Some. by rewrite EqlT. apply write_hpl_is_Some. by rewrite EqlT.
- move : Lti. eapply tag_on_top_retag_ref_uniq. exact EqRT. - move : Lti.
destruct mut.
+ eapply tag_on_top_retag_ref_uniq. exact EqRT.
+ eapply tag_on_top_retag_ref_shr; [done|exact EqRT].
Qed. Qed.
(** InitCall *) (** InitCall *)
Lemma sim_body_init_call fs ft r n es et σs σt Φ : Lemma sim_body_init_call fs ft r n es et σs σt Φ :
let σs' := mkState σs.(shp) σs.(sst) (σs.(snc) :: σs.(scs)) σs.(snp) (S σs.(snc)) in let σs' := mkState σs.(shp) σs.(sst) (σs.(snc) :: σs.(scs)) σs.(snp) (S σs.(snc)) in
......
...@@ -49,7 +49,7 @@ Lemma sim_body_copy_local_unique_r ...@@ -49,7 +49,7 @@ Lemma sim_body_copy_local_unique_r
fs ft (r r': resUR) (h: heaplet) n (l: loc) t k T (ss st: scalar) es σs σt Φ fs ft (r r': resUR) (h: heaplet) n (l: loc) t k T (ss st: scalar) es σs σt Φ
(LU: k = tkLocal k = tkUnique) : (LU: k = tkLocal k = tkUnique) :
tsize T = 1%nat tsize T = 1%nat
tag_on_top σt.(sst) l t tag_on_top σt.(sst) l t Unique
r r' res_tag t k h r r' res_tag t k h
h !! l = Some (ss, st) h !! l = Some (ss, st)
(r {n,fs,ft} (es, σs) (#[st], σt) : Φ : Prop) (r {n,fs,ft} (es, σs) (#[st], σt) : Φ : Prop)
...@@ -112,7 +112,7 @@ Qed. ...@@ -112,7 +112,7 @@ Qed.
Lemma sim_body_copy_unique_r Lemma sim_body_copy_unique_r
fs ft (r r': resUR) (h: heaplet) n (l: loc) t T (ss st: scalar) es σs σt Φ : fs ft (r r': resUR) (h: heaplet) n (l: loc) t T (ss st: scalar) es σs σt Φ :
tsize T = 1%nat tsize T = 1%nat
tag_on_top σt.(sst) l t tag_on_top σt.(sst) l t Unique
r r' res_tag t tkUnique h r r' res_tag t tkUnique h
h !! l = Some (ss, st) h !! l = Some (ss, st)
(r {n,fs,ft} (es, σs) (#[st], σt) : Φ : Prop) (r {n,fs,ft} (es, σs) (#[st], σt) : Φ : Prop)
...@@ -120,7 +120,7 @@ Lemma sim_body_copy_unique_r ...@@ -120,7 +120,7 @@ Lemma sim_body_copy_unique_r
Proof. apply sim_body_copy_local_unique_r. by right. Qed. Proof. apply sim_body_copy_local_unique_r. by right. Qed.
Lemma vsP_res_mapsto_tag_on_top (r: resUR) l t s σs σt : Lemma vsP_res_mapsto_tag_on_top (r: resUR) l t s σs σt :
(r res_loc l [s] t) ={σs,σt}=> (λ _ _ σt, tag_on_top σt.(sst) l t : Prop). (r res_loc l [s] t) ={σs,σt}=> (λ _ _ σt, tag_on_top σt.(sst) l t Unique : Prop).
Proof. Proof.
intros r_f. rewrite cmra_assoc. intros r_f. rewrite cmra_assoc.
intros (WFS & WFT & VALID & PINV & CINV & SREL). intros (WFS & WFT & VALID & PINV & CINV & SREL).
......
...@@ -317,29 +317,25 @@ Proof. ...@@ -317,29 +317,25 @@ Proof.
eapply sim_simple_copy_local_r; done. eapply sim_simple_copy_local_r; done.
Qed. Qed.
Lemma sim_simple_retag_mut_ref fs ft r n (ptr: scalar) ty Φ : Lemma sim_simple_retag_ref fs ft r n (ptr: scalar) m ty Φ :
(0 < tsize ty)%nat (0 < tsize ty)%nat
(if m is Immutable then is_freeze ty else True)
arel r ptr ptr arel r ptr ptr
( l told tnew hplt, ( l told tnew hplt,
ptr = ScPtr l told ptr = ScPtr l told
let s_new := ScPtr l (Tagged tnew) in let s_new := ScPtr l (Tagged tnew) in
(* let tk := match m with Mutable => tkUnique | Immutable => tkPub end in let tk := match m with Mutable => tkUnique | Immutable => tkPub end in
match m with
| Mutable => is_Some (hplt !! l_inner)
| Immutable => if is_freeze ty then is_Some (hplt !! l_inner) else True
end *)
let s_new := ScPtr l (Tagged tnew) in let s_new := ScPtr l (Tagged tnew) in
let tk := tkUnique in
( i: nat, (i < tsize ty)%nat is_Some $ hplt !! (l + i)) ( i: nat, (i < tsize ty)%nat is_Some $ hplt !! (l + i))
Φ (r res_tag tnew tk hplt) n (ValR [s_new]) (ValR [s_new])) Φ (r res_tag tnew tk hplt) n (ValR [s_new]) (ValR [s_new]))
r ⊨ˢ{n,fs,ft} r ⊨ˢ{n,fs,ft}
Retag #[ptr] (RefPtr Mutable) ty Default Retag #[ptr] (RefPtr m) ty Default
Retag #[ptr] (RefPtr Mutable) ty Default Retag #[ptr] (RefPtr m) ty Default
: Φ. : Φ.
Proof. Proof.
intros ?? HH σs σt. intros ??? HH σs σt.
apply sim_body_retag_mut_ref_default; eauto. apply sim_body_retag_ref_default; eauto.
intros ??????????? HS. do 2 (split; [done|]). eapply HH; eauto. intros ??????????? HS. do 2 (split; [done|]). eapply HH; eauto.
intros ??. by apply HS. intros ??. by apply HS.
Qed. Qed.
......
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