(* $Id: Access.v,v 1.2 1999/10/05 10:35:32 boulme Exp $ *)
(* Accessing the fields of a record *)

Set Implicit Arguments.
Unset Strict Implicit.

Require Import Subsig.
Require Import DecOTh.
Require Import EqTDep.

Section Access.


Variable A : Set.

Inductive Dummy : Type :=
    foo : Dummy. 

Hypothesis eqA_dec : forall x y : A, {x = y} + {x <> y}.

(* Access the type of a field in a sigtel *)
Fixpoint fieldsig (a : A) (l : list A) {struct l} :
 forall s : sigtel l, impltel s -> Type :=
  match l return (forall s : sigtel l, impltel s -> Type) with
  | nil => fun _ _ => Dummy
  | b :: m =>
      fun s i =>
      match eqA_dec a b with
      | left _ => dom s
      | right _ => fieldsig a (dprojT2 i)
      end
  end.

(* Access the value of a field in a sigtel *)
Fixpoint fieldimpl (a : A) (l : list A) {struct l} :
 forall (s : sigtel l) (i : impltel s), fieldsig a i :=
  match l return (forall (s : sigtel l) (i : impltel s), fieldsig a i) with
  | nil => fun _ _ => foo
  | b :: m =>
      fun s i =>
      match
        eqA_dec a b as H
        return
          match H with
          | left _ => dom s
          | right _ => fieldsig a (dprojT2 i)
          end
      with
      | left _ => dprojT1 i
      | right _ => fieldimpl a (dprojT2 i)
      end
  end.


(* Two important lemmas, linking subtyping and access *)
(* An extensional view of subtyping ... *)

Lemma subsig_ext_T :
 forall (l1 l2 : list A) (H1 : contO (eq (A:=A)) l1 l2) 
   (s1 : sigtel l1) (s2 : sigtel l2) (H2 : subsig H1 s1 s2),
 df eqA_dec l1 ->
 forall (a : A) (i : impltel s1),
 inD eqA_dec a l2 -> fieldsig a i = fieldsig a (coerce_impltel H2 i).

  intros l1 l2 H1 s1 s2 H2; elim H2; clear H2 s2 s1 H1 l2 l1.

  simpl in |- *; contradiction.

  intros a l1 l2 T f g H1 H2 HR H3 b i H4; case (df_cons_inv H3); case i;
   intros x j H5 H6; simpl in |- *; case (eqA_dec b a); 
   auto; intros H7; apply HR; auto; case (inD_cons_inv H4); 
   auto; intros; case H7; auto.

  intros a l1 l2 T f s H1 H2 HR H3 b i H4; case (df_cons_inv H3); case i;
   intros x j H5 H6; simpl in |- *; case (eqA_dec b a); 
   auto; intros H7; elim (not_ninD_inD H5); rewrite <- H7;
   exact
    (cont_incl (trans_eq (A:=A))
       (contO_cont eqA_dec (refl_equal (A:=A)) (trans_eq (A:=A))
          (sym_eq (A:=A)) H1) H4).

  intros a1 a2 l1 l2 T1 T2 f g H1 H2 HR H3 b i H4; case (df_cons_inv H3);
   case i; intros x j H5 H6; case (df_cons_inv H6); 
   case (ninD_cons_inv H5); case j; clear H6 H5 H3 j i;
   intros y i H3 H5 H6 H7; simpl in |- *; case (eqA_dec b a1);
   case (eqA_dec b a2); auto.
  intros H8 H9; case H3; rewrite <- H9; auto.
  intros H8 H9; apply HR; auto; case (inD_cons_inv H4).
    intros; case H8; auto. 
    intros H10; case (inD_cons_inv H10); intros; auto; case H9; auto.

  intros l1 l2 l3 s1 s2 s3 Hc1 Hc2 H1 HR1 H2 HR2 H3 a i H4.
  simpl in |- *; rewrite <- HR2; auto.
  apply HR1; auto.
    exact
     (cont_incl (trans_eq (A:=A))
        (contO_cont eqA_dec (refl_equal (A:=A)) (trans_eq (A:=A))
           (sym_eq (A:=A)) Hc2) H4).
    exact
     (contO_df (refl_equal (A:=A)) (trans_eq (A:=A)) (sym_eq (A:=A)) Hc1 H3).
Qed.


Lemma subsig_ext :
 forall (l1 l2 : list A) (H1 : contO (eq (A:=A)) l1 l2) 
   (s1 : sigtel l1) (s2 : sigtel l2) (H2 : subsig H1 s1 s2),
 df eqA_dec l1 ->
 forall (a : A) (i : impltel s1),
 inD eqA_dec a l2 ->
 eqT_dep (P:=fun T : Type => T) (fieldimpl a i)
   (fieldimpl a (coerce_impltel H2 i)).

  intros l1 l2 H1 s1 s2 H2; elim H2; clear H2 s2 s1 H1 l2 l1.

  simpl in |- *; contradiction.

  intros a l1 l2 T f g H1 H2 HR H3 b i H4; case (df_cons_inv H3); case i;
   intros x j H5 H6; simpl in |- *; case (eqA_dec b a); 
   auto with eqT_dep; intros H7; apply HR; auto; case (inD_cons_inv H4); 
   auto; intros; case H7; auto.

  intros a l1 l2 T f s H1 H2 HR H3 b i H4; case (df_cons_inv H3); case i;
   intros x j H5 H6; simpl in |- *; case (eqA_dec b a); 
   auto with eqT_dep; intros H7; elim (not_ninD_inD H5); 
   rewrite <- H7;
   exact
    (cont_incl (trans_eq (A:=A))
       (contO_cont eqA_dec (refl_equal (A:=A)) (trans_eq (A:=A))
          (sym_eq (A:=A)) H1) H4).

  intros a1 a2 l1 l2 T1 T2 f g H1 H2 HR H3 b i H4; case (df_cons_inv H3);
   case i; intros x j H5 H6; case (df_cons_inv H6); 
   case (ninD_cons_inv H5); case j; clear H6 H5 H3 j i;
   intros y i H3 H5 H6 H7; simpl in |- *; case (eqA_dec b a1);
   case (eqA_dec b a2); auto with eqT_dep.
  intros H8 H9; case H3; rewrite <- H9; auto with eqT_dep.
  intros H8 H9; apply HR; auto; case (inD_cons_inv H4).
    intros; case H8; auto. 
    intros H10; case (inD_cons_inv H10); intros; auto; case H9; auto.

  intros l1 l2 l3 s1 s2 s3 Hc1 Hc2 H1 HR1 H2 HR2 H3 a i H4;
   generalize
    (contO_df (refl_equal (A:=A)) (trans_eq (A:=A)) (sym_eq (A:=A)) Hc1 H3)
    (cont_incl (trans_eq (A:=A))
       (contO_cont eqA_dec (refl_equal (A:=A)) (trans_eq (A:=A))
          (sym_eq (A:=A)) Hc2) H4); intros;
   pattern (fieldsig a i), (fieldimpl a i) in |- *;
   apply
    eqT_dep_ind
     with (P := fun T : Type => T) (x := fieldimpl a (coerce_impltel H1 i));
   simpl in |- *; auto with eqT_dep.
Qed.

End Access.



