Proof with eauto.
intros U.
induction U.
- intros.
inversion Hexec; subst.
exists tpsc, msc, trsc.
split.
econstructor 1. simpl; auto.
split...
- intros.
inversion Hexec; subst.
+ simpl in H5; by exfalso.
+ eapply sc_sim with (tr1' := trsc) in H8; eauto.
destruct H8 as (tpsc0 & msc0 & tr0 & Hstep0 & HerasedPool0
& Hmem_erasure0 & Htrace_erasure0).
specialize (IHU _ _ _ _ _ _ _ _ _ tr0 H9 HerasedPool0
Hmem_erasure0).
destruct IHU as (tpsc2' & msc2' & trsc2' & Hsexec & HerasedPool'
& Hmem_erasure' & Htrace_erasure2').
exists tpsc2', msc2', trsc2'.
split...
pose proof (step_trace_monotone Hstep0) as Htr0.
destruct Htr0 as [trsc' Htrsc'];
subst.
pose proof (fine_execution_schedule Hsexec); subst.
pose proof (fine_execution_multi_step Hsexec).
eapply multi_step_trace_monotone in H.
destruct H as [tr''' ?].
subst.
rewrite <- catA.
rewrite <- catA in Hsexec.
econstructor; simpl in *;
now eauto.
Qed.

(* Specifications: *)
(** Safety of the SC machine*)
Lemma fsafe_implies_scsafe:
forall n sched tpsc tpf mf msc
(Hsafe: fsafe tpf mf sched n)
(HerasedPool: threadPool_erasure tpf tpsc)
(Hmem_erasure: mem_erasure mf msc),
sc_safe tpsc msc sched n.
(** Final erasure theorem from FineConc to SC*)
Theorem sc_erasure:
forall f arg tpsc tpf m m'
(HinitSC: bare_init initU m (initU, [::], tpsc) m' f arg)
(HinitF: tpf_init initU m (initU, [::], tpf) m' f arg)
(HsafeF: forall n, fsafe tpf (@diluteMem FineDilMem m') initU n),
(forall n, sc_safe tpsc (@diluteMem BareDilMem m') initU n) /\
(forall tpf' mf' tr,
fexecution (initU, [::], tpf) (@diluteMem FineDilMem m')
([::], tr, tpf') mf' ->
exists tpsc' msc' tr',
sc_execution (initU, [::], tpsc) (@diluteMem BareDilMem m')
([::], tr', tpsc') msc' /\
threadPool_erasure tpf' tpsc' /\ mem_erasure mf' msc' /\
trace_erasure tr tr').