(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*          Sandrine Blazy, ENSIIE and INRIA Paris-Rocquencourt        *)
(*          with contributions from Andrew Appel, Rob Dockins,         *)
(*          and Gordon Stewart (Princeton University)                  *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 2 of the License, or  *)
(*  (at your option) any later version.  This file is also distributed *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

(** This file develops the memory model that is used in the dynamic
  semantics of all the languages used in the compiler.
  It defines a type [mem] of memory states, the following 4 basic
  operations over memory states, and their properties:
- [load]: read a memory chunk at a given address;
- [store]: store a memory chunk at a given address;
- [alloc]: allocate a fresh memory block;
- [free]: invalidate a memory block.
*)

Require Import Zwf.
Require Import Axioms.
Require Import Coqlib.
Require Intv.
Require Import Maps.
Require Archi.
Require Import AST.
Require Import Integers.
Require Import Floats.
Require Import Values.
Require Export Memdata.
Require Export Memtype.

(* To avoid useless definitions of inductors in extracted code. *)
Local Unset Elimination Schemes.
Local Unset Case Analysis Schemes.

Local Notation "a # b" := (PMap.get b a) (at level 1).

Module Mem <: MEM.

Definition perm_order' (po: option permission) (p: permission) :=
  match po with
  | Some p' => perm_order p' p
  | None => False
 end.

Definition perm_order'' (po1 po2: option permission) :=
  match po1, po2 with
  | Some p1, Some p2 => perm_order p1 p2
  | _, None => True
  | None, Some _ => False
 end.

Record mem' : Type := mkmem {
  mem_contents: PMap.t (ZMap.t memval);  (**r [block -> offset -> memval] *)
  mem_access: PMap.t (Z -> perm_kind -> option permission);
                                         (**r [block -> offset -> kind -> option permission] *)
  nextblock: block;
  access_max:
    forall b ofs, perm_order'' (mem_access#b ofs Max) (mem_access#b ofs Cur);
  nextblock_noaccess:
    forall b ofs k, ~(Plt b nextblock) -> mem_access#b ofs k = None;
  contents_default:
    forall b, fst mem_contents#b = Undef
}.

Definition mem := mem'.

Lemma mkmem_ext:
 forall cont1 cont2 acc1 acc2 next1 next2 a1 a2 b1 b2 c1 c2,
  cont1=cont2 -> acc1=acc2 -> next1=next2 ->
  mkmem cont1 acc1 next1 a1 b1 c1 = mkmem cont2 acc2 next2 a2 b2 c2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. subst. f_equal; apply proof_irr.
Qed.

(** * Validity of blocks and accesses *)

(** A block address is valid if it was previously allocated. It remains valid
  even after being freed. *)

Definition valid_block (m: mem) (b: block) := Plt b (nextblock m).

Theorem valid_not_valid_diff:
  forall m b b', valid_block m b -> ~(valid_block m b') -> b <> b'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros; red; intros. subst b'. contradiction.
Qed.

Local Hint Resolve valid_not_valid_diff: mem.

(** Permissions *)

Definition perm (m: mem) (b: block) (ofs: Z) (k: perm_kind) (p: permission) : Prop :=
   perm_order' (m.(mem_access)#b ofs k) p.

Theorem perm_implies:
  forall m b ofs k p1 p2, perm m b ofs k p1 -> perm_order p1 p2 -> perm m b ofs k p2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold perm, perm_order'; intros.
(* Goal: match @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k with | Some p' => perm_order p' p2 | None => False end *)
  destruct (m.(mem_access)#b ofs k); auto.
(* Goal: perm_order p1 p *)
(* Goal: forall (m : mem) (b : block) (ofs : Z) (p : permission) (_ : perm m b ofs Cur p), perm m b ofs Max p *)
  eapply perm_order_trans; eauto.
Qed.

Local Hint Resolve perm_implies: mem.

Theorem perm_cur_max:
  forall m b ofs p, perm m b ofs Cur p -> perm m b ofs Max p.
Proof.
  assert (forall po1 po2 p,
          perm_order' po2 p -> perm_order'' po1 po2 -> perm_order' po1 p).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold perm_order', perm_order''. intros.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  destruct po2; try contradiction.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  destruct po1; try contradiction.
(* Goal: perm_order p1 p *)
(* Goal: forall (m : mem) (b : block) (ofs : Z) (p : permission) (_ : perm m b ofs Cur p), perm m b ofs Max p *)
  eapply perm_order_trans; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold perm; intros.
(* Goal: perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs Max) p *)
  generalize (access_max m b ofs). eauto.
Qed.

Theorem perm_cur:
  forall m b ofs k p, perm m b ofs Cur p -> perm m b ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct k; auto. apply perm_cur_max. auto.
Qed.

Theorem perm_max:
  forall m b ofs k p, perm m b ofs k p -> perm m b ofs Max p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct k; auto. apply perm_cur_max. auto.
Qed.

Local Hint Resolve perm_cur perm_max: mem.

Theorem perm_valid_block:
  forall m b ofs k p, perm m b ofs k p -> valid_block m b.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold perm; intros.
(* Goal: valid_block m b *)
  destruct (plt b m.(nextblock)).
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: valid_block m b *)
  assert (m.(mem_access)#b ofs k = None).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply nextblock_noaccess; eauto.
(* Goal: valid_block m b *)
  rewrite H0 in H.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  contradiction.
Qed.

Local Hint Resolve perm_valid_block: mem.

Remark perm_order_dec:
  forall p1 p2, {perm_order p1 p2} + {~perm_order p1 p2}.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct p1; destruct p2; (left; constructor) || (right; intro PO; inversion PO).
Defined.

Remark perm_order'_dec:
  forall op p, {perm_order' op p} + {~perm_order' op p}.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct op; unfold perm_order'.
(* Goal: sumbool (perm_order p0 p) (not (perm_order p0 p)) *)
(* Goal: sumbool False (not False) *)
  apply perm_order_dec.
(* Goal: Ple (nextblock m) (nextblock m') *)
  right; tauto.
Defined.

Theorem perm_dec:
  forall m b ofs k p, {perm m b ofs k p} + {~ perm m b ofs k p}.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold perm; intros.
(* Goal: sumbool (perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p) (not (perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p)) *)
  apply perm_order'_dec.
Defined.

Definition range_perm (m: mem) (b: block) (lo hi: Z) (k: perm_kind) (p: permission) : Prop :=
  forall ofs, lo <= ofs < hi -> perm m b ofs k p.

Theorem range_perm_implies:
  forall m b lo hi k p1 p2,
  range_perm m b lo hi k p1 -> perm_order p1 p2 -> range_perm m b lo hi k p2.
Proof.
(* Goal: forall (m : mem) (b : block) (lo hi : Z) (k : perm_kind) (p : permission) (_ : range_perm m b lo hi k p), range_perm m b lo hi Max p *)
  unfold range_perm; intros; eauto with mem.
Qed.

Theorem range_perm_cur:
  forall m b lo hi k p,
  range_perm m b lo hi Cur p -> range_perm m b lo hi k p.
Proof.
(* Goal: forall (m : mem) (b : block) (lo hi : Z) (k : perm_kind) (p : permission) (_ : range_perm m b lo hi k p), range_perm m b lo hi Max p *)
  unfold range_perm; intros; eauto with mem.
Qed.

Theorem range_perm_max:
  forall m b lo hi k p,
  range_perm m b lo hi k p -> range_perm m b lo hi Max p.
Proof.
(* Goal: forall (m : mem) (b : block) (lo hi : Z) (k : perm_kind) (p : permission) (_ : range_perm m b lo hi k p), range_perm m b lo hi Max p *)
  unfold range_perm; intros; eauto with mem.
Qed.

Local Hint Resolve range_perm_implies range_perm_cur range_perm_max: mem.

Lemma range_perm_dec:
  forall m b lo hi k p, {range_perm m b lo hi k p} + {~ range_perm m b lo hi k p}.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: sumbool (range_perm m b lo hi k p) (not (range_perm m b lo hi k p)) *)
  induction lo using (well_founded_induction_type (Zwf_up_well_founded hi)).
(* Goal: or (not (@eq block b bf)) (or (Z.lt ofs0 lo) (Z.le hi ofs0)) *)
  destruct (zlt lo hi).
(* Goal: sumbool (range_perm m b lo hi k p) (not (range_perm m b lo hi k p)) *)
(* Goal: sumbool (range_perm m b lo hi k p) (not (range_perm m b lo hi k p)) *)
  destruct (perm_dec m b lo k p).
(* Goal: sumbool (range_perm m b lo hi k p) (not (range_perm m b lo hi k p)) *)
(* Goal: sumbool (range_perm m b lo hi k p) (not (range_perm m b lo hi k p)) *)
(* Goal: sumbool (range_perm m b lo hi k p) (not (range_perm m b lo hi k p)) *)
  destruct (H (lo + 1)). red. omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  left; red; intros. destruct (zeq lo ofs). congruence. apply r. omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  right; red; intros. elim n. red; intros; apply H0; omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  right; red; intros. elim n. apply H0. omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  left; red; intros. omegaContradiction.
Defined.

(** [valid_access m chunk b ofs p] holds if a memory access
    of the given chunk is possible in [m] at address [b, ofs]
    with current permissions [p].
    This means:
- The range of bytes accessed all have current permission [p].
- The offset [ofs] is aligned.
*)

Definition valid_access (m: mem) (chunk: memory_chunk) (b: block) (ofs: Z) (p: permission): Prop :=
  range_perm m b ofs (ofs + size_chunk chunk) Cur p
  /\ (align_chunk chunk | ofs).

Theorem valid_access_implies:
  forall m chunk b ofs p1 p2,
  valid_access m chunk b ofs p1 -> perm_order p1 p2 ->
  valid_access m chunk b ofs p2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor; eauto with mem.
Qed.

Theorem valid_access_freeable_any:
  forall m chunk b ofs p,
  valid_access m chunk b ofs Freeable ->
  valid_access m chunk b ofs p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply valid_access_implies; eauto. constructor.
Qed.

Local Hint Resolve valid_access_implies: mem.

Theorem valid_access_valid_block:
  forall m chunk b ofs,
  valid_access m chunk b ofs Nonempty ->
  valid_block m b.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H.
(* Goal: valid_block m b *)
  assert (perm m b ofs Cur Nonempty).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
    apply H. generalize (size_chunk_pos chunk). omega.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
Qed.

Local Hint Resolve valid_access_valid_block: mem.

Lemma valid_access_perm:
  forall m chunk b ofs k p,
  valid_access m chunk b ofs p ->
  perm m b ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H. apply perm_cur. apply H. generalize (size_chunk_pos chunk). omega.
Qed.

Lemma valid_access_compat:
  forall m chunk1 chunk2 b ofs p,
  size_chunk chunk1 = size_chunk chunk2 ->
  align_chunk chunk2 <= align_chunk chunk1 ->
  valid_access m chunk1 b ofs p->
  valid_access m chunk2 b ofs p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H1. rewrite H in H2. constructor; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply Z.divide_trans; eauto. eapply align_le_divides; eauto.
Qed.

Lemma valid_access_dec:
  forall m chunk b ofs p,
  {valid_access m chunk b ofs p} + {~ valid_access m chunk b ofs p}.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: sumbool (valid_access m chunk b ofs p) (not (valid_access m chunk b ofs p)) *)
  destruct (range_perm_dec m b ofs (ofs + size_chunk chunk) Cur p).
(* Goal: sumbool (valid_access m chunk b ofs p) (not (valid_access m chunk b ofs p)) *)
(* Goal: sumbool (valid_access m chunk b ofs p) (not (valid_access m chunk b ofs p)) *)
  destruct (Zdivide_dec (align_chunk chunk) ofs (align_chunk_pos chunk)).
(* Goal: Ple (nextblock m) (nextblock m') *)
  left; constructor; auto.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  right; red; intro V; inv V; contradiction.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  right; red; intro V; inv V; contradiction.
Defined.

(** [valid_pointer m b ofs] returns [true] if the address [b, ofs]
  is nonempty in [m] and [false] if it is empty. *)
Definition valid_pointer (m: mem) (b: block) (ofs: Z): bool :=
  perm_dec m b ofs Cur Nonempty.

Theorem valid_pointer_nonempty_perm:
  forall m b ofs,
  valid_pointer m b ofs = true <-> perm m b ofs Cur Nonempty.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold valid_pointer.
  destruct (perm_dec m b ofs Cur Nonempty); simpl;
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  intuition congruence.
Qed.

Theorem valid_pointer_valid_access:
  forall m b ofs,
  valid_pointer m b ofs = true <-> valid_access m Mint8unsigned b ofs Nonempty.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite valid_pointer_nonempty_perm.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  split; intros.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  split. simpl; red; intros. replace ofs0 with ofs by omega. auto.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  simpl. apply Z.divide_1_l.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  destruct H. apply H. simpl. omega.
Qed.

(** C allows pointers one past the last element of an array.  These are not
  valid according to the previously defined [valid_pointer]. The property
  [weak_valid_pointer m b ofs] holds if address [b, ofs] is a valid pointer
  in [m], or a pointer one past a valid block in [m].  *)

Definition weak_valid_pointer (m: mem) (b: block) (ofs: Z) :=
  valid_pointer m b ofs || valid_pointer m b (ofs - 1).

Lemma weak_valid_pointer_spec:
  forall m b ofs,
  weak_valid_pointer m b ofs = true <->
    valid_pointer m b ofs = true \/ valid_pointer m b (ofs - 1) = true.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold weak_valid_pointer. now rewrite orb_true_iff.
Qed.
Lemma valid_pointer_implies:
  forall m b ofs,
  valid_pointer m b ofs = true -> weak_valid_pointer m b ofs = true.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. apply weak_valid_pointer_spec. auto.
Qed.

(** * Operations over memory stores *)

(** The initial store *)

Program Definition empty: mem :=
  mkmem (PMap.init (ZMap.init Undef))
        (PMap.init (fun ofs k => None))
        1%positive _ _ _.
Next Obligation.
(* Goal: Ple (nextblock m) (nextblock m') *)
  repeat rewrite PMap.gi. red; auto.
Qed.
Next Obligation.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite PMap.gi. auto.
Qed.
Next Obligation.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite PMap.gi. auto.
Qed.

(** Allocation of a fresh block with the given bounds.  Return an updated
  memory state and the address of the fresh block, which initially contains
  undefined cells.  Note that allocation never fails: we model an
  infinite memory. *)

Program Definition alloc (m: mem) (lo hi: Z) :=
  (mkmem (PMap.set m.(nextblock)
                   (ZMap.init Undef)
                   m.(mem_contents))
         (PMap.set m.(nextblock)
                   (fun ofs k => if zle lo ofs && zlt ofs hi then Some Freeable else None)
                   m.(mem_access))
         (Pos.succ m.(nextblock))
         _ _ _,
   m.(nextblock)).
Next Obligation.
(* Goal: perm_order'' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) b (fun (ofs : Z) (k : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (mem_access m)) ofs Max) (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) b (fun (ofs : Z) (k : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (mem_access m)) ofs Cur) *)
  repeat rewrite PMap.gsspec. destruct (peq b (nextblock m)).
(* Goal: or (not (@eq block b2 b)) (or (Z.lt (Z.add ofs delta) lo) (Z.le hi (Z.add ofs delta))) *)
(* Goal: mem_inj f m1 m2' *)
  subst b. destruct (zle lo ofs && zlt ofs hi); red; auto with mem.
(* Goal: perm_order'' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (mem_access m) ofs Max) (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (mem_access m) ofs Cur) *)
  apply access_max.
Qed.
Next Obligation.
(* Goal: @eq memval (@fst memval (PTree.t memval) (if peq b (nextblock m) then @ZMap.init memval Undef else @PMap.get (prod memval (PTree.t memval)) b (mem_contents m))) Undef *)
  rewrite PMap.gsspec. destruct (peq b (nextblock m)).
(* Goal: or (not (@eq block b2 b)) (or (Z.lt (Z.add ofs delta) lo) (Z.le hi (Z.add ofs delta))) *)
(* Goal: mem_inj f m1 m2' *)
  subst b. elim H. apply Plt_succ.
(* Goal: @eq (option permission) (if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission Freeable else @None permission) (@None permission) *)
(* Goal: @eq (option permission) (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (@None permission) *)
  apply nextblock_noaccess. red; intros; elim H.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply Plt_trans_succ; auto.
Qed.
Next Obligation.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite PMap.gsspec. destruct (peq b (nextblock m)). auto. apply contents_default.
Qed.

(** Freeing a block between the given bounds.
  Return the updated memory state where the given range of the given block
  has been invalidated: future reads and writes to this
  range will fail.  Requires freeable permission on the given range. *)

Program Definition unchecked_free (m: mem) (b: block) (lo hi: Z): mem :=
  mkmem m.(mem_contents)
        (PMap.set b
                (fun ofs k => if zle lo ofs && zlt ofs hi then None else m.(mem_access)#b ofs k)
                m.(mem_access))
        m.(nextblock) _ _ _.
Next Obligation.
(* Goal: perm_order'' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) b (fun (ofs : Z) (k : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (mem_access m)) ofs Max) (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) b (fun (ofs : Z) (k : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (mem_access m)) ofs Cur) *)
  repeat rewrite PMap.gsspec. destruct (peq b0 b).
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zle lo ofs && zlt ofs hi). red; auto. apply access_max.
(* Goal: perm_order'' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (mem_access m) ofs Max) (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (mem_access m) ofs Cur) *)
  apply access_max.
Qed.
Next Obligation.
(* Goal: or (and (@eq val v (Val.load_result chunk' v0)) (and (compat_pointer_chunks chunk chunk') (and (@eq block b b) (@eq Z ofs' ofs)))) (or (not (@eq block b b)) (or (Z.le (Z.add ofs' (size_chunk chunk')) ofs) (Z.le (Z.add ofs (size_chunk chunk)) ofs'))) *)
  repeat rewrite PMap.gsspec. destruct (peq b0 b). subst.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zle lo ofs && zlt ofs hi). auto. apply nextblock_noaccess; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply nextblock_noaccess; auto.
Qed.
Next Obligation.
(* Goal: @eq memval (@fst memval (PTree.t memval) (@PMap.get (ZMap.t memval) b0 (mem_contents m))) Undef *)
  apply contents_default.
Qed.

Definition free (m: mem) (b: block) (lo hi: Z): option mem :=
  if range_perm_dec m b lo hi Cur Freeable
  then Some(unchecked_free m b lo hi)
  else None.

Fixpoint free_list (m: mem) (l: list (block * Z * Z)) {struct l}: option mem :=
  match l with
  | nil => Some m
  | (b, lo, hi) :: l' =>
      match free m b lo hi with
      | None => None
      | Some m' => free_list m' l'
      end
  end.

(** Memory reads. *)

(** Reading N adjacent bytes in a block content. *)

Fixpoint getN (n: nat) (p: Z) (c: ZMap.t memval) {struct n}: list memval :=
  match n with
  | O => nil
  | S n' => ZMap.get p c :: getN n' (p + 1) c
  end.

(** [load chunk m b ofs] perform a read in memory state [m], at address
  [b] and offset [ofs].  It returns the value of the memory chunk
  at that address.  [None] is returned if the accessed bytes
  are not readable. *)

Definition load (chunk: memory_chunk) (m: mem) (b: block) (ofs: Z): option val :=
  if valid_access_dec m chunk b ofs Readable
  then Some(decode_val chunk (getN (size_chunk_nat chunk) ofs (m.(mem_contents)#b)))
  else None.

(** [loadv chunk m addr] is similar, but the address and offset are given
  as a single value [addr], which must be a pointer value. *)

Definition loadv (chunk: memory_chunk) (m: mem) (addr: val) : option val :=
  match addr with
  | Vptr b ofs => load chunk m b (Ptrofs.unsigned ofs)
  | _ => None
  end.

(** [loadbytes m b ofs n] reads [n] consecutive bytes starting at
  location [(b, ofs)].  Returns [None] if the accessed locations are
  not readable. *)

Definition loadbytes (m: mem) (b: block) (ofs n: Z): option (list memval) :=
  if range_perm_dec m b ofs (ofs + n) Cur Readable
  then Some (getN (nat_of_Z n) ofs (m.(mem_contents)#b))
  else None.

(** Memory stores. *)

(** Writing N adjacent bytes in a block content. *)

Fixpoint setN (vl: list memval) (p: Z) (c: ZMap.t memval) {struct vl}: ZMap.t memval :=
  match vl with
  | nil => c
  | v :: vl' => setN vl' (p + 1) (ZMap.set p v c)
  end.

Remark setN_other:
  forall vl c p q,
  (forall r, p <= r < p + Z.of_nat (length vl) -> r <> q) ->
  ZMap.get q (setN vl p c) = ZMap.get q c.
Proof.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  induction vl; intros; simpl.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: @In memval (@ZMap.get memval q (setN (@cons memval a vl) p c)) (@cons memval a vl) *)
  simpl length in H. rewrite Nat2Z.inj_succ in H.
(* Goal: @eq memval (@ZMap.get memval q (setN vl (Z.add p (Zpos xH)) (@ZMap.set memval p a c))) (@ZMap.get memval q c) *)
  transitivity (ZMap.get q (ZMap.set p a c)).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  apply IHvl. intros. apply H. omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  apply ZMap.gso. apply not_eq_sym. apply H. omega.
Qed.

Remark setN_outside:
  forall vl c p q,
  q < p \/ q >= p + Z.of_nat (length vl) ->
  ZMap.get q (setN vl p c) = ZMap.get q c.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. apply setN_other.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. omega.
Qed.

Remark getN_setN_same:
  forall vl p c,
  getN (length vl) p (setN vl p c) = vl.
Proof.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  induction vl; intros; simpl.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: @eq (prod block Z) (@pair block Z y (Z.add delta Z0)) (@pair block Z y delta) *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  decEq.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  rewrite setN_outside. apply ZMap.gss. omega.
(* Goal: @In memval (@ZMap.get memval q (setN vl (Z.add p (Zpos xH)) (@ZMap.set memval p a c))) vl *)
  apply IHvl.
Qed.

Remark getN_exten:
  forall c1 c2 n p,
  (forall i, p <= i < p + Z.of_nat n -> ZMap.get i c1 = ZMap.get i c2) ->
  getN n p c1 = getN n p c2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  induction n; intros. auto. rewrite Nat2Z.inj_succ in H. simpl. decEq.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  apply H. omega. apply IHn. intros. apply H. omega.
Qed.

Remark getN_setN_disjoint:
  forall vl q c n p,
  Intv.disjoint (p, p + Z.of_nat n) (q, q + Z.of_nat (length vl)) ->
  getN n p (setN vl q c) = getN n p c.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. apply getN_exten. intros. apply setN_other.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  intros; red; intros; subst r. eelim H; eauto.
Qed.

Remark getN_setN_outside:
  forall vl q c n p,
  p + Z.of_nat n <= q \/ q + Z.of_nat (length vl) <= p ->
  getN n p (setN vl q c) = getN n p c.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. apply getN_setN_disjoint. apply Intv.disjoint_range. auto.
Qed.

Remark setN_default:
  forall vl q c, fst (setN vl q c) = fst c.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  induction vl; simpl; intros. auto. rewrite IHvl. auto.
Qed.

(** [store chunk m b ofs v] perform a write in memory state [m].
  Value [v] is stored at address [b] and offset [ofs].
  Return the updated memory store, or [None] if the accessed bytes
  are not writable. *)

Program Definition store (chunk: memory_chunk) (m: mem) (b: block) (ofs: Z) (v: val): option mem :=
  if valid_access_dec m chunk b ofs Writable then
    Some (mkmem (PMap.set b
                          (setN (encode_val chunk v) ofs (m.(mem_contents)#b))
                          m.(mem_contents))
                m.(mem_access)
                m.(nextblock)
                _ _ _)
  else
    None.
Next Obligation. apply access_max. Qed.
Next Obligation. apply nextblock_noaccess; auto. Qed.
Next Obligation.
(* Goal: @eq memval (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (@PMap.set (ZMap.t memval) b (setN bytes ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)))) (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite PMap.gsspec. destruct (peq b0 b).
(* Goal: @eq memval (@fst memval (PTree.t memval) (@PMap.get (ZMap.t memval) b0 (mem_contents m))) Undef *)
  rewrite setN_default. apply contents_default.
(* Goal: @eq memval (@fst memval (PTree.t memval) (@PMap.get (ZMap.t memval) b0 (mem_contents m))) Undef *)
  apply contents_default.
Qed.

(** [storev chunk m addr v] is similar, but the address and offset are given
  as a single value [addr], which must be a pointer value. *)

Definition storev (chunk: memory_chunk) (m: mem) (addr v: val) : option mem :=
  match addr with
  | Vptr b ofs => store chunk m b (Ptrofs.unsigned ofs) v
  | _ => None
  end.

(** [storebytes m b ofs bytes] stores the given list of bytes [bytes]
  starting at location [(b, ofs)].  Returns updated memory state
  or [None] if the accessed locations are not writable. *)

Program Definition storebytes (m: mem) (b: block) (ofs: Z) (bytes: list memval) : option mem :=
  if range_perm_dec m b ofs (ofs + Z.of_nat (length bytes)) Cur Writable then
    Some (mkmem
             (PMap.set b (setN bytes ofs (m.(mem_contents)#b)) m.(mem_contents))
             m.(mem_access)
             m.(nextblock)
             _ _ _)
  else
    None.
Next Obligation. apply access_max. Qed.
Next Obligation. apply nextblock_noaccess; auto. Qed.
Next Obligation.
(* Goal: @eq memval (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (@PMap.set (ZMap.t memval) b (setN bytes ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)))) (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite PMap.gsspec. destruct (peq b0 b).
(* Goal: @eq memval (@fst memval (PTree.t memval) (@PMap.get (ZMap.t memval) b0 (mem_contents m))) Undef *)
  rewrite setN_default. apply contents_default.
(* Goal: @eq memval (@fst memval (PTree.t memval) (@PMap.get (ZMap.t memval) b0 (mem_contents m))) Undef *)
  apply contents_default.
Qed.

(** [drop_perm m b lo hi p] sets the max permissions of the byte range
    [(b, lo) ... (b, hi - 1)] to [p].  These bytes must have current permissions
    [Freeable] in the initial memory state [m].
    Returns updated memory state, or [None] if insufficient permissions. *)

Program Definition drop_perm (m: mem) (b: block) (lo hi: Z) (p: permission): option mem :=
  if range_perm_dec m b lo hi Cur Freeable then
    Some (mkmem m.(mem_contents)
                (PMap.set b
                        (fun ofs k => if zle lo ofs && zlt ofs hi then Some p else m.(mem_access)#b ofs k)
                        m.(mem_access))
                m.(nextblock) _ _ _)
  else None.
Next Obligation.
(* Goal: perm_order'' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) b (fun (ofs : Z) (k : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (mem_access m)) ofs Max) (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) b (fun (ofs : Z) (k : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (mem_access m)) ofs Cur) *)
  repeat rewrite PMap.gsspec. destruct (peq b0 b). subst b0.
(* Goal: perm_order'' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (mem_access m) ofs Max) (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (mem_access m) ofs Cur) *)
  destruct (zle lo ofs && zlt ofs hi). red; auto with mem. apply access_max.
(* Goal: perm_order'' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (mem_access m) ofs Max) (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b0 (mem_access m) ofs Cur) *)
  apply access_max.
Qed.
Next Obligation.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  specialize (nextblock_noaccess m b0 ofs k H0). intros.
(* Goal: @eq memval (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (@PMap.set (ZMap.t memval) b (setN bytes ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)))) (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite PMap.gsspec. destruct (peq b0 b). subst b0.
(* Goal: forall _ : perm_order' (if andb (if zle lo ofs then true else false) (if zlt ofs hi then true else false) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p', perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p' *)
(* Goal: forall _ : perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b' (mem_access m) ofs k) p', perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b' (mem_access m) ofs k) p' *)
  destruct (zle lo ofs). destruct (zlt ofs hi).
(* Goal: Ple (nextblock m) (nextblock m') *)
  assert (perm m b ofs k Freeable). apply perm_cur. apply H; auto.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  unfold perm in H2. rewrite H1 in H2. contradiction.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto. auto. auto.
Qed.
Next Obligation.
(* Goal: @eq memval (@fst memval (PTree.t memval) (@PMap.get (ZMap.t memval) b0 (mem_contents m))) Undef *)
  apply contents_default.
Qed.

(** * Properties of the memory operations *)

(** Properties of the empty store. *)

Theorem nextblock_empty: nextblock empty = 1%positive.
Proof. reflexivity. Qed.

Theorem perm_empty: forall b ofs k p, ~perm empty b ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold perm, empty; simpl. rewrite PMap.gi. simpl. tauto.
Qed.

Theorem valid_access_empty: forall chunk b ofs p, ~valid_access empty chunk b ofs p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. red; intros. elim (perm_empty b ofs Cur p). apply H.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  generalize (size_chunk_pos chunk); omega.
Qed.

(** ** Properties related to [load] *)

Theorem valid_access_load:
  forall m chunk b ofs,
  valid_access m chunk b ofs Readable ->
  exists v, load chunk m b ofs = Some v.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. econstructor. unfold load. rewrite pred_dec_true; eauto.
Qed.

Theorem load_valid_access:
  forall m chunk b ofs v,
  load chunk m b ofs = Some v ->
  valid_access m chunk b ofs Readable.
Proof.
(* Goal: @eq (option val) (load chunk m' b ofs) (load chunk m b ofs) *)
  intros until v. unfold load.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  destruct (valid_access_dec m chunk b ofs Readable); intros.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
Qed.

Lemma load_result:
  forall chunk m b ofs v,
  load chunk m b ofs = Some v ->
  v = decode_val chunk (getN (size_chunk_nat chunk) ofs (m.(mem_contents)#b)).
Proof.
(* Goal: @eq (option val) (load chunk m' b ofs) (load chunk m b ofs) *)
  intros until v. unfold load.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  destruct (valid_access_dec m chunk b ofs Readable); intros.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
Qed.

Local Hint Resolve load_valid_access valid_access_load: mem.

Theorem load_type:
  forall m chunk b ofs v,
  load chunk m b ofs = Some v ->
  Val.has_type v (type_of_chunk chunk).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit load_result; eauto; intros. rewrite H0.
(* Goal: Val.has_type (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))) (type_of_chunk chunk) *)
  apply decode_val_type.
Qed.

Theorem load_cast:
  forall m chunk b ofs v,
  load chunk m b ofs = Some v ->
  match chunk with
  | Mint8signed => v = Val.sign_ext 8 v
  | Mint8unsigned => v = Val.zero_ext 8 v
  | Mint16signed => v = Val.sign_ext 16 v
  | Mint16unsigned => v = Val.zero_ext 16 v
  | _ => True
  end.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit load_result; eauto.
(* Goal: forall _ : @eq val v (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))), match chunk with | Mint8signed => @eq val v (Val.sign_ext (Zpos (xO (xO (xO xH)))) v) | Mint8unsigned => @eq val v (Val.zero_ext (Zpos (xO (xO (xO xH)))) v) | Mint16signed => @eq val v (Val.sign_ext (Zpos (xO (xO (xO (xO xH))))) v) | Mint16unsigned => @eq val v (Val.zero_ext (Zpos (xO (xO (xO (xO xH))))) v) | Mint32 => True | Mint64 => True | Mfloat32 => True | Mfloat64 => True | Many32 => True | Many64 => True end *)
  set (l := getN (size_chunk_nat chunk) ofs m.(mem_contents)#b).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. subst v. apply decode_val_cast.
Qed.

Theorem load_int8_signed_unsigned:
  forall m b ofs,
  load Mint8signed m b ofs = option_map (Val.sign_ext 8) (load Mint8unsigned m b ofs).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold load.
(* Goal: @eq (option val) (if valid_access_dec m Mint8signed b ofs Readable then @Some val (decode_val Mint8signed (getN (size_chunk_nat Mint8signed) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))) else @None val) (@option_map val val (Val.sign_ext (Zpos (xO (xO (xO xH))))) (if valid_access_dec m Mint8unsigned b ofs Readable then @Some val (decode_val Mint8unsigned (getN (size_chunk_nat Mint8unsigned) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))) else @None val)) *)
  change (size_chunk_nat Mint8signed) with (size_chunk_nat Mint8unsigned).
(* Goal: @eq (option val) (if valid_access_dec m Mint8signed b ofs Readable then @Some val (decode_val Mint8signed (getN (size_chunk_nat Mint8unsigned) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))) else @None val) (@option_map val val (Val.sign_ext (Zpos (xO (xO (xO xH))))) (if valid_access_dec m Mint8unsigned b ofs Readable then @Some val (decode_val Mint8unsigned (getN (size_chunk_nat Mint8unsigned) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))) else @None val)) *)
  set (cl := getN (size_chunk_nat Mint8unsigned) ofs m.(mem_contents)#b).
(* Goal: @eq (option val) (if valid_access_dec m Mint8signed b ofs Readable then @Some val (decode_val Mint8signed cl) else @None val) (@option_map val val (Val.sign_ext (Zpos (xO (xO (xO xH))))) (if valid_access_dec m Mint8unsigned b ofs Readable then @Some val (decode_val Mint8unsigned cl) else @None val)) *)
  destruct (valid_access_dec m Mint8signed b ofs Readable).
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_true; auto. unfold decode_val.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (proj_bytes cl); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  simpl. decEq. decEq. rewrite Int.sign_ext_zero_ext. auto. compute; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_false; auto.
Qed.

Theorem load_int16_signed_unsigned:
  forall m b ofs,
  load Mint16signed m b ofs = option_map (Val.sign_ext 16) (load Mint16unsigned m b ofs).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold load.
(* Goal: @eq (option val) (if valid_access_dec m Mint16signed b ofs Readable then @Some val (decode_val Mint16signed (getN (size_chunk_nat Mint16signed) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))) else @None val) (@option_map val val (Val.sign_ext (Zpos (xO (xO (xO (xO xH)))))) (if valid_access_dec m Mint16unsigned b ofs Readable then @Some val (decode_val Mint16unsigned (getN (size_chunk_nat Mint16unsigned) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))) else @None val)) *)
  change (size_chunk_nat Mint16signed) with (size_chunk_nat Mint16unsigned).
(* Goal: @eq (option val) (if valid_access_dec m Mint16signed b ofs Readable then @Some val (decode_val Mint16signed (getN (size_chunk_nat Mint16unsigned) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))) else @None val) (@option_map val val (Val.sign_ext (Zpos (xO (xO (xO (xO xH)))))) (if valid_access_dec m Mint16unsigned b ofs Readable then @Some val (decode_val Mint16unsigned (getN (size_chunk_nat Mint16unsigned) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))) else @None val)) *)
  set (cl := getN (size_chunk_nat Mint16unsigned) ofs m.(mem_contents)#b).
(* Goal: @eq (option val) (if valid_access_dec m Mint16signed b ofs Readable then @Some val (decode_val Mint16signed cl) else @None val) (@option_map val val (Val.sign_ext (Zpos (xO (xO (xO (xO xH)))))) (if valid_access_dec m Mint16unsigned b ofs Readable then @Some val (decode_val Mint16unsigned cl) else @None val)) *)
  destruct (valid_access_dec m Mint16signed b ofs Readable).
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_true; auto. unfold decode_val.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (proj_bytes cl); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  simpl. decEq. decEq. rewrite Int.sign_ext_zero_ext. auto. compute; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_false; auto.
Qed.

(** ** Properties related to [loadbytes] *)

Theorem range_perm_loadbytes:
  forall m b ofs len,
  range_perm m b ofs (ofs + len) Cur Readable ->
  exists bytes, loadbytes m b ofs len = Some bytes.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. econstructor. unfold loadbytes. rewrite pred_dec_true; eauto.
Qed.

Theorem loadbytes_range_perm:
  forall m b ofs len bytes,
  loadbytes m b ofs len = Some bytes ->
  range_perm m b ofs (ofs + len) Cur Readable.
Proof.
(* Goal: @eq (option (list memval)) (loadbytes m' b ofs n) (loadbytes m b ofs n) *)
  intros until bytes. unfold loadbytes.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (range_perm_dec m b ofs (ofs + len) Cur Readable). auto. congruence.
Qed.

Theorem loadbytes_load:
  forall chunk m b ofs bytes,
  loadbytes m b ofs (size_chunk chunk) = Some bytes ->
  (align_chunk chunk | ofs) ->
  load chunk m b ofs = Some(decode_val chunk bytes).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold loadbytes, load; intros.
  destruct (range_perm_dec m b ofs (ofs + size_chunk chunk) Cur Readable);
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  try congruence.
(* Goal: Ple (nextblock m) (nextblock m') *)
  inv H. rewrite pred_dec_true. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  split; auto.
Qed.

Theorem load_loadbytes:
  forall chunk m b ofs v,
  load chunk m b ofs = Some v ->
  exists bytes, loadbytes m b ofs (size_chunk chunk) = Some bytes
             /\ v = decode_val chunk bytes.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit load_valid_access; eauto. intros [A B].
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  exploit load_result; eauto. intros.
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  exists (getN (size_chunk_nat chunk) ofs m.(mem_contents)#b); split.
(* Goal: Ple (nextblock m) (nextblock m') *)
  unfold loadbytes. rewrite pred_dec_true; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Lemma getN_length:
  forall c n p, length (getN n p c) = n.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  induction n; simpl; intros. auto. decEq; auto.
Qed.

Theorem loadbytes_length:
  forall m b ofs n bytes,
  loadbytes m b ofs n = Some bytes ->
  length bytes = nat_of_Z n.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold loadbytes; intros.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  destruct (range_perm_dec m b ofs (ofs + n) Cur Readable); try congruence.
(* Goal: Val.inject f v1 v3 *)
  inv H. apply getN_length.
Qed.

Theorem loadbytes_empty:
  forall m b ofs n,
  n <= 0 -> loadbytes m b ofs n = Some nil.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold loadbytes. rewrite pred_dec_true. rewrite nat_of_Z_neg; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. omegaContradiction.
Qed.

Lemma getN_concat:
  forall c n1 n2 p,
  getN (n1 + n2)%nat p c = getN n1 p c ++ getN n2 (p + Z.of_nat n1) c.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  induction n1; intros.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  simpl. decEq. omega.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite Nat2Z.inj_succ. simpl. decEq.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace (p + Z.succ (Z.of_nat n1)) with ((p + 1) + Z.of_nat n1) by omega.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Theorem loadbytes_concat:
  forall m b ofs n1 n2 bytes1 bytes2,
  loadbytes m b ofs n1 = Some bytes1 ->
  loadbytes m b (ofs + n1) n2 = Some bytes2 ->
  n1 >= 0 -> n2 >= 0 ->
  loadbytes m b ofs (n1 + n2) = Some(bytes1 ++ bytes2).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold loadbytes; intros.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  destruct (range_perm_dec m b ofs (ofs + n1) Cur Readable); try congruence.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  destruct (range_perm_dec m b (ofs + n1) (ofs + n1 + n2) Cur Readable); try congruence.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_true. rewrite nat_of_Z_plus; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite getN_concat. rewrite nat_of_Z_eq; auto.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  assert (ofs0 < ofs + n1 \/ ofs0 >= ofs + n1) by omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  destruct H4. apply r; omega. apply r0; omega.
Qed.

Theorem loadbytes_split:
  forall m b ofs n1 n2 bytes,
  loadbytes m b ofs (n1 + n2) = Some bytes ->
  n1 >= 0 -> n2 >= 0 ->
  exists bytes1, exists bytes2,
     loadbytes m b ofs n1 = Some bytes1
  /\ loadbytes m b (ofs + n1) n2 = Some bytes2
  /\ bytes = bytes1 ++ bytes2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold loadbytes; intros.
  destruct (range_perm_dec m b ofs (ofs + (n1 + n2)) Cur Readable);
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  try congruence.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite nat_of_Z_plus in H; auto. rewrite getN_concat in H.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite nat_of_Z_eq in H; auto.
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  repeat rewrite pred_dec_true.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  econstructor; econstructor.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  split. reflexivity. split. reflexivity. congruence.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  red; intros; apply r; omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  red; intros; apply r; omega.
Qed.

Theorem load_rep:
 forall ch m1 m2 b ofs v1 v2,
  (forall z, 0 <= z < size_chunk ch -> ZMap.get (ofs + z) m1.(mem_contents)#b = ZMap.get (ofs + z) m2.(mem_contents)#b) ->
  load ch m1 b ofs = Some v1 ->
  load ch m2 b ofs = Some v2 ->
  v1 = v2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq val v1 v2 *)
  apply load_result in H0.
(* Goal: @eq val v1 v2 *)
  apply load_result in H1.
(* Goal: or (and (@eq val v (Val.load_result chunk' v0)) (and (compat_pointer_chunks chunk chunk') (and (@eq block b b) (@eq Z ofs' ofs)))) (or (not (@eq block b b)) (or (Z.le (Z.add ofs' (size_chunk chunk')) ofs) (Z.le (Z.add ofs (size_chunk chunk)) ofs'))) *)
  subst.
(* Goal: @eq val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))) *)
(* Goal: valid_access m' chunk b ofs Readable *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  f_equal.
(* Goal: @eq (list memval) (getN (size_chunk_nat ch) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1))) (getN (size_chunk_nat ch) ofs (@PMap.get (ZMap.t memval) b (mem_contents m2))) *)
  rewrite size_chunk_conv in H.
(* Goal: @eq (list memval) (getN (size_chunk_nat ch) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1))) (getN (size_chunk_nat ch) ofs (@PMap.get (ZMap.t memval) b (mem_contents m2))) *)
  remember (size_chunk_nat ch) as n; clear Heqn.
(* Goal: Ple (nextblock m) (nextblock m') *)
  revert ofs H; induction n; intros; simpl; auto.
(* Goal: @eq val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m)))) *)
(* Goal: valid_access m' chunk b ofs Readable *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  f_equal.
(* Goal: @In memval (@ZMap.get memval q c) (getN (S n) p c) *)
  rewrite Nat2Z.inj_succ in H.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace ofs with (ofs+0) by omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  apply H; omega.
(* Goal: @list_forall2 memval memval (memval_inject f) (getN n (Z.add ofs (Zpos xH)) (@PMap.get (ZMap.t memval) b1 (mem_contents m1))) (getN n (Z.add (Z.add ofs (Zpos xH)) delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2))) *)
  apply IHn.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq memval (@ZMap.get memval (Z.add (Z.add ofs (Zpos xH)) z) (@PMap.get (ZMap.t memval) b (mem_contents m1))) (@ZMap.get memval (Z.add (Z.add ofs (Zpos xH)) z) (@PMap.get (ZMap.t memval) b (mem_contents m2))) *)
  rewrite <- Z.add_assoc.
(* Goal: range_perm m2 b ofs (Z.add ofs (size_chunk chunk)) Cur Readable *)
  apply H.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  rewrite Nat2Z.inj_succ. omega.
Qed.

Theorem load_int64_split:
  forall m b ofs v,
  load Mint64 m b ofs = Some v -> Archi.ptr64 = false ->
  exists v1 v2,
     load Mint32 m b ofs = Some (if Archi.big_endian then v1 else v2)
  /\ load Mint32 m b (ofs + 4) = Some (if Archi.big_endian then v2 else v1)
  /\ Val.lessdef v (Val.longofwords v1 v2).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit load_valid_access; eauto. intros [A B]. simpl in *.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  exploit load_loadbytes. eexact H. simpl. intros [bytes [LB EQ]].
  change 8 with (4 + 4) in LB.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  exploit loadbytes_split. eexact LB. omega. omega.
  intros (bytes1 & bytes2 & LB1 & LB2 & APP).
  change 4 with (size_chunk Mint32) in LB1.
  exploit loadbytes_load. eexact LB1.
(* Goal: Ple (nextblock m) (nextblock m') *)
  simpl. apply Zdivides_trans with 8; auto. exists 2; auto.
  intros L1.
  change 4 with (size_chunk Mint32) in LB2.
  exploit loadbytes_load. eexact LB2.
(* Goal: Ple (nextblock m) (nextblock m') *)
  simpl. apply Z.divide_add_r. apply Zdivides_trans with 8; auto. exists 2; auto. exists 1; auto.
  intros L2.
  exists (decode_val Mint32 (if Archi.big_endian then bytes1 else bytes2));
  exists (decode_val Mint32 (if Archi.big_endian then bytes2 else bytes1)).
(* Goal: Ple (nextblock m) (nextblock m') *)
  split. destruct Archi.big_endian; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  split. destruct Archi.big_endian; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite EQ. rewrite APP. apply decode_val_int64; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  erewrite loadbytes_length; eauto. reflexivity.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  erewrite loadbytes_length; eauto. reflexivity.
Qed.

Lemma addressing_int64_split:
  forall i,
  Archi.ptr64 = false ->
  (8 | Ptrofs.unsigned i) ->
  Ptrofs.unsigned (Ptrofs.add i (Ptrofs.of_int (Int.repr 4))) = Ptrofs.unsigned i + 4.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq Z (Ptrofs.unsigned (Ptrofs.add i (Ptrofs.of_int (Int.repr (Zpos (xO (xO xH))))))) (Z.add (Ptrofs.unsigned i) (Zpos (xO (xO xH)))) *)
  rewrite Ptrofs.add_unsigned.
  replace (Ptrofs.unsigned (Ptrofs.of_int (Int.repr 4))) with (Int.unsigned (Int.repr 4))
    by (symmetry; apply Ptrofs.agree32_of_int; auto).
(* Goal: @eq Z (Ptrofs.unsigned (Ptrofs.repr (Z.add (Ptrofs.unsigned i) (Int.unsigned (Int.repr (Zpos (xO (xO xH)))))))) (Z.add (Ptrofs.unsigned i) (Zpos (xO (xO xH)))) *)
  change (Int.unsigned (Int.repr 4)) with 4.
(* Goal: @eq Z (Ptrofs.unsigned (Ptrofs.repr (Z.add (Ptrofs.unsigned i) (Zpos (xO (xO xH)))))) (Z.add (Ptrofs.unsigned i) (Zpos (xO (xO xH)))) *)
  apply Ptrofs.unsigned_repr.
(* Goal: and (Z.le Z0 (Z.add (Ptrofs.unsigned i) (Zpos (xO (xO xH))))) (Z.le (Z.add (Ptrofs.unsigned i) (Zpos (xO (xO xH)))) Ptrofs.max_unsigned) *)
  exploit (Zdivide_interval (Ptrofs.unsigned i) Ptrofs.modulus 8).
(* Goal: Ple (nextblock m) (nextblock m') *)
  omega. apply Ptrofs.unsigned_range. auto.
(* Goal: Z.divide (Zpos (xO (xO (xO xH)))) Ptrofs.modulus *)
(* Goal: forall _ : and (Z.le Z0 (Ptrofs.unsigned i)) (Z.le (Ptrofs.unsigned i) (Z.sub Ptrofs.modulus (Zpos (xO (xO (xO xH)))))), and (Z.le Z0 (Z.add (Ptrofs.unsigned i) (Zpos (xO (xO xH))))) (Z.le (Z.add (Ptrofs.unsigned i) (Zpos (xO (xO xH)))) Ptrofs.max_unsigned) *)
  exists (two_p (Ptrofs.zwordsize - 3)).
(* Goal: @eq Z Ptrofs.modulus (Z.mul (two_p (Z.sub Ptrofs.zwordsize (Zpos (xI xH)))) (Zpos (xO (xO (xO xH))))) *)
(* Goal: forall _ : and (Z.le Z0 (Ptrofs.unsigned i)) (Z.le (Ptrofs.unsigned i) (Z.sub Ptrofs.modulus (Zpos (xO (xO (xO xH)))))), and (Z.le Z0 (Z.add (Ptrofs.unsigned i) (Zpos (xO (xO xH))))) (Z.le (Z.add (Ptrofs.unsigned i) (Zpos (xO (xO xH)))) Ptrofs.max_unsigned) *)
  unfold Ptrofs.modulus, Ptrofs.zwordsize, Ptrofs.wordsize.
(* Goal: @eq block (nextblock empty) xH *)
  unfold Wordsize_Ptrofs.wordsize. destruct Archi.ptr64; reflexivity.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  unfold Ptrofs.max_unsigned. omega.
Qed.

Theorem loadv_int64_split:
  forall m a v,
  loadv Mint64 m a = Some v -> Archi.ptr64 = false ->
  exists v1 v2,
     loadv Mint32 m a = Some (if Archi.big_endian then v1 else v2)
  /\ loadv Mint32 m (Val.add a (Vint (Int.repr 4))) = Some (if Archi.big_endian then v2 else v1)
  /\ Val.lessdef v (Val.longofwords v1 v2).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct a; simpl in H; inv H.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit load_int64_split; eauto. intros (v1 & v2 & L1 & L2 & EQ).
(* Goal: @eq val v Vundef *)
  unfold Val.add; rewrite H0.
  assert (NV: Ptrofs.unsigned (Ptrofs.add i (Ptrofs.of_int (Int.repr 4))) = Ptrofs.unsigned i + 4).
(* Goal: Ple (nextblock m) (nextblock m') *)
  { apply addressing_int64_split; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
    exploit load_valid_access. eexact H2. intros [P Q]. auto. }
  exists v1, v2.
Opaque Ptrofs.repr.
(* Goal: Ple (nextblock m) (nextblock m') *)
  split. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  split. simpl. rewrite NV. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

(** ** Properties related to [store] *)

Theorem valid_access_store:
  forall m1 chunk b ofs v,
  valid_access m1 chunk b ofs Writable ->
  { m2: mem | store chunk m1 b ofs v = Some m2 }.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option mem) (if valid_access_dec m chunk1 b ofs Writable then @Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk1 v1) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)) (mem_access m) (nextblock m) (fun (b0 : positive) (ofs0 : Z) => store_obligation_1 m b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m))) => store_obligation_2 m b0 ofs0 k H0) (fun b0 : positive => store_obligation_3 chunk1 m b ofs v1 b0)) else @None mem) (if valid_access_dec m chunk2 b ofs Writable then @Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk2 v2) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)) (mem_access m) (nextblock m) (fun (b0 : positive) (ofs0 : Z) => store_obligation_1 m b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m))) => store_obligation_2 m b0 ofs0 k H0) (fun b0 : positive => store_obligation_3 chunk2 m b ofs v2 b0)) else @None mem) *)
  unfold store.
(* Goal: @eq (option mem) (if valid_access_dec m1 chunk b ofs Writable then @Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk v) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1))) (mem_contents m1)) (mem_access m1) (nextblock m1) (fun (b0 : positive) (ofs0 : Z) => store_obligation_1 m1 b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m1))) => store_obligation_2 m1 b0 ofs0 k H0) (fun b0 : positive => store_obligation_3 chunk m1 b ofs v b0)) else @None mem) (@Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk v) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1))) (mem_contents m1)) (mem_access m1) (nextblock m1) (fun (b0 : positive) (ofs0 : Z) => storebytes_obligation_1 m1 b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m1))) => storebytes_obligation_2 m1 b0 ofs0 k H0) (fun b0 : positive => storebytes_obligation_3 m1 b ofs (encode_val chunk v) b0))) *)
  destruct (valid_access_dec m1 chunk b ofs Writable).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eauto.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  contradiction.
