Proof with eauto 10 with wd.
intros.
destruct i; simpl in *;
unfold goto_label in *;
repeat match goal with
| [H: match ?Expr with _ => _ end = _ |- _] =>
destruct Expr eqn:?
end; try discriminate;
try match goal with
| [H: exec_store ?G ?CHUNK ?M ?A ?RS ?RS0 _ = _ |- _] =>
unfold exec_store in H;
destruct (Mem.storev CHUNK M (eval_addrmode G A RS) (RS RS0)) eqn:?;
inv H
| [H: exec_load ?G ?CHUNK ?M ?A ?RS ?RD = _ |- _] =>
unfold exec_load in H;
destruct (Mem.loadv CHUNK M (eval_addrmode G A RS)) eqn:?;
inv H
| [H: Next _ _ = Next _ _ |- _] =>
inv H
end;
try match goal with
| [H: Mem.storev _ _ (eval_addrmode ?G ?A rs) (rs ?R) = _ |- _] =>
eapply storev_wd_domain in H; destruct H
end;
repeat match goal with
| [H: Mem.loadv _ _ (eval_addrmode ?G ?A rs) = _ |- _] =>
eapply loadv_wd in H;
eauto
| [H: Stuck = Next _ _ |- _] => discriminate
| [H: Mem.alloc _ _ _ = _ |- _ /\ _] =>
idtac
| [H: Mem.free _ _ _ _ = _ |- _] =>
eapply free_wd_domain in H; eauto;
destruct H
| [|- _ /\ _] =>
split
| [H: Mem.alloc _ _ _ = _ |- _] =>
idtac
| [|- exists _, _ /\ _] => eexists
| [|- forall _, _] => intros
end;
unfold nextinstr, nextinstr_nf;
try match goal with
| [H: domain_memren ?F ?M, H1: ren_domain_incr ?FG ?F,
H2: domain_memren ?F2 ?M |- _] =>
assert (ren_domain_incr ?FG ?F2) by
(eapply domain_memren_incr with (f'' := F2) (f' := F);
eauto)
end; unfold nextinstr, nextinstr_nf;
(* first steps are done manually to speed up eauto*)
repeat match goal with
| [|- regset_wd _ (@Pregmap.set _ _ _ _)] =>
apply regset_wd_set
| [|- valid_val _ (Val.add _ _)] =>
apply valid_val_add
| [|- valid_val _ (Val.addl _ _)] =>
apply valid_val_addl
| [|- valid_val _ (Val.offset_ptr _ _)] =>
apply valid_val_offset_ptr
| [|- regset_wd _ (undef_regs _ _)] =>
eapply regset_wd_undef
| [|- valid_val _ (@Pregmap.set _ _ _ _ _)] =>
eapply regset_wd_set
| [|- valid_val _ (undef_regs _ _ _)] =>
eapply regset_wd_undef
| [|- mem_wd.val_valid _ _] =>
eapply wd_val_valid
| [H: _ = Vptr ?B _ |- valid_val _ (Vptr ?B _)] =>
eapply valid_val_offset;
erewrite <- H; eauto with wd
end;
eauto 4 with wd.
(* Allocation case*)
assert (Hnew: Mem.valid_block m0 b)
by (eapply Mem.valid_new_block; eauto).
repeat match goal with
| [H: Mem.alloc _ _ _ = _ |- _] =>
eapply mem_valid_alloc in H; eauto;
destruct H as [? [f'' [? ?]]]
| [H1: valid_mem ?M, H: Mem.store _ ?M _ _ _ = _ |- _] =>
eapply store_wd_domain in H; eauto;
destruct H
end.
split; auto.
split. eexists; split; eauto.
intros.
assert (ren_domain_incr f f') by
(eapply domain_memren_incr with (f' := f'');
eauto).
Hint Resolve valid_val_incr regset_wd_incr : wd_alloc.
eauto 2 with wd wd_alloc.
assert (domain_memren f' m0) by
(eapply domain_memren_trans; eauto).
apply regset_wd_set.
apply valid_val_offset_ptr; eauto 2 with wd.
apply regset_wd_set; eauto with wd wd_alloc.
apply regset_wd_set.
simpl. destruct (H8 b). specialize (H9 Hnew).
destruct (f' b); try by exfalso. eauto.
eauto with wd wd_alloc.
eapply wd_val_valid; eauto with wd wd_alloc.
eapply wd_val_valid; eauto with wd wd_alloc.
(* left-overs from free case*)
eapply valid_val_domain with (f := f); eauto.
unfold Mem.loadv in *; simpl in *.
eapply valid_mem_load with (m := m); eauto.
eapply valid_val_domain with (f := f); eauto.
unfold Mem.loadv in *; simpl in *.
eapply valid_mem_load with (m := m); eauto.
eapply valid_val_domain with (f := f); eauto.
unfold Mem.loadv in *; simpl in *.
eapply valid_mem_load with (m := m); eauto.
Qed.

(* Specifications: *)
(** Well-definedness of state is retained. *)
Lemma corestep_wd:
forall the_ge (Hsafe : safe_genv the_ge) c m c' m' f fg
(Hwd: core_wd f c)
(Hmem_wd: valid_mem m)
(Hge_wd: ge_wd fg the_ge)
(Hincr: ren_domain_incr fg f)
(Hdomain: domain_memren f m)
(Hcorestep: corestep (Asm_core_sem the_ge) c m c' m'),
valid_mem m' /\
(exists f', ren_domain_incr f f' /\ domain_memren f' m') /\
forall f', domain_memren f' m' ->
core_wd f' c'.