Section CENV.
Context {cs: compspecs}.
Fixpoint nested_efield (e: expr) (efs: list efield) (tts: list type) : expr :=
match efs, tts with
| nil, _ => e
| _, nil => e
| cons ef efs', cons t0 tts' =>
match ef with
| eArraySubsc ei => Ederef (Ebinop Cop.Oadd (nested_efield e efs' tts') ei (tptr t0)) t0
| eStructField i => Efield (nested_efield e efs' tts') i t0
| eUnionField i => Efield (nested_efield e efs' tts') i t0
end
end.
Inductive array_subsc_denote {cs: compspecs}: expr -> Z -> environ -> Prop :=
| array_subsc_denote_intro_int:
forall e i rho, Vint (Int.repr i) = eval_expr e rho -> array_subsc_denote e i rho
| array_subsc_denote_intro_long:
forall e i rho, Vlong (Int64.repr i) = eval_expr e rho -> array_subsc_denote e i rho.
Inductive efield_denote {cs: compspecs}: list efield -> list gfield -> environ -> Prop :=
| efield_denote_nil: forall rho, efield_denote nil nil rho
| efield_denote_ArraySubsc_int: forall ei efs i gfs rho,
match typeconv (typeof ei) with
| Tint _ Signed _ => Int.min_signed <= i <= Int.max_signed
| Tint _ Unsigned _ => 0 <= i <= Int.max_unsigned
| _ => False
end ->
array_subsc_denote ei i rho ->
efield_denote efs gfs rho ->
efield_denote (eArraySubsc ei :: efs) (ArraySubsc i :: gfs) rho
| efield_denote_ArraySubsc: forall ei efs i gfs rho,
is_ptrofs_type (typeof ei) = true ->
array_subsc_denote ei i rho ->
efield_denote efs gfs rho ->
efield_denote (eArraySubsc ei :: efs) (ArraySubsc i :: gfs) rho
| efield_denote_StructField: forall i efs gfs rho,
efield_denote efs gfs rho ->
efield_denote (eStructField i :: efs) (StructField i :: gfs) rho
| efield_denote_UnionField: forall i efs gfs rho,
efield_denote efs gfs rho ->
efield_denote (eUnionField i :: efs) (UnionField i :: gfs) rho.
Fixpoint typecheck_efield {cs: compspecs} (Delta: tycontext) (efs: list efield) : tc_assert :=
match efs with
| nil => tc_TT
| eArraySubsc ei :: efs' =>
tc_andp (typecheck_expr Delta ei) (typecheck_efield Delta efs')
| eStructField i :: efs' =>
typecheck_efield Delta efs'
| eUnionField i :: efs' =>
typecheck_efield Delta efs'
end.
Definition tc_efield {cs: compspecs} (Delta: tycontext) (efs: list efield) : environ -> mpred := denote_tc_assert (typecheck_efield Delta efs).
Definition typeconv' (ty: type): type :=
match ty with
| Tvoid => remove_attributes ty
| Tint I8 _ _ => Tint I32 Signed noattr
| Tint I16 _ _ => Tint I32 Signed noattr
| Tint I32 _ _ => remove_attributes ty
| Tint IBool _ _ => Tint I32 Signed noattr
| Tlong _ _ => remove_attributes ty
| Tfloat _ _ => remove_attributes ty
| Tpointer _ _ => if eqb_type ty int_or_ptr_type then ty else remove_attributes ty
| Tarray t _ _ => Tpointer t noattr
| Tfunction _ _ _ => Tpointer ty noattr
| Tstruct _ _ => remove_attributes ty
| Tunion _ _ => remove_attributes ty
end.
(* Null Empty Path situation *)
Definition type_almost_match e t lr:=
match typeof e, t, lr with
| _, Tarray t1 _ a1, RRRR => eqb_type (typeconv' (typeof e)) (Tpointer t1 noattr)
| _, _, LLLL => eqb_type (typeof e) t
| _, _, _ => false
end.
(* TODO: remove almost_match' and use "type_is_by_value" in proof for assistent. *)
(* Empty Path situation *)
Definition type_almost_match' e t lr:=
match typeof e, t, lr with
| _, _, LLLL => eqb_type (typeof e) t
| _, _, _ => false
end.
Fixpoint legal_nested_efield_rec t_root (gfs: list gfield) (tts: list type): bool :=
match gfs, tts with
| nil, nil => true
| nil, _ => false
| _ , nil => false
| gf :: gfs0, t0 :: tts0 => (legal_nested_efield_rec t_root gfs0 tts0 && eqb_type (nested_field_type t_root gfs) t0)%bool
end.
Definition legal_nested_efield t_root e gfs tts lr :=
(match gfs with
| nil => type_almost_match' e t_root lr
| _ => type_almost_match e t_root lr
end &&
legal_nested_efield_rec t_root gfs tts)%bool.
Definition LR_of_type (t: type) :=
match t with
| Tarray _ _ _ => RRRR
| _ => LLLL
end.
(* Lemma classify_add_add_case_pi: forall ei ty t n a si, match typeof ei with Tint _ si' _ => si=si' | _ => False end -> typeconv (Tarray t n a) = typeconv ty -> Cop.classify_add ty (typeof ei) = Cop.add_case_pi t si. *)
Definition add_case_pptrofs t si :=
if Archi.ptr64 then Cop.add_case_pl t else Cop.add_case_pi t si.
(* Lemma Archi_ptr64_DEPENDENCY: Archi.ptr64=false.  Lemma sem_add_pi_ptr_special: forall t p i si, complete_type cenv_cs t = true -> isptr p -> match si with | Signed => Int.min_signed <= i <= Int.max_signed | Unsigned => 0 <= i <= Int.max_unsigned end -> sem_add_ptr_int t si p (Vint (Int.repr i)) = Some (offset_val (sizeof t * i) p).  Lemma sem_add_pi_ptr_special': Archi.ptr64 = false -> forall t p i si, complete_type cenv_cs t = true -> isptr p -> sem_add_ptr_int t si p (Vint (Int.repr i)) = Some (offset_val (sizeof t * i) p).  Lemma sem_add_pl_ptr_special': Archi.ptr64 = true -> forall t p i, complete_type cenv_cs t = true -> isptr p -> sem_add_ptr_long t p (Vlong (Int64.repr i)) = Some (offset_val (sizeof t * i) p).  Lemma array_ind_step_ptrofs: forall Delta ei i rho t_root e efs gfs tts t n a t0 p, legal_nested_efield_rec t_root gfs tts = true -> type_almost_match e t_root (LR_of_type t_root) = true -> is_ptrofs_type (typeof ei) = true -> array_subsc_denote ei i rho -> nested_field_type t_root gfs = Tarray t0 n a -> tc_environ Delta rho -> efield_denote efs gfs rho -> field_compatible t_root gfs p -> tc_LR_strong Delta e (LR_of_type t_root) rho && tc_efield Delta efs rho |-- !! (field_address t_root gfs p = eval_LR (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho) && tc_LR_strong Delta (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho -> tc_LR_strong Delta e (LR_of_type t_root) rho && tc_efield Delta (eArraySubsc ei :: efs) rho |-- !! (offset_val (gfield_offset (nested_field_type t_root gfs) (ArraySubsc i)) (field_address t_root gfs p) = eval_lvalue (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho) && tc_lvalue Delta (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho.  Lemma array_ind_step: forall Delta ei i rho t_root e efs gfs tts t n a t0 p, legal_nested_efield_rec t_root gfs tts = true -> type_almost_match e t_root (LR_of_type t_root) = true -> (*  is_int_type (typeof ei) = true -> *)
match typeconv (typeof ei) with
| Tint _ Signed _ => Int.min_signed <= i <= Int.max_signed
| Tint _ Unsigned _ => 0 <= i <= Int.max_unsigned
| _ => False
end ->
array_subsc_denote ei i rho ->
nested_field_type t_root gfs = Tarray t0 n a ->
tc_environ Delta rho ->
efield_denote efs gfs rho ->
field_compatible t_root gfs p ->
tc_LR_strong Delta e (LR_of_type t_root) rho && tc_efield Delta efs rho
|-- !! (field_address t_root gfs p = eval_LR (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho) &&
tc_LR_strong Delta (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho ->
tc_LR_strong Delta e (LR_of_type t_root) rho &&
tc_efield Delta (eArraySubsc ei :: efs) rho
|-- !! (offset_val (gfield_offset (nested_field_type t_root gfs) (ArraySubsc i))
(field_address t_root gfs p) =
eval_lvalue (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho) &&
tc_lvalue Delta (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho.

Lemma union_ind_step: forall Delta t_root e gfs efs tts i a i0 t rho p,
legal_nested_efield_rec t_root gfs tts = true ->
type_almost_match e t_root (LR_of_type t_root) = true ->
in_members i (co_members (get_co i0)) ->
nested_field_type t_root gfs = Tunion i0 a ->
tc_environ Delta rho ->
efield_denote efs gfs rho ->
field_compatible t_root gfs p ->
tc_LR_strong Delta e (LR_of_type t_root) rho && tc_efield Delta efs rho
|-- !! (field_address t_root gfs (eval_LR e (LR_of_type t_root) rho) =
eval_LR (nested_efield e efs tts) (LR_of_type (Tstruct i0 a)) rho) &&
tc_LR_strong Delta (nested_efield e efs tts) (LR_of_type (Tstruct i0 a)) rho ->
tc_LR_strong Delta e (LR_of_type t_root) rho &&
tc_efield Delta (eUnionField i :: efs) rho
|-- !! (offset_val (gfield_offset (nested_field_type t_root gfs) (UnionField i))
(field_address t_root gfs (eval_LR e (LR_of_type t_root) rho)) =
eval_lvalue (nested_efield e (eUnionField i :: efs) (t :: tts)) rho) &&
tc_lvalue Delta (nested_efield e (eUnionField i :: efs) (t :: tts)) rho.