Section SCErasure.
Context {Sem: Semantics}
{SemAxioms: SemAxioms}
{SemD: SemDet}
{CE: CoreErasure}
{initU: seq.seq nat}.
Existing Instance OrdinalPool.OrdinalThreadPool.
Existing Instance DryHybridMachine.dryResources.
Existing Instance DryHybridMachine.DryHybridMachineSig.
Existing Instance dryFineMach.
Existing Instance FineDilMem.
Existing Instance HybridFineMachine.scheduler.
Existing Instance BareMachine.resources.
Existing Instance BareMachine.BareMachineSig.
Existing Instance BareDilMem.
Existing Instance bareMach.
Notation syncStepF := (@syncStep DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig).
Notation syncStepE := (@syncStep BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig).
Notation start_threadF := (@start_thread DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig).
Notation start_threadE := (@start_thread BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig).
Notation resume_threadF := (@resume_thread DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig).
Notation resume_threadE := (@resume_thread BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig).
Notation suspend_threadF := (@suspend_thread DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig).
Notation suspend_threadE := (@suspend_thread BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig).
Notation threadStepF := (@threadStep DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig).
Notation threadStepE := (@threadStep BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig).
Notation fstep := (corestep (@fine_semantics _ initU)).
Notation scstep := (corestep (@bare_semantics _ initU)).
Notation fsafe := (@HybridFineMachine.fsafe DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig FineDilMem).
Notation sc_safe := (@HybridFineMachine.fsafe BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig BareDilMem).
Notation fexecution := (@fine_execution _ FineDilMem DryHybridMachine.dryResources).
Notation sc_execution := (@fine_execution _ BareDilMem BareMachine.resources).
(** ** Simulation for syncStep, startStep, resumeStep, suspendStep *)
Hint Resolve mem_erasure_restr : erased.
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.

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'.