Add LoadPath "..".
Require Import ZF.

(* Cardinal ordering *)

Definition le_card (x y:set) : Prop :=
  exists2 R : set -> set -> Prop,
    Proper (eq_set ==> eq_set ==> iff) R &
    (forall x', x' ∈ x -> exists2 y', y' ∈ y & R x' y') /\
    (forall x1 y1 x2 y2, x1 ∈ x -> x2 ∈ x -> y1 ∈ y -> y2 ∈ y ->
     R x1 y1 -> R x2 y2 -> y1 == y2 -> x1 == x2).

Instance le_card_morph : Proper (eq_set ==> eq_set ==> iff) le_card.
split; destruct 1.
 destruct H2.
 exists x1; trivial; split; intros.
  rewrite <- H in H4.
  elim H2 with x'; intros; trivial.
  exists x2; trivial.
  rewrite <- H0; trivial.

  rewrite <- H in H4,H5|-.
  rewrite <- H0 in H6,H7|-.
  eauto.

 destruct H2.
 exists x1; trivial; split; intros.
  rewrite H in H4.
  elim H2 with x'; intros; trivial.
  exists x2; trivial.
  rewrite H0; trivial.

  rewrite H in H4,H5|-.
  rewrite H0 in H6,H7|-.
  eauto.
Qed.

Instance le_card_refl : Reflexive le_card.
exists (fun x' y' => x' == y').
 do 3 red; intros.
 rewrite H; rewrite H0; reflexivity.

 split; intros.
  exists x'; trivial; reflexivity.

  rewrite H3; rewrite H4; trivial.
Qed.

Instance le_card_trans : Transitive le_card.
red.
destruct 1 as (R,Rm,(incl,inj));
destruct 1 as (R',R'm,(incl',inj')).
exists (fun x' z' => exists2 y', y' ∈ y & R x' y' /\ R' y' z'); [|split;intros].
 do 3 red; intros.
 apply ex2_morph.
  red; reflexivity.

  red; intros.
  rewrite H; rewrite H0; reflexivity.

 elim incl with x'; trivial; intros.
 elim incl' with x0; trivial; intros.
 exists x1; trivial.
 exists x0; auto.

 destruct H3 as (y1',in1,(r1,r1'));
   destruct H4 as (y2',in2,(r2,r2')).
 eauto.
Qed.

Definition lt_card x y :=
  ~ le_card y x.

Lemma incl_le_card : forall x y, x ⊆ y -> le_card x y.
intros.
exists (fun x y => x == y); [|split;intros].
 do 3 red; intros.
 rewrite H0; rewrite H1; reflexivity.

 exists x'; auto.
 reflexivity.

 rewrite H4; rewrite H5; trivial.
Qed.

