Proof with eauto with trace_erasure mem_erasure.
intros.
inversion Hfstep; subst;
inv HschedN;
try match goal with
| [H: containsThread _ ?I |- _ ] =>
assert (containsThread tp1' I)
by (eapply erasedPool_contains; simpl in *; subst; eauto)
end;
assert (Hcomp1' : mem_compatible tp1' m1')
by (simpl; unfold BareMachine.mem_compatible; auto).
- (* start thread case *)
assert (Hstep' := startStep_erasure HerasePool Hmem_erasure H Hcomp1' Htstep).
destruct Hstep' as [tp2' [m2' [Hstart' [HerasePool' Herasemem']]]].
exists tp2', (@diluteMem BareDilMem m2'), tr1'.
split. econstructor 1; simpl; eauto.
simpl in *; subst.
split; eauto...
- assert (Hstep' := resumeStep_erasure HerasePool Hmem_erasure H Hcomp1' Htstep).
destruct Hstep' as [tp2' [Hstart' HerasePool']].
exists tp2', m1', tr1'.
split. econstructor 2; simpl; eauto.
simpl in *; subst.
split; now eauto.
- assert (Htstep' := threadStep_erase HerasePool H Hmem_erasure Hcomp1' Htstep).
destruct Htstep' as (tp2' & m2' & ev' & Htstep' & HerasePool'
& Hmem_erasure' & Htr_erasure').
exists tp2', (@diluteMem BareDilMem m2'), (tr1' ++ map [eta Events.internal tid] ev').
split.
assert (Hsched: U = @yield HybridFineMachine.scheduler (tid :: U)) by reflexivity.
rewrite Hsched.
eapply thread_step; eauto.
split...
simpl in *; subst.
split...
- assert (Hstep' := suspendStep_erasure HerasePool Hmem_erasure H Hcomp1' Htstep).
destruct Hstep' as [tp2' [Hstart' HerasePool']].
exists tp2', m1', tr1'.
split. econstructor 4; simpl; eauto.
simpl in *; subst.
split; now eauto.
- assert (Hstep' := syncStep_erase HerasePool H Hmem_erasure Hcomp1' Htstep).
destruct Hstep' as (tp2' & m2' & Hstep' & HerasePool' & Hmem_erasure').
exists tp2', m2', (tr1' ++ [:: Events.external tid (eraseSyncEvent ev)]).
split.
eapply sync_step; eauto.
simpl in *; subst.
split...
- assert (~ containsThread tp1' tid).
{ intros Hcontra.
destruct HerasePool as [Hnum _].
unfold containsThread in *.
simpl in *; subst.
rewrite <- Hnum in Hcontra.
auto.
}
exists tp1', m1',tr1'.
split.
econstructor 6; simpl; eauto.
simpl in *; subst.
split; now eauto.
Qed.

(* Specifications: *)
Lemma fsafe_execution:
forall tpf mf U tr,
fsafe tpf mf U (size U).+1 ->
exists tpf' mf' tr',
fexecution (U, tr, tpf) mf ([::], tr ++ tr', tpf') mf'.
(** The initial state of the SC machine is an erasure of the initial state of the FineConc machine*)
Lemma init_erasure:
forall f arg U tpsc tpf m m'
(HinitSC: bare_init initU m (U, [::], tpsc) m' f arg)
(HinitF: tpf_init initU m (U, [::], tpf) m' f arg),
threadPool_erasure tpf tpsc.
(** Any execution of the FineConc machine resulting in some trace tr' can be matched by an execution of the SC machine with an erased trace *)
Lemma execution_sim:
forall U U' tpf tpf' mf mf' tpsc msc tr tr' trsc
(Hexec: fexecution (U, tr, tpf) mf (U', tr', tpf') mf')
(HerasedPool: threadPool_erasure tpf tpsc)
(Hmem_erasure: mem_erasure mf msc),
exists tpsc' msc' trsc',
sc_execution (U, trsc, tpsc) msc (U', trsc', tpsc') msc' /\
threadPool_erasure tpf' tpsc' /\ mem_erasure mf' msc' /\
(trace_erasure tr trsc -> trace_erasure tr' trsc').