(* $Id: Records.v,v 1.2 1999/10/05 10:35:39 boulme Exp $ *)
(* Definition of Drecords *)

Set Implicit Arguments.
Unset Strict Implicit.

Require Export DecLists.
Require Export Sigtel.

Section Records.

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

(* signatures of Drecords *)
Record sign : Type := 
  {sign_l : list A; sign_l_df : df eqA_dec sign_l; sign_p :> sigtel sign_l}.

Definition Drecord (s : sign) := impltel s.



Require Import Subsig.

Record subsign (s1 s2 : sign) : Type := 
  {subsign_contO : contO (eq (A:=A)) (sign_l s1) (sign_l s2);
   subsign_p :> subsig subsign_contO s1 s2}. 
 
Hint Resolve subsign_contO: sign.

Definition coerce (s1 s2 : sign) (H : subsign s1 s2) 
  (i : Drecord s1) : Drecord s2 := coerce_impltel H i.


Lemma subsign_refl : forall s : sign, subsign s s.
  intros s;
   refine
    (Build_subsign (subsign_contO:=contO_refl (refl_equal (A:=A)) (sign_l s))
       _); auto with sigtel.  
Defined.

Lemma subsign_antisym :
 forall s1 s2 : sign,
 subsign s1 s2 -> subsign s2 s1 -> length (sign_l s1) = length (sign_l s2).
  intros s1 s2 H1 H2; apply contO_antisym with (R := eq (A:=A));
   auto with sign.
Qed.
    
Lemma subsign_sym :
 forall s1 s2 : sign,
 subsign s1 s2 -> length (sign_l s1) = length (sign_l s2) -> subsign s2 s1. 
  intros s1 s2 H1 H2;
   refine
    (Build_subsign
       (subsign_contO:=contO_sym (sym_eq (A:=A)) (subsign_contO H1) H2) _);
   apply subsig_sym; apply subsign_p.
Defined.

Lemma subsign_trans :
 forall s1 s2 s3 : sign, subsign s1 s2 -> subsign s2 s3 -> subsign s1 s3.
  intros s1 s2 s3 H1 H2;
   refine
    (Build_subsign
       (subsign_contO:=contO_trans (subsign_contO H1) (subsign_contO H2)) _);
   apply subsig_trans with (A := A) (s2 := sign_p s2); 
   apply subsign_p.
Defined.

Require Import Access.
Require Import EqTDep.

Definition fieldT (s : sign) (i : Drecord s) (a : A) : Type :=
  fieldsig eqA_dec a i. 

Definition field (s : sign) (i : Drecord s) (a : A)
  (H : inD eqA_dec a (sign_l s)) : fieldT i a := fieldimpl eqA_dec a i. 

(*** Fonction unsafe ****)
Definition field_us (s : sign) (i : Drecord s) (a : A) : 
  fieldT i a := fieldimpl eqA_dec a i. 

Require Import DecOTh.
Lemma subsign_cont :
 forall s1 s2 : sign, subsign s1 s2 -> cont eqA_dec (sign_l s1) (sign_l s2).
Proof.
  intros; apply contO_cont; auto with sign.
  exact (trans_eq (A:=A)).
Qed.

Lemma subsign_ext_T :
 forall (s1 s2 : sign) (H : subsign s1 s2) (i : Drecord s1) (a : A),
 inD eqA_dec a (sign_l s2) -> fieldT i a = fieldT (coerce H i) a.
Proof.
  intros; unfold fieldT, coerce in |- *; apply subsig_ext_T; auto.
  case s1; auto.
Qed.

Theorem subsign_ext :
 forall (s1 s2 : sign) (H1 : subsign s1 s2) (i : Drecord s1) 
   (a : A) (H2 : inD eqA_dec a (sign_l s2)),
 eqT_dep (P:=fun T : Type => T)
   (field i (cont_incl (trans_eq (A:=A)) (subsign_cont H1) H2))
   (field (coerce H1 i) H2).
Proof.
  intros; unfold field, fieldT, coerce in |- *; apply subsig_ext; auto.
  case s1; auto.
