Section JuicyMachineShell.
Context {Sem: Semantics}.
Notation C:= (semC).
Notation G:= (semG).
Notation tid:= nat.
Notation lockMap:= (AMap.t lock_info).
Notation SSome x:= (Some (Some x)).
Notation SNone:= (Some None).
(** Memories*)
Definition richMem: Type:= juicy_mem.
Definition dryMem: richMem -> mem:= m_dry.
(** Environment and Threadwise semantics *)
(* This all comes from the SEM. *)
(*Parameter G : Type. Parameter Sem : CoreSemantics G code mem.*)
Notation the_sem := (csem (event_semantics.msem semSem)).
(*thread pool*)
Existing Instance OrdinalThreadPool.
Notation thread_pool := (@ThreadPool.t _ _ OrdinalThreadPool).
(** Machine Variables*)
Definition lp_id : tid:= (0)%nat. (*lock pool thread id*)
(** Invariants*)
(** The state respects the memory*)
Definition access_cohere' m phi:= forall loc,
Mem.perm_order'' (max_access_at m loc) (perm_of_res (phi @ loc)).
(* This is similar to the coherence of juicy memories, * * but for entire machines. It is slighly weaker in one way: * - acc_coh is looser and only talks about maxcoh. * - alse acc_coh  might me redundant with max_coh IDK... x*)
Record mem_cohere' m phi :=
{ cont_coh: contents_cohere m phi;
(*acc_coh: access_cohere m phi;*)
(*acc_coh: access_cohere' m phi;*)
max_coh: max_access_cohere m phi;
all_coh: alloc_cohere m phi
}.
Definition mem_thcohere (tp : thread_pool) m :=
forall tid (cnt: containsThread tp tid), mem_cohere' m (getThreadR cnt).
Definition mem_lock_cohere (ls:lockMap) m:=
forall loc rm, AMap.find loc ls = SSome rm -> mem_cohere' m rm.
(*Join juice from all threads *)
Definition getThreadsR (tp : thread_pool):=
map (perm_maps tp) (enums_equality.enum (num_threads tp)).
Fixpoint join_list (ls: seq.seq res) r:=
if ls is phi::ls' then exists r', join phi r' r /\ join_list ls' r' else
app_pred emp r.  (*Or is is just [amp r]?*)
Definition join_threads (tp : thread_pool) r:= join_list (getThreadsR tp) r.
(*Join juice from all locks*)
Fixpoint join_list' (ls: seq.seq (option res)) (r:option res):=
if ls is phi::ls' then exists (r':option res),
@join _ (@Join_lower res _) phi r' r /\ join_list' ls' r' else r=None.
Definition join_locks tp r:= join_list' (map snd (AMap.elements (lset tp))) r.
(*Join all the juices*)
Inductive join_all: thread_pool -> res -> Prop:=
AllJuice tp r0 r1 r:
join_threads tp r0 ->
join_locks tp r1 ->
join (Some r0) r1 (Some r) ->
join_all tp r.
Definition juicyLocks_in_lockSet (lset : lockMap) (juice: rmap):=
forall loc,
(forall i, 0 <= i < LKSIZE -> exists sh psh P, juice @ (fst loc, snd loc + i) = YES sh psh (LK LKSIZE i) P)  ->
AMap.find loc lset.
(* I removed the NO case for two reasons: * - To ensure that lset is "valid" (lr_valid), it needs inherit it from the rmap * - there was no real reason to have a NO other than speculation of the future. *)
Definition lockSet_in_juicyLocks (lset : lockMap) (juice: rmap):=
forall loc, AMap.find loc lset ->
(exists sh,
forall i, 0 <= i < LKSIZE -> exists sh' psh' P, join_sub sh sh' /\ juice @ (fst loc, snd loc + i) = YES sh' psh' (LK LKSIZE i) P).
Definition lockSet_in_juicyLocks' (lset : lockMap) (juice: rmap):=
forall loc, AMap.find loc lset ->
Mem.perm_order'' (Some Nonempty) (perm_of_res (juice @ loc)).
Definition lockSet_Writable (lset : lockMap) m :=
forall b ofs, AMap.find (b,ofs) lset ->
forall ofs0, Intv.In ofs0 (ofs, ofs + LKSIZE)%Z ->
Mem.perm_order'' ((Mem.mem_access m)!! b ofs0 Max) (Some Writable) .
(*This definition makes no sense. In fact if there is at least one lock in rmap, *then the locks_writable is false (because perm_of_res(LK) = Some Nonempty). *)
Definition locks_writable (juice: rmap):=
forall loc sh psh P z i, juice @ loc = YES sh psh (LK z i) P  ->
Mem.perm_order'' (perm_of_res (juice @ loc)) (Some Writable).
Record mem_compatible_with' (tp : thread_pool) m all_juice : Prop :=
{   juice_join : join_all tp all_juice
; all_cohere : mem_cohere' m all_juice
; loc_writable : lockSet_Writable (lockGuts tp) m
; jloc_in_set : juicyLocks_in_lockSet (lockGuts tp) all_juice
; lset_in_juice: lockSet_in_juicyLocks  (lockGuts tp) all_juice
}.
Definition mem_compatible_with := mem_compatible_with'.
Definition mem_compatible tp m := ex (mem_compatible_with tp m).

Lemma compat_lr_valid: forall js m,
mem_compatible js m ->
lr_valid (lockRes js).