(* $Id$ *)
Set Implicit Arguments.
Unset Strict Implicit.

Require Export Sigtel.
Require Export Mixtels.

Structure uple2 (A B : Type) : Type :=  {uple2_A
                                           : A; uple2_B : B}. 

Structure uple4 (A B C D : Type) : Type := 
  {uple4_A : A; uple4_B : B; uple4_C : C; uple4_D : D}. 
Hint Resolve Build_uple2 Build_uple4: core.


Section WellMixed.
(* The set of labels in records *)
Variable A : Set.

(* p1<: p2*)
Definition match_flag (T : Set) (match_ : T -> T -> Type) 
  (p1 p2 : flag T) :=
  match p1 with
  | Abs p11 =>
      match p2 with
      | Abs p21 => match_ p11 p21
      | Man _ _ => False
      end
  | Man p11 p12 =>
      match p2 with
      | Abs p21 => uple2 (match_ p12 p11) (match_ p11 p21)
      | Man p21 p22 =>
          uple4 (match_ p12 p11) (match_ p22 p21) (match_ p11 p21)
            (match_ p12 p22)
          (* (match p2 p'1)) *)
      end
  end.

Fixpoint match_pre (l : list A) : pre l -> pre l -> Type :=
  match l return (pre l -> pre l -> Type) with
  | nil => fun _ _ => True
  | a :: m => match_flag (match_pre (l:=m))
  end.

(*** match_pre est un ordre partiel ***)
Lemma match_pre_trans :
 forall (l : list A) (p1 p2 p3 : pre l),
 match_pre p1 p2 -> match_pre p2 p3 -> match_pre p1 p3.
  intros l; elim l; simpl in |- *; auto.
  intros a m HR p1 p2 p3; case p1.
    case p2; case p3; simpl in |- *; eauto.
      intros; contradiction.
    intros p11 p12; case p2.
      intros p22 H; case H; case p3; simpl in |- *; eauto.
        intros; contradiction.
      intros p21 p22 H; case H; intros H1 H2 H3 H4; case p3; simpl in |- *.
      intros p31 H'; case H'; intros; eauto.
      intros p31 p32 H'; case H'; intros; eauto.
Defined.

Lemma match_pre_antisym :
 forall (l : list A) (p1 p2 : pre l),
 match_pre p1 p2 -> match_pre p2 p1 -> p1 = p2.
  intros l; elim l; simpl in |- *; auto.
  intros p1 p2; case p1; case p2; auto.
  intros a m HR p1 p2; case p1; simpl in |- *.
   case p2; simpl in |- *; intros.
      apply f_equal with (f := Abs (U:=pre m)); auto.
      contradiction.
   intros p11 p12; case p2; simpl in |- *.
      intros; contradiction.
      intros p21 p22 H1 H2; case H1; case H2; intros.
      rewrite (HR p11 p21); auto.
      apply f_equal with (f := Man p21); auto.
Defined.

(*** wellpre : lorsque match_pre est reflexif ***)
Definition wellpre (l : list A) (p : pre l) := match_pre p p.

Lemma match_well_pre1 :
 forall (l : list A) (p1 p2 : pre l), match_pre p1 p2 -> wellpre p1.
  intros l; elim l; unfold wellpre in |- *; simpl in |- *; auto.
    intros a m HR p1 p2; case p1; simpl in |- *.
      intros p11; case p2; simpl in |- *; eauto. intros; contradiction.
      intros p11 p12; case p2; simpl in |- *.
        intros p21 H; case H; eauto.
        intros p21 p22 H; case H; eauto.
Defined.

Lemma match_well_pre2 :
 forall (l : list A) (p1 p2 : pre l), match_pre p1 p2 -> wellpre p2.
  intros l; elim l; unfold wellpre in |- *; simpl in |- *; auto.
    intros a m HR p1 p2; case p1; simpl in |- *.
      intros p11; case p2; simpl in |- *; eauto. intros; contradiction.
      intros p11 p12; case p2; simpl in |- *.
        intros p21 H; case H; eauto.
        intros p21 p22 H; case H; eauto.
Defined.

(********)  
Lemma wellpre_totabs : forall l : list A, wellpre (totabs l).
  intros l; elim l; unfold wellpre in |- *; simpl in |- *; auto.
Defined.

Lemma totabs_mini :
 forall (l : list A) (p : pre l), wellpre p -> match_pre p (totabs l).
  intros l; elim l; unfold wellpre in |- *; simpl in |- *; auto.
  intros a l' HR p; case p; simpl in |- *; auto.
  intros p1 p2 H; case H; auto.
Defined.

(* mais p1 et p2 ne sont pas forcement egaux... *)
Lemma is_all_man_match :
 forall (l : list A) (p1 p2 : pre l),
 is_all_man p1 -> match_pre p2 p1 -> is_all_man p2.
  intros l; elim l; simpl in |- *; auto.
  intros a l' HR p1 p2; case p1; case p2; simpl in |- *;
   try (intros; contradiction); intros p21 p22 p11 p12 H1 H2; 
   case H2; intros; apply HR with (p1 := p12); auto.
Defined.

(****************************************)
     
Definition match_mix :
  forall (l : list A) (s : sigtel l) (p1 p2 : pre l),
  match_pre p1 p2 -> mixtel s p1 -> mixtel s p2 -> Type.
  intros l s; pattern l, s in |- *; apply sigtel_rect; simpl in |- *.
    intros; exact True.
    intros a l' T f HR p1; case p1; simpl in |- *.
      intros p11 p2; case p2; simpl in |- *. 
         intros p21 H m1 m2; case m1; case m2; simpl in |- *;
          intros F2 o2 F1 o1; exact (forall x : T, HR _ _ _ H (F1 x) (F2 x)).
         intros; contradiction.
      intros p11 p12 p2; case p2; simpl in |- *. 
         intros p21 H m1 m2; case m1; case m2; simpl in |- *;
          intros F2 o2 F1 o1; elim H; case o1; intros x v H1 H2;
          exact
           (uple2 (HR _ _ _ H1 v (F1 x))
              (forall x : T, HR _ _ _ H2 (F1 x) (F2 x))).
         intros p21 p22 H m1 m2; case m1; case m2; simpl in |- *;
          intros F2 o2 F1 o1; elim H; case o1; case o2;
          intros x2 v2 x1 v1 H1 H2 H3 H4;
          refine (sigT (fun H0 : identity x1 x2 => _)); 
          generalize v2; elim H0; intros v2';
          exact
           (uple4 (HR _ _ _ H1 v1 (F1 x1)) (HR _ _ _ H2 v2' (F2 x1))
              (forall x : T, HR _ _ _ H3 (F1 x) (F2 x)) 
              (HR _ _ _ H4 v1 v2')). 
Defined.


Transparent is_all_man_match.
Theorem match_mix_new :
 forall (l : list A) (s : sigtel l) (p1 p2 : pre l) 
   (H1 : is_all_man p1) (H2 : match_pre p2 p1) (m1 : mixtel s p1)
   (m2 : mixtel s p2),
 match_mix H2 m2 m1 -> identity (new H1 m1) (new (is_all_man_match H1 H2) m2).

  intros l s; pattern l, s in |- *; apply sigtel_rect; auto.
  intros a l' T f HR p1 p2; case p1; case p2; simpl in |- *;
   try (intros; contradiction); intros p21 p22 p11 p12 H1 H2 m1 m2; 
   case H2; case m1; case m2; simpl in |- *; intros F2 o2 F1 o1 Ha Hb Hc Hd;
   case o2; case o1; intros x' v' x v H; case H; simpl in |- *; 
   intros H'; generalize v'; elim H'; clear H' H v' x'; 
   simpl in |- *; intros v' H; case H; intros; rewrite (HR x _ _ H1 Hd v' v);
   auto.
Defined.

Lemma match_mix_trans :
 forall (l : list A) (s : sigtel l) (p1 p2 p3 : pre l) 
   (H1 : match_pre p1 p2) (H2 : match_pre p2 p3) (m1 : mixtel s p1)
   (m2 : mixtel s p2) (m3 : mixtel s p3),
 match_mix H1 m1 m2 ->
 match_mix H2 m2 m3 -> match_mix (match_pre_trans H1 H2) m1 m3.

  intros l s; pattern l, s in |- *; apply sigtel_rect; auto.
  intros a l' T f HR p1 p2 p3; case p1.
      case p2; case p3; simpl in |- *; try (intros; contradiction);
       intros p31 p21 p11 H1 H2 m1 m2 m3; case m1; 
       case m2; case m3; intros F3 o3 F2 o2 F1 o1 H'1 H'2 x;
       apply HR with (m2 := F2 x); auto.
    intros p11 p12; case p2.
      intros p22 H; case H; case p3; simpl in |- *;
       try (intros; contradiction); intros p31 H1 H2 H3 m1 m2 m3; 
       case m1; case m2; case m3; simpl in |- *; intros F3 o3 F2 o2 F1 o1;
       case o1; simpl in |- *; intros y v H4; case H4; 
       intros H'1 H'2 H'3; constructor 1; auto; intros x;
       apply HR with (m2 := F2 x); auto.
      intros p21 p22 H; case H; case p3; simpl in |- *.
        intros p31 H1 H2 H3 H4 H5 m1 m2 m3; case H5; case m1; case m2;
         case m3; simpl in |- *; intros F3 o3 F2 o2 F1 o1 H6 H7; 
         case o2; case o1; simpl in |- *; intros y v y' v' H'1 H'2; 
         case H'2; case H'1; simpl in |- *; intros H'3; 
         generalize v'; elim H'3; clear H'3 H'2 H'1 v' y'; 
         simpl in |- *; intros v' H'1 H'2 H'3; case H'1; 
         constructor 1; auto; intros x; apply HR with (m2 := F2 x); 
         auto.      
      intros p31 p32 H1 H2 H3 H4 H5 m1 m2 m3; case H5; case m1; case m2;
       case m3; simpl in |- *; intros F3 o3 F2 o2 F1 o1 H6 H7 H8 H9; 
       case o3; case o2; case o1; simpl in |- *;
       intros y v y' v' y'' v'' H'1 H'2; case H'2; 
       case H'1; simpl in |- *. 
          intros H'3; generalize v'; elim H'3; clear H'3 H'2 H'1 v' y';
           simpl in |- *; intros v' H'1 H'2; generalize v''; 
           elim H'2; clear H'2 v'' y''; simpl in |- *; 
           intros v'' H'2; case H'2; case H'1;
           constructor 1 with (x := refl_identity y); 
           simpl in |- *; constructor 1; auto.
          intros x; apply HR with (m2 := F2 x); auto. 
          apply HR with (m2 := v'); auto.
Defined.


(* A FAIRE: pb definir une relation d'equivalence sur les mixtels...
Lemma match_pre_antisym:(l:(list A); p1,p2:(pre l))
  (match_pre p1 p2)->(match_pre p2 p1)->p1=p2.
  Intros l; Elim l; Simpl; Auto.
  Intros p1 p2; Case p1; Case p2; Auto.
  Intros a m HR p1 p2; Case p1; Simpl.
   Case p2; Simpl; Intros.
      Apply f_equal with f:=(Abs 1!(pre m)); Auto.
      Contradiction.
   Intros p11 p12; Case p2; Simpl.
      Intros; Contradiction.
      Intros p21 p22 H1 H2; Case H1; Case H2; Intros.
      Rewrite (HR p11 p21); Auto.
      Apply f_equal with f:=(Man p21); Auto.

Defined.
*)

Definition wellmixed (l : list A) (s : sigtel l) (p : pre l) 
  (H : wellpre p) (m : mixtel s p) := match_mix H m m.

Transparent match_well_pre1.
Lemma match_well_mix1 :
 forall (l : list A) (s : sigtel l) (p1 p2 : pre l) 
   (H : match_pre p1 p2) (m1 : mixtel s p1) (m2 : mixtel s p2),
 match_mix H m1 m2 -> wellmixed (match_well_pre1 H) m1.

  intros l s; pattern l, s in |- *; apply sigtel_rect;
   unfold wellmixed in |- *; auto.
  intros a l' T f HR p1 p2; case p1.
     intros p11; case p2; simpl in |- *; try (intros; contradiction);
      intros p21 H m1 m2; case m1; case m2; simpl in |- *;
      intros F2 o2 F1 o1 H' x; apply HR with (m2 := F2 x); 
      auto.
     intros p11 p12; case p2; simpl in |- *.
      intros p21 H; case H; intros H1 H2 m1 m2; case m1; case m2;
       simpl in |- *; intros F2 o2 F1 o1; case o1; 
       simpl in |- *; intros y v H'; case H';
       constructor 1 with (x := refl_identity y); simpl in |- *;
       constructor 1; auto.
        intros x; apply HR with (m2 := F2 x); auto.
        apply HR with (m2 := F1 y); auto.
      intros p21 p22 H; case H; intros H1 H2 H3 H4 m1 m2; case m1; case m2;
       simpl in |- *; intros F2 o2 F1 o1; case o2; 
       case o1; simpl in |- *.
        intros y v y' v' H'; case H'; intros H'1; generalize v'; elim H'1;
         simpl in |- *; clear H'1 H' v'; intros v' H'; 
         case H'; constructor 1 with (x := refl_identity y); 
         simpl in |- *; constructor 1; auto.
        intros x; apply HR with (m2 := F2 x); auto.
        apply HR with (m2 := v'); auto.
Defined.

Transparent match_well_pre2.
Lemma match_well_mix2 :
 forall (l : list A) (s : sigtel l) (p1 p2 : pre l) 
   (H : match_pre p1 p2) (m1 : mixtel s p1) (m2 : mixtel s p2),
 match_mix H m1 m2 -> wellmixed (match_well_pre2 H) m2.

  intros l s; pattern l, s in |- *; apply sigtel_rect;
   unfold wellmixed in |- *; auto.
  intros a l' T f HR p1 p2; case p1.
     intros p11; case p2; simpl in |- *; try (intros; contradiction);
      intros p21 H m1 m2; case m1; case m2; simpl in |- *;
      intros F2 o2 F1 o1 H' x; apply HR with (m1 := F1 x); 
      auto.
     intros p11 p12; case p2; simpl in |- *.
      intros p21 H; case H; intros H1 H2 m1 m2; case m1; case m2;
       simpl in |- *; intros F2 o2 F1 o1; case o1; 
       simpl in |- *; intros y v H' x; case H'; intros;
       apply HR with (m1 := F1 x); auto.
      intros p21 p22 H; case H; intros H1 H2 H3 H4 m1 m2; case m1; case m2;
       simpl in |- *; intros F2 o2 F1 o1; case o2; 
       case o1; simpl in |- *; intros y v y' v' H'; 
       case H'; intros H'1; generalize v'; elim H'1; 
       simpl in |- *; clear H'1 H' v'; intros v' H'; 
       case H'; constructor 1 with (x := refl_identity y); 
       simpl in |- *; constructor 1; auto.
        intros x; apply HR with (m1 := F1 x); auto.
        apply HR with (m1 := v); auto.
Defined.


(***************)
(**** merge ****)
(***************)

Lemma match_pre_merge :
 forall (l : list A) (p p' p1 p2 p3 p4 : pre l),
 match_pre p p1 ->
 match_pre p' p3 ->
 match_pre p1 p2 ->
 match_pre p3 p4 ->
 uple2
   (match_pre (merge_prex p2 p3 (merge_control p p'))
      (merge_prex p2 p4 (merge_control p p')))
   (match_pre (merge_prex p1 p4 (merge_control p p'))
      (merge_prex p2 p4 (merge_control p p'))).

  intros l; elim l; auto.
    intros a l' HR p p' p1 p2 p3 p4; case p; case p'; case p1; case p2;
     case p3; case p4; clear l p4 p3 p2 p1 p' p; simpl in |- *; 
     auto; try (intros; contradiction).
     intros p41 p31 p21 p11 p'1 p'2 p_1 H1 H2; case H2; intros;
      case (HR p_1 p'2 p11 p21 p31 p41); auto;
      apply match_pre_trans with (p2 := p'1); auto.
    intros p41 p31 p32 p21 p11 p'1 p'2 p_1 H1 H2 H3 H4; case H2; case H4;
     intros; case (HR p_1 p'2 p11 p21 p31 p41); auto.
       apply match_pre_trans with (p2 := p'1); auto.
       constructor 1; auto; constructor 1; auto;
        case (HR p_1 p'2 p11 p21 p32 p31); auto.
    intros p41 p42 p31 p32 p21 p11 p'1 p'2 p_1 H1 H2 H3 H4; case H2; case H4;
     intros; case (HR p_1 p'2 p11 p21 p31 p41); auto.
       apply match_pre_trans with (p2 := p'1); auto.
       case (HR p_1 p'2 p11 p21 p42 p41); auto.
       apply match_pre_trans with (p2 := p32); auto.
       case (HR p_1 p'2 p11 p21 p32 p42); auto; constructor 1; constructor 1;
        auto.
         case (HR p_1 p'2 p11 p21 p32 p31); auto.
         case (HR p_1 p'2 p11 p11 p42 p41); auto.
           apply match_pre_trans with (p2 := p32); auto.
           exact (match_well_pre1 H3).
    intros p41 p31 p21 p11 p'1 p_1 p_2 H1 H2 H3 H4; case H1; intros;
     case (HR p_2 p'1 p11 p21 p31 p41); auto;
     apply match_pre_trans with (p2 := p_1); auto. 
    intros p41 p31 p21 p11 p12 p'1 p_1 p_2 H1 H2 H3 H4; case H1; case H3;
     intros; case (HR p_2 p'1 p11 p21 p31 p41); auto.
       apply match_pre_trans with (p2 := p_1); auto. 
       constructor 1; auto; constructor 1; auto;
        case (HR p_2 p'1 p12 p11 p31 p41); auto.
    intros p41 p31 p21 p22 p11 p12 p'1 p_1 p_2 H1 H2 H3 H4; case H1; case H3;
     intros; case (HR p_2 p'1 p11 p21 p31 p41); auto.
       apply match_pre_trans with (p2 := p_1); auto. 
       case (HR p_2 p'1 p22 p21 p31 p41); auto.
       apply match_pre_trans with (p2 := p12); auto. 
       case (HR p_2 p'1 p12 p22 p31 p41); auto; constructor 1; constructor 1;
        auto.
         case (HR p_2 p'1 p22 p21 p31 p31); auto.
           apply match_pre_trans with (p2 := p12); auto.
           exact (match_well_pre1 H4).
         case (HR p_2 p'1 p12 p11 p31 p41); auto.
    intros p41 p31 p21 p11 p'1 p'2 p_1 p_2 H1 H2 H3 H4; case H1; case H2;
     intros; case (HR p_2 p'1 p11 p21 p31 p41); auto;
     apply match_pre_trans with (p2 := p_1); auto.
    intros p41 p31 p32 p21 p11 p'1 p'2 p_1 p_2 H1 H2 H3 H4; case H1; case H2;
     case H4; intros; case (HR p_2 p'1 p11 p21 p31 p41); 
     auto; apply match_pre_trans with (p2 := p_1); 
     auto.
    intros p41 p42 p31 p32 p21 p11 p'1 p'2 p_1 p_2 H1 H2 H3 H4; case H1;
     case H2; case H4; intros; case (HR p_2 p'1 p11 p21 p31 p41); 
     auto; apply match_pre_trans with (p2 := p_1); 
     auto.
    intros p41 p31 p21 p11 p12 p'1 p'2 p_1 p_2 H1 H2 H3 H4; case H1; case H2;
     case H3; intros; case (HR p_2 p'1 p11 p21 p31 p41); 
     auto.
      apply match_pre_trans with (p2 := p_1); auto.
      constructor 1; auto; constructor 1; auto.
        case (HR p_2 p'1 p12 p11 p31 p41); auto.
    intros p41 p31 p32 p21 p11 p12 p'1 p'2 p_1 p_2 H1 H2 H3 H4; case H1;
     case H2; case H3; case H4; intros; case (HR p_2 p'1 p11 p21 p31 p41);
     auto. apply match_pre_trans with (p2 := p_1); auto.
      constructor 1; auto; constructor 1; auto.
        case (HR p_2 p'1 p12 p11 p31 p41); auto.
    intros p41 p42 p31 p32 p21 p11 p12 p'1 p'2 p_1 p_2 H1 H2 H3 H4; case H1;
     case H2; case H3; case H4; intros; case (HR p_2 p'1 p11 p21 p31 p41);
     auto. apply match_pre_trans with (p2 := p_1); auto.
      constructor 1; auto; constructor 1; auto.
        case (HR p_2 p'1 p12 p11 p31 p41); auto.
    intros p41 p31 p21 p22 p11 p12 p'1 p'2 p_1 p_2 H1 H2 H3 H4; case H1;
     case H2; case H3; intros; case (HR p_2 p'1 p11 p21 p31 p41); 
     auto. apply match_pre_trans with (p2 := p_1); auto.
      case (HR p_2 p'1 p22 p21 p31 p41); auto.
      apply match_pre_trans with (p2 := p12); auto.
      case (HR p_2 p'1 p12 p22 p31 p41); auto.
      constructor 1; constructor 1; auto.
        case (HR p_2 p'1 p22 p21 p31 p31); auto.
          apply match_pre_trans with (p2 := p12); auto.
          exact (match_well_pre1 H4).  
        case (HR p_2 p'1 p12 p11 p31 p41); auto.
    intros p41 p31 p32 p21 p22 p11 p12 p'1 p'2 p_1 p_2 H1 H2 H3 H4; case H1;
     case H2; case H3; case H4; intros; case (HR p_2 p'1 p11 p21 p31 p41);
     auto. apply match_pre_trans with (p2 := p_1); auto.
      case (HR p_2 p'1 p22 p21 p31 p41); auto.
      apply match_pre_trans with (p2 := p12); auto.
      case (HR p_2 p'1 p12 p22 p31 p41); auto.
      constructor 1; constructor 1; auto.
        case (HR p_2 p'1 p22 p21 p31 p31); auto.
          apply match_pre_trans with (p2 := p12); auto.
          exact (match_well_pre2 uple4_B1).  
        case (HR p_2 p'1 p12 p11 p31 p41); auto.
    intros p41 p42 p31 p32 p21 p22 p11 p12 p'1 p'2 p_1 p_2 H1 H2 H3 H4;
     case H1; case H2; case H3; case H4; intros;
     case (HR p_2 p'1 p11 p21 p31 p41); auto. 
      apply match_pre_trans with (p2 := p_1); auto.
      case (HR p_2 p'1 p22 p21 p31 p41); auto.
      apply match_pre_trans with (p2 := p12); auto.
      case (HR p_2 p'1 p12 p22 p31 p41); auto.
      constructor 1; constructor 1; auto.
        case (HR p_2 p'1 p22 p21 p31 p31); auto.
          apply match_pre_trans with (p2 := p12); auto.
          exact (match_well_pre2 uple4_B2).  
        case (HR p_2 p'1 p12 p11 p31 p41); auto.
Defined.


Lemma wellpre_merge :
 forall (l : list A) (p1 p2 : pre l),
 wellpre p1 -> wellpre p2 -> wellpre (merge_pre p1 p2).
  unfold wellpre in |- *; unfold merge_pre in |- *; intros l p1 p2; intros;
   case
    (match_pre_merge (p:=p1) (p':=p2) (p1:=p1) (p2:=p1) (p3:=p2) (p4:=p2));
   auto.  
Defined.

Lemma match_pre_mergex_1 :
 forall (l : list A) (p p' p1 p2 : pre l),
 match_pre p p1 ->
 match_pre p' p2 -> match_pre (merge_prex p1 p2 (merge_control p p')) p1.

  intros l; elim l; simpl in |- *; auto.
    intros a l' HR p p' p1 p2; case p; case p'; case p1; case p2;
     simpl in |- *; try (intros; contradiction); auto.
      intros p21 p11 p'1 p'2 p_1 H1 H2; case H2; intros; apply HR; auto;
       apply match_pre_trans with (p2 := p'1); auto.
      intros p21 p22 p11 p'1 p'2 p_1 H1 H2; case H2; constructor 1.
      case
       (match_pre_merge (p:=p_1) (p':=p'2) (p1:=p11) (p2:=p11) (p3:=p22)
          (p4:=p21)); auto; exact (match_well_pre2 H1).
        apply HR; auto; apply match_pre_trans with (p2 := p'1); auto.
      intros p21 p11 p'1 p_1 p_2 H1; case H1; intros; apply HR; auto;
       apply match_pre_trans with (p2 := p_1); auto.
      intros p21 p11 p12 p'1 p_1 p_2 H1 H2; case H1; constructor 1; auto;
       try (apply HR; auto).
        case
         (match_pre_merge (p:=p_2) (p':=p'1) (p1:=p12) (p2:=p11) (p3:=p21)
            (p4:=p21)); auto; exact (match_well_pre2 H2).
        apply match_pre_trans with (p2 := p_1); auto.
      intros p21 p11 p'1 p'2 p_1 p_2 H1 H2; case H1; case H2; intros;
       apply HR; auto; apply match_pre_trans with (p2 := p_1); 
       auto.
      intros p21 p22 p11 p'1 p'2 p_1 p_2 H1 H2; case H1; case H2; intros;
       apply HR; auto; apply match_pre_trans with (p2 := p_1); 
       auto.
      intros p21 p11 p12 p'1 p'2 p_1 p_2 H1 H2; case H1; case H2;
       constructor 1; auto; try (apply HR; auto).
        case
         (match_pre_merge (p:=p_2) (p':=p'1) (p1:=p12) (p2:=p11) (p3:=p21)
            (p4:=p21)); auto; exact (match_well_pre2 uple2_B0).
        apply match_pre_trans with (p2 := p_1); auto.
      intros p21 p22 p11 p12 p'1 p'2 p_1 p_2 H1 H2; case H1; case H2;
       constructor 1; auto; try (apply HR; auto).
        case
         (match_pre_merge (p:=p_2) (p':=p'1) (p1:=p12) (p2:=p11) (p3:=p21)
            (p4:=p21)); auto; exact (match_well_pre2 uple4_B0).
        apply match_pre_trans with (p2 := p_1); auto.
Defined.

Lemma match_pre_merge_1 :
 forall (l : list A) (p1 p2 : pre l),
 wellpre p1 -> wellpre p2 -> match_pre (merge_pre p1 p2) p1.
 intros l p1 p2; unfold wellpre, merge_pre in |- *; intros;
  apply match_pre_mergex_1; auto.
Defined.

End WellMixed.
