From mathcomp.ssreflect Require Import ssreflect ssrbool ssrnat ssrfun eqtype.
Set Bullet Behavior "Strict Subproofs".
(*Clight Machine *)
(*Asm Machine*)
Module Concurrent_Safety (CC_correct: CompCert_correctness).
(*Import the Clight Hybrid Machine*)
(*Import the Asm X86 Hybrid Machine*)
Module ConcurCC_correct:= (Concurrent_correctness CC_correct).
Definition Clight_init_state (p: Clight.program):=
Clight.start_stack (Clight.globalenv p).
Definition Asm_init_state (p: Asm.program):=
Asm.start_stack (@the_ge p).
Notation valid Sem:=
(valid dryResources Sem OrdinalPool.OrdinalThreadPool).
Definition opt_init_mem_source (p : Clight.program):=
(Genv.init_mem (Ctypes.program_of_program p)).
Definition opt_init_mem_target {F V} (tp:AST.program F V ):=
(Genv.init_mem tp).

(* Specifications: *)
Lemma explicit_safety_step:
forall (p : Clight.program) (tp : Asm.program) (asm_genv_safety : Asm_core.safe_genv the_ge),
let SemSource:= (ClightSemanticsForMachines.ClightSem (Clight.globalenv p)) in
let SemTarget:= @X86Sem tp asm_genv_safety in
forall (U : schedule) (m_s m_t : Memory.Mem.mem)
(j : Values.Val.meminj) (c : Asm.state)
(C_source : OrdinalPool.t(Sem:=SemSource))
(C_target : OrdinalPool.t(Sem:=SemTarget)) tr
(SIM : HybridMachine_simulation (ClightConcurSem (opt_init_mem_source p))
(AsmConcurSem (opt_init_mem_target tp))) (cd : index SIM),
match_state SIM cd j C_source m_s C_target
m_t ->
(forall U,
(valid SemSource) (tr, C_source, m_s) U ->
explicit_safety
HybridMachine.DryHybridMachine.dryResources
SemSource
(threadPool.OrdinalPool.OrdinalThreadPool(Sem:=SemSource))
HybridMachine.DryHybridMachine.DryHybridMachineSig
U tr C_source m_s) ->
forall U,
(valid SemTarget) (tr, C_target, Asm.get_mem c) U ->
explicit_safety
HybridMachine.DryHybridMachine.dryResources
SemTarget
(threadPool.OrdinalPool.OrdinalThreadPool(Sem:=SemTarget))
HybridMachine.DryHybridMachine.DryHybridMachineSig
U tr C_target m_t.
Lemma match_valid_equiv:
forall U (p : Clight.program) (tp : Asm.program) (asm_genv_safety : Asm_core.safe_genv the_ge),
let SemSource:= (ClightSemanticsForMachines.ClightSem (Clight.globalenv p)) in
let SemTarget:= @X86Sem tp asm_genv_safety in
forall (m_s m_t : Memory.Mem.mem)
(j : Values.Val.meminj)
(C_source : OrdinalPool.t(Sem:=SemSource))
(C_target : OrdinalPool.t(Sem:=SemTarget)) tr
(SIM : HybridMachine_simulation (ClightConcurSem (opt_init_mem_source p))
(AsmConcurSem (opt_init_mem_target tp))) (cd : index SIM)
(Hmatch: match_state SIM cd j C_source m_s C_target m_t),
(valid SemSource) (tr, C_source, m_s) U <-> (valid SemTarget) (tr, C_target, m_t) U.
(* Note, unused right now *)
Lemma thread_stepN_schedule_irr:
forall (tp : Asm.program)
(asm_genv_safety : Asm_core.safe_genv the_ge),
let SemTarget:= @X86Sem tp asm_genv_safety in
forall  n U U' (c c':  OrdinalPool.t(Sem:=SemTarget)) m m'
(Hsched: schedPeek U = schedPeek U')
(HstepN: machine_semantics_lemmas.thread_stepN
(AsmConcurSem (opt_init_mem_target tp)) (@the_ge tp) n U c m c' m'),
machine_semantics_lemmas.thread_stepN
(AsmConcurSem (opt_init_mem_target tp)) (@the_ge tp) n U' c m c' m'.
Lemma explicit_safety_step':
forall (p : Clight.program) (tp : Asm.program) (asm_genv_safety : Asm_core.safe_genv the_ge),
let SemSource:= (ClightSemanticsForMachines.ClightSem (Clight.globalenv p)) in
let SemTarget:= @X86Sem tp asm_genv_safety in
forall (m_s m_t : Memory.Mem.mem)
(j : Values.Val.meminj)
(C_source : OrdinalPool.t(Sem:=SemSource))
(C_target : OrdinalPool.t(Sem:=SemTarget)) tr1 tr2
(SIM : HybridMachine_simulation (ClightConcurSem (opt_init_mem_source p))
(AsmConcurSem (opt_init_mem_target tp))) (cd : index SIM)
(Hmatch: match_state SIM cd j C_source m_s C_target m_t)
(Hmatch_events: List.Forall2 (inject_mevent j) tr1 tr2)
(HsafeS: forall U,
(valid SemSource) (tr1, C_source, m_s) U ->
explicit_safety
HybridMachine.DryHybridMachine.dryResources
SemSource
(threadPool.OrdinalPool.OrdinalThreadPool(Sem:=SemSource))
HybridMachine.DryHybridMachine.DryHybridMachineSig
U tr1 C_source m_s)
U (HvalidT: (valid SemTarget) (tr2, C_target, m_t) U),
explicit_safety
HybridMachine.DryHybridMachine.dryResources
SemTarget
(threadPool.OrdinalPool.OrdinalThreadPool(Sem:=SemTarget))
HybridMachine.DryHybridMachine.DryHybridMachineSig
U tr2 C_target m_t.
Lemma Clight_finite_branching:
let ClightSem:= ClightSemanticsForMachines.ClightSem in
forall (p : Clight.program)
(x : kstate dryResources (ClightSem (Clight.globalenv p)) OrdinalPool.OrdinalThreadPool),
safety.finite_on_x
(safety.possible_image
(fun
(x0 : kstate dryResources (ClightSem (Clight.globalenv p))
OrdinalPool.OrdinalThreadPool) (y : schedule)
(x' : kstate dryResources (ClightSem (Clight.globalenv p))
OrdinalPool.OrdinalThreadPool) =>
exists y' : schedule,
kstep dryResources (ClightSem (Clight.globalenv p)) OrdinalPool.OrdinalThreadPool
DryHybridMachineSig x0 y x' y') (valid (ClightSem (Clight.globalenv p))) x).
Lemma csafety_step:
forall (p : Clight.program) (tp : Asm.program) (asm_genv_safety : Asm_core.safe_genv the_ge),
let SemSource:= (ClightSemanticsForMachines.ClightSem (Clight.globalenv p)) in
let SemTarget:= @X86Sem tp asm_genv_safety in
forall (U : schedule) (init_mem_source' : Memory.Mem.mem)
(j : Values.Val.meminj) (c : Asm.state)
(C_source : OrdinalPool.t(Sem:=SemSource))
(C_target : OrdinalPool.t) tr
(SIM : HybridMachine_simulation (ClightConcurSem (opt_init_mem_source p))
(AsmConcurSem (opt_init_mem_target tp))) (cd : index SIM),
match_state SIM cd j C_source init_mem_source' C_target
(Asm.get_mem c) ->
(forall (n : nat) U,
(valid SemSource) (tr, C_source, init_mem_source') U ->
HybridCoarseMachine.csafe(Sem:=SemSource)
(resources:=HybridMachine.DryHybridMachine.dryResources)
(ThreadPool:= threadPool.OrdinalPool.OrdinalThreadPool(Sem:=SemSource))
(machineSig:= HybridMachine.DryHybridMachine.DryHybridMachineSig)
(U, tr, C_source)
init_mem_source' n) ->
forall (n : nat) U ,
(valid SemTarget) (tr, C_target, Asm.get_mem c) U ->
HybridCoarseMachine.csafe (Sem:=SemTarget)
(resources:=HybridMachine.DryHybridMachine.dryResources)
(ThreadPool:= threadPool.OrdinalPool.OrdinalThreadPool(Sem:=SemTarget))
(machineSig:= HybridMachine.DryHybridMachine.DryHybridMachineSig)
(U, tr, C_target)
(Asm.get_mem c) n.
(** for the initial state, it's enough to prove csafety for the valid schedules, we can derive safety for all others. *)
Lemma initial_csafe_all_schedule:
forall  prog asm_genv_safety tr c m r,
let SemTarget:= @X86Sem prog asm_genv_safety in
let tp:=OrdinalPool.mkPool (Krun c) r in
(forall U (n : nat),
(valid SemTarget) (tr, tp, m) U ->
HybridCoarseMachine.csafe
(ThreadPool:=threadPool.OrdinalPool.OrdinalThreadPool(Sem:=SemTarget))
(machineSig:= HybridMachine.DryHybridMachine.DryHybridMachineSig)
(U, nil,
OrdinalPool.mkPool
(Krun c) r) m n)  ->
forall U (n : nat),
HybridCoarseMachine.csafe
(ThreadPool:=threadPool.OrdinalPool.OrdinalThreadPool(Sem:=SemTarget))
(machineSig:= HybridMachine.DryHybridMachine.DryHybridMachineSig)
(U, nil,
OrdinalPool.mkPool (Krun c) r) m n.
Lemma ConcurrentCompilerSafety:
forall (p : Clight.program) (tp : Asm.program),
CC_correct.CompCert_compiler p = Some tp ->
forall asm_genv_safety : Asm_core.safe_genv (@the_ge tp),
let SemSource:= (ClightSemanticsForMachines.ClightSem (Clight.globalenv p)) in
let SemTarget:= @X86Sem tp asm_genv_safety in
concurrent_simulation_safety_preservation
(Genv.init_mem (Ctypes.program_of_program p))
(Genv.init_mem tp)
(SemSource:= SemSource)
(SourceThreadPool:= threadPool.OrdinalPool.OrdinalThreadPool(Sem:=SemSource))
(SourceMachineSig:= HybridMachine.DryHybridMachine.DryHybridMachineSig)
(SemTarget :=  SemTarget)
(TargetThreadPool:= threadPool.OrdinalPool.OrdinalThreadPool(Sem:=SemTarget))
(TargetMachineSig:= HybridMachine.DryHybridMachine.DryHybridMachineSig)
.