Local Open Scope logic.
Inductive efield : Type :=
| eArraySubsc: forall i: expr, efield
| eStructField: forall i: ident, efield
| eUnionField: forall i: ident, efield.
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.

Lemma typeof_nested_efield': forall rho t_root e ef efs gf gfs t tts,
legal_nested_efield_rec t_root (gf :: gfs) (t :: tts) = true ->
efield_denote (ef :: efs) (gf :: gfs) rho ->
nested_field_type t_root (gf :: gfs) = typeof (nested_efield e (ef :: efs) (t :: tts)).