Defined.

Local Hint Resolve valid_access_store: mem.

Section STORE.
Variable chunk: memory_chunk.
Variable m1: mem.
Variable b: block.
Variable ofs: Z.
Variable v: val.
Variable m2: mem.
Hypothesis STORE: store chunk m1 b ofs v = Some m2.

Lemma store_access: mem_access m2 = mem_access m1.
Proof.
(* Goal: valid_access m1 chunk b ofs Writable *)
  unfold store in STORE. destruct ( valid_access_dec m1 chunk b ofs Writable); inv STORE.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Lemma store_mem_contents:
  mem_contents m2 = PMap.set b (setN (encode_val chunk v) ofs m1.(mem_contents)#b) m1.(mem_contents).
Proof.
(* Goal: valid_access m1 chunk b ofs Writable *)
  unfold store in STORE. destruct (valid_access_dec m1 chunk b ofs Writable); inv STORE.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Theorem perm_store_1:
  forall b' ofs' k p, perm m1 b' ofs' k p -> perm m2 b' ofs' k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: Ple (nextblock m) (nextblock m') *)
 unfold perm in *. rewrite store_access; auto.
Qed.

Theorem perm_store_2:
  forall b' ofs' k p, perm m2 b' ofs' k p -> perm m1 b' ofs' k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold perm in *.  rewrite store_access in H; auto.
Qed.

Local Hint Resolve perm_store_1 perm_store_2: mem.

Theorem nextblock_store:
  nextblock m2 = nextblock m1.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: valid_access m1 chunk b ofs Writable *)
  unfold store in STORE. destruct ( valid_access_dec m1 chunk b ofs Writable); inv STORE.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Theorem store_valid_block_1:
  forall b', valid_block m1 b' -> valid_block m2 b'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold valid_block; intros. rewrite nextblock_store; auto.
Qed.

Theorem store_valid_block_2:
  forall b', valid_block m2 b' -> valid_block m1 b'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold valid_block; intros. rewrite nextblock_store in H; auto.
Qed.

Local Hint Resolve store_valid_block_1 store_valid_block_2: mem.

Theorem store_valid_access_1:
  forall chunk' b' ofs' p,
  valid_access m1 chunk' b' ofs' p -> valid_access m2 chunk' b' ofs' p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor; try red; auto with mem.
Qed.

Theorem store_valid_access_2:
  forall chunk' b' ofs' p,
  valid_access m2 chunk' b' ofs' p -> valid_access m1 chunk' b' ofs' p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor; try red; auto with mem.
Qed.

Theorem store_valid_access_3:
  valid_access m1 chunk b ofs Writable.
Proof.
(* Goal: @eq (option mem) (if valid_access_dec m1 chunk b ofs Writable then @Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk v) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1))) (mem_contents m1)) (mem_access m1) (nextblock m1) (fun (b0 : positive) (ofs0 : Z) => store_obligation_1 m1 b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m1))) => store_obligation_2 m1 b0 ofs0 k H0) (fun b0 : positive => store_obligation_3 chunk m1 b ofs v b0)) else @None mem) (@Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk v) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1))) (mem_contents m1)) (mem_access m1) (nextblock m1) (fun (b0 : positive) (ofs0 : Z) => storebytes_obligation_1 m1 b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m1))) => storebytes_obligation_2 m1 b0 ofs0 k H0) (fun b0 : positive => storebytes_obligation_3 m1 b ofs (encode_val chunk v) b0))) *)
  unfold store in STORE. destruct (valid_access_dec m1 chunk b ofs Writable).
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
Qed.

Local Hint Resolve store_valid_access_1 store_valid_access_2 store_valid_access_3: mem.

Theorem load_store_similar:
  forall chunk',
  size_chunk chunk' = size_chunk chunk ->
  align_chunk chunk' <= align_chunk chunk ->
  exists v', load chunk' m2 b ofs = Some v' /\ decode_encode_val v chunk chunk' v'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  exploit (valid_access_load m2 chunk').
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply valid_access_compat. symmetry; eauto. auto. eauto with mem.
  intros [v' LOAD].
(* Goal: Ple (nextblock m) (nextblock m') *)
  exists v'; split; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit load_result; eauto. intros B.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite B. rewrite store_mem_contents; simpl.
(* Goal: forall _ : perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) b (fun (ofs : Z) (k : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (mem_access m)) ofs k) p', perm_order p p' *)
  rewrite PMap.gss.
  replace (size_chunk_nat chunk') with (length (encode_val chunk v)).
(* Goal: @eq (option (list memval)) (@Some (list memval) (getN (@Datatypes.length memval (encode_val chunk v)) ofs (setN (encode_val chunk v) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1))))) (@Some (list memval) (encode_val chunk v)) *)
(* Goal: @eq nat (@Datatypes.length memval (encode_val chunk v)) (nat_of_Z (size_chunk chunk)) *)
(* Goal: range_perm m2 b ofs (Z.add ofs (size_chunk chunk)) Cur Readable *)
  rewrite getN_setN_same. apply decode_encode_val_general.
(* Goal: @eq (list memval) (getN (size_chunk_nat ch) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1))) (getN (size_chunk_nat ch) ofs (@PMap.get (ZMap.t memval) b (mem_contents m2))) *)
  rewrite encode_val_length. repeat rewrite size_chunk_conv in H.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply Nat2Z.inj; auto.
Qed.

Theorem load_store_similar_2:
  forall chunk',
  size_chunk chunk' = size_chunk chunk ->
  align_chunk chunk' <= align_chunk chunk ->
  type_of_chunk chunk' = type_of_chunk chunk ->
  load chunk' m2 b ofs = Some (Val.load_result chunk' v).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct (load_store_similar chunk') as [v' [A B]]; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite A. decEq. eapply decode_encode_val_similar with (chunk1 := chunk); eauto.
Qed.

Theorem load_store_same:
  load chunk m2 b ofs = Some (Val.load_result chunk v).
Proof.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply load_store_similar_2; auto. omega.
Qed.

Theorem load_store_other:
  forall chunk' b' ofs',
  b' <> b
  \/ ofs' + size_chunk chunk' <= ofs
  \/ ofs + size_chunk chunk <= ofs' ->
  load chunk' m2 b' ofs' = load chunk' m1 b' ofs'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold load.
