Section COMPOSITE_ENV.
Context {cs: compspecs}.
Definition gfield_type t gf :=
match t, gf with
| Tarray t0 _ _, ArraySubsc _ => t0
| Tstruct id _, StructField i
| Tunion id _, UnionField i => field_type i (co_members (get_co id))
| _, _ => Tvoid
end.
Definition gfield_offset t gf :=
match t, gf with
| Tarray t0 _ _, ArraySubsc i => sizeof t0 * i
| Tstruct id _, StructField i => field_offset cenv_cs i (co_members (get_co id))
| Tunion id _, UnionField i => 0
| _, _ => 0
end.
Definition no_alignas_attr (a: attr): attr := mk_attr (attr_volatile a) None.
Definition gfield_array_type t lo hi :=
match t with
| Tarray t0 _ a => Tarray t0 (hi - lo) (no_alignas_attr a)
| _ => Tarray Tvoid (hi - lo) (no_alignas_attr (attr_of_type t))
end.
Fixpoint nested_field_rec (t: type) (gfs: list gfield) : option (prod Z type) :=
match gfs with
| nil => Some (0, t)
| hd :: tl =>
match nested_field_rec t tl with
| Some (pos, t') =>
match t', hd with
| Tarray t'' n _, ArraySubsc i => Some(pos + sizeof t'' * i, t'')
| Tstruct id _, StructField i =>
let m := co_members (get_co id) in
if compute_in_members i m then
Some (pos + field_offset cenv_cs i m, field_type i m)
else
None
| Tunion id _, UnionField i =>
let m := co_members (get_co id) in
if compute_in_members i m then
Some (pos, field_type i m)
else
None
| _, _ => None
end
| None => None
end
end%Z.
(* Fixpoint nested_field_rec (t: type) (gfs: list gfield) : option (prod Z type) := match gfs with | nil => Some (0, t) | hd :: tl => match nested_field_rec t tl with | Some (pos, t') => match t', hd with | Tarray t'' n _, ArraySubsc i => Some(pos + sizeof t'' * i, t'') | Tstruct id _, StructField i => if compute_in_members i (co_members (get_co id)) then Some (pos + field_offset cenv_cs i (co_members (get_co id)), field_type i (co_members (get_co id))) else None | Tunion id _, UnionField i => if compute_in_members i (co_members (get_co id)) then Some (pos, field_type i (co_members (get_co id))) else None | _, _ => None end | None => None end end. *)
Definition nested_field_offset (t: type) (gfs: list gfield) : Z :=
match nested_field_rec t gfs with
| Some (pos, _) => pos
| _ => 0
end.
Definition nested_field_type (t: type) (gfs: list gfield) : type :=
match nested_field_rec t gfs with
| Some (_, t0) => t0
| _ => Tvoid
end.
Definition nested_field_array_type t gfs lo hi :=
Tarray (nested_field_type t (ArraySubsc 0 :: gfs)) (hi - lo) (no_alignas_attr (attr_of_type (nested_field_type t gfs))).
Definition legal_field t gf :=
match t, gf with
| Tarray _ n _, ArraySubsc i => 0 <= i < n
| Tstruct id _, StructField i => in_members i (co_members (get_co id))
| Tunion id _, UnionField i => in_members i (co_members (get_co id))
| _, _ => False
end.
Definition legal_field0 t gf :=
match t, gf with
| Tarray _ n _, ArraySubsc i => 0 <= i <= n
| Tstruct id _, StructField i => in_members i (co_members (get_co id))
| Tunion id _, UnionField i => in_members i (co_members (get_co id))
| _, _ => False
end.
Fixpoint legal_nested_field (t: type) (gfs: list gfield) : Prop :=
match gfs with
| nil => True
| gf :: gfs0 => legal_nested_field t gfs0 /\ legal_field (nested_field_type t gfs0) gf
end.
Definition legal_nested_field0 t gfs :=
match gfs with
| nil => True
| gf :: gfs0 => legal_nested_field t gfs0 /\ legal_field0 (nested_field_type t gfs0) gf
end.
Fixpoint compute_legal_nested_field (t: type) (gfs: list gfield) : list Prop :=
match gfs with
| nil => nil
| gf :: gfs0 =>
match (nested_field_type t gfs0), gf with
| Tarray _ n _, ArraySubsc i =>
(0 <= i < n) :: compute_legal_nested_field t gfs0
| Tstruct id _, StructField i =>
if compute_in_members i (co_members (get_co id)) then compute_legal_nested_field t gfs0 else False :: nil
| Tunion id _, UnionField i =>
if compute_in_members i (co_members (get_co id)) then compute_legal_nested_field t gfs0 else False :: nil
| _, _ => False :: nil
end
end.
Ltac valid_nested_field_rec f a T :=
let H := fresh "H" in
let t := fresh "t" in
let ofs := fresh "ofs" in
simpl in T; destruct (nested_field_rec f a) as [[ofs t]|] eqn:H; [|inversion T].
Ltac auto_destruct_above_line :=
repeat (
let H1 := fresh "H" in
let H2 := fresh "H" in
let x := fresh "x" in
match goal with
| H: _ /\ _ |- _ => destruct H as [H1 H2]
| H: prod _ _ |- _ => destruct H as [H1 H2]
| H: @ex _ _ |- _ => destruct H as [x H1]
| H: sigT _ |- _ => destruct H as [x H1]
end).
(* Lemma legal_nested_field_nested_field_rec_None_conflict: forall t gfs P, legal_nested_field t gfs -> nested_field_rec t gfs = None -> P.  Lemma nested_field_rec_cons_eq_Some_lemma: forall t gf gfs ofs0 t0, nested_field_rec t (gf :: gfs) = Some (ofs0, t0) <-> match gf, nested_field_rec t gfs with | ArraySubsc i0, Some (ofs, Tarray t1 n a) => ofs0 = ofs + sizeof t0 * i0 /\ t0 = t1 | StructField i, Some (ofs, Tstruct id a) => in_members i (co_members (get_co id)) /\ co_su (get_co id) = Struct /\ t0 = field_type2 i (co_members (get_co id)) /\ ofs0 = ofs + field_offset2 cenv_cs i (co_members (get_co id)) | UnionField i, Some (ofs, Tunion id a) => in_members i (co_members (get_co id)) /\ co_su (get_co id) = Union /\ t0 = field_type2 i (co_members (get_co id)) /\ ofs0 = ofs | _, _ => False end.  Ltac solve_legal_nested_field_cons H := let HH := fresh "HH" in let Heq := fresh "Heq" in let HeqNFT := fresh "Heq" in let H1 := fresh "H" in let H2 := fresh "H" in let H3 := fresh "H" in let id := fresh "id" in let co := fresh "co" in let CO := fresh "CO" in match type of H with | (legal_nested_field ?T (?A :: ?GFS)) => destruct (legal_nested_field_cons_lemma T A GFS) as [HH _]; specialize (HH H); destruct A eqn:Heq; destruct (nested_field_type2 T GFS) as [ | | | | | | | id ? | id ? ] eqn:HeqNFT; try solve [destruct HH as [_ HH]; inversion HH] end; [try solve [inversion Heq]; destruct HH as [H1 H2] |try solve [inversion Heq]; destruct HH as [H1 H2]; destruct (cenv_cs ! id) as [co |] eqn:CO; [| inversion H2]; destruct H2 as [H2 H3] |try solve [inversion Heq]; destruct HH as [H1 H2]; destruct (cenv_cs ! id) as [co |] eqn:CO; [| inversion H2]; destruct H2 as [H2 H3]].  Ltac solve_nested_field_rec_cons_eq_Some H := let HH := fresh "HH" in let HeqA := fresh "Heq" in let HeqNFT := fresh "Heq" in let H1 := fresh "H" in let H2 := fresh "H" in let H3 := fresh "H" in let H4 := fresh "H" in let ofs := fresh "ofs" in let id := fresh "id" in let co := fresh "co" in let CO := fresh "CO" in match type of H with | (nested_field_rec ?T (?A :: ?GFS) = Some (?OFS, ?T0)) => destruct (nested_field_rec_cons_eq_Some_lemma T A GFS OFS T0) as [HH _]; specialize (HH H); destruct A eqn:HeqA; destruct (nested_field_rec T GFS) as [[ofs [ | | | | | | | id ? | id ? ]]|] eqn:HeqNFT; try solve [inversion HH] end; [try solve [inversion HeqA]; destruct HH as [H1 H2] |try solve [inversion HeqA]; destruct (cenv_cs ! id) as [co |] eqn:CO; [| inversion HH]; destruct HH as [H1 [H2 [H3 H4]]] |try solve [inversion HeqA]; destruct (cenv_cs ! id) as [co |] eqn:CO; [| inversion HH]; destruct HH as [H1 [H2 [H3 H4]]]].  Ltac solve_legal_nested_field := first [ solve [apply legal_nested_field_nil_lemma] | apply legal_nested_field_cons_lemma; simpl; split; [solve_legal_nested_field | auto]].  Global Opaque legal_nested_field. *)
Definition legal_nested_field_dec: forall t gfs,
{legal_nested_field t gfs} + {~ legal_nested_field t gfs}.
Definition legal_nested_field0_dec: forall t gfs,
{legal_nested_field0 t gfs} + {~ legal_nested_field0 t gfs}.
Definition field_compatible t gfs p :=
isptr p /\
complete_legal_cosu_type t = true /\
size_compatible t p /\
align_compatible t p /\
legal_nested_field t gfs.
Definition field_compatible0 t gfs p :=
isptr p /\
complete_legal_cosu_type t = true /\
size_compatible t p /\
align_compatible t p /\
legal_nested_field0 t gfs.
Definition field_address t gfs p :=
if (field_compatible_dec t gfs p)
then offset_val (nested_field_offset t gfs) p
else Vundef.
Definition field_address0 t gfs p :=
if (field_compatible0_dec t gfs p)
then offset_val (nested_field_offset t gfs) p
else Vundef.
Hint Resolve legal_nested_field0_field : core.
(************************************************  nested_field app  ************************************************)

Lemma legal_nested_field_app: forall t gfs0 gfs1,
legal_nested_field t (gfs1 ++ gfs0) -> legal_nested_field (nested_field_type t gfs0) gfs1.