Set Printing Implicit.
Program Definition new_MachineSemantics (op_m:option Mem.mem):
@ConcurSemantics G nat schedule event_trace machine_state mem res (*@semC Sem*).
apply (@Build_ConcurSemantics _ nat schedule event_trace machine_state _ _ (*_*)
(init_machine'' op_m)
(fun U st => halted_machine (U, nil, st))
(fun ge U st m st' m' =>
@internal_step U st m
st' m'
)
(fun ge U (tr:event_trace) st m U' tr' st' m' =>
@external_step U tr st m
U' tr' st' m'
)
unique_Krun)
;
unfold at_external_mach, halted_machine; try reflexivity.
- intros. inversion H; subst; rewrite HschedN; reflexivity.
- intros. inversion H; subst; rewrite HschedN; reflexivity.
Defined.
(** The class of Hybrid Machines parameterized by: - Threadwise semantics - Scheduler granularity *)
Class HybridMachine:=
{
MachineSemantics: schedule -> option res ->
CoreSemantics MachState mem
; ConcurMachineSemantics: option mem ->
@ConcurSemantics G nat (seq.seq nat) event_trace t mem res (*@semC Sem*)
; initial_schedule: forall m m' main vals U p st n,
initial_core (MachineCoreSemantics U p) n m st m' main vals ->
exists c, st = (U, nil, c) (*XXX:this seems wrong *)
}.
End HybridMachineSig.
(** Definition of the Coarse-grain hybrid machine *)
Module HybridCoarseMachine.
Section HybridCoarseMachine.
Variable n: nat.
Context {resources: Resources}
{Sem: Semantics}
{ThreadPool : ThreadPool.ThreadPool}
{machineSig: MachineSig}.
Instance DilMem : DiluteMem :=
{| diluteMem := fun x => x |}.
intros.
split; auto.
Defined.
Instance scheduler : Scheduler :=
{| isCoarse := true;
yield := fun x => x |}.
Notation thread_pool := t.
Notation C:= (semC).
Notation G:= (semG).
Local Notation ctl := (@ctl C).
Notation machine_state := thread_pool.
Notation schedule := (seq nat).
Notation event_trace := (seq machine_event).
Definition HybridCoarseMachine : HybridMachine :=
@Build_HybridMachine resources Sem ThreadPool _ _ _
(MachineCoreSemantics)
(new_MachineSemantics)
(hybrid_initial_schedule).
(** Schedule safety of the coarse-grained machine*)
Inductive csafe (st : MachState) (m : mem) : nat -> Prop :=
| Safe_0: csafe st m 0
| HaltedSafe: forall n, halted_machine st -> csafe st m n
| CoreSafe : forall tp' m' n tr
(Hstep: MachStep st m (fst (fst st),(snd (fst st)) ++ tr,tp') m')
(Hsafe: csafe (fst (fst st),(snd (fst st)) ++ tr,tp') m' n),
csafe st m (S n)
| AngelSafe: forall tp' m' n (tr: event_trace)
(Hstep: MachStep st m (schedSkip (fst (fst st)),(snd (fst st)) ++ tr,tp') m')
(Hsafe: forall U'', csafe (U'',(snd (fst st)) ++ tr,tp') m' n),
csafe st m (S n).
(** Schedule safety of the coarse-grained machine*)
Inductive concur_safe U tp (m : mem) : nat -> Prop :=
| concur_Safe_0: concur_safe U tp m 0
| concur_HaltedSafe: forall n, halted_machine (U, nil, tp) -> concur_safe U tp m n
| concur_Internal : forall tp' m' n
(Hstep: internal_step U tp m tp' m')
(Hsafe: concur_safe U tp' m' n),
concur_safe U tp m (S n)
| concur_External: forall tp' m' n (tr tr': event_trace)
(Hstep: external_step U tr tp m U tr' tp' m')
(Hsafe: concur_safe U tp' m' n),
concur_safe U tp m (S n)
| concur_External_Angel: forall tp' m' n (tr tr': event_trace)
(Hstep: external_step U tr tp m (schedSkip U) tr' tp' m')
(Hsafe: forall U'', concur_safe U'' tp' m' n),
concur_safe U tp m (S n).

(* Specifications: *)
(* TODO: Make a new file with safety lemmas. *)
Lemma csafe_reduce:
forall sched tp tr mem n m,
csafe (sched, tr, tp) mem n ->
m <= n ->
csafe (sched, tr, tp) mem m.
Lemma schedSkip_id: forall U, schedSkip U = U -> U = nil.
Lemma csafe_trace: forall n U tr tp m,
csafe (U, tr, tp) m n ->
forall tr', csafe (U, tr', tp) m n.
Lemma csafe_concur_safe: forall U tr tp m n, csafe (U, tr, tp) m n -> concur_safe U tp m n.
Lemma concur_safe_csafe: forall U tr tp m n, concur_safe U tp m n -> csafe (U, tr, tp) m n.
Inductive ctrace (st : MachState) (m : mem) : event_trace -> Prop :=
| Trace_0: ctrace st m nil (* if a state has trace tr, it also has all prefixes of tr *)
| Trace_Step : forall tp' m' U' tr tr'
(Hstep: MachStep st m (U',(snd (fst st)) ++ tr,tp') m')
(Hsafe: ctrace (U',(snd (fst st)) ++ tr,tp') m' tr'),
ctrace st m (tr ++ tr').