(* Goal: @eq (option val) (if valid_access_dec m2 chunk' b' ofs' Readable then @Some val (decode_val chunk' (getN (size_chunk_nat chunk') ofs' (@PMap.get (ZMap.t memval) b' (mem_contents m2)))) else @None val) (if valid_access_dec m1 chunk' b' ofs' Readable then @Some val (decode_val chunk' (getN (size_chunk_nat chunk') ofs' (@PMap.get (ZMap.t memval) b' (mem_contents m1)))) else @None val) *)
  destruct (valid_access_dec m1 chunk' b' ofs' Readable).
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  rewrite pred_dec_true.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  decEq. decEq. rewrite store_mem_contents; simpl.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  rewrite PMap.gsspec. destruct (peq b' b). subst b'.
(* Goal: or (Z.lt ofs0 ofs) (Z.ge ofs0 (Z.add ofs (Z.of_nat (@Datatypes.length memval (encode_val chunk v))))) *)
  apply getN_setN_outside. rewrite encode_val_length. repeat rewrite <- size_chunk_conv.
(* Goal: perm_order p Readable *)
(* Goal: perm m' b' ofs0 Cur Readable *)
(* Goal: @eq (option (list memval)) (if range_perm_dec m' b' ofs (Z.add ofs n) Cur Readable then @Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m'))) else @None (list memval)) (@None (list memval)) *)
  intuition.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_false. auto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
Qed.

Theorem loadbytes_store_same:
  loadbytes m2 b ofs (size_chunk chunk) = Some(encode_val chunk v).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  assert (valid_access m2 chunk b ofs Readable) by eauto with mem.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  unfold loadbytes. rewrite pred_dec_true. rewrite store_mem_contents; simpl.
(* Goal: forall _ : perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) b (fun (ofs : Z) (k : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (mem_access m)) ofs k) p', perm_order p p' *)
  rewrite PMap.gss.
(* Goal: @eq (option (list memval)) (@Some (list memval) (getN (nat_of_Z (size_chunk chunk)) ofs (setN (encode_val chunk v) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1))))) (@Some (list memval) (encode_val chunk v)) *)
(* Goal: range_perm m2 b ofs (Z.add ofs (size_chunk chunk)) Cur Readable *)
  replace (nat_of_Z (size_chunk chunk)) with (length (encode_val chunk v)).
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite getN_setN_same. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite encode_val_length. auto.
(* Goal: range_perm m2 b ofs (Z.add ofs (size_chunk chunk)) Cur Readable *)
  apply H.
Qed.

Theorem loadbytes_store_other:
  forall b' ofs' n,
  b' <> b
  \/ n <= 0
  \/ ofs' + n <= ofs
  \/ ofs + size_chunk chunk <= ofs' ->
  loadbytes m2 b' ofs' n = loadbytes m1 b' ofs' n.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold loadbytes.
(* Goal: @eq (option (list memval)) (if range_perm_dec m2 b' ofs' (Z.add ofs' n) Cur Readable then @Some (list memval) (getN (nat_of_Z n) ofs' (@PMap.get (ZMap.t memval) b' (mem_contents m2))) else @None (list memval)) (if range_perm_dec m1 b' ofs' (Z.add ofs' n) Cur Readable then @Some (list memval) (getN (nat_of_Z n) ofs' (@PMap.get (ZMap.t memval) b' (mem_contents m1))) else @None (list memval)) *)
  destruct (range_perm_dec m1 b' ofs' (ofs' + n) Cur Readable).
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  rewrite pred_dec_true.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  decEq. rewrite store_mem_contents; simpl.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  rewrite PMap.gsspec. destruct (peq b' b). subst b'.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  destruct H. congruence.
(* Goal: @eq (list memval) (getN (nat_of_Z n) ofs' (setN (encode_val chunk v) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1)))) (getN (nat_of_Z n) ofs' (@PMap.get (ZMap.t memval) b (mem_contents m1))) *)
(* Goal: @eq (list memval) (getN (nat_of_Z n) ofs' (@PMap.get (ZMap.t memval) b' (mem_contents m1))) (getN (nat_of_Z n) ofs' (@PMap.get (ZMap.t memval) b' (mem_contents m1))) *)
(* Goal: range_perm m2 b' ofs' (Z.add ofs' n) Cur Readable *)
(* Goal: @eq (option (list memval)) (if range_perm_dec m2 b' ofs' (Z.add ofs' n) Cur Readable then @Some (list memval) (getN (nat_of_Z n) ofs' (@PMap.get (ZMap.t memval) b' (mem_contents m2))) else @None (list memval)) (@None (list memval)) *)
  destruct (zle n 0) as [z | n0].
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite (nat_of_Z_neg _ z). auto.
(* Goal: @In memval (@ZMap.get memval q (setN (@nil memval) p c)) (@nil memval) *)
(* Goal: @In memval (@ZMap.get memval q (setN (@cons memval a vl) p c)) (@cons memval a vl) *)
  destruct H. omegaContradiction.
(* Goal: or (Z.lt ofs0 ofs) (Z.ge ofs0 (Z.add ofs (Z.of_nat (@Datatypes.length memval (encode_val chunk v))))) *)
  apply getN_setN_outside. rewrite encode_val_length. rewrite <- size_chunk_conv.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite nat_of_Z_eq. auto. omega.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eauto with mem.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_false. auto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  red; intro; elim n0; red; intros; eauto with mem.
Qed.

Lemma setN_in:
  forall vl p q c,
  p <= q < p + Z.of_nat (length vl) ->
  In (ZMap.get q (setN vl p c)) vl.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  induction vl; intros.
(* Goal: @In memval (@ZMap.get memval q (setN (@nil memval) p c)) (@nil memval) *)
(* Goal: @In memval (@ZMap.get memval q (setN (@cons memval a vl) p c)) (@cons memval a vl) *)
  simpl in H. omegaContradiction.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  simpl length in H. rewrite Nat2Z.inj_succ in H. simpl.
(* Goal: memval_inject f (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b1 (mem_contents m1))) (@ZMap.get memval (Z.add ofs0 delta) (setN bytes2 ofs (@PMap.get (ZMap.t memval) b (mem_contents m2)))) *)
(* Goal: memval_inject f (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b1 (mem_contents m1))) (@ZMap.get memval (Z.add ofs0 delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2))) *)
  destruct (zeq p q). subst q. rewrite setN_outside. rewrite ZMap.gss.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  auto with coqlib. omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  right. apply IHvl. omega.
Qed.

Lemma getN_in:
  forall c q n p,
  p <= q < p + Z.of_nat n ->
  In (ZMap.get q c) (getN n p c).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  induction n; intros.
(* Goal: @In memval (@ZMap.get memval q (setN (@nil memval) p c)) (@nil memval) *)
(* Goal: @In memval (@ZMap.get memval q (setN (@cons memval a vl) p c)) (@cons memval a vl) *)
  simpl in H; omegaContradiction.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite Nat2Z.inj_succ in H. simpl. destruct (zeq p q).
(* Goal: Ple (nextblock m) (nextblock m') *)
  subst q. auto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  right. apply IHn. omega.
Qed.

End STORE.

Local Hint Resolve perm_store_1 perm_store_2: mem.
Local Hint Resolve store_valid_block_1 store_valid_block_2: mem.
Local Hint Resolve store_valid_access_1 store_valid_access_2
             store_valid_access_3: mem.

Lemma load_store_overlap:
  forall chunk m1 b ofs v m2 chunk' ofs' v',
  store chunk m1 b ofs v = Some m2 ->
  load chunk' m2 b ofs' = Some v' ->
  ofs' + size_chunk chunk' > ofs ->
  ofs + size_chunk chunk > ofs' ->
  exists mv1 mvl mv1' mvl',
      shape_encoding chunk v (mv1 :: mvl)
  /\  shape_decoding chunk' (mv1' :: mvl') v'
  /\  (   (ofs' = ofs /\ mv1' = mv1)
       \/ (ofs' > ofs /\ In mv1' mvl)
       \/ (ofs' < ofs /\ In mv1 mvl')).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit load_result; eauto. erewrite store_mem_contents by eauto; simpl.
(* Goal: forall _ : perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) b (fun (ofs : Z) (k : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (mem_access m)) ofs k) p', perm_order p p' *)
  rewrite PMap.gss.
  set (c := (mem_contents m1)#b). intros V'.
  destruct (size_chunk_nat_pos chunk) as [sz SIZE].
  destruct (size_chunk_nat_pos chunk') as [sz' SIZE'].
  destruct (encode_val chunk v) as [ | mv1 mvl] eqn:ENC.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  generalize (encode_val_length chunk v); rewrite ENC; simpl; congruence.
  set (c' := setN (mv1::mvl) ofs c) in *.
  exists mv1, mvl, (ZMap.get ofs' c'), (getN sz' (ofs' + 1) c').
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  split. rewrite <- ENC. apply encode_val_shape.
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  split. rewrite V', SIZE'. apply decode_val_shape.
  destruct (zeq ofs' ofs).
(* Goal: Ple (nextblock m) (nextblock m') *)
- subst ofs'. left; split. auto. unfold c'. simpl.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  rewrite setN_outside by omega. apply ZMap.gss.
(* Goal: or (not (@eq block b b)) (or (Z.lt (Z.add ofs delta) lo) (Z.le hi (Z.add ofs delta))) *)
(* Goal: forall (b1 b2 : block) (delta : Z) (chunk : memory_chunk) (ofs : Z) (p : permission) (_ : @eq (option (prod block Z)) (f b1) (@Some (prod block Z) (@pair block Z b2 delta))) (_ : range_perm m1 b1 ofs (Z.add ofs (size_chunk chunk)) Max p), Z.divide (align_chunk chunk) delta *)
(* Goal: forall (b1 : block) (ofs : Z) (b2 : block) (delta : Z) (_ : @eq (option (prod block Z)) (f b1) (@Some (prod block Z) (@pair block Z b2 delta))) (_ : perm m1 b1 ofs Cur Readable), memval_inject f (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b1 (mem_contents m1))) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2'))) *)
- right. destruct (zlt ofs ofs').
(* If ofs < ofs':  the load reads (at ofs') a continuation byte from the write.
       ofs   ofs'   ofs+|chunk|
        [-------------------]       write
             [-------------------]  read
*)
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
+ left; split. omega. unfold c'. simpl. apply setN_in.
  assert (Z.of_nat (length (mv1 :: mvl)) = size_chunk chunk).
(* Goal: Ple (nextblock m) (nextblock m') *)
  { rewrite <- ENC; rewrite encode_val_length. rewrite size_chunk_conv; auto. }
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  simpl length in H3. rewrite Nat2Z.inj_succ in H3. omega.
(* If ofs > ofs':  the load reads (at ofs) the first byte from the write.
       ofs'   ofs   ofs'+|chunk'|
               [-------------------]  write
         [----------------]           read
*)
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
+ right; split. omega. replace mv1 with (ZMap.get ofs c').
  apply getN_in.
  assert (size_chunk chunk' = Z.succ (Z.of_nat sz')).
(* Goal: Ple (nextblock m) (nextblock m') *)
  { rewrite size_chunk_conv. rewrite SIZE'. rewrite Nat2Z.inj_succ; auto. }
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  unfold c'. simpl. rewrite setN_outside by omega. apply ZMap.gss.
Qed.

Definition compat_pointer_chunks (chunk1 chunk2: memory_chunk) : Prop :=
  match chunk1, chunk2 with
  | (Mint32 | Many32), (Mint32 | Many32) => True
  | (Mint64 | Many64), (Mint64 | Many64) => True
  | _, _ => False
  end.

Lemma compat_pointer_chunks_true:
  forall chunk1 chunk2,
  (chunk1 = Mint32 \/ chunk1 = Many32 \/ chunk1 = Mint64 \/ chunk1 = Many64) ->
  (chunk2 = Mint32 \/ chunk2 = Many32 \/ chunk2 = Mint64 \/ chunk2 = Many64) ->
  quantity_chunk chunk1 = quantity_chunk chunk2 ->
  compat_pointer_chunks chunk1 chunk2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H as [P|[P|[P|P]]]; destruct H0 as [Q|[Q|[Q|Q]]];
(* Goal: range_perm m b lo hi Cur Freeable *)
  subst; red; auto; discriminate.
Qed.

Theorem load_pointer_store:
  forall chunk m1 b ofs v m2 chunk' b' ofs' v_b v_o,
  store chunk m1 b ofs v = Some m2 ->
  load chunk' m2 b' ofs' = Some(Vptr v_b v_o) ->
  (v = Vptr v_b v_o /\ compat_pointer_chunks chunk chunk' /\ b' = b /\ ofs' = ofs)
  \/ (b' <> b \/ ofs' + size_chunk chunk' <= ofs \/ ofs + size_chunk chunk <= ofs').
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  destruct (peq b' b); auto. subst b'.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zle (ofs' + size_chunk chunk') ofs); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zle (ofs + size_chunk chunk) ofs'); auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit load_store_overlap; eauto.
(* Goal: forall _ : @ex memval (fun mv1 : memval => @ex (list memval) (fun mvl : list memval => @ex memval (fun mv1' : memval => @ex (list memval) (fun mvl' : list memval => and (shape_encoding chunk (Vptr v_b v_o) (@cons memval mv1 mvl)) (and (shape_decoding chunk' (@cons memval mv1' mvl') v) (or (and (@eq Z ofs ofs) (@eq memval mv1' mv1)) (or (and (Z.gt ofs ofs) (@In memval mv1' mvl)) (and (Z.lt ofs ofs) (@In memval mv1 mvl'))))))))), @eq val v Vundef *)
  intros (mv1 & mvl & mv1' & mvl' & ENC & DEC & CASES).
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  inv DEC; try contradiction.
(* Goal: @eq val v Vundef *)
  destruct CASES as [(A & B) | [(A & B) | (A & B)]].
- (* Same offset *)
(* Goal: or (and (@eq val v (Val.load_result chunk' v0)) (and (compat_pointer_chunks chunk chunk') (and (@eq block b b) (@eq Z ofs' ofs)))) (or (not (@eq block b b)) (or (Z.le (Z.add ofs' (size_chunk chunk')) ofs) (Z.le (Z.add ofs (size_chunk chunk)) ofs'))) *)
  subst. inv ENC.
  assert (chunk = Mint32 \/ chunk = Many32 \/ chunk = Mint64 \/ chunk = Many64)
  by (destruct chunk; auto || contradiction).
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  left; split. rewrite H3.
  destruct H4 as [P|[P|[P|P]]]; subst chunk'; destruct v0; simpl in H3;
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  try congruence; destruct Archi.ptr64; congruence.
(* Goal: Ple (nextblock m) (nextblock m') *)
  split. apply compat_pointer_chunks_true; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
- (* ofs' > ofs *)
(* Goal: @eq val v Vundef *)
  inv ENC.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  + exploit H10; eauto. intros (j & P & Q). inv P. congruence.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  + exploit H8; eauto. intros (n & P); congruence.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  + exploit H2; eauto. congruence.
- (* ofs' < ofs *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit H7; eauto. intros (j & P & Q). subst mv1. inv ENC. congruence.
Qed.

Theorem load_store_pointer_overlap:
  forall chunk m1 b ofs v_b v_o m2 chunk' ofs' v,
  store chunk m1 b ofs (Vptr v_b v_o) = Some m2 ->
  load chunk' m2 b ofs' = Some v ->
  ofs' <> ofs ->
  ofs' + size_chunk chunk' > ofs ->
  ofs + size_chunk chunk > ofs' ->
  v = Vundef.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit load_store_overlap; eauto.
(* Goal: forall _ : @ex memval (fun mv1 : memval => @ex (list memval) (fun mvl : list memval => @ex memval (fun mv1' : memval => @ex (list memval) (fun mvl' : list memval => and (shape_encoding chunk (Vptr v_b v_o) (@cons memval mv1 mvl)) (and (shape_decoding chunk' (@cons memval mv1' mvl') v) (or (and (@eq Z ofs ofs) (@eq memval mv1' mv1)) (or (and (Z.gt ofs ofs) (@In memval mv1' mvl)) (and (Z.lt ofs ofs) (@In memval mv1 mvl'))))))))), @eq val v Vundef *)
  intros (mv1 & mvl & mv1' & mvl' & ENC & DEC & CASES).
(* Goal: @eq val v Vundef *)
  destruct CASES as [(A & B) | [(A & B) | (A & B)]].
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
- congruence.
- inv ENC.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  + exploit H9; eauto. intros (j & P & Q). subst mv1'. inv DEC. congruence. auto.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  + contradiction.
(* Goal: or (and (@eq val v (Val.load_result chunk' v0)) (and (compat_pointer_chunks chunk chunk') (and (@eq block b b) (@eq Z ofs' ofs)))) (or (not (@eq block b b)) (or (Z.le (Z.add ofs' (size_chunk chunk')) ofs) (Z.le (Z.add ofs (size_chunk chunk)) ofs'))) *)
  + exploit H5; eauto. intros; subst. inv DEC; auto.
- inv DEC.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  + exploit H10; eauto. intros (j & P & Q). subst mv1. inv ENC. congruence.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  + exploit H8; eauto. intros (n & P). subst mv1. inv ENC. contradiction.
(* Goal: Ple (nextblock m) (nextblock m') *)
  + auto.
Qed.

Theorem load_store_pointer_mismatch:
  forall chunk m1 b ofs v_b v_o m2 chunk' v,
  store chunk m1 b ofs (Vptr v_b v_o) = Some m2 ->
  load chunk' m2 b ofs = Some v ->
  ~compat_pointer_chunks chunk chunk' ->
  v = Vundef.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit load_store_overlap; eauto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  generalize (size_chunk_pos chunk'); omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  generalize (size_chunk_pos chunk); omega.
(* Goal: forall _ : @ex memval (fun mv1 : memval => @ex (list memval) (fun mvl : list memval => @ex memval (fun mv1' : memval => @ex (list memval) (fun mvl' : list memval => and (shape_encoding chunk (Vptr v_b v_o) (@cons memval mv1 mvl)) (and (shape_decoding chunk' (@cons memval mv1' mvl') v) (or (and (@eq Z ofs ofs) (@eq memval mv1' mv1)) (or (and (Z.gt ofs ofs) (@In memval mv1' mvl)) (and (Z.lt ofs ofs) (@In memval mv1 mvl'))))))))), @eq val v Vundef *)
  intros (mv1 & mvl & mv1' & mvl' & ENC & DEC & CASES).
(* Goal: @In memval (@ZMap.get memval q (setN (@nil memval) p c)) (@nil memval) *)
(* Goal: @In memval (@ZMap.get memval q (setN (@cons memval a vl) p c)) (@cons memval a vl) *)
  destruct CASES as [(A & B) | [(A & B) | (A & B)]]; try omegaContradiction.
(* Goal: Ple (nextblock m) (nextblock m') *)
  inv ENC; inv DEC; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
- elim H1. apply compat_pointer_chunks_true; auto.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
- contradiction.
Qed.

Lemma store_similar_chunks:
  forall chunk1 chunk2 v1 v2 m b ofs,
  encode_val chunk1 v1 = encode_val chunk2 v2 ->
  align_chunk chunk1 = align_chunk chunk2 ->
  store chunk1 m b ofs v1 = store chunk2 m b ofs v2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold store.
(* Goal: @eq (option mem) (if valid_access_dec m chunk1 b ofs Writable then @Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk1 v1) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)) (mem_access m) (nextblock m) (fun (b0 : positive) (ofs0 : Z) => store_obligation_1 m b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m))) => store_obligation_2 m b0 ofs0 k H0) (fun b0 : positive => store_obligation_3 chunk1 m b ofs v1 b0)) else @None mem) (if valid_access_dec m chunk2 b ofs Writable then @Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk2 v2) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)) (mem_access m) (nextblock m) (fun (b0 : positive) (ofs0 : Z) => store_obligation_1 m b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m))) => store_obligation_2 m b0 ofs0 k H0) (fun b0 : positive => store_obligation_3 chunk2 m b ofs v2 b0)) else @None mem) *)
  assert (size_chunk chunk1 = size_chunk chunk2).
(* Goal: range_perm m1 b ofs (Z.add ofs (size_chunk chunk)) Cur Writable *)
    repeat rewrite size_chunk_conv.
    rewrite <- (encode_val_length chunk1 v1).
    rewrite <- (encode_val_length chunk2 v2).
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
    congruence.
(* Goal: @eq (option mem) (if valid_access_dec m chunk1 b ofs Writable then @Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk1 v1) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)) (mem_access m) (nextblock m) (fun (b0 : positive) (ofs0 : Z) => store_obligation_1 m b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m))) => store_obligation_2 m b0 ofs0 k H0) (fun b0 : positive => store_obligation_3 chunk1 m b ofs v1 b0)) else @None mem) (if valid_access_dec m chunk2 b ofs Writable then @Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk2 v2) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)) (mem_access m) (nextblock m) (fun (b0 : positive) (ofs0 : Z) => store_obligation_1 m b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m))) => store_obligation_2 m b0 ofs0 k H0) (fun b0 : positive => store_obligation_3 chunk2 m b ofs v2 b0)) else @None mem) *)
  unfold store.
  destruct (valid_access_dec m chunk1 b ofs Writable);
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (valid_access_dec m chunk2 b ofs Writable); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  f_equal. apply mkmem_ext; auto. congruence.
(* Goal: Ple (nextblock m) (nextblock m') *)
  elim n. apply valid_access_compat with chunk1; auto. omega.
(* Goal: Ple (nextblock m) (nextblock m') *)
  elim n. apply valid_access_compat with chunk2; auto. omega.
Qed.

Theorem store_signed_unsigned_8:
  forall m b ofs v,
  store Mint8signed m b ofs v = store Mint8unsigned m b ofs v.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
Proof. intros. apply store_similar_chunks. apply encode_val_int8_signed_unsigned. auto. Qed.

Theorem store_signed_unsigned_16:
  forall m b ofs v,
  store Mint16signed m b ofs v = store Mint16unsigned m b ofs v.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
Proof. intros. apply store_similar_chunks. apply encode_val_int16_signed_unsigned. auto. Qed.

Theorem store_int8_zero_ext:
  forall m b ofs n,
  store Mint8unsigned m b ofs (Vint (Int.zero_ext 8 n)) =
  store Mint8unsigned m b ofs (Vint n).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
Proof. intros. apply store_similar_chunks. apply encode_val_int8_zero_ext. auto. Qed.

Theorem store_int8_sign_ext:
  forall m b ofs n,
  store Mint8signed m b ofs (Vint (Int.sign_ext 8 n)) =
  store Mint8signed m b ofs (Vint n).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
Proof. intros. apply store_similar_chunks. apply encode_val_int8_sign_ext. auto. Qed.

Theorem store_int16_zero_ext:
  forall m b ofs n,
  store Mint16unsigned m b ofs (Vint (Int.zero_ext 16 n)) =
  store Mint16unsigned m b ofs (Vint n).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
Proof. intros. apply store_similar_chunks. apply encode_val_int16_zero_ext. auto. Qed.

Theorem store_int16_sign_ext:
  forall m b ofs n,
  store Mint16signed m b ofs (Vint (Int.sign_ext 16 n)) =
  store Mint16signed m b ofs (Vint n).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
Proof. intros. apply store_similar_chunks. apply encode_val_int16_sign_ext. auto. Qed.

(*
Theorem store_float64al32:
  forall m b ofs v m',
  store Mfloat64 m b ofs v = Some m' -> store Mfloat64al32 m b ofs v = Some m'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold store; intros.
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (valid_access_dec m Mfloat64 b ofs Writable); try discriminate.
  destruct (valid_access_dec m Mfloat64al32 b ofs Writable).
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite <- H. f_equal. apply mkmem_ext; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  elim n. apply valid_access_compat with Mfloat64; auto. simpl; omega.
Qed.

Theorem storev_float64al32:
  forall m a v m',
  storev Mfloat64 m a v = Some m' -> storev Mfloat64al32 m a v = Some m'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold storev; intros. destruct a; auto. apply store_float64al32; auto.
Qed.
*)

(** ** Properties related to [storebytes]. *)

Theorem range_perm_storebytes:
  forall m1 b ofs bytes,
  range_perm m1 b ofs (ofs + Z.of_nat (length bytes)) Cur Writable ->
  { m2 : mem | storebytes m1 b ofs bytes = Some m2 }.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold storebytes.
  destruct (range_perm_dec m1 b ofs (ofs + Z.of_nat (length bytes)) Cur Writable).
(* Goal: @eq block (nextblock empty) xH *)
  econstructor; reflexivity.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  contradiction.
Defined.

Theorem storebytes_store:
  forall m1 b ofs chunk v m2,
  storebytes m1 b ofs (encode_val chunk v) = Some m2 ->
  (align_chunk chunk | ofs) ->
  store chunk m1 b ofs v = Some m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold storebytes, store. intros.
(* Goal: Val.inject f v1 v3 *)
  destruct (range_perm_dec m1 b ofs (ofs + Z.of_nat (length (encode_val chunk v))) Cur Writable); inv H.
(* Goal: @eq (option mem) (if valid_access_dec m1 chunk b ofs Writable then @Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk v) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1))) (mem_contents m1)) (mem_access m1) (nextblock m1) (fun (b0 : positive) (ofs0 : Z) => store_obligation_1 m1 b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m1))) => store_obligation_2 m1 b0 ofs0 k H0) (fun b0 : positive => store_obligation_3 chunk m1 b ofs v b0)) else @None mem) (@Some mem (mkmem (@PMap.set (ZMap.t memval) b (setN (encode_val chunk v) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1))) (mem_contents m1)) (mem_access m1) (nextblock m1) (fun (b0 : positive) (ofs0 : Z) => storebytes_obligation_1 m1 b0 ofs0) (fun (b0 : positive) (ofs0 : Z) (k : perm_kind) (H0 : not (Plt b0 (nextblock m1))) => storebytes_obligation_2 m1 b0 ofs0 k H0) (fun b0 : positive => storebytes_obligation_3 m1 b ofs (encode_val chunk v) b0))) *)
  destruct (valid_access_dec m1 chunk b ofs Writable).
(* Goal: Ple (nextblock m) (nextblock m') *)
  f_equal. apply mkmem_ext; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  elim n. constructor; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite encode_val_length in r. rewrite size_chunk_conv. auto.
Qed.

Theorem store_storebytes:
  forall m1 b ofs chunk v m2,
  store chunk m1 b ofs v = Some m2 ->
  storebytes m1 b ofs (encode_val chunk v) = Some m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold storebytes, store. intros.
(* Goal: Val.inject f v1 v3 *)
  destruct (valid_access_dec m1 chunk b ofs Writable); inv H.
  destruct (range_perm_dec m1 b ofs (ofs + Z.of_nat (length (encode_val chunk v))) Cur Writable).
(* Goal: Ple (nextblock m) (nextblock m') *)
  f_equal. apply mkmem_ext; auto.
(* Goal: @eq (option mem) (@None mem) (@Some mem m2) *)
  destruct v0.  elim n.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite encode_val_length. rewrite <- size_chunk_conv. auto.
Qed.

Section STOREBYTES.
Variable m1: mem.
Variable b: block.
Variable ofs: Z.
Variable bytes: list memval.
Variable m2: mem.
Hypothesis STORE: storebytes m1 b ofs bytes = Some m2.

Lemma storebytes_access: mem_access m2 = mem_access m1.
Proof.
(* Goal: range_perm m1 b ofs (Z.add ofs (Z.of_nat (@Datatypes.length memval bytes))) Cur Writable *)
  unfold storebytes in STORE.
  destruct (range_perm_dec m1 b ofs (ofs + Z.of_nat (length bytes)) Cur Writable);
  inv STORE.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Lemma storebytes_mem_contents:
   mem_contents m2 = PMap.set b (setN bytes ofs m1.(mem_contents)#b) m1.(mem_contents).
Proof.
(* Goal: range_perm m1 b ofs (Z.add ofs (Z.of_nat (@Datatypes.length memval bytes))) Cur Writable *)
  unfold storebytes in STORE.
  destruct (range_perm_dec m1 b ofs (ofs + Z.of_nat (length bytes)) Cur Writable);
  inv STORE.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Theorem perm_storebytes_1:
  forall b' ofs' k p, perm m1 b' ofs' k p -> perm m2 b' ofs' k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold perm in *. rewrite storebytes_access; auto.
Qed.

Theorem perm_storebytes_2:
  forall b' ofs' k p, perm m2 b' ofs' k p -> perm m1 b' ofs' k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold perm in *. rewrite storebytes_access in H; auto.
Qed.

Local Hint Resolve perm_storebytes_1 perm_storebytes_2: mem.

Theorem storebytes_valid_access_1:
  forall chunk' b' ofs' p,
  valid_access m1 chunk' b' ofs' p -> valid_access m2 chunk' b' ofs' p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor; try red; auto with mem.
Qed.

Theorem storebytes_valid_access_2:
  forall chunk' b' ofs' p,
  valid_access m2 chunk' b' ofs' p -> valid_access m1 chunk' b' ofs' p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor; try red; auto with mem.
Qed.

Local Hint Resolve storebytes_valid_access_1 storebytes_valid_access_2: mem.

Theorem nextblock_storebytes:
  nextblock m2 = nextblock m1.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: range_perm m1 b ofs (Z.add ofs (Z.of_nat (@Datatypes.length memval bytes))) Cur Writable *)
  unfold storebytes in STORE.
  destruct (range_perm_dec m1 b ofs (ofs + Z.of_nat (length bytes)) Cur Writable);
  inv STORE.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Theorem storebytes_valid_block_1:
  forall b', valid_block m1 b' -> valid_block m2 b'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold valid_block; intros. rewrite nextblock_storebytes; auto.
Qed.

Theorem storebytes_valid_block_2:
  forall b', valid_block m2 b' -> valid_block m1 b'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold valid_block; intros. rewrite nextblock_storebytes in H; auto.
Qed.

Local Hint Resolve storebytes_valid_block_1 storebytes_valid_block_2: mem.

Theorem storebytes_range_perm:
  range_perm m1 b ofs (ofs + Z.of_nat (length bytes)) Cur Writable.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: range_perm m1 b ofs (Z.add ofs (Z.of_nat (@Datatypes.length memval bytes))) Cur Writable *)
  unfold storebytes in STORE.
  destruct (range_perm_dec m1 b ofs (ofs + Z.of_nat (length bytes)) Cur Writable);
  inv STORE.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Theorem loadbytes_storebytes_same:
  loadbytes m2 b ofs (Z.of_nat (length bytes)) = Some bytes.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. assert (STORE2:=STORE). unfold storebytes in STORE2. unfold loadbytes.
  destruct (range_perm_dec m1 b ofs (ofs + Z.of_nat (length bytes)) Cur Writable);
(* Goal: range_perm m b lo hi Cur Freeable *)
  try discriminate.
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  rewrite pred_dec_true.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  decEq. inv STORE2; simpl. rewrite PMap.gss. rewrite nat_of_Z_of_nat.
(* Goal: @eq (list memval) (getN (@Datatypes.length memval bytes) ofs (setN bytes ofs (@PMap.get (ZMap.t memval) b (mem_contents m1)))) bytes *)
(* Goal: range_perm m2 b ofs (Z.add ofs (Z.of_nat (@Datatypes.length memval bytes))) Cur Readable *)
  apply getN_setN_same.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  red; eauto with mem.
Qed.

Theorem loadbytes_storebytes_disjoint:
  forall b' ofs' len,
  len >= 0 ->
  b' <> b \/ Intv.disjoint (ofs', ofs' + len) (ofs, ofs + Z.of_nat (length bytes)) ->
  loadbytes m2 b' ofs' len = loadbytes m1 b' ofs' len.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold loadbytes.
  destruct (range_perm_dec m1 b' ofs' (ofs' + len) Cur Readable).
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  rewrite pred_dec_true.
(* Goal: @eq (prod block Z) (@pair block Z y (Z.add delta Z0)) (@pair block Z y delta) *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite storebytes_mem_contents. decEq.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  rewrite PMap.gsspec. destruct (peq b' b). subst b'.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply getN_setN_disjoint. rewrite nat_of_Z_eq; auto. intuition congruence.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: range_perm m2 b' ofs (Z.add ofs (size_chunk chunk)) Cur p *)
  red; auto with mem.
(* Goal: @eq (option (prod block Z)) (if plt b (nextblock m) then @Some (prod block Z) (@pair block Z b Z0) else @None (prod block Z)) (@None (prod block Z)) *)
(* Goal: forall (b b' : block) (delta : Z) (_ : @eq (option (prod block Z)) (flat_inj (nextblock m) b) (@Some (prod block Z) (@pair block Z b' delta))), valid_block m b' *)
(* Goal: meminj_no_overlap (flat_inj (nextblock m)) m *)
(* Goal: forall (b b' : block) (delta : Z) (ofs : Ptrofs.int) (_ : @eq (option (prod block Z)) (flat_inj (nextblock m) b) (@Some (prod block Z) (@pair block Z b' delta))) (_ : or (perm m b (Ptrofs.unsigned ofs) Max Nonempty) (perm m b (Z.sub (Ptrofs.unsigned ofs) (Zpos xH)) Max Nonempty)), and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: forall (b1 : block) (ofs : Z) (b2 : block) (delta : Z) (k : perm_kind) (p : permission) (_ : @eq (option (prod block Z)) (flat_inj (nextblock m) b1) (@Some (prod block Z) (@pair block Z b2 delta))) (_ : perm m b2 (Z.add ofs delta) k p), or (perm m b1 ofs k p) (not (perm m b1 ofs Max Nonempty)) *)
  apply pred_dec_false.
(* Goal: @eq (option mem) (@None mem) (@Some mem m2) *)
  red; intros; elim n. red; auto with mem.
Qed.

Theorem loadbytes_storebytes_other:
  forall b' ofs' len,
  len >= 0 ->
  b' <> b
  \/ ofs' + len <= ofs
  \/ ofs + Z.of_nat (length bytes) <= ofs' ->
  loadbytes m2 b' ofs' len = loadbytes m1 b' ofs' len.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. apply loadbytes_storebytes_disjoint; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct H0; auto. right. apply Intv.disjoint_range; auto.
Qed.

Theorem load_storebytes_other:
  forall chunk b' ofs',
  b' <> b
  \/ ofs' + size_chunk chunk <= ofs
  \/ ofs + Z.of_nat (length bytes) <= ofs' ->
  load chunk m2 b' ofs' = load chunk m1 b' ofs'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold load.
(* Goal: @eq (option val) (if valid_access_dec m2 chunk b' ofs' Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs' (@PMap.get (ZMap.t memval) b' (mem_contents m2)))) else @None val) (if valid_access_dec m1 chunk b' ofs' Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs' (@PMap.get (ZMap.t memval) b' (mem_contents m1)))) else @None val) *)
  destruct (valid_access_dec m1 chunk b' ofs' Readable).
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  rewrite pred_dec_true.
(* Goal: @eq (prod block Z) (@pair block Z y (Z.add delta Z0)) (@pair block Z y delta) *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite storebytes_mem_contents. decEq.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  rewrite PMap.gsspec. destruct (peq b' b). subst b'.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite getN_setN_outside. auto. rewrite <- size_chunk_conv. intuition congruence.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct v; split; auto. red; auto with mem.
(* Goal: @eq (option (prod block Z)) (if plt b (nextblock m) then @Some (prod block Z) (@pair block Z b Z0) else @None (prod block Z)) (@None (prod block Z)) *)
(* Goal: forall (b b' : block) (delta : Z) (_ : @eq (option (prod block Z)) (flat_inj (nextblock m) b) (@Some (prod block Z) (@pair block Z b' delta))), valid_block m b' *)
(* Goal: meminj_no_overlap (flat_inj (nextblock m)) m *)
(* Goal: forall (b b' : block) (delta : Z) (ofs : Ptrofs.int) (_ : @eq (option (prod block Z)) (flat_inj (nextblock m) b) (@Some (prod block Z) (@pair block Z b' delta))) (_ : or (perm m b (Ptrofs.unsigned ofs) Max Nonempty) (perm m b (Z.sub (Ptrofs.unsigned ofs) (Zpos xH)) Max Nonempty)), and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: forall (b1 : block) (ofs : Z) (b2 : block) (delta : Z) (k : perm_kind) (p : permission) (_ : @eq (option (prod block Z)) (flat_inj (nextblock m) b1) (@Some (prod block Z) (@pair block Z b2 delta))) (_ : perm m b2 (Z.add ofs delta) k p), or (perm m b1 ofs k p) (not (perm m b1 ofs Max Nonempty)) *)
  apply pred_dec_false.
