Set Implicit Arguments.
Require Import Plus Omega.

(** By default, Coq features a constructive logic and provides a 
    relatively weak notion of equality. This contrasts with most
    other well-known theorem provers (e.g., Isabelle/HOL), which
    are based on classical logic, offer non-constructive operators,
    and feature an extensional equality. These features can allow for
    dramatic simplifications in formal developments compared with what
    can be achieved in a constructive logic with a weak equality.
   
    Fortunately, it is straightforward to extend the logic Coq with 
    a few axioms in order to recover these features. In fact, three
    axioms suffice to add support for extensionality, classical logic 
    and non-constructive operators. Note that these axioms do not break 
    the soundness of Coq because they are compatible with the boolean 
    model in which every proposition is either true or false. 
    
    The three axioms that we need are called "functional extensionality",
    "propositional extensionality" and "indefinite description". From
    these, other well-known axioms can be derived, including "predicate
    extensionality", "proof irrelevance", the "excluded middle", the
    "strong excluded middle", as well various forms of the "axiom of choice".
    
    There are two interests to adding these axioms to Coq. First, it 
    allows proving some mathematical theorems that otherwise could not
    be proved at all. Second, it allows simplifying some developments,
    for example by replacing equivalence relations by equalities, or by 
    saving the need to carry around evidence of the decidability of 
    particular predicates. 
   
    Of course, there is some interest to constructive developments:
    the use of non-constructive axioms in definitions can prevent one
    from running computations in Coq and may disable the possibility of
    extracting code. However, if you are not running computations in Coq 
    and are not interested in code extraction, then there is no reason to
    refrain yourself from using non-constructive features. And, even
    if you are interested in code extraction and need to be constructive
    for your definitions, you may still be interested in exploiting non-
    constructive features in some of your proofs.

    In this chapter, we will explain the meaning of each of the axioms 
    mentioned above, and we will present concrete examples illustrating
    the benefits of making these axioms available. *)

   
(* ********************************************************************** *)
(* ********************************************************************** *)
(** * Functional extensionality *)

(** The notion of equality between two functions in Coq is definitely
    not satisfying. For example, [fun n => 1 + n] is equal to
    [fun n => S n] but is not equal to [fun n => n + 1]. The reason is
    that two Coq functions can be proved equal if their body are two
    convertible Coq terms, but cannot be proved equal if their body are
    only equal. *)

Definition succ_1 n := S n.
Definition succ_2 n := 1 + n.
Definition succ_3 n := n + 1.

Lemma succ_1_eq_succ_2 : succ_1 = succ_2.
Proof.
  reflexivity. (* works because [S n] and [1 + n] are convertible *)
Qed.

Lemma succ_1_eq_succ_3_fails : succ_1 = succ_3.
Proof.
  (* [n + 1] and [1 + n] are equal but not convertible *)
  try reflexivity.   
  (* rewriting [n + 1 = 1 + n] is not possible because it is not
     possible to perform rewriting involving bound names *)
  unfold succ_3. try rewrite plus_comm.
Admitted.

(** Even though we cannot prove [succ_1] and [succ_3] equal, we can
    prove them extensionaly equal: for any argument [n], the applications
    [succ_1 n] and [succ_3 n] yields equal results. *)

Lemma succ_1_eq_succ_3_ext : 
  forall n, succ_1 n = succ_3 n.
Proof. intros. unfold succ_1, succ_3. rewrite plus_comm. reflexivity. Qed.

(** From this lemma, it is possible to derive the equality [succ_1 = succ_3] 
    by using the axiom of "functional extensionality". This axioms states
    that if two functions agree on all arguments, then they are equal in the
    sense of [=]. This axiom can be stated in Coq as shown below. *)

Axiom func_ext : forall (A B : Type) (f g : A -> B),
  (forall x, f x = g x) -> f = g.

(** Let us check that we can indeed derive [succ_1 = succ_3] using
    functional extensionality. *)

Lemma succ_1_eq_succ_3 : succ_1 = succ_3.
Proof. apply func_ext. apply succ_1_eq_succ_3_ext. Qed.

(** So, one interest of functional extensionality is that it allows
    to more elegantly state that a function matches another. We will
    see another interest of functional extensionality later on, when
    discussing predicate extensionality. *)

(** The functional extensionality axiom only describes equality between
    two functions of arity one. What about functions of arity two or more?
    Functional extensional for functions of higher arities can be derived
    from the basic functional extensionality axiom that we have seen.
    Intuitively, it suffices to iterate applications of [func_ext]. As an
    exercise, prove the extensionality for functions of two arguments by
    filling in the proof below. *)

Lemma func_ext_2 : forall A1 A2 B (f g : A1 -> A2 -> B),
  (forall x1 x2, f x1 x2 = g x1 x2) -> f = g.
Proof.
  (* BEGIN SOLUTION *)
  intros. apply func_ext. intros. apply func_ext. auto. 
  (* END SOLUTION *)
Qed.

(** As another direct application of functional extensionality, prove that
    a function is equal to an eta-expansion of itself, i.e., that [f] is
    always equal to [fun x => f x]. *)

Lemma func_eta : forall A B (f : A -> B),
  (fun x => f x) = f.
Proof.
  (* BEGIN SOLUTION *)
  intros. apply func_ext. auto.
  (* END SOLUTION *)
Qed.

(** The functional extensionality axiom [func_ext] that we have introduced
    above is actually not quite general enough, because it only accomodates
    function with a simple arrow type but not functions with a dependent
    type. It is straightforward to generalize [func_ext] into a version
    that supports functions with a type of the form [forall x:A, B x]. *)

Axiom func_ext_dep : forall (A:Type) (B:A->Type) (f g : forall x, B x),
  (forall x, f x = g x) -> f = g.

(** Note that the axiom [func_ext_dep] is strictly more general than
    [func_ext]. This fact is established next. *)

Lemma func_ext_derivable : forall (A B : Type) (f g : A -> B),
  (forall x, f x = g x) -> f = g.
Proof. intros. apply func_ext_dep. auto. Qed. 

(** So, in practice we only take functional extensionality for dependently-
    typed functions as axiom. From this one axiom, we can derive extensionality
    for simply-typed functions as well as extensionality for functions of 
    several arguments (even for dependently-typed functions). *) 


(* ********************************************************************** *)
(* ********************************************************************** *)
(* ********************************************************************** *)
(** * Propositional extensionality *)

(** Propositional extensionality is another axiom that strengthens 
    the meaning of equality. This axiom asserts that when two propositions
    are equivalent, in the sense that they are related by "if and only if",
    then these two propositions can be considered to be "equal", in the sense
    of [=]. *)

Axiom prop_ext : forall (P Q : Prop), 
  (P <-> Q) -> P = Q.

(** For example, using propositional equality, one can prove that [~ True] 
    is equal to [False] and that [~ False] is equal to [True]. *)

Lemma not_True : (~ True) = False.
Proof. intros. apply prop_ext. split; intros H; auto. Qed.

Lemma not_False : (~ False) = True.
Proof. intros. apply prop_ext. split; intros H; auto. Qed.

(** Having such equalities makes it easy to simplify logical expressions
    through rewriting operations. Moreover, such rewriting operations 
    can be automated, as we will see soon afterwards. *)

(** Combining propositional extensionality with functional extensionality,
    we can derive a result called "predicate extensionality". Predicate
    extensionality states that if two predicate yield equivalent propositions 
    (in the sense of [<->]) on all arguments, then these two predicates 
    can be considered to be equal (in the sense of [=]). The formal
    statement appears next. *)

Lemma pred_ext : forall (A : Type) (P Q : A -> Prop),
  (forall x, P x <-> Q x) -> P = Q.
Proof.
  (* use [prop_ext] and [func_ext_dep] to complete the proof *)
  (* BEGIN SOLUTION *)
  intros. apply func_ext_dep. intros. apply prop_ext. auto.
  (* END SOLUTION *) 
Qed.

