(** *Monotonicity (inject_incr)*)
Class Inject_Monotonic {A:Type}(R: meminj -> relation A):=
monotonicity: forall j j' a1 a2,
R j a1 a2 ->
inject_incr j j' ->
R j' a1 a2.
Ltac emonotonicity:=
try (unfold Inject_Monotonic);
eapply monotonicity.
Instance list_map_rel_monotonicity:
forall {A} {R: meminj -> relation A},
Inject_Monotonic R ->
Inject_Monotonic (fun j => list_map_rel (R j)).
Instance memval_inject_monotonic:
Inject_Monotonic memval_inject:=
memval_inject_incr.
Instance list_memval_inject_monotonic:
Inject_Monotonic list_memval_inject.
Instance inject_hi_low_monotonic:
Inject_Monotonic inject_hi_low.
Instance list_inject_hi_low_monotonic:
Inject_Monotonic list_inject_hi_low.
Instance list_inject_mem_effect_monotonic :
Inject_Monotonic Events.list_inject_mem_effect.
(** *strict_injection_evolution *)
Inductive injection_evolution_effect:
meminj -> meminj ->
Events.mem_effect -> Events.mem_effect -> Prop:=
|EffEvolWrite: forall b1 b2 ofs1 ofs2 mvs1 mvs2 j,
Events.inject_mem_effect
j
(common.Events.Write b1 ofs1 mvs1)
(common.Events.Write b2 ofs2 mvs2) ->
injection_evolution_effect
j j
(common.Events.Write b1 ofs1 mvs1)
(common.Events.Write b2 ofs2 mvs2)
|EffEvolAlloc: forall j j' (b1 b2:block) ofs1 ofs1',
j b1 = None -> (* Do we need this? *)
j' = (fun b => if eq_block b b1 then
Some (b2, 0%Z) else j b) ->
injection_evolution_effect
j j'
(common.Events.Alloc b1 ofs1 ofs1')
(common.Events.Alloc b2 ofs1 ofs1')
|EffEvolFree: forall  j ls1 ls2,
Events.inject_mem_effect j
(common.Events.Free ls1)
(common.Events.Free ls2) ->
injection_evolution_effect
j j
(common.Events.Free ls1)
(common.Events.Free ls2).
Inductive strict_injection_evolution:
meminj -> meminj ->
list Events.mem_effect -> list Events.mem_effect -> Prop:=
| EvolutionNil: forall j,
strict_injection_evolution j j nil nil
| EvolutionCons: forall j j' j'' ev1 ev2 ls1 ls2,
injection_evolution_effect j j' ev1 ev2 ->
strict_injection_evolution j' j'' ls1 ls2 ->
strict_injection_evolution
j j''
(ev1::ls1) (ev2::ls2).
(** *Lessdef*)
Instance list_map_rel_preorder {A} (R: relation A) {Pre: PreOrder R}:
PreOrder (list_map_rel R).
Inductive memval_lessdef: relation memval:=
| MvUndefLessDef : forall mv, memval_lessdef Undef mv
| MvBytelLessDef : forall b, memval_lessdef (Byte b) (Byte b)
| MvReflLessDef : forall v v' q n,
Val.lessdef v v' ->
memval_lessdef (Fragment v q n) (Fragment v' q n).
Instance memval_lessdef_preorder: PreOrder memval_lessdef.
Inductive effect_lessdef:
relation Events.mem_effect:=
| EvWriteLessDef:
forall b ofs mvs mvs',
(list_map_rel memval_lessdef) mvs mvs' ->
effect_lessdef (common.Events.Write b ofs mvs)
(common.Events.Write b ofs mvs')
| EvReflLessDef: forall eff,  effect_lessdef eff eff.
Instance effect_lessdef_preorder: PreOrder effect_lessdef.
Definition effects_lessdef:
relation (list Events.mem_effect):=
Events.list_map_rel effect_lessdef.
(** *Consecutive*)
Inductive consecutive: block -> list Events.mem_effect -> Prop:=
| consecutiveNil: forall nb,
consecutive nb nil
| consecutiveWrite: forall nb b ofs mvals lev',
(b <= nb)%positive -> (* needed?*)
consecutive nb lev' ->
consecutive nb ((common.Events.Write b ofs mvals):: lev')
| consecutiveAlloc: forall nb b ofs mvals lev',
(b = nb)%positive -> (* needed?*)
consecutive (Pos.succ nb) lev' ->
consecutive nb ((common.Events.Alloc b ofs mvals):: lev')
| consecutiveFree: forall nb lsbzz lev',
(Forall (fun x => (fst (fst x)) <= nb)%positive lsbzz) ->
consecutive nb lev' ->
consecutive nb ((common.Events.Free lsbzz):: lev').
(** *Section Diagrams *)
Record diagram
(nb: block) (j j': meminj)
(lev1 lev2: list Events.mem_effect):=
{ Dincr: inject_incr j j'
; Dinj: Events.list_inject_mem_effect j' lev1 lev2
; Dconsec: consecutive nb lev2
}.
Record principled_diagram
(nb: block) (j j': meminj)
(lev1 lev2: list Events.mem_effect):=
{ PDevol: strict_injection_evolution j j' lev1 lev2
; PDinj_str: Events.list_inject_mem_effect_strong j' lev1 lev2
; PDconsec: consecutive nb lev2
}.
Inductive principled_diagram':
block -> meminj -> meminj -> list Events.mem_effect -> Prop :=
|build_pd': forall  nb j j0 lev1 lev20,
principled_diagram nb j j0 lev1 lev20 ->
principled_diagram' nb j j0 lev1.
Inductive diagram':
block -> meminj -> meminj -> list Events.mem_effect -> Prop :=
|build_d': forall nb j j' lev1 lev2,
diagram nb j j' lev1 lev2 ->
diagram' nb j j' lev1.
Definition nextblock_eff (nb:block) (ev:mem_effect):=
match ev with
| Write _ _ _ => nb
| Alloc _ _ _ => Pos.succ nb
| Free _ => nb
end.

Lemma principled_diagram_correct':
forall (nb : block)
(j j' j0 : meminj)
(lev1: list Events.mem_effect),
principled_diagram' nb j j0 lev1 ->
diagram' nb j j' lev1 ->
inject_incr j0 j'.