(* Goal: Ple (nextblock m) (nextblock m') *)
  red; intros; elim n. destruct H0. split; auto. red; auto with mem.
Qed.

End STOREBYTES.

Lemma setN_concat:
  forall bytes1 bytes2 ofs c,
  setN (bytes1 ++ bytes2) ofs c = setN bytes2 (ofs + Z.of_nat (length bytes1)) (setN bytes1 ofs c).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  induction bytes1; intros.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  simpl. decEq. omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  simpl length. rewrite Nat2Z.inj_succ. simpl. rewrite IHbytes1. decEq. omega.
Qed.

Theorem storebytes_concat:
  forall m b ofs bytes1 m1 bytes2 m2,
  storebytes m b ofs bytes1 = Some m1 ->
  storebytes m1 b (ofs + Z.of_nat(length bytes1)) bytes2 = Some m2 ->
  storebytes m b ofs (bytes1 ++ bytes2) = Some m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. generalize H; intro ST1. generalize H0; intro ST2.
(* Goal: @eq (option mem) (storebytes m b ofs (@app memval bytes1 bytes2)) (@Some mem m2) *)
  unfold storebytes; unfold storebytes in ST1; unfold storebytes in ST2.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  destruct (range_perm_dec m b ofs (ofs + Z.of_nat(length bytes1)) Cur Writable); try congruence.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  destruct (range_perm_dec m1 b (ofs + Z.of_nat(length bytes1)) (ofs + Z.of_nat(length bytes1) + Z.of_nat(length bytes2)) Cur Writable); try congruence.
  destruct (range_perm_dec m b ofs (ofs + Z.of_nat (length (bytes1 ++ bytes2))) Cur Writable).
(* Goal: Ple (nextblock m) (nextblock m') *)
  inv ST1; inv ST2; simpl. decEq. apply mkmem_ext; auto.
(* Goal: forall _ : perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) b (fun (ofs : Z) (k : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (mem_access m)) ofs k) p', perm_order p p' *)
  rewrite PMap.gss.  rewrite setN_concat. symmetry. apply PMap.set2.
(* Goal: @eq (option mem) (@None mem) (@Some mem m2) *)
  elim n.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  rewrite app_length. rewrite Nat2Z.inj_add. red; intros.
  destruct (zlt ofs0 (ofs + Z.of_nat(length bytes1))).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  apply r. omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_storebytes_2; eauto. apply r0. omega.
Qed.

Theorem storebytes_split:
  forall m b ofs bytes1 bytes2 m2,
  storebytes m b ofs (bytes1 ++ bytes2) = Some m2 ->
  exists m1,
     storebytes m b ofs bytes1 = Some m1
  /\ storebytes m1 b (ofs + Z.of_nat(length bytes1)) bytes2 = Some m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  destruct (range_perm_storebytes m b ofs bytes1) as [m1 ST1].
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. exploit storebytes_range_perm; eauto. rewrite app_length.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  rewrite Nat2Z.inj_add. omega.
  destruct (range_perm_storebytes m1 b (ofs + Z.of_nat (length bytes1)) bytes2) as [m2' ST2].
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply perm_storebytes_1; eauto. exploit storebytes_range_perm.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  eexact H. instantiate (1 := ofs0). rewrite app_length. rewrite Nat2Z.inj_add. omega.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
  assert (Some m2 = Some m2').
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite <- H. eapply storebytes_concat; eauto.
(* Goal: Val.inject f v1 v3 *)
  inv H0.
(* Goal: Ple (nextblock m) (nextblock m') *)
  exists m1; split; auto.
Qed.

Theorem store_int64_split:
  forall m b ofs v m',
  store Mint64 m b ofs v = Some m' -> Archi.ptr64 = false ->
  exists m1,
     store Mint32 m b ofs (if Archi.big_endian then Val.hiword v else Val.loword v) = Some m1
  /\ store Mint32 m1 b (ofs + 4) (if Archi.big_endian then Val.loword v else Val.hiword v) = Some m'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit store_valid_access_3; eauto. intros [A B]. simpl in *.
  exploit store_storebytes. eexact H. intros SB.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite encode_val_int64 in SB by auto.
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  exploit storebytes_split. eexact SB. intros [m1 [SB1 SB2]].
  rewrite encode_val_length in SB2. simpl in SB2.
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  exists m1; split.
  apply storebytes_store. exact SB1.
(* Goal: Ple (nextblock m) (nextblock m') *)
  simpl. apply Zdivides_trans with 8; auto. exists 2; auto.
  apply storebytes_store. exact SB2.
(* Goal: Ple (nextblock m) (nextblock m') *)
  simpl. apply Z.divide_add_r. apply Zdivides_trans with 8; auto. exists 2; auto. exists 1; auto.
Qed.

Theorem storev_int64_split:
  forall m a v m',
  storev Mint64 m a v = Some m' -> Archi.ptr64 = false ->
  exists m1,
     storev Mint32 m a (if Archi.big_endian then Val.hiword v else Val.loword v) = Some m1
  /\ storev Mint32 m1 (Val.add a (Vint (Int.repr 4))) (if Archi.big_endian then Val.loword v else Val.hiword v) = Some m'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct a; simpl in H; inv H. rewrite H2.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit store_int64_split; eauto. intros [m1 [A B]].
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  exists m1; split.
  exact A.
(* Goal: @eq val v Vundef *)
  unfold storev, Val.add. rewrite H0.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite addressing_int64_split; auto.
  exploit store_valid_access_3. eexact H2. intros [P Q]. exact Q.
Qed.

(** ** Properties related to [alloc]. *)

Section ALLOC.

Variable m1: mem.
Variables lo hi: Z.
Variable m2: mem.
Variable b: block.
Hypothesis ALLOC: alloc m1 lo hi = (m2, b).

Theorem nextblock_alloc:
  nextblock m2 = Pos.succ (nextblock m1).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  injection ALLOC; intros. rewrite <- H0; auto.
Qed.

Theorem alloc_result:
  b = nextblock m1.
Proof.
(* Goal: Ple (nextblock m) (nextblock m') *)
  injection ALLOC; auto.
Qed.

Theorem valid_block_alloc:
  forall b', valid_block m1 b' -> valid_block m2 b'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold valid_block; intros. rewrite nextblock_alloc.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply Plt_trans_succ; auto.
Qed.

Theorem fresh_block_alloc:
  ~(valid_block m1 b).
Proof.
(* Goal: iff (valid_block m1 b) (valid_block m2 b) *)
  unfold valid_block. rewrite alloc_result. apply Plt_strict.
Qed.

Theorem valid_new_block:
  valid_block m2 b.
Proof.
(* Goal: Plt (nextblock m1) (Pos.succ (nextblock m1)) *)
  unfold valid_block. rewrite alloc_result. rewrite nextblock_alloc. apply Plt_succ.
Qed.

Local Hint Resolve valid_block_alloc fresh_block_alloc valid_new_block: mem.

Theorem valid_block_alloc_inv:
  forall b', valid_block m2 b' -> b' = b \/ valid_block m1 b'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold valid_block; intros.
(* Goal: or (@eq block b' b) (Plt b' (nextblock m1)) *)
  rewrite nextblock_alloc in H. rewrite alloc_result.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit Plt_succ_inv; eauto. tauto.
Qed.

Theorem perm_alloc_1:
  forall b' ofs k p, perm m1 b' ofs k p -> perm m2 b' ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold perm; intros. injection ALLOC; intros. rewrite <- H1; simpl.
(* Goal: Ple (nextblock m) (nextblock m') *)
  subst b. rewrite PMap.gsspec. destruct (peq b' (nextblock m1)); auto.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  rewrite nextblock_noaccess in H. contradiction. subst b'. apply Plt_strict.
Qed.

Theorem perm_alloc_2:
  forall ofs k, lo <= ofs < hi -> perm m2 b ofs k Freeable.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold perm; intros. injection ALLOC; intros. rewrite <- H1; simpl.
(* Goal: or (not (@eq block b2 b)) (or (Z.lt (Z.add ofs delta) lo) (Z.le hi (Z.add ofs delta))) *)
(* Goal: mem_inj f m1 m2' *)
  subst b. rewrite PMap.gss. unfold proj_sumbool. rewrite zle_true.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  rewrite zlt_true. simpl. auto with mem. omega. omega.
Qed.

Theorem perm_alloc_inv:
  forall b' ofs k p,
  perm m2 b' ofs k p ->
  if eq_block b' b then lo <= ofs < hi else perm m1 b' ofs k p.
Proof.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  intros until p; unfold perm. inv ALLOC. simpl.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  rewrite PMap.gsspec. unfold eq_block. destruct (peq b' (nextblock m1)); intros.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  destruct (zle lo ofs); try contradiction. destruct (zlt ofs hi); try contradiction.
(* Goal: Ple (nextblock m) (nextblock m') *)
  split; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Theorem perm_alloc_3:
  forall ofs k p, perm m2 b ofs k p -> lo <= ofs < hi.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit perm_alloc_inv; eauto. rewrite dec_eq_true; auto.
Qed.

Theorem perm_alloc_4:
  forall b' ofs k p, perm m2 b' ofs k p -> b' <> b -> perm m1 b' ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit perm_alloc_inv; eauto. rewrite dec_eq_false; auto.
Qed.

Local Hint Resolve perm_alloc_1 perm_alloc_2 perm_alloc_3 perm_alloc_4: mem.

Theorem valid_access_alloc_other:
  forall chunk b' ofs p,
  valid_access m1 chunk b' ofs p ->
  valid_access m2 chunk b' ofs p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor; auto with mem.
(* Goal: range_perm m2 b' ofs (Z.add ofs (size_chunk chunk)) Cur p *)
  red; auto with mem.
Qed.

Theorem valid_access_alloc_same:
  forall chunk ofs,
  lo <= ofs -> ofs + size_chunk chunk <= hi -> (align_chunk chunk | ofs) ->
  valid_access m2 chunk b ofs Freeable.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. constructor; auto with mem.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. apply perm_alloc_2. omega.
Qed.

Local Hint Resolve valid_access_alloc_other valid_access_alloc_same: mem.

Theorem valid_access_alloc_inv:
  forall chunk b' ofs p,
  valid_access m2 chunk b' ofs p ->
  if eq_block b' b
  then lo <= ofs /\ ofs + size_chunk chunk <= hi /\ (align_chunk chunk | ofs)
  else valid_access m1 chunk b' ofs p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H.
  generalize (size_chunk_pos chunk); intro.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  destruct (eq_block b' b). subst b'.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  assert (perm m2 b ofs Cur p). apply H0. omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  assert (perm m2 b (ofs + size_chunk chunk - 1) Cur p). apply H0. omega.
  exploit perm_alloc_inv. eexact H2. rewrite dec_eq_true. intro.
  exploit perm_alloc_inv. eexact H3. rewrite dec_eq_true. intro.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  intuition omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  split; auto. red; intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit perm_alloc_inv. apply H0. eauto. rewrite dec_eq_false; auto.
Qed.

Theorem load_alloc_unchanged:
  forall chunk b' ofs,
  valid_block m1 b' ->
  load chunk m2 b' ofs = load chunk m1 b' ofs.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold load.
(* Goal: @eq (option val) (if valid_access_dec m2 chunk b' ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m2)))) else @None val) (if valid_access_dec m1 chunk b' ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m1)))) else @None val) *)
  destruct (valid_access_dec m2 chunk b' ofs Readable).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  exploit valid_access_alloc_inv; eauto. destruct (eq_block b' b); intros.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  subst b'. elimtype False. eauto with mem.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_true; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  injection ALLOC; intros. rewrite <- H2; simpl.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite PMap.gso. auto. rewrite H1. apply not_eq_sym; eauto with mem.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_false. auto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
Qed.

Theorem load_alloc_other:
  forall chunk b' ofs v,
  load chunk m1 b' ofs = Some v ->
  load chunk m2 b' ofs = Some v.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite <- H. apply load_alloc_unchanged. eauto with mem.
Qed.

Theorem load_alloc_same:
  forall chunk ofs v,
  load chunk m2 b ofs = Some v ->
  v = Vundef.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit load_result; eauto. intro. rewrite H0.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  injection ALLOC; intros. rewrite <- H2; simpl. rewrite <- H1.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite PMap.gss. destruct (size_chunk_nat_pos chunk) as [n E]. rewrite E. simpl.
(* Goal: memval_inject f (@ZMap.get memval ofs (@ZMap.init memval Undef)) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2))) *)
(* Goal: memval_inject f (@ZMap.get memval ofs (@PMap.get (prod memval (PTree.t memval)) b0 (mem_contents m1))) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2))) *)
  rewrite ZMap.gi. apply decode_val_undef.
Qed.

Theorem load_alloc_same':
  forall chunk ofs,
  lo <= ofs -> ofs + size_chunk chunk <= hi -> (align_chunk chunk | ofs) ->
  load chunk m2 b ofs = Some Vundef.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. assert (exists v, load chunk m2 b ofs = Some v).
(* Goal: Ple (nextblock m) (nextblock m') *)
    apply valid_access_load. constructor; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    red; intros. eapply perm_implies. apply perm_alloc_2. omega. auto with mem.
(* Goal: @eq (prod block Z) (@pair block Z y (Z.add delta Z0)) (@pair block Z y delta) *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct H2 as [v LOAD]. rewrite LOAD. decEq.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply load_alloc_same; eauto.
Qed.

Theorem loadbytes_alloc_unchanged:
  forall b' ofs n,
  valid_block m1 b' ->
  loadbytes m2 b' ofs n = loadbytes m1 b' ofs n.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold loadbytes.
  destruct (range_perm_dec m1 b' ofs (ofs + n) Cur Readable).
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  rewrite pred_dec_true.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  injection ALLOC; intros A B. rewrite <- B; simpl.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite PMap.gso. auto. rewrite A. eauto with mem.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply perm_alloc_1; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_false; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros; elim n0. red; intros. eapply perm_alloc_4; eauto. eauto with mem.
Qed.

Theorem loadbytes_alloc_same:
  forall n ofs bytes byte,
  loadbytes m2 b ofs n = Some bytes ->
  In byte bytes -> byte = Undef.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold loadbytes; intros. destruct (range_perm_dec m2 b ofs (ofs + n) Cur Readable); inv H.
(* Goal: perm_order p p' *)
  revert H0.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  injection ALLOC; intros A B. rewrite <- A; rewrite <- B; simpl. rewrite PMap.gss.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  generalize (nat_of_Z n) ofs. induction n0; simpl; intros.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  contradiction.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite ZMap.gi in H0. destruct H0; eauto.
Qed.

End ALLOC.

Local Hint Resolve valid_block_alloc fresh_block_alloc valid_new_block: mem.
Local Hint Resolve valid_access_alloc_other valid_access_alloc_same: mem.

(** ** Properties related to [free]. *)

Theorem range_perm_free:
  forall m1 b lo hi,
  range_perm m1 b lo hi Cur Freeable ->
  { m2: mem | free m1 b lo hi = Some m2 }.
Proof.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  intros; unfold free. rewrite pred_dec_true; auto. econstructor; eauto.
Defined.

Section FREE.

Variable m1: mem.
Variable bf: block.
Variables lo hi: Z.
Variable m2: mem.
Hypothesis FREE: free m1 bf lo hi = Some m2.

Theorem free_range_perm:
  range_perm m1 bf lo hi Cur Freeable.
Proof.
(* Goal: Ple (nextblock m) (nextblock m') *)
  unfold free in FREE. destruct (range_perm_dec m1 bf lo hi Cur Freeable); auto.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
Qed.

Lemma free_result:
  m2 = unchecked_free m1 bf lo hi.
Proof.
(* Goal: @eq mem m2 (unchecked_free m1 bf lo hi) *)
  unfold free in FREE. destruct (range_perm_dec m1 bf lo hi Cur Freeable).
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence. congruence.
Qed.

Theorem nextblock_free:
  nextblock m2 = nextblock m1.
Proof.
(* Goal: @eq block (nextblock empty) xH *)
  rewrite free_result; reflexivity.
Qed.

Theorem valid_block_free_1:
  forall b, valid_block m1 b -> valid_block m2 b.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite free_result. assumption.
Qed.

Theorem valid_block_free_2:
  forall b, valid_block m2 b -> valid_block m1 b.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite free_result in H. assumption.
Qed.

Local Hint Resolve valid_block_free_1 valid_block_free_2: mem.

Theorem perm_free_1:
  forall b ofs k p,
  b <> bf \/ ofs < lo \/ hi <= ofs ->
  perm m1 b ofs k p ->
  perm m2 b ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite free_result. unfold perm, unchecked_free; simpl.
(* Goal: or (not (@eq block b2 b)) (or (Z.lt (Z.add ofs delta) lo) (Z.le hi (Z.add ofs delta))) *)
(* Goal: mem_inj f m1 m2' *)
  rewrite PMap.gsspec. destruct (peq b bf). subst b.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  destruct (zle lo ofs); simpl.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  destruct (zlt ofs hi); simpl.
(* Goal: perm_order p Readable *)
(* Goal: perm m' b' ofs0 Cur Readable *)
(* Goal: @eq (option (list memval)) (if range_perm_dec m' b' ofs (Z.add ofs n) Cur Readable then @Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m'))) else @None (list memval)) (@None (list memval)) *)
  elimtype False; intuition.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Theorem perm_free_2:
  forall ofs k p, lo <= ofs < hi -> ~ perm m2 bf ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite free_result. unfold perm, unchecked_free; simpl.
(* Goal: forall _ : perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) b (fun (ofs : Z) (k : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) (mem_access m)) ofs k) p', perm_order p p' *)
  rewrite PMap.gss. unfold proj_sumbool. rewrite zle_true. rewrite zlt_true.
(* Goal: Ple (nextblock m) (nextblock m') *)
  simpl. tauto. omega. omega.
Qed.

Theorem perm_free_3:
  forall b ofs k p,
  perm m2 b ofs k p -> perm m1 b ofs k p.
Proof.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  intros until p. rewrite free_result. unfold perm, unchecked_free; simpl.
(* Goal: or (not (@eq block b2 b)) (or (Z.lt (Z.add ofs delta) lo) (Z.le hi (Z.add ofs delta))) *)
(* Goal: mem_inj f m1 m2' *)
  rewrite PMap.gsspec. destruct (peq b bf). subst b.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  destruct (zle lo ofs); simpl.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zlt ofs hi); simpl. tauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto. auto. auto.
Qed.

Theorem perm_free_inv:
  forall b ofs k p,
  perm m1 b ofs k p ->
  (b = bf /\ lo <= ofs < hi) \/ perm m2 b ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite free_result. unfold perm, unchecked_free; simpl.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite PMap.gsspec. destruct (peq b bf); auto. subst b.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zle lo ofs); simpl; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zlt ofs hi); simpl; auto.
Qed.

Theorem valid_access_free_1:
  forall chunk b ofs p,
  valid_access m1 chunk b ofs p ->
  b <> bf \/ lo >= hi \/ ofs + size_chunk chunk <= lo \/ hi <= ofs ->
  valid_access m2 chunk b ofs p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor; auto with mem.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply perm_free_1; eauto.
(* Goal: or (not (@eq block b bf)) (or (Z.lt ofs0 lo) (Z.le hi ofs0)) *)
  destruct (zlt lo hi). intuition. right. omega.
Qed.

Theorem valid_access_free_2:
  forall chunk ofs p,
  lo < hi -> ofs + size_chunk chunk > lo -> ofs < hi ->
  ~(valid_access m2 chunk bf ofs p).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros; red; intros. inv H2.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  generalize (size_chunk_pos chunk); intros.
(* Goal: False *)
  destruct (zlt ofs lo).
(* Goal: False *)
(* Goal: False *)
  elim (perm_free_2 lo Cur p).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  omega. apply H3. omega.
(* Goal: False *)
  elim (perm_free_2 ofs Cur p).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  omega. apply H3. omega.
Qed.

Theorem valid_access_free_inv_1:
  forall chunk b ofs p,
  valid_access m2 chunk b ofs p ->
  valid_access m1 chunk b ofs p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H. split; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. generalize (H ofs0 H1).
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite free_result. unfold perm, unchecked_free; simpl.
(* Goal: or (not (@eq block b2 b)) (or (Z.lt (Z.add ofs delta) lo) (Z.le hi (Z.add ofs delta))) *)
(* Goal: mem_inj f m1 m2' *)
  rewrite PMap.gsspec. destruct (peq b bf). subst b.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  destruct (zle lo ofs0); simpl.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  destruct (zlt ofs0 hi); simpl.
(* Goal: Ple (nextblock m) (nextblock m') *)
  tauto. auto. auto. auto.
Qed.

Theorem valid_access_free_inv_2:
  forall chunk ofs p,
  valid_access m2 chunk bf ofs p ->
  lo >= hi \/ ofs + size_chunk chunk <= lo \/ hi <= ofs.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zlt lo hi); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zle (ofs + size_chunk chunk) lo); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zle hi ofs); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  elim (valid_access_free_2 chunk ofs p); auto. omega.
Qed.

Theorem load_free:
  forall chunk b ofs,
  b <> bf \/ lo >= hi \/ ofs + size_chunk chunk <= lo \/ hi <= ofs ->
  load chunk m2 b ofs = load chunk m1 b ofs.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold load.
(* Goal: @eq (option val) (if valid_access_dec m2 chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m2)))) else @None val) (if valid_access_dec m1 chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m1)))) else @None val) *)
  destruct (valid_access_dec m2 chunk b ofs Readable).
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  rewrite pred_dec_true.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite free_result; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply valid_access_free_inv_1; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_false; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  red; intro; elim n. eapply valid_access_free_1; eauto.
Qed.

Theorem load_free_2:
  forall chunk b ofs v,
  load chunk m2 b ofs = Some v -> load chunk m1 b ofs = Some v.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold load. rewrite pred_dec_true.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite (load_result _ _ _ _ _ H). rewrite free_result; auto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  apply valid_access_free_inv_1. eauto with mem.
Qed.

Theorem loadbytes_free:
  forall b ofs n,
  b <> bf \/ lo >= hi \/ ofs + n <= lo \/ hi <= ofs ->
  loadbytes m2 b ofs n = loadbytes m1 b ofs n.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold loadbytes.
  destruct (range_perm_dec m2 b ofs (ofs + n) Cur Readable).
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  rewrite pred_dec_true.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite free_result; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply perm_free_3; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_false; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. elim n0; red; intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_free_1; eauto. destruct H; auto. right; omega.
Qed.

Theorem loadbytes_free_2:
  forall b ofs n bytes,
  loadbytes m2 b ofs n = Some bytes -> loadbytes m1 b ofs n = Some bytes.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold loadbytes in *.
(* Goal: Val.inject f v1 v3 *)
  destruct (range_perm_dec m2 b ofs (ofs + n) Cur Readable); inv H.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_true. rewrite free_result; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. apply perm_free_3; auto.
Qed.

End FREE.

Local Hint Resolve valid_block_free_1 valid_block_free_2
             perm_free_1 perm_free_2 perm_free_3
             valid_access_free_1 valid_access_free_inv_1: mem.

(** ** Properties related to [drop_perm] *)

Theorem range_perm_drop_1:
  forall m b lo hi p m', drop_perm m b lo hi p = Some m' -> range_perm m b lo hi Cur Freeable.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold drop_perm; intros.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (range_perm_dec m b lo hi Cur Freeable). auto. discriminate.
Qed.

Theorem range_perm_drop_2:
  forall m b lo hi p,
  range_perm m b lo hi Cur Freeable -> {m' | drop_perm m b lo hi p = Some m' }.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold drop_perm; intros.
(* Goal: @eq memval byte Undef *)
(* Goal: @eq memval byte Undef *)
  destruct (range_perm_dec m b lo hi Cur Freeable). econstructor. eauto. contradiction.
Defined.

Section DROP.

Variable m: mem.
Variable b: block.
Variable lo hi: Z.
Variable p: permission.
Variable m': mem.
Hypothesis DROP: drop_perm m b lo hi p = Some m'.

Theorem nextblock_drop:
  nextblock m' = nextblock m.
Proof.
(* Goal: Ple (nextblock m) (nextblock m') *)
  unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP; auto.
Qed.

Theorem drop_perm_valid_block_1:
  forall b', valid_block m b' -> valid_block m' b'.
Proof.
(* Goal: Ple (nextblock m) (nextblock m') *)
  unfold valid_block; rewrite nextblock_drop; auto.
Qed.

Theorem drop_perm_valid_block_2:
  forall b', valid_block m' b' -> valid_block m b'.
Proof.
(* Goal: Ple (nextblock m) (nextblock m') *)
  unfold valid_block; rewrite nextblock_drop; auto.
Qed.

Theorem perm_drop_1:
  forall ofs k, lo <= ofs < hi -> perm m' b ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (list memval)) (@Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m')))) (@Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m)))) *)
(* Goal: range_perm m' b' ofs (Z.add ofs n) Cur Readable *)
(* Goal: @eq (option (list memval)) (if range_perm_dec m' b' ofs (Z.add ofs n) Cur Readable then @Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m'))) else @None (list memval)) (@None (list memval)) *)
  unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  unfold perm. simpl. rewrite PMap.gss. unfold proj_sumbool.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  rewrite zle_true. rewrite zlt_true. simpl. constructor.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  omega. omega.
Qed.

Theorem perm_drop_2:
  forall ofs k p', lo <= ofs < hi -> perm m' b ofs k p' -> perm_order p p'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (list memval)) (@Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m')))) (@Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m)))) *)
(* Goal: range_perm m' b' ofs (Z.add ofs n) Cur Readable *)
(* Goal: @eq (option (list memval)) (if range_perm_dec m' b' ofs (Z.add ofs n) Cur Readable then @Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m'))) else @None (list memval)) (@None (list memval)) *)
  unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  revert H0. unfold perm; simpl. rewrite PMap.gss. unfold proj_sumbool.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite zle_true. rewrite zlt_true. simpl. auto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  omega. omega.
Qed.

Theorem perm_drop_3:
  forall b' ofs k p', b' <> b \/ ofs < lo \/ hi <= ofs -> perm m b' ofs k p' -> perm m' b' ofs k p'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (list memval)) (@Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m')))) (@Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m)))) *)
(* Goal: range_perm m' b' ofs (Z.add ofs n) Cur Readable *)
(* Goal: @eq (option (list memval)) (if range_perm_dec m' b' ofs (Z.add ofs n) Cur Readable then @Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m'))) else @None (list memval)) (@None (list memval)) *)
  unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  unfold perm; simpl. rewrite PMap.gsspec. destruct (peq b' b). subst b'.
(* Goal: forall _ : perm_order' (if andb (if zle lo ofs then true else false) (if zlt ofs hi then true else false) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p', perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p' *)
(* Goal: forall _ : perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b' (mem_access m) ofs k) p', perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b' (mem_access m) ofs k) p' *)
  unfold proj_sumbool. destruct (zle lo ofs). destruct (zlt ofs hi).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  byContradiction. intuition omega.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto. auto. auto.
Qed.

Theorem perm_drop_4:
  forall b' ofs k p', perm m' b' ofs k p' -> perm m b' ofs k p'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (list memval)) (@Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m')))) (@Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m)))) *)
(* Goal: range_perm m' b' ofs (Z.add ofs n) Cur Readable *)
(* Goal: @eq (option (list memval)) (if range_perm_dec m' b' ofs (Z.add ofs n) Cur Readable then @Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m'))) else @None (list memval)) (@None (list memval)) *)
  unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  revert H. unfold perm; simpl. rewrite PMap.gsspec. destruct (peq b' b).
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  subst b'. unfold proj_sumbool. destruct (zle lo ofs). destruct (zlt ofs hi).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  simpl. intros. apply perm_implies with p. apply perm_implies with Freeable. apply perm_cur.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply r. tauto. auto with mem. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto. auto. auto.
Qed.

Lemma valid_access_drop_1:
  forall chunk b' ofs p',
  b' <> b \/ ofs + size_chunk chunk <= lo \/ hi <= ofs \/ perm_order p p' ->
  valid_access m chunk b' ofs p' -> valid_access m' chunk b' ofs p'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H0. split; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  destruct (eq_block b' b). subst b'.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct (zlt ofs0 lo). eapply perm_drop_3; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct (zle hi ofs0). eapply perm_drop_3; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  apply perm_implies with p. eapply perm_drop_1; eauto. omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  generalize (size_chunk_pos chunk); intros. intuition.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_drop_3; eauto.
Qed.

Lemma valid_access_drop_2:
  forall chunk b' ofs p',
  valid_access m' chunk b' ofs p' -> valid_access m chunk b' ofs p'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H; split; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply perm_drop_4; eauto.
Qed.

Theorem load_drop:
  forall chunk b' ofs,
  b' <> b \/ ofs + size_chunk chunk <= lo \/ hi <= ofs \/ perm_order p Readable ->
  load chunk m' b' ofs = load chunk m b' ofs.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option val) (load chunk m' b ofs) (load chunk m b ofs) *)
  unfold load.
(* Goal: @eq (option val) (if valid_access_dec m' chunk b' ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m')))) else @None val) (if valid_access_dec m chunk b' ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m)))) else @None val) *)
  destruct (valid_access_dec m chunk b' ofs Readable).
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  rewrite pred_dec_true.
(* Goal: Ple (nextblock m) (nextblock m') *)
  unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP. simpl. auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply valid_access_drop_1; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_false. auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  red; intros; elim n. eapply valid_access_drop_2; eauto.
Qed.

Theorem loadbytes_drop:
  forall b' ofs n,
  b' <> b \/ ofs + n <= lo \/ hi <= ofs \/ perm_order p Readable ->
  loadbytes m' b' ofs n = loadbytes m b' ofs n.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (list memval)) (loadbytes m' b ofs n) (loadbytes m b ofs n) *)
  unfold loadbytes.
  destruct (range_perm_dec m b' ofs (ofs + n) Cur Readable).
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  rewrite pred_dec_true.
(* Goal: Ple (nextblock m) (nextblock m') *)
  unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP. simpl. auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  destruct (eq_block b' b). subst b'.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct (zlt ofs0 lo). eapply perm_drop_3; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct (zle hi ofs0). eapply perm_drop_3; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  apply perm_implies with p. eapply perm_drop_1; eauto. omega. intuition.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_drop_3; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite pred_dec_false; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros; elim n0; red; intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_drop_4; eauto.
Qed.

End DROP.

(** * Generic injections *)

(** A memory state [m1] generically injects into another memory state [m2] via the
  memory injection [f] if the following conditions hold:
- each access in [m2] that corresponds to a valid access in [m1]
  is itself valid;
- the memory value associated in [m1] to an accessible address
  must inject into [m2]'s memory value at the corersponding address.
*)

Record mem_inj (f: meminj) (m1 m2: mem) : Prop :=
  mk_mem_inj {
    mi_perm:
      forall b1 b2 delta ofs k p,
      f b1 = Some(b2, delta) ->
      perm m1 b1 ofs k p ->
      perm m2 b2 (ofs + delta) k p;
    mi_align:
      forall b1 b2 delta chunk ofs p,
      f b1 = Some(b2, delta) ->
      range_perm m1 b1 ofs (ofs + size_chunk chunk) Max p ->
      (align_chunk chunk | delta);
    mi_memval:
      forall b1 ofs b2 delta,
      f b1 = Some(b2, delta) ->
      perm m1 b1 ofs Cur Readable ->
      memval_inject f (ZMap.get ofs m1.(mem_contents)#b1) (ZMap.get (ofs+delta) m2.(mem_contents)#b2)
  }.

(** Preservation of permissions *)

Lemma perm_inj:
  forall f m1 m2 b1 ofs k p b2 delta,
  mem_inj f m1 m2 ->
  perm m1 b1 ofs k p ->
  f b1 = Some(b2, delta) ->
  perm m2 b2 (ofs + delta) k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_perm; eauto.
Qed.

Lemma range_perm_inj:
  forall f m1 m2 b1 lo hi k p b2 delta,
  mem_inj f m1 m2 ->
  range_perm m1 b1 lo hi k p ->
  f b1 = Some(b2, delta) ->
  range_perm m2 b2 (lo + delta) (hi + delta) k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros; red; intros.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace ofs with ((ofs - delta) + delta) by omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_inj; eauto. apply H0. omega.
Qed.

Lemma valid_access_inj:
  forall f m1 m2 b1 b2 delta chunk ofs p,
  mem_inj f m1 m2 ->
  f b1 = Some(b2, delta) ->
  valid_access m1 chunk b1 ofs p ->
  valid_access m2 chunk b2 (ofs + delta) p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H1 as [A B]. constructor.
  replace (ofs + delta + size_chunk chunk)
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
     with ((ofs + size_chunk chunk) + delta) by omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply range_perm_inj; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply Z.divide_add_r; auto. eapply mi_align; eauto with mem.
Qed.

(** Preservation of loads. *)

Lemma getN_inj:
  forall f m1 m2 b1 b2 delta,
  mem_inj f m1 m2 ->
  f b1 = Some(b2, delta) ->
  forall n ofs,
  range_perm m1 b1 ofs (ofs + Z.of_nat n) Cur Readable ->
  list_forall2 (memval_inject f)
               (getN n ofs (m1.(mem_contents)#b1))
               (getN n (ofs + delta) (m2.(mem_contents)#b2)).
Proof.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  induction n; intros; simpl.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  constructor.
(* Goal: @list_forall2 memval memval (memval_inject f) (@cons memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b1 (mem_contents m1))) (getN n (Z.add ofs (Zpos xH)) (@PMap.get (ZMap.t memval) b1 (mem_contents m1)))) (@cons memval (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2))) (getN n (Z.add (Z.add ofs delta) (Zpos xH)) (@PMap.get (ZMap.t memval) b2 (mem_contents m2)))) *)
  rewrite Nat2Z.inj_succ in H1.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  constructor.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_memval; eauto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  apply H1. omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace (ofs + delta + 1) with ((ofs + 1) + delta) by omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  apply IHn. red; intros; apply H1; omega.
Qed.

Lemma load_inj:
  forall f m1 m2 chunk b1 ofs b2 delta v1,
  mem_inj f m1 m2 ->
  load chunk m1 b1 ofs = Some v1 ->
  f b1 = Some (b2, delta) ->
  exists v2, load chunk m2 b2 (ofs + delta) = Some v2 /\ Val.inject f v1 v2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  exists (decode_val chunk (getN (size_chunk_nat chunk) (ofs + delta) (m2.(mem_contents)#b2))).
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  split. unfold load. apply pred_dec_true.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eapply valid_access_inj; eauto with mem.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit load_result; eauto. intro. rewrite H2.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply decode_val_inject. apply getN_inj; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite <- size_chunk_conv. exploit load_valid_access; eauto. intros [A B]. auto.
Qed.

Lemma loadbytes_inj:
  forall f m1 m2 len b1 ofs b2 delta bytes1,
  mem_inj f m1 m2 ->
  loadbytes m1 b1 ofs len = Some bytes1 ->
  f b1 = Some (b2, delta) ->
  exists bytes2, loadbytes m2 b2 (ofs + delta) len = Some bytes2
              /\ list_forall2 (memval_inject f) bytes1 bytes2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold loadbytes in *.
  destruct (range_perm_dec m1 b1 ofs (ofs + len) Cur Readable); inv H0.
  exists (getN (nat_of_Z len) (ofs + delta) (m2.(mem_contents)#b2)).
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  split. apply pred_dec_true.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace (ofs + delta + len) with ((ofs + len) + delta) by omega.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eapply range_perm_inj; eauto with mem.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply getN_inj; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zle 0 len). rewrite nat_of_Z_eq; auto. omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  rewrite nat_of_Z_neg. simpl. red; intros; omegaContradiction. omega.
Qed.

(** Preservation of stores. *)

Lemma setN_inj:
  forall (access: Z -> Prop) delta f vl1 vl2,
  list_forall2 (memval_inject f) vl1 vl2 ->
  forall p c1 c2,
  (forall q, access q -> memval_inject f (ZMap.get q c1) (ZMap.get (q + delta) c2)) ->
  (forall q, access q -> memval_inject f (ZMap.get q (setN vl1 p c1))
                                         (ZMap.get (q + delta) (setN vl2 (p + delta) c2))).
Proof.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  induction 1; intros; simpl.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace (p + delta + 1) with ((p + 1) + delta) by omega.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply IHlist_forall2; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite ZMap.gsspec at 1. destruct (ZIndexed.eq q0 p). subst q0.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite ZMap.gss. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite ZMap.gso. auto. unfold ZIndexed.t in *. omega.
Qed.

Definition meminj_no_overlap (f: meminj) (m: mem) : Prop :=
  forall b1 b1' delta1 b2 b2' delta2 ofs1 ofs2,
  b1 <> b2 ->
  f b1 = Some (b1', delta1) ->
  f b2 = Some (b2', delta2) ->
  perm m b1 ofs1 Max Nonempty ->
  perm m b2 ofs2 Max Nonempty ->
  b1' <> b2' \/ ofs1 + delta1 <> ofs2 + delta2.

Lemma store_mapped_inj:
  forall f chunk m1 b1 ofs v1 n1 m2 b2 delta v2,
  mem_inj f m1 m2 ->
  store chunk m1 b1 ofs v1 = Some n1 ->
  meminj_no_overlap f m1 ->
  f b1 = Some (b2, delta) ->
  Val.inject f v1 v2 ->
  exists n2,
    store chunk m2 b2 (ofs + delta) v2 = Some n2
    /\ mem_inj f n1 n2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  assert (valid_access m2 chunk b2 (ofs + delta) Writable).
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
    eapply valid_access_inj; eauto with mem.
  destruct (valid_access_store _ _ _ _ v2 H4) as [n2 STORE].
(* Goal: Ple (nextblock m) (nextblock m') *)
  exists n2; split. auto.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply perm_store_1; [eexact STORE|].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_perm; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_store_2; eauto.
(* align *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_align with (ofs := ofs0) (p := p); eauto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  red; intros; eauto with mem.
(* mem_contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: memval_inject f (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (mem_contents n1))) (@ZMap.get memval (Z.add ofs0 delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2))) *)
  rewrite (store_mem_contents _ _ _ _ _ _ H0).
  rewrite (store_mem_contents _ _ _ _ _ _ STORE).
(* Goal: memval_inject f (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (@PMap.set (ZMap.t memval) b1 (@PMap.get (ZMap.t memval) b1 (mem_contents m1)) (mem_contents m1)))) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b3 (@PMap.set (ZMap.t memval) b2 (@PMap.get (ZMap.t memval) b2 (mem_contents m2)) (mem_contents m2)))) *)
  rewrite ! PMap.gsspec.
(* Goal: or (not (@eq block b0 b)) (or (Z.lt ofs lo) (Z.le hi ofs)) *)
(* Goal: perm m b0 ofs k p *)
  destruct (peq b0 b1). subst b0.
  (* block = b1, block = b2 *)
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  assert (b3 = b2) by congruence. subst b3.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  assert (delta0 = delta) by congruence. subst delta0.
  rewrite peq_true.
  apply setN_inj with (access := fun ofs => perm m1 b1 ofs Cur Readable).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  apply encode_val_inject; auto. intros. eapply mi_memval; eauto. eauto with mem.
  destruct (peq b3 b2). subst b3.
  (* block <> b1, block = b2 *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite setN_other. eapply mi_memval; eauto. eauto with mem.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  rewrite encode_val_length. rewrite <- size_chunk_conv. intros.
  assert (b2 <> b2 \/ ofs0 + delta0 <> (r - delta) + delta).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply H1; eauto. eauto 6 with mem.
(* Goal: forall _ : and (perm m1 b1 ofs k p) (forall (lo hi : Z) (_ : @In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo) hi) l) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False), False *)
    exploit store_valid_access_3. eexact H0. intros [A B].
(* Goal: perm m b2 (Ptrofs.unsigned ofs2) Max Nonempty *)
    eapply perm_implies. apply perm_cur_max. apply A. omega. auto with mem.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  destruct H8. congruence. omega.
  (* block <> b1, block <> b2 *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_memval; eauto. eauto with mem.
Qed.

Lemma store_unmapped_inj:
  forall f chunk m1 b1 ofs v1 n1 m2,
  mem_inj f m1 m2 ->
  store chunk m1 b1 ofs v1 = Some n1 ->
  f b1 = None ->
  mem_inj f n1 m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_perm; eauto with mem.
(* align *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_align with (ofs := ofs0) (p := p); eauto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  red; intros; eauto with mem.
(* mem_contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: memval_inject f (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (mem_contents n1))) (@ZMap.get memval (Z.add ofs0 delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2))) *)
  rewrite (store_mem_contents _ _ _ _ _ _ H0).
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  rewrite PMap.gso. eapply mi_memval; eauto with mem.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
Qed.

Lemma store_outside_inj:
  forall f m1 m2 chunk b ofs v m2',
  mem_inj f m1 m2 ->
  (forall b' delta ofs',
    f b' = Some(b, delta) ->
    perm m1 b' ofs' Cur Readable ->
    ofs <= ofs' + delta < ofs + size_chunk chunk -> False) ->
  store chunk m2 b ofs v = Some m2' ->
  mem_inj f m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor.
(* perm *)
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* access *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  intros; eapply mi_align0; eauto.
(* mem_contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: memval_inject f (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b1 (mem_contents m1))) (@ZMap.get memval (Z.add ofs0 delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2'))) *)
  rewrite (store_mem_contents _ _ _ _ _ _ H1).
(* Goal: @eq memval (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (@PMap.set (ZMap.t memval) b (setN bytes ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)))) (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite PMap.gsspec. destruct (peq b2 b). subst b2.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite setN_outside. auto.
(* Goal: or (Z.lt ofs0 ofs) (Z.ge ofs0 (Z.add ofs (Z.of_nat (@Datatypes.length memval (encode_val chunk v))))) *)
  rewrite encode_val_length. rewrite <- size_chunk_conv.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zlt (ofs0 + delta) ofs); auto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  destruct (zle (ofs + size_chunk chunk) (ofs0 + delta)). omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  byContradiction. eapply H0; eauto. omega.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
Qed.

Lemma storebytes_mapped_inj:
  forall f m1 b1 ofs bytes1 n1 m2 b2 delta bytes2,
  mem_inj f m1 m2 ->
  storebytes m1 b1 ofs bytes1 = Some n1 ->
  meminj_no_overlap f m1 ->
  f b1 = Some (b2, delta) ->
  list_forall2 (memval_inject f) bytes1 bytes2 ->
  exists n2,
    storebytes m2 b2 (ofs + delta) bytes2 = Some n2
    /\ mem_inj f n1 n2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H.
  assert (range_perm m2 b2 (ofs + delta) (ofs + delta + Z.of_nat (length bytes2)) Cur Writable).
    replace (ofs + delta + Z.of_nat (length bytes2))
       with ((ofs + Z.of_nat (length bytes1)) + delta).
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
    eapply range_perm_inj; eauto with mem.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply storebytes_range_perm; eauto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
    rewrite (list_forall2_length H3). omega.
  destruct (range_perm_storebytes _ _ _ _ H4) as [n2 STORE].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exists n2; split. eauto.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  eapply perm_storebytes_1; [apply STORE |].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_perm0; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_storebytes_2; eauto.
(* align *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_align with (ofs := ofs0) (p := p); eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply perm_storebytes_2; eauto.
(* mem_contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  assert (perm m1 b0 ofs0 Cur Readable). eapply perm_storebytes_2; eauto.
(* Goal: memval_inject f (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m1'))) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b3 (mem_contents m2'))) *)
  rewrite (storebytes_mem_contents _ _ _ _ _ H0).
  rewrite (storebytes_mem_contents _ _ _ _ _ STORE).
(* Goal: or (not (@eq block b0 b)) (or (Z.lt ofs lo) (Z.le hi ofs)) *)
(* Goal: perm m b0 ofs k p *)
  rewrite ! PMap.gsspec. destruct (peq b0 b1). subst b0.
  (* block = b1, block = b2 *)
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  assert (b3 = b2) by congruence. subst b3.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  assert (delta0 = delta) by congruence. subst delta0.
  rewrite peq_true.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply setN_inj with (access := fun ofs => perm m1 b1 ofs Cur Readable); auto.
  destruct (peq b3 b2). subst b3.
  (* block <> b1, block = b2 *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite setN_other. auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  assert (b2 <> b2 \/ ofs0 + delta0 <> (r - delta) + delta).
    eapply H1; eauto 6 with mem.
    exploit storebytes_range_perm. eexact H0.
    instantiate (1 := r - delta).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
    rewrite (list_forall2_length H3). omega.
    eauto 6 with mem.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  destruct H9. congruence. omega.
  (* block <> b1, block <> b2 *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eauto.
Qed.

Lemma storebytes_unmapped_inj:
  forall f m1 b1 ofs bytes1 n1 m2,
  mem_inj f m1 m2 ->
  storebytes m1 b1 ofs bytes1 = Some n1 ->
  f b1 = None ->
  mem_inj f n1 m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_perm0; eauto. eapply perm_storebytes_2; eauto.
(* align *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_align with (ofs := ofs0) (p := p); eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply perm_storebytes_2; eauto.
(* mem_contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: memval_inject f (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m1'))) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b3 (mem_contents m2'))) *)
  rewrite (storebytes_mem_contents _ _ _ _ _ H0).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite PMap.gso. eapply mi_memval0; eauto. eapply perm_storebytes_2; eauto.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
Qed.

Lemma storebytes_outside_inj:
  forall f m1 m2 b ofs bytes2 m2',
  mem_inj f m1 m2 ->
  (forall b' delta ofs',
    f b' = Some(b, delta) ->
    perm m1 b' ofs' Cur Readable ->
    ofs <= ofs' + delta < ofs + Z.of_nat (length bytes2) -> False) ->
  storebytes m2 b ofs bytes2 = Some m2' ->
  mem_inj f m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H. constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply perm_storebytes_1; eauto with mem.
(* align *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eauto.
(* mem_contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: memval_inject f (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (@PMap.set (ZMap.t memval) b1 (setN (@nil memval) ofs1 (@PMap.get (ZMap.t memval) b1 (mem_contents m1))) (mem_contents m1)))) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b3 (mem_contents m2'))) *)
  rewrite (storebytes_mem_contents _ _ _ _ _ H1).
(* Goal: @eq memval (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (@PMap.set (ZMap.t memval) b (setN bytes ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)))) (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite PMap.gsspec. destruct (peq b2 b). subst b2.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite setN_outside. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zlt (ofs0 + delta) ofs); auto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  destruct (zle (ofs + Z.of_nat (length bytes2)) (ofs0 + delta)). omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  byContradiction. eapply H0; eauto. omega.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
Qed.

Lemma storebytes_empty_inj:
  forall f m1 b1 ofs1 m1' m2 b2 ofs2 m2',
  mem_inj f m1 m2 ->
  storebytes m1 b1 ofs1 nil = Some m1' ->
  storebytes m2 b2 ofs2 nil = Some m2' ->
  mem_inj f m1' m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H. constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_storebytes_1; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_perm0; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_storebytes_2; eauto.
(* align *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_align0 with (ofs := ofs) (p := p); eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply perm_storebytes_2; eauto.
(* mem_contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  assert (perm m1 b0 ofs Cur Readable). eapply perm_storebytes_2; eauto.
(* Goal: memval_inject f (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m1'))) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b3 (mem_contents m2'))) *)
  rewrite (storebytes_mem_contents _ _ _ _ _ H0).
(* Goal: memval_inject f (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (@PMap.set (ZMap.t memval) b1 (setN (@nil memval) ofs1 (@PMap.get (ZMap.t memval) b1 (mem_contents m1))) (mem_contents m1)))) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b3 (mem_contents m2'))) *)
  rewrite (storebytes_mem_contents _ _ _ _ _ H1).
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  simpl. rewrite ! PMap.gsspec.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct (peq b0 b1); destruct (peq b3 b2); subst; eapply mi_memval0; eauto.
Qed.

(** Preservation of allocations *)

Lemma alloc_right_inj:
  forall f m1 m2 lo hi b2 m2',
  mem_inj f m1 m2 ->
  alloc m2 lo hi = (m2', b2) ->
  mem_inj f m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. injection H0. intros NEXT MEM.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  inversion H. constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply perm_alloc_1; eauto.
(* align *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eauto.
(* mem_contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  assert (perm m2 b0 (ofs + delta) Cur Readable).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply mi_perm0; eauto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  assert (valid_block m2 b0) by eauto with mem.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  rewrite <- MEM; simpl. rewrite PMap.gso. eauto with mem.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  rewrite NEXT. eauto with mem.
Qed.

Lemma alloc_left_unmapped_inj:
  forall f m1 m2 lo hi m1' b1,
  mem_inj f m1 m2 ->
  alloc m1 lo hi = (m1', b1) ->
  f b1 = None ->
  mem_inj f m1' m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H. constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit perm_alloc_inv; eauto. intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct (eq_block b0 b1). congruence. eauto.
(* align *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_align0 with (ofs := ofs) (p := p); eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. exploit perm_alloc_inv; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (eq_block b0 b1); auto. congruence.
(* mem_contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  injection H0; intros NEXT MEM. intros.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite <- MEM; simpl. rewrite NEXT.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  exploit perm_alloc_inv; eauto. intros.
(* Goal: @eq memval (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (@PMap.set (ZMap.t memval) b (setN bytes ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)))) (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite PMap.gsspec. unfold eq_block in H4. destruct (peq b0 b1).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite ZMap.gi. constructor. eauto.
Qed.

Definition inj_offset_aligned (delta: Z) (size: Z) : Prop :=
  forall chunk, size_chunk chunk <= size -> (align_chunk chunk | delta).

Lemma alloc_left_mapped_inj:
  forall f m1 m2 lo hi m1' b1 b2 delta,
  mem_inj f m1 m2 ->
  alloc m1 lo hi = (m1', b1) ->
  valid_block m2 b2 ->
  inj_offset_aligned delta (hi-lo) ->
  (forall ofs k p, lo <= ofs < hi -> perm m2 b2 (ofs + delta) k p) ->
  f b1 = Some(b2, delta) ->
  mem_inj f m1' m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H. constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  exploit perm_alloc_inv; eauto. intros. destruct (eq_block b0 b1). subst b0.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite H4 in H5; inv H5. eauto. eauto.
(* align *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct (eq_block b0 b1).
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  subst b0. assert (delta0 = delta) by congruence. subst delta0.
  assert (lo <= ofs < hi).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  { eapply perm_alloc_3; eauto. apply H6. generalize (size_chunk_pos chunk); omega. }
  assert (lo <= ofs + size_chunk chunk - 1 < hi).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  { eapply perm_alloc_3; eauto. apply H6. generalize (size_chunk_pos chunk); omega. }
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  apply H2. omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_align0 with (ofs := ofs) (p := p); eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply perm_alloc_4; eauto.
(* mem_contents *)
(* Goal: forall (_ : @eq block (nextblock m2) b2) (_ : @eq mem' (mkmem (@PMap.set (prod memval (PTree.t memval)) (nextblock m2) (@ZMap.init memval Undef) (mem_contents m2)) (@PMap.set (forall (_ : Z) (_ : perm_kind), option permission) (nextblock m2) (fun (ofs : Z) (_ : perm_kind) => if andb (@proj_sumbool (Z.le lo ofs) (Z.gt lo ofs) (zle lo ofs)) (@proj_sumbool (Z.lt ofs hi) (Z.ge ofs hi) (zlt ofs hi)) then @Some permission Freeable else @None permission) (mem_access m2)) (Pos.succ (nextblock m2)) (fun (b : positive) (ofs : Z) => alloc_obligation_1 m2 lo hi b ofs) (fun (b : positive) (ofs : Z) (k : perm_kind) (H : not (Plt b (Pos.succ (nextblock m2)))) => alloc_obligation_2 m2 lo hi b ofs k H) (fun b : positive => alloc_obligation_3 m2 b)) m2'), inject f m1 m2' *)
  injection H0; intros NEXT MEM.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite <- MEM; simpl. rewrite NEXT.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  exploit perm_alloc_inv; eauto. intros.
(* Goal: @eq memval (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (@PMap.set (ZMap.t memval) b (setN bytes ofs (@PMap.get (ZMap.t memval) b (mem_contents m))) (mem_contents m)))) (@ZMap.get memval ofs0 (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
  rewrite PMap.gsspec. unfold eq_block in H7.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct (peq b0 b1). rewrite ZMap.gi. constructor. eauto.
Qed.

Lemma free_left_inj:
  forall f m1 m2 b lo hi m1',
  mem_inj f m1 m2 ->
  free m1 b lo hi = Some m1' ->
  mem_inj f m1' m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit free_result; eauto. intro FREE. inversion H. constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eauto with mem.
(* align *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_align0 with (ofs := ofs) (p := p); eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  red; intros; eapply perm_free_3; eauto.
(* mem_contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite FREE; simpl. eauto with mem.
Qed.

Lemma free_right_inj:
  forall f m1 m2 b lo hi m2',
  mem_inj f m1 m2 ->
  free m2 b lo hi = Some m2' ->
  (forall b' delta ofs k p,
    f b' = Some(b, delta) ->
    perm m1 b' ofs k p -> lo <= ofs + delta < hi -> False) ->
  mem_inj f m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit free_result; eauto. intro FREE. inversion H.
  assert (PERM:
    forall b1 b2 delta ofs k p,
    f b1 = Some (b2, delta) ->
    perm m1 b1 ofs k p -> perm m2' b2 (ofs + delta) k p).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply perm_free_1; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (eq_block b2 b); auto. subst b. right.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  assert (~ (lo <= ofs + delta < hi)). red; intros; eapply H1; eauto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  omega.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  constructor.
(* perm *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* align *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_align0; eauto.
(* mem_contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite FREE; simpl. eauto.
Qed.

(** Preservation of [drop_perm] operations. *)

Lemma drop_unmapped_inj:
  forall f m1 m2 b lo hi p m1',
  mem_inj f m1 m2 ->
  drop_perm m1 b lo hi p = Some m1' ->
  f b = None ->
  mem_inj f m1' m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_perm0; eauto. eapply perm_drop_4; eauto.
(* align *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_align0 with (ofs := ofs) (p := p0); eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  red; intros; eapply perm_drop_4; eauto.
(* contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: memval_inject f (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b1 (mem_contents m1'))) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2))) *)
  replace (ZMap.get ofs m1'.(mem_contents)#b1) with (ZMap.get ofs m1.(mem_contents)#b1).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  apply mi_memval0; auto. eapply perm_drop_4; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  unfold drop_perm in H0; destruct (range_perm_dec m1 b lo hi Cur Freeable); inv H0; auto.
Qed.

Lemma drop_mapped_inj:
  forall f m1 m2 b1 b2 delta lo hi p m1',
  mem_inj f m1 m2 ->
  drop_perm m1 b1 lo hi p = Some m1' ->
  meminj_no_overlap f m1 ->
  f b1 = Some(b2, delta) ->
  exists m2',
      drop_perm m2 b2 (lo + delta) (hi + delta) p = Some m2'
   /\ mem_inj f m1' m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  assert ({ m2' | drop_perm m2 b2 (lo + delta) (hi + delta) p = Some m2' }).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  apply range_perm_drop_2. red; intros.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace ofs with ((ofs - delta) + delta) by omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_inj; eauto. eapply range_perm_drop_1; eauto. omega.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct X as [m2' DROP]. exists m2'; split; auto.
(* Goal: Val.inject f v1 v3 *)
  inv H.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  assert (perm m2 b3 (ofs + delta0) k p0).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply mi_perm0; eauto. eapply perm_drop_4; eauto.
  destruct (eq_block b1 b0).
  (* b1 = b0 *)
(* Goal: Val.inject f v1 v3 *)
  subst b0. rewrite H2 in H; inv H.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct (zlt (ofs + delta0) (lo + delta0)). eapply perm_drop_3; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct (zle (hi + delta0) (ofs + delta0)). eapply perm_drop_3; eauto.
  assert (perm_order p p0).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply perm_drop_2.  eexact H0. instantiate (1 := ofs). omega. eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply perm_implies with p; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_drop_1. eauto. omega.
  (* b1 <> b0 *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_drop_3; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (eq_block b3 b2); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zlt (ofs + delta0) (lo + delta)); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zle (hi + delta) (ofs + delta0)); auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit H1; eauto.
  instantiate (1 := ofs + delta0 - delta).
(* Goal: perm m b2 (Ptrofs.unsigned ofs2) Max Nonempty *)
  apply perm_cur_max. apply perm_implies with Freeable.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply range_perm_drop_1; eauto. omega. auto with mem.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_drop_4; eauto. eapply perm_max. apply perm_implies with p0. eauto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* Goal: perm_order p Readable *)
(* Goal: perm m' b' ofs0 Cur Readable *)
(* Goal: @eq (option (list memval)) (if range_perm_dec m' b' ofs (Z.add ofs n) Cur Readable then @Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m'))) else @None (list memval)) (@None (list memval)) *)
  intuition.
(* align *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_align0 with (ofs := ofs) (p := p0); eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  red; intros; eapply perm_drop_4; eauto.
(* memval *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  replace (m1'.(mem_contents)#b0) with (m1.(mem_contents)#b0).
  replace (m2'.(mem_contents)#b3) with (m2.(mem_contents)#b3).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  apply mi_memval0; auto. eapply perm_drop_4; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  unfold drop_perm in DROP; destruct (range_perm_dec m2 b2 (lo + delta) (hi + delta) Cur Freeable); inv DROP; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  unfold drop_perm in H0; destruct (range_perm_dec m1 b1 lo hi Cur Freeable); inv H0; auto.
Qed.

Lemma drop_outside_inj: forall f m1 m2 b lo hi p m2',
  mem_inj f m1 m2 ->
  drop_perm m2 b lo hi p = Some m2' ->
  (forall b' delta ofs' k p,
    f b' = Some(b, delta) ->
    perm m1 b' ofs' k p ->
    lo <= ofs' + delta < hi -> False) ->
  mem_inj f m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor.
  (* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply perm_drop_3; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (eq_block b2 b); auto. subst b2. right.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zlt (ofs + delta) lo); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zle hi (ofs + delta)); auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  byContradiction. exploit H1; eauto. omega.
  (* align *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_align0; eauto.
  (* contents *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: memval_inject f (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b1 (mem_contents m1))) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2'))) *)
  replace (m2'.(mem_contents)#b2) with (m2.(mem_contents)#b2).
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply mi_memval0; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  unfold drop_perm in H0; destruct (range_perm_dec m2 b lo hi Cur Freeable); inv H0; auto.
Qed.

(** * Memory extensions *)

(**  A store [m2] extends a store [m1] if [m2] can be obtained from [m1]
  by increasing the sizes of the memory blocks of [m1] (decreasing
  the low bounds, increasing the high bounds), and replacing some of
  the [Vundef] values stored in [m1] by more defined values stored
  in [m2] at the same locations. *)

Record extends' (m1 m2: mem) : Prop :=
  mk_extends {
    mext_next: nextblock m1 = nextblock m2;
    mext_inj:  mem_inj inject_id m1 m2;
    mext_perm_inv: forall b ofs k p,
      perm m2 b ofs k p ->
      perm m1 b ofs k p \/ ~perm m1 b ofs Max Nonempty
  }.

Definition extends := extends'.

Theorem extends_refl:
  forall m, extends m m.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. constructor. auto. constructor.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold inject_id in H; inv H. replace (ofs + 0) with ofs by omega. auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold inject_id in H; inv H. apply Z.divide_0_r.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold inject_id in H; inv H. replace (ofs + 0) with ofs by omega.
(* Goal: memval_inject inject_id (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b2 (mem_contents m))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b2 (mem_contents m))) *)
(* Goal: forall (b : block) (ofs : Z) (k : perm_kind) (p : permission) (_ : perm m b ofs k p), or (perm m b ofs k p) (not (perm m b ofs Max Nonempty)) *)
  apply memval_lessdef_refl.
(* Goal: Ple (nextblock m) (nextblock m') *)
  tauto.
Qed.

Theorem load_extends:
  forall chunk m1 m2 b ofs v1,
  extends m1 m2 ->
  load chunk m1 b ofs = Some v1 ->
  exists v2, load chunk m2 b ofs = Some v2 /\ Val.lessdef v1 v2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. exploit load_inj; eauto. unfold inject_id; reflexivity.
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  intros [v2 [A B]]. exists v2; split.
(* Goal: Ple (nextblock m) (nextblock m') *)
  replace (ofs + 0) with ofs in A by omega. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite val_inject_id in B. auto.
Qed.

Theorem loadv_extends:
  forall chunk m1 m2 addr1 addr2 v1,
  extends m1 m2 ->
  loadv chunk m1 addr1 = Some v1 ->
  Val.lessdef addr1 addr2 ->
  exists v2, loadv chunk m2 addr2 = Some v2 /\ Val.lessdef v1 v2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold loadv; intros. inv H1.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct addr2; try congruence. eapply load_extends; eauto.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
Qed.

Theorem loadbytes_extends:
  forall m1 m2 b ofs len bytes1,
  extends m1 m2 ->
  loadbytes m1 b ofs len = Some bytes1 ->
  exists bytes2, loadbytes m2 b ofs len = Some bytes2
              /\ list_forall2 memval_lessdef bytes1 bytes2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  replace ofs with (ofs + 0) by omega. eapply loadbytes_inj; eauto.
Qed.

Theorem store_within_extends:
  forall chunk m1 m2 b ofs v1 m1' v2,
  extends m1 m2 ->
  store chunk m1 b ofs v1 = Some m1' ->
  Val.lessdef v1 v2 ->
  exists m2',
     store chunk m2 b ofs v2 = Some m2'
  /\ extends m1' m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit store_mapped_inj; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    unfold inject_id; red; intros. inv H3; inv H4. auto.
(* Goal: @eq block (nextblock empty) xH *)
    unfold inject_id; reflexivity.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    rewrite val_inject_id. eauto.
  intros [m2' [A B]].
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  exists m2'; split.
(* Goal: Ple (nextblock m) (nextblock m') *)
  replace (ofs + 0) with ofs in A by omega. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  constructor; auto.
(* Goal: @eq block (nextblock m1) (nextblock m2') *)
(* Goal: mem_inj inject_id m1 m2' *)
(* Goal: forall (b : block) (ofs : Z) (k : perm_kind) (p : permission) (_ : perm m2' b ofs k p), or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  rewrite (nextblock_store _ _ _ _ _ _ H0).
  rewrite (nextblock_store _ _ _ _ _ _ A).
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit mext_perm_inv0; intuition eauto using perm_store_1, perm_store_2.
Qed.

Theorem store_outside_extends:
  forall chunk m1 m2 b ofs v m2',
  extends m1 m2 ->
  store chunk m2 b ofs v = Some m2' ->
  (forall ofs', perm m1 b ofs' Cur Readable -> ofs <= ofs' < ofs + size_chunk chunk -> False) ->
  extends m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H. constructor.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite (nextblock_store _ _ _ _ _ _ H0). auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply store_outside_inj; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold inject_id; intros. inv H2. eapply H1; eauto. omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eauto using perm_store_2.
Qed.

Theorem storev_extends:
  forall chunk m1 m2 addr1 v1 m1' addr2 v2,
  extends m1 m2 ->
  storev chunk m1 addr1 v1 = Some m1' ->
  Val.lessdef addr1 addr2 ->
  Val.lessdef v1 v2 ->
  exists m2',
     storev chunk m2 addr2 v2 = Some m2'
  /\ extends m1' m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold storev; intros. inv H1.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct addr2; try congruence. eapply store_within_extends; eauto.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
Qed.

Theorem storebytes_within_extends:
  forall m1 m2 b ofs bytes1 m1' bytes2,
  extends m1 m2 ->
  storebytes m1 b ofs bytes1 = Some m1' ->
  list_forall2 memval_lessdef bytes1 bytes2 ->
  exists m2',
     storebytes m2 b ofs bytes2 = Some m2'
  /\ extends m1' m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit storebytes_mapped_inj; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    unfold inject_id; red; intros. inv H3; inv H4. auto.
(* Goal: @eq block (nextblock empty) xH *)
    unfold inject_id; reflexivity.
  intros [m2' [A B]].
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  exists m2'; split.
(* Goal: Ple (nextblock m) (nextblock m') *)
  replace (ofs + 0) with ofs in A by omega. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  constructor; auto.
(* Goal: @eq block (nextblock m1) (nextblock m2') *)
(* Goal: mem_inj inject_id m1 m2' *)
(* Goal: forall (b : block) (ofs : Z) (k : perm_kind) (p : permission) (_ : perm m2' b ofs k p), or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  rewrite (nextblock_storebytes _ _ _ _ _ H0).
  rewrite (nextblock_storebytes _ _ _ _ _ A).
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit mext_perm_inv0; intuition eauto using perm_storebytes_1, perm_storebytes_2.
Qed.

Theorem storebytes_outside_extends:
  forall m1 m2 b ofs bytes2 m2',
  extends m1 m2 ->
  storebytes m2 b ofs bytes2 = Some m2' ->
  (forall ofs', perm m1 b ofs' Cur Readable -> ofs <= ofs' < ofs + Z.of_nat (length bytes2) -> False) ->
  extends m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H. constructor.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite (nextblock_storebytes _ _ _ _ _ H0). auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply storebytes_outside_inj; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold inject_id; intros. inv H2. eapply H1; eauto. omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eauto using perm_storebytes_2.
Qed.

Theorem alloc_extends:
  forall m1 m2 lo1 hi1 b m1' lo2 hi2,
  extends m1 m2 ->
  alloc m1 lo1 hi1 = (m1', b) ->
  lo2 <= lo1 -> hi1 <= hi2 ->
  exists m2',
     alloc m2 lo2 hi2 = (m2', b)
  /\ extends m1' m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H.
(* Goal: @ex mem' (fun m2' : mem' => and (@eq (prod mem' block) (alloc m2 lo2 hi2) (@pair mem' block m2' b)) (extends m1' m2')) *)
  case_eq (alloc m2 lo2 hi2); intros m2' b' ALLOC.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  assert (b' = b).
(* Goal: @eq block b' b *)
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
    rewrite (alloc_result _ _ _ _ _ H0).
(* Goal: @eq block b' (nextblock m1) *)
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
    rewrite (alloc_result _ _ _ _ _ ALLOC).
(* Goal: Ple (nextblock m) (nextblock m') *)
    auto.
(* Goal: @ex mem' (fun m2'0 : mem' => and (@eq (prod mem' block) (@pair mem' block m2' b') (@pair mem' block m2'0 b)) (extends m1' m2'0)) *)
  subst b'.
(* Goal: Ple (nextblock m) (nextblock m') *)
  exists m2'; split; auto.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  constructor.
(* Goal: @eq block (nextblock m1') (nextblock m2') *)
(* Goal: mem_inj inject_id m1' m2' *)
(* Goal: forall (b : block) (ofs : Z) (k : perm_kind) (p : permission) (_ : perm m2' b ofs k p), or (perm m1' b ofs k p) (not (perm m1' b ofs Max Nonempty)) *)
  rewrite (nextblock_alloc _ _ _ _ _ H0).
(* Goal: @eq block (Pos.succ (nextblock m1)) (nextblock m2') *)
(* Goal: mem_inj inject_id m1' m2' *)
(* Goal: forall (b : block) (ofs : Z) (k : perm_kind) (p : permission) (_ : perm m2' b ofs k p), or (perm m1' b ofs k p) (not (perm m1' b ofs Max Nonempty)) *)
  rewrite (nextblock_alloc _ _ _ _ _ ALLOC).
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply alloc_left_mapped_inj with (m1 := m1) (m2 := m2') (b2 := b) (delta := 0); eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply alloc_right_inj; eauto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red. intros. apply Z.divide_0_r.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: perm_order Freeable p *)
(* Goal: perm_order p p' *)
(* Goal: forall _ : perm_order' (if andb true false then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p', perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p' *)
(* Goal: forall _ : perm_order' (if andb false (if zlt ofs hi then true else false) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p', perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p' *)
(* Goal: forall _ : perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b' (mem_access m) ofs k) p', perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b' (mem_access m) ofs k) p' *)
  eapply perm_implies with Freeable; auto with mem.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_alloc_2; eauto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply perm_alloc_inv in H; eauto.
(* Goal: or (perm m1' b0 ofs k p) (not (perm m1' b0 ofs Max Nonempty)) *)
  generalize (perm_alloc_inv _ _ _ _ _ H0 b0 ofs Max Nonempty); intros PERM.
(* Goal: or (perm m1' b0 ofs k p) (not (perm m1' b0 ofs Max Nonempty)) *)
  destruct (eq_block b0 b).
(* Goal: or (not (@eq block b0 b)) (or (Z.lt ofs lo) (Z.le hi ofs)) *)
(* Goal: perm m b0 ofs k p *)
  subst b0.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  assert (EITHER: lo1 <= ofs < hi1 \/ ~(lo1 <= ofs < hi1)) by omega.
(* Goal: or (perm m1' b ofs k p) (not (perm m1' b ofs Max Nonempty)) *)
(* Goal: or (perm m1' b0 ofs k p) (not (perm m1' b0 ofs Max Nonempty)) *)
  destruct EITHER.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  left. apply perm_implies with Freeable; auto with mem. eapply perm_alloc_2; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  right; tauto.
(* Goal: or (perm m1' b0 ofs k p) (not (perm m1' b0 ofs Max Nonempty)) *)
  exploit mext_perm_inv0; intuition eauto using perm_alloc_1, perm_alloc_4.
Qed.

Theorem free_left_extends:
  forall m1 m2 b lo hi m1',
  extends m1 m2 ->
  free m1 b lo hi = Some m1' ->
  extends m1' m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite (nextblock_free _ _ _ _ _ H0). auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply free_left_inj; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit mext_perm_inv0; eauto. intros [A|A].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_free_inv in A; eauto. destruct A as [[A B]|A]; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  subst b0. right; eapply perm_free_2; eauto.
(* Goal: forall _ : or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)), or (perm m1' b1 ofs k p) (not (perm m1' b1 ofs Max Nonempty)) *)
  intuition eauto using perm_free_3.
Qed.

Theorem free_right_extends:
  forall m1 m2 b lo hi m2',
  extends m1 m2 ->
  free m2 b lo hi = Some m2' ->
  (forall ofs k p, perm m1 b ofs k p -> lo <= ofs < hi -> False) ->
  extends m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. constructor.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite (nextblock_free _ _ _ _ _ H0). auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply free_right_inj; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold inject_id; intros. inv H. eapply H1; eauto. omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eauto using perm_free_3.
Qed.

Theorem free_parallel_extends:
  forall m1 m2 b lo hi m1',
  extends m1 m2 ->
  free m1 b lo hi = Some m1' ->
  exists m2',
     free m2 b lo hi = Some m2'
  /\ extends m1' m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H.
  assert ({ m2': mem | free m2 b lo hi = Some m2' }).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    apply range_perm_free. red; intros.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
    replace ofs with (ofs + 0) by omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply perm_inj with (b1 := b); eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply free_range_perm; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct X as [m2' FREE]. exists m2'; split; auto.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  constructor.
(* Goal: @eq block (nextblock m1) (nextblock m2') *)
(* Goal: mem_inj inject_id m1 m2' *)
(* Goal: forall (b : block) (ofs : Z) (k : perm_kind) (p : permission) (_ : perm m2' b ofs k p), or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  rewrite (nextblock_free _ _ _ _ _ H0).
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite (nextblock_free _ _ _ _ _ FREE). auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply free_right_inj with (m1 := m1'); eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply free_left_inj; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold inject_id; intros. inv H1.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_free_2. eexact H0. instantiate (1 := ofs); omega. eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit mext_perm_inv0; eauto using perm_free_3. intros [A|A].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_free_inv in A; eauto. destruct A as [[A B]|A]; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  subst b0. right; eapply perm_free_2; eauto.
(* Goal: forall _ : or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)), or (perm m1' b1 ofs k p) (not (perm m1' b1 ofs Max Nonempty)) *)
  right; intuition eauto using perm_free_3.
Qed.

Theorem valid_block_extends:
  forall m1 m2 b,
  extends m1 m2 ->
  (valid_block m1 b <-> valid_block m2 b).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. unfold valid_block. rewrite mext_next0. tauto.
Qed.

Theorem perm_extends:
  forall m1 m2 b ofs k p,
  extends m1 m2 -> perm m1 b ofs k p -> perm m2 b ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. replace ofs with (ofs + 0) by omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_inj; eauto.
Qed.

Theorem perm_extends_inv:
  forall m1 m2 b ofs k p,
  extends m1 m2 -> perm m2 b ofs k p -> perm m1 b ofs k p \/ ~perm m1 b ofs Max Nonempty.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H; eauto.
Qed.

Theorem valid_access_extends:
  forall m1 m2 chunk b ofs p,
  extends m1 m2 -> valid_access m1 chunk b ofs p -> valid_access m2 chunk b ofs p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. replace ofs with (ofs + 0) by omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply valid_access_inj; eauto. auto.
Qed.

Theorem valid_pointer_extends:
  forall m1 m2 b ofs,
  extends m1 m2 -> valid_pointer m1 b ofs = true -> valid_pointer m2 b ofs = true.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq bool (valid_pointer m2 b ofs) true *)
  rewrite valid_pointer_valid_access in *.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply valid_access_extends; eauto.
Qed.

Theorem weak_valid_pointer_extends:
  forall m1 m2 b ofs,
  extends m1 m2 ->
  weak_valid_pointer m1 b ofs = true -> weak_valid_pointer m2 b ofs = true.
Proof.
(* Goal: forall _ : @eq bool (weak_valid_pointer m1 b1 ofs) true, @eq bool (weak_valid_pointer m2 b2 (Z.add ofs delta)) true *)
  intros until 1. unfold weak_valid_pointer. rewrite !orb_true_iff.
(* Goal: forall _ : or (@eq bool (valid_pointer m1 b ofs) true) (@eq bool (valid_pointer m1 b (Z.sub ofs (Zpos xH))) true), or (@eq bool (valid_pointer m2 b ofs) true) (@eq bool (valid_pointer m2 b (Z.sub ofs (Zpos xH))) true) *)
  intros []; eauto using valid_pointer_extends.
Qed.

(** * Memory injections *)

(** A memory state [m1] injects into another memory state [m2] via the
  memory injection [f] if the following conditions hold:
- each access in [m2] that corresponds to a valid access in [m1]
  is itself valid;
- the memory value associated in [m1] to an accessible address
  must inject into [m2]'s memory value at the corersponding address;
- unallocated blocks in [m1] must be mapped to [None] by [f];
- if [f b = Some(b', delta)], [b'] must be valid in [m2];
- distinct blocks in [m1] are mapped to non-overlapping sub-blocks in [m2];
- the sizes of [m2]'s blocks are representable with unsigned machine integers;
- pointers that could be represented using unsigned machine integers remain
  representable after the injection.
*)

Record inject' (f: meminj) (m1 m2: mem) : Prop :=
  mk_inject {
    mi_inj:
      mem_inj f m1 m2;
    mi_freeblocks:
      forall b, ~(valid_block m1 b) -> f b = None;
    mi_mappedblocks:
      forall b b' delta, f b = Some(b', delta) -> valid_block m2 b';
    mi_no_overlap:
      meminj_no_overlap f m1;
    mi_representable:
      forall b b' delta ofs,
      f b = Some(b', delta) ->
      perm m1 b (Ptrofs.unsigned ofs) Max Nonempty \/ perm m1 b (Ptrofs.unsigned ofs - 1) Max Nonempty ->
      delta >= 0 /\ 0 <= Ptrofs.unsigned ofs + delta <= Ptrofs.max_unsigned;
    mi_perm_inv:
      forall b1 ofs b2 delta k p,
      f b1 = Some(b2, delta) ->
      perm m2 b2 (ofs + delta) k p ->
      perm m1 b1 ofs k p \/ ~perm m1 b1 ofs Max Nonempty
  }.
Definition inject := inject'.

Local Hint Resolve mi_mappedblocks: mem.

(** Preservation of access validity and pointer validity *)

Theorem valid_block_inject_1:
  forall f m1 m2 b1 b2 delta,
  f b1 = Some(b2, delta) ->
  inject f m1 m2 ->
  valid_block m1 b1.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. destruct (plt b1 (nextblock m1)). auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  assert (f b1 = None). eapply mi_freeblocks; eauto. congruence.
Qed.

Theorem valid_block_inject_2:
  forall f m1 m2 b1 b2 delta,
  f b1 = Some(b2, delta) ->
  inject f m1 m2 ->
  valid_block m2 b2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_mappedblocks; eauto.
Qed.

Local Hint Resolve valid_block_inject_1 valid_block_inject_2: mem.

Theorem perm_inject:
  forall f m1 m2 b1 b2 delta ofs k p,
  f b1 = Some(b2, delta) ->
  inject f m1 m2 ->
  perm m1 b1 ofs k p -> perm m2 b2 (ofs + delta) k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H0. eapply perm_inj; eauto.
Qed.

Theorem perm_inject_inv:
  forall f m1 m2 b1 ofs b2 delta k p,
  inject f m1 m2 ->
  f b1 = Some(b2, delta) ->
  perm m2 b2 (ofs + delta) k p ->
  perm m1 b1 ofs k p \/ ~perm m1 b1 ofs Max Nonempty.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_perm_inv; eauto.
Qed.

Theorem range_perm_inject:
  forall f m1 m2 b1 b2 delta lo hi k p,
  f b1 = Some(b2, delta) ->
  inject f m1 m2 ->
  range_perm m1 b1 lo hi k p -> range_perm m2 b2 (lo + delta) (hi + delta) k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H0. eapply range_perm_inj; eauto.
Qed.

Theorem valid_access_inject:
  forall f m1 m2 chunk b1 ofs b2 delta p,
  f b1 = Some(b2, delta) ->
  inject f m1 m2 ->
  valid_access m1 chunk b1 ofs p ->
  valid_access m2 chunk b2 (ofs + delta) p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply valid_access_inj; eauto. apply mi_inj; auto.
Qed.

Theorem valid_pointer_inject:
  forall f m1 m2 b1 ofs b2 delta,
  f b1 = Some(b2, delta) ->
  inject f m1 m2 ->
  valid_pointer m1 b1 ofs = true ->
  valid_pointer m2 b2 (ofs + delta) = true.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: or (not (@eq block b1' b2')) (not (@eq Z (Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta1))) (Ptrofs.unsigned (Ptrofs.add ofs2 (Ptrofs.repr delta2))))) *)
  rewrite valid_pointer_valid_access in H1.
(* Goal: @eq bool (valid_pointer m2 b2 (Z.add ofs delta)) true *)
  rewrite valid_pointer_valid_access.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply valid_access_inject; eauto.
Qed.

Theorem weak_valid_pointer_inject:
  forall f m1 m2 b1 ofs b2 delta,
  f b1 = Some(b2, delta) ->
  inject f m1 m2 ->
  weak_valid_pointer m1 b1 ofs = true ->
  weak_valid_pointer m2 b2 (ofs + delta) = true.
Proof.
(* Goal: forall _ : @eq bool (weak_valid_pointer m1 b1 ofs) true, @eq bool (weak_valid_pointer m2 b2 (Z.add ofs delta)) true *)
  intros until 2. unfold weak_valid_pointer. rewrite !orb_true_iff.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace (ofs + delta - 1) with ((ofs - 1) + delta) by omega.
(* Goal: forall _ : or (@eq bool (valid_pointer m1 b1 ofs) true) (@eq bool (valid_pointer m1 b1 (Z.sub ofs (Zpos xH))) true), or (@eq bool (valid_pointer m2 b2 (Z.add ofs delta)) true) (@eq bool (valid_pointer m2 b2 (Z.add (Z.sub ofs (Zpos xH)) delta)) true) *)
  intros []; eauto using valid_pointer_inject.
Qed.

(** The following lemmas establish the absence of machine integer overflow
  during address computations. *)

Lemma address_inject:
  forall f m1 m2 b1 ofs1 b2 delta p,
  inject f m1 m2 ->
  perm m1 b1 (Ptrofs.unsigned ofs1) Cur p ->
  f b1 = Some (b2, delta) ->
  Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta)) = Ptrofs.unsigned ofs1 + delta.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  assert (perm m1 b1 (Ptrofs.unsigned ofs1) Max Nonempty) by eauto with mem.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_representable; eauto. intros [A B].
(* Goal: @eq Z (Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta))) (Z.add (Ptrofs.unsigned ofs1) delta) *)
  assert (0 <= delta <= Ptrofs.max_unsigned).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
    generalize (Ptrofs.unsigned_range ofs1). omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  unfold Ptrofs.add. repeat rewrite Ptrofs.unsigned_repr; omega.
Qed.

Lemma address_inject':
  forall f m1 m2 chunk b1 ofs1 b2 delta,
  inject f m1 m2 ->
  valid_access m1 chunk b1 (Ptrofs.unsigned ofs1) Nonempty ->
  f b1 = Some (b2, delta) ->
  Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta)) = Ptrofs.unsigned ofs1 + delta.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H0. eapply address_inject; eauto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  apply H0. generalize (size_chunk_pos chunk). omega.
Qed.

Theorem weak_valid_pointer_inject_no_overflow:
  forall f m1 m2 b ofs b' delta,
  inject f m1 m2 ->
  weak_valid_pointer m1 b (Ptrofs.unsigned ofs) = true ->
  f b = Some(b', delta) ->
  0 <= Ptrofs.unsigned ofs + Ptrofs.unsigned (Ptrofs.repr delta) <= Ptrofs.max_unsigned.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite weak_valid_pointer_spec in H0.
  rewrite ! valid_pointer_nonempty_perm in H0.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_representable; eauto. destruct H0; eauto with mem.
(* Goal: forall _ : and (perm m1 b1 ofs k p) (forall (lo hi : Z) (_ : @In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo) hi) l) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False), False *)
  intros [A B].
  pose proof (Ptrofs.unsigned_range ofs).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  rewrite Ptrofs.unsigned_repr; omega.
Qed.

Theorem valid_pointer_inject_no_overflow:
  forall f m1 m2 b ofs b' delta,
  inject f m1 m2 ->
  valid_pointer m1 b (Ptrofs.unsigned ofs) = true ->
  f b = Some(b', delta) ->
  0 <= Ptrofs.unsigned ofs + Ptrofs.unsigned (Ptrofs.repr delta) <= Ptrofs.max_unsigned.
Proof.
(* Goal: forall (f : Val.meminj) (m1 m2 : mem) (b : block) (ofs : Ptrofs.int) (b' : block) (delta : Z) (_ : inject f m1 m2) (_ : @eq bool (valid_pointer m1 b (Ptrofs.unsigned ofs)) true) (_ : @eq (option (prod block Z)) (f b) (@Some (prod block Z) (@pair block Z b' delta))), and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) (Ptrofs.unsigned (Ptrofs.repr delta)))) (Z.le (Z.add (Ptrofs.unsigned ofs) (Ptrofs.unsigned (Ptrofs.repr delta))) Ptrofs.max_unsigned) *)
  eauto using weak_valid_pointer_inject_no_overflow, valid_pointer_implies.
Qed.

Theorem valid_pointer_inject_val:
  forall f m1 m2 b ofs b' ofs',
  inject f m1 m2 ->
  valid_pointer m1 b (Ptrofs.unsigned ofs) = true ->
  Val.inject f (Vptr b ofs) (Vptr b' ofs') ->
  valid_pointer m2 b' (Ptrofs.unsigned ofs') = true.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H1.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  erewrite address_inject'; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply valid_pointer_inject; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite valid_pointer_valid_access in H0. eauto.
Qed.

Theorem weak_valid_pointer_inject_val:
  forall f m1 m2 b ofs b' ofs',
  inject f m1 m2 ->
  weak_valid_pointer m1 b (Ptrofs.unsigned ofs) = true ->
  Val.inject f (Vptr b ofs) (Vptr b' ofs') ->
  weak_valid_pointer m2 b' (Ptrofs.unsigned ofs') = true.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H1.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit weak_valid_pointer_inject; eauto. intros W.
  rewrite weak_valid_pointer_spec in H0.
  rewrite ! valid_pointer_nonempty_perm in H0.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_representable; eauto. destruct H0; eauto with mem.
(* Goal: forall _ : and (perm m1 b1 ofs k p) (forall (lo hi : Z) (_ : @In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo) hi) l) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False), False *)
  intros [A B].
  pose proof (Ptrofs.unsigned_range ofs).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  unfold Ptrofs.add. repeat rewrite Ptrofs.unsigned_repr; auto; omega.
Qed.

Theorem inject_no_overlap:
  forall f m1 m2 b1 b2 b1' b2' delta1 delta2 ofs1 ofs2,
  inject f m1 m2 ->
  b1 <> b2 ->
  f b1 = Some (b1', delta1) ->
  f b2 = Some (b2', delta2) ->
  perm m1 b1 ofs1 Max Nonempty ->
  perm m1 b2 ofs2 Max Nonempty ->
  b1' <> b2' \/ ofs1 + delta1 <> ofs2 + delta2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. eapply mi_no_overlap0; eauto.
Qed.

Theorem different_pointers_inject:
  forall f m m' b1 ofs1 b2 ofs2 b1' delta1 b2' delta2,
  inject f m m' ->
  b1 <> b2 ->
  valid_pointer m b1 (Ptrofs.unsigned ofs1) = true ->
  valid_pointer m b2 (Ptrofs.unsigned ofs2) = true ->
  f b1 = Some (b1', delta1) ->
  f b2 = Some (b2', delta2) ->
  b1' <> b2' \/
  Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta1)) <>
  Ptrofs.unsigned (Ptrofs.add ofs2 (Ptrofs.repr delta2)).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: or (not (@eq block b1' b2')) (not (@eq Z (Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta1))) (Ptrofs.unsigned (Ptrofs.add ofs2 (Ptrofs.repr delta2))))) *)
  rewrite valid_pointer_valid_access in H1.
(* Goal: or (not (@eq block b1' b2')) (not (@eq Z (Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta1))) (Ptrofs.unsigned (Ptrofs.add ofs2 (Ptrofs.repr delta2))))) *)
  rewrite valid_pointer_valid_access in H2.
(* Goal: or (not (@eq block b1' b2')) (not (@eq Z (Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta1))) (Ptrofs.unsigned (Ptrofs.add ofs2 (Ptrofs.repr delta2))))) *)
  rewrite (address_inject' _ _ _ _ _ _ _ _ H H1 H3).
(* Goal: or (not (@eq block b1' b2')) (not (@eq Z (Z.add (Ptrofs.unsigned ofs1) delta1) (Ptrofs.unsigned (Ptrofs.add ofs2 (Ptrofs.repr delta2))))) *)
  rewrite (address_inject' _ _ _ _ _ _ _ _ H H2 H4).
(* Goal: False *)
(* Goal: False *)
  inv H1. simpl in H5. inv H2. simpl in H1.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_no_overlap; eauto.
(* Goal: perm m b2 (Ptrofs.unsigned ofs2) Max Nonempty *)
  apply perm_cur_max. apply (H5 (Ptrofs.unsigned ofs1)). omega.
(* Goal: perm m b2 (Ptrofs.unsigned ofs2) Max Nonempty *)
  apply perm_cur_max. apply (H1 (Ptrofs.unsigned ofs2)). omega.
Qed.

Theorem disjoint_or_equal_inject:
  forall f m m' b1 b1' delta1 b2 b2' delta2 ofs1 ofs2 sz,
  inject f m m' ->
  f b1 = Some(b1', delta1) ->
  f b2 = Some(b2', delta2) ->
  range_perm m b1 ofs1 (ofs1 + sz) Max Nonempty ->
  range_perm m b2 ofs2 (ofs2 + sz) Max Nonempty ->
  sz > 0 ->
  b1 <> b2 \/ ofs1 = ofs2 \/ ofs1 + sz <= ofs2 \/ ofs2 + sz <= ofs1 ->
  b1' <> b2' \/ ofs1 + delta1 = ofs2 + delta2
             \/ ofs1 + delta1 + sz <= ofs2 + delta2
             \/ ofs2 + delta2 + sz <= ofs1 + delta1.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  destruct (eq_block b1 b2).
(* Goal: or (and (@eq val v (Val.load_result chunk' v0)) (and (compat_pointer_chunks chunk chunk') (and (@eq block b b) (@eq Z ofs' ofs)))) (or (not (@eq block b b)) (or (Z.le (Z.add ofs' (size_chunk chunk')) ofs) (Z.le (Z.add ofs (size_chunk chunk)) ofs'))) *)
  assert (b1' = b2') by congruence. assert (delta1 = delta2) by congruence. subst.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  destruct H5. congruence. right. destruct H5. left; congruence. right. omega.
(* Goal: or (and (@eq val v (Val.load_result chunk' v0)) (and (compat_pointer_chunks chunk chunk') (and (@eq block b b) (@eq Z ofs' ofs)))) (or (not (@eq block b b)) (or (Z.le (Z.add ofs' (size_chunk chunk')) ofs) (Z.le (Z.add ofs (size_chunk chunk)) ofs'))) *)
  destruct (eq_block b1' b2'); auto. subst. right. right.
  set (i1 := (ofs1 + delta1, ofs1 + delta1 + sz)).
  set (i2 := (ofs2 + delta2, ofs2 + delta2 + sz)).
  change (snd i1 <= fst i2 \/ snd i2 <= fst i1).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  apply Intv.range_disjoint'; simpl; try omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold Intv.disjoint, Intv.In; simpl; intros. red; intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_no_overlap; eauto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  instantiate (1 := x - delta1). apply H2. omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  instantiate (1 := x - delta2). apply H3. omega.
(* Goal: perm_order p Readable *)
(* Goal: perm m' b' ofs0 Cur Readable *)
(* Goal: @eq (option (list memval)) (if range_perm_dec m' b' ofs (Z.add ofs n) Cur Readable then @Some (list memval) (getN (nat_of_Z n) ofs (@PMap.get (ZMap.t memval) b' (mem_contents m'))) else @None (list memval)) (@None (list memval)) *)
  intuition.
Qed.

Theorem aligned_area_inject:
  forall f m m' b ofs al sz b' delta,
  inject f m m' ->
  al = 1 \/ al = 2 \/ al = 4 \/ al = 8 -> sz > 0 ->
  (al | sz) ->
  range_perm m b ofs (ofs + sz) Cur Nonempty ->
  (al | ofs) ->
  f b = Some(b', delta) ->
  (al | ofs + delta).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  assert (P: al > 0) by omega.
(* Goal: Ple (nextblock m) (nextblock m') *)
  assert (Q: Z.abs al <= Z.abs sz). apply Zdivide_bounds; auto. omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  rewrite Z.abs_eq in Q; try omega. rewrite Z.abs_eq in Q; try omega.
(* Goal: Z.divide al (Z.add ofs delta) *)
  assert (R: exists chunk, al = align_chunk chunk /\ al = size_chunk chunk).
(* Goal: Ple (nextblock m) (nextblock m') *)
    destruct H0. subst; exists Mint8unsigned; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
    destruct H0. subst; exists Mint16unsigned; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
    destruct H0. subst; exists Mint32; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
    subst; exists Mint64; auto.
(* Goal: Z.divide al (Z.add ofs delta) *)
  destruct R as [chunk [A B]].
(* Goal: Z.divide al (Z.add ofs delta) *)
  assert (valid_access m chunk b ofs Nonempty).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
    split. red; intros; apply H3. omega. congruence.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit valid_access_inject; eauto. intros [C D].
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
Qed.

(** Preservation of loads *)

Theorem load_inject:
  forall f m1 m2 chunk b1 ofs b2 delta v1,
  inject f m1 m2 ->
  load chunk m1 b1 ofs = Some v1 ->
  f b1 = Some (b2, delta) ->
  exists v2, load chunk m2 b2 (ofs + delta) = Some v2 /\ Val.inject f v1 v2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. eapply load_inj; eauto.
Qed.

Theorem loadv_inject:
  forall f m1 m2 chunk a1 a2 v1,
  inject f m1 m2 ->
  loadv chunk m1 a1 = Some v1 ->
  Val.inject f a1 a2 ->
  exists v2, loadv chunk m2 a2 = Some v2 /\ Val.inject f v1 v2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H1; simpl in H0; try discriminate.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit load_inject; eauto. intros [v2 [LOAD INJ]].
(* Goal: Ple (nextblock m) (nextblock m') *)
  exists v2; split; auto. unfold loadv.
  replace (Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta)))
     with (Ptrofs.unsigned ofs1 + delta).
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto. symmetry. eapply address_inject'; eauto with mem.
Qed.

Theorem loadbytes_inject:
  forall f m1 m2 b1 ofs len b2 delta bytes1,
  inject f m1 m2 ->
  loadbytes m1 b1 ofs len = Some bytes1 ->
  f b1 = Some (b2, delta) ->
  exists bytes2, loadbytes m2 b2 (ofs + delta) len = Some bytes2
              /\ list_forall2 (memval_inject f) bytes1 bytes2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. eapply loadbytes_inj; eauto.
Qed.

(** Preservation of stores *)

Theorem store_mapped_inject:
  forall f chunk m1 b1 ofs v1 n1 m2 b2 delta v2,
  inject f m1 m2 ->
  store chunk m1 b1 ofs v1 = Some n1 ->
  f b1 = Some (b2, delta) ->
  Val.inject f v1 v2 ->
  exists n2,
    store chunk m2 b2 (ofs + delta) v2 = Some n2
    /\ inject f n1 n2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit store_mapped_inj; eauto. intros [n2 [STORE MI]].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exists n2; split. eauto. constructor.
(* inj *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* freeblocks *)
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* mappedblocks *)
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* no overlap *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eauto with mem.
(* representable *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_representable; try eassumption.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  destruct H4; eauto with mem.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit mi_perm_inv0; eauto using perm_store_2.
(* Goal: forall _ : or (perm m1 b0 ofs0 k p) (not (perm m1 b0 ofs0 Max Nonempty)), or (perm n1 b0 ofs0 k p) (not (perm n1 b0 ofs0 Max Nonempty)) *)
  intuition eauto using perm_store_1, perm_store_2.
Qed.

Theorem store_unmapped_inject:
  forall f chunk m1 b1 ofs v1 n1 m2,
  inject f m1 m2 ->
  store chunk m1 b1 ofs v1 = Some n1 ->
  f b1 = None ->
  inject f n1 m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  constructor.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply store_unmapped_inj; eauto.
(* freeblocks *)
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* mappedblocks *)
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* no overlap *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eauto with mem.
(* representable *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_representable; try eassumption.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  destruct H3; eauto with mem.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit mi_perm_inv0; eauto using perm_store_2.
(* Goal: forall _ : or (perm m1 b0 ofs0 k p) (not (perm m1 b0 ofs0 Max Nonempty)), or (perm n1 b0 ofs0 k p) (not (perm n1 b0 ofs0 Max Nonempty)) *)
  intuition eauto using perm_store_1, perm_store_2.
Qed.

Theorem store_outside_inject:
  forall f m1 m2 chunk b ofs v m2',
  inject f m1 m2 ->
  (forall b' delta ofs',
    f b' = Some(b, delta) ->
    perm m1 b' ofs' Cur Readable ->
    ofs <= ofs' + delta < ofs + size_chunk chunk -> False) ->
  store chunk m2 b ofs v = Some m2' ->
  inject f m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H. constructor.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply store_outside_inj; eauto.
(* freeblocks *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* mappedblocks *)
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* no overlap *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* representable *)
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eauto using perm_store_2.
Qed.

Theorem storev_mapped_inject:
  forall f chunk m1 a1 v1 n1 m2 a2 v2,
  inject f m1 m2 ->
  storev chunk m1 a1 v1 = Some n1 ->
  Val.inject f a1 a2 ->
  Val.inject f v1 v2 ->
  exists n2,
    storev chunk m2 a2 v2 = Some n2 /\ inject f n1 n2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H1; simpl in H0; try discriminate.
(* Goal: @ex mem (fun n2 : mem => and (@eq (option mem) (storev chunk m2 (Vptr b2 (Ptrofs.add ofs1 (Ptrofs.repr delta))) v2) (@Some mem n2)) (inject f n1 n2)) *)
  unfold storev.
  replace (Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta)))
    with (Ptrofs.unsigned ofs1 + delta).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply store_mapped_inject; eauto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  symmetry. eapply address_inject'; eauto with mem.
Qed.

Theorem storebytes_mapped_inject:
  forall f m1 b1 ofs bytes1 n1 m2 b2 delta bytes2,
  inject f m1 m2 ->
  storebytes m1 b1 ofs bytes1 = Some n1 ->
  f b1 = Some (b2, delta) ->
  list_forall2 (memval_inject f) bytes1 bytes2 ->
  exists n2,
    storebytes m2 b2 (ofs + delta) bytes2 = Some n2
    /\ inject f n1 n2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit storebytes_mapped_inj; eauto. intros [n2 [STORE MI]].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exists n2; split. eauto. constructor.
(* inj *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* freeblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. apply mi_freeblocks0. red; intros; elim H3; eapply storebytes_valid_block_1; eauto.
(* mappedblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply storebytes_valid_block_1; eauto.
(* no overlap *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply mi_no_overlap0; eauto; eapply perm_storebytes_2; eauto.
(* representable *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_representable0; eauto.
(* Goal: or (perm m1 b0 ofs0 k p) (not (perm m1 b0 ofs0 Max Nonempty)) *)
  destruct H4; eauto using perm_storebytes_2.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit mi_perm_inv0; eauto using perm_storebytes_2.
(* Goal: forall _ : or (perm m1 b0 ofs k p) (not (perm m1 b0 ofs Max Nonempty)), or (perm m1' b0 ofs k p) (not (perm m1' b0 ofs Max Nonempty)) *)
  intuition eauto using perm_storebytes_1, perm_storebytes_2.
Qed.

Theorem storebytes_unmapped_inject:
  forall f m1 b1 ofs bytes1 n1 m2,
  inject f m1 m2 ->
  storebytes m1 b1 ofs bytes1 = Some n1 ->
  f b1 = None ->
  inject f n1 m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  constructor.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply storebytes_unmapped_inj; eauto.
(* freeblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. apply mi_freeblocks0. red; intros; elim H2; eapply storebytes_valid_block_1; eauto.
(* mappedblocks *)
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* no overlap *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply mi_no_overlap0; eauto; eapply perm_storebytes_2; eauto.
(* representable *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_representable0; eauto.
(* Goal: or (perm m1 b0 ofs0 k p) (not (perm m1 b0 ofs0 Max Nonempty)) *)
  destruct H3; eauto using perm_storebytes_2.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit mi_perm_inv0; eauto.
(* Goal: forall _ : or (perm m1 b0 ofs k p) (not (perm m1 b0 ofs Max Nonempty)), or (perm m1' b0 ofs k p) (not (perm m1' b0 ofs Max Nonempty)) *)
  intuition eauto using perm_storebytes_1, perm_storebytes_2.
Qed.

Theorem storebytes_outside_inject:
  forall f m1 m2 b ofs bytes2 m2',
  inject f m1 m2 ->
  (forall b' delta ofs',
    f b' = Some(b, delta) ->
    perm m1 b' ofs' Cur Readable ->
    ofs <= ofs' + delta < ofs + Z.of_nat (length bytes2) -> False) ->
  storebytes m2 b ofs bytes2 = Some m2' ->
  inject f m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H. constructor.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply storebytes_outside_inj; eauto.
(* freeblocks *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* mappedblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply storebytes_valid_block_1; eauto.
(* no overlap *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* representable *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_perm_inv0; eauto using perm_storebytes_2.
Qed.

Theorem storebytes_empty_inject:
  forall f m1 b1 ofs1 m1' m2 b2 ofs2 m2',
  inject f m1 m2 ->
  storebytes m1 b1 ofs1 nil = Some m1' ->
  storebytes m2 b2 ofs2 nil = Some m2' ->
  inject f m1' m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H. constructor; intros.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply storebytes_empty_inj; eauto.
(* freeblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. apply mi_freeblocks0. red; intros; elim H2; eapply storebytes_valid_block_1; eauto.
(* mappedblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply storebytes_valid_block_1; eauto.
(* no overlap *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply mi_no_overlap0; eauto; eapply perm_storebytes_2; eauto.
(* representable *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_representable0; eauto.
(* Goal: or (perm m1 b0 ofs0 k p) (not (perm m1 b0 ofs0 Max Nonempty)) *)
  destruct H3; eauto using perm_storebytes_2.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit mi_perm_inv0; eauto using perm_storebytes_2.
(* Goal: forall _ : or (perm m1 b0 ofs k p) (not (perm m1 b0 ofs Max Nonempty)), or (perm m1' b0 ofs k p) (not (perm m1' b0 ofs Max Nonempty)) *)
  intuition eauto using perm_storebytes_1, perm_storebytes_2.
Qed.

(* Preservation of allocations *)

Theorem alloc_right_inject:
  forall f m1 m2 lo hi b2 m2',
  inject f m1 m2 ->
  alloc m2 lo hi = (m2', b2) ->
  inject f m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. injection H0. intros NEXT MEM.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  inversion H. constructor.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply alloc_right_inj; eauto.
(* freeblocks *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* mappedblocks *)
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* no overlap *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* representable *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply perm_alloc_inv in H2; eauto. destruct (eq_block b0 b2).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  subst b0. eelim fresh_block_alloc; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_perm_inv0; eauto.
Qed.

Theorem alloc_left_unmapped_inject:
  forall f m1 m2 lo hi m1' b1,
  inject f m1 m2 ->
  alloc m1 lo hi = (m1', b1) ->
  exists f',
     inject f' m1' m2
  /\ inject_incr f f'
  /\ f' b1 = None
  /\ (forall b, b <> b1 -> f' b = f b).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H.
  set (f' := fun b => if eq_block b b1 then None else f b).
  assert (inject_incr f f').
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    red; unfold f'; intros. destruct (eq_block b b1). subst b.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
    assert (f b1 = None). eauto with mem. congruence.
(* Goal: Ple (nextblock m) (nextblock m') *)
    auto.
  assert (mem_inj f' m1 m2).
(* Goal: valid_access m chunk b ofs p2 *)
    inversion mi_inj0; constructor; eauto with mem.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    unfold f'; intros. destruct (eq_block b0 b1). congruence. eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    unfold f'; intros. destruct (eq_block b0 b1). congruence. eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    unfold f'; intros. destruct (eq_block b0 b1). congruence.
(* Goal: Ple (nextblock m) (nextblock m') *)
    apply memval_inject_incr with f; auto.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  exists f'; split. constructor.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply alloc_left_unmapped_inj; eauto. unfold f'; apply dec_eq_true.
(* freeblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold f'. destruct (eq_block b b1). auto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  apply mi_freeblocks0. red; intro; elim H3. eauto with mem.
(* mappedblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold f'; intros. destruct (eq_block b b1). congruence. eauto.
(* no overlap *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold f'; red; intros.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  destruct (eq_block b0 b1); destruct (eq_block b2 b1); try congruence.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_no_overlap0. eexact H3. eauto. eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit perm_alloc_inv. eauto. eexact H6. rewrite dec_eq_false; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit perm_alloc_inv. eauto. eexact H7. rewrite dec_eq_false; auto.
(* representable *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold f'; intros.
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (eq_block b b1); try discriminate.
(* Goal: valid_block m1 b *)
  eapply mi_representable0; try eassumption.
  destruct H4; eauto using perm_alloc_4.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold f' in H3; destruct (eq_block b0 b1); try discriminate.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_perm_inv0; eauto.
  intuition eauto using perm_alloc_1, perm_alloc_4.
(* incr *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  split. auto.
(* image *)
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  split. unfold f'; apply dec_eq_true.
(* incr *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  intros; unfold f'; apply dec_eq_false; auto.
Qed.

Theorem alloc_left_mapped_inject:
  forall f m1 m2 lo hi m1' b1 b2 delta,
  inject f m1 m2 ->
  alloc m1 lo hi = (m1', b1) ->
  valid_block m2 b2 ->
  0 <= delta <= Ptrofs.max_unsigned ->
  (forall ofs k p, perm m2 b2 ofs k p -> delta = 0 \/ 0 <= ofs < Ptrofs.max_unsigned) ->
  (forall ofs k p, lo <= ofs < hi -> perm m2 b2 (ofs + delta) k p) ->
  inj_offset_aligned delta (hi-lo) ->
  (forall b delta' ofs k p,
   f b = Some (b2, delta') ->
   perm m1 b ofs k p ->
   lo + delta <= ofs + delta' < hi + delta -> False) ->
  exists f',
     inject f' m1' m2
  /\ inject_incr f f'
  /\ f' b1 = Some(b2, delta)
  /\ (forall b, b <> b1 -> f' b = f b).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H.
  set (f' := fun b => if eq_block b b1 then Some(b2, delta) else f b).
  assert (inject_incr f f').
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    red; unfold f'; intros. destruct (eq_block b b1). subst b.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
    assert (f b1 = None). eauto with mem. congruence.
(* Goal: Ple (nextblock m) (nextblock m') *)
    auto.
  assert (mem_inj f' m1 m2).
(* Goal: valid_access m chunk b ofs p2 *)
    inversion mi_inj0; constructor; eauto with mem.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    unfold f'; intros. destruct (eq_block b0 b1).
      inversion H8. subst b0 b3 delta0.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
      elim (fresh_block_alloc _ _ _ _ _ H0). eauto with mem.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
      eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    unfold f'; intros. destruct (eq_block b0 b1).
      inversion H8. subst b0 b3 delta0.
      elim (fresh_block_alloc _ _ _ _ _ H0).
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
      eapply perm_valid_block with (ofs := ofs). apply H9. generalize (size_chunk_pos chunk); omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
      eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    unfold f'; intros. destruct (eq_block b0 b1).
      inversion H8. subst b0 b3 delta0.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
      elim (fresh_block_alloc _ _ _ _ _ H0). eauto with mem.
(* Goal: Ple (nextblock m) (nextblock m') *)
      apply memval_inject_incr with f; auto.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  exists f'. split. constructor.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply alloc_left_mapped_inj; eauto. unfold f'; apply dec_eq_true.
(* freeblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold f'; intros. destruct (eq_block b b1). subst b.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  elim H9. eauto with mem.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* mappedblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold f'; intros. destruct (eq_block b b1). congruence. eauto.
(* overlap *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold f'; red; intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit perm_alloc_inv. eauto. eexact H12. intros P1.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit perm_alloc_inv. eauto. eexact H13. intros P2.
  destruct (eq_block b0 b1); destruct (eq_block b3 b1).
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
  inversion H10; subst b0 b1' delta1.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    destruct (eq_block b2 b2'); auto. subst b2'. right; red; intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply H6; eauto. omega.
  inversion H11; subst b3 b2' delta2.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
    destruct (eq_block b1' b2); auto. subst b1'. right; red; intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply H6; eauto. omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eauto.
(* representable *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold f'; intros.
  destruct (eq_block b b1).
(* Goal: or (and (@eq val v (Val.load_result chunk' v0)) (and (compat_pointer_chunks chunk chunk') (and (@eq block b b) (@eq Z ofs' ofs)))) (or (not (@eq block b b)) (or (Z.le (Z.add ofs' (size_chunk chunk')) ofs) (Z.le (Z.add ofs (size_chunk chunk)) ofs'))) *)
   subst. injection H9; intros; subst b' delta0. destruct H10.
(* Goal: forall _ : @eq val v1 (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b1 (mem_contents m1)))), Val.inject f v1 (decode_val chunk (getN (size_chunk_nat chunk) (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2)))) *)
    exploit perm_alloc_inv; eauto; rewrite dec_eq_true; intro.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    exploit H3. apply H4 with (k := Max) (p := Nonempty); eauto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
    generalize (Ptrofs.unsigned_range_2 ofs). omega.
(* Goal: forall _ : @eq val v1 (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b1 (mem_contents m1)))), Val.inject f v1 (decode_val chunk (getN (size_chunk_nat chunk) (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2)))) *)
   exploit perm_alloc_inv; eauto; rewrite dec_eq_true; intro.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
   exploit H3. apply H4 with (k := Max) (p := Nonempty); eauto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
   generalize (Ptrofs.unsigned_range_2 ofs). omega.
(* Goal: valid_block m1 b *)
  eapply mi_representable0; try eassumption.
  destruct H10; eauto using perm_alloc_4.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold f' in H9; destruct (eq_block b0 b1).
  inversion H9; clear H9; subst b0 b3 delta0.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  assert (EITHER: lo <= ofs < hi \/ ~(lo <= ofs < hi)) by omega.
(* Goal: or (perm m1' b ofs k p) (not (perm m1' b ofs Max Nonempty)) *)
(* Goal: or (perm m1' b0 ofs k p) (not (perm m1' b0 ofs Max Nonempty)) *)
  destruct EITHER.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  left. apply perm_implies with Freeable; auto with mem. eapply perm_alloc_2; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  right; intros A. eapply perm_alloc_inv in A; eauto. rewrite dec_eq_true in A. tauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_perm_inv0; eauto. intuition eauto using perm_alloc_1, perm_alloc_4.
(* incr *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  split. auto.
(* image of b1 *)
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  split. unfold f'; apply dec_eq_true.
(* image of others *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold f'; apply dec_eq_false; auto.
Qed.

Theorem alloc_parallel_inject:
  forall f m1 m2 lo1 hi1 m1' b1 lo2 hi2,
  inject f m1 m2 ->
  alloc m1 lo1 hi1 = (m1', b1) ->
  lo2 <= lo1 -> hi1 <= hi2 ->
  exists f', exists m2', exists b2,
  alloc m2 lo2 hi2 = (m2', b2)
  /\ inject f' m1' m2'
  /\ inject_incr f f'
  /\ f' b1 = Some(b2, 0)
  /\ (forall b, b <> b1 -> f' b = f b).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  case_eq (alloc m2 lo2 hi2). intros m2' b2 ALLOC.
  exploit alloc_left_mapped_inject.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply alloc_right_inject; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eauto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  instantiate (1 := b2). eauto with mem.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  instantiate (1 := 0). unfold Ptrofs.max_unsigned. generalize Ptrofs.modulus_pos; omega.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. apply perm_implies with Freeable; auto with mem.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_alloc_2; eauto. omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. apply Z.divide_0_r.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. apply (valid_not_valid_diff m2 b2 b2); eauto with mem.
  intros [f' [A [B [C D]]]].
(* Goal: Ple (nextblock m) (nextblock m') *)
  exists f'; exists m2'; exists b2; auto.
Qed.

(** Preservation of [free] operations *)

Lemma free_left_inject:
  forall f m1 m2 b lo hi m1',
  inject f m1 m2 ->
  free m1 b lo hi = Some m1' ->
  inject f m1' m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H. constructor.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply free_left_inj; eauto.
(* freeblocks *)
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* mappedblocks *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* no overlap *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eauto with mem.
(* representable *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_representable0; try eassumption.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  destruct H2; eauto with mem.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit mi_perm_inv0; eauto. intuition eauto using perm_free_3.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_free_inv in H4; eauto. destruct H4 as [[A B] | A]; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  subst b1. right; eapply perm_free_2; eauto.
Qed.

Lemma free_list_left_inject:
  forall f m2 l m1 m1',
  inject f m1 m2 ->
  free_list m1 l = Some m1' ->
  inject f m1' m2.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  induction l; simpl; intros.
(* Goal: Ple (nextblock m) (nextblock m') *)
  inv H0. auto.
(* Goal: inject f m1' m2 *)
  destruct a as [[b lo] hi].
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (free m1 b lo hi) as [m11|] eqn:E; try discriminate.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  apply IHl with m11; auto. eapply free_left_inject; eauto.
Qed.

Lemma free_right_inject:
  forall f m1 m2 b lo hi m2',
  inject f m1 m2 ->
  free m2 b lo hi = Some m2' ->
  (forall b1 delta ofs k p,
    f b1 = Some(b, delta) -> perm m1 b1 ofs k p ->
    lo <= ofs + delta < hi -> False) ->
  inject f m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H. constructor.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply free_right_inj; eauto.
(* freeblocks *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* mappedblocks *)
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eauto with mem.
(* no overlap *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* representable *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eauto using perm_free_3.
Qed.

Lemma perm_free_list:
  forall l m m' b ofs k p,
  free_list m l = Some m' ->
  perm m' b ofs k p ->
  perm m b ofs k p /\
  (forall lo hi, In (b, lo, hi) l -> lo <= ofs < hi -> False).
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  induction l; simpl; intros.
(* Goal: Ple (nextblock m) (nextblock m') *)
  inv H. auto.
(* Goal: and (perm m b ofs k p) (forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) a (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False) *)
  destruct a as [[b1 lo1] hi1].
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (free m b1 lo1 hi1) as [m1|] eqn:E; try discriminate.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit IHl; eauto. intros [A B].
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  split. eauto with mem.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H1. inv H1.
(* Goal: Ple (nextblock m) (nextblock m') *)
  elim (perm_free_2 _ _ _ _ _ E ofs k p). auto. auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eauto.
Qed.

Theorem free_inject:
  forall f m1 l m1' m2 b lo hi m2',
  inject f m1 m2 ->
  free_list m1 l = Some m1' ->
  free m2 b lo hi = Some m2' ->
  (forall b1 delta ofs k p,
    f b1 = Some(b, delta) ->
    perm m1 b1 ofs k p -> lo <= ofs + delta < hi ->
    exists lo1, exists hi1, In (b1, lo1, hi1) l /\ lo1 <= ofs < hi1) ->
  inject f m1' m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply free_right_inject; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply free_list_left_inject; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. exploit perm_free_list; eauto. intros [A B].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit H2; eauto. intros [lo1 [hi1 [C D]]]. eauto.
Qed.

Theorem free_parallel_inject:
  forall f m1 m2 b lo hi m1' b' delta,
  inject f m1 m2 ->
  free m1 b lo hi = Some m1' ->
  f b = Some(b', delta) ->
  exists m2',
     free m2 b' (lo + delta) (hi + delta) = Some m2'
  /\ inject f m1' m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
  destruct (range_perm_free m2 b' (lo + delta) (hi + delta)) as [m2' FREE].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply range_perm_inject; eauto. eapply free_range_perm; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  exists m2'; split; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply free_inject with (m1 := m1) (l := (b,lo,hi)::nil); eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  simpl; rewrite H0; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct (eq_block b1 b).
(* Goal: or (not (@eq block b1' b2')) (not (@eq Z (Z.add (Ptrofs.unsigned ofs1) delta1) (Z.add (Ptrofs.unsigned ofs2) delta2))) *)
  subst b1. rewrite H1 in H2; inv H2.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  exists lo, hi; split; auto with coqlib. omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_no_overlap. eexact H. eexact n. eauto. eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_max. eapply perm_implies. eauto. auto with mem.
  instantiate (1 := ofs + delta0 - delta).
(* Goal: perm m b2 (Ptrofs.unsigned ofs2) Max Nonempty *)
  apply perm_cur_max. apply perm_implies with Freeable; auto with mem.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply free_range_perm; eauto. omega.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  intros [A|A]. congruence. omega.
Qed.

Lemma drop_outside_inject: forall f m1 m2 b lo hi p m2',
  inject f m1 m2 ->
  drop_perm m2 b lo hi p = Some m2' ->
  (forall b' delta ofs k p,
    f b' = Some(b, delta) ->
    perm m1 b' ofs k p -> lo <= ofs + delta < hi -> False) ->
  inject f m1 m2'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H. constructor; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply drop_outside_inj; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold valid_block in *. erewrite nextblock_drop; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eapply mi_perm_inv0; eauto using perm_drop_4.
Qed.

(** Composing two memory injections. *)

Lemma mem_inj_compose:
  forall f f' m1 m2 m3,
  mem_inj f m1 m2 -> mem_inj f' m2 m3 -> mem_inj (compose_meminj f f') m1 m3.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold compose_meminj. inv H; inv H0; constructor; intros.
  (* perm *)
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (f b1) as [[b' delta'] |] eqn:?; try discriminate.
(* Goal: Val.inject f v1 v3 *)
  destruct (f' b') as [[b'' delta''] |] eqn:?; inv H.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace (ofs + (delta' + delta'')) with ((ofs + delta') + delta'') by omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eauto.
  (* align *)
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (f b1) as [[b' delta'] |] eqn:?; try discriminate.
(* Goal: Val.inject f v1 v3 *)
  destruct (f' b') as [[b'' delta''] |] eqn:?; inv H.
(* Goal: Z.divide (align_chunk chunk) (Z.add delta' delta'') *)
(* Goal: memval_inject (fun b : block => match f b with | Some (pair b' delta as p) => match f' b' with | Some (pair b'' delta' as p0) => @Some (prod block Z) (@pair block Z b'' (Z.add delta delta')) | None => @None (prod block Z) end | None => @None (prod block Z) end) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b1 (mem_contents m1))) (@ZMap.get memval (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m3))) *)
  apply Z.divide_add_r.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_align0; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_align1 with (ofs := ofs + delta') (p := p); eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. replace ofs0 with ((ofs0 - delta') + delta') by omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_perm0; eauto. apply H0. omega.
  (* memval *)
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (f b1) as [[b' delta'] |] eqn:?; try discriminate.
(* Goal: Val.inject f v1 v3 *)
  destruct (f' b') as [[b'' delta''] |] eqn:?; inv H.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace (ofs + (delta' + delta'')) with ((ofs + delta') + delta'') by omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply memval_inject_compose; eauto.
Qed.

Theorem inject_compose:
  forall f f' m1 m2 m3,
  inject f m1 m2 -> inject f' m2 m3 ->
  inject (compose_meminj f f') m1 m3.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold compose_meminj; intros.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  inv H; inv H0. constructor.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mem_inj_compose; eauto.
(* unmapped *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. erewrite mi_freeblocks0; eauto.
(* mapped *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (f b) as [[b1 delta1] |] eqn:?; try discriminate.
(* Goal: Val.inject f v1 v3 *)
  destruct (f' b1) as [[b2 delta2] |] eqn:?; inv H.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eauto.
(* no overlap *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros.
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (f b1) as [[b1x delta1x] |] eqn:?; try discriminate.
(* Goal: Val.inject f v1 v3 *)
  destruct (f' b1x) as [[b1y delta1y] |] eqn:?; inv H0.
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (f b2) as [[b2x delta2x] |] eqn:?; try discriminate.
(* Goal: False *)
(* Goal: False *)
  destruct (f' b2x) as [[b2y delta2y] |] eqn:?; inv H1.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_no_overlap0; eauto. intros A.
  destruct (eq_block b1x b2x).
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  subst b1x. destruct A. congruence.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  assert (delta1y = delta2y) by congruence. right; omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_no_overlap1. eauto. eauto. eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply perm_inj. eauto. eexact H2. eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
    eapply perm_inj. eauto. eexact H3. eauto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  intuition omega.
(* representable *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (f b) as [[b1 delta1] |] eqn:?; try discriminate.
(* Goal: Val.inject f v1 v3 *)
  destruct (f' b1) as [[b2 delta2] |] eqn:?; inv H.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_representable0; eauto. intros [A B].
  set (ofs' := Ptrofs.repr (Ptrofs.unsigned ofs + delta1)).
  assert (Ptrofs.unsigned ofs' = Ptrofs.unsigned ofs + delta1).
(* Goal: Ple (nextblock m) (nextblock m') *)
    unfold ofs'; apply Ptrofs.unsigned_repr. auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_representable1. eauto. instantiate (1 := ofs').
  rewrite H.
  replace (Ptrofs.unsigned ofs + delta1 - 1) with
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
    ((Ptrofs.unsigned ofs - 1) + delta1) by omega.
  destruct H0; eauto using perm_inj.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  rewrite H. omega.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (f b1) as [[b' delta'] |] eqn:?; try discriminate.
(* Goal: range_perm m b lo hi Cur Freeable *)
  destruct (f' b') as [[b'' delta''] |] eqn:?; try discriminate.
  inversion H; clear H; subst b'' delta.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace (ofs + (delta' + delta'')) with ((ofs + delta') + delta'') in H0 by omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_perm_inv1; eauto. intros [A|A].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_perm_inv0; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  right; red; intros. elim A. eapply perm_inj; eauto.
Qed.

Lemma val_lessdef_inject_compose:
  forall f v1 v2 v3,
  Val.lessdef v1 v2 -> Val.inject f v2 v3 -> Val.inject f v1 v3.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H. auto. auto.
Qed.

Lemma val_inject_lessdef_compose:
  forall f v1 v2 v3,
  Val.inject f v1 v2 -> Val.lessdef v2 v3 -> Val.inject f v1 v3.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H0. auto. inv H. auto.
Qed.

Lemma extends_inject_compose:
  forall f m1 m2 m3,
  extends m1 m2 -> inject f m2 m3 -> inject f m1 m3.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H; inv H0. constructor; intros.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  replace f with (compose_meminj inject_id f). eapply mem_inj_compose; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  apply extensionality; intros. unfold compose_meminj, inject_id.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (f x) as [[y delta] | ]; auto.
(* unmapped *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_freeblocks0. erewrite <- valid_block_extends; eauto.
(* mapped *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eauto.
(* no overlap *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply mi_no_overlap0; eauto; eapply perm_extends; eauto.
(* representable *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_representable0; eauto.
(* Goal: or (perm m2 b (Ptrofs.unsigned ofs) Max Nonempty) (perm m2 b (Z.sub (Ptrofs.unsigned ofs) (Zpos xH)) Max Nonempty) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  destruct H1; eauto using perm_extends.
(* perm inv *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mi_perm_inv0; eauto. intros [A|A].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mext_perm_inv0; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  right; red; intros; elim A. eapply perm_extends; eauto.
Qed.

Lemma inject_extends_compose:
  forall f m1 m2 m3,
  inject f m1 m2 -> extends m2 m3 -> inject f m1 m3.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inv H; inversion H0. constructor; intros.
(* inj *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  replace f with (compose_meminj f inject_id). eapply mem_inj_compose; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  apply extensionality; intros. unfold compose_meminj, inject_id.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (f x) as [[y delta] | ]; auto. decEq. decEq. omega.
(* unmapped *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eauto.
(* mapped *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  erewrite <- valid_block_extends; eauto.
(* no overlap *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. eapply mi_no_overlap0; eauto.
(* representable *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_representable0; eauto.
(* perm inv *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mext_perm_inv0; eauto. intros [A|A].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mi_perm_inv0; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  right; red; intros; elim A. eapply perm_inj; eauto.
Qed.

Lemma extends_extends_compose:
  forall m1 m2 m3,
  extends m1 m2 -> extends m2 m3 -> extends m1 m3.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. inversion H; subst; inv H0; constructor; intros.
  (* nextblock *)
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  congruence.
  (* meminj *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  replace inject_id with (compose_meminj inject_id inject_id).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mem_inj_compose; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  apply extensionality; intros. unfold compose_meminj, inject_id. auto.
  (* perm inv *)
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit mext_perm_inv1; eauto. intros [A|A].
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply mext_perm_inv0; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  right; red; intros; elim A. eapply perm_extends; eauto.
Qed.

(** Injecting a memory into itself. *)

Definition flat_inj (thr: block) : meminj :=
  fun (b: block) => if plt b thr then Some(b, 0) else None.

Definition inject_neutral (thr: block) (m: mem) :=
  mem_inj (flat_inj thr) m m.

Remark flat_inj_no_overlap:
  forall thr m, meminj_no_overlap (flat_inj thr) m.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold flat_inj; intros; red; intros.
(* Goal: or (and (@eq val v (Val.load_result chunk' v0)) (and (compat_pointer_chunks chunk chunk') (and (@eq block b b) (@eq Z ofs' ofs)))) (or (not (@eq block b b)) (or (Z.le (Z.add ofs' (size_chunk chunk')) ofs) (Z.le (Z.add ofs (size_chunk chunk)) ofs'))) *)
  destruct (plt b1 thr); inversion H0; subst.
(* Goal: or (and (@eq val v (Val.load_result chunk' v0)) (and (compat_pointer_chunks chunk chunk') (and (@eq block b b) (@eq Z ofs' ofs)))) (or (not (@eq block b b)) (or (Z.le (Z.add ofs' (size_chunk chunk')) ofs) (Z.le (Z.add ofs (size_chunk chunk)) ofs'))) *)
  destruct (plt b2 thr); inversion H1; subst.
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
Qed.

Theorem neutral_inject:
  forall m, inject_neutral (nextblock m) m -> inject (flat_inj (nextblock m)) m m.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. constructor.
(* meminj *)
(* Goal: Ple (nextblock m) (nextblock m') *)
  auto.
(* freeblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold flat_inj, valid_block; intros.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply pred_dec_false. auto.
(* mappedblocks *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold flat_inj, valid_block; intros.
(* Goal: or (and (@eq val v (Val.load_result chunk' v0)) (and (compat_pointer_chunks chunk chunk') (and (@eq block b b) (@eq Z ofs' ofs)))) (or (not (@eq block b b)) (or (Z.le (Z.add ofs' (size_chunk chunk')) ofs) (Z.le (Z.add ofs (size_chunk chunk)) ofs'))) *)
  destruct (plt b (nextblock m)); inversion H0; subst. auto.
(* no overlap *)
(* Goal: meminj_no_overlap (flat_inj (nextblock m)) m *)
(* Goal: forall (b b' : block) (delta : Z) (ofs : Ptrofs.int) (_ : @eq (option (prod block Z)) (flat_inj (nextblock m) b) (@Some (prod block Z) (@pair block Z b' delta))) (_ : or (perm m b (Ptrofs.unsigned ofs) Max Nonempty) (perm m b (Z.sub (Ptrofs.unsigned ofs) (Zpos xH)) Max Nonempty)), and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: forall (b1 : block) (ofs : Z) (b2 : block) (delta : Z) (k : perm_kind) (p : permission) (_ : @eq (option (prod block Z)) (flat_inj (nextblock m) b1) (@Some (prod block Z) (@pair block Z b2 delta))) (_ : perm m b2 (Z.add ofs delta) k p), or (perm m b1 ofs k p) (not (perm m b1 ofs Max Nonempty)) *)
  apply flat_inj_no_overlap.
(* range *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold flat_inj; intros.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  destruct (plt b (nextblock m)); inv H0. generalize (Ptrofs.unsigned_range_2 ofs); omega.
(* perm inv *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold flat_inj; intros.
(* Goal: Val.inject f v1 v3 *)
  destruct (plt b1 (nextblock m)); inv H0.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite Z.add_0_r in H1; auto.
Qed.

Theorem empty_inject_neutral:
  forall thr, inject_neutral thr empty.
Proof.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  intros; red; constructor.
(* perm *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold flat_inj; intros. destruct (plt b1 thr); inv H.
(* Goal: Ple (nextblock m) (nextblock m') *)
  replace (ofs + 0) with ofs by omega; auto.
(* align *)
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold flat_inj; intros. destruct (plt b1 thr); inv H. apply Z.divide_0_r.
(* mem_contents *)
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  intros; simpl. rewrite ! PMap.gi. rewrite ! ZMap.gi. constructor.
Qed.

Theorem alloc_inject_neutral:
  forall thr m lo hi b m',
  alloc m lo hi = (m', b) ->
  inject_neutral thr m ->
  Plt (nextblock m) thr ->
  inject_neutral thr m'.
Proof.
(* Goal: inj_offset_aligned Z0 (Z.sub hi1 lo1) *)
(* Goal: forall (ofs : Z) (k : perm_kind) (p : permission) (_ : and (Z.le lo1 ofs) (Z.lt ofs hi1)), perm m2' b (Z.add ofs Z0) k p *)
(* Goal: forall (b : block) (ofs : Z) (k : perm_kind) (p : permission) (_ : perm m2' b ofs k p), or (perm m1' b ofs k p) (not (perm m1' b ofs Max Nonempty)) *)
  intros; red.
  eapply alloc_left_mapped_inj with (m1 := m) (b2 := b) (delta := 0).
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply alloc_right_inj; eauto. eauto. eauto with mem.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red. intros. apply Z.divide_0_r.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: perm_order Freeable p *)
(* Goal: perm_order p p' *)
(* Goal: forall _ : perm_order' (if andb true false then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p', perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p' *)
(* Goal: forall _ : perm_order' (if andb false (if zlt ofs hi then true else false) then @Some permission p else @PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p', perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b (mem_access m) ofs k) p' *)
(* Goal: forall _ : perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b' (mem_access m) ofs k) p', perm_order' (@PMap.get (forall (_ : Z) (_ : perm_kind), option permission) b' (mem_access m) ofs k) p' *)
  apply perm_implies with Freeable; auto with mem.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_alloc_2; eauto. omega.
(* Goal: @eq (option (list memval)) (if range_perm_dec m2 b2 (Z.add ofs delta) (Z.add (Z.add ofs delta) len) Cur Readable then @Some (list memval) (getN (nat_of_Z len) (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2))) else @None (list memval)) (@Some (list memval) (getN (nat_of_Z len) (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2)))) *)
(* Goal: @list_forall2 memval memval (memval_inject f) (getN (nat_of_Z len) ofs (@PMap.get (ZMap.t memval) b1 (mem_contents m1))) (getN (nat_of_Z len) (Z.add ofs delta) (@PMap.get (ZMap.t memval) b2 (mem_contents m2))) *)
  unfold flat_inj. apply pred_dec_true.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite (alloc_result _ _ _ _ _ H). auto.
Qed.

Theorem store_inject_neutral:
  forall chunk m b ofs v m' thr,
  store chunk m b ofs v = Some m' ->
  inject_neutral thr m ->
  Plt b thr ->
  Val.inject (flat_inj thr) v v ->
  inject_neutral thr m'.
Proof.
(* Goal: inj_offset_aligned Z0 (Z.sub hi1 lo1) *)
(* Goal: forall (ofs : Z) (k : perm_kind) (p : permission) (_ : and (Z.le lo1 ofs) (Z.lt ofs hi1)), perm m2' b (Z.add ofs Z0) k p *)
(* Goal: forall (b : block) (ofs : Z) (k : perm_kind) (p : permission) (_ : perm m2' b ofs k p), or (perm m1' b ofs k p) (not (perm m1' b ofs Max Nonempty)) *)
  intros; red.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit store_mapped_inj. eauto. eauto. apply flat_inj_no_overlap.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  unfold flat_inj. apply pred_dec_true; auto. eauto.
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  replace (ofs + 0) with ofs by omega.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  intros [m'' [A B]]. congruence.
Qed.

Theorem drop_inject_neutral:
  forall m b lo hi p m' thr,
  drop_perm m b lo hi p = Some m' ->
  inject_neutral thr m ->
  Plt b thr ->
  inject_neutral thr m'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold inject_neutral; intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit drop_mapped_inj; eauto. apply flat_inj_no_overlap.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  unfold flat_inj. apply pred_dec_true; eauto.
(* Goal: @eq block (nextblock m1) (nextblock m3) *)
(* Goal: mem_inj inject_id m1 m3 *)
(* Goal: or (perm m1 b ofs k p) (not (perm m1 b ofs Max Nonempty)) *)
  repeat rewrite Z.add_0_r. intros [m'' [A B]]. congruence.
Qed.

(** * Invariance properties between two memory states *)

Section UNCHANGED_ON.

Variable P: block -> Z -> Prop.

Record unchanged_on (m_before m_after: mem) : Prop := mk_unchanged_on {
  unchanged_on_nextblock:
    Ple (nextblock m_before) (nextblock m_after);
  unchanged_on_perm:
    forall b ofs k p,
    P b ofs -> valid_block m_before b ->
    (perm m_before b ofs k p <-> perm m_after b ofs k p);
  unchanged_on_contents:
    forall b ofs,
    P b ofs -> perm m_before b ofs Cur Readable ->
    ZMap.get ofs (PMap.get b m_after.(mem_contents)) =
    ZMap.get ofs (PMap.get b m_before.(mem_contents))
}.

Lemma unchanged_on_refl:
  forall m, unchanged_on m m.
Proof.
(* Goal: Ple (nextblock m) (nextblock m') *)
  intros; constructor. apply Ple_refl. tauto. tauto.
Qed.

Lemma valid_block_unchanged_on:
  forall m m' b,
  unchanged_on m m' -> valid_block m b -> valid_block m' b.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  unfold valid_block; intros. apply unchanged_on_nextblock in H. xomega.
Qed.

Lemma perm_unchanged_on:
  forall m m' b ofs k p,
  unchanged_on m m' -> P b ofs ->
  perm m b ofs k p -> perm m' b ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H. apply unchanged_on_perm0; auto. eapply perm_valid_block; eauto.
Qed.

Lemma perm_unchanged_on_2:
  forall m m' b ofs k p,
  unchanged_on m m' -> P b ofs -> valid_block m b ->
  perm m' b ofs k p -> perm m b ofs k p.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H. apply unchanged_on_perm0; auto.
Qed.

Lemma unchanged_on_trans:
  forall m1 m2 m3, unchanged_on m1 m2 -> unchanged_on m2 m3 -> unchanged_on m1 m3.
Proof.
(* Goal: memval_inject (flat_inj thr) Undef Undef *)
  intros; constructor.
(* Goal: Ple (nextblock m) (nextblock m') *)
- apply Ple_trans with (nextblock m2); apply unchanged_on_nextblock; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
- intros. transitivity (perm m2 b ofs k p); apply unchanged_on_perm; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply valid_block_unchanged_on; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
- intros. transitivity (ZMap.get ofs (mem_contents m2)#b); apply unchanged_on_contents; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_unchanged_on; eauto.
Qed.

Lemma loadbytes_unchanged_on_1:
  forall m m' b ofs n,
  unchanged_on m m' ->
  valid_block m b ->
  (forall i, ofs <= i < ofs + n -> P b i) ->
  loadbytes m' b ofs n = loadbytes m b ofs n.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (list memval)) (loadbytes m' b ofs n) (loadbytes m b ofs n) *)
  destruct (zle n 0).
(* Goal: Ple (nextblock m) (nextblock m') *)
+ erewrite ! loadbytes_empty by assumption. auto.
(* Goal: unchanged_on Q m m' *)
+ unfold loadbytes. destruct H.
  destruct (range_perm_dec m b ofs (ofs + n) Cur Readable).
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m))))) *)
(* Goal: @eq (option val) (if valid_access_dec m' chunk b ofs Readable then @Some val (decode_val chunk (getN (size_chunk_nat chunk) ofs (@PMap.get (ZMap.t memval) b (mem_contents m')))) else @None val) (@None val) *)
  rewrite pred_dec_true. f_equal.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  apply getN_exten. intros. rewrite nat_of_Z_eq in H by omega.
(* Goal: Ple (nextblock m) (nextblock m') *)
  apply unchanged_on_contents0; auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros. apply unchanged_on_perm0; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_false. auto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  red; intros; elim n0; red; intros. apply <- unchanged_on_perm0; auto.
Qed.

Lemma loadbytes_unchanged_on:
  forall m m' b ofs n bytes,
  unchanged_on m m' ->
  (forall i, ofs <= i < ofs + n -> P b i) ->
  loadbytes m b ofs n = Some bytes ->
  loadbytes m' b ofs n = Some bytes.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros.
(* Goal: @eq (option (list memval)) (loadbytes m' b ofs n) (loadbytes m b ofs n) *)
  destruct (zle n 0).
(* Goal: Ple (nextblock m) (nextblock m') *)
+ erewrite loadbytes_empty in * by assumption. auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
+ rewrite <- H1. apply loadbytes_unchanged_on_1; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  exploit loadbytes_range_perm; eauto. instantiate (1 := ofs). omega.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. eauto with mem.
Qed.

Lemma load_unchanged_on_1:
  forall m m' chunk b ofs,
  unchanged_on m m' ->
  valid_block m b ->
  (forall i, ofs <= i < ofs + size_chunk chunk -> P b i) ->
  load chunk m' b ofs = load chunk m b ofs.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. unfold load. destruct (valid_access_dec m chunk b ofs Readable).
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  destruct v. rewrite pred_dec_true. f_equal. f_equal. apply getN_exten. intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  rewrite <- size_chunk_conv in H4. eapply unchanged_on_contents; eauto.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  split; auto. red; intros. eapply perm_unchanged_on; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite pred_dec_false. auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  red; intros [A B]; elim n; split; auto. red; intros; eapply perm_unchanged_on_2; eauto.
Qed.

Lemma load_unchanged_on:
  forall m m' chunk b ofs v,
  unchanged_on m m' ->
  (forall i, ofs <= i < ofs + size_chunk chunk -> P b i) ->
  load chunk m b ofs = Some v ->
  load chunk m' b ofs = Some v.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. rewrite <- H1. eapply load_unchanged_on_1; eauto with mem.
Qed.

Lemma store_unchanged_on:
  forall chunk m b ofs v m',
  store chunk m b ofs v = Some m' ->
  (forall i, ofs <= i < ofs + size_chunk chunk -> ~ P b i) ->
  unchanged_on m m'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros; constructor; intros.
- rewrite (nextblock_store _ _ _ _ _ _ H). apply Ple_refl.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
- split; intros; eauto with mem.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
- erewrite store_mem_contents; eauto. rewrite PMap.gsspec.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (peq b0 b); auto. subst b0. apply setN_outside.
(* Goal: or (Z.lt ofs0 ofs) (Z.ge ofs0 (Z.add ofs (Z.of_nat (@Datatypes.length memval (encode_val chunk v))))) *)
  rewrite encode_val_length. rewrite <- size_chunk_conv.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zlt ofs0 ofs); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zlt ofs0 (ofs + size_chunk chunk)); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  elim (H0 ofs0). omega. auto.
Qed.

Lemma storebytes_unchanged_on:
  forall m b ofs bytes m',
  storebytes m b ofs bytes = Some m' ->
  (forall i, ofs <= i < ofs + Z.of_nat (length bytes) -> ~ P b i) ->
  unchanged_on m m'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros; constructor; intros.
- rewrite (nextblock_storebytes _ _ _ _ _ H). apply Ple_refl.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
- split; intros. eapply perm_storebytes_1; eauto. eapply perm_storebytes_2; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
- erewrite storebytes_mem_contents; eauto. rewrite PMap.gsspec.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (peq b0 b); auto. subst b0. apply setN_outside.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zlt ofs0 ofs); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (zlt ofs0 (ofs + Z.of_nat (length bytes))); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  elim (H0 ofs0). omega. auto.
Qed.

Lemma alloc_unchanged_on:
  forall m lo hi m' b,
  alloc m lo hi = (m', b) ->
  unchanged_on m m'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros; constructor; intros.
- rewrite (nextblock_alloc _ _ _ _ _ H). apply Ple_succ.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
- split; intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_alloc_1; eauto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_alloc_4; eauto.
(* Goal: perm m b ofs k p *)
(* Goal: forall (lo hi : Z) (_ : or (@eq (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b1 lo1) hi1) (@pair (prod block Z) Z (@pair block Z b lo) hi)) (@In (prod (prod block Z) Z) (@pair (prod block Z) Z (@pair block Z b lo) hi) l)) (_ : and (Z.le lo ofs) (Z.lt ofs hi)), False *)
  eapply valid_not_valid_diff; eauto with mem.
(* Goal: @eq memval (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents (unchecked_free m b lo hi)))) (@ZMap.get memval ofs (@PMap.get (ZMap.t memval) b0 (mem_contents m))) *)
- injection H; intros A B. rewrite <- B; simpl.
(* Goal: Ple (nextblock m) (nextblock m') *)
  rewrite PMap.gso; auto. rewrite A.  eapply valid_not_valid_diff; eauto with mem.
Qed.

Lemma free_unchanged_on:
  forall m b lo hi m',
  free m b lo hi = Some m' ->
  (forall i, lo <= i < hi -> ~ P b i) ->
  unchanged_on m m'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros; constructor; intros.
- rewrite (nextblock_free _ _ _ _ _ H). apply Ple_refl.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
- split; intros.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_free_1; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (eq_block b0 b); auto. destruct (zlt ofs lo); auto. destruct (zle hi ofs); auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  subst b0. elim (H0 ofs). omega. auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_free_3; eauto.
(* Goal: Val.inject f v1 v3 *)
- unfold free in H. destruct (range_perm_dec m b lo hi Cur Freeable); inv H.
(* Goal: Ple (nextblock m) (nextblock m') *)
  simpl. auto.
Qed.

Lemma drop_perm_unchanged_on:
  forall m b lo hi p m',
  drop_perm m b lo hi p = Some m' ->
  (forall i, lo <= i < hi -> ~ P b i) ->
  unchanged_on m m'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros; constructor; intros.
- rewrite (nextblock_drop _ _ _ _ _ _ H). apply Ple_refl.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
- split; intros. eapply perm_drop_3; eauto.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (eq_block b0 b); auto.
(* Goal: or (not (@eq block b0 b)) (or (Z.lt ofs lo) (Z.le hi ofs)) *)
(* Goal: perm m b0 ofs k p *)
  subst b0.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  assert (~ (lo <= ofs < hi)). { red; intros; eelim H0; eauto. }
(* Goal: and (Z.le lo ofs) (Z.lt ofs hi) *)
(* Goal: P b ofs *)
(* Goal: perm m b0 ofs k p *)
  right; omega.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  eapply perm_drop_4; eauto.
- unfold drop_perm in H.
(* Goal: Ple (nextblock m) (nextblock m') *)
  destruct (range_perm_dec m b lo hi Cur Freeable); inv H; simpl. auto.
Qed.

End UNCHANGED_ON.

Lemma unchanged_on_implies:
  forall (P Q: block -> Z -> Prop) m m',
  unchanged_on P m m' ->
  (forall b ofs, Q b ofs -> valid_block m b -> P b ofs) ->
  unchanged_on Q m m'.
Proof.
(* Goal: forall (P Q : forall (_ : block) (_ : Z), Prop) (m m' : mem) (_ : unchanged_on P m m') (_ : forall (b : block) (ofs : Z) (_ : Q b ofs) (_ : valid_block m b), P b ofs), unchanged_on Q m m' *)
  intros. destruct H. constructor; intros.
(* Goal: Ple (nextblock m) (nextblock m') *)
- auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
- apply unchanged_on_perm0; auto.
(* Goal: Ple (nextblock m) (nextblock m') *)
- apply unchanged_on_contents0; auto.
(* Goal: @eq (option (prod block Z)) (f b) (@None (prod block Z)) *)
(* Goal: valid_block m3 b' *)
(* Goal: meminj_no_overlap f m1 *)
(* Goal: and (Z.ge delta Z0) (and (Z.le Z0 (Z.add (Ptrofs.unsigned ofs) delta)) (Z.le (Z.add (Ptrofs.unsigned ofs) delta) Ptrofs.max_unsigned)) *)
(* Goal: or (perm m1 b1 ofs k p) (not (perm m1 b1 ofs Max Nonempty)) *)
  apply H0; auto. eapply perm_valid_block; eauto.
Qed.

End Mem.

Notation mem := Mem.mem.

Global Opaque Mem.alloc Mem.free Mem.store Mem.load Mem.storebytes Mem.loadbytes.

Hint Resolve
  Mem.valid_not_valid_diff
  Mem.perm_implies
  Mem.perm_cur
  Mem.perm_max
  Mem.perm_valid_block
  Mem.range_perm_implies
  Mem.range_perm_cur
  Mem.range_perm_max
  Mem.valid_access_implies
  Mem.valid_access_valid_block
  Mem.valid_access_perm
  Mem.valid_access_load
  Mem.load_valid_access
  Mem.loadbytes_range_perm
  Mem.valid_access_store
  Mem.perm_store_1
  Mem.perm_store_2
  Mem.nextblock_store
  Mem.store_valid_block_1
  Mem.store_valid_block_2
  Mem.store_valid_access_1
  Mem.store_valid_access_2
  Mem.store_valid_access_3
  Mem.storebytes_range_perm
  Mem.perm_storebytes_1
  Mem.perm_storebytes_2
  Mem.storebytes_valid_access_1
  Mem.storebytes_valid_access_2
  Mem.nextblock_storebytes
  Mem.storebytes_valid_block_1
  Mem.storebytes_valid_block_2
  Mem.nextblock_alloc
  Mem.alloc_result
  Mem.valid_block_alloc
  Mem.fresh_block_alloc
  Mem.valid_new_block
  Mem.perm_alloc_1
  Mem.perm_alloc_2
  Mem.perm_alloc_3
  Mem.perm_alloc_4
  Mem.perm_alloc_inv
  Mem.valid_access_alloc_other
  Mem.valid_access_alloc_same
  Mem.valid_access_alloc_inv
  Mem.range_perm_free
  Mem.free_range_perm
  Mem.nextblock_free
  Mem.valid_block_free_1
  Mem.valid_block_free_2
  Mem.perm_free_1
  Mem.perm_free_2
  Mem.perm_free_3
  Mem.valid_access_free_1
  Mem.valid_access_free_2
  Mem.valid_access_free_inv_1
  Mem.valid_access_free_inv_2
  Mem.unchanged_on_refl
: mem.
