(* Clight Safety*)
(** Prove that csafety in Clight_new implies safety in Clight. *)
Set Bullet Behavior "Strict Subproofs".
Section Clight_safety_equivalence.
Context (CPROOF : semax_to_juicy_machine.CSL_proof).
Definition prog:= CPROOF.(CSL_prog).
Definition ge:= Clight.globalenv prog.
Definition init_mem:= proj1_sig (init_mem CPROOF).
(*We should be able to construct a Clight.state from the proof... *)
Definition f_main : {f | Genv.find_funct_ptr (Clight.genv_genv ge) (projT1 (spr CPROOF)) = Some f}.
Inductive match_ctl : ctl -> ctl -> Prop :=
| match_Krun c c' : match_states c (fst (CC'.CC_state_to_CC_core c')) -> match_ctl (Krun c) (Krun c')
| match_Kblocked c c' : match_states c (fst (CC'.CC_state_to_CC_core c')) -> match_ctl (Kblocked c) (Kblocked c')
| match_Kresume c c' v : match_states c (fst (CC'.CC_state_to_CC_core c')) -> match_ctl (Kresume c v) (Kresume c' v)
| match_Kinit v v' : match_ctl (Kinit v v') (Kinit v v').
(* This should essentially reproduce Clight_sim at the hybrid machine level. *)
Inductive match_st (tp : ThreadPool.t(resources := dryResources)(ThreadPool:= threadPool.OrdinalPool.OrdinalThreadPool(Sem:=Clight_newSem ge)))
(tp' : ThreadPool.t(resources := dryResources)(ThreadPool:= threadPool.OrdinalPool.OrdinalThreadPool(Sem:=ClightSem ge))) : Prop :=
MATCH_ST: forall (mtch_cnt: forall {tid},  containsThread tp tid -> containsThread tp' tid)
(mtch_cnt': forall {tid}, containsThread tp' tid -> containsThread tp tid)
(mtch_gtc: forall {tid} (Htid:containsThread tp tid)(Htid':containsThread tp' tid),
match_ctl (getThreadC Htid) (getThreadC Htid'))
(mtch_gtr1: forall {tid} (Htid:containsThread tp tid)(Htid':containsThread tp' tid)
b ofs,
(fst (getThreadR Htid)) !! b ofs = (fst (getThreadR Htid')) !! b ofs)
(mtch_gtr2: forall {tid} (Htid:containsThread tp tid)(Htid':containsThread tp' tid),
snd (getThreadR Htid) = snd (getThreadR Htid'))
(mtch_locks: forall a, lockRes tp a = lockRes tp' a)
(mtch_latest: latestThread tp = latestThread tp'),
match_st tp tp'.

(* Specifications: *)
Lemma MTCH_compat: forall js ds m,
match_st js ds ->
mem_compatible js m ->
mem_compatible ds m.
Lemma MTCH_install_perm:
forall js ds m m' tid (MATCH : match_st js ds)
(Hcmpt : mem_compatible js m) (Htid : containsThread js tid) (Htid' : containsThread ds tid)
(Hperm : install_perm _ _ _ Hcmpt Htid m'),
install_perm _ _ _ (MTCH_compat _ _ _ MATCH Hcmpt) Htid' m'.
Lemma MTCH_invariant:
forall js ds (MATCH : match_st js ds) (Hinv : invariant js), invariant ds.
Lemma MTCH_updThread:
forall tp tp' tid c c' r r' (MATCH : match_st tp tp')
(Htid : containsThread tp tid) (Htid' : containsThread tp' tid) (Hctl : match_ctl c c')
(Hr1: forall b ofs, (fst r) !! b ofs = (fst r') !! b ofs) (Hr2: snd r = snd r'),
match_st (updThread Htid c r) (updThread Htid' c' r').
Lemma MTCH_updThreadC:
forall tp tp' tid c c' (MATCH : match_st tp tp')
(Htid : containsThread tp tid) (Htid' : containsThread tp' tid) (Hctl : match_ctl c c'),
match_st (updThreadC Htid c) (updThreadC Htid' c').
Lemma MTCH_updLockSet:
forall tp tp' a l (MATCH : match_st tp tp'),
match_st (updLockSet tp a l) (updLockSet tp' a l).
Lemma MTCH_remLockSet:
forall tp tp' a (MATCH : match_st tp tp'),
match_st (remLockSet tp a) (remLockSet tp' a).
Lemma MTCH_addThread:
forall tp tp' vf arg r (MATCH : match_st tp tp'),
match_st (addThread tp vf arg r) (addThread tp' vf arg r).