Lemma cantor_le : forall x, lt_card x (power x).
red; red; intros.
destruct H as (R,Rm,(incl,Rfun)).
pose (D := subset x (fun x' => forall x'' z, z ∈ power x ->
             x'' == x' -> R z x'' -> ~ x'' ∈ z)).
assert (D ∈ power x).
 apply power_intro; intros.
 unfold D in H.
 apply subset_elim1 with (1:=H).
elim incl with D; trivial; intros d in_d rel_d.
assert (~ d ∈ D).
 red; intros.
 unfold D in H0.
 elim subset_elim2 with (1:=H0); intros.
 apply H2 with d D; trivial.
apply H0.
unfold D; apply subset_intro; trivial.
intros.
rewrite H2.
assert (z == D).
 apply Rfun with x'' d; auto.
 rewrite H2; trivial.
rewrite H4; trivial.
Qed.

Lemma discr_power : forall x, ~ x == power x.
red; intros.
apply cantor_le with x.
rewrite <- H.
reflexivity.
Qed.

(* Same cardinality *)

Definition equi_card (x y:set) : Prop :=
  exists2 R : set -> set -> Prop,
    Proper (eq_set ==> eq_set ==> iff) R &
    (forall x', x' ∈ x -> exists2 y', y' ∈ y & R x' y') /\
    (forall y', y' ∈ y -> exists2 x', x' ∈ x & R x' y') /\
    (forall x1 y1 x2 y2, x1 ∈ x -> x2 ∈ x -> y1 ∈ y -> y2 ∈ y ->
     R x1 y1 -> R x2 y2 -> (x1 == x2 <-> y1 == y2)).

Instance equi_card_morph : Proper (eq_set ==> eq_set ==> iff) equi_card.
apply morph_impl_iff2; auto with *.
unfold equi_card; do 4 red; intros.
destruct H1 as (R,Rm,(incl1,(incl2,bij))).
exists R; [trivial|split;[|split]]; intros.
 rewrite <- H in H1.
 destruct (incl1 x'); trivial.
 rewrite H0 in H2.
 exists x1; trivial.

 rewrite <- H0 in H1.
 destruct (incl2 y'); trivial.
 rewrite H in H2.
 exists x1; trivial.

 rewrite <- H in H1,H2.
 rewrite <- H0 in H3,H4.
 auto.
Qed.

Instance equi_card_refl : Reflexive equi_card.
exists (fun x' y' => x' == y').
 do 3 red; intros.
 rewrite H; rewrite H0; reflexivity.

 split; [|split]; intros.
  exists x'; trivial; reflexivity.
  exists y'; trivial; reflexivity.
  rewrite H3; rewrite H4; reflexivity.
Qed.

Instance equi_card_sym : Symmetric equi_card.
red; destruct 1 as (R,Rm,(incl1,(incl2,bij))).
exists (fun x' y' => R y' x'); intros; auto.
 do 3 red; intros; apply Rm; trivial.

 split;[|split]; trivial.
 symmetry; auto.
Qed.

Instance equi_card_trans : Transitive equi_card.
red.
destruct 1 as (R,Rm,(incl1,(incl2,bij)));
destruct 1 as (R',R'm,(incl1',(incl2',bij'))).
exists (fun x' z' => exists2 y', y' ∈ y & R x' y' /\ R' y' z').
 do 3 red; intros.
 apply ex2_morph.
  red; reflexivity.

  red; intros.
  rewrite H; rewrite H0; reflexivity.

 split; [|split]; intros.
  elim incl1 with x'; trivial; intros.
  elim incl1' with x0; trivial; intros.
  exists x1; trivial.
  exists x0; auto.

  elim incl2' with y'; trivial; intros.
  elim incl2 with x0; trivial; intros.
  exists x1; trivial.
  exists x0; auto.

  destruct H3 as (y1',in1,(r1,r1'));
    destruct H4 as (y2',in2,(r2,r2')).
  transitivity (y1' == y2'); auto.
Qed.

Lemma equi_card_le : forall x y, equi_card x y -> le_card x y.
destruct 1 as (R,Rm,(incl1,(incl2,bij))).
exists R; [trivial|split;intros;auto].
refine (proj2 (bij _ _ _ _ _ _ _ _ H3 H4) H5); trivial.
Qed.

Lemma cantor : forall x, ~ equi_card x (power x).
red; intros; apply (cantor_le x);
apply equi_card_le; apply equi_card_sym; trivial.
Qed.

(* Strict ordering *)

Require Import ZFnats ZFord.

Definition isCard x :=
  isOrd x /\ (forall y, lt y x -> lt_card y x).

Definition regular_card o :=
  forall x F,
  lt_card x o ->
  ext_fun x F ->
  (forall y, y ∈ x -> lt_card (F y) o) ->
  lt_card (sup x F) o.

Definition regular o := forall x F,
  lt_card x o ->
  ext_fun x F ->
  (forall y, y ∈ x -> lt (F y) o) ->
  lt (sup x F) o.

Section RegularRelational.
Import ZFrepl.

Definition regular_rel o := forall x R,
  lt_card x o ->
  repl_rel x R ->
  (forall y z, y ∈ x -> R y z -> lt z o) ->
  lt (union (repl x R)) o.

Lemma regular_weaker : forall o,
  regular_rel o -> regular o.
red; intros.
change (sup x F) with (union (repl x (fun x y => y == F x))).
apply H; intros; auto.
 apply repl_rel_fun; trivial.

 rewrite H4; auto.
Qed.

End RegularRelational.

(* regular' -> regular ?
   (not converse: w+w is regular but nor regular') *)
Definition regular' o := forall x F,
  lt x o ->
  ext_fun x F ->
  (forall y, y ∈ x -> lt (F y) o) ->
  lt (sup x F) o.

Definition stronglyInaccessibleCard o :=
  limitOrd o /\ regular o.
(* limitOrd or limit *cardinal* ? *)

(* any functional relation from a to b cannot be surjective *)
Definition lt_card2 a b :=
  forall R:set->set->Prop,
  (forall x x' y y', x ∈ a -> y ∈ b -> y' ∈ b ->
   R x y -> R x' y' -> x==x' -> y==y') ->
  exists2 y, y ∈ b & forall x, x ∈ a -> ~ R x y.

Lemma lt_card_weaker : forall a b,
  lt_card2 a b -> lt_card a b.
red; red; intros.
destruct H0 as (R,?,(?,?)).
destruct (H (fun x y => R y x)).
 intros.
 apply H2 with x x'; trivial.
 rewrite <- H8; trivial.

 destruct H1 with x; trivial.
 eapply H4; eauto.
Qed.

(* Hartog numbers *)

Require Import ZFrelations.

Require Import Relations.

(*

Section Inverse_Image.

  Variables (A B : Type) (R : B -> B -> Prop) (f : A -> B).

  Definition Rof (x y : A) : Prop := R (f x) (f y).

  Remark ACC_lemma :
   forall y : B, Acc R y -> forall x : A, y = f x -> Acc Rof x.
    simple induction 1; intros.
    constructor; intros.
    apply (H1 (f y0)); trivial.
    elim H2 using eq_ind_r; trivial.
    Qed.

  Lemma ACC_inverse_image : forall x : A, Acc R (f x) -> Acc Rof x.
    intros; apply (ACC_lemma (f x)); trivial.
    Qed.

  Lemma WF_inverse_image : well_founded R -> well_founded Rof.
    red in |- *; intros; apply ACC_inverse_image; auto.
    Qed.

End Inverse_Image.

Section Burali_Forti_Paradox.

  Definition morphism (A : Type) (R : A -> A -> Prop)
    (B : Type) (S : B -> B -> Prop) (f : A -> B) :=
    forall x y : A, R x y -> S (f x) (f y).

  (* The hypothesis of the paradox:
     assumes there exists an universal system of notations, i.e:
      - A type A0
      - An injection i0 from relations on any type into A0
      - The proof that i0 is injective modulo morphism
   *)
  Variable A0 : Type.                     (* Type_i *)
  Variable i0 : forall X : Type, (X -> X -> Prop) -> A0. (* X: Type_j *)
  Hypothesis
    inj :
      forall (X1 : Type) (R1 : X1 -> X1 -> Prop) (X2 : Type)
        (R2 : X2 -> X2 -> Prop),
      i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f.

  (* Embedding of x in y: x and y are images of 2 well founded relations
     R1 and R2, the ordinal of R2 being strictly greater than that of R1.
   *)
  Record emb (x y : A0) : Prop :=
    {X1 : Type;
     R1 : X1 -> X1 -> Prop;
     eqx : x = i0 X1 R1;
     X2 : Type;
     R2 : X2 -> X2 -> Prop;
     eqy : y = i0 X2 R2;
     W2 : well_founded R2;
     f : X1 -> X2;
     fmorph : morphism X1 R1 X2 R2 f;
     maj : X2;
     majf : forall z : X1, R2 (f z) maj}.

  Lemma emb_trans : forall x y z : A0, emb x y -> emb y z -> emb x z.
intros.
case H; intros.
case H0; intros.
generalize eqx0; clear eqx0.
elim eqy using eq_ind_r; intro.
case (inj _ _ _ _ eqx0); intros.
exists X1 R1 X3 R3 (fun x : X1 => f0 (x0 (f x))) maj0; trivial.
red in |- *; auto.
Defined.

  Lemma ACC_emb :
   forall (X : Type) (R : X -> X -> Prop) (x : X),
   Acc R x ->
   forall (Y : Type) (S : Y -> Y -> Prop) (f : Y -> X),
   morphism Y S X R f -> (forall y : Y, R (f y) x) -> Acc emb (i0 Y S).
simple induction 1; intros.
constructor; intros.
destruct H4.
rewrite eqx.
destruct (inj X2 R2 Y S).
 symmetry; trivial.

apply H1 with (y := f (x1 maj)) (f := fun x : X1 => f (x1 (f0 x)));
 try red in |- *; auto.
Defined.

  (* The embedding relation is well founded *)
  Lemma WF_emb : well_founded emb.
constructor; intros.
destruct H.
rewrite eqx.
apply ACC_emb with (X := X2) (R := R2) (x := maj) (f := f); trivial.
Defined.

  (* The following definition enforces Type_j >= Type_i *)
  Definition Omega : A0 := i0 A0 emb.

Section Subsets.

  Variable a : A0.

  (* We define the type of elements of A0 smaller than a w.r.t embedding.
     The Record is in Type, but it is possible to avoid such structure. *)
  Record sub : Type :=  {witness : A0; emb_wit : emb witness a}.

  (* F is its image through i0 *)
  Definition F : A0 := i0 sub (Rof _ _ emb witness).

  (* F is embedded in Omega:
     - the witness projection is a morphism
     - a is an upper bound because emb_wit proves that witness is
       smaller than a.
   *)
  Lemma F_emb_Omega : emb F Omega.
exists sub (Rof _ _ emb witness) A0 emb witness a; trivial.
exact WF_emb.

red in |- *; trivial.

exact emb_wit.
Defined.

End Subsets.

  Definition fsub (a b : A0) (H : emb a b) (x : sub a) :
    sub b := Build_sub _ (witness _ x) (emb_trans _ _ _ (emb_wit _ x) H).

  (* F is a morphism: a < b => F(a) < F(b)
      - the morphism from F(a) to F(b) is fsub above
      - the upper bound is a, which is in F(b) since a < b
   *)
  Lemma F_morphism : morphism A0 emb A0 emb F.
red in |- *; intros.
exists
 (sub x)
   (Rof _ _ emb (witness x))
   (sub y)
   (Rof _ _ emb (witness y))
   (fsub x y H)
   (Build_sub _ x H); trivial.
apply WF_inverse_image.
exact WF_emb.

unfold morphism, Rof, fsub in |- *; simpl in |- *; intros.
trivial.

unfold Rof, fsub in |- *; simpl in |- *; intros.
apply emb_wit.
Defined.

  (* Omega is embedded in itself:
     - F is a morphism
     - Omega is an upper bound of the image of F
   *)
  Lemma Omega_refl : emb Omega Omega.
exists A0 emb A0 emb F Omega; trivial.
exact WF_emb.

exact F_morphism.

exact F_emb_Omega.
Defined.

  (* The paradox is that Omega cannot be embedded in itself, since
     the embedding relation is well founded.
   *)
  Theorem Burali_Forti : False.
assert (forall x, Acc emb x -> x <> Omega).
 induction 1.
 red; intros.
 rewrite H1 in H0.
 apply (H0 Omega); trivial.
 apply Omega_refl.
apply (H Omega); trivial.
apply WF_emb.
Defined.

End Burali_Forti_Paradox.

Section S.

  Variable X:set.

  Definition A0 : Type := { x:set | x ∈ X}.

  Definition  i0 : forall X : Type, (X -> X -> Prop) -> A0),
       (forall (X1 : Type) (R1 : X1 -> X1 -> Prop)
          (X2 : Type) (R2 : X2 -> X2 -> Prop),
        i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f) ->
       False

*)
(******************************************************)

Section Hartog.

Variable X:set.
Set Implciit Arguments.

  Record REL A0 : Type := {
    Rel :> A0 -> A0 -> Prop;
    dom : A0 -> Prop;
    wfrel : well_founded Rel
  }.

  Definition morphism A0 (R S : REL A0) (f : A0 -> A0) :=
    (forall x y, dom _ R x -> dom _ R y -> R x y -> S (f x) (f y)) /\
    (forall x, dom _ R x -> dom _ S (f x)).

  Record emb A0 (R1 R2 : REL A0) : Prop := {
     f : A0 -> A0;
     fmorph : morphism _ R1 R2 f;
     maj : A0;
     majd : dom _ R2 maj;
     majf : forall z, dom _ R1 z -> R2 (f z) maj}.

  Parameter WF_emb : forall A0, well_founded (emb A0).

  Definition emb0 A0 i0 (x y:A0) :=
    exists2 R1, x = i0 R1 & exists2 R2, y = i0 R2 & emb A0 R1 R2.

  Parameter WF_emb0 : forall A0 i0, well_founded (emb0 A0 i0).

  Definition Emb A0 i0 (P:A0->Prop) : REL A0 :=
     Build_REL _ (emb0 A0 i0) P (WF_emb0 A0 i0).

Parameter Burali_Forti
     : forall (A0 : Type) (i0 : REL A0 -> A0),
       (forall R1 R2 : REL A0,
        i0 R1 = i0 R2 -> exists f : A0 -> A0, morphism A0 R1 R2 f) -> False.

(*
Record iso_rel R o f := {
  rel_ord : isOrd o;
  fun_ty : forall x, f x ∈ o;
  surj : forall y, y ∈ o -> exists x, f x == y;
  equiv : forall x y, rel_app R x y <-> f x ∈ f y
}.

Definition wo := subset (ZFrelations.rel X X)
  (fun R => exists o, exists2 f, ext_fun X f & iso_rel R o f).

Definition hartog := repl wo (fun R => uchoice (fun o => exists2 f, ext_fun X f & iso_rel R o f)).

Hypothesis inj : set -> set.
Hypothesis is_inj : forall o, o ∈ hartog

Require Import Plump.

Definition isWellOrder R := forall x, isWO set (rel_app R) x.

Instance isWo_morph : Proper (eq_set==>iff) isWellOrder.
Admitted.

Instance R_app_morph : forall R, Proper (eq_set ==> eq_set ==> iff) (rel_app R).
do 3 red; intros.
rewrite H; rewrite H0; reflexivity.
Qed.

Definition order_type_assign_rel R a o :=
  forall P,
  Proper (eq_set ==> eq_set ==> iff) P ->
  (forall x f,
   let x' := subset X (fun y => rel_app R y x) in
   ext_fun x' f ->
   (forall y, rel_app R y x -> P y (f y)) ->
   P x (replf x' f)) ->
  P a o.

Instance order_type_assign_ext :
  Proper (eq_set==>eq_set==>eq_set==>iff) order_type_assign_rel.
Admitted.

Lemma order_type_assign_rel_inv : forall r a x,
  order_type_assign_rel r a x ->
  exists2 f,
    forall b, rel_app r b a -> order_type_assign_rel r b (f b) &
    let a' := subset X (fun b => rel_app r b a) in
    ext_fun a' f /\ x == replf a' f.
intros.
apply H; intros.
 apply morph_impl_iff2; auto with *.
 do 4 red; intros.
 destruct H2.
 exists x2; intros.
  rewrite <- H0 in H4; auto.

  destruct H3; split.
   do 2 red; intros; apply H3; auto.
   apply subset_intro.
    apply subset_elim1 in H5; trivial.

    apply subset_elim2 in H5; destruct H5.
    rewrite H5; rewrite H0; trivial.

   rewrite<- H1; rewrite H4.
   apply replf_morph; trivial.
   apply subset_morph; auto with *.
   red; intros.
   rewrite H0; auto with *.

 exists f; intros.
 2:split; [trivial|reflexivity].
 red; intros.
 destruct H1 with b; trivial.
 destruct H6.
 rewrite H7.
 apply H4; intros; trivial.
 apply H5; trivial.
Qed.

Require Import ZFrepl.

Lemma order_type_assign_uchoice : forall R a,
  isWellOrder R ->
  uchoice_pred (order_type_assign_rel R a).
intros.
red in H.
apply isWO_ind with (E:=eq_set) (4:=H a); intros; auto with *.
split;[|split]; intros.
 rewrite <- H3; trivial.

 exists (replf (subset X (fun z => rel_app R z y))
            (fun z => uchoice (order_type_assign_rel R z))).
 red; intros.
 apply H4; intros.
  do 2 red; intros.
  apply uchoice_morph_raw.
  red; intros.
  rewrite H6; rewrite H7; reflexivity.

  apply (uchoice_def _ (H2 _ H5)); trivial.

 clear a H1.
 revert x' H2 H4.
 apply H3; intros.
  apply morph_impl_iff2; auto with *.
  do 4 red; intros.
  rewrite <- H2; apply H4; intros.
   apply H5.
   rewrite <- H1; trivial.

   rewrite H1; trivial.

  clear x H3.
  destruct order_type_assign_rel_inv with (1:=H5) as (f',?,(_,?)).
  rewrite H6.
  apply replf_morph.
   apply subset_morph; auto with *.

   red; intros.
   apply H2; intros; auto.
    apply subset_elim2 in H7; destruct H7.
    rewrite H7; trivial.

    apply H4.
    eapply isWO_trans with eq_set x; auto with *.
    apply subset_elim2 in H7; destruct H7.
    rewrite H7; trivial.

    rewrite H8.
    apply H3.
    rewrite <- H8.
    apply subset_elim2 in H7; destruct H7.
    rewrite H7; trivial.
Qed.

Lemma order_type_assign_ord : forall R a o,
  isWO set (rel_app R) a ->
  order_type_assign_rel R a o ->
  isOrd o.
intros.
revert o H0.
apply isWO_ind with (E:=eq_set) (4:=H); intros; auto with *.
apply isOrd_intro; intros.
apply order_type_assign_rel_inv in H3; trivial.
destruct H3 as (f,?,(?,?)).
rewrite H8 in H6|-*; clear o H8.
 apply replf_elim in H6; trivial; destruct H6.
 rewrite H8 in H5; clear b H8.
 rewrite subset_ax in H6.
 destruct H6 as (?,(x',?,?)).
 rewrite <- H8 in H9; clear x' H8.
 assert (exists2 w, I set (rel_app R) w x & a0 == f w).
  exists (subset X (fun x'
  exists (subset X (fun x' => rel_app R x' x /\ exists2 w, w ∈ a0 & order_type_assign_rel R x' w)).
   red; intros.
   apply isWO_plump with

  admit.
 destruct H8 as (w,?,?).
 assert (rel_app R w y).
  apply isWO_plump with eq_set x; auto with *.
  admit. (* w isWO *)
 apply replf_intro with w; auto.
 apply subset_intro; trivial.
 admit. (* w in X *)

  apply H3 in H11.

 exists

 =

red in H.
pattern a, o; apply H.
 do 3 red; intros.
 rewrite H1; reflexivity.

 intros.
 apply isOrd_intro; intros.
 apply replf_elim in H4; trivial.
 destruct H4.

 apply isOrd_supf; intros.
  do 2 red; intros.
  apply osucc_morph; apply H0; trivial.

  apply subset_elim2 in H2; destruct H2.
  rewrite <- H2 in H3; auto.
Qed.

*)

Definition order_type_assign_rel R a o :=
  forall P,
  Proper (eq_set ==> eq_set ==> iff) P ->
  (forall x f,
   let x' := subset X (fun y => rel_app R y x) in
   ext_fun x' f ->
   (forall y, rel_app R y x -> P y (f y)) ->
   P x (osup x' (fun y => osucc (f y)))) ->
  P a o.

Instance order_type_assign_ext :
  Proper (eq_set==>eq_set==>eq_set==>iff) order_type_assign_rel.
Admitted.

Lemma order_type_assign_rel_inv : forall r a x,
  order_type_assign_rel r a x ->
  exists2 f,
    forall b, rel_app r b a -> order_type_assign_rel r b (f b) &
    let a' := subset X (fun b => rel_app r b a) in
    ext_fun a' f /\ x == osup a' (fun y => osucc (f y)).
intros.
apply H; intros.
 apply morph_impl_iff2; auto with *.
 do 4 red; intros.
 destruct H2.
 exists x2; intros.
  rewrite <- H0 in H4; auto.

  destruct H3; split.
   do 2 red; intros; apply H3; auto.
   apply subset_intro.
    apply subset_elim1 in H5; trivial.

    apply subset_elim2 in H5; destruct H5.
    rewrite H5; rewrite H0; trivial.

   rewrite<- H1; rewrite H4.
   apply osup_morph; auto.
    apply subset_morph; auto with *.
    red; intros.
    rewrite H0; auto with *.

    red; intros.
    apply osucc_morph.
    apply H3; trivial.

 exists f; intros.
 2:split; [trivial|reflexivity].
 red; intros.
 destruct H1 with b; trivial.
 destruct H6.
 rewrite H7.
 apply H4; intros; trivial.
 apply H5; trivial.
Qed.

Require Import ZFrepl.

Require Import Relations.

Definition isWellOrder R :=
  forall x, Acc (rel_app R) x.

Instance isWO_m : Proper (eq_set ==> iff) isWellOrder.
Admitted.

Lemma order_type_assign_uchoice : forall R a,
  isWellOrder R ->
  uchoice_pred (order_type_assign_rel R a).
intros.
elim (H a); intros.
split;[|split]; intros.
 rewrite <- H2; trivial.

 exists (osup (subset X (fun z => rel_app R z x))
            (fun z => osucc (uchoice (order_type_assign_rel R z)))).
 red; intros.
 apply H3; intros.
  do 2 red; intros.
  apply uchoice_morph_raw.
  red; intros.
  rewrite H5; rewrite H6; reflexivity.

  apply (uchoice_def _ (H1 _ H4)); trivial.

 clear a.
 revert x' H1 H3.
 apply H2; intros.
  apply morph_impl_iff2; auto with *.
  do 4 red; intros.
  rewrite <- H3; apply H4; intros.
   apply H5.
   rewrite <- H1; trivial.

   rewrite H1; trivial.

  destruct order_type_assign_rel_inv with (1:=H5) as (f',?,(_,?)).
  rewrite H7.
  apply osup_morph.
   apply subset_morph; auto with *.

   red; intros.
   apply osucc_morph.
   apply H3; intros; auto.
    apply subset_elim2 in H8; destruct H8.
    rewrite H8; trivial.

    apply H4.
    admit. (* R trans... *)
(*    eapply isWO_trans with eq_set x; auto with *.
    apply subset_elim2 in H7; destruct H7.
    rewrite H7; trivial.
*)
    rewrite H9.
    apply H6.
    rewrite <- H9.
    apply subset_elim2 in H8; destruct H8.
    rewrite H8; trivial.
Qed.

Lemma order_type_assign_rel_inv' : forall r a,
  isWellOrder r ->
  uchoice (order_type_assign_rel r a) ==
  osup (subset X (fun b => rel_app r b a))
    (fun b => osucc (uchoice (order_type_assign_rel r b))).
intros.
generalize (uchoice_def _ (order_type_assign_uchoice _ a H)); intro.
apply order_type_assign_rel_inv in H0; destruct H0.
destruct H1.
rewrite H2.
apply osup_morph; auto with *.
red; intros.
apply osucc_morph.
rewrite (H1 x0 x'); trivial.
rewrite H4 in H3; clear x0 H4.
apply subset_elim2 in H3; destruct H3.
rewrite <- H3 in H4 ;clear x0 H3.
apply H0 in H4.
apply uchoice_ext; trivial.
apply order_type_assign_uchoice; trivial.
Qed.

Lemma order_type_assign_ord : forall R a o,
  order_type_assign_rel R a o ->
  isOrd o.
intros.
red in H.
pattern a, o; apply H.
 do 3 red; intros.
 rewrite H1; reflexivity.

 intros.
 apply isOrd_osup; intros.
  do 2 red; intros.
  apply osucc_morph; apply H0; trivial.

  apply subset_elim2 in H2; destruct H2.
  rewrite <- H2 in H3; auto.
Qed.

Definition order_type R :=
  osup X (fun a => osucc (uchoice (order_type_assign_rel R a))).

Lemma ot_ext : forall x x',
  x == x' ->
  eq_fun X
    (fun a => osucc (uchoice (order_type_assign_rel x a)))
    (fun a => osucc (uchoice (order_type_assign_rel x' a))).
red; intros.
apply osucc_morph.
apply uchoice_morph_raw.
apply order_type_assign_ext; auto with *.
Qed.

Instance order_type_ext : morph1 order_type.
unfold order_type.
do 2 red; intros.
apply osup_morph; auto with *.
apply ot_ext; trivial.
Qed.

Definition wo := subset (rel X X) isWellOrder.

Lemma wo_def2 : forall r, r ∈ wo -> isWellOrder r.
intros.
apply subset_elim2 in H; destruct H.
rewrite H; trivial.
Qed.
Hint Resolve wo_def2.

(*
Lemma order_type_assign_rel_inv2 : forall r a x y,
  isWellOrder r ->
  a ∈ X ->
  order_type_assign_rel r a x ->
  y ∈ x ->
  exists2 b, rel_app r b a & order_type_assign_rel r b y.
intros.
destruct order_type_assign_rel_inv with (1:=H1) as (f,fsub,(extf,eqx)).
rewrite eqx in H2.
rewrite sup_ax in H2; trivial.
destruct H2.
exists x0.
 apply subset_elim2 in H2; destruct H2.
 rewrite H2; trivial.
Admitted.
*)

Definition hartog_succ :=
  osup wo order_type.

Lemma isOrd_hartog : isOrd hartog_succ.
unfold hartog_succ.
apply isOrd_osup.
 do 2 red; intros.
 rewrite H0; reflexivity.

 intros.
 unfold order_type.
 apply isOrd_osup.
  red; apply ot_ext; reflexivity.

  intros.
  apply wo_def2 in H.
  generalize (uchoice_def _ (order_type_assign_uchoice _ x0 H)).
  intros.
  apply isOrd_succ.
  apply order_type_assign_ord with (1:=H1).
Qed.

(*
Lemma order_type_assign_rel_inv2 : forall r x,
  isWellOrder r ->
  x ∈ order_type r ->
  forall y, isOrd y ->
  y ⊆ x ->
  exists r', y == order_type r'.
intros r x wor otr.
intros.
unfold order_type in otr.
rewrite sup_ax in otr;[|admit].
destruct otr as (a,aX,aass).
set (w := uchoice (order_type_assign_rel r a)) in *.
pose (r' :=fun a b =>
  uchoice (order_type_assign_rel r a) ∈
  uchoice (order_type_assign_rel r b) /\
  uchoice (order_type_assign_rel r b) ⊆ w).
exists (inject_rel r' X X).
unfold order_type.
apply eq_intro; intros.
 rewrite sup_ax;[|admit].
 admit.

(*
 assert (Hrec : forall x', lt x' x ->
  forall y', isOrd y' -> y' ⊆ x' ->
  sup X (fun a => osucc (uchoice (order_type_assign_rel (inject_rel r') X X) a)) ⊆
  y' *)
 rewrite sup_ax in H1;[|admit].
 destruct H1 as (b,bX,bass).
 apply isOrd_plump with (uchoice (order_type_assign_rel (inject_rel r' X X) b)); trivial.
  admit.

  apply olts_le in bass; trivial.

  .
 apply olts_le in bass.

assert (xord : isOrd x).
 admit.
induction xord using isOrd_ind; intros.

Lemma order_type_assign_rel_inv2 : forall r a x y,
  isWellOrder r ->
  a ∈ X ->
  order_type_assign_rel r a x ->
  y ∈ x ->
  exists2 b, rel_app r b a & order_type_assign_rel r b y.
intros.
assert (rplump :
  forall x y z, x ∈ X -> (forall z, rel_app r z x -> rel_app r z y) ->
  rel_app r y z -> rel_app r x z).
 admit.
assert (rtrans : forall x y z, rel_app r x y -> rel_app r y z -> rel_app r x z).
 admit.
assert (rext : forall x y, (forall z, rel_app r z x <-> rel_app r z y) -> x == y).
 admit.
assert (rty : forall a b, rel_app r a b -> a ∈ X).
 admit.
assert (xord : isOrd x).
 apply order_type_assign_ord in H1; trivial.
revert a y H0 H1 H2.
induction xord using isOrd_ind; intros.
destruct order_type_assign_rel_inv with (1:=H3) as (f,fsub,(extf,eqx)).
rewrite eqx in H4.
rewrite sup_ax in H4; trivial.
2:admit.
destruct H4 as (b,bX,?).
assert (rel_app r b a).
 apply subset_elim2 in bX; destruct bX.
 rewrite H5; trivial.
clear bX.
pose (bs := fun b' => b' ∈ X /\ forall z, rel_app r z b' <-> rel_app r z b /\ f z ∈ y0).
assert (bs (uchoice bs)).
 apply uchoice_def.
 split;[|split];intros.
  destruct H7; split; intros; rewrite <- H6; trivial.

  admit. (* ex *)

  red in H6,H7.
  apply rext.
  intro.
  rewrite (proj2 H6).
  rewrite (proj2 H7).
  reflexivity.

destruct H6 as (inX,H6).
assert (rel_app r (uchoice bs) a).
 apply rplump with b; trivial.
 intros.
 rewrite H6 in H7; destruct H7; trivial.
exists (uchoice bs); trivial.

assert (y0 == f (uchoice bs)).
 apply eq_intro; intros.

elim H1 with (f b) b z; auto; intros.
 assert (z == f x0).
  destruct (order_type_assign_uchoice _ x0 H) as (_,(_,?)).
  apply H11; trivial.
  apply fsub.
  apply rtrans with b; trivial.
 assert (rel_app r x0 (uchoice bs)).
  rewrite H6.
  split; trivial.
  rewrite <- H11; trivial.
 specialize fsub with (1:=H7).
 apply order_type_assign_rel_inv in fsub; destruct fsub.
 destruct H14.
 rewrite H15.
 rewrite sup_ax.
 2:admit.
 exists x0.
  apply subset_intro; eauto.

  assert (z == x1 x0).
   apply H13 in H12.
   destruct (order_type_assign_uchoice _ x0 H) as (_,(_,?)).
   auto.
  rewrite H16; apply lt_osucc.
  apply H13 in H12.
  apply order_type_assign_ord in H12; trivial.

 rewrite eqx.
 rewrite sup_ax.
 2:admit.
 exists b.
  apply subset_intro; eauto.
 apply lt_osucc.
 apply fsub in H5; apply order_type_assign_ord in H5; trivial.
 eauto.

 apply olts_le in H4; apply H4 in H8; trivial.

elim H1 with (f (uchoice bs)) (uchoice bs) z; auto; intros.
assert (z == f x0).
  destruct (order_type_assign_uchoice _ x0 H) as (_,(_,?)).
  apply H11; trivial.
  apply fsub.
  apply rtrans with (uchoice bs); trivial.
 rewrite H11.
 apply -> H6; trivial.

 rewrite eqx.
 rewrite sup_ax.
 2:admit.
 exists (uchoice bs).
  apply subset_intro; eauto.
  apply lt_osucc.
  apply fsub in H7.
  apply order_type_assign_ord in H7; trivial.

 eauto.

rewrite H8.
auto.
Qed.
*)

Lemma hartog_assign_surj : forall x,
  x ∈ hartog_succ ->
  exists2 R, R ∈ wo &
   forall y, y ∈ x -> exists2 b, b ∈ X & order_type_assign_rel R b y.
Admitted.
(*
Lemma hartog_surj : forall x,
  x ∈ hartog_succ ->
  exists2 R, R ∈ wo & order_type R == x.
intros.
destruct hartog_assign_surj with (1:=H) as (R,woR,assR).
exists R; trivial.

   forall y, y ∈ x -> exists2 b, b ∈ X & order_type_assign_rel R b y.

intros.
assert (xord : isOrd x).
 apply isOrd_inv with hartog_succ; trivial.
 apply isOrd_hartog.
unfold hartog_succ in H; rewrite sup_ax in H.
2:admit.
destruct H as (R,Rwo,otr).
unfold order_type in otr.
rewrite sup_ax in otr.
2:apply ot_ext; reflexivity.
destruct otr as (a,aX,xass).
apply olts_le in xass.

rewrite order_type_assign_rel_inv' in xass; auto.
assert (forall y, y ∈ x ->
  exists2 b, rel_app R b a & y ∈ osucc (uchoice (order_type_assign_rel R b))).
 intros.
 apply xass in H.
 rewrite sup_ax in H.
 2:admit.
 destruct H.
 exists x0; trivial.
 apply subset_elim2 in H; destruct H.
 rewrite H; trivial.
clear xass.
admit.
Qed.
*)

Section BuraliForti.

Variable I : set -> set -> Prop.
Hypothesis ty_I : forall x,
  x ∈ hartog_succ -> exists2 y, y ∈ X & I x y.
Hypothesis inj_I : forall x1 y1 x2 y2,
  x1 ∈ hartog_succ ->
  x2 ∈ hartog_succ ->
  y1 ∈ X ->
  y2 ∈ X ->
  I x1 y1 ->
  I x2 y2 ->
  y1 == y2 -> x1 == x2.

  Definition OT R :=
    order_type (inject_rel (fun x y => dom _ R x /\ dom _ R y /\ R x y) X X).

  Parameter OT_inj : forall (R1 R2:REL set),
    (forall x, dom _ R1 x -> x ∈ X) ->
    (forall x, dom _ R2 x -> x ∈ X) ->
    OT R1 ⊆ OT R2 -> exists f, morphism _ R1 R2 f.

  Lemma burali_forti : False.
generalize ty_I inj_I.
admit.
Qed.

End BuraliForti.

(*
Lemma hartog_succ_card : lt_card X hartog_succ.
do 2 red; destruct 1.
apply burali_forti with x; trivial.
Qed.

Lemma hartog_bound :
  forall F,
  ext_fun X F ->
  (forall n, n ∈ X -> lt (F n) hartog_succ) ->
  lt (sup X F) hartog_succ.
Admitted.
*)
(*
Lemma inj :
  order_type R1 ⊆ order_type R2 ->
  exists f, morphism R1 R2 f.
*)
(*
Lemma isCard_hartog : isCard hartog_succ.
split; intros.
 apply isOrd_hartog.

 do 2 red; destruct 1 as (R,tyR,injR).  (* R : h -> y *)
 unfold hartog_succ in H; rewrite sup_ax in H.
 2:admit.
 destruct H as (r,wfr,otr).
 unfold order_type in otr; rewrite sup_ax in otr.
 2:admit.
 destruct otr as (a,aX,a_ass).
 rewrite order_type_assign_rel_inv' in a_ass.
 apply olts_le in a_ass.
 apply burali_forti with (fun o a =>
   exists2 w, R o w /\ w ∈ y &

 rewrite uchoice_ax in a_ass.
 2:apply order_type_assign_uchoice; auto.
 destruct a_ass as (z, zass, zlty).
 apply burali_forti with (fun o a => exists2 w, R o w /\ w ∈ y & order_type_assign_rel r a w); intros.
  elim tyR with x; trivial; intros.

destruct order_type_assign_rel_inv with (1:=zass).
destruct H3.

  assert (exists2 b, rel_app r b a & order_type_assign_rel r b x0).
   apply order_type_assign_rel_inv with z; auto.
   apply isOrd_trans with y; trivial.
   apply order_type_assign_ord with (1:=zass).
  destruct H2 as (b,bRa,b_ass).
  exists b.
   apply app_typ1 with (1:=subset_elim1 _ _ _ wfr) (2:=bRa).

   exists x0; auto.

  destruct H3 as (w1,(rw1,w1y),ass1); destruct H4 as (w2,(rw2,w2y),ass2).
  assert (w1==w2).
   assert (isWellOrder r).
    apply subset_elim2 in wfr; destruct wfr.
    rewrite H3; trivial.
   destruct (order_type_assign_uchoice _ _ H3 H1) as (_,(_,uniq)).
   rewrite <- H5 in ass2; auto.
  apply injR with w1 w2; auto.
Qed.

End Hartog.

(*
Section Burali_Forti_Paradox.

  Definition morphism A (R : A -> A -> Prop) B (S : B -> B -> Prop) f :=
    forall x y, R x y -> S (f x) (f y).

  Variable A0 : Type.                             (* Type_i *)
  Variable i0 : forall X, (X -> X -> Prop) -> A0. (* X: Type_j *)
  Hypothesis inj : forall X1 R1 X2 R2,
    i0 X1 R1 = i0 X2 R2 -> exists f, morphism X1 R1 X2 R2 f.

  Record emb x y : Prop :=
    {X1 : Type;
     R1 : X1 -> X1 -> Prop;
     eqx : x = i0 X1 R1;
     X2 : Type;
     R2 : X2 -> X2 -> Prop;
     eqy : y = i0 X2 R2;
     W2 : WF X2 R2;
     f : X1 -> X2;
     fmorph : morphism X1 R1 X2 R2 f;
     maj : X2;
     majf : forall z, R2 (f z) maj}.

  Lemma emb_trans : forall x y z, emb x y -> emb y z -> emb x z.

  Lemma ACC_emb : forall X R x,
   ACC X R x ->
   forall Y S f,
   morphism Y S X R f ->
   (forall y, R (f y) x) ->
   ACC A0 emb (i0 Y S).

  Lemma WF_emb : WF A0 emb.

  Definition Omega : A0 := i0 A0 emb.

Section Subsets.

  Variable a : A0.

  (* We define the type of elements of A0 smaller than a w.r.t embedding.
     The Record is in Type, but it is possible to avoid such structure. *)
  Record sub : Type :=  {witness : A0; emb_wit : emb witness a}.

  (* F is its image through i0 *)
  Definition F : A0 := i0 sub (Rof _ _ emb witness).

  Lemma F_emb_Omega : emb F Omega.

End Subsets.

  Definition fsub a b (H : emb a b) (x : sub a) : sub b :=
    Build_sub _ (witness _ x) (emb_trans _ _ _ (emb_wit _ x) H).

  (* F is a morphism: a < b => F(a) < F(b)
      - the morphism from F(a) to F(b) is fsub above
      - the upper bound is a, which is in F(b) since a < b
   *)
  Lemma F_morphism : morphism A0 emb A0 emb F.
red in |- *; intros.
exists
 (sub x)
   (Rof _ _ emb (witness x))
   (sub y)
   (Rof _ _ emb (witness y))
   (fsub x y H)
   (Build_sub _ x H); trivial.
Defined.

  Lemma Omega_refl : emb Omega Omega.

  (* The paradox is that Omega cannot be embedded in itself, since
     the embedding relation is well founded.
   *)
  Theorem Burali_Forti : False.
apply ACC_nonreflexive with A0 emb Omega.
apply WF_emb.

exact Omega_refl.
Defined.
*)
End Burali_Forti_Paradox.
*)
End Hartog.


Require Coq.Logic.Classical_Prop.
Require Import ProofCheckingEuclid.euclidean_axioms.
Require Import ProofCheckingEuclid.euclidean_defs.
Require Import ProofCheckingEuclid.euclidean_tactics.
Require Import ProofCheckingEuclid.lemma_NCdistinct.
Require Import ProofCheckingEuclid.lemma_NCorder.
Require Import ProofCheckingEuclid.lemma_betweennotequal.
Require Import ProofCheckingEuclid.lemma_collinear_ABC_ABD_BCD.
Require Import ProofCheckingEuclid.lemma_collinearorder.
Require Import ProofCheckingEuclid.lemma_collinearorder.
Require Import ProofCheckingEuclid.lemma_inequalitysymmetric.
Require Import ProofCheckingEuclid.lemma_s_n_col_ncol.
Require Import ProofCheckingEuclid.lemma_s_ncol_ABD_col_ABC_ncol_ACD.
Require Import ProofCheckingEuclid.lemma_s_ncol_n_col.
Require Import ProofCheckingEuclid.lemma_s_os.

Section Euclid.

Context `{Ax1:euclidean_neutral_ruler_compass}.

Lemma lemma_oppositesidesymmetric :
	forall A B P Q,
	OS P A B Q ->
	OS Q A B P.
Proof.
	intros A B P Q.
	intros OS_P_AB_Q.

	destruct OS_P_AB_Q as (R & BetS_P_R_Q & Col_A_B_R & nCol_A_B_P).

	pose proof (axiom_betweennesssymmetry _ _ _ BetS_P_R_Q) as BetS_Q_R_P.
	pose proof (lemma_betweennotequal _ _ _ BetS_P_R_Q) as (neq_R_Q & _ & _).
	pose proof (lemma_betweennotequal _ _ _ BetS_Q_R_P) as (_ & neq_Q_R & neq_Q_P).

	assert (Col P R Q) as Col_P_R_Q by (unfold Col; one_of_disjunct BetS_P_R_Q).

	pose proof (lemma_collinearorder _ _ _ Col_P_R_Q) as (_ & _ & _ & _ & Col_Q_R_P).
	pose proof (lemma_collinearorder _ _ _ Col_A_B_R) as (_ & _ & _ & _ & Col_R_B_A).

	pose proof (lemma_NCdistinct _ _ _ nCol_A_B_P) as (neq_A_B & _ & _ & _ & _ & _).
	pose proof (lemma_s_ncol_n_col _ _ _ nCol_A_B_P) as n_Col_A_B_P.

	assert (~ Col A B Q) as n_Col_A_B_Q.
	{
		intros Col_A_B_Q.

		pose proof (lemma_collinearorder _ _ _ Col_A_B_Q) as (_ & Col_B_Q_A & _ & _ & _).
		pose proof (lemma_collinear_ABC_ABD_BCD _ _ _ _ Col_A_B_Q Col_A_B_R neq_A_B) as Col_B_Q_R.
		pose proof (lemma_collinearorder _ _ _ Col_B_Q_R) as (_ & Col_Q_R_B & _ & _ & _).
		pose proof (lemma_collinear_ABC_ABD_BCD _ _ _ _ Col_Q_R_B Col_Q_R_P neq_Q_R) as Col_R_B_P.

		assert (Col A P B) as Col_A_P_B.
		assert (eq R B \/ neq R B) as [eq_R_B|neq_R_B] by (apply Classical_Prop.classic).
		{
			(* case eq_R_B *)
			assert (Col P B Q) as Col_P_B_Q by (rewrite <- eq_R_B; exact Col_P_R_Q).
			pose proof (lemma_collinearorder _ _ _ Col_P_B_Q) as (_ & Col_B_Q_P & Col_Q_P_B  & _ & _).

			assert (neq B Q) as neq_B_Q by (rewrite <- eq_R_B; exact neq_R_Q).
			pose proof (lemma_collinear_ABC_ABD_BCD _ _ _ _ Col_B_Q_P Col_B_Q_A neq_B_Q) as Col_Q_P_A.

			pose proof (lemma_collinear_ABC_ABD_BCD _ _ _ _ Col_Q_P_A Col_Q_P_B neq_Q_P) as Col_P_A_B.
			pose proof (lemma_collinearorder _ _ _ Col_P_A_B) as (Col_A_P_B & _ & _ & _ & _).

			exact Col_A_P_B.
		}
		{
			(* case neq_R_B *)
			pose proof (lemma_collinear_ABC_ABD_BCD _ _ _ _ Col_R_B_P Col_R_B_A neq_R_B) as Col_B_P_A.
			pose proof (lemma_collinearorder _ _ _ Col_B_P_A) as (_ & _ & _ & _ & Col_A_P_B).
			exact Col_A_P_B.
		}
		pose proof (lemma_collinearorder _ _ _ Col_A_P_B) as (_ & _ & _ & Col_A_B_P & _).

		contradict Col_A_B_P.
		exact n_Col_A_B_P.
	}
	pose proof (lemma_s_n_col_ncol _ _ _ n_Col_A_B_Q) as nCol_A_B_Q.

	pose proof (lemma_s_os _ _ _ _ _ BetS_Q_R_P Col_A_B_R nCol_A_B_Q) as OS_Q_AB_P.

	exact OS_Q_AB_P.
Qed.

End Euclid.


(** * Poly: Polymorphism and Higher-Order Functions *)

(** In this chapter we continue our development of basic
    concepts of functional programming.  The critical new ideas are
    _polymorphism_ (abstracting functions over the types of the data
    they manipulate) and _higher-order functions_ (treating functions
    as data).
*)

Require Export Lists.

(* ###################################################### *)
(** * Polymorphism *)
(* ###################################################### *)
(** ** Polymorphic Lists *)

(** For the last couple of chapters, we've been working just
    with lists of numbers.  Obviously, interesting programs also need
    to be able to manipulate lists with elements from other types --
    lists of strings, lists of booleans, lists of lists, etc.  We
    _could_ just define a new inductive datatype for each of these,
    for example... *)

Inductive boollist : Type :=
  | bool_nil : boollist
  | bool_cons : bool -> boollist -> boollist.

(** ... but this would quickly become tedious, partly because we
    have to make up different constructor names for each datatype, but
    mostly because we would also need to define new versions of all
    our list manipulating functions ([length], [rev], etc.)  for each
    new datatype definition. *)

(** To avoid all this repetition, Coq supports _polymorphic_
    inductive type definitions.  For example, here is a _polymorphic
    list_ datatype. *)

Inductive list (X:Type) : Type :=
  | nil : list X
  | cons : X -> list X -> list X.

(** This is exactly like the definition of [natlist] from the
    previous chapter, except that the [nat] argument to the [cons]
    constructor has been replaced by an arbitrary type [X], a binding
    for [X] has been added to the header, and the occurrences of
    [natlist] in the types of the constructors have been replaced by
    [list X].  (We can re-use the constructor names [nil] and [cons]
    because the earlier definition of [natlist] was inside of a
    [Module] definition that is now out of scope.) *)

(** What sort of thing is [list] itself?  One good way to think
    about it is that [list] is a _function_ from [Type]s to
    [Inductive] definitions; or, to put it another way, [list] is a
    function from [Type]s to [Type]s.  For any particular type [X],
    the type [list X] is an [Inductive]ly defined set of lists whose
    elements are things of type [X]. *)

(** With this definition, when we use the constructors [nil] and
    [cons] to build lists, we need to tell Coq the type of the
    elements in the lists we are building -- that is, [nil] and [cons]
    are now _polymorphic constructors_.  Observe the types of these
    constructors: *)

Check nil.
(* ===> nil : forall X : Type, list X *)
Check cons.
(* ===> cons : forall X : Type, X -> list X -> list X *)

(** The "[forall X]" in these types can be read as an additional
    argument to the constructors that determines the expected types of
    the arguments that follow.  When [nil] and [cons] are used, these
    arguments are supplied in the same way as the others.  For
    example, the list containing [2] and [1] is written like this: *)

Check (cons nat 2 (cons nat 1 (nil nat))).

(** (We've gone back to writing [nil] and [cons] explicitly here
    because we haven't yet defined the [ [] ] and [::] notations for
    the new version of lists.  We'll do that in a bit.) *)

(** We can now go back and make polymorphic (or "generic")
    versions of all the list-processing functions that we wrote
    before.  Here is [length], for example: *)

Fixpoint length (X:Type) (l:list X) : nat :=
  match l with
  | nil      => 0
  | cons h t => S (length X t)
  end.

(** Note that the uses of [nil] and [cons] in [match] patterns
    do not require any type annotations: Coq already knows that the list
    [l] contains elements of type [X], so there's no reason to include
    [X] in the pattern.  (More precisely, the type [X] is a parameter
    of the whole definition of [list], not of the individual
    constructors.  We'll come back to this point later.)

    As with [nil] and [cons], we can use [length] by applying it first
    to a type and then to its list argument: *)

Example test_length1 :
    length nat (cons nat 1 (cons nat 2 (nil nat))) = 2.
Proof. reflexivity.  Qed.

(** To use our length with other kinds of lists, we simply
    instantiate it with an appropriate type parameter: *)

Example test_length2 :
    length bool (cons bool true (nil bool)) = 1.
Proof. reflexivity.  Qed.

(** Let's close this subsection by re-implementing a few other
    standard list functions on our new polymorphic lists: *)

Fixpoint app (X : Type) (l1 l2 : list X)
                : (list X) :=
  match l1 with
  | nil      => l2
  | cons h t => cons X h (app X t l2)
  end.

Fixpoint snoc (X:Type) (l:list X) (v:X) : (list X) :=
  match l with
  | nil      => cons X v (nil X)
  | cons h t => cons X h (snoc X t v)
  end.

Fixpoint rev (X:Type) (l:list X) : list X :=
  match l with
  | nil      => nil X
  | cons h t => snoc X (rev X t) h
  end.

Example test_rev1 :
    rev nat (cons nat 1 (cons nat 2 (nil nat)))
  = (cons nat 2 (cons nat 1 (nil nat))).
Proof. reflexivity.  Qed.

Example test_rev2:
  rev bool (nil bool) = nil bool.
Proof. reflexivity.  Qed.

Module MumbleBaz.
(** **** Exercise: 2 stars (mumble_grumble) *)
(** Consider the following two inductively defined types. *)

Inductive mumble : Type :=
  | a : mumble
  | b : mumble -> nat -> mumble
  | c : mumble.
Inductive grumble (X:Type) : Type :=
  | d : mumble -> grumble X
  | e : X -> grumble X.

(** Which of the following are well-typed elements of [grumble X] for
    some type [X]?
      - [d (b a 5)]  bad: d needs a type parameter. A good term would be d c. However, (b a 5) is a valid mumble. So the next one is valid:
      - [d mumble (b a 5)] good: this is of type "grumble mumble".
      - [d bool (b a 5)] good: this is of type "grumble bool".
      - [e bool true]  good: this is of type "grumble bool".
      - [e mumble (b c 0)] good: this is of type "grumble mumble".
      - [e bool (b c 0)] bad: "e bool" forces the second argument of e to have type bool, not type mumble. A good term would be e mumble c, for example.
      - [c] good: it has non-polymorhpic type "mumble"
*)
Check d mumble c: grumble mumble.
Check b a 5 : mumble.
Check d mumble (b a 5) : grumble mumble.
Check d bool (b a 5) : grumble bool.
Check e bool true : grumble bool.
Check e mumble (b c 0): grumble mumble.
Check e mumble c: grumble mumble.
Check c : mumble.
(* [] *)

(** **** Exercise: 2 stars (baz_num_elts) *)
(** Consider the following inductive definition: *)

Inductive baz : Type :=
   | x : baz -> baz
   | y : baz -> bool -> baz.

(** How _many_ elements does the type [baz] have? *)
(** None? We can't write any elements at all, because we don't have any constructor that does not already require to have a baz. But we can use the placeholder symbol "_" and coax Coq into accepting _some_ expression as if it were a valid baz: **)
Check x _ : baz.
Check x (x _) : baz.
Check x (y _ true) : baz.
Check y _ _: baz.

(* we can write infinitely many such expressions, but what do they mean??
 We can't really use these expressions much. For instance, this does not work:

Example baz_junk : forall q:bool, y _ q = y _ q.

This is rejected because Coq "can't infer the value of the placeholder".

But we can prove something trivial like this:
*)
Example baz_trivial : forall (b:baz)(q:bool), y b q = y b q.
Proof. reflexivity. Qed.

(* [] *)

End MumbleBaz.

(* ###################################################### *)
(** *** Type Annotation Inference *)

(** Let's write the definition of [app] again, but this time we won't
    specify the types of any of the arguments. Will Coq still accept
    it? *)

Fixpoint app' X l1 l2 : list X :=
  match l1 with
  | nil      => l2
  | cons h t => cons X h (app' X t l2)
  end.

(** Indeed it will.  Let's see what type Coq has assigned to [app']: *)

Check app'.
(* ===> forall X : Type, list X -> list X -> list X *)
Check app.
(* ===> forall X : Type, list X -> list X -> list X *)

(** It has exactly the same type type as [app].  Coq was able to
    use a process called _type inference_ to deduce what the types of
    [X], [l1], and [l2] must be, based on how they are used.  For
    example, since [X] is used as an argument to [cons], it must be a
    [Type], since [cons] expects a [Type] as its first argument;
    matching [l1] with [nil] and [cons] means it must be a [list]; and
    so on.

    This powerful facility means we don't always have to write
    explicit type annotations everywhere, although explicit type
    annotations are still quite useful as documentation and sanity
    checks.  You should try to find a balance in your own code between
    too many type annotations (so many that they clutter and distract)
    and too few (which forces readers to perform type inference in
    their heads in order to understand your code). *)

(* ###################################################### *)
(** *** Type Argument Synthesis *)

(** Whenever we use a polymorphic function, we need to pass it
    one or more types in addition to its other arguments.  For
    example, the recursive call in the body of the [length] function
    above must pass along the type [X].  But just like providing
    explicit type annotations everywhere, this is heavy and verbose.
    Since the second argument to [length] is a list of [X]s, it seems
    entirely obvious that the first argument can only be [X] -- why
    should we have to write it explicitly?

    Fortunately, Coq permits us to avoid this kind of redundancy.  In
    place of any type argument we can write the "implicit argument"
    [_], which can be read as "Please figure out for yourself what
    type belongs here."  More precisely, when Coq encounters a [_], it
    will attempt to _unify_ all locally available information -- the
    type of the function being applied, the types of the other
    arguments, and the type expected by the context in which the
    application appears -- to determine what concrete type should
    replace the [_].

    This may sound similar to type annotation inference -- and,
    indeed, the two procedures rely on the same underlying mechanisms.
    Instead of simply omitting the types of some arguments to a
    function, like
      app' X l1 l2 : list X :=
    we can also replace the types with [_], like
      app' (X : _) (l1 l2 : _) : list X :=
    which tells Coq to attempt to infer the missing information, just
    as with argument synthesis.

    Using implicit arguments, the [length] function can be written
    like this: *)

Fixpoint length' (X:Type) (l:list X) : nat :=
  match l with
  | nil      => 0
  | cons h t => S (length' _ t)
  end.

(** In this instance, we don't save much by writing [_] instead of
    [X].  But in many cases the difference can be significant.  For
    example, suppose we want to write down a list containing the
    numbers [1], [2], and [3].  Instead of writing this... *)

Definition list123 :=
  cons nat 1 (cons nat 2 (cons nat 3 (nil nat))).

(** ...we can use argument synthesis to write this: *)

Definition list123' := cons _ 1 (cons _ 2 (cons _ 3 (nil _))).

(* ###################################################### *)
(** *** Implicit Arguments *)

(** If fact, we can go further.  To avoid having to sprinkle [_]'s
    throughout our programs, we can tell Coq _always_ to infer the
    type argument(s) of a given function. The [Arguments] directive
    specifies the name of the function or constructor, and then lists
    its argument names, with curly brackets around any arguments to be
    treated as implicit.
    *)

Arguments nil {X}.
Arguments cons {X} _ _.  (* use underscore for argument position that has no name *)
Arguments length {X} l.
Arguments app {X} l1 l2.
Arguments rev {X} l.
Arguments snoc {X} l v.

(* note: no _ arguments required... *)
Definition list123'' := cons 1 (cons 2 (cons 3 nil)).
Check (length list123'').

(** Alternatively, we can declare an argument to be implicit while
    defining the function itself, by surrounding the argument in curly
    braces.  For example: *)

Fixpoint length'' {X:Type} (l:list X) : nat :=
  match l with
  | nil      => 0
  | cons h t => S (length'' t)
  end.

(** (Note that we didn't even have to provide a type argument to
    the recursive call to [length'']; indeed, it is invalid to provide
    one.)  We will use this style whenever possible, although we will
    continue to use use explicit [Argument] declarations for
    [Inductive] constructors. *)

(** One small problem with declaring arguments [Implicit] is
    that, occasionally, Coq does not have enough local information to
    determine a type argument; in such cases, we need to tell Coq that
    we want to give the argument explicitly this time, even though
    we've globally declared it to be [Implicit].  For example, suppose we
    write this: *)

(* Definition mynil := nil.  *)

(** If we uncomment this definition, Coq will give us an error,
    because it doesn't know what type argument to supply to [nil].  We
    can help it by providing an explicit type declaration (so that Coq
    has more information available when it gets to the "application"
    of [nil]): *)

Definition mynil : list nat := nil.

(** Alternatively, we can force the implicit arguments to be explicit by
   prefixing the function name with [@]. *)

Check @nil.

Definition mynil' := @nil nat.

(** Using argument synthesis and implicit arguments, we can
    define convenient notation for lists, as before.  Since we have
    made the constructor type arguments implicit, Coq will know to
    automatically infer these when we use the notations. *)

Notation "x :: y" := (cons x y)
                     (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y []) ..).
Notation "x ++ y" := (app x y)
                     (at level 60, right associativity).

(** Now lists can be written just the way we'd hope: *)

Definition list123''' := [1; 2; 3].

(* ###################################################### *)
(** *** Exercises: Polymorphic Lists *)

(** **** Exercise: 2 stars, optional (poly_exercises) *)
(** Here are a few simple exercises, just like ones in the [Lists]
    chapter, for practice with polymorphism.  Fill in the definitions
    and complete the proofs below. *)

Fixpoint repeat {X : Type} (n : X) (count : nat) : list X :=
  match count with
  | 0 => []
  | S c => n :: repeat n c
 end.

Example test_repeat1:
  repeat true 2 = cons true (cons true nil).
 Proof. reflexivity. Qed.

Theorem nil_app : forall X:Type, forall l:list X,
  app [] l = l.

Proof. reflexivity. Qed.

Theorem rev_snoc : forall X : Type,
                     forall v : X,
                     forall s : list X,
  rev (snoc s v) = v :: (rev s).
Proof.
  intros. induction s. reflexivity. simpl.
rewrite IHs. reflexivity. Qed.

Theorem rev_involutive : forall X : Type, forall l : list X,
  rev (rev l) = l.
Proof.
intros. induction l. reflexivity. simpl. rewrite rev_snoc. rewrite IHl. reflexivity. Qed.

Theorem snoc_with_append : forall X : Type,
                         forall l1 l2 : list X,
                         forall v : X,
  snoc (l1 ++ l2) v = l1 ++ (snoc l2 v).
Proof. intros. induction l1. reflexivity. simpl. rewrite IHl1. reflexivity. Qed.
(** [] *)

(* ###################################################### *)
(** ** Polymorphic Pairs *)

(** Following the same pattern, the type definition we gave in
    the last chapter for pairs of numbers can be generalized to
    _polymorphic pairs_ (or _products_): *)

Inductive prod (X Y : Type) : Type :=
  pair : X -> Y -> prod X Y.

Arguments pair {X} {Y} _ _.

(** As with lists, we make the type arguments implicit and define the
    familiar concrete notation. *)

Notation "( x , y )" := (pair x y).

(** We can also use the [Notation] mechanism to define the standard
    notation for pair _types_: *)

Notation "X * Y" := (prod X Y) : type_scope.

(** (The annotation [: type_scope] tells Coq that this abbreviation
    should be used when parsing types.  This avoids a clash with the
    multiplication symbol.) *)

(** A note of caution: it is easy at first to get [(x,y)] and
    [X*Y] confused.  Remember that [(x,y)] is a _value_ built from two
    other values; [X*Y] is a _type_ built from two other types.  If
    [x] has type [X] and [y] has type [Y], then [(x,y)] has type
    [X*Y]. *)

(** The first and second projection functions now look pretty
    much as they would in any functional programming language. *)

Definition fst {X Y : Type} (p : X * Y) : X :=
  match p with (x,y) => x end.

Definition snd {X Y : Type} (p : X * Y) : Y :=
  match p with (x,y) => y end.

(** The following function takes two lists and combines them
    into a list of pairs.  In many functional programming languages,
    it is called [zip].  We call it [combine] for consistency with
    Coq's standard library. *)
(** Note that the pair notation can be used both in expressions and in
    patterns... *)

Fixpoint combine {X Y : Type} (lx : list X) (ly : list Y)
           : list (X*Y) :=
  match (lx,ly) with
  | ([],_) => []
  | (_,[]) => []
  | (x::tx, y::ty) => (x,y) :: (combine tx ty)
  end.

(** **** Exercise: 1 star, optional (combine_checks) *)
(** Try answering the following questions on paper and
    checking your answers in coq:
    - What is the type of [combine] (i.e., what does [Check
      @combine] print?)

It prints X->Y->list X->list Y->list (X*Y)

    - What does
        Eval compute in (combine [1;2] [false;false;true;true]).
      print?   []

It prints [(1,false);(2,false)].

*)

Check @combine.
(* No, actually it prints forall X Y : Type, list X -> list  Y -> list (X*Y). *)

Eval compute in (combine [1;2] [false;false;true;true]).

(* Yes, it prints  [(1, false); (2, false)] : list (nat * bool)
*)

(** **** Exercise: 2 stars (split) *)
(** The function [split] is the right inverse of combine: it takes a
    list of pairs and returns a pair of lists.  In many functional
    programing languages, this function is called [unzip].

    Uncomment the material below and fill in the definition of
    [split].  Make sure it passes the given unit tests. *)

Fixpoint split
           {X Y : Type} (l : list (X*Y))
           : (list X) * (list Y) :=
match l with
| [] => ([],[])
| (h,h') :: t => (h:: fst(split t), h':: snd (split t))
end.

Example test_split:
  split [(1,false);(2,false)] = ([1;2],[false;false]).
Proof.
reflexivity. Qed.
(** [] *)

(* ###################################################### *)
(** ** Polymorphic Options *)

(** One last polymorphic type for now: _polymorphic options_.
    The type declaration generalizes the one for [natoption] in the
    previous chapter: *)

Inductive option (X:Type) : Type :=
  | Some : X -> option X
  | None : option X.

Arguments Some {X} _.
Arguments None {X}.

(** We can now rewrite the [index] function so that it works
    with any type of lists. *)

Fixpoint index {X : Type} (n : nat)
               (l : list X) : option X :=
  match l with
  | [] => None
  | a :: l' => if beq_nat n O then Some a else index (pred n) l'
  end.

Example test_index1 :    index 0 [4;5;6;7]  = Some 4.
Proof. reflexivity.  Qed.
Example test_index2 :    index  1 [[1];[2]]  = Some [2].
Proof. reflexivity.  Qed.
Example test_index3 :    index  2 [true]  = None.
Proof. reflexivity.  Qed.

(** **** Exercise: 1 star, optional (hd_opt_poly) *)
(** Complete the definition of a polymorphic version of the
    [hd_opt] function from the last chapter. Be sure that it
    passes the unit tests below. *)

Definition hd_opt {X : Type} (l : list X)  : option X :=
  match l with
| [] => None
| h::_ => Some h
end.

(** Once again, to force the implicit arguments to be explicit,
    we can use [@] before the name of the function. *)

Check @hd_opt.

Example test_hd_opt1 :  hd_opt [1;2] = Some 1.
Proof. reflexivity. Qed.
Example test_hd_opt2 :   hd_opt  [[1];[2]]  = Some [1].
Proof. reflexivity. Qed.
(** [] *)

(* ###################################################### *)
(** * Functions as Data *)
(* ###################################################### *)
(** ** Higher-Order Functions *)

(** Like many other modern programming languages -- including
    all _functional languages_ (ML, Haskell, Scheme, etc.) -- Coq
    treats functions as first-class citizens, allowing functions to be
    passed as arguments to other functions, returned as results,
    stored in data structures, etc.

    Functions that manipulate other functions are often called
    _higher-order_ functions.  Here's a simple one: *)

Definition doit3times {X:Type} (f:X->X) (n:X) : X :=
  f (f (f n)).

(** The argument [f] here is itself a function (from [X] to
    [X]); the body of [doit3times] applies [f] three times to some
    value [n]. *)

Check @doit3times.
(* ===> doit3times : forall X : Type, (X -> X) -> X -> X *)

Example test_doit3times: doit3times minustwo 9 = 3.
Proof. reflexivity.  Qed.

Example test_doit3times': doit3times negb true = false.
Proof. reflexivity.  Qed.

(* ###################################################### *)
(** ** Partial Application *)

(** In fact, the multiple-argument functions we have already
    seen are also examples of passing functions as data.  To see why,
    recall the type of [plus]. *)

Check plus.
(* ==> nat -> nat -> nat *)

(** Each [->] in this expression is actually a _binary_ operator
    on types.  (This is the same as saying that Coq primitively
    supports only one-argument functions -- do you see why?)  This
    operator is _right-associative_, so the type of [plus] is really a
    shorthand for [nat -> (nat -> nat)] -- i.e., it can be read as
    saying that "[plus] is a one-argument function that takes a [nat]
    and returns a one-argument function that takes another [nat] and
    returns a [nat]."  In the examples above, we have always applied
    [plus] to both of its arguments at once, but if we like we can
    supply just the first.  This is called _partial application_. *)

Definition plus3 := plus 3.
Check plus3.

Example test_plus3 :    plus3 4 = 7.
Proof. reflexivity.  Qed.
Example test_plus3' :   doit3times plus3 0 = 9.
Proof. reflexivity.  Qed.
Example test_plus3'' :  doit3times (plus 3) 0 = 9.
Proof. reflexivity.  Qed.

(* ###################################################### *)
(** ** Digression: Currying *)

(** **** Exercise: 2 stars, advanced (currying) *)
(** In Coq, a function [f : A -> B -> C] really has the type [A
    -> (B -> C)].  That is, if you give [f] a value of type [A], it
    will give you function [f' : B -> C].  If you then give [f'] a
    value of type [B], it will return a value of type [C].  This
    allows for partial application, as in [plus3].  Processing a list
    of arguments with functions that return functions is called
    _currying_, in honor of the logician Haskell Curry.

    Conversely, we can reinterpret the type [A -> B -> C] as [(A *
    B) -> C].  This is called _uncurrying_.  With an uncurried binary
    function, both arguments must be given at once as a pair; there is
    no partial application. *)

(** We can define currying as follows: *)

Definition prod_curry {X Y Z : Type}
  (f : X * Y -> Z) (x : X) (y : Y) : Z := f (x, y).

(** As an exercise, define its inverse, [prod_uncurry].  Then prove
    the theorems below to show that the two are inverses. *)

Definition prod_uncurry {X Y Z : Type}
  (f : X -> Y -> Z) (p : X * Y) : Z :=
  f (fst p) ( snd p).

(** (Thought exercise: before running these commands, can you
    calculate the types of [prod_curry] and [prod_uncurry]?) *)

Check @prod_curry.
Check @prod_uncurry.

Theorem uncurry_curry : forall (X Y Z : Type) (f : X -> Y -> Z) x y,
  prod_curry (prod_uncurry f) x y = f x y.
Proof.
  intros. (*** simpl does not do anything! Why?? "compute" works but "simpl" does not. I wish they explained in more detail what these tactics actually do. *) reflexivity. Qed.

Theorem curry_uncurry : forall (X Y Z : Type)
                               (f : (X * Y) -> Z) (p : X * Y),
  prod_uncurry (prod_curry f) p = f p.
Proof.
intros. (* "compute" or "simpl" do nothing useful at this point! *)
destruct p. (* this is the important thing to do! Remember that a pair is just an inductive type with one constructor. So we can just "destruct" it into two values. *)
Case "p=(x,y)".
reflexivity. Qed.

(** [] *)

(* ###################################################### *)
(** ** Filter *)

(** Here is a useful higher-order function, which takes a list
    of [X]s and a _predicate_ on [X] (a function from [X] to [bool])
    and "filters" the list, returning a new list containing just those
    elements for which the predicate returns [true]. *)

Fixpoint filter {X:Type} (test: X->bool) (l:list X)
                : (list X) :=
  match l with
  | []     => []
  | h :: t => if test h then h :: (filter test t)
                        else       filter test t
  end.

(** For example, if we apply [filter] to the predicate [evenb]
    and a list of numbers [l], it returns a list containing just the
    even members of [l]. *)

Example test_filter1: filter evenb [1;2;3;4] = [2;4].
Proof. reflexivity.  Qed.

Definition length_is_1 {X : Type} (l : list X) : bool :=
  beq_nat (length l) 1.

Example test_filter2:
    filter length_is_1
           [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ]
  = [ [3]; [4]; [8] ].
Proof. reflexivity.  Qed.

(** We can use [filter] to give a concise version of the
    [countoddmembers] function from the [Lists] chapter. *)

Definition countoddmembers' (l:list nat) : nat :=
  length (filter oddb l).

Example test_countoddmembers'1:   countoddmembers' [1;0;3;1;4;5] = 4.
Proof. reflexivity.  Qed.
Example test_countoddmembers'2:   countoddmembers' [0;2;4] = 0.
Proof. reflexivity.  Qed.
Example test_countoddmembers'3:   countoddmembers' nil = 0.
Proof. reflexivity.  Qed.

(* ###################################################### *)
(** ** Anonymous Functions *)

(** It is a little annoying to be forced to define the function
    [length_is_1] and give it a name just to be able to pass it as an
    argument to [filter], since we will probably never use it again.
    Moreover, this is not an isolated example.  When using
    higher-order functions, we often want to pass as arguments
    "one-off" functions that we will never use again; having to give
    each of these functions a name would be tedious.

    Fortunately, there is a better way. It is also possible to
    construct a function "on the fly" without declaring it at the top
    level or giving it a name; this is analogous to the notation we've
    been using for writing down constant lists, natural numbers, and
    so on. *)

Example test_anon_fun':
  doit3times (fun n => n * n) 2 = 256.
Proof. reflexivity.  Qed.

(** Here is the motivating example from before, rewritten to use
    an anonymous function. *)

Example test_filter2':
    filter (fun l => beq_nat (length l) 1)
           [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ]
  = [ [3]; [4]; [8] ].
Proof. reflexivity.  Qed.

(** **** Exercise: 2 stars (filter_even_gt7) *)

(** Use [filter] (instead of [Fixpoint]) to write a Coq function
    [filter_even_gt7] that takes a list of natural numbers as input
    and returns a list of just those that are even and greater than
    7. *)

Definition filter_even_gt7 (l : list nat) : list nat :=
  filter (fun x => andb (evenb x) (ble_nat 8 x) ) l.

Example test_filter_even_gt7_1 :
  filter_even_gt7 [1;2;6;9;10;3;12;8] = [10;12;8].
Proof. reflexivity. Qed.

Example test_filter_even_gt7_2 :
  filter_even_gt7 [5;2;6;19;129] = [].
Proof. reflexivity. Qed.
(** [] *)

(** **** Exercise: 3 stars (partition) *)
(** Use [filter] to write a Coq function [partition]:
  partition : forall X : Type,
              (X -> bool) -> list X -> list X * list X
   Given a set [X], a test function of type [X -> bool] and a [list
   X], [partition] should return a pair of lists.  The first member of
   the pair is the sublist of the original list containing the
   elements that satisfy the test, and the second is the sublist
   containing those that fail the test.  The order of elements in the
   two sublists should be the same as their order in the original
   list.
*)

Definition partition {X : Type} (test : X -> bool) (l : list X)
                     : list X * list X :=
 (filter test l, filter (fun x => negb (test x)) l).

Example test_partition1: partition oddb [1;2;3;4;5] = ([1;3;5], [2;4]).
Proof. reflexivity. Qed.

Example test_partition2: partition (fun x => false) [5;9;0] = ([], [5;9;0]).
Proof. reflexivity. Qed.
(** [] *)

(* ###################################################### *)
(** ** Map *)

(** Another handy higher-order function is called [map]. *)

Fixpoint map {X Y:Type} (f:X->Y) (l:list X)
             : (list Y) :=
  match l with
  | []     => []
  | h :: t => (f h) :: (map f t)
  end.

(** It takes a function [f] and a list [ l = [n1, n2, n3, ...] ]
    and returns the list [ [f n1, f n2, f n3,...] ], where [f] has
    been applied to each element of [l] in turn.  For example: *)

Example test_map1: map (plus 3) [2;0;2] = [5;3;5].
Proof. reflexivity.  Qed.

(** The element types of the input and output lists need not be
    the same ([map] takes _two_ type arguments, [X] and [Y]).  This
    version of [map] can thus be applied to a list of numbers and a
    function from numbers to booleans to yield a list of booleans: *)

Example test_map2: map oddb [2;1;2;5] = [false;true;false;true].
Proof. reflexivity.  Qed.

(** It can even be applied to a list of numbers and
    a function from numbers to _lists_ of booleans to
    yield a list of lists of booleans: *)

Example test_map3:
    map (fun n => [evenb n;oddb n]) [2;1;2;5]
  = [[true;false];[false;true];[true;false];[false;true]].
Proof. reflexivity.  Qed.

(** **** Exercise: 3 stars (map_rev) *)
(** Show that [map] and [rev] commute.  You may need to define an
    auxiliary lemma. *)
Lemma map_snoc: forall (X Y : Type) (f : X->Y) (l : list X) (x : X),
  map f (snoc l x) = snoc (map f l) (f x).
Proof. intros. induction l. Case "[]". reflexivity.
Case "x0 :: l". simpl. rewrite IHl. reflexivity. Qed.

Theorem map_rev : forall (X Y : Type) (f : X -> Y) (l : list X),
  map f (rev l) = rev (map f l).
Proof.
  intros. induction l. reflexivity. simpl. rewrite map_snoc. rewrite IHl. reflexivity. Qed.

(** [] *)

(** **** Exercise: 2 stars (flat_map) *)
(** The function [map] maps a [list X] to a [list Y] using a function
    of type [X -> Y].  We can define a similar function, [flat_map],
    which maps a [list X] to a [list Y] using a function [f] of type
    [X -> list Y].  Your definition should work by 'flattening' the
    results of [f], like so:
        flat_map (fun n => [n;n+1;n+2]) [1;5;10]
      = [1; 2; 3; 5; 6; 7; 10; 11; 12].
*)

Fixpoint flat_map {X Y:Type} (f:X -> list Y) (l:list X)
                   : (list Y) :=
match l with
| [] => []
| h::t => (f h) ++ (flat_map f t)
end.

Example test_flat_map1:
  flat_map (fun n => [n;n;n]) [1;5;4]
  = [1; 1; 1; 5; 5; 5; 4; 4; 4].
 Proof. reflexivity. Qed.
(** [] *)

(** Lists are not the only inductive type that we can write a
    [map] function for.  Here is the definition of [map] for the
    [option] type: *)

Definition option_map {X Y : Type} (f : X -> Y) (xo : option X)
                      : option Y :=
  match xo with
    | None => None
    | Some x => Some (f x)
  end.

(** **** Exercise: 2 stars, optional (implicit_args) *)
(** The definitions and uses of [filter] and [map] use implicit
    arguments in many places.  Replace the curly braces around the
    implicit arguments with parentheses, and then fill in explicit
    type parameters where necessary and use Coq to check that you've
    done so correctly.  (This exercise is not to be turned in; it is
    probably easiest to do it on a _copy_ of this file that you can
    throw away afterwards.)  [] *)

(* ###################################################### *)
(** ** Fold *)

(** An even more powerful higher-order function is called
    [fold].  This function is the inspiration for the "[reduce]"
    operation that lies at the heart of Google's map/reduce
    distributed programming framework. *)

Fixpoint fold {X Y:Type} (f: X->Y->Y) (l:list X) (b:Y) : Y :=
  match l with
  | nil => b
  | h :: t => f h (fold f t b)
  end.

(** Intuitively, the behavior of the [fold] operation is to
    insert a given binary operator [f] between every pair of elements
    in a given list.  For example, [ fold plus [1;2;3;4] ] intuitively
    means [1+2+3+4].  To make this precise, we also need a "starting
    element" that serves as the initial second input to [f].  So, for
    example,
   fold plus [1;2;3;4] 0
    yields
   1 + (2 + (3 + (4 + 0))).
    Here are some more examples:
*)

Check (fold andb).
(* ===> fold andb : list bool -> bool -> bool *)

Example fold_example1 : fold mult [1;2;3;4] 1 = 24.
Proof. reflexivity. Qed.

Example fold_example2 : fold andb [true;true;false;true] true = false.
Proof. reflexivity. Qed.

Example fold_example3 : fold app  [[1];[];[2;3];[4]] [] = [1;2;3;4].
Proof. reflexivity. Qed.

(** **** Exercise: 1 star, advanced (fold_types_different) *)
(** Observe that the type of [fold] is parameterized by _two_ type
    variables, [X] and [Y], and the parameter [f] is a binary operator
    that takes an [X] and a [Y] and returns a [Y].  Can you think of a
    situation where it would be useful for [X] and [Y] to be
    different? *)

(* for example, to count the elements in a list, we can fold on + with Y = nat and any X. This is shown below in the definition of fold_length *)

(* ###################################################### *)
(** ** Functions For Constructing Functions *)

(** Most of the higher-order functions we have talked about so
    far take functions as _arguments_.  Now let's look at some
    examples involving _returning_ functions as the results of other
    functions.

    To begin, here is a function that takes a value [x] (drawn from
    some type [X]) and returns a function from [nat] to [X] that
    yields [x] whenever it is called, ignoring its [nat] argument. *)

Definition constfun {X: Type} (x: X) : nat->X :=
  fun (k:nat) => x.

Definition ftrue := constfun true.

Example constfun_example1 : ftrue 0 = true.
Proof. reflexivity. Qed.

Example constfun_example2 : (constfun 5) 99 = 5.
Proof. reflexivity. Qed.

(** Similarly, but a bit more interestingly, here is a function
    that takes a function [f] from numbers to some type [X], a number
    [k], and a value [x], and constructs a function that behaves
    exactly like [f] except that, when called with the argument [k],
    it returns [x]. *)

Definition override {X: Type} (f: nat->X) (k:nat) (x:X) : nat->X:=
  fun (k':nat) => if beq_nat k k' then x else f k'.

(** For example, we can apply [override] twice to obtain a
    function from numbers to booleans that returns [false] on [1] and
    [3] and returns [true] on all other arguments. *)

Definition fmostlytrue := override (override ftrue 1 false) 3 false.

Example override_example1 : fmostlytrue 0 = true.
Proof. reflexivity. Qed.

Example override_example2 : fmostlytrue 1 = false.
Proof. reflexivity. Qed.

Example override_example3 : fmostlytrue 2 = true.
Proof. reflexivity. Qed.

Example override_example4 : fmostlytrue 3 = false.
Proof. reflexivity. Qed.

(** **** Exercise: 1 star (override_example) *)
(** Before starting to work on the following proof, make sure you
    understand exactly what the theorem is saying and can paraphrase
    it in your own words.  The proof itself is straightforward. *)

(* Here X=bool; "constfun b" is a function that always returns b. The "override" makes a new function that returns true on 3, otherwise it returns b. But we evaluate this new function on 2, not on 3. So the result is b. *)

Theorem override_example : forall (b:bool),
  (override (constfun b) 3 true) 2 = b.
Proof.
  reflexivity. Qed.
(** [] *)

(** We'll use function overriding heavily in parts of the rest of the
    course, and we will end up needing to know quite a bit about its
    properties.  To prove these properties, though, we need to know
    about a few more of Coq's tactics; developing these is the main
    topic of the next chapter.  For now, though, let's introduce just
    one very useful tactic that will also help us with proving
    properties of some of the other functions we have introduced in
    this chapter. *)

(* ###################################################### *)
(** * The [unfold] Tactic *)

(** Sometimes, a proof will get stuck because Coq doesn't
    automatically expand a function call into its definition.  (This
    is a feature, not a bug: if Coq automatically expanded everything
    possible, our proof goals would quickly become enormous -- hard to
    read and slow for Coq to manipulate!) *)

Theorem unfold_example_bad : forall m n,
  3 + n = m ->
  plus3 n + 1 = m + 1.
Proof.
  intros m n H.
(* At this point, we'd like to do [rewrite -> H], since
     [plus3 n] is definitionally equal to [3 + n].  However,
     Coq doesn't automatically expand [plus3 n] to its
     definition. *)
  Abort.

(** The [unfold] tactic can be used to explicitly replace a
    defined name by the right-hand side of its definition.  *)

Theorem unfold_example : forall m n,
  3 + n = m ->
  plus3 n + 1 = m + 1.
Proof.
  intros m n H.
  unfold plus3.
  rewrite -> H.
  reflexivity.  Qed.

(** Now we can prove a first property of [override]: If we
    override a function at some argument [k] and then look up [k], we
    get back the overridden value. *)

Theorem override_eq : forall {X:Type} x k (f:nat->X),
  (override f k x) k = x.
Proof.
  intros X x k f.
  unfold override.
  rewrite <- beq_nat_refl.
  reflexivity.  Qed.

(** This proof was straightforward, but note that it requires
    [unfold] to expand the definition of [override]. *)

(** **** Exercise: 2 stars (override_neq) *)
Theorem override_neq : forall (X:Type) x1 x2 k1 k2 (f : nat->X),
  f k1 = x1 ->
  beq_nat k2 k1 = false ->
  (override f k2 x2) k1 = x1.
Proof.
intros. unfold override. rewrite H0. rewrite H. reflexivity.
 Qed.
(** [] *)

(** As the inverse of [unfold], Coq also provides a tactic
    [fold], which can be used to "unexpand" a definition.  It is used
    much less often. *)

(* ##################################################### *)
(** * Additional Exercises *)

(** **** Exercise: 2 stars (fold_length) *)
(** Many common functions on lists can be implemented in terms of
   [fold].  For example, here is an alternative definition of [length]: *)

Definition fold_length {X : Type} (l : list X) : nat :=
  fold (fun _ n => S n) l 0.

Example test_fold_length1 : fold_length [4;7;0] = 3.
Proof. reflexivity. Qed.

(** Prove the correctness of [fold_length]. *)

Theorem fold_length_correct : forall X (l : list X),
  fold_length l = length l.
Proof. intros. induction l. Case "[]".  reflexivity.
Case "x::l". unfold fold_length. simpl.  rewrite <- IHl. (* we do not need another unfold. Apparently, reflexivity is quite clever! *)
reflexivity. Qed.
(** [] *)

(** **** Exercise: 3 stars (fold_map) *)
(** We can also define [map] in terms of [fold].  Finish [fold_map]
    below. *)

Check fold. (* ('a ->'b ->'b) -> list 'a -> 'b -> 'b *)

Definition fold_map {X Y:Type} (f : X -> Y) (l : list X) : list Y :=
fold (fun v ls => (f v) :: ls) l [].

(** Write down a theorem in Coq stating that [fold_map] is correct,
    and prove it. *)

(*** The reason we now need to use "unfold" seems to be that fold_map is defined not directly as a fixpoint but as a "definition" through "fold", and this is not being directly expanded. Once we get to "fold", the fixpoint is being expanded by "simpl". In contrast, "map" is defined directly as a fixpoint and is being expanded right away by "simpl". On the other hand, "reflexivity" is more clever and does expand everything, including "Definition" and "fixpoint". However, "reflexivity" cannot be used in the beginning because the goal is still far and reflexivity fails to unify the two sides of the equation.  We would ideally need a tactic stronger tha "simpl", that does what "reflexivity" does for simplifying and expanding things, but does not attempt to unify and does not fail when unifying is not yet possible. *)

Theorem fold_map_is_fold: forall (X Y : Type)(f : X -> Y) (l : list X),
fold_map f l = map f l.
Proof.
intros.
induction l. Case "[]". reflexivity.
Case "x::l". unfold fold_map. simpl.
rewrite <- IHl. reflexivity. Qed.
(** [] *)

(* $Date: 2013-07-17 16:19:11 -0400 (Wed, 17 Jul 2013) $ *)


Require Import GeoCoq.Axioms.parallel_postulates.
Require Import GeoCoq.Tarski_dev.Ch12_parallel.

Section midpoint_playfair.

Context `{TnEQD:Tarski_neutral_dimensionless_with_decidable_point_equality}.

Lemma midpoint_converse_postulate_implies_playfair :
  midpoint_converse_postulate ->
  playfair_s_postulate.
Proof.
intros HT A1 A2 B1 B2 C1 C2 P HPar1 HCol1 HPar2 HCol2.
elim HPar1; clear HPar1; intro HPar1; elim HPar2; clear HPar2; intro HPar2.

  {
  assert (HDiff : P <> A1) by (intro; treat_equalities; apply HPar1; exists P; Col).
  assert (HX := symmetric_point_construction A1 P); destruct HX as [X HMid1].
  assert (HB3 : exists B3, Col B1 B2 B3 /\ BetS A2 B3 X).
    {
    assert (H : P <> B1 \/ P <> B2).
      {
      elim (par_strict_distinct A1 A2 B1 B2 HPar1); intros.
      elim (eq_dec_points P B1); intro; elim (eq_dec_points P B2); intro; treat_equalities; intuition.
      }
    elim H; clear H; intro H.

      {
      destruct (hilbert_s_version_of_pasch X A1 A2 B1 P) as [B3 [HCol HBet]];
      assert_diffs; unfold Midpoint in *; spliter;
      try (exists B3; split); Col; unfold BetS in *; try ColR; [..|repeat split; Between|].

        {
        apply coplanar_perm_22, col_cop__cop with P; Col.
        apply coplanar_perm_2, col_cop__cop with B2; Col.
        apply par__coplanar; Par.
        }

        {
        intro; apply HPar1; exists A2; split; Col; ColR.
        }

        {
        intro; apply H; apply l6_21 with A1 P B1 P; Col.

          {
          intro; apply par_strict_not_col_3 in HPar1; apply HPar1; ColR.
          }

          {
          assert_diffs; assert_cols; ColR.
          }
        }

        {
        induction HBet; spliter; Between.
        assert (Hc : ~ Bet A2 B3 A1) by (intro; apply HPar1; exists B3; assert_cols; split; ColR).
        exfalso; apply Hc; Between.
        }
      }

      {
      destruct (hilbert_s_version_of_pasch X A1 A2 B2 P) as [B3 [HCol HBet]];
      assert_diffs; unfold Midpoint in *; spliter;
      try (exists B3; split); Col; unfold BetS in *; try ColR; [..|repeat split; Between|].

        {
        apply coplanar_perm_22, col_cop__cop with P; Col.
        apply coplanar_perm_2, col_cop__cop with B1; Col.
        apply par__coplanar; Par.
        }

        {
        intro; apply HPar1; exists A2; split; Col; ColR.
        }

        {
        intro; apply H; apply l6_21 with A1 P B2 P; Col.

          {
          intro; apply par_strict_not_col_3 in HPar1; apply HPar1; ColR.
          }

          {
          assert_diffs; assert_cols; ColR.
          }
        }

        {
        induction HBet; spliter; Between.
        assert (Hc : ~ Bet A2 B3 A1) by (intro; apply HPar1; exists B3; assert_cols; split; ColR).
        exfalso; apply Hc; Between.
        }
      }
    }
  destruct HB3 as [B3 [HCol3 HBet1]].
  assert (HPB3 : P <> B3).
    {
    intro; treat_equalities; apply HPar1.
    exists P; unfold BetS in *; spliter; assert_diffs; assert_cols; split; ColR.
    }
  assert (HPar3 : Par A1 A2 P B3) by (apply par_col2_par with B1 B2; try ColR; try left; Par).
  assert (HC3 : exists C3, Col C1 C2 C3 /\ BetS A2 C3 X).
    {
    assert (H : P <> C1 \/ P <> C2).
      {
      elim (par_strict_distinct A1 A2 C1 C2 HPar2); intros.
      elim (eq_dec_points P C1); intro; elim (eq_dec_points P C2); intro; treat_equalities; intuition.
      }
    elim H; clear H; intro H.

      {
      destruct (hilbert_s_version_of_pasch X A1 A2 C1 P) as [C3 [HCol HBet]];
      assert_diffs; unfold Midpoint in *; spliter;
      try (exists C3; split); Col; unfold BetS in *; try ColR; [..|repeat split; Between|].

        {
        apply coplanar_perm_22, col_cop__cop with P; Col.
        apply coplanar_perm_2, col_cop__cop with C2; Col.
        apply par__coplanar; Par.
        }

        {
        intro; apply HPar2; exists A2; split; Col; ColR.
        }

        {
        intro; apply H; apply l6_21 with A1 P C1 P; Col.

          {
          intro; apply par_strict_not_col_3 in HPar2; apply HPar2; ColR.
          }

          {
          assert_diffs; assert_cols; ColR.
          }
        }

        {
        induction HBet; spliter; Between.
        assert (Hc : ~ Bet A2 C3 A1) by (intro; apply HPar2; exists C3; assert_cols; split; ColR).
        exfalso; apply Hc; Between.
        }
      }

      {
      destruct (hilbert_s_version_of_pasch X A1 A2 C2 P) as [C3 [HCol HBet]];
      assert_diffs; unfold Midpoint in *; spliter;
      try (exists C3; split); Col; unfold BetS in *; try ColR; [..|repeat split; Between|].

        {
        apply coplanar_perm_22, col_cop__cop with P; Col.
        apply coplanar_perm_2, col_cop__cop with C1; Col.
        apply par__coplanar; Par.
        }

        {
        intro; apply HPar2; exists A2; split; Col; ColR.
        }

        {
        intro; apply H; apply l6_21 with A1 P C2 P; Col.

          {
          intro; apply par_strict_not_col_3 in HPar2; apply HPar2; ColR.
          }

          {
          assert_diffs; assert_cols; ColR.
          }
        }

        {
        induction HBet; spliter; Between.
        assert (Hc : ~ Bet A2 C3 A1) by (intro; apply HPar2; exists C3; assert_cols; split; ColR).
        exfalso; apply Hc; Between.
        }
      }
    }
  destruct HC3 as [C3 [HCol4 HBet2]].
  assert (HPC3 : P <> C3).
    {
    intro; treat_equalities; apply HPar1.
    exists P; unfold BetS in *; spliter; assert_diffs; assert_cols; split; ColR.
    }
  assert (HPar4 : Par A1 A2 P C3) by (apply par_col2_par with C1 C2; try ColR; try left; Par).
  assert (HCol5 : Col A2 X B3) by (unfold BetS in *; spliter; assert_cols; Col).
  assert (HCol6 : Col A2 X C3) by (unfold BetS in *; spliter; assert_cols; Col).
  assert (HNC' : ~ Col A1 A2 X)
    by (intro; apply HPar1; exists P; assert_diffs; assert_cols; split; ColR).
  assert (B3 = C3) by (apply l7_17 with A2 X; apply HT with A1 P; Col; Par).
  elim (par_strict_distinct A1 A2 B1 B2 HPar1); intros.
  elim (par_strict_distinct A1 A2 C1 C2 HPar2); intros.
  spliter; treat_equalities; split; ColR.
  }

  {
  elim (par_strict_distinct A1 A2 B1 B2 HPar1); intros; spliter; exfalso; apply HPar1.
  exists P; split; Col; ColR.
  }

  {
  elim (par_strict_distinct A1 A2 C1 C2 HPar2); intros; spliter; exfalso; apply HPar2.
  exists P; split; Col; ColR.
  }

  {
  spliter; spliter; split; Col; ColR.
  }
Qed.

End midpoint_playfair.


(**

The motivation of top-like comes from defining disjointness for types: "Two types are disjoint if they have no common super types".
However, since we introduce [Top] to our type system, now every two types have at least one common supertype: [Top].

Situation is becoming more complicated after we introduce intersection types and its subtyping,
Top, Top & Top, Top & Top & Top ... are supertypes of all types. We need to generalize the idea of top-like types like these.

 **)

Require Import Coq.Program.Equality.
Require Import Strings.String.
Require Import Metalib.LibTactics.
Require Import Language.

(** * Definition *)

Inductive toplike : type -> Prop :=
| Tl_Top :
    toplike Top
| Tl_And : forall A B,
    toplike A ->
    toplike B ->
    toplike (And A B)
| Tl_Arr : forall A B,
    toplike B ->
    toplike (Arr A B)
| Tl_Rcd : forall l A,
    toplike A ->
    toplike (Rcd l A).

Hint Constructors toplike : core.

(** * Automations *)

(** ** Structural Inversion *)

Ltac solve_toplike :=
  match goal with
  | H: toplike Int |- _ => inversion H
  | H: toplike (Arr _ ?A) |- toplike ?A =>
      dependent destruction H; assumption
  | H: toplike (Rcd _ ?A) |- toplike ?A =>
      dependent destruction H; assumption
  end.

Hint Extern 5 => solve_toplike : core.

(** ** Contradictions *)

Ltac contra_toplike :=
  match goal with
  | [H1: toplike ?A, H2: not (toplike ?A) |- _] =>
      (contradiction)
  | [H1: toplike (Arr _ ?A), H2: not (toplike ?A) |- _] =>
      (dependent destruction H1; contradiction)
  | [H1: toplike (And ?A _), H2: not (toplike ?A) |- _] =>
      (dependent destruction H1; contradiction)
  | [H1: toplike (And _ ?A), H2: not (toplike ?A) |- _] =>
      (dependent destruction H1; contradiction)
  | [H1: toplike (Rcd _ ?A), H2: not (toplike ?A) |- _] =>
      (dependent induction H1; contradiction)
  end.

Hint Extern 5 => contra_toplike : core.

(** * Properties *)

(** ** Decidablility *)

(** For any type A, it's toplike or not toplike *)

Lemma toplike_decidable:
  forall A,
    toplike A \/ ~ toplike A.
Proof.
  intro A.
  induction A.
  - Case "Int".
    right. intro Contra. inversion Contra.
  - Case "Top".
    left. constructor.
  - Case "Arr".
    destruct IHA1; destruct IHA2; eauto;
      try solve [right; intros Contra; eauto].
  - Case "And".
    destruct IHA1; destruct IHA2; eauto;
      try solve [right; intros Contra; eauto].
  - Case "Rcd".
    destruct IHA; eauto.
Qed.


(* Voir l'enonce a la page suivante: https://staff.aist.go.jp/reynald.affeldt/coq/.
   Il s'agit essentiellement de remplacer les "Abort" par les scripts
   "Proof. [tactiques] Qed." adequats. *)

(* partie 1 *)

Lemma hilbertS (A B C : Prop) :
  (A -> B -> C) -> (A -> B) -> A -> C.
Proof.
Abort.
(* partie 2.1 *)

Lemma exo1 (P Q : Prop) : P -> (Q -> P).
Proof.
Abort.

Lemma exo2 (P Q : Prop) : P -> ( ~ P -> Q).
Proof.
Abort.

Lemma exo3 (P Q R : Prop) : (P -> Q) -> ((Q -> R) -> (P -> R)).
Proof.
Abort.

Lemma exo4 (P Q : Prop) : (P -> Q) -> ( ~ Q -> ~ P).
Proof.
Abort.

Require Import Classical.

Lemma bottom_c (A : Prop) : ((~A) -> False) -> A.
Proof.
Abort.

Lemma exo5 (P Q : Prop) : ( ~ Q -> ~ P) -> (P -> Q).
Proof.
Abort.

Lemma exo6 (P : Prop) : ~ ~ P -> P.
Proof.
Abort.

Lemma exo7 (P : Prop) : P -> ~ ~ P.
Proof.
Abort.

Lemma exo8 (P Q R : Prop) : (P -> (Q -> R)) -> (P /\ Q -> R).
Proof.
Abort.

Lemma exo9 (P Q R : Prop) : (P /\ Q -> R) -> (P -> (Q -> R)).
Proof.
Abort.

Lemma exo10 (P : Prop) : P /\ ~ P -> False.
Proof.
Abort.

Lemma exo11 (P : Prop) : False -> P /\ ~ P.
Proof.
Abort.

(* partie 2.2 *)

Lemma exo12 (P Q : Prop) : P \/ Q <-> ~ ( ~ P /\ ~ Q).
Proof.
Abort.

Lemma exo13 (P : Prop) : ~ P <-> (P -> False).
Proof.
Abort.

Lemma exo14 (P Q : Prop) : (P <-> Q) <-> (P -> Q) /\ (Q -> P).
Abort.

(* partie 3 *)

Lemma exemple134 (A B C : Prop) : (A /\ B -> C) <-> (A -> B -> C).
Abort.

Lemma exemple135 (A B C : Prop) : (C -> A) \/ (C -> B) -> (C -> A \/ B).
Abort.

Lemma exemple_136 (X : Type) (A B : X -> Prop) :
  ((forall x, A x) \/ (forall x, B x)) -> forall x, A x \/ B x.
Abort.

Lemma exemple_137 (X : Type) (A B : X -> Prop) :
  (exists x, A x /\ B x) -> ((exists x, A x) /\ (exists x, B x)).
Abort.

Lemma exemple_138 (A B : Prop) : ~ (A /\ B) -> ( ~ A \/ ~ B).
Abort.

Lemma exemple_138' (A B : Prop) : ~ (A /\ B) -> ( ~ A \/ ~ B).
Abort.

Lemma exemple_139 (X : Type) : forall (x1 x2 : X), x1 = x2 -> x2 = x1.
Abort.

Lemma exemple_140 (X : Type) : forall (x1 x2 x3 : X), x1 = x2 /\ x2 = x3 -> x1 = x3.
Abort.

(* partie 4 *)

Definition FALSE : Prop := forall (P : Prop), P.

Lemma FALSE_False : FALSE <-> False.
Abort.

Definition AND (A B : Prop) := forall (P : Prop), (A -> B -> P) -> P.

Definition OR (A B : Prop) := forall (P : Prop), ((A -> P) -> (B -> P) -> P).

Definition EX (A : Type) (P : A -> Prop) := forall (Q : Prop), (forall a, P a -> Q) -> Q.

Definition EQ (A : Type) (a a' : A) := forall (P : A -> Prop), P a -> P a'.

Lemma SPLIT (A B : Prop) : A -> B -> AND A B.
Abort.

Lemma PROJ1 (A B : Prop) : AND A B -> A.
Abort.

Lemma PROJ2 (A B : Prop) : AND A B -> B.
Abort.

Lemma ORINTROL (A B : Prop) : A -> OR A B.
Abort.

Lemma ORINTROR (A B : Prop) : B -> OR A B.
Abort.

Lemma AND_and (A B : Prop) : AND A B <-> A /\ B.
Abort.

Lemma OR_or (A B : Prop) : OR A B <-> A \/ B.
Abort.

Lemma EX_exists (A : Type) (P : A -> Prop) : EX A P <-> exists a, P a.
Abort.

Lemma EQ_eq (A : Type) (a a' : A) : EQ _ a a' <-> a = a'.
Abort.