Require Export GeoCoq.Elements.OriginalProofs.lemma_inequalitysymmetric.
Require Export GeoCoq.Elements.OriginalProofs.lemma_localextension.
Require Export GeoCoq.Elements.OriginalProofs.lemma_doublereverse.

Section Euclid.
Context `{Ax:euclidean_neutral_ruler_compass}.
Lemma lemma_differenceofparts :
   forall A B C a b c,
   Cong A B a b -> Cong A C a c -> BetS A B C -> BetS a b c ->
   Cong B C b c.
Proof.
intros.
assert (Cong B C b c).
by cases on (eq B A \/ neq B A).
{
 assert (Cong A A a b) by (conclude cn_equalitysub).
 assert (Cong a b A A) by (conclude lemma_congruencesymmetric).
 assert (~ neq a b).
  {
  intro.
  assert (neq A A) by (conclude axiom_nocollapse).
  assert (eq A A) by (conclude cn_equalityreflexive).
  contradict.
  }
 assert (Cong A C A C) by (conclude cn_congruencereflexive).
 assert (Cong B C A C) by (conclude cn_equalitysub).
 assert (Cong B C a c) by (conclude lemma_congruencetransitive).
 assert (Cong b c b c) by (conclude cn_congruencereflexive).
 assert (Cong b c a c) by (conclude cn_equalitysub).
 assert (Cong a c b c) by (conclude lemma_congruencesymmetric).
 assert (Cong B C b c) by (conclude lemma_congruencetransitive).
 close.
 }
{
 assert (~ eq C A).
  {
  intro.
  assert (BetS A B A) by (conclude cn_equalitysub).
  assert (~ BetS A B A) by (conclude axiom_betweennessidentity).
  contradict.
  }
 assert (neq A C) by (conclude lemma_inequalitysymmetric).
 let Tf:=fresh in
 assert (Tf:exists E, (BetS C A E /\ Cong A E A C)) by (conclude lemma_localextension);destruct Tf as [E];spliter.
 assert (neq A C) by (conclude lemma_inequalitysymmetric).
 assert (neq a c) by (conclude axiom_nocollapse).
 assert (neq c a) by (conclude lemma_inequalitysymmetric).
 let Tf:=fresh in
 assert (Tf:exists e, (BetS c a e /\ Cong a e a c)) by (conclude lemma_localextension);destruct Tf as [e];spliter.
 assert (Cong E A A E) by (conclude cn_equalityreverse).
 assert (Cong E A A C) by (conclude lemma_congruencetransitive).
 assert (Cong E A a c) by (conclude lemma_congruencetransitive).
 assert (Cong e a a e) by (conclude cn_equalityreverse).
 assert (Cong e a a c) by (conclude lemma_congruencetransitive).
 assert (Cong a c e a) by (conclude lemma_congruencesymmetric).
 assert (Cong E A a c) by (conclude lemma_congruencetransitive).
 assert (Cong E A e a) by (conclude lemma_congruencetransitive).
 assert (BetS E A C) by (conclude axiom_betweennesssymmetry).
 assert (BetS e a c) by (conclude axiom_betweennesssymmetry).
 assert (Cong E C e c) by (conclude cn_sumofparts).
 assert (BetS E A B) by (conclude axiom_innertransitivity).
 assert (BetS e a b) by (conclude axiom_innertransitivity).
 assert (Cong C B c b) by (conclude axiom_5_line).
 assert (Cong b c B C) by (forward_using lemma_doublereverse).
 assert (Cong B C b c) by (conclude lemma_congruencesymmetric).
 close.
 }
(* cases *)
close.
Qed.

End Euclid.


(********************************************************************)
(*                                                                  *)
(*  The Why3 Verification Platform   /   The Why3 Development Team  *)
(*  Copyright 2010-2019   --   Inria - CNRS - Paris-Sud University  *)
(*                                                                  *)
(*  This software is distributed under the terms of the GNU Lesser  *)
(*  General Public License version 2.1, with the special exception  *)
(*  on linking described in file LICENSE.                           *)
(*                                                                  *)
(********************************************************************)

(* This file is generated by Why3's Coq-realize driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require Reals.Rbasic_fun.
Require BuiltIn.
Require real.Real.

Import Rbasic_fun.

(* Why3 comment *)
(* abs is replaced with (Reals.Rbasic_fun.Rabs x) by the coq driver *)

(* Why3 goal *)
Lemma abs_def :
  forall (x:Reals.Rdefinitions.R),
  ((0%R <= x)%R -> ((Reals.Rbasic_fun.Rabs x) = x)) /\
  (~ (0%R <= x)%R -> ((Reals.Rbasic_fun.Rabs x) = (-x)%R)).
split ; intros H.
apply Rabs_right.
now apply Rle_ge.
apply Rabs_left.
now apply Rnot_le_lt.
Qed.

(* Why3 goal *)
Lemma Abs_le :
  forall (x:Reals.Rdefinitions.R) (y:Reals.Rdefinitions.R),
  ((Reals.Rbasic_fun.Rabs x) <= y)%R <-> ((-y)%R <= x)%R /\ (x <= y)%R.
intros x y.
unfold Rabs.
case Rcase_abs ; intros H ; (split ; [intros H0;split | intros (H0,H1)]).
rewrite <- (Ropp_involutive x).
now apply Ropp_le_contravar.
apply Rlt_le.
apply Rlt_le_trans with (1 := H).
apply Rle_trans with (2 := H0).
rewrite <- Ropp_0.
apply Ropp_le_contravar.
now apply Rlt_le.
rewrite <- (Ropp_involutive y).
now apply Ropp_le_contravar.
apply Rge_le in H.
apply Rle_trans with (2 := H).
apply Rle_trans with (Ropp x).
now apply Ropp_le_contravar.
rewrite <- Ropp_0.
now apply Ropp_le_contravar.
exact H0.
exact H1.
Qed.

(* Why3 goal *)
Lemma Abs_pos :
  forall (x:Reals.Rdefinitions.R), (0%R <= (Reals.Rbasic_fun.Rabs x))%R.
exact Rabs_pos.
Qed.

(* Why3 goal *)
Lemma Abs_sum :
  forall (x:Reals.Rdefinitions.R) (y:Reals.Rdefinitions.R),
  ((Reals.Rbasic_fun.Rabs (x + y)%R) <=
   ((Reals.Rbasic_fun.Rabs x) + (Reals.Rbasic_fun.Rabs y))%R)%R.
exact Rabs_triang.
Qed.

(* Why3 goal *)
Lemma Abs_prod :
  forall (x:Reals.Rdefinitions.R) (y:Reals.Rdefinitions.R),
  ((Reals.Rbasic_fun.Rabs (x * y)%R) =
   ((Reals.Rbasic_fun.Rabs x) * (Reals.Rbasic_fun.Rabs y))%R).
exact Rabs_mult.
Qed.

(* Why3 goal *)
Lemma triangular_inequality :
  forall (x:Reals.Rdefinitions.R) (y:Reals.Rdefinitions.R)
    (z:Reals.Rdefinitions.R),
  ((Reals.Rbasic_fun.Rabs (x - z)%R) <=
   ((Reals.Rbasic_fun.Rabs (x - y)%R) + (Reals.Rbasic_fun.Rabs (y - z)%R))%R)%R.
intros x y z.
replace (x - z)%R with ((x - y) + (y - z))%R by ring.
apply Rabs_triang.
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) (lf2 : natural) : natural := plus Zero lf2.


Require Import init.

Require Import rat.
Require Import set.

Declare Scope real_scope.
Delimit Scope real_scope with real.

Definition dedekind_cut (a : rat → Prop) :=
    a ≠ all ∧
    a ≠ empty ∧
    (∀ l u, a u → l < u → a l) ∧
    (∀ l, a l → ∃ u, a u ∧ l < u).

Theorem dedekind_le : ∀ a, dedekind_cut a → ∀ l u, a u → l ≤ u → a l.
Proof.
    intros a a_cut l u au lu.
    classic_case (l = u).
    -   subst.
        exact au.
    -   apply (land (rand (rand a_cut)) _ _ au).
        split; assumption.
Qed.

Theorem dedekind_lt : ∀ a, dedekind_cut a → ∀ l u, a l → ¬a u → l < u.
Proof.
    intros a a_cut l u al nau.
    classic_case (l = u) as [eq|neq]; try (subst; contradiction).
    classic_contradiction leq.
    rewrite nlt_le in leq.
    rewrite neq_sym in neq.
    apply nau.
    apply (land (rand (rand a_cut)) u l); try split; assumption.
Qed.

Notation "'real'" := (set_type dedekind_cut).

Definition rat_to_real_base (a b : rat) := b < a.
Lemma rat_to_real_cut : ∀ a, dedekind_cut (rat_to_real_base a).
Proof.
    intros a.
    unfold rat_to_real_base.
    split.
    2: split.
    3: split.
    -   intros eq.
        assert (all a) as contr by exact true.
        rewrite <- eq in contr.
        destruct contr; contradiction.
    -   apply empty_neq.
        exists (a + -(1)).
        rewrite <- (plus_rid a) at 2.
        apply lt_lplus.
        apply pos_neg2.
        exact one_pos.
    -   intros l u ltq1 ltq2.
        exact (trans ltq2 ltq1).
    -   intros l ltq.
        exists ((l + a) * div 2).
        split.
        +   apply lt_mult_rcancel_pos with 2; try exact two_pos.
            rewrite mult_rlinv by apply two_pos.
            rewrite ldist.
            rewrite mult_rid.
            apply lt_rplus.
            exact ltq.
        +   apply lt_mult_rcancel_pos with 2; try exact two_pos.
            rewrite mult_rlinv by apply two_pos.
            rewrite ldist.
            rewrite mult_rid.
            apply lt_lplus.
            exact ltq.
Qed.

Definition rat_to_real a := [_|rat_to_real_cut a].


Declare ML Module "coq-paramcoq.plugin".

Require Import NPeano.
Require Import Recdef.
Set Implicit Arguments.
Require Import Lia.

Fixpoint subS (n m : nat) {struct n} : nat :=
  match n return  nat with
  | 0 => 0 (* originally n*)
  | S k => match m return nat with
           | 0 => S k (* originally n*)
           | S l => subS k l
           end
  end.

Definition modS :=
fun x y : nat => match y with
                 | 0 => match (1 mod 0) with | 0 => 0 | _ => x end
                 | S y' => subS y' (snd (divmod x y' 0 y'))
                 end.

Lemma subS_same : forall n m, subS  n m = Nat.sub n m.
Proof.
  induction n; destruct m; simpl; auto.
Defined.

Lemma modS_same : forall n m, modS  n m = Nat.modulo n m.
Proof.
   destruct m; simpl; auto.
    rewrite  subS_same. reflexivity.
Defined.

Function GcdS (a b : nat) {wf lt a} : nat :=
match a with
 | O => b
 | S k =>  GcdS (modS b (S k))  (S k)
end.
Proof.
- intros m n k Heq. rewrite modS_same.
  simpl.
  lia.
- exact Wf_nat.lt_wf.
Defined.

Ltac destruct_reflexivity :=
  intros ; repeat match goal with
    | [ x : _ |- _ = _ ] => destruct x; reflexivity; fail
  end.

Ltac destruct_construct x :=
    (destruct x; [ constructor 1 ]; auto; fail)
 || (destruct x; [ constructor 1 | constructor 2 ]; auto; fail)
 || (destruct x; [ constructor 1 | constructor 2 | constructor 3]; auto; fail).

Ltac unfold_cofix := intros; match goal with
 [ |- _ = ?folded ] =>
    let x := fresh "x" in
    let typ := type of folded in
    (match folded with _ _ => pattern folded | _ => pattern folded at 2 end);
    match goal with [ |- ?P ?x ] =>
    refine (let rebuild : typ -> typ := _ in
            let path : rebuild folded = folded := _ in
            eq_rect _ P _ folded path) end;
    [ intro x ; destruct_construct x; fail
    | destruct folded; reflexivity
    | reflexivity]; fail
end.

Ltac destruct_with_nat_arg_pattern x :=
  pattern x;
  match type of x with
   | ?I 0 => refine (let gen : forall m (q : I m),
     (match m return I m -> Type with
         0 => fun p => _ p
     | S n => fun _  => unit end q) := _ in gen 0 x)
   | ?I (S ?n) => refine (let gen : forall m (q : I m),
     (match m return I m -> Type with
         0 => fun _  => unit
     | S n => fun p => _ p end q) := _ in gen (S n) x)
  end; intros m q; destruct q.

Ltac destruct_reflexivity_with_nat_arg_pattern :=
  intros ; repeat match goal with
    | [ x : _ |- _ = _ ] => destruct_with_nat_arg_pattern x; reflexivity; fail
  end.

Global Parametricity Tactic := ((destruct_reflexivity; fail)
                            || (unfold_cofix; fail)
                            || (destruct_reflexivity_with_nat_arg_pattern; fail)
                            ||  auto).

Require Import ProofIrrelevance.

(* Parametricity Recursive GcdS qualified. *)  (* FIXME *)

(*
DepRefs:
nat
le
lt
prod
snd
subS
Init.Nat.divmod
modS
GcdS_F
Recdef.iter
and
iff
Basics.impl
unit
Init.Unconvertible
Relation_Definitions.relation
Morphisms.Proper
RelationClasses.subrelation
Morphisms.subrelation_proper
eq
eq_rect
eq_ind
eq_sym
eq_ind_r
PeanoNat.Nat.succ_wd_obligation_1
Nat.succ_wd
Morphisms.subrelation_refl
Morphisms.respectful
RelationClasses.Transitive
RelationClasses.transitivity
Morphisms.trans_co_impl_morphism_obligation_1
Morphisms.trans_co_impl_morphism
RelationClasses.Symmetric
RelationClasses.Reflexive
RelationClasses.Equivalence
RelationClasses.Equivalence_Transitive
RelationClasses.PER
RelationClasses.PER_Symmetric
RelationClasses.symmetry
RelationClasses.PER_Transitive
Morphisms.PER_morphism_obligation_1
Morphisms.PER_morphism
Init.Nat.pred
RelationClasses.Equivalence_Symmetric
RelationClasses.Equivalence_PER
Nat.pred_succ
Morphisms.reflexive_proper_proxy
and_rect
and_ind
Morphisms.iff_impl_subrelation
PeanoNat.Nat.pred_wd_obligation_1
Nat.pred_wd
RelationClasses.Equivalence_Reflexive
Morphisms.subrelation_respectful
RelationClasses.eq_Reflexive
eq_trans
RelationClasses.eq_Transitive
RelationClasses.eq_Symmetric
RelationClasses.eq_equivalence
Nat.eq_equiv
Nat.succ_inj
Nat.succ_inj_wd
Morphisms.ProperProxy
Morphisms.Reflexive_partial_app_morphism
False
False_rect
False_ind
not
iff_sym
RelationClasses.iff_Symmetric
iff_trans
RelationClasses.iff_Transitive
iff_refl
RelationClasses.iff_Reflexive
RelationClasses.iff_equivalence
Morphisms.per_partial_app_morphism_obligation_1
Morphisms.per_partial_app_morphism
Morphisms.trans_sym_co_inv_impl_morphism_obligation_1
Morphisms.trans_sym_co_inv_impl_morphism
Basics.flip
RelationClasses.reflexivity
comparison
Init.Nat.compare
or
or_ind
Morphisms.trans_co_eq_inv_impl_morphism_obligation_1
Morphisms.trans_co_eq_inv_impl_morphism
Morphisms.eq_proper_proxy
Morphisms_Prop.or_iff_morphism_obligation_1
Morphisms_Prop.or_iff_morphism
nat_rect
nat_ind
f_equal
f_equal_nat
eq_add_S
True
Nat.compare_eq_iff
Peano.le_0_n
le_ind
Peano.le_pred
Peano.le_S_n
Peano.le_n_S
Nat.compare_le_iff
Nat.compare_lt_iff
Nat.lt_eq_cases
Nat.le_refl
Morphisms.iff_flip_impl_subrelation
Nat.lt_succ_r
Nat.lt_succ_diag_r
PeanoNat.Nat.lt_wd_obligation_1
Nat.lt_wd
Nat.compare_refl
Morphisms_Prop.not_iff_morphism_obligation_1
Morphisms_Prop.not_iff_morphism
Nat.lt_irrefl
Nat.neq_succ_diag_l
Nat.lt_le_incl
Nat.nlt_succ_diag_l
Nat.nle_succ_diag_l
Nat.bi_induction
Morphisms_Prop.iff_iff_iff_impl_morphism_obligation_1
Morphisms_Prop.iff_iff_iff_impl_morphism
Nat.central_induction
Nat.le_wd
or_iff_compat_r
or_cancel_r
Nat.le_succ_l
Nat.succ_lt_mono
lt_S_n
Acc
Acc_inv
positive
BinPosDef.Pos.succ
BinPosDef.Pos.of_succ_nat
Z
BinIntDef.Z.of_nat
Decidable.decidable
Decidable.dec_not_not
BinPosDef.Pos.pred_double
BinIntDef.Z.pred_double
BinIntDef.Z.double
BinIntDef.Z.succ_double
BinIntDef.Z.pos_sub
BinPosDef.Pos.add
BinIntDef.Z.add
Morphisms.reflexive_proper
Z.eq
Morphisms.reflexive_eq_dom_reflexive
Z.add_wd
Z.eq_equiv
BinIntDef.Z.succ
Z.succ_wd
BinIntDef.Z.pred
BinIntDef.Z.opp
BinPosDef.Pos.compare_cont
BinPosDef.Pos.compare
BinPosDef.Pos.mask
BinPosDef.Pos.double_pred_mask
BinPosDef.Pos.double_mask
BinPosDef.Pos.succ_double_mask
BinPosDef.Pos.sub_mask
Pos.mask2cmp
BinPosDef.Pos.pred
BinPosDef.Pos.pred_mask
BinPosDef.Pos.sub_mask_carry
positive_rect
positive_ind
Pos.sub_mask_carry_spec
Pos.switch_Eq
Pos.compare_cont_spec
Pos.compare_xI_xO
Pos.compare_xO_xI
Pos.compare_sub_mask
BinPosDef.Pos.add_carry
Pos.add_carry_spec
Pos.add_comm
Pos.add_1_r
Pos.add_succ_r
Pos.add_succ_l
Pos.add_1_l
Pos.add_assoc
Pos.succ_pred_double
Pos.add_xI_pred_double
Pos.SubMaskSpec
Pos.sub_mask_spec
Pos.sub_mask_nul_iff
Pos.compare_eq_iff
Pos.eq_equiv
Pos.compare_refl
Pos.sub_mask_diag
Pos.compare_xI_xI
Pos.compare_xO_xO
Pos.lt
Pos.compare_lt_iff
CompOpp
Pos.compare_cont_antisym
Pos.compare_antisym
CompOpp_involutive
CompOpp_inj
CompOpp_iff
CompareSpec
Pos.compare_spec
Pos.add_no_neutral
Pos.sub_mask_add_diag_r
ex
Pos.sub_mask_neg_iff
Pos.lt_iff_add
Pos.succ_not_1
Pos.succ_inj
Pos.add_carry_add
not_eq_sym
Pos.add_reg_r
Pos.add_reg_l
Pos.add_cancel_l
Pos.sub_mask_add_diag_l
Pos.sub_mask_add
Pos.sub_mask_pos_iff
Pos.sub_mask_pos'
Pos.sub_mask_pos
BinPosDef.Pos.sub
Pos.sub_xI_xI
Pos.sub_xI_xO
Pos.sub_xO_xI
Pos.sub_xO_xO
Z.pos_sub_spec
Z.pos_sub_diag
Z.Private_BootStrap.add_opp_diag_r
Z.pos_sub_opp
Z.Private_BootStrap.opp_add_distr
Pos.peano_rect
Pos.peano_ind
Pos.compare_succ_r
Pos.compare_succ_l
Pos.compare_succ_succ
Pos.add_compare_mono_l
Pos.add_compare_mono_r
Pos.lt_trans
Pos.add_lt_mono_l
Pos.lt_succ_diag_r
Pos.lt_add_r
Pos.sub_add
Pos.add_sub_assoc
Pos.add_lt_mono_r
Pos.sub_add_distr
Pos.add_sub
Pos.sub_sub_distr
Pos.gt
Pos.gt_lt_iff
Pos.lt_gt
Z.Private_BootStrap.pos_sub_add
Z.Private_BootStrap.opp_inj
Z.Private_BootStrap.add_comm
Z.Private_BootStrap.add_0_r
Z.Private_BootStrap.add_assoc_pos
Z.Private_BootStrap.add_assoc
Z.pred_succ
Z.pred_wd
Z.succ_inj
Z.succ_inj_wd
Z.add_succ_l
Z.add_0_l
Z.succ_pred
Z.peano_ind
Z.bi_induction
Z.add_assoc
fast_Zplus_assoc
lt_n_S
nat_rec
gt
lt_le_S
gt_le_S
all
Morphisms.pointwise_relation
Morphisms_Prop.all_iff_morphism_obligation_1
Morphisms_Prop.all_iff_morphism
RelationClasses.complement
RelationClasses.Irreflexive
RelationClasses.StrictOrder
RelationClasses.StrictOrder_Transitive
Nat.lt_asymm
Nat.lt_trans
Nat.lt_strorder
Nat.Private_OrderTac.IsTotal.lt_strorder
Nat.le_lteq
Nat.Private_OrderTac.IsTotal.le_lteq
Nat.lt_compat
Nat.Private_OrderTac.IsTotal.lt_compat
OrdersTac.ord
OrdersTac.trans_ord
Nat.Private_OrderTac.IsTotal.eq_equiv
Nat.Private_OrderTac.Tac.interp_ord
Nat.Private_OrderTac.Tac.trans
Nat.Private_OrderTac.Tac.lt_trans
RelationClasses.StrictOrder_Irreflexive
Nat.Private_OrderTac.Tac.lt_irrefl
Nat.le_gt_cases
Nat.lt_trichotomy
Nat.lt_total
Nat.Private_OrderTac.IsTotal.lt_total
Nat.Private_OrderTac.Tac.not_gt_le
Nat.le_le_succ_r
Nat.Private_OrderTac.Tac.le_lt_trans
Nat.le_succ_r
Nat.lt_exists_pred_strong
Nat.lt_exists_pred
Nat.rs_rs'
Nat.A'A_right
Nat.le_ngt
Nat.rbase
Nat.lt_lt_succ_r
Nat.rs'_rs''
Nat.strong_right_induction
Nat.right_induction
Nat.Private_OrderTac.Tac.lt_eq
Nat.eq_le_incl
Nat.pred_0
Nat.neq_succ_0
Nat.le_0_l
Nat.induction
Nat.lt_0_succ
le_n_S
sumbool
sumbool_rect
sumbool_rec
le_lt_dec
le_gt_dec
Zplus_assoc_reverse
fast_Zplus_assoc_reverse
Nat.Private_OrderTac.Tac.not_ge_lt
Nat.lt_le_trans
ltof
lt_n_Sm_le
Nat.nlt_0_r
well_founded
well_founded_ltof
lt_wf
N
BinNatDef.N.sub
Init.Nat.sub
BinNatDef.N.of_nat
Init.Nat.add
BinPosDef.Pos.iter_op
BinPosDef.Pos.to_nat
BinNatDef.N.to_nat
BinPosDef.Pos.of_nat
Pos.of_nat_succ
Pos.iter_op_succ
Nat.add_succ_l
Nat.add_0_l
PeanoNat.Nat.add_wd_obligation_1
Nat.add_wd
Nat.add_assoc
Pos2Nat.inj_succ
Nat2Pos.id
SuccNat2Pos.id_succ
Nnat.Nat2N.id
BinNatDef.N.compare
Pos2Nat.is_succ
Pos.le
Pos.le_1_l
Pos.lt_succ_r
Pos.lt_1_succ
Pos.succ_pred_or
Nat.compare_succ
Pos2Nat.inj_1
Nat.compare_antisym
Nat.compare_gt_iff
Pos2Nat.is_pos
Pos2Nat.inj_compare
Nnat.N2Nat.inj_compare
Nnat.Nat2N.inj_compare
nat_compare_le
BinIntDef.Z.of_N
nat_N_Z
BinIntDef.Z.sub
BinIntDef.Z.compare
Z.compare_sub
N.le
N2Z.inj_compare
N.compare_antisym
BinIntDef.Z.max
N2Z.inj_sub_max
N2Z.inj_sub
Nat.sub_0_r
Pos.sub_mask_neg_iff'
Pos.sub_mask_neg
Pos2Nat.inj_add
PeanoNat.Nat.sub_wd_obligation_1
Nat.sub_wd
Nat.sub_succ_r
Nat.sub_0_l
Nat.nle_succ_0
Nat.succ_le_mono
Nat.sub_succ
Nat.case_analysis
Nat.double_induction
Nat.sub_0_le
Nat.sub_diag
Nat.add_succ_r
Nat.add_0_r
Nat.add_comm
Nat.lt_ind
Nat.lt_succ_l
Nat.lt_ind_rel
Nat.sub_gt
Nat.add_pred_l
Nat.add_pred_r
Nat.add_sub_assoc
Nat.add_sub
Nat.add_sub_eq_l
Pos2Nat.inj_lt
Nnat.N2Nat.inj_sub
Pos2Nat.id
Pos2Nat.inj
Nnat.N2Nat.id
Nnat.N2Nat.inj
Nnat.Nat2N.inj_sub
Nat2Z.inj_sub
BinPosDef.Pos.mul
BinIntDef.Z.mul
Z.mul_wd
Z.Private_BootStrap.mul_1_l
Pos.mul_1_r
Pos.mul_xI_r
Pos.mul_xO_r
Pos.mul_comm
Pos.mul_add_distr_l
Pos.mul_add_distr_r
Pos.add_lt_mono
Pos.gt_lt
Pos.mul_compare_mono_l
Pos.mul_lt_mono_l
Pos.mul_sub_distr_l
Pos.mul_sub_distr_r
Pos.mul_compare_mono_r
Z.Private_BootStrap.mul_add_distr_pos
Z.Private_BootStrap.mul_0_r
Z.Private_BootStrap.mul_opp_r
Z.Private_BootStrap.mul_add_distr_r
Z.mul_succ_l
Z.add_succ_r
Z.add_0_r
Z.add_comm
Z.add_cancel_l
Z.add_cancel_r
Z.mul_0_l
Z.mul_succ_r
Z.one_succ
Z.add_1_l
Zred_factor3
fast_Zred_factor3
Z.mul_0_r
Zred_factor5
fast_Zred_factor5
Z.le
Z.lt
Z.compare_eq_iff
Z.compare_le_iff
Z.compare_lt_iff
Z.lt_eq_cases
Z.lt_wd
Z.compare_refl
Z.lt_irrefl
Z.sub_succ_r
Z.lt_succ_r
Z.lt_le_incl
Z.central_induction
Z.le_refl
Z.lt_succ_diag_r
Z.neq_succ_diag_l
Z.nlt_succ_diag_l
Z.nle_succ_diag_l
Z.le_wd
Z.le_succ_l
Z.lt_asymm
Z.lt_trans
Z.le_trans
RelationClasses.PreOrder
Z.le_preorder
RelationClasses.PreOrder_Reflexive
Nat2Z.is_nonneg
Z.mul_1_r
intro_Z
Z.pred_inj
Z.pred_inj_wd
Z.opp_wd
Z.add_pred_l
Z.opp_succ
Z.opp_0
Z.opp_add_distr
fast_Zopp_plus_distr
Z.mul_add_distr_r
Z.mul_comm
Z.mul_add_distr_l
Z.add_shuffle0
Z.add_shuffle1
Z.sub_wd
Z.sub_0_r
Z.add_pred_r
Z.add_opp_r
Z.sub_succ_l
Z.sub_diag
Z.add_opp_diag_l
Z.add_opp_diag_r
Pos2Z.opp_neg
OMEGA13
fast_OMEGA13
Z.succ_lt_mono
Z.succ_le_mono
Z.add_le_mono_l
Z.add_le_mono_r
Z.opp_pred
Z.opp_involutive
Z.opp_sub_distr
Z.sub_sub_distr
Z.sub_simpl_r
Z.le_0_sub
Z.compare_antisym
Z.ge
Z.ge_le_iff
Zge_left
Nat.lt_nge
gt_not_le
not_le_minus_0
inj_minus2
Z.add_shuffle3
fast_Zplus_permute
subS_same
Init.Nat.modulo
modS_same
ge
ex_ind
Nat.lt_decidable
dec_lt
Nat.nlt_ge
not_lt
Z.add_le_mono
Z.add_nonneg_nonneg
OMEGA2
Z.gt
inj_eq
proj1
Nat.compare_ge_iff
nat_compare_ge
Nat2Z.inj_compare
Nat2Z.inj_ge
inj_ge
nat_compare_gt
Nat2Z.inj_gt
inj_gt
Nat2Z.inj_le
inj_le
Pos2Z.inj_succ
Nat2Z.inj_succ
Z.opp_eq_mul_m1
fast_Zopp_eq_mult_neg_1
sumbool_ind
GcdS_tcc
max_type
max_type_rect
max_type_ind
max
and_rec
Nat.le_lt_trans
sig
sig_rect
sig_rec
GcdS_terminate
GcdS
nat_R is defined
nat_R_rect is defined
nat_R_ind is defined
nat_R_rec is defined
le_R is defined
le_R_ind is defined
Coq__o__Init__o__Peano__o__lt_R is defined
'Coq__o__Init__o__Peano__o__lt_R' is now a registered translation.
prod_R is defined
prod_R_rect is defined
prod_R_ind is defined
prod_R_rec is defined
Coq__o__Init__o__Datatypes__o__snd_R is defined
'Coq__o__Init__o__Datatypes__o__snd_R' is now a registered translation.
Top__o__subS_R is defined
'Top__o__subS_R' is now a registered translation.
Coq__o__Init__o__Nat__o__divmod_R is defined
'Coq__o__Init__o__Nat__o__divmod_R' is now a registered translation.
Top__o__modS_R is defined
'Top__o__modS_R' is now a registered translation.
Top__o__GcdS_F_R is defined
'Top__o__GcdS_F_R' is now a registered translation.
Coq__o__funind__o__Recdef__o__iter_R is defined
'Coq__o__funind__o__Recdef__o__iter_R' is now a registered translation.
and_R is defined
and_R_rect is defined
and_R_ind is defined
and_R_rec is defined
Coq__o__Init__o__Logic__o__iff_R is defined
'Coq__o__Init__o__Logic__o__iff_R' is now a registered translation.
Coq__o__Program__o__Basics__o__impl_R is defined
'Coq__o__Program__o__Basics__o__impl_R' is now a registered translation.
unit_R is defined
unit_R_rect is defined
unit_R_ind is defined
unit_R_rec is defined
Coq__o__Classes__o__Init__o__Unconvertible_R is defined
'Coq__o__Classes__o__Init__o__Unconvertible_R' is now a registered translation.
Coq__o__Relations__o__Relation_Definitions__o__relation_R is defined
'Coq__o__Relations__o__Relation_Definitions__o__relation_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__Proper_R is defined
'Coq__o__Classes__o__Morphisms__o__Proper_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__subrelation_R is defined
'Coq__o__Classes__o__RelationClasses__o__subrelation_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__subrelation_proper_R is defined
'Coq__o__Classes__o__Morphisms__o__subrelation_proper_R' is now a registered translation.
eq_R is defined
eq_R_rect is defined
eq_R_ind is defined
eq_R_rec is defined
Coq__o__Init__o__Logic__o__eq_rect_R is defined
'Coq__o__Init__o__Logic__o__eq_rect_R' is now a registered translation.
Coq__o__Init__o__Logic__o__eq_ind_R is defined
'Coq__o__Init__o__Logic__o__eq_ind_R' is now a registered translation.
Coq__o__Init__o__Logic__o__eq_sym_R is defined
'Coq__o__Init__o__Logic__o__eq_sym_R' is now a registered translation.
Coq__o__Init__o__Logic__o__eq_ind_r_R is defined
'Coq__o__Init__o__Logic__o__eq_ind_r_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_obligation_1_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_obligation_1_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__subrelation_refl_R is defined
'Coq__o__Classes__o__Morphisms__o__subrelation_refl_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__respectful_R is defined
'Coq__o__Classes__o__Morphisms__o__respectful_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__Transitive_R is defined
'Coq__o__Classes__o__RelationClasses__o__Transitive_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__transitivity_R is defined
'Coq__o__Classes__o__RelationClasses__o__transitivity_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_obligation_1_R is defined
'Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_obligation_1_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_R is defined
'Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__Symmetric_R is defined
'Coq__o__Classes__o__RelationClasses__o__Symmetric_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__Reflexive_R is defined
'Coq__o__Classes__o__RelationClasses__o__Reflexive_R' is now a registered translation.
Equivalence_R is defined
Coq__o__Classes__o__RelationClasses__o__Equivalence_Transitive_R is defined
'Coq__o__Classes__o__RelationClasses__o__Equivalence_Transitive_R' is now a registered translation.
PER_R is defined
Coq__o__Classes__o__RelationClasses__o__PER_Symmetric_R is defined
'Coq__o__Classes__o__RelationClasses__o__PER_Symmetric_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__symmetry_R is defined
'Coq__o__Classes__o__RelationClasses__o__symmetry_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__PER_Transitive_R is defined
'Coq__o__Classes__o__RelationClasses__o__PER_Transitive_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__PER_morphism_obligation_1_R is defined
'Coq__o__Classes__o__Morphisms__o__PER_morphism_obligation_1_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__PER_morphism_R is defined
'Coq__o__Classes__o__Morphisms__o__PER_morphism_R' is now a registered translation.
Coq__o__Init__o__Nat__o__pred_R is defined
'Coq__o__Init__o__Nat__o__pred_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__Equivalence_Symmetric_R is defined
'Coq__o__Classes__o__RelationClasses__o__Equivalence_Symmetric_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__Equivalence_PER_R is defined
'Coq__o__Classes__o__RelationClasses__o__Equivalence_PER_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_succ_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_succ_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__reflexive_proper_proxy_R is defined
'Coq__o__Classes__o__Morphisms__o__reflexive_proper_proxy_R' is now a registered translation.
Coq__o__Init__o__Logic__o__and_rect_R is defined
'Coq__o__Init__o__Logic__o__and_rect_R' is now a registered translation.
Coq__o__Init__o__Logic__o__and_ind_R is defined
'Coq__o__Init__o__Logic__o__and_ind_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__iff_impl_subrelation_R is defined
'Coq__o__Classes__o__Morphisms__o__iff_impl_subrelation_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_obligation_1_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_obligation_1_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__Equivalence_Reflexive_R is defined
'Coq__o__Classes__o__RelationClasses__o__Equivalence_Reflexive_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__subrelation_respectful_R is defined
'Coq__o__Classes__o__Morphisms__o__subrelation_respectful_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__eq_Reflexive_R is defined
'Coq__o__Classes__o__RelationClasses__o__eq_Reflexive_R' is now a registered translation.
Coq__o__Init__o__Logic__o__eq_trans_R is defined
'Coq__o__Init__o__Logic__o__eq_trans_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__eq_Transitive_R is defined
'Coq__o__Classes__o__RelationClasses__o__eq_Transitive_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__eq_Symmetric_R is defined
'Coq__o__Classes__o__RelationClasses__o__eq_Symmetric_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__eq_equivalence_R is defined
'Coq__o__Classes__o__RelationClasses__o__eq_equivalence_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__eq_equiv_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__eq_equiv_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_wd_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_wd_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__ProperProxy_R is defined
'Coq__o__Classes__o__Morphisms__o__ProperProxy_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__Reflexive_partial_app_morphism_R is defined
'Coq__o__Classes__o__Morphisms__o__Reflexive_partial_app_morphism_R' is now a registered translation.
False_R is defined
False_R_rect is defined
False_R_ind is defined
False_R_rec is defined
Coq__o__Init__o__Logic__o__False_rect_R is defined
'Coq__o__Init__o__Logic__o__False_rect_R' is now a registered translation.
Coq__o__Init__o__Logic__o__False_ind_R is defined
'Coq__o__Init__o__Logic__o__False_ind_R' is now a registered translation.
Coq__o__Init__o__Logic__o__not_R is defined
'Coq__o__Init__o__Logic__o__not_R' is now a registered translation.
Coq__o__Init__o__Logic__o__iff_sym_R is defined
'Coq__o__Init__o__Logic__o__iff_sym_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__iff_Symmetric_R is defined
'Coq__o__Classes__o__RelationClasses__o__iff_Symmetric_R' is now a registered translation.
Coq__o__Init__o__Logic__o__iff_trans_R is defined
'Coq__o__Init__o__Logic__o__iff_trans_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__iff_Transitive_R is defined
'Coq__o__Classes__o__RelationClasses__o__iff_Transitive_R' is now a registered translation.
Coq__o__Init__o__Logic__o__iff_refl_R is defined
'Coq__o__Init__o__Logic__o__iff_refl_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__iff_Reflexive_R is defined
'Coq__o__Classes__o__RelationClasses__o__iff_Reflexive_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__iff_equivalence_R is defined
'Coq__o__Classes__o__RelationClasses__o__iff_equivalence_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_obligation_1_R is defined
'Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_obligation_1_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_R is defined
'Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_obligation_1_R is defined
'Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_obligation_1_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_R is defined
'Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_R' is now a registered translation.
Coq__o__Program__o__Basics__o__flip_R is defined
'Coq__o__Program__o__Basics__o__flip_R' is now a registered translation.
Coq__o__Classes__o__RelationClasses__o__reflexivity_R is defined
'Coq__o__Classes__o__RelationClasses__o__reflexivity_R' is now a registered translation.
comparison_R is defined
comparison_R_rect is defined
comparison_R_ind is defined
comparison_R_rec is defined
Coq__o__Init__o__Nat__o__compare_R is defined
'Coq__o__Init__o__Nat__o__compare_R' is now a registered translation.
or_R is defined
or_R_ind is defined
Coq__o__Init__o__Logic__o__or_ind_R is defined
'Coq__o__Init__o__Logic__o__or_ind_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_obligation_1_R is defined
'Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_obligation_1_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_R is defined
'Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__eq_proper_proxy_R is defined
'Coq__o__Classes__o__Morphisms__o__eq_proper_proxy_R' is now a registered translation.
Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_obligation_1_R is defined
'Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_obligation_1_R' is now a registered translation.
Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_R is defined
'Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_R' is now a registered translation.
Coq__o__Init__o__Datatypes__o__nat_rect_R is defined
'Coq__o__Init__o__Datatypes__o__nat_rect_R' is now a registered translation.
Coq__o__Init__o__Datatypes__o__nat_ind_R is defined
'Coq__o__Init__o__Datatypes__o__nat_ind_R' is now a registered translation.
Coq__o__Init__o__Logic__o__f_equal_R is defined
'Coq__o__Init__o__Logic__o__f_equal_R' is now a registered translation.
Coq__o__Init__o__Peano__o__f_equal_nat_R is defined
'Coq__o__Init__o__Peano__o__f_equal_nat_R' is now a registered translation.
Coq__o__Init__o__Peano__o__eq_add_S_R is defined
'Coq__o__Init__o__Peano__o__eq_add_S_R' is now a registered translation.
True_R is defined
True_R_rect is defined
True_R_ind is defined
True_R_rec is defined
Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_eq_iff_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_eq_iff_R' is now a registered translation.
Coq__o__Init__o__Peano__o__le_0_n_R is defined
'Coq__o__Init__o__Peano__o__le_0_n_R' is now a registered translation.
Coq__o__Init__o__Peano__o__le_ind_R is defined
'Coq__o__Init__o__Peano__o__le_ind_R' is now a registered translation.
Coq__o__Init__o__Peano__o__le_pred_R is defined
'Coq__o__Init__o__Peano__o__le_pred_R' is now a registered translation.
Coq__o__Init__o__Peano__o__le_S_n_R is defined
'Coq__o__Init__o__Peano__o__le_S_n_R' is now a registered translation.
Coq__o__Init__o__Peano__o__le_n_S_R is defined
'Coq__o__Init__o__Peano__o__le_n_S_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_le_iff_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_le_iff_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_lt_iff_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_lt_iff_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_eq_cases_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_eq_cases_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__le_refl_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_refl_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__iff_flip_impl_subrelation_R is defined
'Coq__o__Classes__o__Morphisms__o__iff_flip_impl_subrelation_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_r_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_r_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_diag_r_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_diag_r_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_obligation_1_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_obligation_1_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_refl_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_refl_R' is now a registered translation.
Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_obligation_1_R is defined
'Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_obligation_1_R' is now a registered translation.
Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_R is defined
'Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_irrefl_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_irrefl_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__neq_succ_diag_l_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__neq_succ_diag_l_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_le_incl_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_le_incl_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__nlt_succ_diag_l_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__nlt_succ_diag_l_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__nle_succ_diag_l_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__nle_succ_diag_l_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__bi_induction_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__bi_induction_R' is now a registered translation.
Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_obligation_1_R is defined
'Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_obligation_1_R' is now a registered translation.
Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_R is defined
'Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__central_induction_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__central_induction_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__le_wd_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_wd_R' is now a registered translation.
Coq__o__Init__o__Logic__o__or_iff_compat_r_R is defined
'Coq__o__Init__o__Logic__o__or_iff_compat_r_R' is now a registered translation.
Coq__o__Init__o__Logic__o__or_cancel_r_R is defined
'Coq__o__Init__o__Logic__o__or_cancel_r_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__le_succ_l_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_succ_l_R' is now a registered translation.
Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_lt_mono_R is defined
'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_lt_mono_R' is now a registered translation.
Coq__o__Arith__o__Lt__o__lt_S_n_R is defined
'Coq__o__Arith__o__Lt__o__lt_S_n_R' is now a registered translation.
Acc_R is defined
Acc_R_rect is defined
Acc_R_ind is defined
Acc_R_rec is defined
Coq__o__Init__o__Wf__o__Acc_inv_R is defined
'Coq__o__Init__o__Wf__o__Acc_inv_R' is now a registered translation.
positive_R is defined
positive_R_rect is defined
positive_R_ind is defined
positive_R_rec is defined
Coq__o__PArith__o__BinPosDef__o__Pos__o__succ_R is defined
'Coq__o__PArith__o__BinPosDef__o__Pos__o__succ_R' is now a registered translation.
Coq__o__PArith__o__BinPosDef__o__Pos__o__of_succ_nat_R is defined
'Coq__o__PArith__o__BinPosDef__o__Pos__o__of_succ_nat_R' is now a registered translation.
Z_R is defined
Z_R_rect is defined
Z_R_ind is defined
Z_R_rec is defined
Coq__o__ZArith__o__BinIntDef__o__Z__o__of_nat_R is defined
'Coq__o__ZArith__o__BinIntDef__o__Z__o__of_nat_R' is now a registered translation.
Coq__o__Logic__o__Decidable__o__decidable_R is defined
'Coq__o__Logic__o__Decidable__o__decidable_R' is now a registered translation.
Coq__o__Logic__o__Decidable__o__dec_not_not_R is defined
'Coq__o__Logic__o__Decidable__o__dec_not_not_R' is now a registered translation.
Coq__o__PArith__o__BinPosDef__o__Pos__o__pred_double_R is defined
'Coq__o__PArith__o__BinPosDef__o__Pos__o__pred_double_R' is now a registered translation.
Coq__o__ZArith__o__BinIntDef__o__Z__o__pred_double_R is defined
'Coq__o__ZArith__o__BinIntDef__o__Z__o__pred_double_R' is now a registered translation.
Coq__o__ZArith__o__BinIntDef__o__Z__o__double_R is defined
'Coq__o__ZArith__o__BinIntDef__o__Z__o__double_R' is now a registered translation.
Coq__o__ZArith__o__BinIntDef__o__Z__o__succ_double_R is defined
'Coq__o__ZArith__o__BinIntDef__o__Z__o__succ_double_R' is now a registered translation.
Coq__o__ZArith__o__BinIntDef__o__Z__o__pos_sub_R is defined
'Coq__o__ZArith__o__BinIntDef__o__Z__o__pos_sub_R' is now a registered translation.
Coq__o__PArith__o__BinPosDef__o__Pos__o__add_R is defined
'Coq__o__PArith__o__BinPosDef__o__Pos__o__add_R' is now a registered translation.
Coq__o__ZArith__o__BinIntDef__o__Z__o__add_R is defined
'Coq__o__ZArith__o__BinIntDef__o__Z__o__add_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__reflexive_proper_R is defined
'Coq__o__Classes__o__Morphisms__o__reflexive_proper_R' is now a registered translation.
Coq__o__ZArith__o__BinInt__o__Z__o__eq_R is defined
'Coq__o__ZArith__o__BinInt__o__Z__o__eq_R' is now a registered translation.
Coq__o__Classes__o__Morphisms__o__reflexive_eq_dom_reflexive_R is defined
'Coq__o__Classes__o__Morphisms__o__reflexive_eq_dom_reflexive_R' is now a registered translation.
Coq__o__ZArith__o__BinInt__o__Z__o__add_wd_R is defined
'Coq__o__ZArith__o__BinInt__o__Z__o__add_wd_R' is now a registered translation.
Coq__o__ZArith__o__BinInt__o__Z__o__eq_equiv_R is defined
'Coq__o__ZArith__o__BinInt__o__Z__o__eq_equiv_R' is now a registered translation.
Coq__o__ZArith__o__BinIntDef__o__Z__o__succ_R is defined
'Coq__o__ZArith__o__BinIntDef__o__Z__o__succ_R' is now a registered translation.
Coq__o__ZArith__o__BinInt__o__Z__o__succ_wd_R is defined
'Coq__o__ZArith__o__BinInt__o__Z__o__succ_wd_R' is now a registered translation.
Coq__o__ZArith__o__BinIntDef__o__Z__o__pred_R is defined
'Coq__o__ZArith__o__BinIntDef__o__Z__o__pred_R' is now a registered translation.
Coq__o__ZArith__o__BinIntDef__o__Z__o__opp_R is defined
'Coq__o__ZArith__o__BinIntDef__o__Z__o__opp_R' is now a registered translation.
Coq__o__PArith__o__BinPosDef__o__Pos__o__compare_cont_R is defined
'Coq__o__PArith__o__BinPosDef__o__Pos__o__compare_cont_R' is now a registered translation.
Coq__o__PArith__o__BinPosDef__o__Pos__o__compare_R is defined
'Coq__o__PArith__o__BinPosDef__o__Pos__o__compare_R' is now a registered translation.
mask_R is defined
mask_R_rect is defined
mask_R_ind is defined
mask_R_rec is defined
Coq__o__PArith__o__BinPosDef__o__Pos__o__double_pred_mask_R is defined
'Coq__o__PArith__o__BinPosDef__o__Pos__o__double_pred_mask_R' is now a registered translation.
Coq__o__PArith__o__BinPosDef__o__Pos__o__double_mask_R is defined
'Coq__o__PArith__o__BinPosDef__o__Pos__o__double_mask_R' is now a registered translation.
Coq__o__PArith__o__BinPosDef__o__Pos__o__succ_double_mask_R is defined
'Coq__o__PArith__o__BinPosDef__o__Pos__o__succ_double_mask_R' is now a registered translation.

Anomaly: Uncaught exception Not_found. Please report at
http://coq.inria.fr/bugs/.
*)


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*             Ralph Matthes [+]                              *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(*                             [+] Affiliation IRIT -- CNRS   *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import List Arith Omega.

Require Import wf_utils.

Set Implicit Arguments.

Section lazy_list.

  (* Implementation of lazy lists as the subset of co-lists
     characterized by a finiteness predicate *)

  Variable X : Type.

  CoInductive llist : Type :=
    | lnil : llist
    | lcons : X -> llist -> llist.

  Implicit Types (a: X) (s: llist) (l: list X).

  Unset Elimination Schemes.

  Inductive lfin : llist-> Prop :=
    | lfin_nil :  lfin lnil
    | lfin_cons : forall a ll, lfin ll -> lfin (lcons a ll).

  Arguments lfin_cons : clear implicits.

  Set Elimination Schemes.

  Section small_inversions.

    Let shape_inv s := match s with lnil => False | _         => True   end.
    Let pred_inv s  := match s with lnil => lnil  | lcons x s => s      end.

    Definition lfin_inv x s (H : lfin (lcons x s)) : lfin s :=
      match H in lfin s return shape_inv s -> lfin (pred_inv s) with
        | lfin_nil         => fun E => match E with end
        | lfin_cons _ _ H1 => fun _ => H1
      end I.

    Let output_invert s : lfin s -> Prop :=
      match s as s' return lfin s' -> _ with
        | lnil      => fun H => lfin_nil = H
        | lcons x s => fun H => exists H', lfin_cons x s H' = H
      end.

    Definition lfin_invert s H : @output_invert s H :=
      match H in lfin s return @output_invert s H with
        | lfin_nil         => eq_refl
        | lfin_cons _ _ H' => ex_intro _ H' eq_refl
      end.

  End small_inversions.

  (** We show proof irrelevance for lfin by induction/inversion
      where inversion is obtained by dependent pattern matching

      Interesting case because lfin is not a decidable predicate
      but nevertheless has provable PIRR
    *)

  Fixpoint lfin_pirr s (H1 : lfin s) : forall H2, H1 = H2.
  Proof.
    destruct H1 as [ | x s H1 ]; intros H2.
    + apply (lfin_invert H2).
    + destruct (lfin_invert H2) as (H & E).
      subst; f_equal; apply lfin_pirr.
  Defined.

  Section lfin_rect.

    (** We show dependent recursion principle for lfin implementing
        what a command like

        Scheme lfin_rect := Induction for lfin Sort Type.

        But Scheme is not smart enough to invent PIRR ...
        Remark that we use singleton elimination here ... *)

    Variable P : forall s, lfin s -> Type.

    Hypothesis HP1 : @P _ lfin_nil.
    Hypothesis HP2 : forall x s H, @P s H -> P (@lfin_cons x s H).

    Ltac pirr := match goal with |- @P _ ?a -> @P _ ?b => rewrite (@lfin_pirr _ a b); trivial end.

    Fixpoint lfin_rect s H { struct H } : @P s H.
    Proof.
      revert H.
      refine (match s with
        | lnil      => fun H => _
        | lcons x s => fun H => _
      end).
      + generalize HP1; pirr.
      + generalize (@HP2 x s (lfin_inv H) (@lfin_rect s (lfin_inv H))); pirr.
    Defined.

  End lfin_rect.

  (* Now we define lazy lists *)

  Definition lazy_list := { s | lfin s }.

  Implicit Type ll : lazy_list.

  (* Constructors *)

  Definition lazy_nil : lazy_list := exist _ _ lfin_nil.
  Definition lazy_cons a : lazy_list -> lazy_list.
  Proof.
    intros (ll & H).
    exists (lcons a ll).
    apply lfin_cons, H.
  Defined.

  (* Injectivity of constructors *)

  Fact lazy_cons_inj a b ll1 ll2 : lazy_cons a ll1 = lazy_cons b ll2 -> a = b /\ ll1 = ll2.
  Proof.
    revert ll1 ll2; intros (s1 & H1) (s2 & H2); simpl.
    intros E; apply f_equal with (f := @proj1_sig _ _) in E; simpl in E.
    inversion E; subst; split; auto; f_equal.
    apply lfin_pirr.
  Qed.

  Fact lazy_nil_cons_discr a ll : lazy_nil <> lazy_cons a ll.
  Proof. destruct ll; discriminate. Qed.

  (** And a dependent recursion principle similar to list_rect *)

  Section lazy_list_rect.

    Variable P : lazy_list -> Type.

    Hypothesis (HP0 : P lazy_nil).
    Hypothesis (HP1 : forall a m, P m -> P (lazy_cons a m)).

    Theorem lazy_list_rect : forall ll, P ll.
    Proof.
      intros (? & H).
      induction H as [ | x s H IH ].
      + apply HP0.
      + apply HP1 with (1 := IH).
    Defined.

  End lazy_list_rect.

  (* We have everything to define an isomorphism between list and lazy_list *)

  Section list_lazy_iso.

    Fixpoint list2lazy l :=
      match l with
        | nil  => lazy_nil
        | x::l => lazy_cons x (list2lazy l)
      end.

    Fact list2lazy_inj l m : list2lazy l = list2lazy m -> l = m.
    Proof.
      revert m; induction l as [ | a l IH ]; intros [ | b m ]; simpl; auto.
      + intros H; exfalso; revert H; apply lazy_nil_cons_discr.
      + intros H; exfalso; symmetry in H; revert H; apply lazy_nil_cons_discr.
      + intros H; apply lazy_cons_inj in H; destruct H; f_equal; auto.
    Qed.

    Section lazy2list.

      Let lazy2list_rec ll : { l | ll = list2lazy l }.
      Proof.
        induction ll as [ | a ll (l & Hl) ] using lazy_list_rect.
        + exists nil; auto.
        + exists (a::l); simpl; f_equal; auto.
      Qed.

      Definition lazy2list ll := proj1_sig (lazy2list_rec ll).

      Fact list2lazy2list ll : ll = list2lazy (lazy2list ll).
      Proof. apply (proj2_sig (lazy2list_rec ll)). Qed.

    End lazy2list.

    Fact lazy2list2lazy l : l = lazy2list (list2lazy l).
    Proof. apply list2lazy_inj; rewrite <- list2lazy2list; trivial. Qed.

    (* Fixpoint equations *)

    Fact lazy2list_nil : lazy2list lazy_nil = nil.
    Proof. apply list2lazy_inj; rewrite <- list2lazy2list; auto. Qed.

    Fact lazy2list_cons a ll : lazy2list (lazy_cons a ll) = a :: lazy2list ll.
    Proof.
      apply list2lazy_inj.
      simpl; repeat rewrite <- list2lazy2list; trivial.
    Qed.

  End list_lazy_iso.

  Definition lazy_length ll := length (lazy2list ll).

  Fact lazy_length_nil : lazy_length lazy_nil = 0.
  Proof. unfold lazy_length; rewrite lazy2list_nil; auto. Qed.

  Fact lazy_length_cons x ll : lazy_length (lazy_cons x ll) = S (lazy_length ll).
  Proof. unfold lazy_length; rewrite lazy2list_cons; auto. Qed.

End lazy_list.

Arguments lazy_nil {X}.

Section Rotate.

  (** From "Simple and Efficient Purely Functional Queues and Deques" by Chris Okasaki
      See application in file fifo_3llists.v *)

  Variable (X : Type).

  Implicit Type (l r m a : lazy_list X).

  Let prec l r := lazy_length r = 1 + lazy_length l.
  Let spec l r a m := lazy2list m = lazy2list l ++ rev (lazy2list r) ++ lazy2list a.

  Definition lazy_rotate l r : forall a, prec l r -> sig (spec l r a).
  Proof.
    induction on l r as loop with measure (lazy_length l); intros a.
    induction r as [ | y r' _ ] using lazy_list_rect; intros H.
    + exfalso; red in H; revert H; rewrite lazy_length_nil; intros; omega.
    + revert H.
      induction l as [ | x l' _ ] using lazy_list_rect; intros H.
      * exists (lazy_cons y a); red in H |- *.
        assert (r' = lazy_nil); [ | subst ].
        { revert H.
          induction r' as [ | ? r' ] using lazy_list_rect; auto.
          do 2 rewrite lazy_length_cons.
          rewrite lazy_length_nil; simpl; intros; omega. }
        do 2 rewrite lazy2list_cons, lazy2list_nil; auto.
      * refine (let (m,Hm) := loop l' r' _ (lazy_cons y a) _ in exist _ (lazy_cons x m) _).
        - rewrite lazy_length_cons; omega.
        - red in H |- *; do 2 rewrite lazy_length_cons in H; omega.
        - red in H, Hm |- *.
          repeat rewrite lazy2list_cons.
          rewrite Hm, lazy2list_cons; simpl.
          rewrite app_ass; auto.
  Defined.

End Rotate.

Arguments lazy_rotate {X}.

Extraction Inline lfin_rect lazy_nil lazy_cons lazy_list_rect.


Require Export Omega.
Set Implicit Arguments.

Local Close Scope nat.
Local Open Scope Z.

Lemma Z_mul_neg1_r a:
      a * -1 = - a.
Proof.
 omega.
Qed.

Lemma Z_add_neg_r a b:
      a + -b = a - b.
Proof.
 omega.
Qed.

Ltac Z_simp_all
 := simpl in *;
    repeat rewrite Z.add_0_r in *;
    repeat rewrite Z.mul_1_r in *;
    repeat rewrite Z_mul_neg1_r in *;
    repeat rewrite Z_add_neg_r in *.


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

(*i $Id: Qfield.v 14641 2011-11-06 11:59:10Z herbelin $ i*)

Require Export Field.
Require Export QArith_base.
Require Import NArithRing.

(** * field and ring tactics for rational numbers *)

Definition Qsrt : ring_theory 0 1 Qplus Qmult Qminus Qopp Qeq.
Proof.
  constructor.
  exact Qplus_0_l.
  exact Qplus_comm.
  exact Qplus_assoc.
  exact Qmult_1_l.
  exact Qmult_comm.
  exact Qmult_assoc.
  exact Qmult_plus_distr_l.
  reflexivity.
  exact Qplus_opp_r.
Qed.

Definition Qsft : field_theory 0 1 Qplus Qmult Qminus Qopp Qdiv Qinv Qeq.
Proof.
  constructor.
  exact Qsrt.
  discriminate.
  reflexivity.
  intros p Hp.
  rewrite Qmult_comm.
  apply Qmult_inv_r.
  exact Hp.
Qed.

Lemma Qpower_theory : power_theory 1 Qmult Qeq Z_of_N Qpower.
Proof.
constructor.
intros r [|n];
reflexivity.
Qed.

Ltac isQcst t :=
  match t with
  | inject_Z ?z => isZcst z
  | Qmake ?n ?d =>
    match isZcst n with
      true => isPcst d
    | _ => false
    end
  | _ => false
  end.

Ltac Qcst t :=
  match isQcst t with
    true => t
    | _ => NotConstant
  end.

Ltac Qpow_tac t :=
  match t with
  | Z0 => N0
  | Zpos ?n => Ncst (Npos n)
  | Z_of_N ?n => Ncst n
  | NtoZ ?n => Ncst n
  | _ => NotConstant
  end.

Add Field Qfield : Qsft
 (decidable Qeq_bool_eq,
  completeness Qeq_eq_bool,
  constants [Qcst],
  power_tac Qpower_theory [Qpow_tac]).

(** Exemple of use: *)

Section Examples.

Let ex1 : forall x y z : Q, (x+y)*z ==  (x*z)+(y*z).
  intros.
  ring.
Qed.

Let ex2 : forall x y : Q, x+y == y+x.
  intros.
  ring.
Qed.

Let ex3 : forall x y z : Q, (x+y)+z == x+(y+z).
  intros.
  ring.
Qed.

Let ex4 : (inject_Z 1)+(inject_Z 1)==(inject_Z 2).
  ring.
Qed.

Let ex5 : 1+1 == 2#1.
  ring.
Qed.

Let ex6 : (1#1)+(1#1) == 2#1.
  ring.
Qed.

Let ex7 : forall x : Q, x-x== 0.
  intro.
  ring.
Qed.

Let ex8 : forall x : Q, x^1 == x.
  intro.
  ring.
Qed.

Let ex9 : forall x : Q, x^0 == 1.
  intro.
  ring.
Qed.

Let ex10 : forall x y : Q, ~(y==0) -> (x/y)*y == x.
intros.
field.
auto.
Qed.

End Examples.

Lemma Qopp_plus : forall a b,  -(a+b) == -a + -b.
Proof.
  intros; ring.
Qed.

Lemma Qopp_opp : forall q, - -q==q.
Proof.
  intros; ring.
Qed.


(** * Permutation over lists, and finite multisets. *)

Set Implicit Arguments.

From Coq Require Import List Relations Multiset Arith Setoid.
From CoLoR Require Import decidable_set more_list equiv_list.
From CoLoR Require list_permut.

 Definition permut (n : nat) (f : nat -> nat) :=
  (forall i, n <= i -> f i = i) /\
  (forall i, i < n -> f i < n) /\
  (forall i j, i < n -> j < n -> f i = f j -> i = j).

Lemma adequacy :
  forall (A : Type) (R : relation A) (l1 l2 : list A),
  list_permut.permut0 R l1 l2 <->
  (length l1 = length l2 /\
   exists pi, (permut (length l1) pi) /\
   forall i, i < length l1 ->
   match (nth_error l1 i), (nth_error l2 (pi i)) with
   | (Some ai), (Some bi) => R ai bi
   | _, _ => False
   end).
Proof.
intros A R l1; pattern l1; apply list_rec2; clear l1.
intro n; induction n as [ | n]; intros l1 L1 l2; split.
intros P; inversion P; subst.
split; trivial.
exists (fun (i : nat) => i); repeat split; trivial.
intros i L; simpl in L; inversion L.
simpl in L1; inversion L1.
intros [L _]; destruct l1 as [ | a1 l1].
destruct l2 as [ | a2 l2].
apply list_permut.Pnil.
simpl in L; discriminate.
simpl in L1; inversion L1.
intros P; inversion P as [ | a1 b1 l1' l2' l2'' a1_R_b1 Q ]; subst; split; trivial.
exists (fun (i : nat) => i); repeat split; trivial.
intros i L; simpl in L; inversion L.
rewrite (list_permut.permut_length P); trivial.
simpl in L1; generalize (le_S_n _ _ L1); clear L1; intro L1.
rewrite (IHn l1' L1 (l2' ++ l2'')) in Q.
destruct Q as [ L [pi [ Q H]]].
exists (fun (i : nat) =>
             match i with
             | 0 => length l2'
             | S i =>
                 if le_lt_dec (length l2') (pi i)
                 then S (pi i)
                 else pi i
             end); split.
unfold permut in *; repeat split.
intros [ | i] L'; simpl in L'.
inversion L'.
generalize (le_S_n _ _ L'); clear L'; intro L'.
destruct Q as [Q _].
rewrite (Q i L').
destruct (le_lt_dec (length l2') i) as [ll2'_le_i | ll2'_gt_i]; trivial.
rewrite L in L'.
absurd (length l2' < length l2'); auto with arith.
apply le_lt_trans with i; trivial.
apply le_trans with (length (l2' ++ l2'')); trivial.
rewrite length_app; auto with arith.
intros [ | i] L'.
simpl; rewrite L; unfold lt; apply le_n_S; rewrite length_app; auto with arith.
simpl in L'; generalize (le_S_n _ _ L'); clear L'; intro L'.
destruct Q as [_ [Q _]].
destruct (le_lt_dec (length l2') (pi i)) as [ll2'_le_pii | ll2'_gt_pii].
simpl; unfold lt; apply le_n_S; apply Q; trivial.
simpl; apply lt_le_trans with (length l1').
apply Q; trivial.
auto with arith.
destruct Q as [_ [_ Q]].
intros [ | i] [ | j] L' L'' H'; trivial.
destruct  (le_lt_dec (length l2') (pi j)) as [ll2'_cmp_pij | ll2'_cmp_pij];
rewrite H' in ll2'_cmp_pij;
absurd (S (pi j) <= pi j); trivial; auto with arith.
destruct  (le_lt_dec (length l2') (pi i)) as [ll2'_cmp_pii | ll2'_cmp_pii];
rewrite <- H' in ll2'_cmp_pii;
absurd (S (pi i) <= pi i); trivial; auto with arith.
destruct  (le_lt_dec (length l2') (pi i)) as [ll2'_le_pii | ll2'_gt_pii];
destruct  (le_lt_dec (length l2') (pi j)) as [ll2'_le_pij | ll2'_gt_pij].
apply (f_equal (fun n => S n)); apply Q.
simpl in L'; apply lt_S_n; trivial.
simpl in L''; apply lt_S_n; trivial.
injection H'; trivial.
absurd (length l2' < length l2'); auto with arith.
apply le_lt_trans with (pi j); trivial.
rewrite <- H'; auto with arith.
absurd (length l2' < length l2'); auto with arith.
apply le_lt_trans with (pi i); trivial.
rewrite H'; auto with arith.
apply (f_equal (fun n => S n)); apply Q; trivial.
simpl in L'; apply lt_S_n; trivial.
simpl in L''; apply lt_S_n; trivial.
intros [ | i] L'.
simpl; rewrite nth_error_at_pos; trivial.
simpl in L'; generalize (le_S_n _ _ L'); clear L'; intro L'.
simpl; rewrite (nth_error_remove b1 l2' l2'' (pi i)); apply H; trivial.

intros [L [pi [P H]]].
destruct l1 as [ | a1 l1].
destruct l2 as [ | a2 l2].
apply list_permut.Pnil.
simpl in L; discriminate.
assert (L' : 0 < length (a1 :: l1)).
simpl; auto with arith.
generalize (H 0 L'); simpl.
assert (H' := nth_error_ok_in (pi 0) l2).
destruct (nth_error l2 (pi 0)) as [ b1 | ].
intro a1_R_b1; destruct (H' _ (eq_refl _)) as [l2' [l2'' [L'' H'']]]; clear H'.
subst l2; apply list_permut.Pcons; trivial.
rewrite IHn; [split | simpl in L1; apply le_S_n; trivial].
rewrite length_app in L; rewrite plus_comm in L; simpl in L; injection L;
intro L'''; rewrite L'''; rewrite plus_comm; rewrite length_app; trivial.
exists (fun i =>
               if le_lt_dec (length l1) i
               then i
               else
                 if le_lt_dec (pi (S i)) (pi 0)
                 then pi (S i)
                 else (pi (S i)) -1); split.
unfold permut in *; repeat split.

intros i L''';
destruct (le_lt_dec (length l1) i) as [ll1_le_i | ll1_gt_i]; trivial.
absurd (i < i); auto with arith.
apply lt_le_trans with (length l1); trivial.

intros i L''';
destruct (le_lt_dec (length l1) i) as [ll1_le_i | _]; trivial.
assert (L'''' : S i < length (a1 :: l1)).
simpl; auto with arith.
destruct (le_lt_dec (pi (S i)) (pi 0)) as [piSi_le_pi0 | piSi_gt_pi0].
assert (piSi_lt_pi0 : pi (S i) < pi 0).
destruct (le_lt_or_eq _ _ piSi_le_pi0) as [L5 | E]; trivial.
destruct P as [_ [_ P]].
absurd (S i = 0).
discriminate.
apply (P (S i) 0); trivial.
apply lt_le_trans with (pi 0); trivial.
destruct P as [_ [P _]].
generalize (P 0 (lt_O_Sn _)); simpl; auto with arith.
destruct P as [_ [P _]].
generalize (P (S i) L''''); destruct (pi (S i)) as [ | p]; simpl.
intros _; apply le_lt_trans with i; auto with arith.
rewrite <- minus_n_O; auto with arith.

intros i j Li Lj;
destruct (le_lt_dec (length l1) i) as [ll1_le_i | _];
destruct (le_lt_dec (length l1) j) as [ll1_le_j | _];
trivial.
absurd (i < i); auto with arith.
apply lt_le_trans with (length l1); trivial.
absurd (j < j); auto with arith.
apply lt_le_trans with (length l1); trivial.
destruct P as [_ [_ P]];
destruct (le_lt_dec (pi (S i)) (pi 0)) as [piSi_le_pi0 | piSi_gt_pi0];
destruct (le_lt_dec (pi (S j)) (pi 0)) as [piSj_le_pi0 | piSj_gt_pi0].
intro piSi_eq_piSj; assert (Si_eq_Sj : S i = S j).
apply (P (S i) (S j)); simpl; auto with arith.
injection Si_eq_Sj; trivial.
destruct (le_lt_or_eq _ _ piSi_le_pi0) as [L5 | E]; clear piSi_le_pi0.
destruct (pi (S j)) as [ | pj].
absurd (pi 0 < 0); auto with arith.
simpl; rewrite <- minus_n_O.
intro H'; rewrite H' in L5.
absurd (S pj < S pj); auto with arith.
apply le_lt_trans with (pi 0); auto with arith.
absurd (S i = 0).
discriminate.
apply (P (S i) 0); trivial.
simpl; auto with arith.
destruct (le_lt_or_eq _ _ piSj_le_pi0) as [L5 | E]; clear piSj_le_pi0.
destruct (pi (S i)) as [ | qi].
absurd (pi 0 < 0); auto with arith.
simpl; rewrite <- minus_n_O.
intro H'; rewrite <- H' in L5.
absurd (S qi < S qi); auto with arith.
apply le_lt_trans with (pi 0); auto with arith.
absurd (S j = 0).
discriminate.
apply (P (S j) 0); trivial.
simpl; auto with arith.
intro piSi_eq_piSj; assert (Si_eq_Sj : S i = S j).
apply (P (S i) (S j)); simpl; auto with arith.
destruct (pi (S i)) as [ | qi].
absurd (pi 0 < 0); auto with arith.
destruct (pi (S j)) as [ | pj].
absurd (pi 0 < 0); auto with arith.
simpl in piSi_eq_piSj; do 2 rewrite <- minus_n_O in piSi_eq_piSj; subst; trivial.
injection Si_eq_Sj; trivial.

intros i Li;
destruct (le_lt_dec (length l1) i) as [ll1_lt_i | _].
absurd (i < i); auto with arith.
apply lt_le_trans with (length l1); trivial.
generalize (H (S i) (lt_n_S _ _ Li)); simpl.
destruct (nth_error l1 i) as [ai | ]; trivial.
generalize (nth_error_ok_in (pi (S i)) (l2' ++ b1 :: l2''));
destruct (nth_error (l2' ++ b1 :: l2'') (pi (S i))) as [bi | ];
[idtac | contradiction].
intros H' ai_R_bi; destruct (H' _ (eq_refl _)) as [k2 [k2' [Lk2 H'']]]; clear H'.
destruct (in_in_split_set b1 bi l2' l2'' k2 k2' H'') as [[H''' | H'''] | H''']; clear H''.
destruct H''' as [l [H3 H4]]; subst.
rewrite <- ass_app; rewrite <- Lk2; rewrite <- L''; simpl.
destruct (le_lt_dec (length k2) (length (k2 ++ bi :: l))) as [Ok | Ko].
rewrite nth_error_at_pos; trivial.
absurd (length k2 < length k2); auto with arith.
apply le_lt_trans with (length (k2 ++ bi :: l)); trivial.
rewrite length_app; auto with arith.
destruct H''' as [l [H3 H4]]; subst.
rewrite <- Lk2; rewrite <- L''; simpl.
destruct (le_lt_dec (length (l2' ++ b1 :: l)) (length l2')) as [Ko | Ok].
absurd (length l2' < length l2'); auto with arith.
apply lt_le_trans with (length (l2' ++ b1 :: l)); trivial.
rewrite length_app; rewrite plus_comm; simpl; auto with arith.
rewrite (length_app l2' (b1 :: l)).
rewrite plus_comm; simpl; rewrite <- minus_n_O; rewrite plus_comm;
rewrite <- length_app.
rewrite ass_app; rewrite nth_error_at_pos; trivial.
destruct H''' as [_ [H3 H4]]; subst;
absurd (0 = S i).
discriminate.
destruct P as [_ [_ P]].
apply P; simpl; auto with arith.
rewrite <- Lk2; rewrite L''; subst; trivial.
intro; contradiction.
Qed.

Section defs.

  (** * From lists to multisets *)

  Variable A : Type.
  Variable eqA : relation A.
  Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.

  Let emptyBag := EmptyBag A.
  Let singletonBag := SingletonBag _ eqA_dec.

  (** contents of a list *)

  Fixpoint list_contents (l:list A) : multiset A :=
    match l with
      | nil => emptyBag
      | a :: l => munion (singletonBag a) (list_contents l)
    end.

  (** * [permutation]: definition and basic properties *)

  Definition permutation (l m:list A) :=
    meq (list_contents l) (list_contents m).
End defs.

Lemma permut_closure : forall (A : Type) eqA
 (eqA_dec : forall a1 a2, {eqA a1 a2}+{~eqA a1 a2}),
forall a1 a2, @permutation A eqA eqA_dec (a1 :: nil) (a2 :: nil) <->
(forall a, eqA a1 a <-> eqA a2 a).
Proof.
intros A eqA eqA_dec; unfold permutation, meq; simpl.
intros a1 a2; split.
intros H a; assert (Ha := H a); clear H; do 2 rewrite <- plus_n_O in Ha.
destruct (eqA_dec a1 a) as [a1_eq_a | a1_diff_a];
destruct (eqA_dec a2 a) as [a2_eq_a | a2_diff_a].
intuition.
discriminate.
discriminate.
intuition.
intros H a;
destruct (eqA_dec a1 a) as [a1_eq_a | a1_diff_a];
destruct (eqA_dec a2 a) as [a2_eq_a | a2_diff_a]; trivial.
absurd (eqA a2 a); trivial; rewrite <- (H a); trivial.
absurd (eqA a1 a); trivial; rewrite  (H a); trivial.
Qed.


Require Import mathcomp.ssreflect.ssreflect.
From mathcomp Require Import all_ssreflect.
(**
#
#
** Recap

 Proof language
   - [: name], to prepare the goal for a tactic
   - [=>] [name] [/view] [//] [/=] [{name}] [[]], to post-process the goal
   - [rewrite lem -lem // /= /def]
   - [apply: lem]
 Library
   - naming convention: [addnC], [eqP], [orbN], [orNb], ...
   - notations: [.+1], [if-is-then-else]
   - [Search _ (_ + _) in ssrnat]
   - [Search _ addn "C" in ssrnat]
   - Use the HTML doc!
 Approach
   - boolean predicates
   - [reflect P b] to link bool with Prop

#
#
--------------------------------------------------------
#
#
** Today
   - The [seq] library
   - forward reasoning with [have]
   - spec lemmas
   - [rewrite] patterns

#
#
--------------------------------------------------------
--------------------------------------------------------
#
#
** Sequences
  - an alias for lists (used to be differnt)
  - many notations

*)
Check [::].
Check [:: 3 ; 4].
Check [::] ++ [:: true ; false].
Eval compute in [seq x.+1 | x <- [:: 1; 2; 3]].
Eval compute in [seq x <- [::3; 4; 5] | odd x ].
Eval compute in rcons [:: 4; 5] 3.
Eval compute in all odd [:: 3; 5].

Module polylist.

(**
#
#
--------------------------------------------------------
#
#
** Polymorphic lists
   - This statement makes no assumptions on T
   - recap: [// /= ->]
*)
Lemma size_cat T (s1 s2 : seq T) : size (s1 ++ s2) = size s1 + size s2.
Proof.  by elim: s1 => //= x s1 ->. Qed.

End polylist.

Eval compute in 3 \in [:: 7; 4; 3].

Fail Check forall T : Type, forall x : T, x \in [:: x ].

(**
#
#
--------------------------------------------------------
#
#
** Had-hoc polymorphism
  - T : Type |- l : list T
  - T : eqType |- l : list T
  - eqType means: a type with a decidable equality (_ == _)
*)

Check forall T : eqType, forall x : T, x \in [:: x ].

(**
#
#
--------------------------------------------------------
#
#
** The \in notation
   - overloaded as [(_ == _)]
   - pushing \in with inE
   - computable.
   - rewrite !inE
*)
Lemma test_in l : 3 \in [:: 4; 5] ++ l -> l != [::].
Proof.
by rewrite !inE => /=; apply: contraL => /eqP->.
Qed.

(**
#
#
--------------------------------------------------------
#
#
** Forward reasoning
   - have
   - have :=
   - have + views
   - do I need eqType here?
*)
(**
Definition of all
<<
Fixpoint all a s := if s is x :: s' then a x && all a s' else true.
>> *)
(**
Definition of count
<<
Fixpoint count a s := if s is x :: s' then a x + count s' else 0.
>> *)
(**
A lemma linking the two concepts *)
Lemma all_count (T : eqType) (a : pred T) s :
  all a s = (count a s == size s).
Proof.
elim: s => //= x s.
have EM_a : a x || ~~ a x.
  by exact: orbN.
move: EM_a => /orP EM_a. case: EM_a => [-> | /negbTE-> ] //= _.
(*# have /orP[ ax | n_ax ] : a x || ~~ a x by case: (a x). #*)
Search _ count size in seq.
by rewrite add0n eqn_leq andbC ltnNge count_size.
(*# have := boolP (a x). #*)
Qed.

(**
#
#
--------------------------------------------------------
--------------------------------------------------------
#
#
** Spec lemmas
   - Inductive predicates to drive the proof
*)

Module myreflect1.

Inductive reflect (P : Prop) (b : bool) : Prop :=
  | ReflectT (p : P) (e : b = true)
  | ReflectF (np : ~ P) (e : b = false).

Fixpoint eqn m n :=
  match m, n with
  | 0, 0 => true
  | j.+1,k.+1 => eqn j k
  | _, _ => false
  end.
Arguments eqn !m !n.

Axiom eqP : forall m n, reflect (m = n) (eqn m n).

Lemma test_reflect1 m n : ~~ (eqn m n) || (n <= m <= n).
Proof.
case: (eqn m n) => /=.
(*# case: (eqP m n) => [Enm -> | nE_mn ->] /=. #*)
Admitted.

End myreflect1.

(*#
Module myreflect2.

Inductive reflect (P : Prop) : bool-> Prop :=
  | ReflectT (p : P) : reflect P true
  | ReflectF (np : ~ P) : reflect P false.

Fixpoint eqn m n :=
  match m, n with
  | 0, 0 => true
  | j.+1,k.+1 => eqn j k
  | _, _ => false
  end.
Arguments eqn !m !n.

Axiom eqP : forall m n, reflect (m = n) (eqn m n).
Arguments eqP {m n}.

Lemma test_reflect1 m n : ~~ (eqn m n) || (n <= m <= n).
Proof.
case: (@eqP m n) => [Enm | nE_mn ] /=.
by case: eqP => [->|] //=; rewrite leqnn.
Qed.

End myreflect2.

Check (_ =P _).
Check eqP.

#*)

Inductive leq_xor_gtn m n : bool -> bool -> Prop :=
  | LeqNotGtn of m <= n : leq_xor_gtn m n true false
  | GtnNotLeq of n < m  : leq_xor_gtn m n false true.

Axiom leqP : forall m n : nat, leq_xor_gtn m n (m <= n) (n < m).

(**
#
#
--------------------------------------------------------
#
#
** Let's try out leqP on an ugly goal
   - matching of indexes
   - generalization of unresolved implicits
   - instantiation by matching
*)
Lemma test_leqP m n1 n2 :
  (m <= (if n1 < n2 then n1 else n2)) =
  (m <= n1) && (m <= n2) && ((n1 < n2) || (n2 <= n1)).
Proof.
case: leqP => [leqn21 | /ltnW ltn12 ]; rewrite /= andbT.
  by rewrite andb_idl // => /leq_trans /(_ leqn21).
by rewrite andb_idr // => /leq_trans->.
Qed.

(**
#
#
--------------------------------------------------------
#
#
** Another commodity: [ifP]
   - a spec lemma for if-then-else
   - handy with case, since matching spares you to write
     the expressions involved
*)
Lemma test_ifP n m : if n <= m then 0 <= m - n else m - n == 0.
Proof.
case: ifP => //.
by move=> /negbT; rewrite subn_eq0 leqNgt negbK=> /ltnW.
Qed.

(**
#
#

--------------------------------------------------------
#
#
** Rewrite on steroids
   - keyed matching
   - instantiation
   - localization
*)
Lemma ugly_goal n m :
  n + (m * 2).+1 = n + (m + m.+1).
Proof.
rewrite addnC.
rewrite (addnC m).
rewrite [_ + m]addnC.
rewrite [in n + _]addnC.
rewrite [X in _ = X + n]addnC.
rewrite [in RHS]addnC.
Abort.

Lemma ugly_goal n m :
  n + m = n + m.
Proof.
rewrite addnC.
rewrite [in RHS]addnC.
Abort.

Lemma no_pattern n : n + 0 = n.
Proof.
rewrite -[n in RHS]addn0.
Abort.

(**
#
#
--------------------------------------------------------
#
#
** References for this lesson:
  - SSReflect #manual#
  - documentation of the
       #library#
    - in particular #seq#

#
#
--------------------------------------------------------
#
#
** Demo:
   - you should be now able to read this proof

*)

Lemma dvdn_fact m n : 0 < m <= n -> m %| n`!.
Proof.
case: m => //= m; elim: n => //= n IHn; rewrite ltnS leq_eqVlt.
by move=> /orP[ /eqP-> | /IHn]; [apply: dvdn_mulr | apply: dvdn_mull].
Qed.

