Section permMapDefs.
Definition empty_map : access_map :=
(fun z => None, Maps.PTree.empty (Z -> option permission)).
intros. unfold empty_map, Maps.PMap.get.
rewrite Maps.PTree.gempty; reflexivity.
Qed.
Definition permission_at (m : mem) (b : block) (ofs : Z) (k : perm_kind) :=
Maps.PMap.get b (Mem.mem_access m) ofs k.
(** Coherence between permissions. This is used for the relation between data and lock permissions*)
(** Note: p1 should be data permission and p2 lock permission*)
Definition perm_coh (p1 p2 : option permission) :=
match p1 with
| Some Freeable | Some Writable | Some Readable =>
match p2 with
| None => True
| _ => False
end
| Some Nonempty | None =>
match p2 with
| Some Freeable => False
| _ => True
end
end.
destruct res; simpl; auto.
- apply perm_coh_empty_1.
- destruct k; try apply perm_coh_empty_1; simpl.
destruct (perm_of_sh (Share.glb Share.Rsh sh)) eqn: ?; auto.
destruct p0; auto.
eapply perm_of_glb_not_Freeable; eauto.
Qed.
Definition permMapCoherence (pmap1 pmap2 : access_map) :=
forall b ofs, perm_coh (pmap1 !! b ofs) (pmap2 !! b ofs).
intros r H b ofs.
rewrite empty_map_spec.
specialize (H b ofs).
apply perm_coh_empty_2; assumption.
Qed.
(* Some None represents the empty permission. None is used for permissions that conflict/race. *)
Definition perm_union (p1 p2 : option permission) : option (option permission) :=
match p1,p2 with
| None, _ => Some p2
| _, None => Some p1
| Some p1', Some p2' =>
match p1', p2' with
| Freeable, _ => None
| _, Freeable => None
| Nonempty, _ => Some p2
| _, Nonempty => Some p1
| Writable, _ => None
| _, Writable => None
| Readable, Readable => Some (Some Readable)
end
end.
Inductive not_racy : option permission -> Prop :=
| empty : not_racy None.
Inductive racy : option permission -> Prop :=
| freeable : racy (Some Freeable).
Definition perm_max (p1 p2 : option permission) : option permission :=
match p1,p2 with
| Some Freeable, _ => p1
| _, Some Freeable => p2
| Some Writable, _ => p1
| _, Some Writable => p2
| Some Readable, _ => p1
| _, Some Readable => p2
| Some Nonempty, _ => p1
| _, Some Nonempty => p2
| None, None => None
end.
intros a b c H1 H2.
destruct a, b; try solve[inversion H2];
try solve[exists c; reflexivity].
simpl in H2.
destruct H1 as [k H1].
inversion H2; subst.
- exists k; assumption.
- destruct c; inversion H1.
exists (Some p0); reflexivity.
- destruct c; inversion H1.
destruct p; inversion H0.
exists (Some Readable); reflexivity.
- exists (Some Readable); reflexivity.
- destruct c; inversion H1;
try solve[exists (Some Nonempty); reflexivity].
destruct p; inversion H0; try(destruct p0; inversion H3);
try solve[exists (Some Nonempty); reflexivity];
try solve[exists (Some Readable); reflexivity];
try solve[exists (Some Writable); reflexivity].
Qed.
(* Lemma join_sh_permDisjoint: forall rsh1 rsh2 rsh3 (sh1 sh2 sh3: pshare), join rsh1 rsh2 rsh3 -> join sh1 sh2 sh3 -> permDisjoint (perm_of_sh (Share.glb Share.Rsh sh1))) (perm_of_sh (Share.glb Share.Rsh sh1))). *)
(*The new version of the above*)
Ltac if_simpl:=
repeat match goal with
| [ H: ?X = true |- context[if ?X then _ else _] ] => rewrite H; simpl
| [ H: ?X = false |- context[if ?X then _ else _] ] => rewrite H; simpl
| [ H: ?X = left _ |- context[match ?X with left _ => _ | right _ => _ end] ]=>
rewrite H; simpl
| [ H: ?X = right _ |- context[match ?X with left _ => _ | right _ => _ end] ]=>
rewrite H; simpl
| [ H: (@is_left _ _ ?X) = true |-
context [match ?X with left _ => _ | right _ => _ end ]] => destruct X; inversion H
| [ H: (@is_left _ _ ?X) = false |-
context [match ?X with left _ => _ | right _ => _ end ]] => destruct X; inversion H
end.
Ltac permDisj_solve:= eexists; simpl; reflexivity.
Ltac joins_sh_contradiction_onside:=
match goal with
| [ H: joins ?sh1 ?sh2,
W1: writable0_share ?sh1,
W2: writable0_share ?sh2 |- _ ] =>
exfalso; eapply writable0_not_join_writable0; eassumption
| [ H: joins ?sh1 ?sh2,
W1: writable0_share ?sh1,
W2: readable_share ?sh2 |- _ ] =>
exfalso; eapply writable0_not_join_readable; eassumption
| [ H: joins Share.top ?sh2,
H0: ?sh2 <> Share.bot |- _ ] =>
exfalso; eapply H0; eapply only_bot_joins_top; eassumption
end.
Ltac joins_sh_contradiction:=
first[ joins_sh_contradiction_onside |
match goal with
| [ H: joins ?sh1 ?sh2 |- _ ] =>
eapply joins_comm in H
end; joins_sh_contradiction_onside].
Ltac glb_contradictions:=
repeat match goal with
| [ H: writable0_share_dec _ = _ |- _ ] => clear H
end;
match goal with
| [ H:  Share.glb Share.Rsh ?sh = Share.top  |- _ ] =>
exfalso; eapply glb_Rsh_not_top; eassumption
| [ H: writable0_share (Share.glb Share.Rsh ?sh) |- _ ] =>
eapply writable0_right in H
end; join_sh_contradiction.

Lemma joins_permDisjoint_lock: forall r1 r2,
joins r1 r2 ->
permDisjoint (perm_of_res_lock r1) (perm_of_res_lock r2).