Commit 5714f22b authored by Hai Dang's avatar Hai Dang

fix write local and simple

parent 2bc85deb
......@@ -1176,6 +1176,69 @@ Proof.
eapply retag1_head_step'; eauto.
Qed.
Lemma retag_ref_change_1 h α cids c nxtp x rk mut T h' α' nxtp'
(N2: rk TwoPhase) (TS: (O < tsize T)%nat) (FRZ: is_freeze T) :
retag h α nxtp cids c x rk (Reference (RefPtr mut) T) = Some (h', α', nxtp')
l otag, h !! x = Some (ScPtr l otag)
rk' new,
h' = <[x := ScPtr l new]>h
retag_ref h α cids nxtp l otag T rk' (adding_protector rk c) =
Some (new, α', nxtp')
rk' = if mut then UniqueRef (is_two_phase rk) else SharedRef.
Proof.
rewrite retag_equation_2 /=.
destruct (h !! x) as [[| |l t|]|]; simpl; [done..| |done|done].
destruct mut; (case retag_ref as [[[t1 α1] n1]|] eqn:Eq => [/=|//]);
intros; simplify_eq; exists l, t; (split; [done|]);
eexists; exists t1; done.
Qed.
Lemma retag_ref_change_2
h α cids c nxtp l otag rk (mut: mutability) T new α' nxtp'
(TS: (O < tsize T)%nat) (FRZ: is_freeze T) :
let rk' := if mut then UniqueRef false else SharedRef in
let opro := (adding_protector rk c) in
retag_ref h α cids nxtp l otag T rk' opro = Some (new, α', nxtp')
nxtp' = S nxtp new = Tagged nxtp
reborrowN α cids l (tsize T) otag (Tagged nxtp)
(if mut then Unique else SharedReadOnly) opro = Some α'.
Proof.
intros rk' opro. rewrite /retag_ref. destruct (tsize T) as [|n] eqn:EqT; [lia|].
destruct mut; simpl; [|rewrite visit_freeze_sensitive_is_freeze //];
case reborrowN as [α1|] eqn:Eq1 => [/=|//]; intros; simplify_eq; by rewrite -EqT.
Qed.
Lemma retag_ref_change h α cids c nxtp x rk mut T h' α' nxtp'
(N2: rk TwoPhase) (TS: (O < tsize T)%nat) (FRZ: is_freeze T) :
retag h α nxtp cids c x rk (Reference (RefPtr mut) T) = Some (h', α', nxtp')
l otag, h !! x = Some (ScPtr l otag)
h' = <[x := ScPtr l (Tagged nxtp)]>h
nxtp' = S nxtp
reborrowN α cids l (tsize T) otag (Tagged nxtp)
(if mut then Unique else SharedReadOnly) (adding_protector rk c) = Some α'.
Proof.
intros RT.
apply retag_ref_change_1 in RT
as (l & otag & EqL & rk' & new & Eqh & RT &?); [|done..].
subst. exists l, otag. split; [done|].
rewrite (_: is_two_phase rk = false) in RT; [|by destruct rk].
apply retag_ref_change_2 in RT as (?&?&?); [|done..]. by subst new.
Qed.
Lemma retag_ref_reborrowN
(h: mem) α t cids c x l otg T rk (mut: mutability) α'
(N2: rk TwoPhase) (TS: (O < tsize T)%nat) (FRZ: is_freeze T) :
h !! x = Some (ScPtr l otg)
reborrowN α cids l (tsize T) otg (Tagged t)
(if mut then Unique else SharedReadOnly) (adding_protector rk c) =
Some α'
retag h α t cids c x rk (Reference (RefPtr mut) T) = Some (<[x:=ScPtr l (Tagged t)]> h, α', S t).
Proof.
intros Eqx RB. rewrite retag_equation_2 Eqx /= /retag_ref.
destruct (tsize T) eqn:EqT; [lia|].
rewrite (_: is_two_phase rk = false); [|by destruct rk].
destruct mut; simpl; [|rewrite visit_freeze_sensitive_is_freeze //]; rewrite EqT RB /= //.
Qed.
(* Lemma syscall_head_step σ id :
head_step (SysCall id) σ [SysCallEvt id] # σ [].
......
......@@ -92,7 +92,7 @@ Proof.
{ rewrite lookup_insert. done. }
(* Finishing up. *)
eapply sim_body_viewshift.
{ do 6 eapply viewshift_frame_r. eapply vs_call_empty_public. }
{ do 5 eapply viewshift_frame_r. eapply vs_call_empty_public. }
apply: sim_body_result=>Hval. simpl. split.
- eexists. split; first done. eapply res_end_call_sat; first done.
solve_res.
......
......@@ -99,8 +99,11 @@ Proof.
Qed.
Lemma tagKindR_exclusive_heaplet (h0 h: heapletR) mb :
mb Some (to_tagKindR tkUnique, h0) Some (to_tagKindR tkUnique, h) h0 h.
Proof. by intros []%tagKindR_exclusive_heaplet'. Qed.
Some mb Some (to_tagKindR tkUnique, h0) Some (to_tagKindR tkUnique, h) False.
Proof.
destruct mb as [c ]. rewrite -Some_op pair_op. intros [Eq _]%Some_equiv_inj.
destruct c; inversion Eq; simpl in *; simplify_eq.
Qed.
Lemma tagKindR_valid (k: tagKindR) :
valid k k', k = to_tagKindR k'.
......@@ -220,6 +223,15 @@ Proof.
rewrite -Some_op pair_op. intros [?%exclusive_r]; [done|apply _].
Qed.
Lemma tmap_lookup_op_r_unique_equiv (pm1 pm2: tmapUR) t h0 (VALID: (pm1 pm2)):
pm2 !! t Some (to_tagKindR tkUnique, h0)
(pm1 pm2) !! t Some (to_tagKindR tkUnique, h0).
Proof.
intros HL. move : (VALID t). rewrite lookup_op HL.
destruct (pm1 !! t) as [[k1 h1]|] eqn:Eqt; rewrite Eqt; [|done].
rewrite -Some_op pair_op. intros [?%exclusive_r]; [done|apply _].
Qed.
Lemma tmap_lookup_op_l_unique_equiv (pm1 pm2: tmapUR) t h0
(VALID: (pm1 pm2)):
pm1 !! t Some (to_tagKindR tkUnique, h0)
......@@ -455,6 +467,14 @@ Proof.
naive_solver.
Qed.
Lemma res_mapsto_llookup_1 l v t (LEN: (0 < length v)%nat) :
((res_mapsto l v t).(rlm) !! l : optionR tagR) Some (to_tagR t).
Proof.
rewrite lookup_op /= lookup_empty right_id lookup_fmap.
destruct (length v); [lia|].
rewrite /= lookup_insert //.
Qed.
Lemma res_mapsto_tlookup l v (t: ptr_id) :
(res_mapsto l v t).(rtm) !! t
Some (to_tagKindR tkUnique, to_agree <$> (write_mem l v )).
......
......@@ -287,3 +287,15 @@ Proof.
intros Hrel. eapply Forall2_impl; first done.
eauto using vrel_persistent.
Qed.
Lemma arel_res_mapsto_overwrite_1 r l t v1 v2 ss st :
arel (r res_mapsto l [v1] t) ss st arel (r res_mapsto l [v2] t) ss st.
Proof.
destruct ss as [| |? [t1|]|], st as [| |? []|]; simpl; auto; [|naive_solver].
intros (?&?& h & Eqh). do 2 (split; [done|]).
case (decide (t1 = t)) => ?; [subst t1|].
- exfalso. move : Eqh. rewrite lookup_op res_mapsto_tlookup.
apply tagKindR_exclusive.
- exists h. move : Eqh.
by do 2 (rewrite lookup_op res_mapsto_tlookup_ne; [|done]).
Qed.
This diff is collapsed.
......@@ -243,9 +243,8 @@ Qed.
(** * Memory: local *)
Lemma sim_simple_alloc_local fs ft r n T css cst Φ :
( (l: loc) (tg: nat),
let rt := res_tag tg tkUnique in
let r' := res_mapsto l (tsize T) tg in
Φ (r rt r') n (PlaceR l (Tagged tg) T) css (PlaceR l (Tagged tg) T) cst)
let r' := res_mapsto l (repeat %S (tsize T)) tg in
Φ (r r') n (PlaceR l (Tagged tg) T) css (PlaceR l (Tagged tg) T) cst)
r ⊨ˢ{n,fs,ft} (Alloc T, css) (Alloc T, cst) : Φ.
Proof.
intros HH σs σt <-<-. apply sim_body_alloc_local=>/=. exact: HH.
......@@ -253,8 +252,8 @@ Qed.
Lemma sim_simple_write_local fs ft r r' n l tg ty v v' css cst Φ :
tsize ty = 1%nat
r r' res_mapsto l 1 v' tg
( s, v = [s] Φ (r' res_mapsto l 1 s tg) n (ValR [%S]) css (ValR [%S]) cst)
r r' res_mapsto l [v'] tg
( s, v = [s] Φ (r' res_mapsto l [s] tg) n (ValR [%S]) css (ValR [%S]) cst)
r ⊨ˢ{n,fs,ft}
(Place l (Tagged tg) ty <- #v, css) (Place l (Tagged tg) ty <- #v, cst)
: Φ.
......@@ -262,7 +261,7 @@ Proof. intros Hty Hres HH σs σt <-<-. eapply sim_body_write_local_1; eauto. Qe
Lemma sim_simple_copy_local_l fs ft r r' n l tg ty s et css cst Φ :
tsize ty = 1%nat
r r' res_mapsto l 1 s tg
r r' res_mapsto l [s] tg
(r ⊨ˢ{n,fs,ft} (#[s], css) (et, cst) : Φ)
r ⊨ˢ{n,fs,ft}
(Copy (Place l (Tagged tg) ty), css) (et, cst)
......@@ -274,7 +273,7 @@ Qed.
Lemma sim_simple_copy_local_r fs ft r r' n l tg ty s es css cst Φ :
tsize ty = 1%nat
r r' res_mapsto l 1 s tg
r r' res_mapsto l [s] tg
(r ⊨ˢ{n,fs,ft} (es, css) (#[s], cst) : Φ)
r ⊨ˢ{S n,fs,ft}
(es, css) (Copy (Place l (Tagged tg) ty), cst)
......@@ -286,7 +285,7 @@ Qed.
Lemma sim_simple_copy_local fs ft r r' n l tg ty s css cst Φ :
tsize ty = 1%nat
r r' res_mapsto l 1 s tg
r r' res_mapsto l [s] tg
(r ⊨ˢ{n,fs,ft} (#[s], css) (#[s], cst) : Φ)
r ⊨ˢ{S n,fs,ft}
(Copy (Place l (Tagged tg) ty), css) (Copy (Place l (Tagged tg) ty), cst)
......@@ -298,7 +297,7 @@ Proof.
Qed.
Lemma sim_simple_retag_local fs ft r r' r'' rs n l s' s tg ty css cst Φ :
r r' res_mapsto l 1 s tg
r r' res_mapsto l [s] tg
arel rs s' s
r' r'' rs
( l_inner tg_inner hplt,
......@@ -310,7 +309,7 @@ Lemma sim_simple_retag_local fs ft r r' r'' rs n l s' s tg ty css cst Φ :
end *)
let tk := tkUnique in
is_Some (hplt !! l_inner)
Φ (r'' rs res_mapsto l 1 s_new tg res_tag tg_inner tk hplt) n (ValR [%S]) css (ValR [%S]) cst)
Φ (r'' rs res_mapsto l [s_new] tg res_tag tg_inner tk hplt) n (ValR [%S]) css (ValR [%S]) cst)
r ⊨ˢ{n,fs,ft}
(Retag (Place l (Tagged tg) (Reference (RefPtr Mutable) ty)) Default, css)
......@@ -337,15 +336,18 @@ Proof.
intros [Hrel1 ?]%rrel_with_eq [Hrel2 ?]%rrel_with_eq. simplify_eq.
Admitted.
Lemma sim_simple_copy_shared fs ft r n (rs rt: result) css cst Φ :
rrel r rs rt
( r' (v1 v2: result),
rrel r' v1 v2
( r' (v1 v2: value),
(* this post-condition is weak, we can return related values *)
vrel r' v1 v2
Φ (r r') n v1 css v2 cst)
r ⊨ˢ{n,fs,ft} (Copy rs, css) (Copy rt, cst) : Φ.
Proof.
intros [Hrel ?]%rrel_with_eq. simplify_eq.
Admitted.
intros [Hrel <-]%rrel_with_eq HH σs σt <-<-.
eapply sim_body_copy_public; eauto.
Qed.
Lemma sim_simple_retag_shared fs ft r n (rs rt: result) k css cst Φ :
rrel r rs rt
......
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