(** Erasure Proof *)
(** This file contains the proof of erasure between juicy and dry programs *)
(** *Imports*)
(* This file uses Proof Irrelevance: forall (P : Prop) (p1 p2 : P), p1 = p2. *)
(* CompCert imports *)
(* VST imports *)
(* Concurrency Imports *)
(*The semantics*)
(*Erasure specification*)
(*SSReflect*)
From mathcomp.ssreflect Require Import ssreflect ssrfun ssrbool ssrnat eqtype seq.
From mathcomp.ssreflect Require Import ssreflect seq.
Set Bullet Behavior "Strict Subproofs".
Module Parching <: ErasureSig.
Section Parching.
Context (ge : Clight.genv).
Instance Sem : Semantics := ClightSemanticsForMachines.Clight_newSem ge.
Instance JR : Resources := LocksAndResources.
Instance JTP : ThreadPool.ThreadPool := OrdinalPool.OrdinalThreadPool.
Instance JMS : MachineSig := Concur.JuicyMachineShell.
Instance DilMem : DiluteMem := HybridMachineSig.HybridCoarseMachine.DilMem.
Instance scheduler : Scheduler := HybridCoarseMachine.scheduler.
Instance JuicyMachine : HybridMachine := HybridCoarseMachine.HybridCoarseMachine.
Definition jstate := jstate ge.
Instance DR : Resources := DryHybridMachine.dryResources.
Instance DTP : ThreadPool.ThreadPool := OrdinalPool.OrdinalThreadPool.
Instance DMS : MachineSig := DryHybridMachine.DryHybridMachineSig.
Instance DryMachine : HybridMachine := HybridCoarseMachine.HybridCoarseMachine.
Definition dstate := ThreadPool.t
(ThreadPool := OrdinalPool.OrdinalThreadPool)
(* @t dryResources DSem (@OrdinalPool.OrdinalThreadPool dryResources DSem) *).  Definition dmachine_state:= MachState(ThreadPool := OrdinalPool.OrdinalThreadPool).  Import event_semantics threadPool.ThreadPool.  (** * Match relation between juicy and dry state : *)
(* 1-2. Same threads are contained in each state: 3.   Threads have the same c 4-5.   Threads have the same permissions up to erasure 6.   the locks are in the same addresses. 7-8-9. Lock contents match up to erasure. *)
Inductive match_st' : jstate ->  dstate -> Prop:=
MATCH_ST: forall (js:jstate) (ds:dstate)
(mtch_cnt: forall {tid},  containsThread js tid -> containsThread ds tid )
(mtch_cnt': forall {tid}, containsThread ds tid -> containsThread js tid )
(mtch_gtc: forall {tid} (Htid:containsThread js tid)(Htid':containsThread ds tid),
getThreadC Htid = getThreadC Htid' )
(mtch_perm1: forall b ofs {tid} (Htid:containsThread js tid)(Htid':containsThread ds tid),
juicy_mem.perm_of_res (resource_at (getThreadR Htid) (b, ofs)) =
((getThreadR Htid').1 !! b) ofs )
(mtch_perm2: forall b ofs {tid} (Htid:containsThread js tid)(Htid':containsThread ds tid),
juicy_mem.perm_of_res_lock (resource_at (getThreadR Htid) (b, ofs)) =
((getThreadR Htid').2 !! b) ofs )
(mtch_locks: forall a,
ssrbool.isSome (lockRes js a) = ssrbool.isSome (lockRes ds a))
(mtch_locksEmpty: forall lock dres,
lockRes js lock = Some (None) ->
lockRes ds lock = Some dres ->
dres = (empty_map, empty_map))
(mtch_locksRes: forall lock jres dres,
lockRes js lock = Some (Some jres) ->
lockRes ds lock = Some dres ->
forall b ofs,
juicy_mem.perm_of_res (resource_at jres (b, ofs)) = (dres.1 !! b) ofs )
(mtch_locksRes: forall lock jres dres,
lockRes js lock = Some (Some jres) ->
lockRes ds lock = Some dres ->
forall b ofs,
juicy_mem.perm_of_res_lock (resource_at jres (b, ofs)) = (dres.2 !! b) ofs )

Lemma lock_range_perm : forall m js ds (MATCH : match_st js ds) i (Hi : containsThread js i)
(Hcmpt : mem_compatible js m) b ofs
sh R (HJcanwrite : Concur.lock_at_least sh R (getThreadR Hi) b (Ptrofs.intval ofs)),
Mem.range_perm (Concur.juicyRestrict_locks (Concur.mem_compat_thread_max_cohere Hcmpt Hi)) b
(Ptrofs.intval ofs) (Ptrofs.intval ofs + LKSIZE) Cur Readable.