Section SyncCallsDiagrams.
Context (hb: nat).
(*Instantiate definitions in Concur with the current hybridbound*)
Notation concur_match:= (concur_match hb).
Notation match_thread:= (match_thread hb).
Notation match_thread_source:= (match_thread_source hb).
Notation match_thread_target:= (match_thread_target hb).
Notation memcompat2:= (memcompat2 hb).
Notation memcompat1:= (memcompat1 hb).
Notation contains12:= (contains12 hb).
Notation mtch_target:= (mtch_target hb).
Notation mtch_compiled:= (mtch_compiled hb).
Notation mtch_source:= (mtch_source hb).
Notation thread_perms st i cnt:= (fst (@getThreadR _ _ st i cnt)).
Notation lock_perms st i cnt:= (snd (@getThreadR  _ _ st i cnt)).
(* Thread states *)
(* angel,lock permissions and new thread permissions *)
(*Hangel_bound: sub_map_virtue angel (getMaxPerm m1)*)
(* Thread states *)
(* angel, lock permissions and new thread permissions *)
(* Thread states *)
(* The following two things are not needed *)
(* angel, lock permissions and new thread permissions *)
(* Thread states *)
(* angel, lock permissions and new thread permissions *)
(* Thread states *)
(* angel,lock permissions and new thread permissions *)
(** *Compiled diagrams*)
(*TODO: 1. Find a better name 2. Simplify / Clean it? *)
Ltac unify_at_ext:=
repeat match goal with
[H: semantics.at_external _ _ _ = Some _ |- _] =>
simpl in H
end;
match goal with
[H1: Clight.at_external ?X = _,
H2: Clight.at_external ?X = _ |- _] =>
rewrite H1 in H2; invert H2
end.
Ltac inj_args_inv:=
match goal with
[Hinj_args: Val.inject_list ?f (Vptr ?b1 ?ofs :: nil) _  |- _ ]=>
invert Hinj_args;
match goal with
| [ Hinj_ptr: Val.inject _ (Vptr b1 ofs) _,
Hinj_nil: Val.inject_list _ nil _ |- _ ] =>
invert Hinj_ptr; invert Hinj_nil;
match goal with
| [Hinj_b_badname: f b1 = Some _ |- _ ] =>
let Hinj_b:= fresh "Hinj_b" in rename Hinj_b_badname into Hinj_b;
try (let Hinj_b':= fresh "Hinj_b'" in
eapply evolution_inject_incr in Hinj_b as Hinj_b';
eauto; [idtac] (*check only one goal left.*) )
end
end
end.
Ltac inject_lock_update_mem_strict_load:=
lazymatch goal with
[CMatch: concur_match _ ?mu ?st1 ?m1' ?st2 ?m2',
Hlock: lock_update_mem_strict_load _ _ _ _ _ _ _ |- _ ] =>
let Hlock_update_mem_strict_load1:= fresh "Hlock_update_mem_strict_load1" in
dup Hlock as Hlock_update_mem_strict_load1;
let m2'':=fresh "m2''" in
let Hlock_update_mem_strict_load2:=fresh "Hlock_update_mem_strict_load2" in
let Hinj2:=fresh "Hinj2" in
eapply lock_update_mem_strict_load_inject in Hlock
as (m2''&Hlock_update_mem_strict_load2&Hinj2);
eauto; try (eapply CMatch; eauto); [idtac]
end.
Ltac get_injection_thread_mem:=
match goal with
[CMatch: concur_match _ ?mu ?st1 ?m1' ?st2 ?m2' |- _ ] =>
let Hinj':= fresh "Hinj'" in
assert (Hinj': Mem.inject mu m1' m2') by
(rewrite <- (cur_equiv_restr_mem_equiv m1') by eassumption;
rewrite <- (cur_equiv_restr_mem_equiv m2') by eassumption;
eapply INJ_threads; eauto)
end.
Ltac use_retroactive_int_diagram_atx:=
match goal with
[Hstrict: strict_evolution_diagram _ _ _ _ _ _ _  |- _] =>
eapply retroactive_int_diagram_atx in Hstrict;
eauto; [idtac]; (* This checks there is only one goal left! *)
inversion Hstrict; unify_at_ext
end.
Ltac inject_lock_update_mem_strict:=
lazymatch goal with
[CMatch: concur_match _ ?mu ?st1 ?m1' ?st2 ?m2',
Hlock: lock_update_mem_strict _ _ _ _ _ |- _ ] =>
let Hlock_update_mem_strict1:= fresh "Hlock_update_mem_strict1" in
dup Hlock as Hlock_update_mem_strict1;
let m2'':=fresh "m2''" in
let Hlock_update_mem_strict2:=fresh "Hlock_update_mem_strict2" in
let Hinj2:=fresh "Hinj2" in
eapply lock_update_mem_strict_inject in Hlock
as (m2''&Hlock_update_mem_strict2&Hinj2);
eauto; try (eapply CMatch; eauto); [ ]
end.
Ltac left_diagram:=
(* 1. Set up the injection*)
get_injection_thread_mem;
(* 2. Now we expand the diagram backwards *)
use_retroactive_int_diagram_atx;
inj_args_inv;
(* There are different types of left diagram. `            each case is a different type. *)
first
[inject_lock_update_mem_strict_load
| inject_lock_update_mem_strict].
(*+ tactics to push mem_compat forward (in diagrams) *)

Lemma store_cmpt:
forall Sem Tp st chunk b ofs v m m' p Hlt ,
Mem.store chunk (@restrPermMap p m Hlt ) b ofs v = Some m' ->
@mem_compatible Sem Tp st m ->
@mem_compatible Sem Tp st m'.