(** Like functional extensionality, predicate extensionality allows for
    more concise statements of lemmas. To get some practice with using
    [pred_ext], prove that the two definitions of the predicate "is equal 
    to zero" shown below are equal. *)

Definition zero_1 n := (n = 0).

Definition zero_2 n := (forall m, n <> S m).

Lemma zero_1_eq_zero_2 : zero_1 = zero_2.
Proof.
  (* BEGIN SOLUTION *)
  apply pred_ext. intros n.
  unfold zero_1, zero_2. split; intros H.
    intros m E. congruence.
    destruct n. auto. destruct (H n). auto.
  (* END SOLUTION *) 
Qed.

(** Note that, like other extensionality results, predicate extensionality 
    can be easily generalized to support higher arities. *)

(** A major application of predicate extensionality is the
    construction of a general-purpose set library that features
    a proper double-inclusion lemma [subset E F -> subset F E -> E F].
    In Coq, a (possibly-infinite) set of values of type [A] can be 
    represented as a predicate of type [A->Prop]. *)

Definition set (A:Type) := A -> Prop.

(** The idea underlying this representation of sets is that a set [E]
    contains a value [x] if and only if [E x] holds. We write [mem x E]
    to describe membership of [x] to the set [E]. It is defined as follows. *)

Definition mem (A : Type) (x : A) (E : set A) : Prop := 
  E x.

(** We can define the basic operations on sets, such as union, intersection,
    empty sets and singleton sets, by constructing the appropriate functions. *)

Section SetOperations.
Variables A : Type.

Definition empty : set A := 
  fun _ => False.

Definition singleton (v : A) : set A :=
  fun x => x = v.

Definition union (E F : set A) : set A :=
  fun x => mem x E \/ mem x F.

Definition inter (E F : set A) : set A :=
  fun x => mem x E /\ mem x F.

(** We can define inclusion in terms of logical implication: [E] is a subset
    of [F] set if all the members of [E] are also members of [F], that is,
    if for any [x], the proposition [mem x E] implies [mem x F]. *)

Definition subset (E F : set A) : Prop :=
  forall x, mem x E -> mem x F.

(** Now that we have defined inclusion, we can state the double inclusion
    result: if two sets are subsets of each other, then they are equal.
    This statement appears next. *)

Lemma double_inclusion : forall (E F : set A), 
  subset E F -> subset F E -> E = F.
Proof. 
  (* Complete the proof using predicate extensionality ([pred_ext]). *)
  (* BEGIN SOLUTION *)
  intros E F H1 H2. apply pred_ext. intros. split. apply H1. apply H2.
  (* END SOLUTION *)
Qed.

End SetOperations.


(* ********************************************************************** *)
(* ********************************************************************** *)
(* ********************************************************************** *)
(** * Classical logic *)

(** A "classical logic" is a logic where any given proposition is either
    "true" or "false". This property is also known as the "excluded middle",
    capturing the idea that there is no such thing as being half-way 
    between "true" and "false". The logic of Coq can be safely extended 
    into a classical logic by including the excluded middle axiom. *)

Axiom classic : forall (P : Prop), P \/ ~ P.

(** The above statement states that, for any proposition [P], we can 
    assume that either there exists a proof of [P], or there exists a
    proof of the negation of [P]. Using the axiom of propositional
    extensionality that we have introduced earlier on, we can reformulate
    this result is a slightly different way: any proposition [P] is
    either equal to [True] or equal to [False]. This alternative 
    formulation, known as "propositional degeneracy" is formally stated
    and proved below. *)

Lemma prop_degeneracy : forall (P : Prop),
   P = True \/ P = False.
Proof.
  intros. destruct (classic P).
    left. apply prop_ext. tauto.
    right. apply prop_ext. tauto.
Qed.



(** Beyond the fact that the excluded middle is sometimes necessary,
    it is sometimes also very convenient. It means that, at any time
    in a proof, we can perform a case analysis on whether a given
    proposition is true or not. The tactic [test] helps exploiting
    the excluded middle in such a way. [test P] applies to any goal
    and produces two copies of this goal: a first one containing the
    hypothesis [P], and a second one containing the hypothesis [~P]. *)

Tactic Notation "test" constr(P) :=
  destruct (classic P).
Tactic Notation "test" constr(P) "as" ident(H) :=
  destruct (classic P) as [H|H].

(** The excluded middle is also often exploited indirectly through
    the introduction of a double negation, which allows to replace
    a goal [P] with [False] and to add [~P] as hypothesis. The double
    negation property is captured by the following lemma. *)

Lemma not_not_elim : forall (P : Prop), 
  ~ ~ P -> P.
Proof. 
  (* complete the proof usint the tactic [test]; at some point in
     the proof, you need to invoke [elimtype False] in order to
     discard one absurd subgoal *)
  (* BEGIN SOLUTION *) 
   intros P N. test P.
      auto.
      elimtype False. apply N. auto.
  (* END SOLUTION *)
Qed.

(** Another formulation of the double negation is known as 
   "Peirce's result". It says that to prove [P], it is sufficient
   to prove [P] under the assumption that [~P] holds. *)

Lemma peirce : forall (P : Prop), 
  (~ P -> P) -> P.
Proof. intros P N. test P. auto. auto. Qed.

(** Classical reasoning is particularly useful to prove disjunction.
    For example, to prove the disjunction [P \/ Q], it suffices to
    prove that [P] is true under the assumption that [Q] is false,
    or, symmetrically, to prove that [Q] is true under the assumption
    that [P] is false. Prove this result formally. *)

Lemma classic_or : forall (P Q : Prop), 
  ((~ Q -> P) \/ (~ P -> Q)) -> (P \/ Q).
Proof.
  (* BEGIN SOLUTION *) 
  intros P Q H. destruct H.
    test Q. auto. auto.
    test P. auto. auto.
  (* END SOLUTION *)
Qed.

(** Many of the consequences of classical logic are best stated in
    the form of rewriting rules. For example, the elimination of
    double negation can be written [(~ ~ P) = P]. Similarly, the
    distribution of negation over disjunction takes the form of an
    equality [(~ (P \/ Q)) = (~ P /\ ~ Q)]. Negation also distributes
    over quantifiers, for example the negation of an existential is
    a universal: [(~ (exists x, P x)) = (forall x, ~ P x)].

    In what follows, we show how to derive equalities of this form
    and how to set up a tactic that exploits these equalities in order
    to automate the simplification of logical expressions. Let us
    start with the equality for double negation. *)

Lemma not_not : forall P : Prop,
   (~ ~ P) = P.
Proof. 
  intros. apply prop_ext. split.
    apply not_not_elim.
    intros M N. apply N. apply M.
Qed.

(** To prove the distribution of negation over logical conjunction,
    we follow a more brute-force approach that consists in considering
    all four possible cases (P true and Q true, P true and Q false, 
    (P false and Q true, and P false and Q false). For each case, 
    we call the decision procedure [tauto] to handle the goal. *)

Lemma not_and : forall P Q : Prop,
  (~ (P /\ Q)) = (~ P \/ ~ Q).
Proof.
  intros. apply prop_ext.
  destruct (classic P); destruct (classic Q); tauto.
Qed.

(** In a similar way, we can show how negation distributes over
    disjunctions, implications and equivalences. The proofs all follow
    the exact same pattern, so we use a tactic to factorize them. *)

Ltac classic_bruteforce_2 := 
  intros P Q; apply prop_ext;
  destruct (classic P); destruct (classic Q); tauto.

Lemma not_or : forall (P Q : Prop),
  (~ (P \/ Q)) = (~ P /\ ~ Q).
Proof. classic_bruteforce_2. Qed.

Lemma not_impl : forall (P Q : Prop),
  (~ (P -> Q)) = (P /\ ~ Q).
Proof. classic_bruteforce_2. Qed.

Lemma not_iff : forall (P Q : Prop),
  (~ (P <-> Q)) = ((P /\ ~ Q) \/ (~ P /\ Q)).
Proof. classic_bruteforce_2. Qed.

(** At this point, we are almost ready to set up the tactic that
    automates the simplification of logical expressions. We only
    need to prove a few additional lemmas describing how [True]
    and [False] behave in front of conjunctions and disjunctions. *)

Lemma and_True_l : forall P, (True /\ P) = P.
Proof. intros. apply prop_ext; tauto. Qed.
Lemma and_True_r : forall P, (P /\ True) = P.
Proof. intros. apply prop_ext; tauto. Qed.
Lemma and_False_l : forall P, (False /\ P) = False.
Proof. intros. apply prop_ext; tauto. Qed.
Lemma and_False_r : forall P, (P /\ False) = False.
Proof. intros. apply prop_ext; tauto. Qed.
Lemma or_True_l : forall P, (True \/ P) = True.
Proof. intros. apply prop_ext; tauto. Qed.
Lemma or_True_r : forall P, (P \/ True) = True.
Proof. intros. apply prop_ext; tauto. Qed.
Lemma or_False_l : forall P, (False \/ P) = P.
Proof. intros. apply prop_ext; tauto. Qed.
Lemma or_False_r : forall P, (P \/ False) = P.
Proof. intros. apply prop_ext; tauto. Qed.

(** The tactic [rew_logic] is defined in such a way that it 
    automatically tries to perform rewriting using all the 
    equalities that we have proved. The tactic is implemented 
    using the [autorewrite] mechanism. *)

Hint Rewrite not_True not_False not_not not_and not_or
  and_True_l and_True_r and_False_l and_False_r
  or_True_l or_True_r or_False_l or_False_r 
  not_impl not_iff : rew_logic.

Ltac rew_logic := autorewrite with rew_logic in *.

(** The following example illustrates the behavior of [rew_logic]. *)

Lemma rew_logic_demo_1 : forall (P Q R : Prop) (n : nat),
  ~ ((P \/ ~ ((~ Q /\ R) /\ (n <> 3)) -> ~ ~ Q) /\ (~ R /\ ~ Q)).
Proof.
  intros.
  (* first we can simplify the expression *)
  rew_logic.
  (* to simplify further, we need to perform case analyses;
     for example, let's do a case analysis on proposition [Q] *)
  destruct (prop_degeneracy Q) as [H|H]; rewrite H; clear H.
    (* in the first subgoal, [Q] has been replaced with [True]; *)
    (* this subgoal can be simplified further *)
    rew_logic. auto.
    (* in the second subgoal [Q] has been replaced with [False]; *)
    (* this subgoal can also be simplified further *)
    rew_logic.
      (* let's perform a second case analysis, on [R] this time *)
      destruct (prop_degeneracy R) as [H|H]; rewrite H; clear H.
        rew_logic. auto.
        rew_logic. auto.
  (* Note: it was also possible to first test [Q] and then test [P] *) 
Qed.

(** We still need to explain how negation distributes over existential
    and universal quantifiers. These results can be very useful in practice.
    Interestingly, the simplification of [~ (exists ..)] does not require
    classical logic. Only the simplification of [~ (forall ..)] does. 
    The two proofs appear below. *)

Lemma not_exists : forall A (P:A->Prop),
  (~ (exists x, P x)) = (forall x, ~ P x).
Proof.
  intros. apply prop_ext. split; intros H.
    intros x M. apply H. exists x. auto.
    intros [x M]. apply (H x). auto.
Qed.

Lemma not_forall : forall A (P:A->Prop),
  (~ (forall x, P x)) = (exists x, ~ P x).
Proof.
  intros. apply prop_ext. split; intros H.
    (* here, without classical logic, we would be completely
       stuck because we have absolutely no witness to provide *)
    apply not_not_elim. intros M. apply H.
     intros. apply not_not_elim. intros N.
     apply M. exists x. apply N.
    intros M. destruct H as [x H]. apply H. apply M.
Qed.

(** The following example shows how to distribute negation over
    universal and existential quantifiers. *)

Lemma rew_logic_demo_2 : forall (P : nat -> Prop), 
  ~ (forall n, n <> 0 -> exists m, m <> n /\ ~ P m) ->
    (exists n, n <> 0 /\ forall m, m = n \/ P m).
Proof.
  intros P H.
  (* distribute [not] over [forall] *)
  rewrite not_forall in H. 
  destruct H as [n H]. exists n.
  (* simplify a logical expression *)
  rew_logic.
  destruct H as [H1 H2]. split. auto. intros m.
  (* distribute [not] over [exists] *)
  rewrite not_exists in H2. 
  specialize (H2 m).
  (* simplify a logical expression *)
  rew_logic. auto.
Qed.
  
(** Note: for technical reasons, we cannot extend our simplification tactic
    [rew_logic] with the lemmas [not_forall]. Indeed, because Coq internally
    represents implication as a universal quantification, the pattern
    [~ (forall x, P x)] would match any proposition of the form [~ (P -> Q)],
    leading to unwanted rewriting operations being performed. *)

(** When working in a classical logic, facts can be very easily moved
    from the goal to the context and reciprocally by taking the negation.
    We set up two new tactics to assist in this process. The tactic [up]
    applies to an arbitrary goal [P], replaces the goal with [False] and 
    adds [~ P] as assumption. The tactic [down H] replaces the current
    goal with [~ H] and adds the negation of the current goal as hypothesis.     
    Below, we implement the two tactics and then give a demo. *)

Ltac up H :=
  apply not_not_elim; intros H; 
  autorewrite with rew_logic in H.

Lemma down_lemma : forall (P Q : Prop), P -> ~ P -> Q.
Proof. tauto. Qed.

Ltac down H :=
  match goal with
  | |- False => idtac
  | _ => let G := fresh "G" in up G
  end;
  apply (@down_lemma _ _ H);
  clear H; autorewrite with rew_logic.
  
(** A demo follows. This demo shows in particular that reasoning
    by contraposition is made very simple. *)

Lemma up_demo : forall (P : nat->Prop) (n m : nat),
  (n <> m -> ~ P n) -> P n -> n = m.
Proof.
  intros P n m U V. up W. apply U. auto. auto.
Qed.

(** The same lemma can also be proved by applying the tactic [down] to
    the first hypothesis, thereby computing the negation of an implication. *)

Lemma down_demo : forall (P : nat->Prop) (n m : nat),
  (n <> m -> ~ P n) -> P n -> n = m.
Proof.
  intros P n m U V. down U. auto.
Qed.

(** Note that, without classical logic, the proof of the above lemma would
    need to invoke the lemma [eq_dec_nat] in order to perform a case analysis
    on whether [n = m] or [n <> m]. With classical logic, all predicates are
    decidabile by default, so proofs can be much simpler. *)


(* ********************************************************************** *)
(* ********************************************************************** *)
(* ********************************************************************** *)
(** * Non-constructivism *)

(** The "excluded middle" property captures the fact that, inside a proof,
    we can make a case analysis on whether a proposition is true or false.
    The "strong excluded middle" property states that we can make a case
    analysis on whether a proposition is true or false not just inside a 
    proof, but even inside any definition. For example, with the strong
    excluded middle we can define the min function simply as 
    [fun n m => If n < m then n else m], without having to worry about
    whether comparison is decidable. We are only saying "if the property
    [n < m] is true, then [min n m] should be equal to [n], otherwise it
    should be equal to [m]". However, we are not providing any concrete way 
    of computing whether [n] is less than [m]. This is why such a definition
    of [min] is said to be "non-constructive".

    The excluded middle was stated using a normal disjunction, [P \/ ~P]. 
    The strong excluded middle is similar except that it uses a strong sum,
    of the form [{P} + {~P}]. Its statement is thus as follows.
*)

Axiom classicT : forall (P : Prop), {P} + {~ P}.

(** If [P] is a proposition, then [classicT P] is an term of type
    [{P} + {~ P}] which can be examined using a Coq if-statement.
    For example, in the definition of the minimum function, the argument 
    of the if-statement is [classicT (n < m)], as shown below. *)

Definition min' n m := 
  if classicT (n < m) then n else m.

(** In a non-constructive logic, the pattern [if classicT P then .. else ..] 
    is very common. So, we introduce a specific notation for it, in order
    to simply write [If P then v1 else v2] (starting with a capital "i"). *)

Notation "'If' P 'then' v1 'else' v2" := 
  (if (classicT P) then v1 else v2)
  (at level 200, right associativity) : type_scope.

(** For example, we can re-define [min] using this notation *)

Definition min n m :=
  If n < m then n else m.

(** At this point, we know how to write non-constructive definitions.
    Let's now see how to prove properties about non-constructive 
    definitions. For example, let's prove that [min] is associative. 
    Whenever we see a pattern of the form [If P then v1 else v2], we
    can perform a case analysis on [P] using [destruct (classictT P)]. *)

Lemma min_assoc_1 : forall n m p,
  min n (min m p) = min (min n m) p.
Proof.
  intros. unfold min.
  destruct (classicT (m < p)).
    destruct (classicT (n < m)). 
      destruct (classicT (n < p)). omega. omega. 
      destruct (classicT (m < p)). omega. omega.
    destruct (classicT (n < m)).
      auto.
      destruct (classicT (n < p)).
        omega.
      destruct (classicT (m < p)). omega. omega.
Qed.

(** Testing whether the condition of a if-statement is true or false
    is something that we keep repeating over and over in the proof above.
    More generally, it is very common that we want to perform a case
    analysis on the condition from an if-statement. So, we introduce a
    tactic, called [case_if], that looks in the goal for the first if-
    statement that it finds and perform a case analysis on its condition. *)

Ltac case_if :=
  let go P := destruct P; try solve [elimtype False; congruence] in
  match goal with 
  | |- context [if ?P then _ else _] => go P
  | K: context [if ?P then _ else _] |- _ => go P
  end.

(** Using [case_if], we can now revisit the proof of associativity of 
    the mininum function. By using [repeat case_if], the proof script
    now fits on a single line! *)

Lemma min_assoc_2 : forall n m p,
  min n (min m p) = min (min n m) p.
Proof. intros. unfold min. repeat case_if; omega. Qed.

(** Sometimes we have in the goal an expression of the form
    [If P then v1 else v2] yet we know that [P] is true. So, rather
    than performing a case analysis on [P] and having to prove that
    [~P] is absurd, we could directly simplify [If P then v1 else v2]
    into [v1] and have [P] appear as a new subgoal. This can be 
    achieved by using the following lemma. *)

Lemma If_l : forall (A:Type) (P:Prop) (x y : A), 
  P -> (If P then x else y) = x.
Proof. intros. case_if. auto. Qed.

(** For example, if we have [If K 3 then True else False] and we
    know that [K n] holds for all [n], then we can perform a rewrite
    step using the lemma [If_l] to simplify the goal into [True]. *)

Lemma If_l_demo : forall (K : nat->Prop),
  (forall n, K n) -> If K 3 then True else False.
Proof. intros. rewrite If_l. auto. auto. Qed.

(** Symmetrically, if our goal contains an expression of the form
    [If P then v1 else v2] and we know that [~P] is true, then we
    may simplify the expression into [v2] directly, using the following
    lemma. *)

Lemma If_r : forall (A:Type) (P:Prop) (x y : A), 
  ~ P -> (If P then x else y) = y.
Proof. intros. case_if. auto. Qed.


(* ********************************************************************** *)
(* ********************************************************************** *)
(* ********************************************************************** *)
(** * Indefinite description *)

(** The strong excluded middle introduces non-constructivism by allowing 
    to test in a program whether a proposition is true or false. The
    indefinite description axiom takes non-constructivism one step further
    by allowing to "pick" a value that satisfies some given property.
    In other words, we can write in a definition "let [x] be a value 
    satisfying the predicate [P]" without having to explicitly say how
    the value [x] can be constructed.

    Technically, if one can prove that the assertion [exists y, P y],
    then applying the indefinite description axiom to [P] returns one
    arbitrary value [x] satisfying [P x]. 

    Indefinite description is a very strong axiom. It is so strong that
    it entails the strong excluded middle, it entails all the version of
    the axiom of choice, and it allows defining Hilbert's epsilon operator
    (which we will describe soon afterwards). The statement of indefinite
    description, shown below, is certainly a bit mysterious at first sight. *)

Axiom indefinite_description : forall (A : Type) (P : A->Prop), 
   ex P -> sig P. 

(** On the one hand, [ex P] is by definition equivalent to [exists x, P x]
    (because the later is a notation for [ex (fun x => P x)]). On the 
    other hand [sig P] is by definition the same as [ { x | P x } ].
    Both [ex P] and [sig P] describe dependent pairs made of a value and
    a proposition. The only difference is that [ex P] is of type [Prop],
    whereas [sig P] is of type [Type]. 

[[
    Inductive ex  (A : Type) (P : A -> Prop) : Prop :=
      ex_intro : forall x, P x -> ex P.
  
    Inductive sig (A : Type) (P : A -> Prop) : Type :=
      exist    : forall x, P x -> sig P.
]]
  
    So, whereas a pair of type [ex P] can only be deconstructed 
    inside a proof to obtain a particular witness [x] satisfying [P],
    a pair type [sigP] can be deconstructed anywhere in order to
    obtain such a witness, and not just in proofs.

    The indefinite description axiom simply says that if we are able
    to build a dependent pair in the sort [Prop], then we can assume
    that we would have been able to build a similar dependent pair
    in the sort [Type]. In technical words, we are "reifying" objects
    from the proof level into objects from the computational level. *)

(** A first consequence of the indefinite description axiom is the
    axiom of choice. The axiom of choice is required for proving
    certain mathematical results, in particular results from topology
    or from category theory. One classic such result is Tychonoff's
    theorem, which states that the product of any collection of
    compact spaces is itself compact.
 
    The axiom of choice can take many forms. All of them are derivable
    from indefinite description. Here, we consider a particular version
    called "functional choice". Functional choice states that if we
    have a binary relation that maps every input to at least one output, 
    then we can build a function that implements this relation in the
    sense that this input and output values of this function are related
    by the relation. More precisely, if [R] is a relation such that for
    any [x] there exists at least one [y] satisfying [R x y], then there
    exists a function [f] such that for any [x] we have [R x (f x)]. *)

Lemma func_choice : forall A B (R:A->B->Prop),
  (forall x, exists y, R x y) ->
  (exists f, forall x, R x (f x)).

(** Remark: if for a given [x] we have several values [y] such that
    [R x y] holds, then [f x] can be equal to any of these values.

    To prove functional choice, we invoke, for each [x], the indefinite 
    description axiom on the predicate [exists y, R x y]. This allows us
    to pick one particular value [y] that is related to [x]. We use this
    value to define the result produced by [f x]. *) 

Proof.
  intros. exists (fun x => proj1_sig (indefinite_description (H x))).
  intros x. apply proj2_sig.
Qed.

(** A second consequence of indefinite description it that it entails
    the excluded middle and even the strong excluded middle (under the
    assumption that we have the propositional extensionality axiom).  
    The proofs are out of the scope of this tutorial. They can be found
    in the TLC library. *)

Lemma classic_derivable : forall (P : Prop), P \/ ~ P.
Admitted.

Lemma classicT_derivable : forall (P : Prop), {P} + {~ P}.
Admitted.

(** A third and very useful application of indefinite description
    is the construction of Hilbert's epsilon operator, which can
    be used to non-constructively "pick" values satisfying some
    predicate. Consider an inhabited type [A] (i.e. such that there
    exists at least one [x] of type [A]). Then, for any predicate [P] 
    of type [A -> Prop], the expression [epsilon P] denotes a term 
    of type [A]. If, on the one hand, there exists at least one [x] 
    satisfying [P], then [epsilon P] also satisfies [P]. If, on the
    other hand, there exists no value satisfying [P], then [epsilon P] 
    could be any abitrary value of type [A].

    Before we can show the definition of [epsilon], we need to
    introduce a proper definition of "inhabited types". Passing 
    around an arbitrary value of type [A] directly as witness is 
    not appropriate because we do not want the result of [epsilon]
    to depend on the witness given. So, in order to capture the
    fact that a type is inhabited without depending on the particular
    witness provided, we introduce a type-class called [Inhab]. If
    you have never used type-classes in Coq, don't worry, we are 
    only going to use type-classes in a very straightforward way. *)

(** A value of type [Inhab A] is a proof that the type [A] is 
    inhabited. By declaring this as a [Class], we will have Coq
    automatically pass around proofs of the form [Inhab A] without
    having to be explicit about thes proofs. The definition of the
    class is as follows. *)

Class Inhab (A:Type) : Prop := 
  { Inhab_intro : exists x:A, True }.

(** To work with type classes, we need to declare the variables
    that are eligible for automatic generalization. So we write: *)

Generalizable Variables A B.

(** The auxiliary lemma [prove_Inhab] helps building a proof of
    [Inhab A] from a given value of type [A]: if [x] is a value
    of type [A], then [prove_Inhab x] is a proof of [Inhab A]. *)

Lemma prove_Inhab : forall (A:Type), A -> Inhab A.
Proof. intros A x. constructor. exists x. auto. Qed. 

(** For example, we can prove that the type [nat] is inhabited.
    By using the word [Instance] instead of [Lemma], we register
    the corresponding statement in a database, making it possible
    for Coq to automatically refer to this result when it is looking
    for some evidence that [nat] is inhabited. *)

Instance bool_Inhab : Inhab nat.
Proof. apply (prove_Inhab 0). Qed.

(** When we have an inhabited type, we can ask for an arbitrary
    value of that type. We will need to do so in the definition
    of [epsilon]. So, let's introduce the definition [arbitrary].
    Below, the argument [`{Inhab A}] indicates that [arbitrary] 
    expects a type [A] and of proof that this type is inhabited.
    Moreover, it indicates that these arguments will be passed
    automatically so we need not be explicit about them. *)

Definition arbitrary `{Inhab A} : A :=
  proj1_sig (@indefinite_description A _ Inhab_intro).

(** For example, we can define the function [pred] using [arbitrary]. *)

Definition pred n :=
  match n with
  | O => arbitrary
  | S m => m
  end.

(** We are now ready to present the epsilon operator. Before we look
    at the definition of [epsilon] in terms of [indefinite_description], 
    let us first look at the interface that the epsilon operator
    satisfies. *)

Module Type EpsilonInterface.

(** If [A] is inhabited, then [epsilon P] is a value of type [A]. *)

Parameter epsilon : forall `{Inhab A} (P : A -> Prop), A.

(** If there exists a value [x] satisfying [P], then [epsilon P]
    satisfies [P]. This result captures the fact that [epsilon]
    not only knows in advance whether [P] is satisfiable, but it
    is even able to pick one value satisfying [P] when there
    exists one. *)

Parameter epsilon_spec : forall `{Inhab A} (P : A->Prop),
  (exists x, P x) -> P (epsilon P).

(** If [P] and [Q] are two equivalent predicates, then [epsilon P]
    is equal to [epsilon Q]. This result follows directly
    from predicate extensionality: if [P] and [Q] are equivalent
    then [P = Q], hence [epsilon P = epsilon Q]. 

    This result means that when [epsilon] returns a value [x] 
    for one given predicate [P], it has commited itself to 
    returning the exact same value for any other predicate logically
    equivalent to [P]. *)

Parameter epsilon_eq : forall `{Inhab A} (P Q : A->Prop),
  (forall x, P x <-> Q x) -> epsilon P = epsilon Q.

End EpsilonInterface.

(** Let's now investigate the definition of the epsilon operator. The 
    idea is to apply indefinite description for picking a value [x]
    satisfying [(exists y, P y) -> P x]. In other words, if there
    exists at least one value satisfying [P], then epsilon should pick
    one such value. Otherwise, it does not matter what value [epsilon] 
    picks. 

    In order to invoke the indefinite description axiom on the
    predicate [fun x => (exists y, P y) -> P x], we need to show
    that there always exists a value [x] satisfying this predicate,
    that is, [exists x, (exists y, P y) -> P x]. Proving this 
    statement involves classic reasoning. On the one hand, if
    [exists y, P y] is true, then we instantiate [x] with one
    such value [y] and we have [P x]. On the other hand, if
    [exists y, P y] is false, then we instantiate [x] with an 
    arbitrary value of type [A], and the implication 
    [(exists y, P y) -> P arbitrary] holds because [exists y, P y] 
    is false. The following lemma formalizes this piece of reasoning. *)

Lemma epsilon_aux : forall `{Inhab A} (P : A->Prop),  
  ex (fun x => (exists y, P y) -> P x).
Proof.
  intros. destruct (classic (exists y, P y)) as [[y Py]|M].
    exists y. intros _. auto.
    exists arbitrary. intros N. elimtype False. auto.
Qed. 

(** We can now define [epsilon] by applying indefinite description
    to the above result and returning the witness produced by 
    indefinite description. *)

Definition epsilon `{Inhab A} (P : A -> Prop) : A := 
  proj1_sig (indefinite_description (epsilon_aux P)).

(** The specification of the epsilon operator follows directly
    from the definition of indefinite description. *)

Lemma epsilon_spec : forall `{Inhab A} (P : A->Prop),
  (exists x, P x) -> P (epsilon P).
Proof.
  intros A IA P. unfold epsilon. 
  apply (proj2_sig (indefinite_description (epsilon_aux P))).
Qed.

(** The second property of the epsilon operator follows directly 
    from extensionality, as mentioned earlier on. *)

Lemma epsilon_eq : forall `{Inhab A} (P Q : A->Prop),
  (forall x, P x <-> Q x) -> epsilon P = epsilon Q.
Proof. intros. f_equal. apply pred_ext. auto. Qed.

(** We are going to illustrate the interest of the epsilon operator
    on two particular applications. First, we prove the "omniscient
    functional choice", a result slightly stronger than "functional
    choice". Later on, we will show how the epsilon operator can be
    used to build general quotient structures. *)

(** Recall the statement of functional choice. *)

Parameter func_choice' : forall A B (R:A->B->Prop),
  (forall x, exists y, R x y) ->
  (exists f, forall x, R x (f x)).

(** "Omniscient functional choice" is similar to "functional choice" 
    except that it does not require the user to provide up-front a
    proof that the relation [R] maps every input to at least one output. 
    Instead, the omniscient choice produces a function [f] right away, 
    and then, if the user wants to derive [R x (f x)] for a particular
    input value [x], then he needs to prove that there exists at least 
    one value [y] such that [R x y] holds. *)

Lemma omniscient_func_choice : forall A `{Inhab B} (R : A->B->Prop),
  exists f, forall x, (exists y, R x y) -> R x (f x).

(** Omnicient functional choice is stronger than functional choice 
    because it only requires proving [exists y, R x y] for the values
    [x] of interest, and not for all the possible values [x]. 

    The result can be easily proved using the epsilon operator. 
    We build [f] as a function that maps each [x] to the value
    [epsilon (fun y => R x y)]. Using this value for [f x] ensures
    that, if we can prove that there exists at least one [y] satisfying
    [R x y], then we have [R x (f x)], as required. *)

Proof.
  intros A B IB R. exists (fun x => epsilon (fun y => R x y)).
  intros x Hx. apply epsilon_spec. apply Hx.
Qed.


(* ********************************************************************** *)
(* ********************************************************************** *)
(* ********************************************************************** *)
(** * Proof irrelevance *)

(** From propositional extensionality, we can derive "proof irrelevance",
    which is a very interesting logical property. It captures the fact
    that two proofs of a same proposition can be considered to be equal. 
    More precisely, if [u] and [v] are two proof terms for a same
    proposition [P], in the sense that [u : P] and [v : P], then we have
    the equality [u = v]. *)

Parameter proof_irrelevance : forall (P : Prop) (u v : P), u = v. 

(** Intuitively, the reason why proof irrelevance makes sense is because
    Coq forbids to perform case analysis on values of sort [Prop] for
    building values whose type does not have the sort [Prop]. As a result,
    one cannot exploit the fact that the proof terms [u] and [v] have
    been built differently for disproving [u = v]. Because it is not 
    possible to disprove [u = v], it does not hurt the logic to consider
    that [u = v] is true. 

    The proof showing that irrelevance follows from propositional 
    extensionality is quite technical. It can be found in the Coq library
    or in the TLC library. Remark: proof irrelevance also follows from
    the excluded middle. *)

(** Proof irrelevance is crucial for reasoning about dependent pairs,
    and more generally for working with dependent types. To illustrate
    this, assume that we have defined the type [pos] as the subtype
    of natural numbers that are strictly greater than zero. *)

Definition pos := { n:nat | n > 0 }.

(** Recall that this notation stands for:
    [Definition pos := sig (fun n:nat => n > 0)].
    and that [sig] is defined as follows:
    [[
    Inductive sig (A : Type) (P : A -> Prop) : Type :=
      exist : forall x, P x -> sig P.
    ]] *)

(** We can build a value of type [pos] by providing a natural
    number [n] and a proof of [n > 0]. The auxiliary function
    [new_pos], defined below, helps building values of type [pos]. *)

Definition new_pos (n:nat) (H:n>0) : pos :=
  exist (fun n => n > 0) n H.

Implicit Arguments new_pos []. 

(** If we want to prove two values of type [pos] equal, then we need
    to show not only that the two underlying natural numbers are equal, 
    but also that the that the two proofs showing that these numbers
    are nonzero are equal. That's where proof irrelevance is useful.
    Without it, we would not be able to prove that the two proofs are
    equal in general. The use of proof irrelevance appears below. *)

Lemma new_pos_eq : forall (n1 n2 : nat) (H1 : n1>0) (H2 : n2>0), 
  n1 = n2 -> new_pos n1 H1 = new_pos n2 H2.
Proof.
  intros. unfold new_pos.
  (* note that [rewrite] does not work for substituting [n1] with [n2]
     because there are dependencies on [n1] and [n2] *)
  try rewrite H. 
  (* however, [destruct] works here (it does not always work though) *)
  destruct H.  
  (* at this point it only remains to prove [H1] equal to [H2] *)
  f_equal. apply proof_irrelevance.
Qed.

(** Having to prove an equality of the form [exist P x p = exist P y q]
    is a common pattern when working with dependent types. We can
    encapsulate this pattern in the following convenient lemma. *)

Lemma exist_eq :
  forall (A : Type) (P : A->Prop) (x1 x2 : A) (H1 : P x1) (H2 : P x2),
    x1 = x2 -> exist P x1 H1 = exist P x2 H2.
Proof. intros. destruct H. f_equal. apply proof_irrelevance. Qed.

(** For example, we can use this lemma to simplify our proof *)

Lemma new_pos_eq' : forall (n1 n2 : nat) (H1 : n1>0) (H2 : n2>0), 
  n1 = n2 -> new_pos n1 H1 = new_pos n2 H2.
Proof. intros. apply exist_eq. auto. Qed.

(** In summary, proof irrelevance is critical for working with
    dependent types, because when we manipulate pairs made of a 
    value and a proof, we need to reason about equalities between
    proofs. Proof irrelevance allows us to consider that two proofs
    of a same proposition are always equal. *)
    
(** We end this section with one remark that will be useful to those
    working with dependently-typed values. When working with dependent
    pairs that do have computation content, i.e., values of the form
    [existT P x q] and type [sigT P], we need a lemma for extracting
    information about equalities between two such objects. This lemma,
    called "injectivity of dependent pairs" is as follows: *)

Lemma inj_pairT2 : 
  forall (A : Type) (P : A -> Type) (x : A) (H1 H2 : P x),
  existT P x H1 = existT P x H2 -> H1 = H2.
Admitted. (* the proof uses proof irrelevance *)


(* ********************************************************************** *)
(* ********************************************************************** *)
(* ********************************************************************** *)
(** * Quotient structures *)

(** Coq does not support quotient structures very well. Indeed, given
    a type [A] and an equivalence relation [R], the quotient type
    [A/R] can only be built and used in a constructive logic if there
    exists a computable "normalization function" [f] of type [A -> A] 
    that takes each element [x] to the elements that represents the class 
    of [x], i.e., such that [f x = f y <-> R x y]. Even though there
    are many cases where we can find such a computable function [f],
    there are also many cases where there is no such function and thus
    no way of building the quotient type.

    In a non-constructive logic, things are much simpler. Whenever we
    have a type [A] and an equivalence relation [R], we can define a
    (non-constructive) normalization function with help of the epsilon
    operator, and use this function to define the quotient type [A/R]. *) 

Module Quotient.
Require Import Equivalence.

Parameter A : Type.
Parameter IA : Inhab A. Existing Instance IA.
Parameter R : A -> A -> Prop.
Parameter E : Equivalence R.

(** First, we use the epsilon operator to define a function called
    [repr], of type [A -> A], such that [repr x = repr y] if and
    only if [R x y] holds. Intuitively, [repr] maps very element of
    type [x] onto the element that represents the equivalence class 
    of [x].
 
    We define [repr x] as the result of picking a value [y] that is
    related to [x] i.e., a value satisfying the predicate
    [fun y => R x y]. *)

Definition repr x := epsilon (R x).

(** Because [R] is a reflexive relation, [repr x] satisfies [R x].
    This means that [repr x] is, as expected, in the same equivalence
    class as [x]. *)

Lemma repr_elim : forall x,
  R x (repr x).
Proof.
  intros. unfold repr. apply epsilon_spec. 
  exists x. destruct E as [R _ _]. apply R.
Qed.

(** Furthermore, [repr] uniquely characterizes the equivalent classes
    in the sense that [repr x] and [repr y] are equal if and only if
    [x] and [y] belong to the same equivalence class. *)

Lemma repr_spec : forall x y, 
  repr x = repr y <-> R x y.
Proof.
  intros. destruct E as [_ S T].
  generalize (repr_elim x). generalize (repr_elim y). intros Ry Rx.
  split; intros M.
    rewrite M in Rx. eauto.
    unfold repr. apply epsilon_eq. intuition eauto.
Qed.

(** We are now going to define the quotient type [Q] as a subtype of the
    type [A] made of the values that represent an equivalence class,
    i.e., of the values [x] satisfying [x = repr x]. To define the type
    [Q] in Coq, we first define a predicate of the form [is_repr x],
    which captures the fact that the equality [x = repr x] holds. *)

Definition is_repr x := (x = repr x).

(** We define [Q] as [ { x : A | is_repr x } ], which can be formulated
    more concisely as [ sig is_repr ]. *)

Definition Q : Type := sig is_repr.

(** In order to justify that we can use [repr] to map each value of
    type [A] onto its corresponding value in the quotient type [Q],
    we need to prove that [repr] behaves as the identity functions on
    values that are representing an equivalence class. More precisely,
    we need to show that for any [x], [repr x] satisfies the predicate
    [is_repr] (i.e., that we have [repr x = repr (repr x)]). *)

Lemma is_repr_repr : forall x, 
  is_repr (repr x).   
Proof. intros. unfold is_repr. apply repr_spec. apply repr_elim. Qed.

(** Using this property, we can view the function [repr] of type 
    [A->A] as a function of type [A->Q] that takes a value of type 
    [A] and returns the corresponding value in the quotient type [Q].
    This function is called [proj]. *)

Definition proj : A -> Q :=
  fun x => exist is_repr (repr x) (is_repr_repr x).

(** The fact that [repr] characterizes equivalence classes implies
    that [proj] also characterizes equivalence classes: [proj x] 
    and [proj y] are equal values of type [Q] if and only if [x] 
    and [y] belong to the equivalence class. *)

Lemma proj_spec : forall x y,
  proj x = proj y <-> R x y.
Proof.
  intros. unfold proj. split; intros H.
    inversion H. apply repr_spec. auto.
    generalize (proj2 (repr_spec x y) H).
     intros. apply exist_eq. auto.
Qed. 

(** It may also be useful to define a function that takes values
    from the quotient type [Q] back to the original type [A].
    Because [Q] is a subtype of [A], this function is implemented
    simply by returning the first projection. *)

Definition unproj : Q -> A :=
  fun q => proj1_sig q.

(** The function [unproj] can be used for example to transport 
    a function into the quotient structure, that is, to transform
    a function [f] of type [A->A] into a corresponding function [g]
    of type [Q->Q]. The function [g] can be defined using [f],
    [proj] and [unproj]. The idea is to take an argument [q] of
    type [Q], convert it into an value of type [A] using [unproj], 
    then applying [f] to that value, and finally using [proj] to 
    convert the result back into a value form the quotient type [Q].
    The formal definition appears below. *)
    
Parameter f : A -> A.

Definition g : Q -> Q := 
  fun q => proj (f (unproj q)).

(** In order to translate properties about the function [f] into
    properties about the function [g], one usually need to argue
    at some point in the proof that [f] "respects" the relation [R]. 
    This property is typically stated in the following form: *)

Parameter f_resp : forall x y, R x y -> R (f x) (f y).

(** How to establish and to use such a property is specific to
    the equivalence relation and to the function being considered.
    Going through a complete example would be out of the scope of this
    tutorial, so we end this section here. In summary, the epsilon
    operator offers a general technique for building quotient structures.
    The central idea is that for any equivalence relation [R] the
    function [fun x => epsilon (R x)] is a normalization function that,
    for each equivalence class of [R], picks one particular element to
    represent this equivalence class. *)

End Quotient.



(* ********************************************************************** *)
(* ********************************************************************** *)
(* ********************************************************************** *)
(** * Recursive functions *)

Module FixedPoints.
Require Import Even.

(** The epsilon operator can be used to define the "optimal fixed
    point combinator". This combinator can be used to define (partial)
    recursive functions for which termination is nontrivial to justify.
    More precisely, the optimal fixed point combinator allows one to
    construct the fixed point of any functional, without having to 
    justify termination; then, subsequently, one can derive a fixed point
    equation that holds on the domain of definition of the function.

    This approach has two benefits compared to what can be done in a
    constructive logic. First, one is able to completely separate the
    definition of the function from the justification of why the definition
    actually admits a fixed point. In particular, the domain of the 
    function and the termination relation used to argue for termination
    need not be provided at the time of defining the function. Second,
    one is able to justify the termination of the function through
    interactive proofs that need not involve dependently-typed values.
    This makes the definition of nontrivial partial recursive function
    accessible to those who do not master programming with dependent types.

    The optimal fixed point combinator takes as argument a functional and
    returns its fixed point, of type [A->B]. The only restriction is that 
    the return type [B] must be inhabited. Note: in this tutorial, we do 
    not discuss the implementation of the fixed point combinator but only
    explain how to use it. *)

Parameter FixFun : forall A `{Inhab B} (F:(A->B)->(A->B)), (A->B).

(** We will illustrate the working of the optimal fixed point combinator
    on three examples: a recursive function that terminates only on even
    numbers, a function implementing division (this function does not
    terminate if its second argument is zero), and the Ackerman function
    (whose termination relation involves a lexicographical order).

    To start with, consider the following ML function [f]. It is defined
    in such a way that [f 0] is equal to 1, [f 1] diverges, and [f n] is 
    equal to 2 + [f (n-2)]. This is quite an artificial example, but it
    will very clearly illustrate the working of the optimal fixed point.

[[
let rec f n =
  if n = 0 then 1 else 
  if n = 1 then 1 + f 1 else
  2 + f (n - 2).
]]

    Because this function is not total (it does not terminate odd arguments),
    it cannot be translated into a Coq fixpoint. So, we are going to describe
    this recursive function in the form of a functional, that is, a function
    that is like the function [f] that we want to define except that it takes
    as argument an extra argument representing the function that should be 
    used to make recursive calls. Here, the functional is named [F] and its
    extra argument is named [f]. *)

Definition F f n :=
  If n = 0 then 1 else 
  If n = 1 then 1 + f 1 else
  2 + f (n - 2).

(** We now want to build the fixed point of this functional [F]. That is,
    a function [f] such that we have [f n = F f n] for any [n] in the
    domain of definition [f]. We can obtain such a fixed point simply
    by applying the optimal fixed point combinator [FixFun] to the 
    functional [F]. Note that we do not need to provide the domain of the
    recursive function at this point. *)

Definition f := FixFun F.

(** At this point, we have build one function [f]. For the time being,
    we know nothing about the properties of [f]. We are now going to
    prove that we have [f n = F f n] whenever [n] is even. Using this
    result, whenever we see an application of the form [f n] for some
    even number [n], we are able to "unfold" the definition of [f] and
    rewrite [f n] into:

[[
  If n = 0 then 1 else 
  If n = 1 then 1 + f 1 else
  2 + f (n - 2).
]]

    The fixed point equation is formally stated as follows. *)

Parameter F_fix_statement : forall n, even n ->
  f n = F f n.

(** In order to prove this fixed point equation, it suffices to
    establish that the functional [F] is "contractive" with respect
    to some well-founded relation [R] on the domain of [f], which
    is the set of even values. The definition of contractiveness is
    the one nontrivial notion involved here. To present it, we first
    state its definition in the particular case of a total function,
    we will then generalize it to the case of a partial function, and 
    then we will see how we prove functions contractive in practice.

    A functional [F] describing a non-partial recursive function is
    "contractive" if, for any two functions [f1] and [f2] and for any
    argument [x], we can prove the equality [F f1 x = F f2 x] under the
    assumption that [f1] and [f2] agree on all values strictly smaller 
    than [x]. Formally, [F] is contractive if:

    [[ forall f1 f2 x, 
       (forall y, R y x -> f1 y = f2 y) ->
        F f1 x = F f2 x.
    ]]

    Basically, [F f1 x] and [F f2 x] correspond to two copies of the
    body of the function [f], where in the first copy the recursive
    calls are made using an abstract function called [f1] and where in 
    the second copy the recursive calls are made using another abstract
    function [f2]. To prove the two copies equal, we need to argue that
    for each recursive call made on a value [y] we have [f1 y = f2 y].   
    Because the only assumption that we have about [f1] and [f2] is 
    that they agree on arguments strictly smaller than [x] (here [R y x]
    should be read [y] smaller than [x] w.r.t. [R]), we will be forced
    to giving some evidence that if a recursive call made on a value [y]
    then this value is smaller than [x].

    It turns out that establishing that a functional is contractive
    suffices to prove the existence of a unique fixed point and to
    derive a fixed point equation for the functional considered.

    The formal definition of the contraction condition appears next.
    It generalizes our previous definition to include a domain [P].
    On the one hand, we can assume that our current argument [x] is in 
    the domain. On the other hand, we have to prove that recursive calls
    are made to values [y] that are also in the domain. *)

Definition contractive A B (P:A->Prop) 
    (F:(A->B)->(A->B)) (R:A->A->Prop) :=
  forall f1 f2 x, P x -> 
  (forall y, P y -> R y x -> f1 y = f2 y) ->
  F f1 x = F f2 x.

(** The specification of the optimal fixed point combinator states that
    if [f] has been built as the optimal fixed point of a functional [F]
    and if [F] is contractive on some domain [P] with respect to some 
    well-founded [R], then the function [f] satisfies the fixed point 
    equation [f x = F f x] on the domain [P]. *)

Parameter FixFun_fix : forall A (R:A->A->Prop) (P:A->Prop)
  `{Inhab B} (F:(A->B)->(A->B)) (f:A->B),
  f = FixFun F -> well_founded R -> contractive P F R ->
  (forall x, P x -> f x = F f x).

Implicit Arguments FixFun_fix [A B F f].

(** Using this property, we can prove that [f n = F f n] holds for
    any even [n]. To achieve this, we instantiate the well-founded 
    relation [R] as [<] and we instantiate [P] as [even]. 

    In order to carry out the proof, we will use an auxiliary tactic
    called [math] to help us discard arithmetic goals that contain
    a contradiction in their hypotheses. We also use an auxiliary lemma
    for reasoning about the fact that [even n] implies [even (n-2)] when
    [n] is not 0 nor 1. The tactic and the lemma appear below. *)

Ltac math := first [ simpl; omega | elimtype False; omega ].

Lemma even_minus_2 : forall n, 
  even n -> n <> 0 -> n <> 1 -> even (n - 2).
Proof.
  intros. inversion H. math. inversion H2.
  simpl. rewrite <- minus_n_O. auto.
Qed.

(** The proof of the fixed point equation is then as follows. It 
    starts with an application of the specification of the optimal
    fixed point combinator ([FixFun_fix]). It then establishes the
    "contraction condition", i.e., the fact that [F] is contractive. *)

Lemma f_fix : forall n, even n ->
  f n = F f n.
Proof.
  (* first, we apply the specification of the combinator *)
  eapply (FixFun_fix lt). reflexivity. apply lt_wf.
  (* then we prove the contraction condition *)
  intros f1 f2 n Pn IH. unfold F.
  (* we have two copies of the body, one with [f1] and one with [f2] *)
  (* we case-analyse until we reach the recursive calls *)
  case_if. auto.
  case_if.
    (* the case where the function diverge cannot happen because 
       [n = 1] is not possible when we have [even n] *)
    subst. inversion Pn. inversion H0.
    (* in the general case, we simplify the two bodies *)
    f_equal.
    (* until the point where we reach a recursive call, in which
       situation we invoke the assumption relating [f1] and [f2] *)
    apply IH. 
      (* first, we need to prove that the recursive call is made
         inside the domain: we have [even n] and we know that [n] 
         is not 0 nor 1, so we can deduce [even (n-2)] *)
      apply even_minus_2; auto.
      (* second, we have to show that recursive call was made on
         a strictly smaller value than the current argument *)
      math.
Qed.

(** Once we have the fixed point equation, we can use it to prove
    concrete properties about the recursive function. For example,
    we can prove that for any even [n], the value [f n] is equal
    to [n + 1]. We can prove this property by induction on [n]. *)

Lemma f_spec : forall n, even n -> f n = 1 + n.
Proof.
  (* first we set up the induction *)
  intros n. pattern n. apply (well_founded_ind lt_wf). clear n.
  intros n IH E. 
  (* then we unfold the definition of [f] *)
  rewrite f_fix; [| assumption ]. unfold F.
  (* now we can analyse the body of [f] *)
  case_if. math.
  case_if. subst. inversion E. inversion H0.
  (* on the recursive call, we invoke the induction hypothesis *)
  rewrite IH. math. math. apply even_minus_2; auto.
Qed.

(** In summary, our development was three-step:

    - define the functional and build its fixed point,
    
    - derive the fixed point equation by proving the functional 
      to be contractive,

    - prove properties of the function by rewriting with the 
      fixed point equation in order to unfold the definition.

    Observe that, for reasoning about the function [f], we were
    required to set up a proof by induction on the termination
    relation [<] and we had to justify again that the recursive
    calls were made to smaller values. We thereby had to duplicate
    some of the arguments already given in the proof of the fixed
    point equation (in [f_fix]). This situation is a bit unsatisfying
    because it duplicates some material, however it does not seem
    to be possible to do better without some tool support. In the 
    future, we can hope some support for automatically generating
    reasoning principles for recursive functions, in the same
    style as done by the implementation of the [Program Fixpoint]
    feature of Coq. We could thereby get the same convenient features 
    as in [Program Fixpoint], yet without having to be manipulating
    dependently-typed values. Nevertheless, despites the fact that 
    there might be some duplicated arguments, this duplication can
    be largely avoided by introducing the appropriate auxiliary
    lemmas, like we did for example by introducing [even_minus_2]. 
    So, even without specific tool support, the optimal fixed point
    combinator can be very useful in practice. *)

(** We now show a slightly more interesting example which consists in
    formalizing the division function. This function has two arguments,
    so we use a version of the fixed point combinator, called [FixFun2]
    that accomodates two arguments. (Remark: [FixFun2] is defined in
    terms of [FixFun] by packing the two arguments into a pair. *)

Parameter FixFun2 :
  forall A1 A2 `{Inhab B} (F:(A1->A2->B)->(A1->A2->B)), (A1->A2->B).

(** The division function that we consider returns a pair made of
    the quotient and the remainder. Because the result type needs
    to be proved inhabited, we need a lemma to establish that pairs
    are inhabited when both their components are inhabited. *)

Instance prod_Inhab : forall `{Inhab A} `{Inhab B}, Inhab (A*B).
Proof. intros. apply (prove_Inhab (arbitrary,arbitrary)). Qed.

(** The functional associated with the division function [div] is
    defined below. The intention is that [div n m] returns a pair
    [(q,r)] such that [n = q*m + r] and [r < m]. Observe that the
    recursion is non-structural (recursive calls are of the form
    [div (n-m) m], and that the recursive function does not terminate
    when [m = 0]. *)

Definition Div div n m :=
  If n < m then (0,n) 
  else let '(q,r) := div (n-m) m in 
       (q+1,r).

(** We now build the optimal fixed point. *)

Definition div := FixFun2 Div.

(** For reasoning about the function, we use a generalization of
    the lemma [FixFun_fix] that accomodates two arguments. Observe
    that the well-founded relation involved is now a binary 
    relation over pairs of arguments. *)

Parameter FixFun2_fix : forall A1 A2 (R:A1*A2->A1*A2->Prop)
    (P:A1->A2->Prop) `{IB:Inhab B} F (f:A1->A2->B), 
  f = FixFun2 F -> well_founded R -> 
  (forall x1 x2 f1 f2, P x1 x2 ->   
    (forall y1 y2, P y1 y2 -> R (y1,y2) (x1,x2) -> f1 y1 y2 = f2 y1 y2) ->
     F f1 x1 x2 = F f2 x1 x2) ->
  (forall x1 x2, P x1 x2 -> f x1 x2 = F f x1 x2).

Implicit Arguments FixFun2_fix [A1 A2 B IB F f].

(** The function [div] terminates when [m <> 0] because the
    first argument strictly decreases on each recursive call.
    We could define the termination relation [R] as 
    [fun (n1,m1) (n2,m2) => n1 < n2] and prove this particular
    relation well-founded. However, it saves some effort to use
    a "measure", because a measure is always well-founded.

    If [m] is a function that "measures" the size of the arguments,
    and if the measure decreases on every recursive calls, then
    [fun y x => m y < m x] is a well-founded binary relation that 
    can be used to prove termination. We define the predicate
    [measure] in such a way that it turns a measure [m] into a
    well-founded binary relation, as shown below. *)

Definition measure (A:Type) (m:A->nat) : A->A->Prop :=
  fun y x => m y < m x.

Lemma measure_wf : forall A (f:A->nat), well_founded (measure f).
Proof.
  intros A g. intros a. set (n := g a). assert (n = g a). auto.
  clearbody n. revert a H. pattern n. apply (well_founded_ind lt_wf).
  clear n. intros n IH a E. constructor. intros b M. subst.
  apply (IH (g b)); auto.
Qed.

(** Moreover, we extend the tactic [math] so that it is able to 
    automatically unfold the definition of [measure]. *)

Ltac math ::= 
  unfold measure in *; first [ simpl; omega | elimtype False; omega ].

(** For our division function [div] takes two arguments. As explained
    earlier, our termination relation needs to be a binary relation
    over pairs of natural numbers. Since the first argument decreases
    strictly on each recursive calls, [measure fst] denotes the
    relation [fun (n1,m1) (n2,m2) => n1 < n2] that we want to use.

    By applying [FixFun2_fix] to the measure [measure fst], we are
    able to prove a fixed point equation for [div]. *)

Lemma div_fix : forall n m, m <> 0 -> 
  div n m = Div div n m.
Proof.
  eapply (FixFun2_fix (measure (@fst nat nat))). 
  reflexivity. apply measure_wf.
  intros * Posm IH. unfold Div. case_if. auto.
  rewrite IH; auto. math.
Qed.

(** As a third example, we consider the Ackermann function.
    Termination of this function involves a lexicographical
    relation. Let us recall the definition of lexicographical
    relation and the fact that they are well-founded. *)

Definition lexico2 {A1 A2} (R1:A1->A1->Prop) (R2:A2->A2->Prop)
    : (A1*A2)->(A1*A2)->Prop :=
  fun p1 p2 => let '(x1,x2) := p1 in let '(y1,y2) := p2 in
  (R1 x1 y1) \/ (x1 = y1) /\ (R2 x2 y2).

Parameter lexico2_wf : forall {A1 A2} 
    (R1:A1->A1->Prop) (R2:A2->A2->Prop),
  well_founded R1 -> well_founded R2 -> well_founded (lexico2 R1 R2).

(** The Ackermann function is defined as shown next. *)

Definition Ack ack m n :=
  If m = 0 then n+1 else 
  If n = 0 then ack (m-1) 1 else
  ack (m-1) (ack m (n-1)).

Definition ack := FixFun2 Ack.

(** We can prove the fixed point equation using [FixFun2_fix]. 
    This time, our function is total, so we use [fun _ _ => True]
    to describe its domain. *)

Lemma ack_fix : forall m n, 
  ack m n = Ack ack m n.
Proof.
  intros. eapply (FixFun2_fix (lexico2 lt lt) (fun _ _ => True));
   auto. apply lexico2_wf; apply lt_wf.
  intros * _ IH. unfold Ack. case_if. auto. case_if.
  rewrite IH; auto. math.
  rewrite IH; auto. rewrite IH; auto. math. math.
Qed.

(** Exercise: following the pattern of the Ackermann function, 
    define a greatest common denominator (GCD) function based on
    Euclide's algorithm, and then state and prove a fixed point
    for it. In ML, this [gcd] function would be defined as follows.
[[
    let rec gcd x m =
       if n = 0 then m else
       if m = 0 then n else
       if n <= m then gcd n (m-n) 
                 else gcd (n-m) m
]]
    For the termination measure, you should use the sum of the
    two arguments. So, in the proof of the fixed point equation, 
    you will need to provide [measure (fun p => fst p + snd p)]
    as first argument to [FixFun2_fix], and use the lemma
    [measure_wf] to prove this measure well-founded. *)

(* BEGIN SOLUTION *)

Definition Gcd gcd n m :=
  If n = 0 then m else
  If m = 0 then n else
  If n <= m then gcd n (m-n) else gcd (n-m) m.

Definition gcd := FixFun2 Gcd.

Lemma gcd_fix : forall n m, 
  gcd n m = Gcd gcd n m.
Proof.
  intros. eapply (FixFun2_fix (measure (fun p => fst p + snd p)) 
   (fun _ _ => True)); auto. apply measure_wf.
  intros * _ IH. unfold Gcd. 
  case_if. auto. 
  case_if. auto.
  case_if. rewrite IH; auto. math. rewrite IH; auto. math.
Qed.

(* END SOLUTION *)

(** Follow-up exercise: prove that [gcd n (k*n)] is equal to [n]
    for any [n] and [k]. The proof starts with and induction on [k]. 
    In both cases ([k = 0] and [k = S k']), you will need to invoke
    [rewrite gcd_fix; unfold Gcd] in order to unfold the body of
    the GCD function. 
 
    You will need to use the lemma [rewrite mult_0_r] to prove that
    [S k * 0 = 0], to use the lemma [minus_plus] to prove that
    [n + k*n - n = k*n], and to use the lemma [le_plus_l] to prove
    that [n <= n + k*n].
[[
   Lemma gcd_multiple : forall n k, gcd n (k * n) = n.
]]
*) 

(* BEGIN SOLUTION *)

Lemma gcd_multiple : forall n k, gcd n (k * n) = n.
Proof.
  intros. induction k. simpl. 
  rewrite gcd_fix; unfold Gcd. case_if. auto. case_if. auto.
  rewrite gcd_fix; unfold Gcd. case_if. 
    subst. rewrite mult_0_r. auto.
    simpl. case_if. auto. rewrite If_l.
      rewrite minus_plus. auto.
      apply le_plus_l.
Qed.

(* END SOLUTION *)




End FixedPoints.


(* ********************************************************************** *)
(* ********************************************************************** *)
(* ********************************************************************** *)
(** * Conclusion *)

(** Overall, only three axioms are needed to extend the strength of Coq's
    logic. All the others axioms can be derived from these three axioms.
    The three axioms that we need are:

    - functional extensionality: [(forall x, f x = g x) -> f = g],

    - predicate extensionality: [(P <-> Q) -> (P = Q)],

    - and indefinite description: [ex P -> sig p].


    Adding these axioms to Coq's logic allows to prove mathematical
    theorems that could not be proved otherwise. This includes proofs
    that need to exploit "proof irrelevance" or the "excluded middle" 
    or the "axiom of choice". Moreover, adding these axioms to the logic
    allows for dramatic simplifications in formal developments. In 
    particular, it gives:

    - the ability to [If P then .. else ..] in any definition,

    - tactics for simplifying logical expressions such as [~ (P /\ Q)],

    - equality between provably-equivalent functions and predicates,

    - support for sets with a proper double-inclusion property,

    - the ability to build non-computable quotient structures,

    - the possibility to simplify definitions of nontrivial partial
      recursive and co-recursive functions.


    If you are interested in conducting your own developments using 
    extensionality, the (strong) excluded middle, the epsilon operator,
    the extensional sets and the optimal fixed point combinators,
    you might be interested in using the Coq library TLC, developed by
    the author. This library exports all the lemmas and tactics presented
    in this tutorial, plus many more. Further information about TLC is
    available from http://www.chargueraud.org/softs/tlc .

*)