Lemma prime_above m : {p | m < p & prime p}.
Proof.
Check pdivP.
have /pdivP[p pr_p p_dv_m1]: 1 < m`! + 1 by rewrite addn1 ltnS fact_gt0.
exists p => //; rewrite ltnNge; apply: contraL p_dv_m1 => p_le_m.
Check dvdn_addr.
by rewrite dvdn_addr ?dvdn_fact ?prime_gt0 // gtnNdvd ?prime_gt1.
Qed.

(** #
# *)


Require Import Setoid.
Require Import Morphisms.
Require Import Coq.Program.Basics.
Require Import ClassicalFacts.

Unset Printing Records.

From Ordinal Require Import Defs.
From Ordinal Require Import Operators.
From Ordinal Require Import Arith.
From Ordinal Require Import Enumerate.

Section fixpoints.
  Variable f : Ord -> Ord.

  Definition iter_f (base:Ord) : nat -> Ord :=
    fix iter_f (n:nat) : Ord :=
      match n with
      | 0 => base
      | S n' => f (iter_f n')
      end.

  Lemma iter_f_monotone :
     (forall x y, x <= y -> f x <= f y) ->
     forall i x y, x <= y -> iter_f x i <= iter_f y i.
  Proof.
    intro H. induction i; simpl; auto.
  Qed.

  Definition fixOrd (base:Ord) : Ord := supOrd (iter_f base).

  Lemma fixOrd_above : forall base, base ≤ fixOrd base.
  Proof.
    intros.
    unfold fixOrd.
    apply (sup_le _ (iter_f base) 0%nat).
  Qed.

  Lemma iter_f_complete n :
    forall base, complete base ->
    (forall x, complete x -> complete (f x)) ->
    complete (iter_f base n).
  Proof.
    induction n as [n IH1] using (well_founded_induction Wf_nat.lt_wf).
    destruct n; simpl; auto.
  Qed.

  Lemma iter_f_index_monotone i j :
    (forall x, complete x -> x <= f x) ->
    (forall x, complete x -> complete (f x)) ->
    (i <= j)%nat ->
    forall base, complete base -> iter_f base i <= iter_f base j.
  Proof.
    intros Hf1 Hf2 H; induction H; intros base Hbase; simpl.
    - reflexivity.
    - rewrite IHle; auto.
      apply Hf1. apply iter_f_complete; auto.
  Qed.

  Lemma directed_iter_f base :
    (forall x, complete x -> x <= f x) ->
    (forall x y, x <= y -> f x <= f y) ->
    (forall x, complete x -> complete (f x)) ->
    complete base ->
    directed nat (iter_f base).
  Proof.
    intros. intros i j. exists (Nat.max i j).
    split; apply iter_f_index_monotone; auto.
    + apply PeanoNat.Nat.le_max_l.
    + apply PeanoNat.Nat.le_max_r.
  Qed.

  Hypothesis Hmonotone : forall x y, x <= y -> f x <= f y.

  Lemma fixOrd_monotone :
     forall x y, x <= y -> fixOrd x <= fixOrd y.
  Proof.
    unfold fixOrd; intros.
    apply sup_least. intro n.
    eapply ord_le_trans with (iter_f y n); [ | apply sup_le ].
    apply iter_f_monotone; auto.
  Qed.

  Hypothesis Hcont : strongly_continuous f.

  Lemma fixOrd_prefixpoint : forall base, f (fixOrd base) ≤ fixOrd base.
  Proof.
    intros.
    apply ord_le_trans with (supOrd (fun i => f (iter_f base i))).
    - apply (Hcont nat (iter_f base) 0%nat).
    - apply sup_least. intro i.
      unfold fixOrd.
      apply (sup_le _ (iter_f base) (S i)).
  Qed.

  Hypothesis Hinflationary : forall x, x ≤ f x.

  Lemma fixOrd_fixpoint : forall base, fixOrd base ≈ f (fixOrd base).
  Proof.
    intros; split.
    - apply Hinflationary.
    - apply fixOrd_prefixpoint; auto.
  Qed.

  Lemma fixOrd_least : forall base z, base ≤ z -> f z ≤ z -> fixOrd base ≤ z.
  Proof.
    intros.
    unfold fixOrd.
    apply sup_least.
    intro i; induction i; simpl; auto.
    apply ord_le_trans with (f z); auto.
  Qed.

  Lemma normal_fix_continuous : strongly_continuous fixOrd.
  Proof.
    intros A g a0. unfold fixOrd.
    apply sup_least; intro i.
    induction i; simpl.
    - apply sup_ord_le_morphism. intro a.
      rewrite <- (sup_le _ _ 0%nat).
      simpl. auto with ord.
    - etransitivity; [ apply Hmonotone; apply IHi |].
      rewrite (Hcont A (fun i => supOrd (iter_f (g i))) a0).
      apply sup_ord_le_morphism. intro a.
      apply fixOrd_prefixpoint.
  Qed.

  Lemma normal_fix_complete base :
    complete base ->
    (forall x, complete x -> x <= f x) ->
    (forall x y, x <= y -> f x <= f y) ->
    (forall x, complete x -> complete (f x)) ->
    complete (fixOrd base).
  Proof.
    intros Hbase Hf1 Hf2 Hf3.
    unfold fixOrd.
    apply sup_complete; auto.
    - intros; apply iter_f_complete; auto.
    - apply directed_iter_f; auto.
    - assert (Hc' : complete (f base)).
      { apply Hf3; auto. }
      destruct (complete_zeroDec base Hbase).
      + destruct (complete_zeroDec (f base) Hc').
        * right. intro i.
          revert H H0. clear -Hf1 Hf2 Hbase. revert base Hbase.
          induction i; simpl; intros; auto.
          transitivity (f base); auto.
          apply Hf2; auto.
          rewrite IHi; auto.
          apply zero_least.
        * left.
          exists 1%nat. simpl.
          auto.
      + left.
        exists 0%nat. simpl. auto.
  Qed.

End fixpoints.

Lemma iter_f_monotone_func f g n :
  (forall x, f x ≤ g x) ->
  (forall x y, x ≤ y -> g x ≤ g y) ->
  forall x, iter_f f x n ≤ iter_f g x n.
Proof.
  intros Hf Hg.
  induction n; intros; simpl.
  - reflexivity.
  - etransitivity; [ apply Hf | apply Hg; auto ].
Qed.

Lemma fixOrd_monotone_func f g :
  (forall x, f x ≤ g x) ->
  (forall x y, x ≤ y -> g x ≤ g y) ->
  forall x, fixOrd f x ≤ fixOrd g x.
Proof.
  intros.
  unfold fixOrd. apply sup_ord_le_morphism.
  intro n. apply iter_f_monotone_func; auto.
Qed.

Definition enum_fixpoints (f:Ord -> Ord) : Ord -> Ord :=
  fix rec (x:Ord) : Ord :=
  match x with
  | ord B g => fixOrd f (ord B (fun b => rec (g b)))
  end.

Lemma enum_fixpoints_monotone f :
  (forall x y, x ≤ y -> f x ≤ f y) ->
  (forall x y, x ≤ y -> enum_fixpoints f x ≤ enum_fixpoints f y).
Proof.
  intros Hf x y; revert x.
  induction y as [C h Hy].
  destruct x as [B g].
  simpl; intros.
  unfold fixOrd.
  apply sup_ord_le_morphism; intro i; simpl.
  apply iter_f_monotone; auto.
  rewrite ord_le_unfold; simpl; intro b.
  rewrite ord_lt_unfold; simpl.
  destruct (ord_le_subord _ _ H b) as [c Hb].
  exists c.
  apply Hy; auto.
Qed.

Lemma enum_fixpoints_increasing f :
  (forall x y, x ≤ y -> f x ≤ f y) ->
  (forall x y, x < y -> enum_fixpoints f x < enum_fixpoints f y).
Proof.
  intros Hf x y H.
  rewrite ord_lt_unfold in H.
  destruct x as [B g].
  destruct y as [C h].
  simpl in *.
  destruct H as [i ?].
  eapply ord_lt_le_trans; [| apply fixOrd_above ].
  rewrite ord_lt_unfold. exists i. simpl.
  apply (enum_fixpoints_monotone f Hf (ord B g) (h i)); auto.
Qed.

Lemma enum_fixpoints_func_mono f g :
  (forall x y, x ≤ y -> f x ≤ f y) ->
  (forall x y, x ≤ y -> g x ≤ g y) ->
  (forall x, f x ≤ g x) ->
  (forall x, enum_fixpoints f x ≤ enum_fixpoints g x).
Proof.
  intros Hf Hg Hfg.
  induction x as [A q Hx]; simpl.
  unfold fixOrd.
  apply sup_ord_le_morphism. intro i.
  transitivity (iter_f f (ord A (fun b : A => enum_fixpoints g (q b))) i).
  - apply iter_f_monotone; auto.
    rewrite ord_le_unfold; simpl; intro a.
    rewrite ord_lt_unfold; simpl; exists a.
    auto.
  - apply iter_f_monotone_func; auto.
Qed.

Lemma enum_are_fixpoints f :
  strongly_continuous f ->
  (forall x, x ≤ f x) ->
  forall x, enum_fixpoints f x ≈ f (enum_fixpoints f x).
Proof.
  intros Hcont Hinflationary.
  destruct x as [X g]; simpl.
  apply fixOrd_fixpoint; auto.
Qed.

Lemma enum_fixpoints_zero f :
  (forall x y, x ≤ y -> f x ≤ f y) ->
  enum_fixpoints f zeroOrd ≈ fixOrd f zeroOrd.
Proof.
  simpl.
  split; apply fixOrd_monotone; auto.
  - rewrite ord_le_unfold; simpl; intuition.
  - rewrite ord_le_unfold; simpl; intuition.
Qed.

Lemma enum_fixpoints_succ f x :
  enum_fixpoints f (succOrd x) ≈ fixOrd f (succOrd (enum_fixpoints f x)).
Proof.
  simpl; intros. reflexivity.
Qed.

Lemma enum_fixpoints_cont f :
  (forall x y, x ≤ y -> f x ≤ f y) ->
  (forall x, x ≤ f x) ->
  strongly_continuous f ->
  strongly_continuous (enum_fixpoints f).
Proof.
  intros Hmono Hinf Hcont A g a0.
  apply fixOrd_least; auto.
  - rewrite ord_le_unfold.
    simpl.
    intros [a i]. simpl.
    rewrite <- (sup_le _ _ a).
    apply enum_fixpoints_increasing; auto with ord.
  - rewrite (Hcont A (fun i => enum_fixpoints f (g i)) a0).
    apply sup_least; intro a.
    rewrite <- enum_are_fixpoints; auto.
    rewrite <- (sup_le _ _ a); auto with ord.
Qed.

Theorem enum_fixpoints_enumerates f:
  (forall x, x ≤ f x) ->
  (forall x y, x ≤ y -> f x ≤ f y) ->
  strongly_continuous f ->
  enumerates (enum_fixpoints f) (fun x => x ≈ f x).
Proof.
  intros Hinf Hmono Hcont.
  hnf; intros.
  constructor; auto.
  - apply enum_are_fixpoints; auto.
  - intros; apply enum_fixpoints_monotone; auto.
  - intros; apply enum_fixpoints_increasing; auto.
  - intros x z Hz1 Hz2.
    destruct x as [A g]. simpl.
    apply fixOrd_least; auto.
    + rewrite ord_le_unfold. simpl; intros.
      apply Hz2. apply (index_lt (ord A g) a).
    + apply Hz1.
Qed.

Lemma enum_fixpoints_enumerates_range f :
  (forall x, x ≤ f x) ->
  (forall x y, x ≤ y -> f x ≤ f y) ->
  strongly_continuous f ->
  enumerates (enum_fixpoints f) (fun x => exists y, x ≈ enum_fixpoints f y).
Proof.
  intros Hinf Hmono Hcont.
  hnf; intros.
  constructor; auto.
  - intro x. exists x. reflexivity.
  - intros; apply enum_fixpoints_monotone; auto.
  - intros; apply enum_fixpoints_increasing; auto.
  - intros x z [y Hy] H.
    destruct x as [A g]; simpl; intros.
    apply fixOrd_least; auto.
    + rewrite ord_le_unfold; simpl; intros.
      apply H. apply (index_lt (ord A g)).
    + transitivity (f (enum_fixpoints f y)).
      apply Hmono. apply Hy.
      rewrite Hy.
      apply enum_are_fixpoints; auto.
Qed.

Lemma enum_fixpoints_complete f :
  (forall x, complete x -> x ≤ f x) ->
  (forall x y, x ≤ y -> f x ≤ f y) ->
  (forall x, complete x -> complete (f x)) ->
  forall x, complete x -> complete (enum_fixpoints f x).
Proof.
  intros Hf1 Hf2 Hf3.
  induction x as [B g Hx]. intro Hc.
  simpl enum_fixpoints.
  apply normal_fix_complete; auto.
  apply lim_complete.
  + intros; apply Hx. apply Hc.
  + intros b1 b2. destruct (complete_directed _ Hc b1 b2) as [b' [Hb1 Hb2]].
    exists b'. split; apply enum_fixpoints_monotone; auto.
  + apply Hc.
Qed.

Definition ε (x:Ord) := enum_fixpoints powOmega x.

Lemma ε_monotone : forall x y, x ≤ y -> ε x ≤ ε y.
Proof.
  unfold ε.
  apply enum_fixpoints_monotone.
  apply powOmega_monotone.
Qed.

Lemma ε_increasing : forall x y, x < y -> ε x < ε y.
Proof.
  unfold ε.
  apply enum_fixpoints_increasing.
  apply powOmega_monotone.
Qed.

Lemma ε_continuous : strongly_continuous ε.
Proof.
  unfold ε.
  apply enum_fixpoints_cont; auto.
  apply powOmega_monotone.
  apply increasing_inflationary.
  apply powOmega_increasing.
  unfold powOmega.
  apply expOrd_continuous.
Qed.

Lemma ε_fixpoint : forall x, ε x ≈ expOrd ω (ε x).
Proof.
  intro x.
  apply enum_are_fixpoints.
  apply expOrd_continuous.
  apply increasing_inflationary.
  apply powOmega_increasing.
Qed.

Theorem ε_enumerates : enumerates ε (fun x => x ≈ expOrd ω x).
Proof.
  unfold ε.
  apply enum_fixpoints_enumerates.
  apply increasing_inflationary.
  apply powOmega_increasing.
  apply powOmega_monotone.
  apply expOrd_continuous.
Qed.

Theorem ε_complete x : complete x -> complete (ε x).
Proof.
  intros. unfold ε.
  apply enum_fixpoints_complete; auto.
  intros; apply increasing_inflationary. apply powOmega_increasing.
  apply powOmega_monotone.
  intros; apply expOrd_complete; auto.
  apply (index_lt ω 0%nat).
  apply omega_complete.
Qed.

Opaque foldOrd.

Theorem ε0_least_expOmega_closed :
  forall X, expOrd ω X ≤ X -> ε 0 ≤ X.
Proof.
  intros.
  unfold ε. simpl. unfold fixOrd.
  apply sup_least; intro i.
  induction i; simpl iter_f.
  { rewrite ord_le_unfold; intros []. }
  rewrite <- H.
  unfold powOmega.
  apply expOrd_monotone.
  apply IHi.
Qed.

Theorem KnuthUp_epsilon : KnuthUp 2 ω ω ≈ ε 0.
Proof.
  rewrite KnuthUp_succ.
  transitivity (foldOrd 1 (expOrd ω) ω); [ reflexivity |].
  rewrite foldOrd_unfold.
  split.
  - apply lub_least.
    + unfold ε; simpl.
      unfold fixOrd.
      rewrite <- (sup_le _ _ 1%nat).
      apply succ_least. apply expOrd_nonzero.
    + apply sup_least; intro n.
      induction n.
      * simpl.
        rewrite foldOrd_unfold.
        transitivity (expOrd ω 1).
        { apply expOrd_monotone. apply lub_least; auto with ord.
          apply sup_least; intros []. }
        unfold fixOrd. rewrite <- (sup_le _ _ 2%nat).
        unfold iter_f. unfold powOmega.
        apply expOrd_monotone.
        apply succ_least. apply expOrd_nonzero.
      * unfold ε. simpl.
        rewrite fixOrd_fixpoint.
        unfold powOmega.
        apply expOrd_monotone.
        rewrite foldOrd_succ.
        apply IHn.
        intros. apply succ_least; apply expOrd_nonzero.
        apply expOrd_continuous.
        apply increasing_inflationary.
        apply powOmega_increasing.
  - unfold ε. simpl enum_fixpoints. unfold fixOrd.
    apply sup_least; intro n.
    rewrite <- lub_le2.
    rewrite <- (sup_le _ _ n).
    simpl.
    induction n; simpl.
    + rewrite ord_le_unfold; intros [].
    + unfold powOmega at 1.
      apply expOrd_monotone.
      rewrite foldOrd_succ.
      apply IHn.
      intros. apply succ_least. apply expOrd_nonzero.
Qed.