(** * Rel: Properties of Relations *)

(** This short (and optional) chapter develops some basic definitions
    and a few theorems about binary relations in Coq.  The key
    definitions are repeated where they are actually used (in the
    [Smallstep] chapter of _Programming Language Foundations_),
    so readers who are already comfortable with these ideas can safely
    skim or skip this chapter.  However, relations are also a good
    source of exercises for developing facility with Coq's basic
    reasoning facilities, so it may be useful to look at this material
    just after the [IndProp] chapter. *)

Set Warnings "-notation-overridden,-parsing".
From LF Require Export IndProp.
From Coq Require Import omega.Omega.

(* ################################################################# *)
(** * Relations *)

(** A binary _relation_ on a set [X] is a family of propositions
    parameterized by two elements of [X] -- i.e., a proposition about
    pairs of elements of [X].  *)

Definition relation (X: Type) := X -> X -> Prop.

(** Confusingly, the Coq standard library hijacks the generic term
    "relation" for this specific instance of the idea. To maintain
    consistency with the library, we will do the same.  So, henceforth
    the Coq identifier [relation] will always refer to a binary
    relation between some set and itself, whereas the English word
    "relation" can refer either to the specific Coq concept or the
    more general concept of a relation between any number of possibly
    different sets.  The context of the discussion should always make
    clear which is meant. *)

(** An example relation on [nat] is [le], the less-than-or-equal-to
    relation, which we usually write [n1 <= n2]. *)

Print le.
(* ====> Inductive le (n : nat) : nat -> Prop :=
             le_n : n <= n
           | le_S : forall m : nat, n <= m -> n <= S m *)
Check le : nat -> nat -> Prop.
Check le : relation nat.
(** (Why did we write it this way instead of starting with [Inductive
    le : relation nat...]?  Because we wanted to put the first [nat]
    to the left of the [:], which makes Coq generate a somewhat nicer
    induction principle for reasoning about [<=].) *)

(* ################################################################# *)
(** * Basic Properties *)

(** As anyone knows who has taken an undergraduate discrete math
    course, there is a lot to be said about relations in general,
    including ways of classifying relations (as reflexive, transitive,
    etc.), theorems that can be proved generically about certain sorts
    of relations, constructions that build one relation from another,
    etc.  For example... *)

(* ----------------------------------------------------------------- *)
(** *** Partial Functions *)

(** A relation [R] on a set [X] is a _partial function_ if, for every
    [x], there is at most one [y] such that [R x y] -- i.e., [R x y1]
    and [R x y2] together imply [y1 = y2]. *)

Definition partial_function {X: Type} (R: relation X) :=
  forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2.

(** For example, the [next_nat] relation defined earlier is a partial
    function. *)

Print next_nat.
(* ====> Inductive next_nat (n : nat) : nat -> Prop :=
           nn : next_nat n (S n) *)
Check next_nat : relation nat.

Theorem next_nat_partial_function :
   partial_function next_nat.
Proof.
  unfold partial_function.
  intros x y1 y2 H1 H2.
  inversion H1. inversion H2.
  reflexivity.  Qed.

(** However, the [<=] relation on numbers is not a partial
    function.  (Assume, for a contradiction, that [<=] is a partial
    function.  But then, since [0 <= 0] and [0 <= 1], it follows that
    [0 = 1].  This is nonsense, so our assumption was
    contradictory.) *)

Theorem le_not_a_partial_function :
  ~ (partial_function le).
Proof.
  unfold not. unfold partial_function. intros Hc.
  assert (0 = 1) as Nonsense. {
    apply Hc with (x := 0).
    - apply le_n.
    - apply le_S. apply le_n. }
  discriminate Nonsense.   Qed.

(** **** Exercise: 2 stars, standard, optional (total_relation_not_partial)

    Show that the [total_relation] defined in (an exercise in)
    [IndProp] is not a partial function. *)

Theorem total_relation_not_pf :
  ~ (partial_function total_relation).
Proof.
  unfold not. unfold partial_function. intros Hc.
  assert (0 = 1) as Nonsense. {
    apply (Hc 0 0 1); apply tr.
  }
  congruence. Qed.

(** **** Exercise: 2 stars, standard, optional (empty_relation_partial)

    Show that the [empty_relation] defined in (an exercise in)
    [IndProp] is a partial function. *)

Theorem empty_relation_pf :
  (partial_function empty_relation).
Proof.
  unfold not. unfold partial_function. intros.
  inversion H. inversion H1. Qed.

(* ----------------------------------------------------------------- *)
(** *** Reflexive Relations *)

(** A _reflexive_ relation on a set [X] is one for which every element
    of [X] is related to itself. *)

Definition reflexive {X: Type} (R: relation X) :=
  forall a : X, R a a.

Theorem le_reflexive :
  reflexive le.
Proof.
  unfold reflexive. intros n. apply le_n.  Qed.

(* ----------------------------------------------------------------- *)
(** *** Transitive Relations *)

(** A relation [R] is _transitive_ if [R a c] holds whenever [R a b]
    and [R b c] do. *)

Definition transitive {X: Type} (R: relation X) :=
  forall a b c : X, (R a b) -> (R b c) -> (R a c).

Theorem le_trans :
  transitive le.
Proof.
  intros n m o Hnm Hmo.
  induction Hmo.
  - (* le_n *) apply Hnm.
  - (* le_S *) apply le_S. apply IHHmo.  Qed.

Theorem lt_trans:
  transitive lt.
Proof.
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  apply le_S in Hnm.
  apply le_trans with (a := (S n)) (b := (S m)) (c := o).
  apply Hnm.
  apply Hmo. Qed.

(** **** Exercise: 2 stars, standard, optional (le_trans_hard_way)

    We can also prove [lt_trans] more laboriously by induction,
    without using [le_trans].  Do this. *)

Theorem lt_trans' :
  transitive lt.
Proof.
  (* Prove this by induction on evidence that [m] is less than [o]. *)
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  induction Hmo as [| m' Hm'o].
  - apply le_S. apply Hnm.
  - apply le_S. apply IHHm'o.
Qed.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (lt_trans'')

    Prove the same thing again by induction on [o]. *)

Theorem lt_trans'' :
  transitive lt.
Proof.
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  induction o as [| o'].
  - inversion Hmo.
  - inversion Hmo.
    + apply le_S in Hnm.
      rewrite <- H0.
      apply Hnm.
    + apply le_S.
      apply IHo'.
      apply H0.
Qed.

(** [] *)

(** The transitivity of [le], in turn, can be used to prove some facts
    that will be useful later (e.g., for the proof of antisymmetry
    below)... *)

Theorem le_Sn_le : forall n m, S n <= m -> n <= m.
Proof.
  intros n m H. apply le_trans with (S n).
  - apply le_S. apply le_n.
  - apply H.
Qed.

(** **** Exercise: 1 star, standard, optional (le_S_n)  *)
Theorem le_S_n : forall n m,
  (S n <= S m) -> (n <= m).
Proof.
  intros.
  inversion H.
  - apply le_n.
  - apply le_Sn_le in H1. apply H1.
Qed.

(** [] *)

(** **** Exercise: 2 stars, standard, optional (le_Sn_n_inf)

    Provide an informal proof of the following theorem:

    Theorem: For every [n], [~ (S n <= n)]

    A formal proof of this is an optional exercise below, but try
    writing an informal proof without doing the formal proof first.

    Proof: *)
    (* FILL IN HERE

    [] *)

(** **** Exercise: 1 star, standard, optional (le_Sn_n)  *)
Theorem le_Sn_n : forall n,
  ~ (S n <= n).
Proof.
  unfold not. intros.
  induction n.
  - inversion H.
  - apply IHn, le_S_n, H.
Qed.

(** [] *)

(** Reflexivity and transitivity are the main concepts we'll need for
    later chapters, but, for a bit of additional practice working with
    relations in Coq, let's look at a few other common ones... *)

(* ----------------------------------------------------------------- *)
(** *** Symmetric and Antisymmetric Relations *)

(** A relation [R] is _symmetric_ if [R a b] implies [R b a]. *)

Definition symmetric {X: Type} (R: relation X) :=
  forall a b : X, (R a b) -> (R b a).

(** **** Exercise: 2 stars, standard, optional (le_not_symmetric)  *)
Theorem le_not_symmetric :
  ~ (symmetric le).
Proof.
  unfold symmetric. unfold not. intros.
  assert (Nonsense: 1 <= 0). {
    apply H. apply le_S. apply le_n.
  }
  apply le_Sn_n in Nonsense. congruence.
Qed.

(** [] *)

(** A relation [R] is _antisymmetric_ if [R a b] and [R b a] together
    imply [a = b] -- that is, if the only "cycles" in [R] are trivial
    ones. *)

Definition antisymmetric {X: Type} (R: relation X) :=
  forall a b : X, (R a b) -> (R b a) -> a = b.

(** **** Exercise: 2 stars, standard, optional (le_antisymmetric)  *)
Theorem le_antisymmetric :
  antisymmetric le.
Proof.
  unfold antisymmetric. intros.
  inversion H.
  - reflexivity.
  - omega.
Qed.

(** [] *)

(** **** Exercise: 2 stars, standard, optional (le_step)  *)
Theorem le_step : forall n m p,
  n < m ->
  m <= S p ->
  n <= p.
Proof.
  intros. unfold lt in H.
  apply le_S_n.
  apply le_trans with m.
  - apply H.
  - apply H0.
Qed.
(** [] *)

(* ----------------------------------------------------------------- *)
(** *** Equivalence Relations *)

(** A relation is an _equivalence_ if it's reflexive, symmetric, and
    transitive.  *)

Definition equivalence {X:Type} (R: relation X) :=
  (reflexive R) /\ (symmetric R) /\ (transitive R).

(* ----------------------------------------------------------------- *)
(** *** Partial Orders and Preorders *)

(** A relation is a _partial order_ when it's reflexive,
    _anti_-symmetric, and transitive.  In the Coq standard library
    it's called just "order" for short. *)

Definition order {X:Type} (R: relation X) :=
  (reflexive R) /\ (antisymmetric R) /\ (transitive R).

(** A preorder is almost like a partial order, but doesn't have to be
    antisymmetric. *)

Definition preorder {X:Type} (R: relation X) :=
  (reflexive R) /\ (transitive R).

Theorem le_order :
  order le.
Proof.
  unfold order. split.
    - (* refl *) apply le_reflexive.
    - split.
      + (* antisym *) apply le_antisymmetric.
      + (* transitive. *) apply le_trans.  Qed.

(* ################################################################# *)
(** * Reflexive, Transitive Closure *)

(** The _reflexive, transitive closure_ of a relation [R] is the
    smallest relation that contains [R] and that is both reflexive and
    transitive.  Formally, it is defined like this in the Relations
    module of the Coq standard library: *)

Inductive clos_refl_trans {A: Type} (R: relation A) : relation A :=
    | rt_step x y (H : R x y) : clos_refl_trans R x y
    | rt_refl x : clos_refl_trans R x x
    | rt_trans x y z
          (Hxy : clos_refl_trans R x y)
          (Hyz : clos_refl_trans R y z) :
          clos_refl_trans R x z.

(** For example, the reflexive and transitive closure of the
    [next_nat] relation coincides with the [le] relation. *)

Theorem next_nat_closure_is_le : forall n m,
  (n <= m) <-> ((clos_refl_trans next_nat) n m).
Proof.
  intros n m. split.
  - (* -> *)
    intro H. induction H.
    + (* le_n *) apply rt_refl.
    + (* le_S *)
      apply rt_trans with m. apply IHle. apply rt_step.
      apply nn.
  - (* <- *)
    intro H. induction H.
    + (* rt_step *) inversion H. apply le_S. apply le_n.
    + (* rt_refl *) apply le_n.
    + (* rt_trans *)
      apply le_trans with y.
      apply IHclos_refl_trans1.
      apply IHclos_refl_trans2. Qed.

(** The above definition of reflexive, transitive closure is natural:
    it says, explicitly, that the reflexive and transitive closure of
    [R] is the least relation that includes [R] and that is closed
    under rules of reflexivity and transitivity.  But it turns out
    that this definition is not very convenient for doing proofs,
    since the "nondeterminism" of the [rt_trans] rule can sometimes
    lead to tricky inductions.  Here is a more useful definition: *)

Inductive clos_refl_trans_1n {A : Type}
                             (R : relation A) (x : A)
                             : A -> Prop :=
  | rt1n_refl : clos_refl_trans_1n R x x
  | rt1n_trans (y z : A)
      (Hxy : R x y) (Hrest : clos_refl_trans_1n R y z) :
      clos_refl_trans_1n R x z.

(** Our new definition of reflexive, transitive closure "bundles"
    the [rt_step] and [rt_trans] rules into the single rule step.
    The left-hand premise of this step is a single use of [R],
    leading to a much simpler induction principle.

    Before we go on, we should check that the two definitions do
    indeed define the same relation...

    First, we prove two lemmas showing that [clos_refl_trans_1n] mimics
    the behavior of the two "missing" [clos_refl_trans]
    constructors.  *)

Lemma rsc_R : forall (X:Type) (R:relation X) (x y : X),
       R x y -> clos_refl_trans_1n R x y.
Proof.
  intros X R x y H.
  apply rt1n_trans with y. apply H. apply rt1n_refl.   Qed.

(** **** Exercise: 2 stars, standard, optional (rsc_trans)  *)
Lemma rsc_trans :
  forall (X:Type) (R: relation X) (x y z : X),
      clos_refl_trans_1n R x y  ->
      clos_refl_trans_1n R y z ->
      clos_refl_trans_1n R x z.
Proof.
  intros. induction H.
  - apply H0.
  - apply (rt1n_trans R x y z).
    + apply Hxy.
    + apply IHclos_refl_trans_1n, H0.
Qed.
(** [] *)

(** Then we use these facts to prove that the two definitions of
    reflexive, transitive closure do indeed define the same
    relation. *)

(** **** Exercise: 3 stars, standard, optional (rtc_rsc_coincide)  *)
Theorem rtc_rsc_coincide :
         forall (X:Type) (R: relation X) (x y : X),
  clos_refl_trans R x y <-> clos_refl_trans_1n R x y.
Proof.
  intros. split.
  + intros. induction H.
    - apply rsc_R, H.
    - apply rt1n_refl.
    - apply (rsc_trans X R x y z).
      * apply IHclos_refl_trans1.
      * apply IHclos_refl_trans2.
  + intros. induction H.
    - apply rt_refl.
    - apply (rt_trans R x y z).
      * apply rt_step, Hxy.
      * apply IHclos_refl_trans_1n.
Qed.
(** [] *)

(* Wed Jan 9 12:02:46 EST 2019 *)


Require Import VST.floyd.proofauto.
Require Import FunInd.
Require Import Znumtheory.

Open Scope Z.

Fixpoint product (L: list Z): Z :=
  match L with
  | [] => 1
  | x :: t => x * product t
  end.

Theorem product_app (L1 L2: list Z): product (L1 ++ L2) = product L1 * product L2.
Proof.
  induction L1; simpl; lia.
Qed.

Theorem prime_divisor_existence (n: Z) (H: 2 <= n):
  exists p, prime p /\ Z.divide p n.
Proof.
  assert (0 <= n) by lia. revert H. pattern n. apply Z_lt_induction; auto. clear n H0. intros.
  destruct (prime_dec x).
  + exists x. split; auto. exists 1. lia.
  + apply not_prime_divide in n; try lia. destruct n as [n [H1 H2]]. destruct H2.
    subst. assert (0 <= x0 < x0 * n) by nia. assert (2 <= x0) by nia. pose proof (H _ H2 H3).
    destruct H4 as [p [H4 H5]]. exists p. split; auto. destruct H5. subst. exists (x * n). lia.
Qed.

Theorem fta_existence (n: Z) (H: 1 <= n): exists (L: list Z), Forall prime L /\ product L = n.
Proof.
  assert (0 <= n) by lia. revert H. pattern n. apply Z_lt_induction; auto. intros. clear n H0.
  assert (x = 1 \/ 1 < x) by lia. destruct H0.
  + subst. exists nil. simpl. repeat try split. constructor.
  + assert (2 <= x) by lia. destruct (prime_divisor_existence x H2) as [p [H3 H4]].
    destruct H4. assert (1 < p) by (inversion H3; auto).
    assert (0 <= x0 < x) by nia. assert (1 <= x0) by nia.
    assert (x0 = 1 \/ 1 < x0) by lia. destruct H8.
    - assert (x = p) by lia. exists [x]. split.
      * constructor; auto. congruence.
      * simpl. lia.
    - assert (0 <= p < x) by nia. assert (1 <= p) by nia.
      pose proof (H _ H6 H7). pose proof (H _ H9 H10). destruct H11 as [L1 H11], H12 as [L2 H12].
      exists (L1 ++ L2). destruct H11, H12. split.
      * apply Forall_app. auto.
      * rewrite product_app. lia.
Qed.

Theorem prime_divisor_of_prime_product (p: Z) (H: prime p) (L: list Z) (H0: Forall prime L):
  Z.divide p (product L) -> In p L.
Proof.
  induction L.
  + simpl in *. intros. destruct H1. assert (1 < p) by (inversion H; auto).
    symmetry in H1. rewrite Zmult_comm in H1. assert (p >= 0) by lia. pose proof (Zmult_one _ _ H3 H1).
    lia.
  + simpl in *. inversion H0; subst; clear H0. intros. apply prime_mult in H0; auto. destruct H0.
    - apply prime_div_prime in H0; auto.
    - auto.
Qed.

Theorem prime_product_one_empty_list (L: list Z): Forall prime L -> product L = 1 -> L = [].
Proof.
  intros. destruct L; auto. simpl in *. inversion H; subst; clear H. exfalso.
  assert (1 < z) by (inversion H3; auto). assert (z >= 0) by lia. pose proof (Zmult_one _ _ H1 H0).
  lia.
Qed.

Theorem Forall_elt2 A (L1 L2: list A) (x: A) (P: A -> Prop):
  Forall P (L1 ++ x :: L2) -> Forall P (L1 ++ L2).
Proof.
  induction L1.
  + simpl. intros. inversion H; subst; clear H. auto.
  + simpl. intros. inversion H; subst; clear H. apply IHL1 in H3. constructor; auto.
Qed.

Theorem prime_product_ge_one (L: list Z): Forall prime L -> product L >= 1.
Proof.
  induction L; intros.
  + simpl. lia.
  + simpl. inversion H; subst; clear H. inversion H2. pose proof (IHL H3). nia.
Qed.

Theorem product_split (L1 L2: list Z) (x: Z): x * product (L1 ++ L2) = product (L1 ++ x :: L2).
Proof.
  induction L1.
  + simpl. auto.
  + simpl. lia.
Qed.

Theorem fta_unique (n: Z) (H: 1 <= n) (L1 L2: list Z):
  Forall prime L1 -> product L1 = n ->
  Forall prime L2 -> product L2 = n ->
  Permutation L1 L2.
Proof.
  assert (0 <= n) by lia. revert H L1 L2. pattern n. apply Z_lt_induction; auto. intros. clear n H0.
  assert (x = 1 \/ 2 <= x) by lia. destruct H0.
  + subst. assert (L1 = []).
    { apply prime_product_one_empty_list; auto. }
    assert (L2 = []).
    { rewrite H0 in H5. apply prime_product_one_empty_list; auto. }
    subst. constructor.
  + pose proof (prime_divisor_existence _ H0). destruct H6. destruct H6.
    assert (Z.divide x0 (product L1)) by congruence.
    assert (Z.divide x0 (product L2)) by congruence.
    apply prime_divisor_of_prime_product in H8; auto.
    apply prime_divisor_of_prime_product in H9; auto.
    apply in_split in H8. apply in_split in H9.
    destruct H8 as [l1 [l2 H8]]. destruct H9 as [l3 [l4 H9]].
    rewrite H8, H9. apply Permutation_elt. destruct H7. rewrite H7 in *.
    assert (product (l1 ++ l2) = x1).
    { pose proof (product_split l1 l2 x0). rewrite <- H8 in H10. rewrite H3 in H10.
      assert (0 < x0) by (inversion H6; lia). nia. }
    assert (product (l3 ++ l4) = x1).
    { pose proof (product_split l3 l4 x0). rewrite <- H9 in H11. rewrite H5 in H11.
      assert (0 < x0) by (inversion H6; lia). nia. }
    assert (Forall prime (l1 ++ l2)) by (apply Forall_elt2 with (x:=x0); congruence).
    assert (Forall prime (l3 ++ l4)) by (apply Forall_elt2 with (x:=x0); congruence).
    assert (1 <= x1).
    { rewrite <- H10. pose proof (prime_product_ge_one (l1 ++ l2) H12). lia. }
    assert (1 < x0) by (inversion H6; lia).
    assert (0 <= x1 < x1 * x0) by nia.
    apply (H x1); auto.
Qed.


Require Export Tactics.

Check 3 = 3.

Check forall n m : nat, n + m = m + n.

Definition injective {A B} (f : A -> B) :=
  forall x y : A, f x = f y -> x = y.

Check injective.

Lemma succ_inj : injective S.
Proof.
  intros n m H. inversion H. reflexivity.
Qed.

Example and_example : 3 + 4 = 7 /\ 2 * 2 = 4.
Proof.
  split.
  - simpl. reflexivity.
  - simpl. reflexivity.
Qed.

Lemma and_intro : forall A B : Prop, A -> B -> A /\ B.
Proof.
  intros A B.
  intros HA.
  intros HB.
  split.
  - apply HA.
  - apply HB.
Qed.

Example and_example' : 3 + 4 = 7 /\ 2 * 2 = 4.
Proof.
  apply and_intro.
  - reflexivity.
  - reflexivity.
Qed.

Example and_exercise :
  forall n m : nat, n + m = 0 -> n = 0 /\ m = 0.
Proof.
  intros n m.
  destruct n.
  - simpl.
    intros H.
    apply and_intro.
    + reflexivity.
    + apply H.
  - intros H.
    simpl in H.
    inversion H.
Qed.

Lemma and_example2 :
  forall n m : nat, n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m.
  intros H.
  destruct H as [Hn Hm].
  rewrite -> Hn.
  rewrite -> Hm.
  reflexivity.
Qed.

Lemma and_example2' :
  forall n m : nat, n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m.
  intros [Hn Hm].
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example3 :
  forall n m : nat, n + m = 0 -> n * m = 0.
Proof.
  intros n m H.
  assert (H' : n = 0 /\ m = 0).
  { apply and_exercise. apply H. }
  destruct H' as [Hn Hm].
  rewrite Hn. reflexivity.
Qed.

Lemma proj1 : forall P Q : Prop,
  P /\ Q -> P.
Proof.
  intros P Q.
  intros H.
  destruct H as [HP HQ].
  apply HP.
Qed.

Lemma proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
  intros P Q H.
  destruct H as [HP HQ].
  apply HQ.
Qed.

Theorem and_assoc : forall P Q R : Prop,
  P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
  intros P Q R.
  intros [HP [HQ HR]].
  split.
  - split.
    + apply HP.
    + apply HQ.
  - apply HR.
Qed.

Lemma or_example :
  forall n m : nat, n = 0 \/ m = 0 -> n * m = 0.
Proof.
  intros n m [Hn | Hm].
  - rewrite -> Hn.
    reflexivity.
  - rewrite -> Hm.
    rewrite <- mult_n_O.
    reflexivity.
Qed.

Lemma or_intro : forall A B : Prop, A -> A \/ B.
Proof.
  intros A B.
  intros HA.
  left.
  apply HA.
Qed.

Lemma zero_or_succ :
  forall n : nat, n = 0 \/ n = S (pred n).
Proof.
  intros n.
  destruct n.
  - left.
    reflexivity.
  - right.
    simpl.
    reflexivity.
Qed.

Lemma mult_eq_0 :
  forall n m, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros n m.
  intros H.
  destruct n.
  - left. reflexivity.
  - simpl in H.
    apply and_exercise in H.
    destruct H as [Hm Hnm].
    right.
    apply Hm.
Qed.

Theorem or_commut : forall P Q : Prop,
  P \/ Q -> Q \/ P.
Proof.
  intros P Q.
  intros H.
  destruct H.
  - right.
    apply H.
  - left.
    apply H.
Qed.

Module MyNot.

Definition not (P:Prop) := P -> False.

(* Notation "¬ x" := (not x) : type_scope. *)

Check not.
(* ===> Prop -> Prop *)

End MyNot.

Theorem ex_falso_quodlibet : forall (P:Prop),
  False -> P.
Proof.
  intros P cont.
  destruct cont.
Qed.

Fact not_implies_our_not : forall (P:Prop),
  ~ P -> (forall (Q:Prop), P -> Q).
Proof.
  intros P.
  unfold not.
  intros np.
  intros Q.
  intros H.
  apply np in H.
  inversion H.
Qed.

Theorem zero_not_one : ~(0 = 1).
Proof.
  intros contra.
  inversion contra.
Qed.

Check (0 <> 1).

Eval compute in (0 <> 1).
Eval compute in (0 <> 0).

Theorem zero_not_one' : 0 <> 1.
Proof.
  unfold not.
  intros H.
  inversion H.
Qed.

Theorem not_False :
  ~ False.
Proof.
  unfold not.
  intros H.
  inversion H.
Qed.

Theorem contradiction_implies_anything : forall P Q : Prop,
  (P /\ ~P) -> Q.
Proof.
  intros P Q.
  intros [HP1 HP2].
  unfold not in HP2.
  apply HP2 in HP1.
  inversion HP1.
Qed.

Theorem contrapositive : forall (P Q : Prop),
  (P -> Q) -> (~Q -> ~P).
Proof.
  intros P Q.
  intros H.
  intros nQ.
  unfold not in nQ.
  unfold not.
  intros HP.
  apply H in HP.
  apply nQ in HP.
  inversion HP.
Qed.

Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
  intros P.
  unfold not.
  intros [H1 H2].
  apply H2 in H1.
  inversion H1.
Qed.

Theorem not_true_is_false : forall b : bool,
  b <> true -> b = false.
Proof.
  intros [] H.
  - unfold not in H.
    apply ex_falso_quodlibet.
    apply H.
    reflexivity.
  - reflexivity.
Qed.

Theorem not_true_is_false' : forall b : bool,
  b <> true -> b = false.
Proof.
  intros [] H.
  - (* b = false *)
    unfold not in H.
    exfalso. (* <=== *)
    apply H. reflexivity.
  - (* b = true *) reflexivity.
Qed.

Lemma True_is_true : True.
Proof.
  apply I.
Qed.

Module MyIff.

Require Import  Coq.Setoids.Setoid.

Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P).

Notation "P <-> Q" := (iff P Q)
                      (at level 95, no associativity)
                      : type_scope.

End MyIff.

Theorem iff_sym : forall P Q : Prop,
  (P <-> Q) -> (Q <-> P).
Proof.
  intros P Q.
  intros leq.
  unfold iff in leq.
  unfold iff.
  rewrite -> and_comm.
  apply leq.
Qed.

Theorem iff_sym_1 : forall P Q : Prop,
  (P <-> Q) -> (Q <-> P).
Proof.
  intros P Q.
  intros [HAB HBA].
  split.
  - apply HBA.
  - apply HAB.
Qed.

Lemma not_true_iff_false : forall b,
  b <> true <-> b = false.
Proof.
  intros b.
  split.
  - apply not_true_is_false.
  - intros H1.
    rewrite -> H1.
    unfold not.
    intros H2.
    inversion H2.
Qed.

Theorem iff_refl : forall P : Prop,
  P <-> P.
Proof.
  intros P.
  split.
  - intros H.
    apply H.
  - intros H.
    apply H.
Qed.

Theorem iff_trans : forall P Q R : Prop,
  (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
  intros P Q R.
  intros [HPQ HQP].
  intros [HQR HRQ].
  split.
  - intros P1.
    apply HPQ in P1.
    apply HQR in P1.
    apply P1.
  - intros P1.
    apply HRQ in P1.
    apply HQP in P1.
    apply P1.
Qed.

Theorem or_distributes_over_and : forall P Q R : Prop,
  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  intros P Q R.
  unfold iff.
  split.
  - intros H1.
    destruct H1.
    + split.
      * apply or_intro.
        apply H.
      * apply or_intro.
        apply H.
    + split.
      * apply or_commut.
        apply or_intro.
        apply H.
      * apply or_commut.
        apply or_intro.
        apply H.
  - intros [H1 H2].
    destruct H1.
    + apply or_intro.
      apply H.
    + destruct H2.
      * apply or_intro.
        apply H0.
      * apply or_commut.
        apply or_intro.
        split. apply H. apply H0.
Qed.

Lemma mult_0 : forall n m, n * m = 0 <-> n = 0 \/ m = 0.
Proof.
  intros n m.
  split.
  - apply mult_eq_0.
  - apply or_example.
Qed.

Lemma or_assoc :
  forall P Q R : Prop, P \/ (Q \/ R) <-> (P \/ Q) \/ R.
Proof.
  intros P Q R.
  split.
  - intros [H | [H | H]].
    + left. left. apply H.
    + left. right. apply H.
    + right. apply H.
  - intros [[H | H] | H].
    + left. apply H.
    + right. left. apply H.
    + right. right. apply H.
Qed.

Lemma mult_0_3 :
  forall n m p, n * m * p = 0 <-> n = 0 \/ m = 0 \/ p = 0.
Proof.
 intros n m p.
 rewrite mult_0.
 rewrite mult_0.
 rewrite -> or_assoc.
 reflexivity.
Qed.

Lemma apply_iff_example :
  forall n m : nat, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros n m.
  apply mult_0.
Qed.

Lemma four_is_even : exists n : nat, 4 = n + n.
Proof.
  exists 2.
  reflexivity.
Qed.

Theorem exists_example_2 : forall n,
  (exists m, n = 4 + m) ->
  (exists o, n = 2 + o).
Proof.
  intros n.
  intros [m Hm].
  exists (2 + m).
  apply Hm.
Qed.

Theorem dist_not_exists : forall (X:Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  intros X P.
  intros H.
  unfold not.
  intro E.
  inversion E as [ x Hx ].
  apply Hx.
  apply H.
Qed.

Theorem dist_not_exists_2 : forall (X:Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  intros X P.
  intros H.
  unfold not.
  intros E.
  destruct E.
  apply H0.
  apply H.
Qed.

Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
  intros X P Q.
  split.
  - intros H.
    destruct H.
    + destruct H.
      * left.
        exists x.
        apply H.
      * right.
        exists x.
        apply H.
  - intros H.
    destruct H.
    + destruct H.
      exists x.
      left.
      apply H.
    + destruct H.
      exists x.
      right.
      apply H.
Qed.

Require Import Coq.Lists.List.
Import ListNotations.

Fixpoint In {A : Type} (x : A) (l : list A) : Prop :=
  match l with
    | [] => False
    | x' :: l' => x' = x \/ In x l'
  end.

Example In_example_1 : In 4 [1; 2; 3; 4; 5].
Proof.
  simpl.
  right.
  right.
  right.
  left.
  reflexivity.
Qed.

Example In_example_2 :
  forall n : nat, In n [2; 4] -> exists n': nat, n = 2 * n'.
Proof.
  simpl.
  intros n.
  intros [H | [H | []]].
  - exists 1.
    simpl. rewrite <- H.
    reflexivity.
  - exists 2.
    simpl.
    rewrite <- H.
    reflexivity.
Qed.

Lemma In_map :
  forall (A B : Type) (f : A -> B) (l : list A) (x : A),
    In x l -> In (f x) (map f l).
Proof.
  intros A B f l x.
  induction l as [| x' l' IHl'].
  - simpl.
    intros [].
  - simpl. intros [H | H].
    left. rewrite -> H. reflexivity.
    apply IHl' in H.
    right. apply H.
Qed.

Lemma In_map_iff :
  forall (A B : Type) (f : A -> B) (l : list A) (y : B),
    In y (map f l) <->
    exists x, f x = y /\ In x l.
Proof.
  intros A B f l y.
  split.
  - induction l as [| x' l' IHl'].
    + simpl.
      intros H.
      inversion H.
    + simpl.
      intros H.
      destruct H as [H1 | H2].
      * exists x'.
        split. apply H1.
        rewrite <- H1 in IHl'.
        left.
        reflexivity.
      * apply IHl' in H2.
        destruct H2.
        exists x.
        split. apply H.
        right.
        apply H.
  - intros H.
    destruct H.
    destruct H as [H1 H2].
    apply In_map with (f := f) in H2.
    rewrite -> H1 in H2.
    apply H2.
Qed.

Lemma in_app_iff : forall A l l' (a:A),
  In a (l++l') <-> In a l \/ In a l'.
Proof.
  intros A l l' a.
  split.
  - generalize dependent l'.
    induction l as [| x l'' IHl].
    + simpl.
      intros l' H.
      right.
      apply H.
    + simpl.
      intros l' H.
      destruct H as [H1 | H2].
      * left. left. apply H1.
      * apply IHl in H2.
        destruct H2 as [H3 | H4].
        left. right. apply H3.
        right. apply H4.
  - generalize dependent l'.
    induction l as [| x l'' IHl'].
    + intros l' [H1 | H2].
      simpl in H1.
      inversion H1.
      simpl. apply H2.
    + simpl.
      intros l' [[H1 | H2] | H3].
      left. apply H1.
      specialize IHl' with l'.
      right.
      apply IHl'.
      left.
      apply H2.
      specialize IHl' with l'.
      right.
      apply IHl'.
      right.
      apply H3.
Qed.

Fixpoint All {T : Type} (P : T -> Prop) (l : list T) : Prop :=
  match l with
    | [] => True
    | x :: l' => P x /\ All P l'
  end.

Lemma All_In :
  forall T (P : T -> Prop) (l : list T),
  (forall x, In x l -> P x) <-> All P l.
Proof.
  intros T P l.
  split.
  - induction l as [| x l' IHl'].
    + simpl.
      intros H.
      apply I.
    + simpl.
      intros H.
      pose proof (H x) as HS.
      split.
      * apply HS.
        left.
        reflexivity.
      * apply IHl'.
        intros.
        pose proof (H x0) as HS2.
        apply HS2.
        right.
        apply H0.
  - intros H.
    induction l as [| x l' IHl'].
    + simpl.
      intros x.
      intros y.
      inversion y.
    + intros x0.
      simpl.
      simpl in H.
      intros.
      destruct H0.
      * destruct H as [H1 H2].
        specialize (IHl' H2).
Abort.

Definition combine_odd_even (Podd Peven : nat -> Prop) : nat -> Prop :=
fun n => Podd n \/ Peven n.

Fixpoint evenb (n:nat) : bool :=
  match n with
    | O => true
    | S O => false
    | S (S n') => evenb n'
  end.

Definition oddb (n:nat) : bool := negb (evenb n).

Eval compute in oddb 0.

Theorem combine_odd_even_intro :
  forall (Podd Peven : nat -> Prop) (n : nat),
    (oddb n = true -> Podd n) ->
    (oddb n = false -> Peven n) ->
    combine_odd_even Podd Peven n.
Proof.
  intros Podd Peven.
  intros n.
  intros H1 H2.
  induction n as [|n' IHn'].
  - unfold combine_odd_even.
    unfold oddb in H2.
    simpl in H2.
    assert (H3: false = false).
    reflexivity.
    apply H2 in H3.
    right.
    apply H3.
  - unfold combine_odd_even.
Abort.

Require Import Coq.Arith.Plus.

Lemma plus_comm3_take3 :
  forall n m p, n + (m + p) = (p + m) + n.
Proof.
  intros n m p.
  rewrite plus_comm.
  rewrite (plus_comm m).
  reflexivity.
Qed.

Require Import Coq.Arith.Mult.

Example lemma_application_ex :
  forall {n : nat} {ns : list nat},
    In n (map (fun m => m * 0) ns) ->
    n = 0.
Proof.
  intros n ns H.
  destruct (proj1 _ _ (In_map_iff _ _ _ _ _) H).
  destruct H0.
  rewrite mult_0_r in H0.
  symmetry.
  apply H0.
Qed.


(****************************************************************************

          IEEE754  :  Faux

          Laurent Thery

  *****************************************************************************
  Auxillary properties about natural numbers, relative numbers and reals *)
Require Export Min.
Require Export Arith.
Require Export Reals.
Require Export Zpower.
Require Export ZArith.
Require Export Zcomplements.
Require Export sTactic.
Hint Resolve R1_neq_R0: real.
(*Missing rule for nat *)

Theorem minus_minus : forall a b : nat, a <= b -> b - (b - a) = a.
intros a b H'.
apply sym_equal.
apply plus_minus; auto.
rewrite plus_comm; apply le_plus_minus; auto.
Qed.

Theorem lte_comp_mult :
 forall p q r t : nat, p <= q -> r <= t -> p * r <= q * t.
intros p q r t H'; elim H'; simpl in |- *; auto with arith.
elim p; simpl in |- *; auto with arith.
intros n H m H0 H1 H2; apply plus_le_compat; auto with arith.
apply le_trans with (m := r + n * r); auto with arith.
Qed.
Hint Resolve lte_comp_mult: arith.

Theorem le_refl_eq : forall n m : nat, n = m -> n <= m.
intros n m H'; rewrite H'; auto.
Qed.

Theorem lt_le_pred : forall n m : nat, n < m -> n <= pred m.
intros n m H'; inversion H'; simpl in |- *; auto.
apply le_trans with (S n); auto.
Qed.

Theorem lt_comp_mult_l : forall p q r : nat, 0 < p -> q < r -> p * q < p * r.
intros p; elim p; simpl in |- *.
auto with arith.
intros n0; case n0.
simpl in |- *; auto with arith.
intros n1 H' q r H'0 H'1.
apply lt_trans with (m := q + S n1 * r); auto with arith.
Qed.
Hint Resolve lt_comp_mult_l: arith.

Theorem lt_comp_mult_r : forall p q r : nat, 0 < p -> q < r -> q * p < r * p.
intros; repeat rewrite (fun x : nat => mult_comm x p); auto with arith.
Qed.
Hint Resolve lt_comp_mult_r: arith.

Theorem lt_comp_mult : forall p q r s : nat, p < q -> r < s -> p * r < q * s.
intros p q r s; case q.
intros H'; inversion H'.
intros q'; case p.
intros H' H'0; simpl in |- *; apply le_lt_trans with (m := r);
 auto with arith.
intros p' H' H'0; apply le_lt_trans with (m := S q' * r); auto with arith.
Qed.
Hint Resolve lt_comp_mult: arith.

Theorem mult_eq_inv : forall n m p : nat, 0 < n -> n * m = n * p -> m = p.
intros n m p H' H'0.
apply le_antisym; auto.
case (le_or_lt m p); intros H'1; auto with arith.
absurd (n * p < n * m); auto with arith.
rewrite H'0; auto with arith.
case (le_or_lt p m); intros H'1; auto with arith.
absurd (n * m < n * p); auto with arith.
rewrite H'0; auto with arith.
Qed.

Definition natEq : forall n m : nat, {n = m} + {n <> m}.
intros n; elim n.
intros m; case m; auto with arith.
intros n0 H' m; case m; auto with arith.
Defined.

Theorem notEqLt : forall n : nat, 0 < n -> n <> 0.
intros n H'; Contradict H'; auto.
rewrite H'; auto with arith.
Qed.
Hint Resolve notEqLt: arith.

Theorem lt_next : forall n m : nat, n < m -> m = S n \/ S n < m.
intros n m H'; elim H'; auto with arith.
Qed.

Theorem le_next : forall n m : nat, n <= m -> m = n \/ S n <= m.
intros n m H'; case (le_lt_or_eq _ _ H'); auto with arith.
Qed.

Theorem min_or :
 forall n m : nat, min n m = n /\ n <= m \/ min n m = m /\ m < n.
intros n; elim n; simpl in |- *; auto with arith.
intros n' Rec m; case m; simpl in |- *; auto with arith.
intros m'; elim (Rec m'); intros H'0; case H'0; clear H'0; intros H'0 H'1;
 rewrite H'0; auto with arith.
Qed.

Theorem minus_inv_lt_aux : forall n m : nat, n - m = 0 -> n - S m = 0.
intros n; elim n; simpl in |- *; auto with arith.
intros n0 H' m; case m; auto with arith.
intros H'0; discriminate.
Qed.

Theorem minus_inv_lt : forall n m : nat, m <= n -> m - n = 0.
intros n m H'; elim H'; simpl in |- *; auto with arith.
intros m0 H'0 H'1; apply minus_inv_lt_aux; auto.
Qed.

Theorem minus_le : forall m n p q : nat, m <= n -> p <= q -> m - q <= n - p.
intros m n p q H' H'0.
case (le_or_lt m q); intros H'1.
rewrite minus_inv_lt with (1 := H'1); auto with arith.
apply (fun p n m : nat => plus_le_reg_l n m p) with (p := q).
rewrite le_plus_minus_r; auto with arith.
rewrite (le_plus_minus p q); auto.
rewrite (plus_comm p).
rewrite plus_assoc_reverse.
rewrite le_plus_minus_r; auto with arith.
apply le_trans with (1 := H'); auto with arith.
apply le_trans with (1 := H'0); auto with arith.
apply le_trans with (2 := H'); auto with arith.
Qed.

Theorem lt_minus_inv : forall n m p : nat, n <= p -> m < n -> p - n < p - m.
intros n m p H'; generalize m; clear m; elim H'.
intros m H'0; rewrite <- minus_n_n; elim H'0.
rewrite <- minus_Sn_m; auto with arith.
intros m0 H'1 H'2; rewrite <- minus_Sn_m; auto with arith.
intros m H'0 H'1 m0 H'2; repeat rewrite <- minus_Sn_m; auto with arith.
apply le_trans with n; auto with arith.
Qed.

Theorem lt_mult_anti_compatibility :
 forall n n1 n2 : nat, 0 < n -> n * n1 < n * n2 -> n1 < n2.
intros n n1 n2 H' H'0; case (le_or_lt n2 n1); auto.
intros H'1; Contradict H'0; auto.
apply le_not_lt; auto with arith.
Qed.

Theorem le_mult_anti_compatibility :
 forall n n1 n2 : nat, 0 < n -> n * n1 <= n * n2 -> n1 <= n2.
intros n n1 n2 H' H'0; case (le_or_lt n1 n2); auto.
intros H'1; Contradict H'0; auto.
apply lt_not_le; auto with arith.
Qed.

Theorem min_n_0 : forall n : nat, min n 0 = 0.
intros n; case n; simpl in |- *; auto.
Qed.
(*Simplification rules missing in R *)
Hint Resolve Rabs_pos: real.

Theorem Rlt_Rminus_ZERO : forall r1 r2 : R, (r2 < r1)%R -> (0 < r1 - r2)%R.
intros r1 r2 H; replace 0%R with (r1 - r1)%R; unfold Rminus in |- *;
 auto with real.
Qed.
Hint Resolve Rlt_Rminus_ZERO: real.

Theorem Rabsolu_left1 : forall a : R, (a <= 0)%R -> Rabs a = (- a)%R.
intros a H; case H; intros H1.
apply Rabs_left; auto.
rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real.
Qed.

Theorem RmaxLess1 : forall r1 r2 : R, (r1 <= Rmax r1 r2)%R.
intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real.
Qed.

Theorem RmaxLess2 : forall r1 r2 : R, (r2 <= Rmax r1 r2)%R.
intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real;
 intros; apply Ropp_le_cancel; auto with real.
Qed.

Theorem RmaxSym : forall p q : R, Rmax p q = Rmax q p.
intros p q; unfold Rmax in |- *.
case (Rle_dec p q); case (Rle_dec q p); auto; intros H1 H2; apply Rle_antisym;
 auto.
case (Rle_or_lt p q); auto; intros H'0; Contradict H1; apply Rlt_le; auto.
case (Rle_or_lt q p); auto; intros H'0; Contradict H2; apply Rlt_le; auto.
Qed.

Theorem RmaxAbs :
 forall p q r : R,
 (p <= q)%R -> (q <= r)%R -> (Rabs q <= Rmax (Rabs p) (Rabs r))%R.
intros p q r H' H'0; case (Rle_or_lt 0 p); intros H'1.
repeat rewrite Rabs_right; auto with real.
apply Rle_trans with r; auto with real.
apply RmaxLess2; auto.
apply Rge_trans with p; auto with real; apply Rge_trans with q;
 auto with real.
apply Rge_trans with p; auto with real.
rewrite (Rabs_left p); auto.
case (Rle_or_lt 0 q); intros H'2.
repeat rewrite Rabs_right; auto with real.
apply Rle_trans with r; auto.
apply RmaxLess2; auto.
apply Rge_trans with q; auto with real.
rewrite (Rabs_left q); auto.
case (Rle_or_lt 0 r); intros H'3.
repeat rewrite Rabs_right; auto with real.
apply Rle_trans with (- p)%R; auto with real.
apply RmaxLess1; auto.
rewrite (Rabs_left r); auto.
apply Rle_trans with (- p)%R; auto with real.
apply RmaxLess1; auto.
Qed.

Theorem Rabsolu_Zabs : forall z : Z, Rabs (IZR z) = IZR (Zabs z).
intros z; case z; simpl in |- *; auto with real.
apply Rabs_right; auto with real.
intros p0; apply Rabs_right; auto with real zarith.
intros p0; unfold IZR; rewrite <- INR_IPR; rewrite Rabs_Ropp.
apply Rabs_right; auto with real zarith.
Qed.

Theorem RmaxRmult :
 forall p q r : R, (0 <= r)%R -> Rmax (r * p) (r * q) = (r * Rmax p q)%R.
intros p q r H; unfold Rmax in |- *.
case (Rle_dec p q); case (Rle_dec (r * p) (r * q)); auto; intros H1 H2; auto.
case H; intros E1.
case H1; auto with real.
rewrite <- E1; repeat rewrite Rmult_0_l; auto.
case H; intros E1.
case H2; auto with real.
apply Rmult_le_reg_l with (r := r); auto.
rewrite <- E1; repeat rewrite Rmult_0_l; auto.
Qed.

Theorem Rle_R0_Ropp : forall p : R, (p <= 0)%R -> (0 <= - p)%R.
intros p H; rewrite <- Ropp_0; auto with real.
Qed.

Theorem Rlt_R0_Ropp : forall p : R, (p < 0)%R -> (0 < - p)%R.
intros p H; rewrite <- Ropp_0; auto with real.
Qed.
Hint Resolve Rle_R0_Ropp Rlt_R0_Ropp: real.
(* Properties of Z *)

Theorem convert_not_O : forall p : positive, nat_of_P p <> 0.
intros p; elim p.
intros p0 H'; unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6.
generalize H'; case (nat_of_P p0); auto.
intros p0 H'; unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6.
generalize H'; case (nat_of_P p0); simpl in |- *; auto.
unfold nat_of_P in |- *; simpl in |- *; auto with arith.
Qed.
Hint Resolve convert_not_O: zarith arith.
Hint Resolve Zlt_le_weak Zle_not_gt Zgt_irrefl Zlt_irrefl Zle_not_lt
  Zlt_not_le Zlt_asym inj_lt inj_le: zarith.

Theorem inj_abs :
 forall x : Z, (0 <= x)%Z -> Z_of_nat (Zabs_nat x) = x.
intros x; elim x; auto.
unfold Zabs_nat in |- *.
intros p.
pattern p at 1 3 in |- *;
 rewrite <- (pred_o_P_of_succ_nat_o_nat_of_P_eq_id p).
generalize (convert_not_O p); case (nat_of_P p); simpl in |- *;
 auto with arith.
intros H'; case H'; auto.
intros n H' H'0; rewrite Ppred_succ; auto.
intros p H'; Contradict H'; auto.
Qed.

Theorem inject_nat_convert :
 forall (p : Z) (q : positive),
 p = Zpos q -> Z_of_nat (nat_of_P q) = p.
intros p q H'; rewrite H'.
CaseEq (nat_of_P q); simpl in |- *.
elim q; unfold nat_of_P in |- *; simpl in |- *; intros;
 try discriminate.
absurd (0%Z = Zpos p0); auto.
red in |- *; intros H'0; try discriminate.
apply H; auto.
change (nat_of_P p0 = 0) in |- *.
generalize H0; rewrite ZL6; case (nat_of_P p0); simpl in |- *;
 auto; intros; try discriminate.
intros n; rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ.
intros H'0; apply f_equal with (f := Zpos).
apply nat_of_P_inj; auto.
Qed.
Hint Resolve inj_le inj_lt: zarith.

Theorem ZleLe : forall x y : nat, (Z_of_nat x <= Z_of_nat y)%Z -> x <= y.
intros x y H'.
case (le_or_lt x y); auto with arith.
intros H'0; Contradict H'; auto with zarith.
Qed.

Theorem inject_nat_eq : forall x y : nat, Z_of_nat x = Z_of_nat y -> x = y.
intros x y H'; apply le_antisym.
apply ZleLe; auto.
idtac; rewrite H'; auto with zarith.
apply ZleLe; auto.
idtac; rewrite H'; auto with zarith.
Qed.

Theorem Zcompare_EGAL :
 forall p q : Z, (p ?= q)%Z = Datatypes.Eq -> p = q.
intros p q; case p; case q; simpl in |- *; auto with arith;
 try (intros; discriminate); intros q1 p1.
intros H1; rewrite (Pcompare_Eq_eq p1 q1); auto.
unfold Pos.compare.
generalize (Pcompare_Eq_eq p1 q1);
 case (Pcompare p1 q1 Datatypes.Eq); simpl in |- *;
 intros H H1; try discriminate; rewrite H; auto.
Qed.

Theorem Zlt_Zopp : forall x y : Z, (x < y)%Z -> (- y < - x)%Z.
intros x y; case x; case y; simpl in |- *; auto with zarith; intros p p0;
 unfold Zlt in |- *; simpl in |- *; unfold Pos.compare; rewrite <- ZC4;
 auto.
Qed.
Hint Resolve Zlt_Zopp: zarith.

Theorem Zle_Zopp : forall x y : Z, (x <= y)%Z -> (- y <= - x)%Z.
intros x y H'; case (Zle_lt_or_eq _ _ H'); auto with zarith.
Qed.
Hint Resolve Zle_Zopp: zarith.

Theorem absolu_INR : forall n : nat, Zabs_nat (Z_of_nat n) = n.
intros n; case n; simpl in |- *; auto with arith.
intros n0; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith.
Qed.

Theorem absolu_Zopp : forall p : Z, Zabs_nat (- p) = Zabs_nat p.
intros p; case p; simpl in |- *; auto.
Qed.

Theorem Zabs_absolu : forall z : Z, Zabs z = Z_of_nat (Zabs_nat z).
intros z; case z; simpl in |- *; auto; intros p; apply sym_equal;
 apply inject_nat_convert; auto.
Qed.

Theorem absolu_comp_mult :
 forall p q : Z, Zabs_nat (p * q) = Zabs_nat p * Zabs_nat q.
intros p q; case p; case q; simpl in |- *; auto; intros p0 p1;
 apply
  ((fun (x y : positive) (_ : positive -> positive) =>
    nat_of_P_mult_morphism x y) p1 p0 (fun x => x)).
Qed.

Theorem Zmin_sym : forall m n : Z, Zmin n m = Zmin m n.
intros m n; unfold Zmin in |- *.
case n; case m; simpl in |- *; auto; unfold Pos.compare.
intros p p0; rewrite (ZC4 p p0).
generalize (Pcompare_Eq_eq p0 p).
case (Pcompare p0 p Datatypes.Eq); simpl in |- *; auto.
intros H'; rewrite H'; auto.
intros p p0; rewrite (ZC4 p p0).
generalize (Pcompare_Eq_eq p0 p).
case (Pcompare p0 p Datatypes.Eq); simpl in |- *; auto.
intros H'; rewrite H'; auto.
Qed.

Theorem Zpower_nat_O : forall z : Z, Zpower_nat z 0 = Z_of_nat 1.
intros z; unfold Zpower_nat in |- *; simpl in |- *; auto.
Qed.

Theorem Zpower_nat_1 : forall z : Z, Zpower_nat z 1 = z.
intros z; unfold Zpower_nat in |- *; simpl in |- *; rewrite Zmult_1_r; auto.
Qed.

Theorem Zmin_le1 : forall z1 z2 : Z, (z1 <= z2)%Z -> Zmin z1 z2 = z1.
intros z1 z2; unfold Zle, Zmin in |- *; case (z1 ?= z2)%Z; auto; intros H;
 Contradict H; auto.
Qed.

Theorem Zmin_le2 : forall z1 z2 : Z, (z2 <= z1)%Z -> Zmin z1 z2 = z2.
intros z1 z2 H; rewrite Zmin_sym; apply Zmin_le1; auto.
Qed.

Theorem Zmin_Zle :
 forall z1 z2 z3 : Z,
 (z1 <= z2)%Z -> (z1 <= z3)%Z -> (z1 <= Zmin z2 z3)%Z.
intros z1 z2 z3 H' H'0; unfold Zmin in |- *.
case (z2 ?= z3)%Z; auto.
Qed.

Theorem Zminus_n_predm :
 forall n m : Z, Zsucc (n - m) = (n - Zpred m)%Z.
intros n m.
unfold Zpred in |- *; unfold Zsucc in |- *; ring.
Qed.

Theorem Zopp_Zpred_Zs : forall z : Z, (- Zpred z)%Z = Zsucc (- z).
intros z; unfold Zpred, Zsucc in |- *; ring.
Qed.

Theorem Zle_mult_gen :
 forall x y : Z, (0 <= x)%Z -> (0 <= y)%Z -> (0 <= x * y)%Z.
intros x y H' H'0; case (Zle_lt_or_eq _ _ H').
intros H'1; rewrite Zmult_comm; apply Zmult_gt_0_le_0_compat; auto;
 apply Zlt_gt; auto.
intros H'1; rewrite <- H'1; simpl in |- *; auto with zarith.
Qed.
Hint Resolve Zle_mult_gen: zarith.

Definition Zmax : forall x_ x_ : Z, Z :=
  fun n m : Z =>
  match (n ?= m)%Z with
  | Datatypes.Eq => m
  | Datatypes.Lt => m
  | Datatypes.Gt => n
  end.

Theorem ZmaxLe1 : forall z1 z2 : Z, (z1 <= Zmax z1 z2)%Z.
intros z1 z2; unfold Zmax in |- *; CaseEq (z1 ?= z2)%Z; simpl in |- *;
 auto with zarith.
unfold Zle in |- *; intros H; rewrite H; red in |- *; intros; discriminate.
Qed.

Theorem ZmaxSym : forall z1 z2 : Z, Zmax z1 z2 = Zmax z2 z1.
intros z1 z2; unfold Zmax in |- *; CaseEq (z1 ?= z2)%Z; CaseEq (z2 ?= z1)%Z;
 intros H1 H2; try case (Zcompare_EGAL _ _ H1); auto;
 try case (Zcompare_EGAL _ _ H2); auto; Contradict H1.
case (Zcompare.Zcompare_Gt_Lt_antisym z2 z1); auto.
intros H' H'0; rewrite H'0; auto; red in |- *; intros; discriminate.
case (Zcompare.Zcompare_Gt_Lt_antisym z1 z2); auto.
intros H'; rewrite H'; auto; intros; red in |- *; intros; discriminate.
Qed.

Theorem Zmax_le2 : forall z1 z2 : Z, (z1 <= z2)%Z -> Zmax z1 z2 = z2.
intros z1 z2; unfold Zle, Zmax in |- *; case (z1 ?= z2)%Z; auto.
intros H'; case H'; auto.
Qed.

Theorem Zmax_le1 : forall z1 z2 : Z, (z2 <= z1)%Z -> Zmax z1 z2 = z1.
intros z1 z2 H'; rewrite ZmaxSym; apply Zmax_le2; auto.
Qed.

Theorem ZmaxLe2 : forall z1 z2 : Z, (z2 <= Zmax z1 z2)%Z.
intros z1 z2; rewrite ZmaxSym; apply ZmaxLe1.
Qed.
Hint Resolve ZmaxLe1 ZmaxLe2: zarith.

Theorem Zeq_Zs :
 forall p q : Z, (p <= q)%Z -> (q < Zsucc p)%Z -> p = q.
intros p q H' H'0; apply Zle_antisym; auto.
apply Zlt_succ_le; auto.
Qed.

Theorem Zmin_Zmax : forall z1 z2 : Z, (Zmin z1 z2 <= Zmax z1 z2)%Z.
intros z1 z2; case (Zle_or_lt z1 z2); unfold Zle, Zlt, Zmin, Zmax in |- *;
 CaseEq (z1 ?= z2)%Z; auto; intros H1 H2; try rewrite H1;
 try rewrite H2; red in |- *; intros; discriminate.
Qed.

Theorem Zabs_Zmult :
 forall z1 z2 : Z, Zabs (z1 * z2) = (Zabs z1 * Zabs z2)%Z.
intros z1 z2; case z1; case z2; simpl in |- *; auto with zarith.
Qed.

Theorem Zle_Zmult_comp_r :
 forall x y z : Z, (0 <= z)%Z -> (x <= y)%Z -> (x * z <= y * z)%Z.
intros x y z H' H'0; case (Zle_lt_or_eq _ _ H'); intros Zlt1.
apply Zmult_gt_0_le_compat_r; auto.
apply Zlt_gt; auto.
rewrite <- Zlt1; repeat rewrite <- Zmult_0_r_reverse; auto with zarith.
Qed.

Theorem Zle_Zmult_comp_l :
 forall x y z : Z, (0 <= z)%Z -> (x <= y)%Z -> (z * x <= z * y)%Z.
intros x y z H' H'0; repeat rewrite (Zmult_comm z);
 apply Zle_Zmult_comp_r; auto.
Qed.

Theorem NotZmultZero :
 forall z1 z2 : Z, z1 <> 0%Z -> z2 <> 0%Z -> (z1 * z2)%Z <> 0%Z.
intros z1 z2; case z1; case z2; simpl in |- *; intros; auto; try discriminate.
Qed.
Hint Resolve NotZmultZero: zarith.
(* Conversions from R <-> Z  <-> N *)

Theorem IZR_zero : forall p : Z, p = 0%Z -> IZR p = 0%R.
intros p H'; rewrite H'; auto.
Qed.
Hint Resolve not_O_INR: real.

Theorem IZR_zero_r : forall p : Z, IZR p = 0%R -> p = 0%Z.
intros p; case p; simpl in |- *; auto.
intros p1 H'; Contradict H'; auto with real zarith.
intros p1 H'; absurd (INR (nat_of_P p1) = 0%R); auto with real zarith.
rewrite <- (Ropp_involutive (INR (nat_of_P p1))).
unfold IZR in H'; rewrite <- INR_IPR in H'.
rewrite H'; auto with real.
Qed.

Theorem INR_lt_nm : forall n m : nat, n < m -> (INR n < INR m)%R.
intros n m H'; elim H'; auto.
replace (INR n) with (INR n + 0)%R; auto with real; rewrite S_INR;
 auto with real.
intros m0 H'0 H'1.
replace (INR n) with (INR n + 0)%R; auto with real; rewrite S_INR;
 auto with real.
Qed.
Hint Resolve INR_lt_nm: real.

Theorem Rlt_INR1 : forall n : nat, 1 < n -> (1 < INR n)%R.
replace 1%R with (INR 1); auto with real.
Qed.
Hint Resolve Rlt_INR1: real.

Theorem NEq_INR : forall n m : nat, n <> m -> INR n <> INR m.
intros n m H'; (case (le_or_lt n m); intros H'1).
case (le_lt_or_eq _ _ H'1); intros H'2.
apply Rlt_dichotomy_converse; auto with real.
Contradict H'; auto.
apply Compare.not_eq_sym; apply Rlt_dichotomy_converse; auto with real.
Qed.
Hint Resolve NEq_INR: real.

Theorem NEq_INRO : forall n : nat, n <> 0 -> INR n <> 0%R.
replace 0%R with (INR 0); auto with real.
Qed.
Hint Resolve NEq_INRO: real.

Theorem NEq_INR1 : forall n : nat, n <> 1 -> INR n <> 1%R.
replace 1%R with (INR 1); auto with real.
Qed.
Hint Resolve NEq_INR1: real.

Theorem not_O_lt : forall n : nat, n <> 0 -> 0 < n.
intros n; elim n; simpl in |- *; auto with arith.
Qed.
Hint Resolve not_O_lt: arith.

Theorem NEq_IZRO : forall n : Z, n <> 0%Z -> IZR n <> 0%R.
intros n H; Contradict H.
apply IZR_zero_r; auto.
Qed.
Hint Resolve NEq_IZRO: real.

Theorem Rlt_IZR : forall p q : Z, (p < q)%Z -> (IZR p < IZR q)%R.
intros p q H; case (Rle_or_lt (IZR q) (IZR p)); auto.
intros H1; Contradict H; apply Zle_not_lt.
apply le_IZR; auto.
Qed.
Hint Resolve Rlt_IZR: real.

Theorem Rle_IZR : forall x y : Z, (x <= y)%Z -> (IZR x <= IZR y)%R.
intros x y H'.
case (Zle_lt_or_eq _ _ H'); clear H'; intros H'.
apply Rlt_le; auto with real.
rewrite <- H'; auto with real.
Qed.
Hint Resolve Rle_IZR: real.

Theorem Rlt_IZRO : forall p : Z, (0 < p)%Z -> (0 < IZR p)%R.
intros p H; replace 0%R with (IZR 0); auto with real.
Qed.
Hint Resolve Rlt_IZRO: real.

Theorem Rle_IZRO : forall x y : Z, (0 <= y)%Z -> (0 <= IZR y)%R.
intros; replace 0%R with (IZR 0); auto with real.
Qed.
Hint Resolve Rle_IZRO: real.

Theorem Rlt_IZR1 : forall p q : Z, (1 < q)%Z -> (1 < IZR q)%R.
intros; replace 1%R with (IZR 1); auto with real.
Qed.
Hint Resolve Rlt_IZR1: real.

Theorem Rle_IZR1 : forall x y : Z, (1 <= y)%Z -> (1 <= IZR y)%R.
intros; replace 1%R with (IZR 1); auto with real.
Qed.
Hint Resolve Rle_IZR1: real.

Theorem lt_Rlt : forall n m : nat, (INR n < INR m)%R -> n < m.
intros n m H'; case (le_or_lt m n); auto; intros H0; Contradict H';
 auto with real.
case (le_lt_or_eq _ _ H0); intros H1; auto with real.
rewrite H1; apply Rlt_irrefl.
Qed.

Theorem INR_inv : forall n m : nat, INR n = INR m -> n = m.
intros n; elim n; auto; try rewrite S_INR.
intros m; case m; auto.
intros m' H1; Contradict H1; auto.
rewrite S_INR.
apply Rlt_dichotomy_converse; left.
apply Rle_lt_0_plus_1.
apply pos_INR.
intros n' H' m; case m.
intros H'0; Contradict H'0; auto.
rewrite S_INR.
apply Rlt_dichotomy_converse; right.
red in |- *; apply Rle_lt_0_plus_1.
apply pos_INR.
intros m' H'0.
rewrite (H' m'); auto.
repeat rewrite S_INR in H'0.
apply Rplus_eq_reg_l with (r := 1%R); repeat rewrite (Rplus_comm 1);
 auto with real.
Qed.

Theorem Rle_INR : forall x y : nat, x <= y -> (INR x <= INR y)%R.
intros x y H; repeat rewrite INR_IZR_INZ.
apply Rle_IZR; auto with zarith.
Qed.
Hint Resolve Rle_INR: real.

Theorem le_Rle : forall n m : nat, (INR n <= INR m)%R -> n <= m.
intros n m H'; case H'; auto.
intros H'0; apply lt_le_weak; apply lt_Rlt; auto.
intros H'0; rewrite <- (INR_inv _ _ H'0); auto with arith.
Qed.

Theorem Rmult_IZR : forall z t : Z, IZR (z * t) = (IZR z * IZR t)%R.
intros z t; case z; case t; simpl in |- *; auto with real; unfold IZR; intros t1 z1; repeat rewrite <- INR_IPR.
- rewrite nat_of_P_mult_morphism; auto with real.
- rewrite nat_of_P_mult_morphism; auto with real.
  rewrite Rmult_comm.
  rewrite Ropp_mult_distr_l_reverse; auto with real.
  apply Ropp_eq_compat; rewrite mult_comm; auto with real.
- rewrite nat_of_P_mult_morphism; auto with real.
  rewrite Ropp_mult_distr_l_reverse; auto with real.
- rewrite nat_of_P_mult_morphism; auto with real.
  rewrite Rmult_opp_opp; auto with real.
Qed.

Theorem absolu_Zs :
 forall z : Z, (0 <= z)%Z -> Zabs_nat (Zsucc z) = S (Zabs_nat z).
intros z; case z.
3: intros p H'; Contradict H'; auto with zarith.
replace (Zsucc 0) with (Z_of_nat 1).
intros H'; rewrite absolu_INR; simpl in |- *; auto.
simpl in |- *; auto.
intros p H'; rewrite <- Zpos_succ_morphism; simpl in |- *; auto with zarith.
unfold nat_of_P in |- *; rewrite Pmult_nat_succ_morphism; auto.
Qed.
Hint Resolve Zlt_le_succ: zarith.

Theorem Zlt_next :
 forall n m : Z, (n < m)%Z -> m = Zsucc n \/ (Zsucc n < m)%Z.
intros n m H'; case (Zle_lt_or_eq (Zsucc n) m); auto with zarith.
Qed.

Theorem Zle_next :
 forall n m : Z, (n <= m)%Z -> m = n \/ (Zsucc n <= m)%Z.
intros n m H'; case (Zle_lt_or_eq _ _ H'); auto with zarith.
Qed.

Theorem Zlt_Zopp_Inv : forall p q : Z, (- p < - q)%Z -> (q < p)%Z.
intros x y H'; case (Zle_or_lt x y); auto with zarith.
Qed.

Theorem Zle_Zopp_Inv : forall p q : Z, (- p <= - q)%Z -> (q <= p)%Z.
intros p q H'; case (Zle_lt_or_eq _ _ H'); auto with zarith.
Qed.

Theorem absolu_Zs_neg :
 forall z : Z, (z < 0)%Z -> S (Zabs_nat (Zsucc z)) = Zabs_nat z.
intros z H'; apply inject_nat_eq.
rewrite inj_S.
repeat rewrite <- (absolu_Zopp (Zsucc z)).
repeat rewrite <- (absolu_Zopp z).
repeat rewrite inj_abs; replace 0%Z with (- (0))%Z; auto with zarith.
Qed.

Theorem Zlt_absolu :
 forall (x : Z) (n : nat), Zabs_nat x < n -> (x < Z_of_nat n)%Z.
intros x n; case x; simpl in |- *; auto with zarith.
replace 0%Z with (Z_of_nat 0); auto with zarith.
intros p; rewrite <- (inject_nat_convert (Zpos p) p); auto with zarith.
case n; simpl in |- *; intros; red in |- *; simpl in |- *; auto.
Qed.

Theorem inj_pred :
 forall n : nat, n <> 0 -> Z_of_nat (pred n) = Zpred (Z_of_nat n).
intros n; case n; auto.
intros H'; Contradict H'; auto.
intros n0 H'; rewrite inj_S; rewrite <- Zpred_succ; auto.
Qed.

Theorem Zle_abs : forall p : Z, (p <= Z_of_nat (Zabs_nat p))%Z.
intros p; case p; simpl in |- *; auto with zarith; intros q;
 rewrite inject_nat_convert with (p := Zpos q);
 auto with zarith.
unfold Zle in |- *; red in |- *; intros H'2; discriminate.
Qed.
Hint Resolve Zle_abs: zarith.

Theorem ZleAbs :
 forall (z : Z) (n : nat),
 (- Z_of_nat n <= z)%Z -> (z <= Z_of_nat n)%Z -> Zabs_nat z <= n.
intros z n H' H'0; case (le_or_lt (Zabs_nat z) n); auto; intros lt.
case (Zle_or_lt 0 z); intros Zle0.
Contradict H'0.
apply Zlt_not_le; auto.
rewrite <- (inj_abs z); auto with zarith.
Contradict H'.
apply Zlt_not_le; auto.
replace z with (- Z_of_nat (Zabs_nat z))%Z.
apply Zlt_Zopp; auto with zarith.
rewrite <- absolu_Zopp.
rewrite inj_abs; auto with zarith.
Qed.

Theorem lt_Zlt_inv : forall n m : nat, (Z_of_nat n < Z_of_nat m)%Z -> n < m.
intros n m H'; case (le_or_lt n m); auto.
intros H'0.
case (le_lt_or_eq _ _ H'0); auto with zarith.
intros H'1.
Contradict H'.
apply Zle_not_lt; auto with zarith.
Qed.

Theorem NconvertO : forall p : positive, nat_of_P p <> 0.
intros p; elim p; unfold nat_of_P in |- *; simpl in |- *.
intros p0 H'; red in |- *; intros H'0; discriminate.
intros p0; rewrite ZL6; unfold nat_of_P in |- *.
case (Pmult_nat p0 1); simpl in |- *; auto.
red in |- *; intros H'; discriminate.
Qed.
Hint Resolve NconvertO: zarith.

Theorem absolu_lt_nz : forall z : Z, z <> 0%Z -> 0 < Zabs_nat z.
intros z; case z; simpl in |- *; auto; try (intros H'; case H'; auto; fail);
 intros p; generalize (NconvertO p); auto with arith.
Qed.

Theorem Rlt2 : (0 < INR 2)%R.
replace 0%R with (INR 0); auto with real arith.
Qed.
Hint Resolve Rlt2: real.

Theorem RlIt2 : (0 < / INR 2)%R.
apply Rmult_lt_reg_l with (r := INR 2); auto with real.
Qed.
Hint Resolve RlIt2: real.

Theorem Rledouble : forall r : R, (0 <= r)%R -> (r <= INR 2 * r)%R.
intros r H'.
replace (INR 2 * r)%R with (r + r)%R; [ idtac | simpl in |- *; ring ].
pattern r at 1 in |- *; replace r with (r + 0)%R; [ idtac | ring ].
apply Rplus_le_compat_l; auto.
Qed.

Theorem Rltdouble : forall r : R, (0 < r)%R -> (r < INR 2 * r)%R.
intros r H'.
pattern r at 1 in |- *; replace r with (r + 0)%R; try ring.
replace (INR 2 * r)%R with (r + r)%R; simpl in |- *; try ring; auto with real.
Qed.

Theorem Rlt_RinvDouble : forall r : R, (0 < r)%R -> (/ INR 2 * r < r)%R.
intros r H'.
apply Rmult_lt_reg_l with (r := INR 2); auto with real.
rewrite <- Rmult_assoc; rewrite Rinv_r.
apply Rmult_lt_compat_r; replace 1%R with (INR 1); auto with real arith.
replace 0%R with (INR 0); auto with real arith.
Qed.
Hint Resolve Rledouble: real.

Theorem Rle_Rinv : forall x y : R, (0 < x)%R -> (x <= y)%R -> (/ y <= / x)%R.
intros x y H H1; case H1; intros H2.
left; apply Rinv_lt_contravar; auto.
apply Rmult_lt_0_compat; auto.
apply Rlt_trans with (2 := H2); auto.
rewrite H2; auto with real.
Qed.

Theorem Int_part_INR : forall n : nat, Int_part (INR n) = Z_of_nat n.
intros n; unfold Int_part in |- *.
cut (up (INR n) = (Z_of_nat n + Z_of_nat 1)%Z).
intros H'; rewrite H'; simpl in |- *; ring.
apply sym_equal; apply tech_up; auto.
replace (Z_of_nat n + Z_of_nat 1)%Z with (Z_of_nat (S n)).
repeat rewrite <- INR_IZR_INZ.
apply INR_lt_nm; auto.
rewrite Zplus_comm; rewrite <- inj_plus; simpl in |- *; auto.
rewrite plus_IZR; simpl in |- *; auto with real.
repeat rewrite <- INR_IZR_INZ; auto with real.
Qed.

Theorem Int_part_IZR : forall z : Z, Int_part (IZR z) = z.
intros z; unfold Int_part in |- *.
cut (up (IZR z) = (z + 1)%Z).
intros Z1; rewrite Z1; rewrite Zplus_comm; apply Zminus_plus;
 auto with zarith.
apply sym_equal; apply tech_up; simpl in |- *; auto with real zarith.
replace (IZR z) with (IZR z + IZR 0)%R; try rewrite plus_IZR;
 auto with real zarith.
Qed.

Theorem Zlt_Rlt : forall z1 z2 : Z, (IZR z1 < IZR z2)%R -> (z1 < z2)%Z.
intros z1 z2 H; case (Zle_or_lt z2 z1); auto.
intros H1; Contradict H; auto with real zarith.
apply Rle_not_lt; auto with real zarith.
Qed.

Theorem Zle_Rle :
 forall z1 z2 : Z, (IZR z1 <= IZR z2)%R -> (z1 <= z2)%Z.
intros z1 z2 H; case (Zle_or_lt z1 z2); auto.
intros H1; Contradict H; auto with real zarith.
apply Rlt_not_le; auto with real zarith.
Qed.

Theorem IZR_inv : forall z1 z2 : Z, IZR z1 = IZR z2 :>R -> z1 = z2.
intros z1 z2 H; apply Zle_antisym; apply Zle_Rle; rewrite H; auto with real.
Qed.

Theorem Zabs_eq_opp : forall x, (x <= 0)%Z -> Zabs x = (- x)%Z.
intros x; case x; simpl in |- *; auto.
intros p H; Contradict H; auto with zarith.
Qed.

Theorem Zabs_Zs : forall z : Z, (Zabs (Zsucc z) <= Zsucc (Zabs z))%Z.
intros z; case z; auto.
simpl in |- *; auto with zarith.
repeat rewrite Zabs_eq; auto with zarith.
intros p; rewrite Zabs_eq_opp; auto with zarith.
2: unfold Zsucc in |- *; replace 0%Z with (-1 + 1)%Z; auto with zarith.
2: case p; simpl in |- *; intros; red in |- *; simpl in |- *; intros;
    red in |- *; intros; discriminate.
replace (- Zsucc (Zneg p))%Z with (Zpos p - 1)%Z.
replace (Zsucc (Zabs (Zneg p))) with (Zpos p + 1)%Z;
 auto with zarith.
unfold Zsucc in |- *; rewrite Zopp_plus_distr.
auto with zarith.
Qed.
Hint Resolve Zabs_Zs: zarith.

Theorem Zle_Zpred : forall x y : Z, (x < y)%Z -> (x <= Zpred y)%Z.
intros x y H; apply Zlt_succ_le.
rewrite <- Zsucc_pred; auto.
Qed.
Hint Resolve Zle_Zpred: zarith.

Theorem Zabs_Zopp : forall z : Z, Zabs (- z) = Zabs z.
intros z; case z; simpl in |- *; auto.
Qed.

Theorem Zle_Zabs : forall z : Z, (z <= Zabs z)%Z.
intros z; case z; simpl in |- *; red in |- *; simpl in |- *; auto;
 try (red in |- *; intros; discriminate; fail).
intros p; elim p; simpl in |- *; auto;
 try (red in |- *; intros; discriminate; fail).
Qed.
Hint Resolve Zle_Zabs: zarith.

Theorem Zlt_mult_simpl_l :
 forall a b c : Z, (0 < c)%Z -> (c * a < c * b)%Z -> (a < b)%Z.
intros a b0 c H H0; apply Zgt_lt.
apply Zmult_gt_reg_r with (p := c); try apply Zlt_gt; auto with zarith.
repeat rewrite (fun x => Zmult_comm x c); auto with zarith.
Qed.
(* An equality function on Z that return a bool *)

Fixpoint pos_eq_bool (a b : positive) {struct b} : bool :=
  match a, b with
  | xH, xH => true
  | xI a', xI b' => pos_eq_bool a' b'
  | xO a', xO b' => pos_eq_bool a' b'
  | _, _ => false
  end.

Theorem pos_eq_bool_correct :
 forall p q : positive,
 match pos_eq_bool p q with
 | true => p = q
 | false => p <> q
 end.
intros p q; generalize p; elim q; simpl in |- *; auto; clear p q.
intros p Rec q; case q; simpl in |- *;
 try (intros; red in |- *; intros; discriminate; fail).
intros q'; generalize (Rec q'); case (pos_eq_bool q' p); simpl in |- *; auto.
intros H1; rewrite H1; auto.
intros H1; Contradict H1; injection H1; auto.
intros p Rec q; case q; simpl in |- *;
 try (intros; red in |- *; intros; discriminate; fail).
intros q'; generalize (Rec q'); case (pos_eq_bool q' p); simpl in |- *; auto.
intros H1; rewrite H1; auto.
intros H1; Contradict H1; injection H1; auto.
intros q; case q; simpl in |- *;
 try (intros; red in |- *; intros; discriminate; fail);
 auto.
Qed.

Theorem Z_O_1 : (0 < 1)%Z.
red in |- *; simpl in |- *; auto; intros; red in |- *; intros; discriminate.
Qed.
Hint Resolve Z_O_1: zarith.

Definition Z_eq_bool a b :=
  match a, b with
  | Z0, Z0 => true
  | Zpos a', Zpos b' => pos_eq_bool a' b'
  | Zneg a', Zneg b' => pos_eq_bool a' b'
  | _, _ => false
  end.

Theorem Z_eq_bool_correct :
 forall p q : Z,
 match Z_eq_bool p q with
 | true => p = q
 | false => p <> q
 end.
intros p q; case p; case q; simpl in |- *; auto;
 try (intros; red in |- *; intros; discriminate; fail).
intros p' q'; generalize (pos_eq_bool_correct q' p');
 case (pos_eq_bool q' p'); simpl in |- *; auto.
intros H1; rewrite H1; auto.
intros H1; Contradict H1; injection H1; auto.
intros p' q'; generalize (pos_eq_bool_correct q' p');
 case (pos_eq_bool q' p'); simpl in |- *; auto.
intros H1; rewrite H1; auto.
intros H1; Contradict H1; injection H1; auto.
Qed.

Theorem Zlt_mult_ZERO :
 forall x y : Z, (0 < x)%Z -> (0 < y)%Z -> (0 < x * y)%Z.
intros x y; case x; case y; unfold Zlt in |- *; simpl in |- *; auto.
Qed.
Hint Resolve Zlt_mult_ZERO: zarith.

Theorem Zlt_Zminus_ZERO :
 forall z1 z2 : Z, (z2 < z1)%Z -> (0 < z1 - z2)%Z.
intros z1 z2; rewrite (Zminus_diag_reverse z2); auto with zarith.
Qed.

Theorem Zle_Zminus_ZERO :
 forall z1 z2 : Z, (z2 <= z1)%Z -> (0 <= z1 - z2)%Z.
intros z1 z2; rewrite (Zminus_diag_reverse z2); auto with zarith.
Qed.
Hint Resolve Zle_Zminus_ZERO Zlt_Zminus_ZERO: zarith.

Theorem Zle_Zpred_Zpred :
 forall z1 z2 : Z, (z1 <= z2)%Z -> (Zpred z1 <= Zpred z2)%Z.
intros z1 z2 H; apply Zsucc_le_reg.
repeat rewrite <- Zsucc_pred; auto.
Qed.
Hint Resolve Zle_Zpred_Zpred: zarith.

Theorem Zle_ZERO_Zabs : forall z : Z, (0 <= Zabs z)%Z.
intros z; case z; simpl in |- *; auto with zarith.
Qed.
Hint Resolve Zle_ZERO_Zabs: zarith.

Theorem Zlt_Zabs_inv1 :
 forall z1 z2 : Z, (Zabs z1 < z2)%Z -> (- z2 < z1)%Z.
intros z1 z2 H; case (Zle_or_lt 0 z1); intros H1.
apply Zlt_le_trans with (- (0))%Z; auto with zarith.
apply Zlt_Zopp; apply Zle_lt_trans with (2 := H); auto with zarith.
rewrite <- (Zopp_involutive z1); rewrite <- (Zabs_eq_opp z1);
 auto with zarith.
Qed.

Theorem Zlt_Zabs_inv2 :
 forall z1 z2 : Z, (Zabs z1 < Zabs z2)%Z -> (z1 < Zabs z2)%Z.
intros z1 z2; case z1; case z2; simpl in |- *; auto with zarith.
Qed.

Theorem Zle_Zabs_inv1 :
 forall z1 z2 : Z, (Zabs z1 <= z2)%Z -> (- z2 <= z1)%Z.
intros z1 z2 H; case (Zle_or_lt 0 z1); intros H1.
apply Zle_trans with (- (0))%Z; auto with zarith.
apply Zle_Zopp; apply Zle_trans with (2 := H); auto with zarith.
rewrite <- (Zopp_involutive z1); rewrite <- (Zabs_eq_opp z1);
 auto with zarith.
Qed.

Theorem Zle_Zabs_inv2 :
 forall z1 z2 : Z, (Zabs z1 <= z2)%Z -> (z1 <= z2)%Z.
intros z1 z2 H; case (Zle_or_lt 0 z1); intros H1.
rewrite <- (Zabs_eq z1); auto.
apply Zle_trans with (Zabs z1); auto with zarith.
Qed.

Theorem Zlt_Zabs_Zpred :
 forall z1 z2 : Z,
 (Zabs z1 < z2)%Z -> z1 <> Zpred z2 -> (Zabs (Zsucc z1) < z2)%Z.
intros z1 z2 H H0; case (Zle_or_lt 0 z1); intros H1.
rewrite Zabs_eq; auto with zarith.
rewrite Zabs_eq in H; auto with zarith.
apply Zlt_trans with (2 := H).
repeat rewrite Zabs_eq_opp; auto with zarith.
Qed.

Theorem Zle_n_Zpred :
 forall z1 z2 : Z, (Zpred z1 <= Zpred z2)%Z -> (z1 <= z2)%Z.
intros z1 z2 H; rewrite (Zsucc_pred z1); rewrite (Zsucc_pred z2);
 auto with zarith.
Qed.

Theorem Zpred_Zopp_Zs : forall z : Z, Zpred (- z) = (- Zsucc z)%Z.
intros z; unfold Zpred, Zsucc in |- *; ring.
Qed.

Theorem Zlt_1_O : forall z : Z, (1 <= z)%Z -> (0 < z)%Z.
intros z H; apply Zsucc_lt_reg; simpl in |- *; auto with zarith.
Qed.
Hint Resolve Zlt_succ Zsucc_lt_compat Zle_lt_succ: zarith.

Theorem Zlt_not_eq : forall p q : Z, (p < q)%Z -> p <> q.
intros p q H; Contradict H; rewrite H; auto with zarith.
Qed.

Theorem Zlt_not_eq_rev : forall p q : Z, (q < p)%Z -> p <> q.
intros p q H; Contradict H; rewrite H; auto with zarith.
Qed.
Hint Resolve Zlt_not_eq Zlt_not_eq_rev: zarith.

Theorem Zle_Zpred_Zlt :
 forall z1 z2 : Z, (z1 <= z2)%Z -> (Zpred z1 < z2)%Z.
intros z1 z2 H; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; auto with zarith.
Qed.
Hint Resolve Zle_Zpred_Zlt: zarith.

Theorem Zle_Zpred_inv :
 forall z1 z2 : Z, (z1 <= Zpred z2)%Z -> (z1 < z2)%Z.
intros z1 z2 H; rewrite (Zsucc_pred z2); auto with zarith.
Qed.

Theorem Zabs_intro :
 forall (P : Z -> Prop) (z : Z), P (- z)%Z -> P z -> P (Zabs z).
intros P z; case z; simpl in |- *; auto.
Qed.

Theorem Zpred_Zle_Zabs_intro :
 forall z1 z2 : Z,
 (- Zpred z2 <= z1)%Z -> (z1 <= Zpred z2)%Z -> (Zabs z1 < z2)%Z.
intros z1 z2 H H0; apply Zle_Zpred_inv.
apply Zabs_intro with (P := fun x => (x <= Zpred z2)%Z); auto with zarith.
Qed.

Theorem Zlt_ZERO_Zle_ONE : forall z : Z, (0 < z)%Z -> (1 <= z)%Z.
intros z H; replace 1%Z with (Zsucc 0); auto with zarith; simpl in |- *; auto.
Qed.
Hint Resolve Zlt_ZERO_Zle_ONE: zarith.

Theorem ptonat_def1 : forall p q, 1 < Pmult_nat p (S (S q)).
intros p; elim p; simpl in |- *; auto with arith.
Qed.
Hint Resolve ptonat_def1: arith.

Theorem lt_S_le : forall p q, p < q -> S p <= q.
intros p q; unfold lt in |- *; simpl in |- *; auto.
Qed.
Hint Resolve lt_S_le: arith.

Theorem Zlt_Zabs_intro :
 forall z1 z2 : Z, (- z2 < z1)%Z -> (z1 < z2)%Z -> (Zabs z1 < z2)%Z.
intros z1 z2; case z1; case z2; simpl in |- *; auto with zarith.
intros p p0 H H0; change (- Zneg p0 < - Zneg p)%Z in |- *;
 auto with zarith.
Qed.


From GameTheory Require Import ImpartialGame.
Require Import Coq.Init.Wf.
Require Import Coq.Wellfounded.Lexicographic_Product.
Require Import Coq.Relations.Relation_Operators.
Import Relation_Definitions.

(** The definition of a sum of games is adapted from *)
(** #http://poleiro.info/posts/2013-09-08-an-introduction-to-combinatorial-game-theory.html#  *)
Definition cg_pair_order {cg1 cg2} :=
  symprod _ _ (valid_move cg1) (valid_move cg2).
Definition cg_pair_order_wf {cg1 cg2} : well_founded cg_pair_order :=
  wf_symprod _ _ _ _ (finite_game cg1) (finite_game cg2).

Definition sum_game (a b : impartial_game) : impartial_game.
  refine {|
      position := position a * position b;
      start := (start a, start b);
      moves pos := map (fun s => (s, snd pos)) (moves a (fst pos)) ++
                   map (fun s => (fst pos, s)) (moves b (snd pos));
    |}.
  match goal with
  | |- well_founded ?R =>
      assert (EQ : RelationClasses.relation_equivalence R cg_pair_order)
  end.
  { intros [pos1' pos2'] [pos1 pos2]. split.
    - intros H.
      apply in_app_or in H.
      repeat rewrite in_map_iff in H.
      destruct H as [(pos1'' & H1 & H2) | (pos2'' & H1 & H2)];
        simpl in *; inversion H1; subst; clear H1;
        constructor; auto.
    - intros H.
      inversion H as [? ? H' ?|? ? H']; subst; clear H;
        rewrite in_app_iff; repeat rewrite in_map_iff;
        simpl; eauto. }
  rewrite EQ.
  apply cg_pair_order_wf.
Defined.

Notation "a ~+~ b" := (sum_game a b) (at level 31, left associativity).

(** This lemma describes what valid moves look like in a sum of games. *)
(** We make use of both directions of the implication. *)
Lemma moves_in_game_sum : forall a b (s s' : position (a ~+~ b)),
    valid_move (a ~+~ b) s' s <->
      (valid_move a (fst s') (fst s) /\ snd s' = snd s) \/
      (valid_move b (snd s') (snd s) /\ fst s' = fst s).
Proof.
  intros.
  split; intros; destruct s, s'.
  - unfold valid_move in H. simpl in H.
    apply in_app_or in H.
    destruct H; rewrite in_map_iff in H; destruct H as [x [H1 H2]];
    [ left | right ]; inversion H1; subst; auto.
  - simpl in *.
    unfold valid_move. simpl.
    apply in_or_app.
    destruct H as [[H1 H2] | [H1 H2]]; subst;
      [ left | right ]; apply in_map_iff; [ exists p1 | exists p2 ]; auto.
Qed.

Ltac valid_move_sum_left :=
  apply moves_in_game_sum; left; simpl; intuition.
Ltac valid_move_sum_right :=
  apply moves_in_game_sum; right; simpl; intuition.

(** Transitive closure of relation: adapted from https://madiot.fr/pso/tp6.html *)
Inductive trans {A} (R : relation A) : relation A :=
  | rel_same : forall x y, R x y -> trans R x y
  | rel_trans : forall x y z, R x y -> R y z -> trans R x z.

Lemma Acc_trans (A : Type) (R : relation A) :
  forall x, Acc R x -> Acc (trans R) x.
Proof.
  intros.
  induction H.
  constructor. intros.
  destruct H1; auto.
  apply Acc_inv with y; auto.
  constructor. auto.
Qed.

Theorem wf_trans : forall (A : Type) (R : relation A),
  well_founded R -> well_founded (trans R).
Proof.
  intros A R W x. apply Acc_trans, W.
Qed.

(** In this proof, we need to go back two steps, not just one. *)
(** Therefore inducting on the Wf relation of a + b does not give us a strong enough induction principle. *)
(** Instead we define the transitive closure of this relation, and then prove it is well-founded. *)
(** Then we use this as our induction principle. *)
Lemma sum_losing_is_losing : forall a b x y,
    losing_state a x ->
    losing_state b y ->
    losing_state (a ~+~ b) (x, y).
Proof.
  intros a b.
  enough (forall s, losing_state a (fst s) ->
                    losing_state b (snd s) ->
                    losing_state (a ~+~ b) s) by auto.
  refine (well_founded_induction (wf_trans _ _ (finite_game (a ~+~ b))) _ _); intros [x y] IH ? ?; simpl in *.
  constructor; intros.
  apply moves_in_game_sum in H1 as [[? ?] | [? ?]]; destruct s'; simpl in *; subst.
  - inversion H; subst. specialize H2 with p.
    destruct H2; auto.
    apply trans_to_losing with (s', y).
    valid_move_sum_left.
    apply IH; auto.
    apply rel_trans with (s, y); valid_move_sum_left.
  - inversion H0; subst. specialize H2 with p0.
    destruct H2; auto.
    apply trans_to_losing with (x, s').
    valid_move_sum_right.
    apply IH; auto.
    apply rel_trans with (x, s); valid_move_sum_right.
Qed.

Lemma z_plus_z_is_losing : forall z, losing_state (z ~+~ z) (start z, start z).
Proof.
  intros z.
  enough (forall s, losing_state (z ~+~ z) (s, s)) by easy.
  refine (well_founded_induction (finite_game z) _ _); intros a IH.
  constructor; intros.
  destruct s'.
  apply moves_in_game_sum in H as [[? ?] | [? ?]]; simpl in *; subst.
  - apply trans_to_losing with (p, p).
    valid_move_sum_right.
    apply IH; auto.
  - apply trans_to_losing with (p0, p0).
    valid_move_sum_left.
    apply IH; auto.
Qed.

Lemma sum_losing_then_losing : forall x y,
    losing_state (x ~+~ y) (start x, start y) ->
    losing_state x (start x) ->
    losing_state y (start y).
Proof.
  intros.
  destruct (winning_or_losing y (start y)); auto.
  destruct w.
  pose proof (sum_losing_is_losing _ _ (start x) s').
  exfalso; apply (not_both_winning_losing (x ~+~ y) (start x, s')).
  intuition.
  inversion H; subst.
  apply (H4 (start x, s')).
  valid_move_sum_right.
Qed.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (y : natural) (x : natural) : natural := plus y (mult y x).


Require Import Coq.ZArith.ZArith.
Require Import Coq.micromega.Lia.
Require Import Crypto.Util.ZUtil.Hints.Core.
Require Import Crypto.Util.ListUtil.
Local Open Scope Z_scope.

Module Z.
  Lemma base_pow_neg b n : n < 0 -> b^n = 0.
  Proof.
    destruct n; intro H; try reflexivity; compute in H; congruence.
  Qed.
  Hint Rewrite base_pow_neg using zutil_arith : zsimplify.

  Lemma nonneg_pow_pos a b : 0 < a -> 0 < a^b -> 0 <= b.
  Proof.
    destruct (Z_lt_le_dec b 0); intros; auto.
    erewrite Z.pow_neg_r in * by eassumption.
    lia.
  Qed.
  Hint Resolve nonneg_pow_pos (fun n => nonneg_pow_pos 2 n Z.lt_0_2) : zarith.
  Lemma nonneg_pow_pos_helper a b dummy : 0 < a -> 0 <= dummy < a^b -> 0 <= b.
  Proof. eauto with zarith lia. Qed.
  Hint Resolve nonneg_pow_pos_helper (fun n dummy => nonneg_pow_pos_helper 2 n dummy Z.lt_0_2) : zarith.

  Lemma div_pow2succ : forall n x, (0 <= x) ->
    n / 2 ^ Z.succ x = Z.div2 (n / 2 ^ x).
  Proof.
    intros.
    rewrite Z.pow_succ_r, Z.mul_comm by auto.
    rewrite <- Z.div_div by (try apply Z.pow_nonzero; lia).
    rewrite Zdiv2_div.
    reflexivity.
  Qed.

  Definition pow_sub_r'
    := fun a b c y H0 H1 => @Logic.eq_trans _ _ _ y (@Z.pow_sub_r a b c H0 H1).
  Definition pow_sub_r'_sym
    := fun a b c y p H0 H1 => Logic.eq_sym (@Logic.eq_trans _ y _ _ (Logic.eq_sym p) (@Z.pow_sub_r a b c H0 H1)).
  Hint Resolve pow_sub_r' pow_sub_r'_sym Z.eq_le_incl : zarith.
  Hint Resolve (fun b => f_equal (fun e => b ^ e)) (fun e => f_equal (fun b => b ^ e)) : zarith.

  Lemma two_p_two_eq_four : 2^(2) = 4.
  Proof. reflexivity. Qed.
  Hint Rewrite <- two_p_two_eq_four : push_Zpow.

  Lemma pow_pos_le a b : 0 < a -> 0 < b -> a <= a ^ b.
  Proof.
    intros; transitivity (a ^ 1).
    { rewrite Z.pow_1_r; reflexivity. }
    { apply Z.pow_le_mono; auto with zarith. }
  Qed.
  Hint Resolve pow_pos_le : zarith.

  Lemma pow_pos_lt a b : 1 < a -> 1 < b -> a < a ^ b.
  Proof.
    intros; eapply Z.le_lt_trans with (m:=a ^ 1).
    { rewrite Z.pow_1_r; reflexivity. }
    { apply Z.pow_lt_mono_r; auto with zarith. }
  Qed.
  Hint Resolve pow_pos_lt : zarith.

  Lemma pow_div_base a b : a <> 0 -> 0 < b -> a ^ b / a = a ^ (b - 1).
  Proof. intros; rewrite Z.pow_sub_r, Z.pow_1_r; lia. Qed.
  Hint Rewrite pow_div_base using zutil_arith : pull_Zpow.

  Lemma pow_mul_base a b : 0 <= b -> a * a ^ b = a ^ (b + 1).
  Proof. intros; rewrite <-Z.pow_succ_r, <-Z.add_1_r by lia; reflexivity. Qed.
  Hint Rewrite pow_mul_base using zutil_arith : pull_Zpow.
End Z.


Require Import Logic.Class.Eq.
Require Import Logic.Fol.Syntax.

(* If equality on v is decidable, then so is equality on P v                    *)
Lemma eqDecidable : forall (v:Type) (e:Eq v),
    forall (s t:P v), {s = t} + {s <> t}.
Proof.
    intros v e s t. revert s t.
    induction s as [|x y|s1 IH1 s2 IH2|x s1 IH1];
    destruct t as [|x' y'|t1 t2|x' t1].
    - left. reflexivity.
    - right. intros H. inversion H.
    - right. intros H. inversion H.
    - right. intros H. inversion H.
    - right. intros H. inversion H.
    - destruct (eqDec x x') as [Ex|Ex], (eqDec y y') as [Ey|Ey].
        + subst. left. reflexivity.
        + right. intros H. inversion H. subst. apply Ey. reflexivity.
        + right. intros H. inversion H. subst. apply Ex. reflexivity.
        + right. intros H. inversion H. subst. apply Ex. reflexivity.
    - right. intros H. inversion H.
    - right. intros H. inversion H.
    - right. intros H. inversion H.
    - right. intros H. inversion H.
    - destruct (IH1 t1) as [E1|E1], (IH2 t2) as [E2|E2].
        + subst. left. reflexivity.
        + right. intros H. inversion H. subst. apply E2. reflexivity.
        + right. intros H. inversion H. subst. apply E1. reflexivity.
        + right. intros H. inversion H. subst. apply E1. reflexivity.
    - right. intros H. inversion H.
    - right. intros H. inversion H.
    - right. intros H. inversion H.
    - right. intros H. inversion H.
    - destruct (eqDec x x') as [E|E], (IH1 t1) as [E1|E1].
        + subst. left. reflexivity.
        + right. intros H. inversion H. subst. apply E1. reflexivity.
        + right. intros H. inversion H. subst. apply E.  reflexivity.
        + right. intros H. inversion H. subst. apply E.  reflexivity.
Defined.

Arguments eqDecidable {v} {e}.

Instance EqP (v:Type) (e:Eq v) : Eq (P v) := { eqDec := eqDecidable }.


Require Import FSets.
Require Import S_as_OT.

Inductive accessRight : Set :=
| weak : accessRight
| read : accessRight
| write : accessRight
| send : accessRight.

(* This defines a stepwise ordering on accessRights *)

  Inductive accessRight_succ : accessRight -> accessRight -> Prop :=
  | succ_weak_read : accessRight_succ weak read
  | succ_read_write : accessRight_succ read write
  | succ_write_send : accessRight_succ write send.

  Hint Constructors accessRight_succ: caps.

  Hint Resolve (f_equal accessRight_succ) : caps.

(* The successor of n is not equal to n *)

  Theorem accessRight_succ_neq : forall n Sn, accessRight_succ n Sn -> n <> Sn.
  Proof.
    intros n Sn H.
    destruct H; discriminate.
  Qed.

  Hint Immediate accessRight_succ_neq : caps.

(* Weak is not the successor of anything *)

  Theorem accessRight_succ_weak : forall n, ~ accessRight_succ n weak.
  Proof.
    intros n H.
    inversion H.
  Qed.

  Hint Resolve accessRight_succ_weak : caps.

(* Nothing is the successor of send *)

  Theorem accessRight_succ_send : forall n, ~ accessRight_succ send n.
  Proof.
    intros n H.
    inversion H.
  Qed.

  Hint Resolve accessRight_succ_send : caps.

(* Successor is not reflexive *)

  Theorem accessRight_succ_n_n : forall n, ~ accessRight_succ n n.
  Proof.
    intros n H.
    destruct n;
      inversion H.
  Qed.

  Hint Resolve accessRight_succ_n_n : caps.

(* Successor is not symmetric *)

  Theorem accessRight_succ_neq_succ : forall a b, accessRight_succ a b -> ~ accessRight_succ b a.
  Proof.
    intros a b S H.
    inversion S; subst; inversion H.
  Qed.

(* Define an order using successor *)

  Inductive accessRight_le : accessRight -> accessRight -> Prop :=
  | le_base : forall x, accessRight_le x x
  | le_trans : forall x y z, accessRight_le x y -> accessRight_succ y z -> accessRight_le x z.

  Hint Constructors accessRight_le : caps.

  Hint Resolve (f_equal accessRight_le) : caps.

(* accessRight_le is transitive *)

  Theorem accessRight_le_trans : forall x y z, accessRight_le x y -> accessRight_le y z -> accessRight_le x z.
  Proof.
    intros.
    induction H0; firstorder.  apply (le_trans x y z); assumption.
  Qed.

  Hint Resolve accessRight_le_trans: caps.

(* accessRight_le is reflexive *)

  Theorem accessRight_le_refl : forall x, accessRight_le x x.
  Proof.
    auto with caps.

(*
    intros. exact (le_base x).
*)
  Qed.

(** modeled from Coq.Arith.Le **)

(* Weak is less than everything *)

  Theorem accessRight_le_weak_n : forall n, accessRight_le weak n.
  Proof.
    induction n;
      eauto with caps.
(*
    apply le_trans with weak; constructor.
    apply le_trans with read; try constructor.
    apply le_trans with weak; constructor.
    apply le_trans with write; try constructor.
    apply le_trans with read; try constructor.
    apply le_trans with weak; constructor.
    constructor.
*)
  Qed.

  Hint Resolve accessRight_le_weak_n : caps.

(* The successor of anything is not less than weak *)

  Theorem accessRight_le_Sn_weak : forall n Sn, accessRight_succ n Sn -> ~ accessRight_le Sn weak.
  Proof.
    intros n Sn S.
    red.
    intro H.
    change ((fun r =>
      match r with
        | weak => False
        | read => True
        | write => True
        | send => True
      end) weak).
    induction H.
    destruct S; trivial.
    destruct H0; trivial.
  Qed.

  Hint Resolve accessRight_le_Sn_weak : caps.

(* Only weak is less than weak *)

  Theorem accessRight_le_n_weak_eq : forall n, accessRight_le n weak -> weak = n .
  Proof.
    intros n H.
    inversion H;
      [trivial
        | absurd (accessRight_succ y weak); eauto with caps] .
  Qed.

  Hint Immediate accessRight_le_n_weak_eq : caps.

(* The successor of n is not less than n *)

  Theorem accessRight_le_Sn_n : forall n Sn, accessRight_succ n Sn -> ~ accessRight_le Sn n.
  Proof.
    intros n p S.
    induction S; eauto with caps; intro ; inversion H ; subst;
      inversion H1 ; subst ; inversion H0 ; subst.
    absurd (accessRight_succ y weak); eauto with caps.
    inversion H3; subst.  inversion H2; subst.
    absurd (accessRight_succ y weak); eauto with caps.
  Qed.
  Hint Resolve accessRight_le_Sn_n : caps.

  Theorem accessRight_le_n_S : forall n m Sn Sm,
    accessRight_succ n Sn -> accessRight_succ m Sm -> accessRight_le n m -> accessRight_le Sn Sm.
  Proof.
    intros.
    inversion H; subst; inversion H0; subst; firstorder; eauto with caps.
    absurd (accessRight_le read weak); eauto with caps.
    absurd (accessRight_le write weak); eauto with caps.
    absurd (accessRight_le write read); eauto with caps.
  Qed.

  Theorem accessRight_le_Sn_le : forall n m Sn Sm,
    accessRight_succ n Sn -> accessRight_succ m Sm -> accessRight_le Sn Sm -> accessRight_le n m.
  Proof.
    intros n m Sn Sm S S1 H.
    inversion S; inversion S1; subst; eauto with caps.
    inversion H; subst.  inversion H1; subst.  inversion H0; subst; contradiction accessRight_succ_weak with y.
    inversion H; subst.  inversion H1; subst.  inversion H0; subst. contradiction accessRight_succ_weak with y.
    inversion H; subst.  inversion H1; subst.  inversion H0; subst.
    inversion H3; subst.  inversion H2; subst.  contradiction accessRight_succ_weak with y.
  Qed.

  Hint Resolve accessRight_le_Sn_le : caps.

  Theorem accessRight_le_n_Sn : forall n p, accessRight_succ n p -> accessRight_le n p.
  Proof.
    eauto with caps.
  Qed.

  Hint Resolve accessRight_le_n_Sn : caps.

  Theorem accessRight_le_pred_n : forall n Sn m,
    accessRight_succ n Sn -> accessRight_le Sn m -> accessRight_le n m.
  Proof.
    intros n Sn m H. apply accessRight_le_trans. eauto with caps.
  Qed.

  Hint Immediate accessRight_le_pred_n: caps.

  Theorem accessRight_le_not_Sn : forall n Sn m,
    accessRight_succ n Sn -> ~ accessRight_le n m -> ~ accessRight_le Sn m.
  Proof.
    intros n Sn m S H.
    inversion S; subst; eauto with caps.
  Qed.

  Hint Resolve accessRight_le_not_Sn : caps.

  Theorem accessRight_le_not_n_Sn : forall n Sn m,
    accessRight_succ n Sn -> ~ accessRight_le m Sn -> ~ accessRight_le m n.
  Proof.
    intros n Sn m S H.
    eauto with caps.
  Qed.

  Hint Resolve accessRight_le_not_n_Sn : caps.

(* If n is less than m, m is not the successor of n *)

  Theorem accessRight_le_succ : forall n m,
    accessRight_le n m -> ~ accessRight_succ m n.
  Proof.
    intros n m H.
    inversion H as [| x pred_m z H0 H1]; subst; eauto with caps.
    inversion H1; subst.
    inversion H0; subst;  intro NOT;  inversion NOT; subst.  contradiction accessRight_succ_weak with y.
    inversion H0; subst.  intro NOT; inversion NOT.  inversion H3; subst.  inversion H2; subst.  intro NOT.  inversion NOT.
    contradiction accessRight_succ_weak with y.
    inversion H0; subst.  intro NOT; inversion NOT; subst.  inversion H3; subst.  inversion H2; subst.  intro NOT.  inversion NOT.
    inversion H5; subst.  inversion H4; subst.  intro NOT; inversion NOT.  contradiction accessRight_succ_weak with y.
  Qed.

  Hint Resolve accessRight_le_succ : caps.

  Theorem accessRight_le_antisym : forall x y, accessRight_le x y -> accessRight_le y x -> x = y.
  Proof.
    intros x y H H0.
    inversion H as [| x' pred_y z H1 H2]; subst; eauto with caps.
    absurd (accessRight_le y x); eauto with caps.
    apply accessRight_le_Sn_n in H2.
    eauto with caps.
  Qed.

  Hint Resolve accessRight_le_antisym : caps.

  Theorem accessRight_succ_neq_trans : forall n Sn SSn,
    accessRight_succ n Sn -> accessRight_succ Sn SSn -> n <> SSn.
  Proof.
    intros n Sn SSn S S1.
    inversion S; subst; inversion S1; subst; discriminate.
  Qed.

  Hint Resolve accessRight_succ_neq_trans : caps.

  Inductive accessRight_lt (n m :accessRight) : Prop :=
  | accessRight_lt_le : forall Sn, accessRight_succ n Sn -> accessRight_le Sn m -> accessRight_lt n m.

  Hint Constructors accessRight_lt : caps.

  Theorem accessRight_lt_trans : forall n m p,
    accessRight_lt n m -> accessRight_lt m p -> accessRight_lt n p.
  Proof.
    intros n m p H H0; inversion H0 as [Sm]; subst; inversion H as [Sn]; subst; constructor 1 with Sn; eauto with caps.
  Qed.

  Hint Resolve accessRight_lt_trans : caps.

  Theorem accessRight_lt_irrefl : forall n,  ~ accessRight_lt n n.
  Proof.
    intros n H.
    destruct H.
    contradiction accessRight_le_Sn_n with n Sn.
  Qed.

  Hint Resolve accessRight_lt_irrefl : caps.

  Theorem accessRight_lt_not_eq: forall n m,
    accessRight_lt n m -> n <> m.
    intros n m Hlt.
    destruct Hlt as [Sn S Hle].
    destruct S.
    destruct m ; try discriminate ; inversion Hle; subst; contradiction accessRight_succ_weak with y .
    destruct m ; try discriminate ; inversion Hle; subst; inversion H0; subst; inversion H; subst; contradiction accessRight_succ_weak with y .
    destruct m ; try discriminate ; inversion Hle; subst. inversion H0; subst. inversion H; subst.  inversion H2; subst.     inversion H1; subst. contradiction accessRight_succ_weak with y .
  Qed.

  Hint Resolve accessRight_lt_not_eq : caps.

  Theorem accessRight_lt_eq_lt_dec n m :
    {accessRight_lt n m} + {n = m} + {accessRight_lt m n}.
  Proof.
    intros.
    destruct n; destruct m; eauto with caps.
  Qed.

  Theorem accessRight_eq_dec: forall n m:accessRight, {n = m} + {n <> m}.
  Proof.
    intros.
    induction n; destruct m; auto;
    (* all that remains are the <> cases *)
      right; simplify_eq.
  Qed.

Module AccessRight_as_UOT <: UsualOrderedType.

  Definition t := accessRight.

  Definition eq := @eq accessRight.
  Definition eq_refl := @refl_equal t.
  Definition eq_sym := @sym_eq t.
  Definition eq_trans := @trans_eq t.
  Definition eq_dec := accessRight_eq_dec.

  Definition lt := accessRight_lt.

  Definition lt_trans := accessRight_lt_trans.

  Definition lt_not_eq := accessRight_lt_not_eq.

  Theorem compare : forall x y : t, Compare lt eq x y.
  Proof.
    unfold t, lt.
    intros.
    case (accessRight_lt_eq_lt_dec x y).
    intro s.  destruct s as [a|a].
    exact (LT eq a).
    exact (EQ accessRight_lt a).
    intro a.
    exact (GT eq a).
  Qed.

Hint Unfold eq : caps.
Hint Unfold lt : caps.

End AccessRight_as_UOT.

Module AccessRightOT <: OrderedType := AccessRight_as_UOT.

Module AccessRightFSetList := FSetList.Make AccessRightOT.

Module Type AccessRightFSetType := FSetInterface.S with Module E := AccessRightOT.

Module AccessRightFSet : AccessRightFSetType := AccessRightFSetList.

Definition accessRightSet := AccessRightFSet.t.

Hint Immediate AccessRightFSet.eq_sym : caps.
Hint Resolve AccessRightFSet.eq_refl AccessRightFSet.eq_trans AccessRightFSet.lt_not_eq AccessRightFSet.lt_trans : caps.

Require FSetAddEq.
Require FSetListUOT.
Require FoldEqual.

Module ARSetProps := FSetProperties.Properties AccessRightFSet.
Module ARSetFacts := FSetFacts.Facts AccessRightFSet.
Module ARSetfDep := FSetBridge.DepOfNodep AccessRightFSet.
Module ARSetEqProps := FSetEqProperties.EqProperties AccessRightFSet.
Module ARSetAddEq := FSetAddEq.Make AccessRightFSet.
Module ARSetFold := FoldEqual.Make AccessRightFSet.

Definition all_rights := AccessRightFSet.add read
        (AccessRightFSet.add write
          (AccessRightFSet.add weak
            (AccessRightFSet.singleton send))).


Require Export Basics.

Fixpoint ble_nat (n m : nat) : bool :=
  match n with
  | O => true
  | S n' =>
      match m with
      | O => false
      | S m' => ble_nat n' m'
      end
  end.

Fixpoint minus (n m:nat) : nat :=
  match n, m with
  | O   , _    => O
  | S _ , O    => n
  | S n', S m' => minus n' m'
  end.

Theorem minus_help : forall (x y : nat),
  ble_nat x y = true -> x + (minus y x) = y.
Proof.
  intros x y. intros H.
  induction x as [ | x'].
  simpl. admit.
  simpl. admit.

Theorem ble_nat1 : forall (x y : nat),
  ble_nat (S x) y = true -> ble_nat x y = true.
Proof.
  intros x y. intros H.
  induction y as [ | y'].
  inversion H.

Theorem ble_nat2 : forall (x : nat),
  ble_nat x (S x).

Theorem ble_nat_alt : forall (x y : nat),
  ble_nat x y = true -> exists (z : nat), x + z = y.
Proof.
  intros x y.
  intros H.
  assert (Lemma1 : x + (minus y x) = y).