(*Require Import ExtAxioms.*)
(*Will need : *)
Require Export Coq.Logic.FunctionalExtensionality.
Notation val_inject:= Val.inject.
(** * Structured Injections *)
Record SM_Injection :=
{ (** The blocks allocated by *this* module in the source language. *)
locBlocksSrc : block -> bool
(** The blocks allocated by *this* module in the target language. *)
; locBlocksTgt : block -> bool
(** The subset of local source blocks that have been made public. Must be mapped. *)
; pubBlocksSrc : block -> bool
(** The subset of local target blocks that have been made public. Contains the image of the public source blocks. *)
; pubBlocksTgt : block -> bool
(** Memory injection on blocks allocated by *this* module. *)
; local_of: meminj
(** The blocks allocated by *other* modules at the source level. *)
; extBlocksSrc: block -> bool
(** The blocks allocated by *other* modules at the target level. *)
; extBlocksTgt: block -> bool
(** The subset of extern source blocks that have been made public. Must be mapped. *)
; frgnBlocksSrc : block -> bool
(** The subset of extern source blocks that have been made public. Must be mapped. *)
; frgnBlocksTgt : block -> bool
(** Memory injection on blocks allocated by OTHER modules; the injection is not modified by coresteps, and is partitioned by frgnBlocksSrc/Tgt into foreign (leaked to this module) and unknown (non-leaked) components, where the former blocks are accessible by *this* module. This module behaves uniformly over block mentioned by frgnInj, and assumes that blocks in frgnInj remain mapped. Compilation of *this* module neither merges nor unmaps blocks from here, nor does it spill into them. *)
; extern_of: meminj }.
(** The four projections: *)
Definition unknown_of (mu: SM_Injection) : meminj :=
match mu with
Build_SM_Injection locBSrc locBTgt pSrc pTgt local extBSrc extBTgt fSrc fTgt extern =>
fun b => if locBSrc b then None else if fSrc b then None else extern b
end.
Definition foreign_of (mu: SM_Injection) : meminj :=
match mu with
Build_SM_Injection locBSrc locBTgt pSrc pTgt local extBSrc extBTgt fSrc fTgt extern =>
fun b => if fSrc b then extern b else None
end.
Definition pub_of (mu: SM_Injection) : meminj :=
match mu with
Build_SM_Injection locBSrc locBTgt pSrc pTgt local extBSrc extBTgt fSrc fTgt extern =>
fun b => if pSrc b then local b else None
end.
Definition priv_of (mu: SM_Injection) : meminj :=
match mu with
Build_SM_Injection locBSrc locBTgt pSrc pTgt local extBSrc extBTgt fSrc fTgt extern =>
fun b => if pSrc b then None else local b
end.
(** * Lemmas *)
Definition join (j k:meminj):meminj := fun b =>
match j b with
Some (b1, delta) => Some (b1,delta)
| None => k b
end.
Definition disjoint (j k:meminj):Prop :=
forall b, j b = None \/ k b = None.
Definition shared_of (mu: SM_Injection) : meminj :=
join (foreign_of mu) (pub_of mu).
Record SM_wd (mu:SM_Injection):Prop := {
disjoint_extern_local_Src: forall b, locBlocksSrc mu b = false \/ extBlocksSrc mu b = false;
disjoint_extern_local_Tgt: forall b, locBlocksTgt mu b = false \/ extBlocksTgt mu b = false;
local_DomRng: forall b1 b2 z, local_of mu b1 = Some(b2,z) ->
(locBlocksSrc mu b1 = true /\ locBlocksTgt mu b2 = true);
extern_DomRng: forall b1 b2 z, extern_of mu b1 = Some(b2,z) ->
(extBlocksSrc mu b1 = true /\ extBlocksTgt mu b2 = true);
pubSrcAx: forall b1, pubBlocksSrc mu b1 = true ->
exists b2 z, local_of mu b1 = Some(b2,z) /\
pubBlocksTgt mu b2 = true;
frgnSrcAx: forall b1, frgnBlocksSrc mu b1 = true ->
exists b2 z, extern_of mu b1 = Some(b2,z) /\
frgnBlocksTgt mu b2 = true;
pubBlocksLocalTgt: forall b, pubBlocksTgt mu b = true ->
locBlocksTgt mu b = true;
frgnBlocksExternTgt: forall b, frgnBlocksTgt mu b = true ->
extBlocksTgt mu b = true
}.
(*DOM/RNG: all blocks mentioned by a SM_Injection. Used for stating match_validblocks etc*)
Definition DomSrc (mu: SM_Injection) (b1: block): bool :=
locBlocksSrc mu b1 || extBlocksSrc mu b1.
Definition DOM (mu: SM_Injection) (b1: block): Prop := DomSrc mu b1 = true.
Definition DomTgt (mu: SM_Injection) (b2: block): bool :=
locBlocksTgt mu b2 || extBlocksTgt mu b2.
Definition RNG (mu: SM_Injection) (b2:block): Prop := DomTgt mu b2 = true.
(*we enforce pub_of mu = pub_of mu', via pubBlocksSrc/Tgt mu = pubBlocksSrc/Tgt mu': it suffices to reclassify leakage at at/afterExternal. This enables the proof of effect_corediagram_trans.diagram_injinj etc*)
Definition intern_incr (mu mu': SM_Injection): Prop :=
inject_incr (local_of mu) (local_of mu') /\
(extern_of mu = extern_of mu') /\
(forall b, locBlocksSrc mu b = true -> locBlocksSrc mu' b = true) /\
(forall b, locBlocksTgt mu b = true -> locBlocksTgt mu' b = true) /\
(pubBlocksSrc mu = pubBlocksSrc mu') /\
(pubBlocksTgt mu = pubBlocksTgt mu') /\
(frgnBlocksSrc mu = frgnBlocksSrc mu') /\
(frgnBlocksTgt mu = frgnBlocksTgt mu') /\
(extBlocksSrc mu = extBlocksSrc mu') /\
(extBlocksTgt mu = extBlocksTgt mu').
Definition extern_incr (mu mu': SM_Injection): Prop :=
inject_incr (extern_of mu) (extern_of mu') /\
(local_of mu = local_of mu') /\
(forall b, extBlocksSrc mu b = true -> extBlocksSrc mu' b = true) /\
(forall b, extBlocksTgt mu b = true -> extBlocksTgt mu' b = true) /\
(locBlocksSrc mu = locBlocksSrc mu') /\
(locBlocksTgt mu = locBlocksTgt mu') /\
(pubBlocksSrc mu = pubBlocksSrc mu') /\
(pubBlocksTgt mu = pubBlocksTgt mu') /\
(frgnBlocksSrc mu = frgnBlocksSrc mu') /\
(frgnBlocksTgt mu = frgnBlocksTgt mu').
(*The join of all four components - useful for stating match_state conditions*)
Definition as_inj (mu: SM_Injection) : meminj :=
join (extern_of mu) (local_of mu).
Definition locvisible_of mu := join (foreign_of mu) (local_of mu) .
Definition extvisible_of mu := join (extern_of mu) (pub_of mu).
(*an inject_separated-like property wrt DOM/RNG instead of wrt validity in suitable memories*)
Definition sm_inject_separated (mu mu' : SM_Injection) (m1 m2:mem):Prop :=
(forall b1 b2 d, as_inj mu b1 = None -> as_inj mu' b1 = Some(b2,d) ->
(DomSrc mu b1 = false /\ DomTgt mu b2 = false)) /\
(forall b1, DomSrc mu b1 = false -> DomSrc mu' b1 = true -> ~Mem.valid_block m1 b1) /\
(forall b2, DomTgt mu b2 = false -> DomTgt mu' b2 = true -> ~Mem.valid_block m2 b2).
Definition freshloc m m' b := andb (valid_block_dec m' b) (negb (valid_block_dec m b)).
(*Expresses that the evolution soundly and completely tracks what happened during related coresteps. sm_locally_allocated is typically be used in conjunction with intern_incr, so extern mu = extern mu', and equalities (pSrc,pTgt,fSrc,fTgt)=(pSrc',pTgt',fSrc',fTgt') hold, too.*)
Definition sm_locally_allocated (mu mu' : SM_Injection) (m1 m2 m1' m2':mem):Prop :=
match mu, mu' with
Build_SM_Injection locBSrc locBTgt pSrc pTgt local extBSrc extBTgt fSrc fTgt extern,
Build_SM_Injection locBSrc' locBTgt' pSrc' pTgt' local' extBSrc' extBTgt' fSrc' fTgt' extern'
=>    locBSrc' = (fun b => orb (locBSrc b) (freshloc m1 m1' b))
/\ locBTgt' = (fun b => orb (locBTgt b) (freshloc m2 m2' b))
/\ extBSrc' = extBSrc
/\ extBTgt' = extBTgt
end.

Lemma sm_locally_allocatedChar: forall mu mu' m1 m2 m1' m2',
sm_locally_allocated mu mu' m1 m2 m1' m2' <->
(    DomSrc mu' = (fun b => orb (DomSrc mu b) (freshloc m1 m1' b))
/\ DomTgt mu' = (fun b => orb (DomTgt mu b) (freshloc m2 m2' b))
/\ locBlocksSrc mu' = (fun b => orb (locBlocksSrc mu b) (freshloc m1 m1' b))
/\ locBlocksTgt mu' = (fun b => orb (locBlocksTgt mu b) (freshloc m2 m2' b))
/\ extBlocksSrc mu' = extBlocksSrc mu
/\ extBlocksTgt mu' = extBlocksTgt mu).