(*Require Import VST.concurrency.cl_step_lemmas.*)
Set Bullet Behavior "Strict Subproofs".
(** Lemmas common to both parts of the progress/preservation simulation results *)
Definition pures_same phi1 phi2 := forall loc k pp, phi1 @ loc = PURE k pp <-> phi2 @ loc = PURE k pp.
Definition isVAL (r : resource) :=
match r with
| YES _ _ (VAL _) _ => Logic.True
| _ => False
end.
Definition thread_safety {Z} (Jspec : juicy_ext_spec Z) m ge (tp : jstate ge) PHI (mcompat : mem_compatible_with tp m PHI) n
i (cnti : containsThread tp i) := forall (ora : Z),
match getThreadC cnti with
| Krun c => semax.jsafeN Jspec ge n ora c (jm_ cnti mcompat)
| Kblocked c =>
(* The dry memory will change, so when we prove safety after an external we must only inspect the rmap m_phi part of the juicy memory.  This means more proof for each of the synchronisation primitives. *)
jsafe_phi Jspec ge n ora c (getThreadR cnti)
| Kresume c v =>
forall c',
(* [v] is not used here. The problem is probably coming from the definition of JuicyMachine.resume_thread'. *)
cl_after_external None c = Some c' ->
(* same quantification as in Kblocked *)
jsafe_phi_bupd Jspec ge n ora c' (getThreadR cnti)
| Kinit v1 v2 =>
val_inject (Mem.flat_inj (Mem.nextblock m)) v2 v2 /\
exists q_new,
cl_initial_core ge v1 (v2 :: nil) q_new /\
jsafe_phi Jspec ge n ora q_new (getThreadR cnti)
end.
(* assert (cnti = Htid) by apply proof_irr; subst Htid). assert (ctn = cnti) by apply proof_irr; subst cnt). destruct (cntAdd' _ _ _ cnti) as [(cnti', ne) | Ei]. *)
Ltac join_sub_tac :=
try
match goal with
c : mem_compatible_with ?tp ?m ?Phi |- _ =>
match goal with
| cnt1 : containsThread tp _,
cnt2 : containsThread tp _,
cnt3 : containsThread tp _,
cnt4 : containsThread tp _ |- _ =>
assert (join_sub (getThreadR cnt1) Phi) by (apply compatible_threadRes_sub, c);
assert (join_sub (getThreadR cnt2) Phi) by (apply compatible_threadRes_sub, c);
assert (join_sub (getThreadR cnt3) Phi) by (apply compatible_threadRes_sub, c);
assert (join_sub (getThreadR cnt4) Phi) by (apply compatible_threadRes_sub, c)
| cnt1 : containsThread tp _,
cnt2 : containsThread tp _,
cnt3 : containsThread tp _ |- _ =>
assert (join_sub (getThreadR cnt1) Phi) by (apply compatible_threadRes_sub, c);
assert (join_sub (getThreadR cnt2) Phi) by (apply compatible_threadRes_sub, c);
assert (join_sub (getThreadR cnt3) Phi) by (apply compatible_threadRes_sub, c)
| cnt1 : containsThread tp _,
cnt2 : containsThread tp _ |- _ =>
assert (join_sub (getThreadR cnt1) Phi) by (apply compatible_threadRes_sub, c);
assert (join_sub (getThreadR cnt2) Phi) by (apply compatible_threadRes_sub, c)
| cnt1 : containsThread tp _ |- _ =>
assert (join_sub (getThreadR cnt1) Phi) by (apply compatible_threadRes_sub, c)
end
end;
try
match goal with
| F : AMap.find (elt:=option rmap) ?loc (lset ?tp) = Some (Some ?phi),
c : mem_compatible_with ?tp _ ?Phi |- _
=> assert (join_sub phi Phi) by eapply (@compatible_lockRes_sub tp loc phi F), c
end;
eauto using join_sub_trans.
Tactic Notation "REWR" :=
first
[ unshelve erewrite <-gtc_age |
unshelve erewrite gLockSetCode |
unshelve erewrite gRemLockSetCode |
rewrite gssThreadCode |
rewrite gssThreadCC |
unshelve erewrite gsoThreadCode |
unshelve erewrite <-gsoThreadCC |
unshelve erewrite gsoAddCode |
rewrite gssAddCode |
unshelve erewrite <-getThreadR_age |
unshelve erewrite gssThreadRes |
unshelve erewrite gsoThreadRes |
unshelve erewrite gThreadCR |
unshelve erewrite gssAddRes |
unshelve erewrite gsoAddRes |
unshelve erewrite gLockSetRes |
unshelve erewrite perm_of_age |
unshelve erewrite gRemLockSetRes |
unshelve erewrite m_phi_age_to
]; auto.
Tactic Notation "REWR" "in" hyp(H) :=
first
[ unshelve erewrite <-gtc_age in H |
unshelve erewrite gLockSetCode in H |
unshelve erewrite gRemLockSetCode in H |
rewrite gssThreadCode in H |
rewrite gssThreadCC in H |
unshelve erewrite gsoThreadCode in H |
unshelve erewrite <-gsoThreadCC in H |
unshelve erewrite gsoAddCode in H |
rewrite gssAddCode in H |
unshelve erewrite <-getThreadR_age in H |
unshelve erewrite gssThreadRes in H |
unshelve erewrite gsoThreadRes in H |
unshelve erewrite gThreadCR in H |
unshelve erewrite gssAddRes in H |
unshelve erewrite gsoAddRes in H |
unshelve erewrite gLockSetRes in H |
unshelve erewrite perm_of_age in H |
unshelve erewrite gRemLockSetRes in H |
unshelve erewrite m_phi_age_to in H
]; auto.
Tactic Notation "REWR" "in" "*" :=
first
[ unshelve erewrite <-gtc_age in * |
unshelve erewrite gLockSetCode in * |
unshelve erewrite gRemLockSetCode in * |
rewrite gssThreadCode in * |
rewrite gssThreadCC in * |
unshelve erewrite gsoThreadCode in * |
unshelve erewrite <-gsoThreadCC in * |
unshelve erewrite gsoAddCode in * |
rewrite gssAddCode in * |
unshelve erewrite <-getThreadR_age in * |
unshelve erewrite gssThreadRes in * |
unshelve erewrite gsoThreadRes in * |
unshelve erewrite gThreadCR in * |
unshelve erewrite gssAddRes in * |
unshelve erewrite gsoAddRes in * |
unshelve erewrite gLockSetRes in * |
unshelve erewrite perm_of_age in * |
unshelve erewrite gRemLockSetRes in * |
unshelve erewrite m_phi_age_to in *
]; auto.

Lemma FF_orp:
forall A (ND: NatDed A) (P: A), seplog.orp seplog.FF P = P.