(*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.
(*in extern_incr steps, sm_inject_separated_intern_MYB is not needed/trivial, since locBlocksSrc mu b = locBlocksSrc mu' b and locBlocksTgt mu b = locBlocksTgt mu' b*)
Definition sm_valid (mu : SM_Injection) (m1 m2: mem) :=
(forall b1, DOM mu b1 -> Mem.valid_block m1 b1)
/\ (forall b2, RNG mu b2 -> Mem.valid_block m2 b2).
Definition smvalid_src (mu : SM_Injection) m1 :=
forall b1, DOM mu b1 -> Memory.Mem.valid_block m1 b1.
Definition smvalid_tgt (mu : SM_Injection) m2 :=
forall b2, RNG mu b2 -> Memory.Mem.valid_block m2 b2.
Definition sharedSrc mu b :=
match shared_of mu b
with Some _ => true | None => false
end.
Definition sharedTgt mu b := orb (frgnBlocksTgt mu b) (pubBlocksTgt mu b).
(*Construction used in make_initial_core: put incoming injection into foreign/unknown component as specified, initialize local_of, locBlocksSrc/Tgt, and pubBlocksSrc/Tgt as empty*)
Definition initial_SM (extS extT frgnS frgnT: block->bool)
(extern:meminj): SM_Injection :=
Build_SM_Injection
(*locBlocksSrc/Tgt:*) (fun b => false) (fun b => false) (*pubBlocksSrc/Tgt:*)(fun b => false) (fun b => false) (*local:*)(fun b => None) (*extBlocksSrc/Tgt:*) extS extT (*frgnBlocksSrc/Tgt:*) frgnS frgnT extern.  Lemma initial_SM_wd: forall extS extT frgnS frgnT extern (EXT: forall b1 b2 d, extern b1 =Some(b2,d) -> extS b1 = true /\ extT b2 = true) (F: forall b1, frgnS b1 = true -> exists b2 z, extern b1 = Some (b2, z) /\ frgnT b2 = true) (FS: forall b, frgnS b = true -> extS b = true) (FT: forall b, frgnT b = true -> extT b = true), SM_wd (initial_SM extS extT frgnS frgnT extern).  Lemma initial_SM_as_inj: forall extS extT frgnS frgnT j, as_inj (initial_SM extS extT frgnS frgnT j) = j.  Definition restrict (j: meminj) (X:block -> bool) : meminj := fun b => if X b then j b else None.  Lemma restrictD_Some: forall j X b1 b2 d (R:restrict j X b1 = Some(b2,d)), j b1 = Some(b2,d) /\ X b1 = true. Lemma restrictI_Some: forall j X b b2 d (J:j b = Some(b2,d)) (Hb: X b = true), restrict j X b = Some(b2,d). Lemma restrictD_None: forall j X b1 b2 d (R:restrict j X b1 = None) (J: j b1 = Some(b2,d)), X b1 = false. Lemma restrictD_None': forall j X b1 (R:restrict j X b1 = None), j b1 = None \/ (exists b2 d, j b1 =Some(b2,d) /\ X b1 = false). Lemma restrictI_None: forall j X b (Hb: j b = None \/ X b = false), restrict j X b = None.  Lemma join_restrict: forall j k X, join (restrict j X) (restrict k X) = restrict (join j k) X.  Lemma restrict_outside: forall j X (HX: forall b1 b2 d, j b1 = Some(b2, d) -> X b1 = true), restrict j X = j.  Lemma restrict_incr: forall j X, inject_incr (restrict j X) j.  Lemma restrict_nest: forall j X Y (HXY: forall b, Y b = true -> X b = true), restrict (restrict j X) Y = restrict j Y. Lemma restrict_nest': forall j X Y (HXY: forall b, Y b = true -> X b = true), restrict (restrict j Y) X = restrict j Y.  Lemma val_inject_restrictD: forall j v v' X (V: val_inject (restrict j X) v v'), val_inject j v v'.  Lemma forall_vals_inject_restrictD: forall j vals1 vals2 X (Inj : Forall2 (val_inject (restrict j X)) vals1 vals2), Forall2 (val_inject j) vals1 vals2.  Definition reestablish (mu0 mu: SM_Injection): SM_Injection := match mu0, mu with Build_SM_Injection locBSrc0 locBTgt0 pSrc0 pTgt0 local0 extBSrc0 extBTgt0 fSrc0 fTgt0 extern0, Build_SM_Injection locBSrc locBTgt pSrc pTgt local extBSrc extBTgt fSrc fTgt extern => Build_SM_Injection locBSrc0 locBTgt0 pSrc0 pTgt0 local0 (fun b => if locBSrc0 b then false else locBSrc b || extBSrc b) (fun b => if locBTgt0 b then false else locBTgt b || extBTgt b) fSrc0 fTgt0 (*We have not YET learned about additional blocks - that's done by replace_externs in AfterEtxernal!*)
(fun b => if locBSrc0 b then None else join extern local b)
end.

Lemma reestablish_sm_valid: forall mu0 mu (WD0:SM_wd mu0) (WD:SM_wd mu)
(LocSrc: forall b, locBlocksSrc mu0 b = true -> DomSrc mu b = true)
(DomTgt: forall b, locBlocksTgt mu0 b = true -> DomTgt mu b = true)
m1 m2 (VAL: sm_valid mu m1 m2),
sm_valid (reestablish mu0 mu) m1 m2.