Commit afc821a4 authored by Ralf Jung's avatar Ralf Jung

Merge branch 'master' of git.fp.mpi-sws.org:nowbook

parents c860c56b 1ffae0a8
This diff is collapsed.
......@@ -119,9 +119,9 @@ Module IrisVS (RL : PCM_T) (C : CORE_LANG).
symmetry; destruct (w' i); [assumption | contradiction].
+ exists (fdRemove i rs); split; [assumption | intros j Hm].
destruct Hm as [| Hm]; [contradiction |]; specialize (HD j); simpl in HD.
unfold mask_sing, mask_set in HD; destruct (Peano_dec.eq_nat_dec i j);
unfold mask_sing, mask_set, mcup in HD; destruct (Peano_dec.eq_nat_dec i j);
[subst j; contradiction HD; tauto | clear HD].
rewrite fdLookup_in; setoid_rewrite (fdRemove_neq _ _ _ n0); rewrite <- fdLookup_in; now auto.
rewrite fdLookup_in; setoid_rewrite (fdRemove_neq _ _ _ n0); rewrite <- fdLookup_in; unfold mcup in HM; now auto.
- rewrite <- fdLookup_notin_strong in HLr; contradiction HLr; clear HLr.
specialize (HSub i); rewrite HLu in HSub; clear - HM HSub.
destruct (HM i) as [HD _]; [left | rewrite HD, fdLookup_in_strong; destruct (w' i); [eexists; reflexivity | contradiction] ].
......@@ -149,7 +149,7 @@ Module IrisVS (RL : PCM_T) (C : CORE_LANG).
* erewrite <-comp_map_insert_old; try eassumption. rewrite<- EQR; reflexivity.
* erewrite <-comp_map_insert_new; try eassumption. rewrite <-EQR.
erewrite pcm_op_unit by apply _. assumption.
+ specialize (HD j); unfold mask_sing, mask_set in *; simpl in Hm, HD.
+ specialize (HD j); unfold mask_sing, mask_set, mcup in *; simpl in Hm, HD.
destruct (Peano_dec.eq_nat_dec i j);
[subst j; clear Hm |
destruct Hm as [Hm | Hm]; [contradiction | rewrite fdLookup_in_strong, fdUpdate_neq, <- fdLookup_in_strong by assumption; now auto] ].
......@@ -215,16 +215,16 @@ Module IrisVS (RL : PCM_T) (C : CORE_LANG).
destruct HVS as [w'' [rq [HSub' [Hq HEq] ] ] ]; try assumption; [| |].
- (* disjointness of masks: possible lemma *)
clear - HD HDisj; intros i [ [Hmf | Hmf] Hm12]; [eapply HDisj; now eauto |].
eapply HD; split; [eassumption | tauto].
unfold mcup in *; eapply HD; split; [eassumption | tauto].
- rewrite assoc, HR; eapply wsat_equiv, HE; try reflexivity; [].
clear; intros i; tauto.
clear; intros i; unfold mcup; tauto.
- rewrite assoc in HEq; destruct (Some rq · Some rr) as [rqr |] eqn: HR';
[| apply wsat_not_empty in HEq; [contradiction | now erewrite !pcm_op_zero by apply _] ].
exists w'' rqr; split; [assumption | split].
+ unfold lt in HLe0; rewrite HSub, HSub', <- HLe0 in Hr; exists rq rr.
rewrite HR'; split; now auto.
+ eapply wsat_equiv, HEq; try reflexivity; [].
clear; intros i; tauto.
clear; intros i; unfold mcup; tauto.
Qed.
Instance LP_optres (P : option RL.res -> Prop) : LimitPreserving P.
......@@ -348,7 +348,7 @@ Module IrisVS (RL : PCM_T) (C : CORE_LANG).
destruct HE as [rs [HE HM] ].
exists (fdUpdate i r rs).
assert (HRi : rs i = None).
{ destruct (HM i) as [HDom _]; [tauto |].
{ destruct (HM i) as [HDom _]; unfold mcup; [tauto |].
rewrite <- fdLookup_notin_strong, HDom, fdLookup_notin_strong; assumption.
}
split.
......
......@@ -628,24 +628,24 @@ Module IrisWP (RL : PCM_T) (C : CORE_LANG).
rewrite unfold_wp; rewrite ->unfold_wp in HW; intros w'; intros.
edestruct HW with (mf := mf m2) as [HV [HS [HF HS'] ] ]; try eassumption;
[| eapply wsat_equiv, HE; try reflexivity; [] |].
{ intros j [ [Hmf | Hm'] Hm]; [apply (HD0 j) | apply (HD j) ]; tauto.
{ intros j [ [Hmf | Hm'] Hm]; [unfold mcup in HD0; apply (HD0 j) | apply (HD j) ]; tauto.
}
{ clear; intros j; tauto.
{ clear; intros j; unfold mcup; tauto.
}
clear HW HE; split; [intros HVal; clear HS HF HInd | split; [intros; clear HV HF | split; [intros; clear HV HS | intros; clear HV HS HF] ] ].
- specialize (HV HVal); destruct HV as [w'' [r' [HSW [Hφ HE] ] ] ].
do 2 eexists; split; [eassumption | split; [eassumption |] ].
eapply wsat_equiv, HE; try reflexivity; [].
intros j; tauto.
intros j; unfold mcup; tauto.
- edestruct HS as [w'' [r' [HSW [HW HE] ] ] ]; try eassumption; []; clear HS.
do 2 eexists; split; [eassumption | split; [eapply HInd, HW; assumption |] ].
eapply wsat_equiv, HE; try reflexivity; [].
intros j; tauto.
intros j; unfold mcup; tauto.
- destruct (HF _ _ HDec) as [w'' [rfk [rret [HSW [HWR [HWF HE] ] ] ] ] ]; clear HF.
do 3 eexists; split; [eassumption |].
do 2 (split; [apply HInd; eassumption |]).
eapply wsat_equiv, HE; try reflexivity; [].
intros j; tauto.
intros j; unfold mcup; tauto.
- auto.
Qed.
......
......@@ -21,12 +21,19 @@ Definition mle (m1 m2 : mask) :=
forall n, m1 n -> m2 n.
Definition meq (m1 m2 : mask) :=
forall n, m1 n <-> m2 n.
Definition mcap (m1 m2 : mask) : mask :=
fun i => (m1 : mask) i /\ (m2 : mask) i.
Definition mcup (m1 m2 : mask) : mask :=
fun i => (m1 : mask) i \/ (m2 : mask) i.
Definition mminus (m1 m2 : mask) : mask :=
fun i => (m1 : mask) i /\ ~ (m2 : mask) i.
Delimit Scope mask_scope with mask.
Notation "m1 == m2" := (meq m1 m2) (at level 70) : mask_scope.
Notation "m1 ⊆ m2" := (mle m1 m2) (at level 70) : mask_scope.
Notation "m1 ∩ m2" := (fun i => (m1 : mask) i /\ (m2 : mask) i) (at level 40) : mask_scope.
Notation "m1 \ m2" := (fun i => (m1 : mask) i /\ ~ (m2 : mask) i) (at level 30) : mask_scope.
Notation "m1 ∪ m2" := (fun i => (m1 : mask) i \/ (m2 : mask) i) (at level 50) : mask_scope.
Notation "m1 ∩ m2" := (mcap m1 m2) (at level 40) : mask_scope.
Notation "m1 \ m2" := (mminus m1 m2) (at level 30) : mask_scope.
Notation "m1 ∪ m2" := (mcup m1 m2) (at level 50) : mask_scope.
Notation "m1 # m2" := (mask_disj m1 m2) (at level 70) : mask_scope.
Open Scope mask_scope.
......@@ -81,7 +88,13 @@ Qed.
Lemma mask_emp_union m :
meq (m mask_emp) m.
Proof.
intros k; unfold mask_emp, const; tauto.
intros k; unfold mcup, mask_emp, const. tauto.
Qed.
Lemma mask_full_union m :
meq (mask_full m) mask_full.
Proof.
intros i; unfold mcup, mask_full, const; tauto.
Qed.
Lemma mask_emp_disjoint m :
......@@ -93,7 +106,7 @@ Qed.
Lemma mask_union_idem m :
meq (m m) m.
Proof.
intros k; tauto.
intros k; unfold mcup; tauto.
Qed.
Global Instance mask_disj_sub : Proper (mle --> mle --> impl) mask_disj.
......
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