Commit 5714f22b by 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.