Proof with (auto using provenance_monotone with va).
intros chunk x y V; unfold vnormalize; generalize Archi.ptr64; intro ptr64; inversion V; subst; destruct chunk eqn:C; simpl...
- destruct (zlt n 8); constructor...
apply is_sign_ext_uns...
apply is_sign_ext_sgn...
- constructor... apply is_zero_ext_uns... apply Z.min_case...
- destruct (zlt n 16); constructor...
apply is_sign_ext_uns...
apply is_sign_ext_sgn...
- constructor... apply is_zero_ext_uns... apply Z.min_case...
- unfold provenance; destruct (va_strict tt)...
- destruct (zlt n1 8). rewrite zlt_true by omega...
destruct (zlt n2 8)...
- destruct (zlt n1 16). rewrite zlt_true by omega...
destruct (zlt n2 16)...
- constructor... apply is_sign_ext_sgn... apply Z.min_case...
- constructor... apply is_zero_ext_uns...
- constructor... apply is_sign_ext_sgn... apply Z.min_case...
- constructor... apply is_zero_ext_uns...
- unfold provenance; destruct (va_strict tt)...
- destruct (zlt n2 8); constructor...
- destruct (zlt n2 16); constructor...
- destruct ptr64...
- destruct ptr64...
- destruct ptr64...
- destruct ptr64...
- destruct ptr64...
- destruct ptr64...
- constructor... apply is_sign_ext_sgn...
- constructor... apply is_zero_ext_uns...
- constructor... apply is_sign_ext_sgn...
- constructor... apply is_zero_ext_uns...
- unfold provenance; destruct (va_strict tt)...
- unfold provenance; destruct (va_strict tt)...
- unfold provenance; destruct (va_strict tt)...
- unfold provenance; destruct (va_strict tt)...
- unfold provenance; destruct (va_strict tt)...
- unfold provenance; destruct (va_strict tt)...
- unfold provenance; destruct (va_strict tt)...
- unfold provenance; destruct (va_strict tt)...
- destruct (zlt n 8)...
- destruct (zlt n 16)...
Qed.
(** Abstracting memory blocks *)
Inductive acontent : Type :=
| ACval (chunk: memory_chunk) (av: aval).
Definition eq_acontent : forall (c1 c2: acontent), {c1=c2} + {c1<>c2}.
Definition inval_if (hi: Z) (lo: Z) (c: ZTree.t acontent) :=
match c##lo with
| None => c
| Some (ACval chunk av) => if zle (lo + size_chunk chunk) hi then c else ZTree.remove lo c
end.
Function inval_before (hi: Z) (lo: Z) (c: ZTree.t acontent) { wf (Zwf_up hi) lo } : ZTree.t acontent :=
if zlt lo hi
then inval_before hi (lo + 1) (inval_if hi lo c)
else c.
Definition ablock_store (chunk: memory_chunk) (ab: ablock) (i: Z) (av: aval) : ablock :=
{| ab_contents :=
ZTree.set i (ACval chunk av)
(inval_before i (i - 7)
(inval_after (i + 1) (i + size_chunk chunk - 1) ab.(ab_contents)));
ab_summary :=
vplub av ab.(ab_summary) |}.
Definition ablock_store_anywhere (chunk: memory_chunk) (ab: ablock) (av: aval) : ablock :=
ablock_init (vplub av ab.(ab_summary)).
Definition ablock_loadbytes (ab: ablock) : aptr := ab.(ab_summary).
Definition ablock_storebytes (ab: ablock) (p: aptr) (ofs: Z) (sz: Z) :=
{| ab_contents :=
inval_before ofs (ofs - 7)
(inval_after ofs (ofs + sz - 1) ab.(ab_contents));
ab_summary :=
plub p ab.(ab_summary) |}.
Definition ablock_storebytes_anywhere (ab: ablock) (p: aptr) :=
ablock_init (plub p ab.(ab_summary)).
Definition smatch (m: mem) (b: block) (p: aptr) : Prop :=
(forall chunk ofs v, Mem.load chunk m b ofs = Some v -> vmatch v (Ifptr p))
/\(forall ofs b' ofs' q i, Mem.loadbytes m b ofs 1 = Some (Fragment (Vptr b' ofs') q i :: nil) -> pmatch b' ofs' p).
Remark loadbytes_load_ext:
forall b m m',
(forall ofs n bytes, Mem.loadbytes m' b ofs n = Some bytes -> n >= 0 -> Mem.loadbytes m b ofs n = Some bytes) ->
forall chunk ofs v, Mem.load chunk m' b ofs = Some v -> Mem.load chunk m b ofs = Some v.

Lemma store_provenance:
forall chunk m b ofs v m' b' ofs' b'' ofs'' q i,
Mem.store chunk m b ofs v = Some m' ->
Mem.loadbytes m' b' ofs' 1 = Some (Fragment (Vptr b'' ofs'') q i :: nil) ->
v = Vptr b'' ofs'' /\ (chunk = Mint32 \/ chunk = Many32 \/ chunk = Mint64 \/ chunk = Many64)
\/ Mem.loadbytes m b' ofs' 1 = Some (Fragment (Vptr b'' ofs'') q i :: nil).