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 align_1_compatible: forall t, alignof t = 1 -> forall p, align_compatible t p. *)
(* Lemma field_compatible_complete_type: forall t path p, field_compatible t path p -> complete_type cenv_cs t = true.  Lemma field_compatible_legal_nested_field0: forall (t : type) (path : list gfield) (p : val), field_compatible t path p -> legal_nested_field0 t path.  Lemma field_compatible0_legal_nested_field0: forall (t : type) (path : list gfield) (p : val), field_compatible0 t path p -> legal_nested_field0 t path.  Lemma field_compatible_field_address: forall t gfs p, field_compatible t gfs p -> field_address t gfs p = offset_val (nested_field_offset t gfs) p.  Lemma field_compatible0_field_address0: forall t gfs p, field_compatible0 t gfs p -> field_address0 t gfs p = offset_val (nested_field_offset t gfs) p.  Lemma field_compatible_shrink: forall t_root gfsB gfsA a, field_compatible t_root (gfsB ++ gfsA) a -> field_compatible t_root gfsA a.  Lemma field_compatible0_shrink: forall t_root gfsB gfsA a, field_compatible0 t_root (gfsB ++ gfsA) a -> field_compatible0 t_root gfsA a.  Lemma field_compatible0_shrink1: forall t_root gfsB gfsA a, gfsB <> nil -> field_compatible0 t_root (gfsB ++ gfsA) a -> field_compatible t_root gfsA a.  Lemma field_compatible_app: forall gfsB t_root gfsA a, field_compatible t_root (gfsB ++ gfsA) a -> field_compatible (nested_field_type t_root gfsA) gfsB (field_address t_root gfsA a).  Lemma field_compatible0_app1: forall gfsB t_root gfsA a (NEQ: gfsB <> nil), field_compatible0 t_root (gfsB ++ gfsA) a -> field_compatible0 (nested_field_type t_root gfsA) gfsB (field_address t_root gfsA a).  Lemma field_compatible_app_inv': forall gfsB t_root gfsA a, field_compatible t_root gfsA a -> legal_nested_field (nested_field_type t_root gfsA) gfsB -> field_compatible t_root (gfsB ++ gfsA) a.  Lemma field_compatible0_app_inv': forall gfsB t_root gfsA a, field_compatible t_root gfsA a -> legal_nested_field0 (nested_field_type t_root gfsA) gfsB -> field_compatible0 t_root (gfsB ++ gfsA) a.  Lemma field_compatible_app_inv: forall gfsB t_root gfsA a, field_compatible t_root gfsA a -> field_compatible (nested_field_type t_root gfsA) gfsB (field_address t_root gfsA a) -> field_compatible t_root (gfsB ++ gfsA) a.  Lemma field_compatible0_app_inv: forall gfsB t_root gfsA a, field_compatible t_root gfsA a -> field_compatible0 (nested_field_type t_root gfsA) gfsB (field_address t_root gfsA a) -> field_compatible0 t_root (gfsB ++ gfsA) a.  Lemma field_address_app: forall t_root gfsA gfsB a, field_address t_root (gfsB ++ gfsA) a = field_address (nested_field_type t_root gfsA) gfsB (field_address t_root gfsA a).  Lemma field_address0_app: forall t_root gfsA gfsB a (NEQ: gfsB <> nil), field_address0 t_root (gfsB ++ gfsA) a = field_address0 (nested_field_type t_root gfsA) gfsB (field_address t_root gfsA a).  End COMPOSITE_ENV. (* Arguments nested_field_offset2 {cs} t gfs /. Arguments nested_field_type2 {cs} t gfs /. *)
(* Hint Resolve field_address_isptr : core. *)
Hint Resolve is_pointer_or_null_field_compatible : core.
(* Hint Extern 1 (complete_type _ _ = true) => (eapply field_compatible_complete_type; eassumption). *)
Hint Extern 1 (isptr _) => (eapply field_compatible_isptr; eassumption) : core.
Hint Extern 1 (isptr _) => (eapply field_compatible0_isptr; eassumption) : core.
Hint Extern 1 (legal_nested_field _ _) => (eapply field_compatible_legal_nested_field; eassumption) : core.
Hint Extern 1 (legal_nested_field0 _ _) => (eapply field_compatible_legal_nested_field0; eassumption) : core.
Hint Extern 1 (legal_nested_field0 _ _) => (eapply field_compatible0_legal_nested_field0; eassumption) : core.

Lemma nested_field_type_change_composite: forall {cs_from cs_to} {CCE: change_composite_env cs_from cs_to} (t: type),
cs_preserve_type cs_from cs_to (coeq _ _) t = true ->
forall gfs, @nested_field_type cs_from t gfs = @nested_field_type cs_to t gfs.