Proof with eauto with val_erasure erased.
intros.
inversion HerasePool as [Hnum Hthreads].
specialize (Hthreads _ cnti cnti').
inversion Hstep; subst;
match goal with
| [H: ctl_erasure ?Expr1 ?Expr2, H1: ?Expr1 = _ |- _] =>
rewrite H1 in H; destruct Expr2 eqn:?; simpl in H
end; try (by exfalso);
try match goal with
| [H: Mem.load _ _ _ _ = Some _ |- _] =>
eapply mem_load_erased in H; eauto with val_erasure erased;
destruct Hload as [? [Hload ?]]
end;
try match goal with
| [H: Mem.store _ _ _ _ _ = Some _ |- _] =>
eapply mem_store_erased in H; eauto with val_erasure erased;
destruct Hstore as [m2' [Hstore Hmem_erasure']]
end;
try match goal with
| [|- _ <> Vundef] => intro Hcontra; discriminate
end;
match goal with
| [H: at_external _ _ (restrPermMap ?E1) = _, H1: core_erasure _ _   |- _] =>
pose proof (at_external_erase _ _ H1 (mem_erasure_restr E1 Hmem_erasure) H) as Hat_external';
destruct Hat_external' as [vs' [Hat_external' Hval_erasure]]
end;
repeat match goal with
| [H: _ /\ _ |- _] => destruct H
| [H: val_erasure_list _ _ |- _] =>
inv H
| [H: val_erasure (Vptr _ _) _ |- _] => inv H
| [H:val_erasure (Vint _) _ |- _] => inv H
end; subst.
- exists (updThreadC cnti' (Kresume s Vundef)), m2'.
split; [econstructor; eauto | split; eauto].
constructor. simpl; eauto.
intros j cntj cntj'.
rewrite gLockSetCode.
destruct (i == j) eqn:Hij; move/eqP:Hij=>Hij.
+ subst.
rewrite gssThreadCode.
rewrite gssThreadCC.
simpl;
now auto.
+ rewrite gsoThreadCode; auto.
assert (cntj0' := cntUpdateC' _ _ cntj').
erewrite <- @gsoThreadCC with (cntj := cntj0')
by eauto.
inversion HerasePool;
now eauto.
- exists (updThreadC cnti' (Kresume s Vundef)), m2'.
split; [econstructor; eauto | split; eauto].
constructor. simpl; eauto.
intros j cntj cntj'.
rewrite gLockSetCode.
destruct (i == j) eqn:Hij; move/eqP:Hij=>Hij.
+ subst.
rewrite gssThreadCode.
rewrite gssThreadCC.
simpl;
now auto.
+ rewrite gsoThreadCode; auto.
assert (cntj0' := cntUpdateC' _ _ cntj').
erewrite <- @gsoThreadCC with (cntj := cntj0')
by eauto.
inversion HerasePool;
now eauto.
- exists (addThread
(updThreadC cnti' (Kresume s Vundef))
(Vptr b ofs) v'0 tt), m1'.
split; [econstructor; eauto | split; eauto].
eapply erased_addThread; eauto...
eapply erased_updThread; eauto...
simpl;
split;
now eauto...
- exists (updThreadC cnti' (Kresume s Vundef)), m2'.
split; [econstructor; eauto | split; eauto].
constructor. simpl; eauto.
intros j cntj cntj'.
rewrite gLockSetCode.
destruct (i == j) eqn:Hij; move/eqP:Hij=>Hij.
+ subst.
rewrite gssThreadCode.
rewrite gssThreadCC.
simpl; auto.
+ rewrite gsoThreadCode; auto.
assert (cntj0' := cntUpdateC' _ _ cntj').
erewrite <- @gsoThreadCC with (cntj := cntj0')
by eauto.
inversion HerasePool; eauto.
- exists (updThreadC cnti' (Kresume s Vundef)), m1'.
split; [econstructor; eauto | split; eauto].
constructor. simpl; eauto.
intros j cntj cntj'.
rewrite gRemLockSetCode.
destruct (i == j) eqn:Hij; move/eqP:Hij=>Hij.
+ subst.
rewrite gssThreadCode.
rewrite gssThreadCC.
simpl; auto.
+ rewrite gsoThreadCode; auto.
assert (cntj0' := cntUpdateC' _ _ cntj').
erewrite <- @gsoThreadCC with (cntj := cntj0')
by eauto.
inversion HerasePool; eauto.
- exists tp1', m1'.
split; [econstructor; eauto | split; eauto].
Qed.
Ltac pf_cleanup :=
repeat match goal with
| [H1: invariant ?X, H2: invariant ?X |- _] =>
assert (H1 = H2) by (by eapply proof_irr);
subst H2
| [H1: mem_compatible ?TP ?M, H2: mem_compatible ?TP ?M |- _] =>
assert (H1 = H2) by (by eapply proof_irr);
subst H2
| [H1: is_true (leq ?X ?Y), H2: is_true (leq ?X ?Y) |- _] =>
assert (H1 = H2) by (by eapply proof_irr); subst H2
| [H1: containsThread ?TP ?M, H2: containsThread ?TP ?M |- _] =>
assert (H1 = H2) by (by eapply proof_irr); subst H2
| [H1: containsThread ?TP ?M,
H2: containsThread (@updThreadC _ ?TP _ _) ?M |- _] =>
apply cntUpdateC' in H2;
assert (H1 = H2) by (by eapply cnt_irr); subst H2
| [H1: containsThread ?TP ?M,
H2: containsThread (@updThread _ ?TP _ _ _) ?M |- _] =>
apply cntUpdate' in H2;
assert (H1 = H2) by (by eapply cnt_irr); subst H2
end.

(* Specifications: *)
Lemma startStep_erasure:
forall tp1 tp1' tp2 m1 m1' m2 i
(HerasePool: threadPool_erasure tp1 tp1')
(Herase_mem: mem_erasure m1 m1')
(cnti: containsThread tp1 i)
(cnti': ThreadPool.containsThread tp1' i)
(Hcomp1': mem_compatible tp1' m1')
(Hstep: start_threadF m1 cnti tp2 m2),
exists tp2' m2',
start_threadE m1' cnti' tp2' m2' /\
threadPool_erasure tp2 tp2' /\
mem_erasure m2 (erasePerm m2').
Lemma resumeStep_erasure:
forall tp1 m1 tp1' m1' tp2 i
(HerasePool: threadPool_erasure tp1 tp1')
(Herase_mem: mem_erasure m1 m1')
(cnti: containsThread tp1 i)
(cnti': containsThread tp1' i)
(Hcomp1': mem_compatible tp1' m1')
(Hstep: resume_thread m1 cnti tp2),
exists tp2',
resume_thread m1' cnti' tp2' /\
threadPool_erasure tp2 tp2'.
Lemma suspendStep_erasure:
forall tp1 m1 tp1' m1' tp2 i
(HerasePool: threadPool_erasure tp1 tp1')
(Herase_mem: mem_erasure m1 m1')
(cnti: containsThread tp1 i)
(cnti': containsThread tp1' i)
(Hcomp1': mem_compatible tp1' m1')
(Hstep: suspend_threadF m1 cnti tp2),
exists tp2',
suspend_threadE m1' cnti' tp2' /\
threadPool_erasure tp2 tp2'.
Lemma threadStep_erase:
forall tp1 tp1' m1 m1' tp2 m2 i ev
(HerasePool: threadPool_erasure tp1 tp1')
(cnti: containsThread tp1 i)
(cnti': containsThread tp1' i)
(Hmem_erasure: mem_erasure m1 m1')
(Hcomp1: mem_compatible tp1 m1)
(Hcomp1': mem_compatible tp1' m1')
(Hstep: threadStepF cnti Hcomp1 tp2 m2 ev),
exists tp2' m2' ev',
threadStepE cnti' Hcomp1' tp2' m2' ev' /\
threadPool_erasure tp2 tp2' /\ mem_erasure m2 (erasePerm m2') /\
mem_event_list_erasure ev ev'.
(** A step on the FineConc machine can be matched by a step on the SC machine producing an erased event *)
Lemma sc_sim:
forall tp1 tp1' i U tr1 tr1' tr2 m1 m1' tp2 m2
(HerasePool: threadPool_erasure tp1 tp1')
(Hmem_erasure: mem_erasure m1 m1')
(Hfstep: fstep (i :: U, tr1, tp1) m1 (U, tr2, tp2) m2),
exists tp2' m2' tr2',
scstep (i :: U, tr1', tp1') m1' (U, tr2', tp2') m2' /\
threadPool_erasure tp2 tp2' /\ mem_erasure m2 m2' /\
(trace_erasure tr1 tr1' -> trace_erasure tr2 tr2').