End MemErasure.
(** ** Erasure of cores *)
Module CoreErasure.
Section CoreErasure.
Context {Sem: Semantics}.
Class CoreErasure :=
{ core_erasure : semC -> semC -> Prop;
core_erasure_refl: forall c, core_erasure c c;
at_external_erase:
forall c c' m m' ef vs
(Hcore_erase: core_erasure c c')
(Hmem_erase: mem_erasure m m')
(Hat_ext:at_external semSem c m = Some (ef, vs)),
exists vs',
at_external semSem c' m' = Some (ef, vs') /\
val_erasure_list vs vs';
after_external_erase:
forall v v' c c' m m' c2
(HeraseCores: core_erasure c c')
(HeraseVal: optionval_erasure v v')
(Hmem_erase: mem_erasure m m')
(Hafter_external: after_external semSem v c m = Some c2),
exists c2',
after_external semSem v' c' m' = Some c2' /\
core_erasure c2 c2';
erasure_initial_core:
forall h v arg v' arg' c m m' m2
(Hv: val_erasure v v')
(Harg: val_erasure arg arg')
(Hmem_erase: mem_erasure m m')
(Hinit: initial_core semSem h m c m2 v [:: arg]),
exists c' m2',
initial_core semSem h m' c' m2' v' [:: arg'] /\
core_erasure c c' /\
mem_erasure m2 (erasePerm m2');
halted_erase:
forall c c' n
(HeraseCores: core_erasure c c')
(Hhalted: halted semSem c n),
halted semSem c' n;
evstep_erase:
forall c1 c1' c2 ev m1 m1' m2
(HeraseCores: core_erasure c1 c1')
(Hmem_erasure: mem_erasure m1 m1')
(Hstep: ev_step semSem c1 m1 ev c2 m2),
exists c2' m2' ev',
ev_step semSem c1' m1' ev' c2' m2' /\
core_erasure c2 c2' /\ mem_erasure m2 (erasePerm m2') /\
mem_event_list_erasure ev ev'
}.
End CoreErasure.
Hint Resolve core_erasure_refl : erased.
End CoreErasure.
Module ThreadPoolErasure.
Section ThreadPoolErasure.
Context {Sem: Semantics}
{CE: CoreErasure}.
Existing Instance OrdinalPool.OrdinalThreadPool.
Existing Instance DryHybridMachine.dryResources.
Existing Instance BareMachine.resources.
Existing Instance AsmContext.bareMach.
Existing Instance AsmContext.dryFineMach.
Notation containsThreadF := (@containsThread DryHybridMachine.dryResources Sem OrdinalPool.OrdinalThreadPool).
Notation containsThreadE := (@containsThread BareMachine.resources Sem OrdinalPool.OrdinalThreadPool).
Definition ctl_erasure c c' : Prop :=
match c, c' with
| Kinit vf arg, Kinit vf' arg' =>
val_erasure vf vf' /\ val_erasure arg arg'
| Krun c, Krun c' =>
core_erasure c c'
| Kblocked c, Kblocked c' =>
core_erasure c c'
| Kresume c arg, Kresume c' arg' =>
core_erasure c c' /\ arg = arg'
(*we don't use this and our semantics are strange*)
| _, _  => False
end.
Inductive threadPool_erasure tp tp' :=
| ErasedPool :
(forall i, containsThreadF tp i <-> containsThreadE tp' i) ->
(forall i (cnti: containsThreadF tp i)
(cnti': containsThreadE tp' i),
ctl_erasure (getThreadC cnti) (getThreadC cnti')) ->
threadPool_erasure tp tp'.

Lemma erasedPool_contains:
forall tp1 tp1'
(HerasedPool: threadPool_erasure tp1 tp1') i,
containsThread tp1 i <-> containsThread tp1' i.