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.
Definition lvalue_LR_of_type: forall Delta rho P p t e,
t = typeof e ->
tc_environ Delta rho ->
P |-- !! (p = eval_lvalue e rho) && tc_lvalue Delta e rho ->
P |-- !! (p = eval_LR e (LR_of_type t) rho) && tc_LR_strong Delta e (LR_of_type t) rho.
Fixpoint compute_nested_efield_rec {cs:compspecs} e lr_default :=
match e with
| Efield e' id t =>
match typeof e' with
| Tstruct id_str _ =>
if eqb_type (field_type id (co_members (get_co id_str))) t
then match compute_nested_efield_rec e' LLLL with
| (e'', efs, lr) => (e'', eStructField id :: efs, lr)
end
else (e, nil, lr_default)
| Tunion id_uni _ =>
if eqb_type (field_type id (co_members (get_co id_uni))) t
then match compute_nested_efield_rec e' LLLL with
| (e'', efs, lr) => (e'', eUnionField id :: efs, lr)
end
else (e, nil, lr_default)
| _ => (e, nil, lr_default)
end
| Ederef (Ebinop Cop.Oadd e' ei (Tpointer t a)) t' =>
match typeof e' with
| Tarray t'' _ _ =>
match eqb_type t t'', eqb_type t t', eqb_attr a noattr with
| true, true, true =>
match compute_nested_efield_rec e' RRRR with
| (e'', efs, lr) => (e'', eArraySubsc ei :: efs, lr)
end
| _, _, _ => (e, nil, lr_default)
end
| Tpointer t'' _ =>
match eqb_type t t'', eqb_type t t', eqb_attr a noattr, eqb_type (typeof e') int_or_ptr_type with
| true, true, true, false => (e', eArraySubsc ei :: nil, RRRR)
| _, _, _, _ => (e, nil, lr_default)
end
| _ => (e, nil, lr_default)
end
| _ => (e, nil, lr_default)
end.
Definition compute_nested_efield {cs: compspecs} (e: expr): expr * list efield * LLRR := compute_nested_efield_rec e LLLL.
Inductive compute_root_type: forall (t_from_e: type) (lr: LLRR) (t_root: type), Prop :=
| compute_root_type_lvalue: forall t, compute_root_type t LLLL t
| compute_root_type_Tpointer_expr: forall t a1 n a2, compute_root_type (Tpointer t a1) RRRR (Tarray t n a2)
| compute_root_type_Tarray_expr: forall t n1 a1 n2 a2, compute_root_type (Tarray t n1 a1) RRRR (Tarray t n2 a2).
(* which means (e, lr) is possible to be called by compute_nested_efield_rec *)
Definition LR_possible (e: expr) (lr: LLRR) : bool :=
match lr with
| LLLL => match (typeof e) with
| Tarray _ _ _ => false
| _ => true
end
| RRRR => match (typeof e) with
| Tarray _ _ _ => true
| _ => false
end
end.
Definition array_relexed_type_eq (t1 t2: type): Prop :=
match t1, t2 with
| Tarray t1' _ _, Tarray t2' _ _ => t1' = t2'
| _, _ => t1 = t2
end.

Lemma compute_nested_efield_trivial: forall e rho lr_default,
forall e_root efs lr,
e_root = e -> efs = nil -> lr = lr_default ->
LR_possible e lr_default = true ->
forall t_root gfs,
exists tts,
compute_root_type (typeof e_root) lr t_root ->
efield_denote efs gfs rho ->
nested_efield e_root efs tts = e /\
LR_of_type t_root = lr /\
type_almost_match e_root t_root lr = true /\
legal_nested_efield_rec t_root gfs tts = true /\
match gfs with
| nil => array_relexed_type_eq t_root (typeof e)
| _ => nested_field_type t_root gfs = typeof e
end.