Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; fail)).
induction a; intros; simpl; destruct k; try (apply wrong_kind_ok; simpl; congruence).
(* Eval *)
split; intros. tauto. simpl; congruence.
(* Evar *)
destruct (e!x) as [[b ty']|] eqn:?.
destruct (type_eq ty ty')...
subst. apply topred_ok; auto. apply red_var_local; auto.
destruct (Genv.find_symbol ge x) as [b|] eqn:?...
apply topred_ok; auto. apply red_var_global; auto.
(* Efield *)
destruct (is_val a) as [[v ty'] | ] eqn:?.
rewrite (is_val_inv _ _ _ Heqo).
destruct v...
destruct ty'...
(* top struct *)
destruct (ge.(genv_cenv)!i0) as [co|] eqn:?...
destruct (field_offset ge f (co_members co)) as [delta|] eqn:?...
apply topred_ok; auto. eapply red_field_struct; eauto.
(* top union *)
destruct (ge.(genv_cenv)!i0) as [co|] eqn:?...
apply topred_ok; auto. eapply red_field_union; eauto.
(* in depth *)
eapply incontext_ok; eauto.
(* Evalof *)
destruct (is_loc a) as [[[b ofs] ty'] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ Heqo).
(* top *)
destruct (type_eq ty ty')... subst ty'.
destruct (do_deref_loc w ty m b ofs) as [[[w' t] v] | ] eqn:?.
exploit do_deref_loc_sound; eauto. intros [A B].
apply topred_ok; auto. red. split. apply red_rvalof; auto. exists w'; auto.
apply not_invert_ok; simpl; intros; myinv. exploit do_deref_loc_complete; eauto. congruence.
(* depth *)
eapply incontext_ok; eauto.
(* Ederef *)
destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo).
(* top *)
destruct v... apply topred_ok; auto. apply red_deref; auto.
(* depth *)
eapply incontext_ok; eauto.
(* Eaddrof *)
destruct (is_loc a) as [[[b ofs] ty'] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ Heqo).
(* top *)
apply topred_ok; auto. split. apply red_addrof; auto. exists w; constructor.
(* depth *)
eapply incontext_ok; eauto.
(* unop *)
destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo).
(* top *)
destruct (sem_unary_operation op v ty' m) as [v'|] eqn:?...
apply topred_ok; auto. split. apply red_unop; auto. exists w; constructor.
(* depth *)
eapply incontext_ok; eauto.
(* binop *)
destruct (is_val a1) as [[v1 ty1] | ] eqn:?.
destruct (is_val a2) as [[v2 ty2] | ] eqn:?.
rewrite (is_val_inv _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0).
(* top *)
destruct (sem_binary_operation ge op v1 ty1 v2 ty2 m) as [v|] eqn:?...
apply topred_ok; auto. split. apply red_binop; auto. exists w; constructor.
(* depth *)
eapply incontext2_ok; eauto.
eapply incontext2_ok; eauto.
(* cast *)
destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo).
(* top *)
destruct (sem_cast v ty' ty m) as [v'|] eqn:?...
apply topred_ok; auto. split. apply red_cast; auto. exists w; constructor.
(* depth *)
eapply incontext_ok; eauto.
(* seqand *)
destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo).
(* top *)
destruct (bool_val v ty' m) as [v'|] eqn:?... destruct v'.
apply topred_ok; auto. split. eapply red_seqand_true; eauto. exists w; constructor.
apply topred_ok; auto. split. eapply red_seqand_false; eauto. exists w; constructor.
(* depth *)
eapply incontext_ok; eauto.
(* seqor *)
destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo).
(* top *)
destruct (bool_val v ty' m) as [v'|] eqn:?... destruct v'.
apply topred_ok; auto. split. eapply red_seqor_true; eauto. exists w; constructor.
apply topred_ok; auto. split. eapply red_seqor_false; eauto. exists w; constructor.
(* depth *)
eapply incontext_ok; eauto.
(* condition *)
destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo).
(* top *)
destruct (bool_val v ty' m) as [v'|] eqn:?...
apply topred_ok; auto. split. eapply red_condition; eauto. exists w; constructor.
(* depth *)
eapply incontext_ok; eauto.
(* sizeof *)
apply topred_ok; auto. split. apply red_sizeof. exists w; constructor.
(* alignof *)
apply topred_ok; auto. split. apply red_alignof. exists w; constructor.
(* assign *)
destruct (is_loc a1) as [[[b ofs] ty1] | ] eqn:?.
destruct (is_val a2) as [[v2 ty2] | ] eqn:?.
rewrite (is_loc_inv _ _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0).
(* top *)
destruct (type_eq ty1 ty)... subst ty1.
destruct (sem_cast v2 ty2 ty m) as [v|] eqn:?...
destruct (do_assign_loc w ty m b ofs v) as [[[w' t] m']|] eqn:?.
exploit do_assign_loc_sound; eauto. intros [P Q].
apply topred_ok; auto. split. apply red_assign; auto. exists w'; auto.
apply not_invert_ok; simpl; intros; myinv. exploit do_assign_loc_complete; eauto. congruence.
(* depth *)
eapply incontext2_ok; eauto.
eapply incontext2_ok; eauto.
(* assignop *)
destruct (is_loc a1) as [[[b ofs] ty1] | ] eqn:?.
destruct (is_val a2) as [[v2 ty2] | ] eqn:?.
rewrite (is_loc_inv _ _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0).
(* top *)
destruct (type_eq ty1 ty)... subst ty1.
destruct (do_deref_loc w ty m b ofs) as [[[w' t] v] | ] eqn:?.
exploit do_deref_loc_sound; eauto. intros [A B].
apply topred_ok; auto. red. split. apply red_assignop; auto. exists w'; auto.
apply not_invert_ok; simpl; intros; myinv. exploit do_deref_loc_complete; eauto. congruence.
(* depth *)
eapply incontext2_ok; eauto.
eapply incontext2_ok; eauto.
(* postincr *)
destruct (is_loc a) as [[[b ofs] ty'] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ Heqo).
(* top *)
destruct (type_eq ty' ty)... subst ty'.
destruct (do_deref_loc w ty m b ofs) as [[[w' t] v] | ] eqn:?.
exploit do_deref_loc_sound; eauto. intros [A B].
apply topred_ok; auto. red. split. apply red_postincr; auto. exists w'; auto.
apply not_invert_ok; simpl; intros; myinv. exploit do_deref_loc_complete; eauto. congruence.
(* depth *)
eapply incontext_ok; eauto.
(* comma *)
destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo).
(* top *)
destruct (type_eq (typeof a2) ty)... subst ty.
apply topred_ok; auto. split. apply red_comma; auto. exists w; constructor.
(* depth *)
eapply incontext_ok; eauto.
(* call *)
destruct (is_val a) as [[vf tyf] | ] eqn:?.
destruct (is_val_list rargs) as [vtl | ] eqn:?.
rewrite (is_val_inv _ _ _ Heqo). exploit is_val_list_all_values; eauto. intros ALLVAL.
(* top *)
destruct (classify_fun tyf) as [tyargs tyres cconv|] eqn:?...
destruct (Genv.find_funct ge vf) as [fd|] eqn:?...
destruct (sem_cast_arguments vtl tyargs m) as [vargs|] eqn:?...
destruct (type_eq (type_of_fundef fd) (Tfunction tyargs tyres cconv))...
apply topred_ok; auto. red. split; auto. eapply red_call; eauto.
eapply sem_cast_arguments_sound; eauto.
apply not_invert_ok; simpl; intros; myinv. specialize (H ALLVAL). myinv. congruence.
apply not_invert_ok; simpl; intros; myinv. specialize (H ALLVAL). myinv.
exploit sem_cast_arguments_complete; eauto. intros [vtl' [P Q]]. congruence.
apply not_invert_ok; simpl; intros; myinv. specialize (H ALLVAL). myinv. congruence.
apply not_invert_ok; simpl; intros; myinv. specialize (H ALLVAL). myinv. congruence.
(* depth *)
eapply incontext2_list_ok; eauto.
eapply incontext2_list_ok; eauto.
(* builtin *)
destruct (is_val_list rargs) as [vtl | ] eqn:?.
exploit is_val_list_all_values; eauto. intros ALLVAL.
(* top *)
destruct (sem_cast_arguments vtl tyargs m) as [vargs|] eqn:?...
destruct (do_external ef w vargs m) as [[[[? ?] v] m'] | ] eqn:?...
exploit do_ef_external_sound; eauto. intros [EC PT].
apply topred_ok; auto. red. split; auto. eapply red_builtin; eauto.
eapply sem_cast_arguments_sound; eauto.
exists w0; auto.
apply not_invert_ok; simpl; intros; myinv. specialize (H ALLVAL). myinv.
assert (x = vargs).
exploit sem_cast_arguments_complete; eauto. intros [vtl' [A B]]. congruence.
subst x. exploit do_ef_external_complete; eauto. congruence.
apply not_invert_ok; simpl; intros; myinv. specialize (H ALLVAL). myinv.
exploit sem_cast_arguments_complete; eauto. intros [vtl' [A B]]. congruence.
(* depth *)
eapply incontext_list_ok; eauto.
(* loc *)
split; intros. tauto. simpl; congruence.
(* paren *)
destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo).
(* top *)
destruct (sem_cast v ty' tycast m) as [v'|] eqn:?...
apply topred_ok; auto. split. apply red_paren; auto. exists w; constructor.
(* depth *)
eapply incontext_ok; eauto.
induction al; simpl; intros.
(* nil *)
split; intros. tauto. simpl; congruence.
(* cons *)
eapply incontext2_list_ok'; eauto.
Qed.

(* Specifications: *)
Lemma step_exprlist_val_list:
forall m al, is_val_list al <> None -> step_exprlist al m = nil.