Commit f734ecf1 authored by Hai Dang's avatar Hai Dang
Browse files

add cmra for local var

parent 3476c8a5
...@@ -25,22 +25,24 @@ Definition cmapUR := gmapUR call_id callStateR. ...@@ -25,22 +25,24 @@ Definition cmapUR := gmapUR call_id callStateR.
Definition to_cmapUR (cm: cmap) : cmapUR := fmap to_callStateR cm. Definition to_cmapUR (cm: cmap) : cmapUR := fmap to_callStateR cm.
Definition ptrmap := gmap ptr_id (tag_kind * mem). Definition tmap := gmap ptr_id (tag_kind * mem).
Definition heapletR := gmapR loc (agreeR scalarC). Definition heapletR := gmapR loc (agreeR scalarC).
(* ptr_id TagKid x (loc Ag(Scalar)) *) (* ptr_id TagKid x (loc Ag(Scalar)) *)
Definition ptrmapUR := gmapUR ptr_id (prodR tagKindR heapletR). Definition tmapUR := gmapUR ptr_id (prodR tagKindR heapletR).
Definition to_heapletR (h: mem) : heapletR := fmap to_agree h. Definition to_heapletR (h: mem) : heapletR := fmap to_agree h.
Definition to_ptrmapUR (pm: ptrmap) : ptrmapUR := Definition to_tmapUR (pm: tmap) : tmapUR :=
fmap (λ tm, (to_tagKindR tm.1, to_heapletR tm.2)) pm. fmap (λ tm, (to_tagKindR tm.1, to_heapletR tm.2)) pm.
Definition lmap := gmap loc (scalar * stack). Definition lmap := gmap loc (scalar * stack).
Definition lmapUR := gmapR loc (csumR (exclR (leibnizO (scalar * stack))) (agreeR unitO)). Definition lmapUR := gmapUR loc (csumR (exclR (leibnizO (scalar * stack))) (agreeR unitO)).
Definition res := (ptrmap * cmap)%type. Definition res := (tmap * cmap * lmap)%type.
Definition resUR := prodUR ptrmapUR cmapUR. Definition resUR := prodUR (prodUR tmapUR cmapUR) lmapUR.
Definition to_resUR (r: res) : resUR := (to_ptrmapUR r.1, to_cmapUR r.2).
Definition rtm (r: resUR) : tmapUR := r.1.1.
Definition rcm (r: resUR) : cmapUR := r.1.2.
Definition rlm (r: resUR) : lmapUR := r.2.
Lemma local_update_discrete_valid_frame `{CmraDiscrete A} (r_f r r' : A) : Lemma local_update_discrete_valid_frame `{CmraDiscrete A} (r_f r r' : A) :
(r_f r) (r_f r, r) ~l~> (r_f r', r') (r_f r'). (r_f r) (r_f r, r) ~l~> (r_f r', r') (r_f r').
...@@ -167,8 +169,8 @@ Proof. ...@@ -167,8 +169,8 @@ Proof.
- inversion Eq. - inversion Eq.
Qed. Qed.
(** ptrmap properties *) (** tmap properties *)
Lemma ptrmap_insert_op_r (pm1 pm2: ptrmapUR) t h0 kh (VALID: (pm1 pm2)): Lemma tmap_insert_op_r (pm1 pm2: tmapUR) t h0 kh (VALID: (pm1 pm2)):
pm2 !! t = Some (to_tagKindR tkUnique, h0) pm2 !! t = Some (to_tagKindR tkUnique, h0)
pm1 <[t:=kh]> pm2 = <[t:=kh]> (pm1 pm2). pm1 <[t:=kh]> pm2 = <[t:=kh]> (pm1 pm2).
Proof. Proof.
...@@ -182,7 +184,7 @@ Proof. ...@@ -182,7 +184,7 @@ Proof.
+ do 2 (rewrite lookup_insert_ne //). by rewrite lookup_op. + do 2 (rewrite lookup_insert_ne //). by rewrite lookup_op.
Qed. Qed.
Lemma ptrmap_lookup_op_r (pm1 pm2: ptrmapUR) t h0 (VALID: (pm1 pm2)): Lemma tmap_lookup_op_r (pm1 pm2: tmapUR) t h0 (VALID: (pm1 pm2)):
pm2 !! t = Some (to_tagKindR tkUnique, h0) pm2 !! t = Some (to_tagKindR tkUnique, h0)
(pm1 pm2) !! t = Some (to_tagKindR tkUnique, h0). (pm1 pm2) !! t = Some (to_tagKindR tkUnique, h0).
Proof. Proof.
...@@ -191,7 +193,7 @@ Proof. ...@@ -191,7 +193,7 @@ Proof.
rewrite -Some_op pair_op. intros [?%exclusive_r]; [done|apply _]. rewrite -Some_op pair_op. intros [?%exclusive_r]; [done|apply _].
Qed. Qed.
Lemma ptrmap_lookup_op_l_unique_equiv (pm1 pm2: ptrmapUR) t h0 Lemma tmap_lookup_op_l_unique_equiv (pm1 pm2: tmapUR) t h0
(VALID: (pm1 pm2)): (VALID: (pm1 pm2)):
pm1 !! t Some (to_tagKindR tkUnique, h0) pm1 !! t Some (to_tagKindR tkUnique, h0)
(pm1 pm2) !! t Some (to_tagKindR tkUnique, h0). (pm1 pm2) !! t Some (to_tagKindR tkUnique, h0).
...@@ -201,16 +203,16 @@ Proof. ...@@ -201,16 +203,16 @@ Proof.
rewrite -Some_op pair_op. intros [?%exclusive_l]; [done|apply _]. rewrite -Some_op pair_op. intros [?%exclusive_l]; [done|apply _].
Qed. Qed.
Lemma ptrmap_lookup_op_unique_included (pm1 pm2: ptrmapUR) t h0 Lemma tmap_lookup_op_unique_included (pm1 pm2: tmapUR) t h0
(VALID: pm2) (INCL: pm1 pm2): (VALID: pm2) (INCL: pm1 pm2):
pm1 !! t Some (to_tagKindR tkUnique, h0) pm1 !! t Some (to_tagKindR tkUnique, h0)
pm2 !! t Some (to_tagKindR tkUnique, h0). pm2 !! t Some (to_tagKindR tkUnique, h0).
Proof. Proof.
destruct INCL as [cm' Eq]. rewrite Eq. apply ptrmap_lookup_op_l_unique_equiv. destruct INCL as [cm' Eq]. rewrite Eq. apply tmap_lookup_op_l_unique_equiv.
by rewrite -Eq. by rewrite -Eq.
Qed. Qed.
Lemma ptrmap_lookup_op_r_equiv_pub (pm1 pm2: ptrmapUR) t h2 (VALID: (pm1 pm2)): Lemma tmap_lookup_op_r_equiv_pub (pm1 pm2: tmapUR) t h2 (VALID: (pm1 pm2)):
pm2 !! t Some (to_tagKindR tkPub, h2) pm2 !! t Some (to_tagKindR tkPub, h2)
h1, (pm1 pm2) !! t Some (to_tagKindR tkPub, h1 h2). h1, (pm1 pm2) !! t Some (to_tagKindR tkPub, h1 h2).
Proof. Proof.
...@@ -222,17 +224,17 @@ Proof. ...@@ -222,17 +224,17 @@ Proof.
- intros _. exists (: gmap loc _). by rewrite 2!left_id HL. - intros _. exists (: gmap loc _). by rewrite 2!left_id HL.
Qed. Qed.
Lemma ptrmap_valid (r_f r: ptrmapUR) t h0 kh Lemma tmap_valid (r_f r: tmapUR) t h0 kh
(Eqtg: r !! t = Some (to_tagKindR tkUnique, h0)) (VN: kh) : (Eqtg: r !! t = Some (to_tagKindR tkUnique, h0)) (VN: kh) :
(r_f r) (r_f (<[t:= kh]> r)). (r_f r) (r_f (<[t:= kh]> r)).
Proof. Proof.
intros VALID. intros VALID.
apply (local_update_discrete_valid_frame _ _ _ VALID). apply (local_update_discrete_valid_frame _ _ _ VALID).
have EQ := (ptrmap_insert_op_r _ _ _ _ kh VALID Eqtg). rewrite EQ. have EQ := (tmap_insert_op_r _ _ _ _ kh VALID Eqtg). rewrite EQ.
eapply (insert_local_update _ _ _ eapply (insert_local_update _ _ _
(to_tagKindR tkUnique, h0) (to_tagKindR tkUnique, h0)); (to_tagKindR tkUnique, h0) (to_tagKindR tkUnique, h0));
[|exact Eqtg|by apply exclusive_local_update]. [|exact Eqtg|by apply exclusive_local_update].
by rewrite (ptrmap_lookup_op_r _ _ _ _ VALID Eqtg). by rewrite (tmap_lookup_op_r _ _ _ _ VALID Eqtg).
Qed. Qed.
(** heaplet *) (** heaplet *)
...@@ -266,7 +268,7 @@ Proof. ...@@ -266,7 +268,7 @@ Proof.
by destruct (h !! l) as [s|] eqn:Eql; rewrite Eql. by destruct (h !! l) as [s|] eqn:Eql; rewrite Eql.
Qed. Qed.
Lemma ptrmap_lookup_core_pub (pm: ptrmapUR) t h: Lemma tmap_lookup_core_pub (pm: tmapUR) t h:
pm !! t Some (to_tagKindR tkPub, h) pm !! t Some (to_tagKindR tkPub, h)
core pm !! t Some (to_tagKindR tkPub, h). core pm !! t Some (to_tagKindR tkPub, h).
Proof. intros Eq. rewrite lookup_core Eq /core /= core_id //. Qed. Proof. intros Eq. rewrite lookup_core Eq /core /= core_id //. Qed.
...@@ -92,7 +92,7 @@ Proof. ...@@ -92,7 +92,7 @@ Proof.
econs 3; eauto. econs 3; eauto.
Qed. Qed.
Lemma adequacy Lemma adequacy_classical
prog_src prog_src
prog_tgt idx conf_src conf_tgt prog_tgt idx conf_src conf_tgt
`{NSD: e σ, never_stuck prog_src e σ \/ `{NSD: e σ, never_stuck prog_src e σ \/
......
...@@ -16,13 +16,13 @@ Definition arel (r: resUR) (s1 s2: scalar) : Prop := ...@@ -16,13 +16,13 @@ Definition arel (r: resUR) (s1 s2: scalar) : Prop :=
l1 = l2 tg1 = tg2 l1 = l2 tg1 = tg2
match tg1 with match tg1 with
| Untagged => True | Untagged => True
| Tagged t => h, r.1 !! t Some (to_tagKindR tkPub, h) | Tagged t => h, r.(rtm) !! t Some (to_tagKindR tkPub, h)
end end
| _, _ => False | _, _ => False
end. end.
Definition ptrmap_inv (r: resUR) (σ: state) : Prop := Definition tmap_inv (r: resUR) (σ: state) : Prop :=
(t: ptr_id) (k: tag_kind) h, r.1 !! t Some (to_tagKindR k, h) (t: ptr_id) (k: tag_kind) h, r.(rtm) !! t Some (to_tagKindR k, h)
(t < σ.(snp))%nat (t < σ.(snp))%nat
( (l: loc) (s: scalar), h !! l Some (to_agree s) ( (l: loc) (s: scalar), h !! l Some (to_agree s)
(stk: stack), σ.(sst) !! l = Some stk (stk: stack), σ.(sst) !! l = Some stk
...@@ -38,7 +38,7 @@ Definition ptrmap_inv (r: resUR) (σ: state) : Prop := ...@@ -38,7 +38,7 @@ Definition ptrmap_inv (r: resUR) (σ: state) : Prop :=
end). end).
Definition cmap_inv (r: resUR) (σ: state) : Prop := Definition cmap_inv (r: resUR) (σ: state) : Prop :=
(c: call_id) (cs: callStateR), r.2 !! c Some cs (c: call_id) (cs: callStateR), r.(rcm) !! c Some cs
match cs with match cs with
(* if c is a private call id *) (* if c is a private call id *)
| Cinl (Excl T) => | Cinl (Excl T) =>
...@@ -47,7 +47,7 @@ Definition cmap_inv (r: resUR) (σ: state) : Prop := ...@@ -47,7 +47,7 @@ Definition cmap_inv (r: resUR) (σ: state) : Prop :=
(t: ptr_id), t T (t: ptr_id), t T
t < σ.(snp) t < σ.(snp)
(* that protects the heaplet [h] *) (* that protects the heaplet [h] *)
k h, r.1 !! t Some (k, h) k h, r.(rtm) !! t Some (k, h)
(* if [l] is in that heaplet [h] *) (* if [l] is in that heaplet [h] *)
(l: loc), l dom (gset loc) h (l: loc), l dom (gset loc) h
(* then a c-protector must be in the stack of l *) (* then a c-protector must be in the stack of l *)
...@@ -62,8 +62,8 @@ Definition cmap_inv (r: resUR) (σ: state) : Prop := ...@@ -62,8 +62,8 @@ Definition cmap_inv (r: resUR) (σ: state) : Prop :=
by some call id [c] and [l] is in [t]'s heaplet [h]. *) by some call id [c] and [l] is in [t]'s heaplet [h]. *)
Definition priv_loc (r: resUR) (l: loc) (t: ptr_id) := Definition priv_loc (r: resUR) (l: loc) (t: ptr_id) :=
(c: call_id) (T: gset ptr_id) h, (c: call_id) (T: gset ptr_id) h,
r.2 !! c Some (Cinl (Excl T)) t T r.(rcm) !! c Some (Cinl (Excl T)) t T
r.1 !! t Some (to_tagKindR tkUnique, h) l dom (gset loc) h. r.(rtm) !! t Some (to_tagKindR tkUnique, h) l dom (gset loc) h.
(** State relation *) (** State relation *)
Definition srel (r: resUR) (σs σt: state) : Prop := Definition srel (r: resUR) (σs σt: state) : Prop :=
...@@ -77,7 +77,7 @@ Definition wsat (r: resUR) (σs σt: state) : Prop := ...@@ -77,7 +77,7 @@ Definition wsat (r: resUR) (σs σt: state) : Prop :=
(* Wellformedness *) (* Wellformedness *)
Wf σs Wf σt r Wf σs Wf σt r
(* Invariants *) (* Invariants *)
ptrmap_inv r σt cmap_inv r σt srel r σs σt. tmap_inv r σt cmap_inv r σt srel r σs σt.
(** Value relation for function arguments/return values *) (** Value relation for function arguments/return values *)
(* Values passed among functions are public *) (* Values passed among functions are public *)
...@@ -89,20 +89,20 @@ Definition vrel_expr (r: resUR) (e1 e2: expr) := ...@@ -89,20 +89,20 @@ Definition vrel_expr (r: resUR) (e1 e2: expr) :=
(** Condition for resource before EndCall *) (** Condition for resource before EndCall *)
(* Any private location w.r.t to the current call id ownership must be related *) (* Any private location w.r.t to the current call id ownership must be related *)
Definition end_call_sat (r: resUR) (σs σt: state) : Prop := Definition end_call_sat (r: resUR) (σs σt: state) : Prop :=
c, hd_error σt.(scs) = Some c is_Some (r.2 !! c) c, hd_error σt.(scs) = Some c is_Some (r.(rcm) !! c)
( r_f, (r_f r) ( r_f, (r_f r)
T, (r_f r).2 !! c Some (Cinl (Excl T)) (t: ptr_id), t T T, (r_f r).(rcm) !! c Some (Cinl (Excl T)) (t: ptr_id), t T
h, (r_f r).1 !! t Some (to_tagKindR tkUnique, h) h, (r_f r).(rtm) !! t Some (to_tagKindR tkUnique, h)
l st, l dom (gset loc) h σt.(shp) !! l = Some st l st, l dom (gset loc) h σt.(shp) !! l = Some st
ss, σs.(shp) !! l = Some ss arel (r_f r) ss st). ss, σs.(shp) !! l = Some ss arel (r_f r) ss st).
Definition init_res : resUR := (ε, {[O := to_callStateR csPub]}). Definition init_res : resUR := ((ε, {[O := to_callStateR csPub]}), ε).
Lemma wsat_init_state : wsat init_res init_state init_state. Lemma wsat_init_state : wsat init_res init_state init_state.
Proof. Proof.
split; last split; last split; last split; last split. split; last split; last split; last split; last split.
- apply wf_init_state. - apply wf_init_state.
- apply wf_init_state. - apply wf_init_state.
- split; [done|]. intros ?; simpl. destruct i. - split; [|done]. split; [done|]. intros ?; simpl. destruct i.
+ rewrite lookup_singleton //. + rewrite lookup_singleton //.
+ rewrite lookup_singleton_ne //. + rewrite lookup_singleton_ne //.
- intros ??? HL. exfalso. move : HL. rewrite /= lookup_empty. inversion 1. - intros ??? HL. exfalso. move : HL. rewrite /= lookup_empty. inversion 1.
...@@ -158,8 +158,9 @@ Proof. ...@@ -158,8 +158,9 @@ Proof.
intros [Eql [Eqt PV]]. subst. repeat split. intros [Eql [Eqt PV]]. subst. repeat split.
destruct t2 as [t2|]; [|done]. destruct t2 as [t2|]; [|done].
destruct PV as [h HL]. destruct PV as [h HL].
have HL1: Some (to_tagKindR tkPub, h) r2.1 !! t2. have HL1: Some (to_tagKindR tkPub, h) r2.(rtm) !! t2.
{ rewrite -HL. by apply lookup_included, prod_included, Le. } { rewrite -HL. apply lookup_included, prod_included.
by apply prod_included in Le as []. }
apply option_included in HL1 as [?|[th1 [[tk2 h2] [? [Eq1 INCL]]]]]; [done|]. apply option_included in HL1 as [?|[th1 [[tk2 h2] [? [Eq1 INCL]]]]]; [done|].
simplify_eq. exists h2. rewrite Eq1 (_: tk2 to_tagKindR tkPub) //. simplify_eq. exists h2. rewrite Eq1 (_: tk2 to_tagKindR tkPub) //.
apply tag_kind_incl_eq; [done|]. apply tag_kind_incl_eq; [done|].
...@@ -167,7 +168,7 @@ Proof. ...@@ -167,7 +168,7 @@ Proof.
- apply csum_included. naive_solver. - apply csum_included. naive_solver.
- have VL2: tk2. - have VL2: tk2.
{ apply (pair_valid tk2 h2). rewrite -pair_valid. { apply (pair_valid tk2 h2). rewrite -pair_valid.
apply (lookup_valid_Some r2.1 t2); [apply VAL|]. by rewrite Eq1. } apply (lookup_valid_Some r2.(rtm) t2); [apply VAL|]. by rewrite Eq1. }
destruct Eq as [|[|Eq]]; [by subst|naive_solver|]. destruct Eq as [|[|Eq]]; [by subst|naive_solver|].
destruct Eq as [?[ag[? [? ?]]]]. simplify_eq. destruct Eq as [?[ag[? [? ?]]]]. simplify_eq.
apply to_agree_uninj in VL2 as [[] Eq]. rewrite -Eq. apply to_agree_uninj in VL2 as [[] Eq]. rewrite -Eq.
...@@ -188,29 +189,33 @@ Lemma priv_loc_mono (r1 r2 : resUR) (VAL: ✓ r2) : ...@@ -188,29 +189,33 @@ Lemma priv_loc_mono (r1 r2 : resUR) (VAL: ✓ r2) :
r1 r2 l t, priv_loc r1 l t priv_loc r2 l t. r1 r2 l t, priv_loc r1 l t priv_loc r2 l t.
Proof. Proof.
intros LE l t (c & T & h & Eq2 & InT & Eq1 & InD). intros LE l t (c & T & h & Eq2 & InT & Eq1 & InD).
apply prod_included in LE as []. apply pair_valid in VAL as []. do 2 (apply prod_included in LE as [LE ]).
do 2 (apply pair_valid in VAL as [VAL ]).
exists c, T, h. repeat split; [|done| |done]. exists c, T, h. repeat split; [|done| |done].
- by apply (cmap_lookup_op_unique_included r1.2). - by apply (cmap_lookup_op_unique_included r1.(rcm)).
- by apply (ptrmap_lookup_op_unique_included r1.1). - by apply (tmap_lookup_op_unique_included r1.(rtm)).
Qed. Qed.
Instance ptrmap_inv_proper : Proper (() ==> (=) ==> iff) ptrmap_inv. Instance tmap_inv_proper : Proper (() ==> (=) ==> iff) tmap_inv.
Proof. Proof.
intros r1 r2 Eqr ? σ ?. subst. rewrite /ptrmap_inv. by setoid_rewrite Eqr. intros r1 r2 [[Eqt Eqc] Eqm] ? σ ?. subst. rewrite /tmap_inv /rtm.
by setoid_rewrite Eqt.
Qed. Qed.
Instance cmap_inv_proper : Proper (() ==> (=) ==> iff) cmap_inv. Instance cmap_inv_proper : Proper (() ==> (=) ==> iff) cmap_inv.
Proof. Proof.
intros r1 r2 Eqr ? σ ?. subst. rewrite /cmap_inv. setoid_rewrite Eqr. intros r1 r2 [[Eqt Eqc] Eqm] ? σ ?. subst. rewrite /cmap_inv /rcm /rtm.
split; intros EQ ?? Eq; specialize (EQ _ _ Eq); destruct cs as [[]| |]; eauto; setoid_rewrite Eqc.
[by setoid_rewrite <- Eqr|by setoid_rewrite Eqr]. split; intros EQ ?? Eq; specialize (EQ _ _ Eq);
destruct cs as [[]| |]; eauto;
[by setoid_rewrite <- Eqt|by setoid_rewrite Eqt].
Qed. Qed.
Instance arel_proper : Proper (() ==> (=) ==> (=) ==> iff) arel. Instance arel_proper : Proper (() ==> (=) ==> (=) ==> iff) arel.
Proof. solve_proper. Qed. Proof. rewrite /arel /rtm. solve_proper. Qed.
Instance priv_loc_proper : Proper (() ==> (=) ==> (=) ==> iff) priv_loc. Instance priv_loc_proper : Proper (() ==> (=) ==> (=) ==> iff) priv_loc.
Proof. solve_proper. Qed. Proof. rewrite /priv_loc /rcm /rtm. solve_proper. Qed.
Instance srel_proper : Proper (() ==> (=) ==> (=) ==> iff) srel. Instance srel_proper : Proper (() ==> (=) ==> (=) ==> iff) srel.
Proof. Proof.
...@@ -227,7 +232,7 @@ Instance wsat_proper : Proper ((≡) ==> (=) ==> (=) ==> iff) wsat. ...@@ -227,7 +232,7 @@ Instance wsat_proper : Proper ((≡) ==> (=) ==> (=) ==> iff) wsat.
Proof. solve_proper. Qed. Proof. solve_proper. Qed.
Lemma cinv_lookup_in (r: resUR) (σ: state) c cs: Lemma cinv_lookup_in (r: resUR) (σ: state) c cs:
Wf σ cmap_inv r σ r.2 !! c Some cs (c < σ.(snc))%nat. Wf σ cmap_inv r σ r.(rcm) !! c Some cs (c < σ.(snc))%nat.
Proof. Proof.
intros WF CINV EQ. specialize (CINV c cs EQ). intros WF CINV EQ. specialize (CINV c cs EQ).
destruct cs as [[]| |]; [|done..]. destruct cs as [[]| |]; [|done..].
...@@ -235,7 +240,7 @@ Proof. ...@@ -235,7 +240,7 @@ Proof.
Qed. Qed.
Lemma cinv_lookup_in_eq (r: resUR) (σ: state) c cs: Lemma cinv_lookup_in_eq (r: resUR) (σ: state) c cs:
Wf σ cmap_inv r σ r.2 !! c = Some cs (c < σ.(snc))%nat. Wf σ cmap_inv r σ r.(rcm) !! c = Some cs (c < σ.(snc))%nat.
Proof. Proof.
intros WF CINV EQ. eapply cinv_lookup_in; eauto. by rewrite EQ. intros WF CINV EQ. eapply cinv_lookup_in; eauto. by rewrite EQ.
Qed. Qed.
......
...@@ -7,7 +7,7 @@ Set Default Proof Using "Type". ...@@ -7,7 +7,7 @@ Set Default Proof Using "Type".
Lemma sim_body_copy_left_1 Lemma sim_body_copy_left_1
fs ft (r: resUR) k (h: heapletR) n l t et σs σt Φ fs ft (r: resUR) k (h: heapletR) n l t et σs σt Φ
(UNIQUE: r.1 !! t Some (k, h)) (UNIQUE: r.(rtm) !! t Some (k, h))
(InD: l dom (gset loc) h) : (InD: l dom (gset loc) h) :
( s, σs.(shp) !! l = Some s r {n,fs,ft} (#[s%S], σs) (et, σt) : Φ : Prop) ( s, σs.(shp) !! l = Some s r {n,fs,ft} (#[s%S], σs) (et, σt) : Φ : Prop)
r {n,fs,ft} (Copy (Place l (Tagged t) int), σs) (et, σt) : Φ. r {n,fs,ft} (Copy (Place l (Tagged t) int), σs) (et, σt) : Φ.
......
...@@ -3,7 +3,7 @@ From Paco Require Import paco. ...@@ -3,7 +3,7 @@ From Paco Require Import paco.
From stbor.lang Require Import steps_wf steps_inversion. From stbor.lang Require Import steps_wf steps_inversion.
From stbor.sim Require Import sflib behavior global local. From stbor.sim Require Import sflib behavior global local.
From stbor.sim Require Import invariant global_adequacy refl_step. From stbor.sim Require Import invariant refl_step.
Set Default Proof Using "Type". Set Default Proof Using "Type".
...@@ -141,10 +141,11 @@ Proof. ...@@ -141,10 +141,11 @@ Proof.
σt.(scs) = c2 :: cids2 σt.(scs) = c2 :: cids2
σs2 = mkState σs.(shp) σs.(sst) cids1 σs.(snp) σs.(snc) σs2 = mkState σs.(shp) σs.(sst) cids1 σs.(snp) σs.(snc)
σt2 = mkState σt.(shp) σt.(sst) cids2 σt.(snp) σt.(snc) σt2 = mkState σt.(shp) σt.(sst) cids2 σt.(snp) σt.(snc)
r2 = (r'.1, match (r'.2 !! c2) with r2 = ((r'.(rtm),
| Some (Cinl (Excl T)) => <[c2 := to_callStateR csPub]> r'.2 match (r'.(rcm) !! c2) with
| _ => r'.2 | Some (Cinl (Excl T)) => <[c2 := to_callStateR csPub]> r'.(rcm)
end). | _ => r'.(rcm)
end), r'.(rlm)).
have SIMEND : r' {idx',fns,fnt} (EndCall vs1, σs) (EndCall vt1, σt) : Φ. have SIMEND : r' {idx',fns,fnt} (EndCall vs1, σs) (EndCall vt1, σt) : Φ.
{ apply sim_body_end_call; auto. { apply sim_body_end_call; auto.
clear. intros. rewrite /Φ. naive_solver. } clear. intros. rewrite /Φ. naive_solver. }
......
...@@ -4,7 +4,7 @@ From stbor.sim Require Import global_adequacy local_adequacy refl_step. ...@@ -4,7 +4,7 @@ From stbor.sim Require Import global_adequacy local_adequacy refl_step.
Set Default Proof Using "Type". Set Default Proof Using "Type".
Lemma sim_prog_sim Lemma sim_prog_sim_classical
prog_src prog_src
prog_tgt prog_tgt
`{NSD: e σ, never_stuck prog_src e σ \/ `{NSD: e σ, never_stuck prog_src e σ \/
...@@ -19,7 +19,8 @@ Proof. ...@@ -19,7 +19,8 @@ Proof.
destruct (FUNS _ _ Eqt) as ([xls ebs HCs] & Eqs & Eql & SIMf). destruct (FUNS _ _ Eqt) as ([xls ebs HCs] & Eqs & Eql & SIMf).
apply nil_length_inv in Eql. subst xls. apply nil_length_inv in Eql. subst xls.
specialize (SIMf ε ebs ebt [] [] init_state init_state) as [idx SIM]; [done..|]. specialize (SIMf ε ebs ebt [] [] init_state init_state) as [idx SIM]; [done..|].
unfold behave_prog. eapply (adequacy _ _ idx); [apply NSD| |by apply wf_init_state..]. unfold behave_prog.
eapply (adequacy_classical _ _ idx); [apply NSD| |by apply wf_init_state..].
eapply sim_local_conf_sim; eauto. eapply sim_local_conf_sim; eauto.
econs; swap 2 4. econs; swap 2 4.
- econs 1. - econs 1.
...@@ -37,10 +38,10 @@ Proof. ...@@ -37,10 +38,10 @@ Proof.
{ exists O. by rewrite -STACK. } { exists O. by rewrite -STACK. }
rewrite /end_call_sat -STACK. rewrite /end_call_sat -STACK.
intros c Eq. simpl in Eq. simplify_eq. intros c Eq. simpl in Eq. simplify_eq.
have HL: (init_res r').2 !! 0%nat Some (to_callStateR csPub). have HL: (init_res r').(rcm) !! 0%nat Some (to_callStateR csPub).
{ apply cmap_lookup_op_l_equiv_pub; [apply VALID|]. { apply cmap_lookup_op_l_equiv_pub; [apply VALID|].
by rewrite /= lookup_singleton. } by rewrite /= lookup_singleton. }
split. { destruct ((init_res r').2 !! 0%nat). by eexists. by inversion HL. } split. { destruct ((init_res r').(rcm) !! 0%nat). by eexists. by inversion HL. }
intros r_f VALIDf T HL2. exfalso. intros r_f VALIDf T HL2. exfalso.
move : HL2. rewrite lookup_op HL. apply callStateR_exclusive_2. move : HL2. rewrite lookup_op HL. apply callStateR_exclusive_2.
- instantiate (1:=ε). rewrite right_id left_id. apply wsat_init_state. - instantiate (1:=ε). rewrite right_id left_id. apply wsat_init_state.
......
This diff is collapsed.
...@@ -8,7 +8,7 @@ Set Default Proof Using "Type". ...@@ -8,7 +8,7 @@ Set Default Proof Using "Type".
Lemma sim_body_copy_right_1 Lemma sim_body_copy_right_1
fs ft (r: resUR) k (h: heapletR) n l t s es σs σt Φ fs ft (r: resUR) k (h: heapletR) n l t s es σs σt Φ
(* we know we're going to read s *) (* we know we're going to read s *)
(UNIQUE: r.1 !! t Some (k, h)) (UNIQUE: r.(rtm) !! t Some (k, h))
(InD: h !! l Some (to_agree s)) (InD: h !! l Some (to_agree s))
(IN: tag_in_stack σt l t) : (IN: tag_in_stack σt l t) :
(σt.(shp) !! l = Some s r {n,fs,ft} (es, σs) (#[s%S], σt) : Φ : Prop) (σt.(shp) !! l = Some s r {n,fs,ft} (es, σs) (#[s%S], σt) : Φ : Prop)
......
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