Qed.


Definition flatsign (s : sign) (l : list A) (H1 : df eqA_dec l)
  (H2 : disj eqA_dec l (sign_l s)) (f : Drecord s -> sigtel l) :=
  Build_sign (df_disj_app (sign_l_df s) H1 H2) (flatsig f).

Lemma flatsign_subsign :
 forall (s : sign) (l : list A) (H1 : df eqA_dec l)
   (H2 : disj eqA_dec l (sign_l s)) (f : Drecord s -> sigtel l),
 subsign (flatsign H1 H2 f) s.
  intros s1; case s1; unfold flatsign in |- *; simpl in |- *;
   intros l1' H1' s1' l2 H2 H3 f;
   refine
    (Build_subsign (s1:=Build_sign (df_disj_app H1' H2 H3) (flatsig f))
       (s2:=Build_sign H1' s1')
       (subsign_contO:=prefix_contO (prefix_flat (refl_equal (A:=A)) l1' l2))
       _); simpl in |- *; auto with sigtel.
Defined.
Hint Resolve flatsign_subsign: sign.


Definition concatsign (s1 s2 : sign)
  (H : disj eqA_dec (sign_l s2) (sign_l s1)) :=
  flatsign (sign_l_df s2) H (fun _ : Drecord s1 => s2).

Lemma subsign_concatsign_1 :
 forall (s1 s2 : sign) (H : disj eqA_dec (sign_l s2) (sign_l s1)),
 subsign (concatsign H) s1.
Proof.
  intros s1 s2; case s2; unfold concatsign in |- *; simpl in |- *;
   auto with sign.
Defined.

Lemma subsign_concatsign_2 :
 forall (s1 s2 : sign) (H : disj eqA_dec (sign_l s2) (sign_l s1)),
 subsign (concatsign H) s2.
Proof.
  intros s1 s2; case s2; case s1; unfold concatsign, flatsign in |- *;
   simpl in |- *.
  intros l1 H1 s1' l2 H2 s2' H;
   refine
    (Build_subsign
       (s1:=Build_sign (df_disj_app H1 H2 H)
              (flatsig (fun _ : impltel s1' => s2'))) (s2:=
       Build_sign H2 s2')
       (subsign_contO:=contO_flat_const (refl_equal (A:=A)) l1 l2) _);
   simpl in |- *; apply flatsig_constant.
Defined.
Hint Resolve subsign_concatsign_1 subsign_concatsign_2: sign.

Require Import Apsig.

Definition apsign (s1 s2 : sign) (H : subsign s1 s2) 
  (i : Drecord s2) :=
  Build_sign
    (df_extractO (refl_equal (A:=A)) (trans_eq (A:=A)) 
       (sym_eq (A:=A)) (subsign_contO H) (sign_l_df s1))
    (projT1 (apsig_sig H) i).

Lemma apsign_subsign_l :
 forall (s1 s2 : sign) (H : subsign s1 s2),
 subsign
   (flatsign
      (df_extractO (refl_equal (A:=A)) (trans_eq (A:=A)) 
         (sym_eq (A:=A)) (subsign_contO H) (sign_l_df s1))
      (disj_extractO (refl_equal (A:=A)) (trans_eq (A:=A)) 
         (sym_eq (A:=A)) (subsign_contO H) (sign_l_df s1))
      (fun i => sign_p (apsign H i))) s1.
exact
 (fun s1 s2 H =>
  Build_subsign
    (s1:=flatsign
           (df_extractO (refl_equal (A:=A)) (trans_eq (A:=A)) 
              (sym_eq (A:=A)) (subsign_contO H) (sign_l_df s1))
           (disj_extractO (refl_equal (A:=A)) (trans_eq (A:=A))
              (sym_eq (A:=A)) (subsign_contO H) (sign_l_df s1))
           (fun i => sign_p (apsign H i))) (projT2 (apsig_sig H))).
Defined.

Definition apsign_subsign_r :
  forall (s1 s2 : sign) (H : subsign s1 s2),
  subsign s1
    (flatsign
       (df_extractO (refl_equal (A:=A)) (trans_eq (A:=A)) 
          (sym_eq (A:=A)) (subsign_contO H) (sign_l_df s1))
       (disj_extractO (refl_equal (A:=A)) (trans_eq (A:=A)) 
          (sym_eq (A:=A)) (subsign_contO H) (sign_l_df s1))
       (fun i => sign_p (apsign H i))).
  intros s1 s2 H; apply subsign_sym.
  apply apsign_subsign_l.
  simpl in |- *; apply extractO_length.
Defined.


Section Mergesign.

Variable s s1 s2 : sign.
Hypothesis H1 : subsign s1 s.
Hypothesis H2 : subsign s2 s.
Hypothesis
  H3 :
    disj eqA_dec
      (extractO (refl_equal (A:=A)) (trans_eq (A:=A)) (subsign_contO H2))
      (extractO (refl_equal (A:=A)) (trans_eq (A:=A)) (subsign_contO H1)).

Definition mergesign :=
  flatsign
    (df_disj_app
       (df_extractO (refl_equal (A:=A)) (trans_eq (A:=A)) 
          (sym_eq (A:=A)) (subsign_contO H1) (sign_l_df s1))
       (df_extractO (refl_equal (A:=A)) (trans_eq (A:=A)) 
          (sym_eq (A:=A)) (subsign_contO H2) (sign_l_df s2)) H3)
    (disj_sym (refl_equal (A:=A)) (trans_eq (A:=A)) 
       (sym_eq (A:=A))
       (disj_and_app
          (disj_sym (refl_equal (A:=A)) (trans_eq (A:=A)) 
             (sym_eq (A:=A))
             (disj_extractO (refl_equal (A:=A)) (trans_eq (A:=A))
                (sym_eq (A:=A)) (subsign_contO H1) 
                (sign_l_df s1)))
          (disj_sym (refl_equal (A:=A)) (trans_eq (A:=A)) 
             (sym_eq (A:=A))
             (disj_extractO (refl_equal (A:=A)) (trans_eq (A:=A))
                (sym_eq (A:=A)) (subsign_contO H2) 
                (sign_l_df s2)))))
    (fun i : Drecord s =>
     sign_p (concatsign (s1:=apsign H1 i) (s2:=apsign H2 i) H3)).  

Lemma subsign_mergesign_1 : subsign mergesign s1.
  refine
   (Build_subsign (s1:=mergesign) (s2:=s1)
      (subsign_contO:=comp_1 (refl_equal (A:=A)) (trans_eq (A:=A))
                        (sym_eq (A:=A)) (subsign_contO H1) 
                        (subsign_contO H2)) _).
  unfold comp_1 in |- *;
   apply
    subsig_trans
     with
       (A := A)
       (s2 := flatsig (fun i : impltel (sign_p s) => projT1 (apsig_sig H1) i));
   simpl in |- *; auto with sigtel.
  apply (projT2 (apsig_sig H1)).
Defined.

Lemma subsign_mergesign_2 : subsign mergesign s2.
  refine
   (Build_subsign (s1:=mergesign) (s2:=s2)
      (subsign_contO:=comp_2 (refl_equal (A:=A)) (trans_eq (A:=A))
                        (sym_eq (A:=A)) (subsign_contO H1) 
                        (subsign_contO H2)) _).
  unfold comp_2 in |- *;
   apply
    subsig_trans
     with
       (A := A)
       (s2 := flatsig (fun i : impltel (sign_p s) => projT1 (apsig_sig H2) i)).
  simpl in |- *; apply subsig_flatsig; unfold Drecord in |- *;
   auto with sigtel.
  apply (projT2 (apsig_sig H2)).
Defined.

End Mergesign.

End Records.

Notation "i @ f" := (field i (a:=f) I)  (at level 50, left associativity).

Notation "x -: tx ;; f"
  := (Csig x (fun x:tx => f)) (at level 53, right associativity).
Notation "x -: tx ;;" := (Csig x (fun x:tx => (Esig _))) (at level 53).












