(** This file is part of CoqEAL, the Coq Effective Algebra Library.
(c) Copyright INRIA and University of Gothenburg, see LICENSE *)
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat div seq zmodp.
From mathcomp Require Import path choice fintype tuple finset ssralg bigop poly polydiv.

From CoqEAL Require Import param refinements pos hrel poly_op.

(******************************************************************************)
(** This file implements sparse polynomials in sparse Horner normal form.     *)
(*                                                                            *)
(******************************************************************************)

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Local Open Scope ring_scope.

Import GRing.Theory Pdiv.Ring Pdiv.CommonRing Pdiv.RingMonic.
Import Refinements.Op Poly.Op.

(******************************************************************************)
(** PART I: Defining generic datastructures and programming with them         *)
(******************************************************************************)
Section hpoly.

Context {A N pos : Type}.

Inductive hpoly A := Pc : A -> hpoly A
                   | PX : A -> pos -> hpoly A -> hpoly A.

Section hpoly_op.

Context `{zero_of A, one_of A, add_of A, sub_of A, opp_of A, mul_of A, eq_of A}.
Context `{one_of pos, add_of pos, sub_of pos, eq_of pos, lt_of pos}.
Context `{zero_of N, one_of N, eq_of N, leq_of N, lt_of N, add_of N, sub_of N}.
Context `{cast_of N pos, cast_of pos N}.
Context `{spec_of N nat}.

Local Open Scope computable_scope.

Fixpoint normalize (p : hpoly A) : hpoly A := match p with
  | Pc c => Pc c
  | PX a n p => match normalize p with
    | Pc c => PX a n (Pc c)
    | PX b m q => if (b == 0)%C then PX a (m + n) q else PX a n (PX b m q)
    end
  end.

Fixpoint from_seq (p : seq A) : hpoly A := match p with
  | [::] => Pc 0
  | [:: c] => Pc c
  | x :: xs => PX x 1 (from_seq xs)
  end.

#[export] Instance cast_hpoly : cast_of A (hpoly A) := fun x => Pc x.

#[export] Instance zero_hpoly : zero_of (hpoly A) := Pc 0.
#[export] Instance one_hpoly  : one_of (hpoly A)  := Pc 1.

Fixpoint map_hpoly A B (f : A -> B) (p : hpoly A) : hpoly B := match p with
  | Pc c     => Pc (f c)
  | PX a n p => PX (f a) n (map_hpoly f p)
  end.

#[export] Instance opp_hpoly : opp_of (hpoly A) := map_hpoly -%C.
#[export] Instance scale_hpoly : scale_of A (hpoly A) :=
  fun a => map_hpoly [eta *%C a].

Fixpoint addXn_const (n : N) a (q : hpoly A) := match q with
  | Pc b      => if (n == 0)%C then Pc (a + b) else PX b (cast n) (Pc a)
  | PX b m q' => let cn := cast n in
    if (n == 0)%C then PX (a + b) m q' else
      if (n == cast m)%C then PX b m (addXn_const 0 a q') else
        if (n < cast m)%C then PX b cn (PX a (m - cn) q')
        else PX b m (addXn_const (n - cast m)%C a q')
  end.

Fixpoint addXn (n : N) p q {struct p} := match p, q with
  | Pc a      , q      => addXn_const n a q
  | PX a n' p', Pc b   => if (n == 0)%C then PX (a + b) n' p'
                                        else PX b (cast n) (PX a n' p')
  | PX a n' p', PX b m q' =>
    if (n == 0)%C then
      if (n' == m)%C then PX (a + b) n' (addXn 0 p' q') else
        if (n' < m)%C then PX (a + b) n' (addXn 0 p' (PX 0 (m - n') q'))
        else PX (a + b) m (addXn (cast (n' - m)) p' q')
    else addXn (n + cast n') p' (addXn_const 0 b (addXn_const n a (PX 0 m q')))
  end.

(* (* This definition is nicer but Coq doesn't like it *) *)
(* Fixpoint add_hpoly_op p q := match p, q with *)
(*   | Pc a, Pc b     => Pc (a + b) *)
(*   | PX a n p, Pc b => PX (a + b) n p *)
(*   | Pc a, PX b n p => PX (a + b) n p *)
(*   | PX a n p, PX b m q => *)
(*   if (m == n)%C then PX (a + b) n (add_hpoly_op p q) *)
(*                 else if n < m then PX (a + b) n (add_hpoly_op p (PX 0 (m - n) q)) *)
(*                               else PX (a + b) m (add_hpoly_op q (PX 0 (n - m) p)) *)
(*   end. *)

#[export] Instance add_hpoly : add_of (hpoly A) := addXn 0.
#[export] Instance sub_hpoly : sub_of (hpoly A) := fun p q => p + - q.

#[export] Instance shift_hpoly : shift_of (hpoly A) N :=
  fun n p => if (n == 0)%C then p else PX 0 (cast n) p.

#[export] Instance mul_hpoly : mul_of (hpoly A) := fix f p q := match p, q with
  | Pc a, q => a *: q
  | p, Pc b => map_hpoly (fun x => (x * b)%C) p
  | PX a n p, PX b m q =>
     shift_hpoly (cast (n + m)) (f p q) + shift_hpoly (cast m) (a *: q) +
    (shift_hpoly (cast n) (map_hpoly (fun x => (x * b)%C) p) + Pc (a * b))
  end.

#[export] Instance exp_hpoly : exp_of (hpoly A) N :=
  fun p n => iter (spec n) (mul_hpoly p) 1.

Fixpoint eq0_hpoly (p : hpoly A) : bool := match p with
  | Pc a      => (a == 0)%C
  | PX a n p' => (eq0_hpoly p') && (a == 0)%C
  end.

#[export] Instance eq_hpoly : eq_of (hpoly A) := fun p q => eq0_hpoly (p - q).

(* Alternative definition, should be used with normalize: *)
(* Fixpoint eq_hpoly_op p q {struct p} := match p, q with *)
(*   | Pc a, Pc b => (a == b)%C *)
(*   | PX a n p', PX b m q' => (a == b)%C && (cast n == cast m) && (eq_hpoly_op p' q') *)
(*   | _, _ => false *)
(*   end. *)

#[export] Instance size_hpoly : size_of (hpoly A) N :=
  fix f p :=
    if eq0_hpoly p then 0%C else match p with
                                 | Pc a => 1%C
                                 | PX a n p' => if eq0_hpoly p' then 1%C
                                                else (cast n + f p')%C
                                 end.

#[export] Instance lead_coef_hpoly : lead_coef_of A (hpoly A) :=
  fix f p :=
    match p with
    | Pc a => a
    | PX a n p' => let b := f p' in
                   if (b == 0)%C then a else b
    end.

#[export] Instance split_hpoly : split_of (hpoly A) N :=
  fix f m p:=
    if (m == 0)%C then (p, Pc 0)%C else
      match p with
      | Pc a => (Pc 0, Pc a)
      | PX a n p' => if (cast n <= m)%C
                     then let (p1, p2) := f (m - cast n)%C p' in
                          (p1, PX a n p2)
                     else (shift_hpoly (cast n - m)%C p', Pc a)
      end.

Definition head_hpoly (p : hpoly A) :=
  match p with
  | Pc a => a
  | PX a n p' => a
  end.

End hpoly_op.
End hpoly.

Parametricity hpoly.
Parametricity normalize.
Parametricity from_seq.
Parametricity cast_hpoly.
Parametricity zero_hpoly.
Parametricity one_hpoly.
Parametricity map_hpoly.
Parametricity opp_hpoly.
Parametricity scale_hpoly.
Parametricity addXn_const.
Parametricity addXn.
Parametricity add_hpoly.
Parametricity sub_hpoly.
Parametricity shift_hpoly.
Parametricity mul_hpoly.
Definition exp_hpoly' := Eval compute in @exp_hpoly.
Parametricity exp_hpoly'.
Realizer @exp_hpoly as exp_hpoly_R := exp_hpoly'_R.
Parametricity eq0_hpoly.
Parametricity eq_hpoly.
Parametricity size_hpoly.
Parametricity lead_coef_hpoly.
Parametricity split_hpoly.
Parametricity head_hpoly.

Section hpoly_more_op.

Variable R : ringType.
Context (pos N C: Type).
Context `{zero_of C, one_of C, eq_of C}.
Context `{spec_of C R, spec_of N nat}.
Context `{cast_of pos N}.

Fixpoint spec_hpoly_aux n (p : @hpoly pos C) : {poly R} :=
  match p with
  | Pc c => match n with
            | O => if (c == 0)%C then 0 else if (c == 1)%C then 1
                                             else (spec c)%:P
            | S O => if (c == 0)%C then 0 else if (c == 1)%C then 'X
                                               else (spec c) *: 'X
            | S m => if (c == 0)%C then 0 else if (c == 1)%C then 'X^(S m)
                                               else (spec c) *: 'X^(S m)
            end
  | PX a m p => let mon := match n with
                           | O => if (a == 0)%C then 0
                                  else if (a == 1)%C then 1 else (spec a)%:P
                           | S O => if (a == 0)%C then 0
                                    else if (a == 1)%C then 'X
                                         else (spec a) *: 'X
                           | S k => if (a == 0)%C then 0
                                    else if (a == 1)%C then 'X^(S k)
                                         else (spec a) *: 'X^(S k)
                           end
                in if (eq0_hpoly p) then mon
                   else
                     let k := if (n == 0)%N then (spec (cast m : N) : nat)
                              else (spec (cast m : N) + n)%N
                     in if (a == 0)%C then (spec_hpoly_aux k p) else
                          (spec_hpoly_aux k p) + mon
  end.

#[export] Instance spec_hpoly : spec_of (hpoly C) {poly R} := spec_hpoly_aux 0%N.

Lemma spec_aux_shift n p :
  spec_hpoly_aux n p = spec_hpoly_aux 0%N p * 'X^n.
Proof.
  have shift_polyC (c : C) m :
    match m with
    | O => if (c == 0)%C then 0 else if (c == 1)%C then 1
                                     else (spec c)%:P
    | S O => if (c == 0)%C then 0 else if (c == 1)%C then 'X : {poly R}
                                       else (spec c) *: 'X
    | S m => if (c == 0)%C then 0 else if (c == 1)%C then 'X^(S m)
                                       else (spec c) *: 'X^(S m)
    end = (if (c == 0)%C then 0 else if (c == 1)%C then 1 else (spec c)%:P) *
          'X^m.
    case: m=> [|m] /=; first by rewrite expr0 mulr1.
    by case: m=> [|m] /=; rewrite ?expr1 -mul_polyC;
      case: ifP=> _; rewrite ?mul0r //;
        case: ifP=> _; rewrite ?mul1r.
  elim: p n=> [c n|c m p ih n] //=.
  case: ifP=> _ //.
  have -> : (if (n == 0)%N then (spec (cast m : N) : nat)
             else (spec (cast m : N) + n)%N) = (spec (cast m : N) + n)%N.
    by case: n=> [|n] /=; rewrite ?addn0.
  rewrite shift_polyC ih [in RHS]ih.
  by case: ifP=> c0;
    rewrite ?mulrDl -mulrA -exprD // c0.
Qed.

Lemma spec_aux_eq0 p : eq0_hpoly p -> spec_hpoly_aux 0%N p = 0.
Proof.
  elim: p=> [c|c m p ih] /=; first by move->.
  move/andP=> heq0.
  by rewrite (proj1 heq0) (proj2 heq0).
Qed.

End hpoly_more_op.

Arguments spec_hpoly / _ _ _ _ _ _ _ _ _ _ _ : assert.

(******************************************************************************)
(** PART II: Proving correctness properties of the previously defined objects *)
(******************************************************************************)
Section hpoly_theory.

Variable A : ringType.

Instance zeroA : zero_of A   := 0%R.
Instance oneA  : one_of A    := 1%R.
Instance addA  : add_of A    := +%R.
Instance oppA  : opp_of A    := -%R.
Instance subA  : sub_of A    := fun x y => x - y.
Instance mulA  : mul_of A    := *%R.
Instance eqA   : eq_of A     := eqtype.eq_op.
Instance specA : spec_of A A := spec_id.

Instance zero_nat : zero_of nat     := 0%N.
Instance eq_nat   : eq_of nat       := eqtype.eq_op.
Instance lt_nat   : lt_of nat       := ltn.
Instance leq_nat  : leq_of nat      := ssrnat.leq.
Instance add_nat  : add_of nat      := addn.
Instance sub_nat  : sub_of nat      := subn.
Instance spec_nat : spec_of nat nat := spec_id.

Fixpoint to_poly (p : hpoly A) := match p with
  | Pc c => c%:P
  | PX a n p => to_poly p * 'X^(cast (n : pos)) + a%:P
  end.

Definition to_hpoly : {poly A} -> (@hpoly pos A) := fun p => from_seq (polyseq p).

(* This instance has to be declared here in order not to make form_seq confused *)
Instance one_nat  : one_of nat  := 1%N.

Lemma to_hpolyK : cancel to_hpoly to_poly.
Proof.
elim/poly_ind; rewrite /to_hpoly ?polyseq0 // => p c ih.
rewrite -{1}cons_poly_def polyseq_cons.
have [|pn0] /= := nilP.
  rewrite -polyseq0 => /poly_inj ->; rewrite mul0r add0r.
  apply/poly_inj; rewrite !polyseqC.
   by case c0: (c == 0); rewrite ?polyseq0 // polyseqC c0.
by case: (polyseq p) ih => /= [<-| a l -> //]; rewrite mul0r add0r.
Qed.

Lemma ncons_add : forall m n (a : A) p,
  ncons (m + n) a p = ncons m a (ncons n a p).
Proof. by elim=> //= m ih n a p; rewrite ih. Qed.

Lemma normalizeK : forall p, to_poly (normalize p) = to_poly p.
Proof.
elim => //= a n p <-; case: (normalize p) => //= b m q.
case: ifP => //= /eqP ->; case: n => [[]] //= n n0.
by rewrite addr0 /cast /cast_pos_nat insubdK /= ?exprD ?mulrA ?addnS.
Qed.

Definition Rhpoly : {poly A} -> hpoly A -> Type := fun_hrel to_poly.

(* This is OK here, but not everywhere *)
Instance refines_eq_refl A' (x : A') : refines Logic.eq x x | 999.
Proof. by rewrite refinesE. Qed.

Lemma RhpolyE p q : refines Rhpoly p q -> p = to_poly q.
Proof. by rewrite refinesE. Qed.

Instance Rhpolyspec_r x : refines Rhpoly (to_poly x) x | 10000.
Proof. by rewrite !refinesE; case: x. Qed.

Fact normalize_lock : unit. Proof. exact tt. Qed.
Definition normalize_id := locked_with normalize_lock (@id {poly A}).
Lemma normalize_idE p : normalize_id p = p.
Proof. by rewrite /normalize_id unlock. Qed.

Local Open Scope rel_scope.

Instance Rhpoly_normalize : refines (Rhpoly ==> Rhpoly) normalize_id normalize.
Proof.
  by rewrite refinesE => p hp rp;
    rewrite /Rhpoly /fun_hrel normalizeK normalize_idE.
Qed.

Instance Rhpoly_cast : refines (eq ==> Rhpoly) (fun x => x%:P) cast.
Proof.
  by rewrite refinesE=> _ x ->; rewrite /Rhpoly /fun_hrel /cast /cast_hpoly /=.
Qed.

(* zero and one *)
Instance Rhpoly_0 : refines Rhpoly 0%R 0%C.
Proof. by rewrite refinesE. Qed.

Instance Rhpoly_1 : refines Rhpoly 1%R 1%C.
Proof. by rewrite refinesE. Qed.

Instance Rhpoly_opp : refines (Rhpoly ==> Rhpoly) -%R -%C.
Proof.
apply refines_abstr => p hp h1.
rewrite [p]RhpolyE refinesE /Rhpoly /fun_hrel {p h1}.
by elim: hp => /= [a|a n p ->]; rewrite polyCN // opprD mulNr.
Qed.

Instance Rhpoly_scale : refines (Logic.eq ==> Rhpoly ==> Rhpoly) *:%R *:%C.
Proof.
rewrite refinesE => /= a b -> p hp h1.
rewrite [p]RhpolyE /Rhpoly /fun_hrel {a p h1}.
elim: hp => [a|a n p ih] /=; first by rewrite polyCM mul_polyC.
by rewrite ih polyCM -!mul_polyC mulrDr mulrA.
Qed.

Lemma addXn_constE n a q :
  to_poly (addXn_const n a q) = a%:P * 'X^n + to_poly q.
Proof.
elim: q n => [b [|n]|b m q' ih n] /=; simpC;
  first by rewrite polyCD expr0 mulr1.
  by rewrite /cast /cast_pos_nat insubdK.
case: eqP => [->|/eqP n0] /=; first by rewrite polyCD expr0 mulr1 addrCA.
case: eqP => [hn|hnc] /=; first by rewrite ih expr0 mulr1 -hn mulrDl -addrA.
rewrite [(_ < _)%C]/((_ < _)%N) subn_eq0.
case hnm: (n < cast m).
  rewrite /= /cast /cast_nat_pos /cast_pos_nat.
  rewrite insubdK -?topredE /= ?lt0n // mulrDl -mulrA -exprD addrCA -addrA.
  by rewrite ?insubdK -?topredE /= ?subn_gt0 ?lt0n ?subnK // ltnW.
by rewrite /= ih mulrDl -mulrA -exprD subnK ?addrA // leqNgt hnm.
Qed.

Arguments addXn_const _ _ _ _ _ _ _ _ _ _ _ n a q : simpl never.

Lemma addXnE n p q : to_poly (addXn n p q) = to_poly p * 'X^n + to_poly q.
Proof.
elim: p n q => [a n q|a n' p ih n [b|b m q]] /=; simpC;
  first by rewrite addXn_constE.
  case: eqP => [->|/eqP n0]; first by rewrite expr0 mulr1 /= polyCD addrA.
  by rewrite /= /cast /cast_pos_nat /cast_nat_pos insubdK // -topredE /= lt0n.
case: eqP => [->|/eqP no].
  rewrite expr0 mulr1 /leq_op /leq_pos /eq_op /eq_pos.
  case: ifP => [/eqP ->|hneq] /=.
    by rewrite ih expr0 mulr1 mulrDl polyCD -!addrA [_ + (a%:P + _)]addrCA.
  rewrite -[(_ < _)%C]/((_ < _)%N).
  case hnm: (val n' < val m);
    rewrite /= ih polyCD mulrDl -!addrA ?expr0.
    rewrite mulr1 /= addr0 -mulrA -exprD [_ + (a%:P + _)]addrCA /cast.
    by rewrite /cast_pos_nat insubdK ?subnK -?topredE /= ?subn_gt0 // ltnW.
  rewrite -mulrA -exprD [_ + (a%:P + _)]addrCA /cast /cast_pos_nat.
  rewrite insubdK ?subnK // -?topredE /=; first by rewrite leqNgt hnm.
  rewrite subn_gt0 ltnNge leq_eqVlt hnm Bool.orb_false_r {hnm}.
  move/negbT: hneq; apply: contra; move/eqP=> heq; apply/eqP; exact: val_inj.
rewrite !ih !addXn_constE expr0 mulr1 /= addr0 mulrDl -mulrA -exprD addnC.
by rewrite -!addrA [b%:P + (_ + _)]addrCA [b%:P + _]addrC.
Qed.

Instance Rhpoly_add :
  refines (Rhpoly ==> Rhpoly ==> Rhpoly) +%R (add_hpoly (N:=nat)).
Proof.
apply refines_abstr2 => p hp h1 q hq h2.
rewrite [p]RhpolyE [q]RhpolyE refinesE /Rhpoly /fun_hrel {p q h1 h2}.
by rewrite /add_op /add_hpoly addXnE expr0 mulr1.
Qed.

Lemma to_poly_scale_l a p : to_poly (a *: p)%C = a *: (to_poly p).
Proof.
  elim: p=> [b|b n p ih] /=;
    rewrite /mul_op /mulA -mul_polyC polyCM //.
  by rewrite ih -mul_polyC mulrDr mulrA /mul_op /mulA.
Qed.

Lemma mulXnC (R : ringType) (p : {poly R}) n : p * 'X^n = 'X^n * p.
Proof.
  apply/polyP=> i.
  by rewrite coefMXn coefXnM.
Qed.

Lemma to_poly_scale_r a p :
  to_poly (map_hpoly (fun x => (x * a)%C) p) = to_poly p * a%:P.
Proof.
  elim: p=> [b|b n p ih] /=;
    rewrite /mul_op /mulA polyCM //.
  by rewrite ih mulrDl -mulrA mulXnC -mulrA.
Qed.

Lemma cast_nat_posK n : n > 0 -> cast_pos_nat (cast_nat_pos n) = n.
Proof.
  by rewrite /cast_pos_nat /cast_nat_pos val_insubd=> ->.
Qed.

Instance Rhpoly_mul :
  refines (Rhpoly ==> Rhpoly ==> Rhpoly) *%R (mul_hpoly (N:=nat)).
Proof.
  apply refines_abstr2=> p hp h1 q hq h2.
  rewrite [p]RhpolyE [q]RhpolyE refinesE /Rhpoly /fun_hrel {p q h1 h2}.
  elim: hp hq => [a [b|b m l']|a n l ih [b|b m l']] /=;
        first by rewrite polyCM.
      by rewrite polyCM to_poly_scale_l -mul_polyC mulrDr mulrA.
    by rewrite polyCM to_poly_scale_r mulrDl -mulrA mulXnC mulrA.
  rewrite [in (cast _)]/add_op /add_pos.
  case: n=> n lt0n; case: m=> m lt0m /=.
  rewrite /cast cast_nat_posK /cast_pos_nat ?addn_gt0 ?lt0n //= /shift_hpoly.
  simpC; rewrite !gtn_eqF ?addn_gt0 ?lt0n //=.
  rewrite mulrDr !mulrDl -mulrA -mulXnC -mulrA -exprD !mulrA !addXnE /= expr0.
  rewrite !mulr1 !addr0 ih /cast !cast_nat_posK ?addn_gt0 ?lt0n //=.
  rewrite to_poly_scale_l to_poly_scale_r -mul_polyC -[_ * b%:P * _]mulrA.
  by rewrite [b%:P * _]mulXnC mulrA polyCM addnC.
Qed.

Instance Rhpoly_exp :
  refines (Rhpoly ==> Logic.eq ==> Rhpoly) (@GRing.exp _) exp_op.
Proof.
  apply refines_abstr2=> p sp hp m n; rewrite refinesE=> -> {m}.
  rewrite /exp_op /exp_hpoly.
  elim: n=> [|n ihn] /=;
    by rewrite ?(expr0, exprS); tc.
Qed.

Instance Rhpoly_sub :
  refines (Rhpoly ==> Rhpoly ==> Rhpoly) (fun x y => x - y)
          (sub_hpoly (N:=nat)).
Proof.
apply refines_abstr2 => p hp h1 q hq h2.
by rewrite refinesE /sub_hpoly /Rhpoly /fun_hrel [_ - _]RhpolyE.
Qed.

Instance Rhpoly_shift : refines (Logic.eq ==> Rhpoly ==> Rhpoly)
                                (shiftp (R:=A)) shift_op.
Proof.
  rewrite refinesE=> _ n -> p hp h1.
  rewrite [p]RhpolyE /Rhpoly /fun_hrel {p h1} /shiftp /shift_hpoly.
  case: n=> [|n] /=; first by rewrite expr0 mulr1.
  by rewrite addr0 /cast cast_nat_posK ?ltn0Sn.
Qed.

(* Add to ssr? *)
Lemma size_MXnaddC (R : ringType) (p : {poly R}) (c : R) n :
  size (p * 'X^n.+1 + c%:P) = if (p == 0) then size c%:P else (n.+1 + size p)%N.
Proof.
have [->|/eqP hp0] := eqP; first by rewrite mul0r add0r.
rewrite size_addl polyseqMXn ?size_ncons // size_polyC.
by case: (c == 0)=> //=; rewrite ltnS ltn_addl // size_poly_gt0.
Qed.

Instance Rhpoly_eq0 :
  refines (Rhpoly ==> bool_R) (fun p => 0 == p) eq0_hpoly.
Proof.
  rewrite refinesE => p hp rp; rewrite [p]RhpolyE {p rp} eq_sym.
  have -> : (to_poly hp == 0) = (eq0_hpoly hp).
    elim: hp => [a|a n p ih] /=; first by rewrite polyC_eq0.
    rewrite /cast /cast_pos_nat /=; case: n=> n ngt0.
    rewrite /val_of_pos -[n]prednK // -size_poly_eq0 size_MXnaddC -ih prednK //.
    case: ifP=> /=; first by rewrite size_poly_eq0 polyC_eq0.
    by rewrite addn_eq0 size_poly_eq0 andbC=> ->.
  exact: bool_Rxx.
Qed.

Instance Rhpoly_eq : refines (Rhpoly ==> Rhpoly ==> bool_R)
                             eqtype.eq_op (eq_hpoly (N:=nat)).
Proof.
  apply refines_abstr2=> p hp h1 q hq h2.
  rewrite /eq_hpoly refinesE -subr_eq0 eq_sym [_ == _]refines_eq.
  exact: bool_Rxx.
Qed.

Instance Rhpoly_size : refines (Rhpoly ==> Logic.eq) (sizep (R:=A)) size_op.
Proof.
  apply refines_abstr=> p hp h1.
  rewrite [p]RhpolyE refinesE {p h1} sizepE /size_op.
  elim: hp=> [a|a n p ih] /=; first by rewrite size_polyC; simpC; case: eqP.
  rewrite /cast /cast_pos_nat /=; case: n=> n ngt0.
  rewrite /val_of_pos -[n]prednK // size_MXnaddC ih prednK // eq_sym
          [_ == _]refines_eq.
  by case: ifP=> //=; simpC; rewrite size_polyC; case: ifP.
Qed.

Lemma lead_coef_MXnaddC (R : ringType) (p : {poly R}) (c : R) n :
  lead_coef (p * 'X^n.+1 + c%:P) = if (lead_coef p == 0) then c
                                   else lead_coef p.
Proof.
  have [|/eqP hp0] := eqP.
    move/eqP; rewrite lead_coef_eq0; move/eqP=> ->.
    by rewrite mul0r add0r lead_coefC.
  rewrite lead_coefDl; first by rewrite lead_coef_Mmonic ?monicXn.
  rewrite size_polyC size_Mmonic ?monicXn -?lead_coef_eq0 //.
  rewrite size_polyXn !addnS -pred_Sn.
  case: (c == 0)=> //=.
  by rewrite ltnS ltn_addr // size_poly_gt0 -lead_coef_eq0.
Qed.

Instance Rhpoly_lead_coef : refines (Rhpoly ==> Logic.eq)
                                    lead_coef lead_coef_op.
Proof.
  rewrite /lead_coef_op refinesE=> _ hp <-.
  elim: hp=> [a|a n p ih] /=; first by rewrite lead_coefC.
  rewrite -ih /cast /cast_pos_nat /=; case: n=> n ngt0.
  by rewrite /val_of_pos -[n]prednK // lead_coef_MXnaddC.
Qed.

Lemma rdivpXnSm (p : {poly A}) a n m :
  rdivp (p * 'X^n + a%:P) 'X^m.+1 = if (n <= m.+1)%C then rdivp p 'X^(m.+1 - n)
                                    else p * 'X^(n - m.+1).
Proof.
  have [leqnSm|gtnSm] := leqP n m.+1.
    rewrite [(_ <= _)%C]leqnSm.
    rewrite [p in LHS](@rdivp_eq _ 'X^(m.+1 - n)) ?monicXn //.
    rewrite mulrDl -addrA -mulrA -exprD subnK ?rdivp_addl_mul_small //.
      by rewrite monicXn.
    rewrite size_polyXn (leq_ltn_trans (size_add _ _)) // gtn_max.
    rewrite (leq_ltn_trans (size_mul_leq _ _)) /=.
      by rewrite size_polyC; case: (a != 0).
    rewrite size_polyXn addnS -pred_Sn addnC -ltn_subRL [X in (_ < X)]subSn //.
    by rewrite -[X in (_ < X)](size_polyXn A) ltn_rmodp monic_neq0 ?monicXn.
  rewrite ifN -?ltnNge // -[in LHS](subnK (ltnW gtnSm)) exprD mulrA.
  by rewrite rdivp_addl_mul_small ?monicXn ?size_polyC ?size_polyXn;
    case: (a != 0).
Qed.

Lemma rmodpXnSm (p : {poly A}) a n m :
  rmodp (p * 'X^n + a%:P) 'X^m.+1 =
  if (n <= m.+1)%C then (rmodp p 'X^(m.+1 - n)) * 'X^n + a%:P
  else a%:P.
Proof.
  have [leqnSm|gtnSm] := leqP n m.+1.
    rewrite [(_ <= _)%C]leqnSm.
    rewrite [p in LHS](@rdivp_eq _ 'X^(m.+1 - n)) ?monicXn //.
    rewrite mulrDl -addrA -mulrA -exprD subnK ?rmodp_addl_mul_small //.
      by rewrite monicXn.
    rewrite size_polyXn (leq_ltn_trans (size_add _ _)) // gtn_max.
    rewrite (leq_ltn_trans (size_mul_leq _ _)) /=.
      by rewrite size_polyC; case: (a != 0).
    rewrite size_polyXn addnS -pred_Sn addnC -ltn_subRL [X in (_ < X)]subSn //.
    by rewrite -[X in (_ < X)](size_polyXn A) ltn_rmodp monic_neq0 ?monicXn.
  rewrite ifN -?ltnNge // -[in LHS](subnK (ltnW gtnSm)) exprD mulrA.
  by rewrite rmodp_addl_mul_small ?monicXn ?size_polyC ?size_polyXn;
    case: (a != 0).
Qed.

Instance Rhpoly_split :
  refines (Logic.eq ==> Rhpoly ==> prod_R Rhpoly Rhpoly)
          (splitp (R:=A)) split_op.
Proof.
  rewrite refinesE=> _ m -> p hp h1.
  rewrite [p]RhpolyE /Rhpoly /fun_hrel /splitp /split_op {p h1} /=.
  apply: prod_RI; rewrite /prod_hrel /=.
  elim: hp m=> [a [|m]|a n p ih [|m]] /=; first by rewrite expr0 rdivp1 rmodp1.
      rewrite rdivp_small ?rmodp_small ?polyC0 // size_polyC size_polyXn;
      by case: (a != 0).
    by rewrite expr0 rdivp1 rmodp1.
  rewrite rdivpXnSm rmodpXnSm.
  case: ifP=> hnSm /=.
    have -> /= := surjective_pairing (split_hpoly (m.+1 - cast n)%C p).
    by have [-> ->] := ih (m.+1 - cast n)%C.
  rewrite /shift_hpoly [(_ == _)%C]subn_eq0 ifN /=.
  rewrite polyC0 addr0 /cast cast_nat_posK //.
    by rewrite subn_gt0 ltnNge [(_ <= _)%N]hnSm.
  by rewrite [(_ <= _)%N]hnSm.
Qed.

Instance Rhpoly_head : refines (Rhpoly ==> Logic.eq) (fun p => p`_0) head_hpoly.
Proof.
  rewrite refinesE=> _ hp <-.
  elim: hp=> [a|a n p ih]; rewrite [to_poly _]/=; first by rewrite coefC.
  rewrite coefD coefMXn coefC /cast /cast_pos_nat.
  case: n=> n ngt0 /=.
  by rewrite ngt0 add0r.
Qed.

Instance Rhpoly_spec_l :
  refines (Rhpoly ==> Logic.eq) spec_id (spec_hpoly (N:=nat) (C:=A)).
Proof.
  rewrite refinesE /spec_id=> _ hp <-.
  have simp_polyC a :
    a%:P = (if a == 0 then 0 else if a == 1 then 1 else (specA a)%:P).
    case: ifP=> [/eqP a0|_]; first by rewrite a0 polyC0.
    case: ifP=> [/eqP a1|_]; first by rewrite a1 polyC1.
    by rewrite /specA /spec_id.
  elim: hp=> [a|a n p ih] /=; simpC.
    exact: simp_polyC.
  rewrite spec_aux_shift /spec_nat /spec_id ih /spec_hpoly.
  case: ifP=> p0.
    rewrite spec_aux_eq0 // mul0r add0r.
    exact: simp_polyC.
  case: ifP=> [/eqP a0|_]; first by rewrite a0 polyC0 addr0.
  by rewrite [in LHS]simp_polyC.
Qed.

(*************************************************************************)
(* PART III: Parametricity part                                          *)
(*************************************************************************)
Section hpoly_parametricity.

Import Refinements.Op.

Context (C : Type) (rAC : A -> C -> Type).
Context (P : Type) (rP : pos -> P -> Type).
Context (N : Type) (rN : nat -> N -> Type).
Context `{zero_of C, one_of C, opp_of C, add_of C, sub_of C, mul_of C, eq_of C}.
Context `{one_of P, add_of P, sub_of P, eq_of P, lt_of P}.
Context `{zero_of N, one_of N, eq_of N, lt_of N, leq_of N, add_of N, sub_of N}.
Context `{cast_of N P, cast_of P N}.
Context `{spec_of C A, spec_of N nat}.
Context `{!refines rAC 0%R 0%C, !refines rAC 1%R 1%C}.
Context `{!refines (rAC ==> rAC) -%R -%C}.
Context `{!refines (rAC ==> rAC ==> rAC) +%R +%C}.
Context `{!refines (rAC ==> rAC ==> rAC) (fun x y => x - y) sub_op}.
Context `{!refines (rAC ==> rAC ==> rAC) *%R *%C}.
Context `{!refines (rAC ==> rAC ==> bool_R) eqtype.eq_op eq_op}.
Context `{!refines (rAC ==> Logic.eq) spec_id spec}.
Context `{!refines rP pos1 1%C}.
Context `{!refines (rP ==> rP ==> rP) add_pos +%C}.
Context `{!refines (rP ==> rP ==> rP) sub_pos sub_op}.
Context `{!refines (rP ==> rP ==> bool_R) eqtype.eq_op eq_op}.
Context `{!refines (rP ==> rP ==> bool_R) lt_pos lt_op}.
Context `{!refines rN 0%N 0%C, !refines rN 1%N 1%C}.
Context `{!refines (rN ==> rN ==> rN) addn +%C}.
Context `{!refines (rN ==> rN ==> rN) subn sub_op}.
Context `{!refines (rN ==> rN ==> bool_R) eqtype.eq_op eq_op}.
Context `{!refines (rN ==> rN ==> bool_R) ltn lt_op}.
Context `{!refines (rN ==> rN ==> bool_R) ssrnat.leq leq_op}.
Context `{!refines (rN ==> rP) cast_nat_pos cast}.
Context `{!refines (rP ==> rN) cast_pos_nat cast}.
Context `{!refines (rN ==> nat_R) spec_id spec}.

Definition RhpolyC := (Rhpoly \o (hpoly_R rP rAC)).

#[export] Instance RhpolyC_0 : refines RhpolyC 0%R 0%C.
Proof. param_comp zero_hpoly_R. Qed.

#[export] Instance RhpolyC_1 : refines RhpolyC 1%R 1%C.
Proof. param_comp one_hpoly_R. Qed.

#[export] Instance RhpolyCD : refines (RhpolyC ==> RhpolyC ==> RhpolyC)
                                      +%R (add_hpoly (N:=N)).
Proof. param_comp add_hpoly_R. Qed.

#[export] Instance RhpolyCN : refines (RhpolyC ==> RhpolyC) -%R -%C.
Proof. param_comp opp_hpoly_R. Qed.

#[export] Instance RhpolyC_sub : refines (RhpolyC ==> RhpolyC ==> RhpolyC)
                                      (fun x y => x - y) (sub_hpoly (N:=N)).
Proof. param_comp sub_hpoly_R. Qed.

#[export] Instance RhpolyCM :
  refines (RhpolyC ==> RhpolyC ==> RhpolyC) *%R (mul_hpoly (N:=N)).
Proof. param_comp mul_hpoly_R. Qed.

#[export] Instance RhpolyC_exp :
  refines (RhpolyC ==> rN ==> RhpolyC) (@GRing.exp _) exp_op.
Proof.
  eapply refines_trans; tc.
  rewrite refinesE; do ?move=> ?*.
  eapply (exp_hpoly_R (N_R:=rN))=> // *;
    exact: refinesP.
Qed.

#[export] Instance RhpolyC_size :
  refines (RhpolyC ==> rN) (sizep (R:=A)) size_hpoly.
Proof. param_comp size_hpoly_R. Qed.

#[export] Instance RhpolyC_lead_coef :
  refines (RhpolyC ==> rAC) lead_coef lead_coef_op.
Proof.
  rewrite /lead_coef_op.
  param_comp lead_coef_hpoly_R.
Qed.

#[export] Instance RhpolyC_polyC :
  refines (rAC ==> RhpolyC) (fun a => a%:P) cast.
Proof. param_comp cast_hpoly_R. Qed.

#[export] Instance RhpolyC_eq : refines (RhpolyC ==> RhpolyC ==> bool_R)
                                     eqtype.eq_op (eq_hpoly (N:=N)).
Proof. param_comp eq_hpoly_R. Qed.

#[export] Instance RhpolyC_scale : refines (rAC ==> RhpolyC ==> RhpolyC) *:%R *:%C.
Proof. param_comp scale_hpoly_R. Qed.

#[export] Instance RhpolyC_shift : refines (rN ==> RhpolyC ==> RhpolyC)
                                        (shiftp (R:=A)) shift_hpoly.
Proof.
  eapply refines_trans; tc.
  rewrite refinesE; do ?move=> ?*.
  eapply (shift_hpoly_R (N_R:=rN))=> // *;
  exact: refinesP.
Qed.

#[export] Instance RhpolyCMXn p sp n rn :
  refines rN n rn -> refines RhpolyC p sp ->
  refines RhpolyC (p * 'X^n) (shift_op rn sp).
Proof. by move=> hn hp; rewrite -[_ * 'X^_]/(shiftp _ _); tc. Qed.

#[export] Instance RhpolyC_Xnmul p sp n rn :
  refines rN n rn -> refines RhpolyC p sp ->
  refines RhpolyC ('X^n * p) (shift_op rn sp).
Proof. rewrite -mulXnC; exact: RhpolyCMXn. Qed.

#[export] Instance RhpolyC_scaleXn c rc n rn :
  refines rN n rn -> refines rAC c rc ->
  refines RhpolyC (c *: 'X^n) (shift_op rn (cast rc)).
Proof.
  move=> hn hc; rewrite -mul_polyC -[_ * 'X^_]/(shiftp _ _).
  exact: refines_apply.
Qed.

#[export] Instance RhpolyCMX p sp :
  refines RhpolyC p sp -> refines RhpolyC (p * 'X) (shift_op (1%C : N) sp).
Proof. rewrite -['X]expr1; exact: RhpolyCMXn. Qed.

#[export] Instance RhpolyC_Xmul p sp :
  refines RhpolyC p sp -> refines RhpolyC ('X * p) (shift_op (1%C : N) sp).
Proof. rewrite -['X]expr1 -mulXnC; exact: RhpolyCMX. Qed.

#[export] Instance RhpolyC_scaleX c rc :
  refines rAC c rc ->
  refines RhpolyC (c *: 'X) (shift_op (1%C : N) (cast rc)).
Proof. rewrite -['X]expr1; exact: RhpolyC_scaleXn. Qed.

#[export] Instance RhpolyC_split :
  refines (rN ==> RhpolyC ==> prod_R RhpolyC RhpolyC)
          (splitp (R:=A)) split_op.
Proof.
refines_trans.
  rewrite refinesE; do ?move=> ?*.
  eapply (split_hpoly_R (N_R:=rN))=> // *;
    exact: refinesP.
Qed.

#[export] Instance RhpolyC_splitn n rn p sp :
  refines rN n rn -> refines RhpolyC p sp ->
  refines (prod_R RhpolyC RhpolyC) (splitp n p) (split_op rn sp).
Proof. by move=> hn hp; exact: refines_apply. Qed.

(* same as for seqpoly... maybe have a generic version + refinement instance in
   another file? *)
Definition eq_prod_hpoly (x y : (@hpoly P C * @hpoly P C)) :=
  (eq_hpoly (N:=N) x.1 y.1) && (eq_hpoly (N:=N) x.2 y.2).

#[export] Instance refines_prod_RhpolyC_eq :
  refines (prod_R RhpolyC RhpolyC ==> prod_R RhpolyC RhpolyC ==> bool_R)
          eqtype.eq_op eq_prod_hpoly.
Proof.
  rewrite refinesE=> x x' hx y y' hy.
  rewrite /eqtype.eq_op /eq_prod_hpoly /=.
  have -> : (x.1 == y.1) = (eq_hpoly (N:=N) x'.1 y'.1).
    exact: refines_eq.
  have -> : (x.2 == y.2) = (eq_hpoly (N:=N) x'.2 y'.2).
    exact: refines_eq.
  exact: bool_Rxx.
Qed.

#[export] Instance RhpolyC_X : refines RhpolyC 'X (shift_op (1%C : N) 1)%C.
Proof. rewrite -['X]mul1r; exact: RhpolyCMX. Qed.

#[export] Instance RhpolyC_Xn n rn :
  refines rN n rn -> refines RhpolyC 'X^n (shift_op rn 1)%C.
Proof. move=> hn; rewrite -['X^_]mul1r; exact: RhpolyCMXn. Qed.

(* #[export] Instance RhpolyC_horner : param (RhpolyC ==> rAC ==> rAC) *)
(*   (fun p x => p.[x]) (fun sp x => horner_seq sp x). *)
(* Proof. admit. Qed. *)
(* (* Proof. exact: param_trans. Qed. *) *)

#[export] Instance RhpolyC_head :
  refines (RhpolyC ==> rAC) (fun p => p`_0) head_hpoly.
Proof. param_comp head_hpoly_R. Qed.

#[export] Instance RhpolyC_spec :
  refines (RhpolyC ==> eq) spec_id (spec_hpoly (N:=N) (C:=C)).
Proof.
  eapply refines_trans; tc.
  rewrite refinesE=> hp hq rpq.
  elim: rpq=> {hp hq} [a c rac|a c rac n m rnm hp hq rpq] /=;
    rewrite ![(a == _)%C]refines_eq /specA [spec_id _]refines_eq //=.
  have -> : eq0_hpoly hp = eq0_hpoly hq.
    elim: rpq=> [x y rxy|x y rxy k l rkl p q rpq ih];
      by rewrite /= [(_ == _)%C]refines_eq ?ih.
  rewrite /spec_nat [spec_id _]refines_eq.
  by rewrite ![spec_hpoly_aux (spec _) _]spec_aux_shift=> ->.
Qed.

End hpoly_parametricity.
End hpoly_theory.

From mathcomp Require Import ssrint.
From CoqEAL Require Import binnat binint.

Section testpoly.

Goal (0 == 0 :> {poly int}).
by coqeal.
Abort.

Goal (0 == (0 : {poly {poly {poly int}}})).
by coqeal.
Abort.

Goal (1 == 1 :> {poly int}).
by coqeal.
Abort.

Goal (1 == (1 : {poly {poly {poly int}}})).
by coqeal.
Abort.

Goal ((1 + 2%:Z *: 'X + 3%:Z *: 'X^2) + (1 + 2%:Z%:P * 'X + 3%:Z%:P * 'X^2)
      == (1 + 1 + (2%:Z + 2%:Z) *: 'X + (3%:Z + 3%:Z)%:P * 'X^2)).
rewrite -[X in (X == _)]/(spec_id _) [spec_id _]refines_eq /=.
(* by coqeal. *)
Abort.

Goal (- 1 == - (1: {poly {poly int}})).
by coqeal.
Abort.

Goal (- (1 + 2%:Z *: 'X + 3%:Z%:P * 'X^2) == -1 - 2%:Z%:P * 'X - 3%:Z *: 'X^2).
by coqeal.
Abort.

Goal (1 + 2%:Z *: 'X + 3%:Z *: 'X^2 - (1 + 2%:Z *: 'X + 3%:Z *: 'X^2) == 0).
by rewrite -[X in (X == _)]/(spec_id _) [spec_id _]refines_eq /=.
Abort.

Goal ((1 + 2%:Z *: 'X) * (1 + 2%:Z%:P * 'X) == 1 + 4%:Z *: 'X + 4%:Z *: 'X^2).
by coqeal.
Abort.

(* (1 + xy) * x = x + x^2y *)
Goal ((1 + 'X * 'X%:P) * 'X == 'X + 'X^2 * 'X%:P :> {poly {poly int}}).
rewrite -[X in (X == _)]/(spec_id _) [spec_id _]refines_eq /=.
(* by coqeal. *)
Abort.

Goal (sizep ('X^2 : {poly int}) ==
      sizep (- 3%:Z *: 'X^(sizep ('X : {poly int})))).
by coqeal.
Abort.

Definition test := [coqeal simpl of sizep (1 + 2%:Z *: 'X + 3%:Z *: 'X^2)].

Goal (sizep (1 + 2%:Z *: 'X + 3%:Z *: 'X^2) = 3%N).
by coqeal.
Qed.

Goal ((1 + 2%:Z *: 'X) * (1 + 2%:Z%:P * 'X^(sizep (1 : {poly int}))) ==
      1 + 4%:Z *: 'X + 4%:Z *: 'X^(sizep (10%:Z *: 'X))).
by coqeal.
Abort.

Goal (splitp 2 (1 + 2%:Z *: 'X + 3%:Z%:P * 'X^2 + 4%:Z *: 'X^3) ==
      (3%:Z%:P + 4%:Z *: 'X, 1 + 2%:Z%:P * 'X)).
by coqeal.
Abort.

Goal (splitp (sizep ('X : {poly int}))
             (1 + 2%:Z *: 'X + 3%:Z%:P * 'X^2 + 4%:Z *: 'X^3) ==
      (3%:Z%:P + 4%:Z *: 'X, 1 + 2%:Z%:P * 'X)).
by coqeal.
Abort.

End testpoly.


(* Define a type of days *)
Inductive day : Type :=
  | monday
  | tuesday
  | wednesday
  | thursday
  | friday
  | saturday
  | sunday.

(* Define a function which matches a day and returns the next day *)
Definition next_weekday (d:day) : day :=
  match d with
  | monday => tuesday
  | tuesday => wednesday
  | wednesday => thursday
  | thursday => friday
  | friday => monday
  | saturday => monday
  | sunday => monday
  end.

  (* Calculate the next week day after Friday *)
Compute (next_weekday friday).

(* We can then compound expressions *)
Compute (next_weekday (next_weekday saturday)).

(* Expect a result to be true -- a test of sorts *)
Example test_next_weekday: (next_weekday (next_weekday saturday)) = tuesday.

(* We can ask Coq to verify it like such *)
Proof. simpl. reflexivity. Qed.

(* Define the standard type bool of booleans with members true and false *)
Inductive bool : Type :=
  | true
  | false.

(* Define negation *)
Definition negb (b:bool) : bool :=
    match b with
    | true => false
    | false => true
    end.

(* Define anding two bools *)
Definition andb (b1: bool) (b2: bool) : bool :=
    match b1 with
    | true => b2
    | false => false
    end.

(* Define or-ing two bools *)
Definition orb (b1: bool) (b2: bool) : bool :=
    match b1 with
    | true => true
    | false => b2
    end.

Example test_orb1: (orb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_orb2: (orb false false) = false.
Proof. simpl. reflexivity. Qed.
Example test_orb3: (orb false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_orb4: (orb true true) = true.
Proof. simpl. reflexivity. Qed.

(* infix syntax for boolean ops *)
Notation "x && y" := (andb x y).
Notation "x || y" := (orb x y).

Example test_orb5: false || false || true = true.
Proof. simpl. reflexivity. Qed.

(* Conditional expressions *)
Definition negb' (b:bool) : bool :=
    if b then false
    else true.

Definition andb' (b1: bool) (b2: bool) : bool :=
    if b1 then b2
    else false.

Definition orb' (b1: bool) (b2: bool) : bool :=
    if b1 then true
    else b2.

    (*
    The command Admitted can be used as a placeholder for an incomplete proof. We use it in exercises to indicate the parts that we're leaving for you -- i.e., your job is to replace Admitteds with real proofs.
Remove "Admitted." and complete the definition of the following function; then make sure that the Example assertions below can each be verified by Coq. (I.e., fill in each proof, following the model of the orb tests above, and make sure Coq accepts it.) The function should return true if either or both of its inputs are false.
Hint: if simpl will not simplify the goal in your proof, it's probably because you defined nandb without using a match expression. Try a different definition of nandb, or just skip over simpl and go directly to reflexivity. We'll explain this phenomenon later in the chapter.
    *)
Definition nandb (b1:bool) (b2:bool) : bool :=
    if b1 && b2 then false
    else true.

Example test_nandb1: (nandb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb2: (nandb false false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb3: (nandb false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb4: (nandb true true) = false.
Proof. simpl. reflexivity. Qed.

Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
    if (b1 && b2) && b3 then true
    else false.

Example test_andb31: (andb3 true true true) = true.
Proof. simpl. reflexivity. Qed.
Example test_andb32: (andb3 false true true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb33: (andb3 true false true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb34: (andb3 true true false) = false.
Proof. simpl. reflexivity. Qed.

Check true.
Check (negb true).
Check negb.

(*
In particular, the definitions of rgb and color say which constructor expressions belong to the sets rgb and color:
red, green, and blue belong to the set rgb;
black and white belong to the set color;
if p is a constructor expression belonging to the set rgb, then primary p (pronounced "the constructor primary applied to the argument p") is a constructor expression belonging to the set color; and
constructor expressions formed in these ways are the only ones belonging to the sets rgb and color.
*)
Inductive rgb : Type :=
  | red
  | green
  | blue.
Inductive color : Type :=
  | black
  | white
  | primary (p : rgb).

Definition monochrome (c : color) : bool :=
  match c with
  | black => true
  | white => true
  | primary p => false
  end.

Definition isred (c: color) : bool :=
    match c with
    | black => false
    | white => false
    | primary red => true
    | primary _ => false
    end.

Module Playground.
  Definition b : rgb := blue.
End Playground.
Definition b : bool := true.
Check Playground.b : rgb.
Check b : bool.

Module TuplePlayground.
Inductive bit : Type :=
  | B0
  | B1.
Inductive nybble : Type :=
  | bits (b0 b1 b2 b3 : bit).

Check (bits B1 B0 B1 B0)
  : nybble.

Definition all_zero (nb : nybble) : bool :=
  match nb with
  | (bits B0 B0 B0 B0) => true
  | (bits _ _ _ _) => false
  end.

Compute (all_zero (bits B1 B0 B1 B0)).
(* ===> false : bool *)
Compute (all_zero (bits B0 B0 B0 B0)).
(* ===> true : bool *)
End TuplePlayground.

Module NatPlayground.
Inductive nat : Type :=
  | O
  | S (n : nat).

  Inductive nat' : Type :=
  | stop
  | tick (foo : nat').

  Definition pred (n : nat) : nat :=
  match n with
  | O => O
  | S n' => n'
  end.

End NatPlayground.

Check (S (S (S (S O)))).
(* ===> 4 : nat *)
Definition minustwo (n : nat) : nat :=
  match n with
  | O => O
  | S O => O
  | S (S n') => n'
  end.
Compute (minustwo 4).
(* ===> 2 : nat *)

Check S : nat -> nat.
Check pred : nat -> nat.
Check minustwo : nat -> nat.

(* Recursion === Fixpoint *)
Fixpoint even (n:nat) : bool :=
  match n with
  | O => true
  | S O => false
  | S (S n') => even n'
  end.
Definition odd (n:nat) : bool :=
  negb (even n).
Example test_odd1: odd 1 = true.
Proof. simpl. reflexivity. Qed.
Example test_odd2: odd 4 = false.
Proof. simpl. reflexivity. Qed.

Module NatPlayground2.

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

Fixpoint mut (n m : nat) : nat :=
    match n with
    | O => O
    | S n' => plus m (mut n' m)
    end.

Example test_mult1: (mut 3 3) = 9.
Proof. simpl. reflexivity. Qed.

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

End NatPlayground2.

Fixpoint exp (base power : nat) : nat :=
  match power with
  | O => S O
  | S p => mult base (exp base p)
  end.
Example test_exp1: (exp 3 3) = 27.
Proof. simpl. reflexivity. Qed.

Fixpoint factorial (n : nat) : nat :=
 match n with
 | O => 1
 | S n' => mult n (factorial n')
 end.

Example test_factorial1: (factorial 3) = 6.
Proof. simpl. reflexivity. Qed.
Example test_factorial2: (factorial 5) = (mult 10 12).
Proof. simpl. reflexivity. Qed.

Notation "x + y" := (plus x y)
                       (at level 50, left associativity)
                       : nat_scope.
Notation "x - y" := (minus x y)
                       (at level 50, left associativity)
                       : nat_scope.
Notation "x * y" := (mult x y)
                       (at level 40, left associativity)
                       : nat_scope.
Check ((0 + 1) + 1) : nat.

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

Fixpoint leb (n m : nat) : bool :=
  match n with
  | O => true
  | S n' =>
      match m with
      | O => false
      | S m' => leb n' m'
      end
  end.
Example test_leb1: leb 2 2 = true.
Proof. simpl. reflexivity. Qed.
Example test_leb2: leb 2 4 = true.
Proof. simpl. reflexivity. Qed.
Example test_leb3: leb 4 2 = false.
Proof. simpl. reflexivity. Qed.

Notation "x =? y" := (eqb x y) (at level 70) : nat_scope.
Notation "x <=? y" := (leb x y) (at level 70) : nat_scope.
Example test_leb3': (4 <=? 2) = false.
Proof. simpl. reflexivity. Qed.

(* Less than resulting in a bool *)
Definition ltb (n m : nat) : bool :=
  match (n <=? m) with
  | true => negb (n =? m)
  | false => false
  end.

Notation "x <? y" := (ltb x y) (at level 70) : nat_scope.

Example test_ltb1: (ltb 2 2) = false.
Proof. simpl. reflexivity. Qed.
Example test_ltb2: (ltb 2 4) = true.
Proof. simpl. reflexivity. Qed.
Example test_ltb3: (ltb 4 2) = false.
Proof. simpl. reflexivity. Qed.

Theorem plus_O_n : forall n : nat, 0 + n = n.
Proof.
  intros n. simpl. reflexivity. Qed.
Theorem plus_O_n' : forall n : nat, 0 + n = n.
Proof.
  intros n. reflexivity. Qed.

Theorem plus_O_n'' : forall n : nat, 0 + n = n.
Proof.
  intros m. reflexivity. Qed.

Theorem plus_1_l : forall n:nat, 1 + n = S n.
Proof.
  intros n. reflexivity. Qed.

Theorem mult_0_l : forall n:nat, 0 * n = 0.
Proof.
  intros n. reflexivity. Qed.

Theorem plus_id_example : forall n m : nat,
(* The arrow is prnounced "implies" *)
  n = m ->
  n + n = m + m.

Proof.
  (* move both quanitifers into the context *)
  intros n m.
  (* move the hypothesis into the context *)
  intros H.
  (* rewrite the goal using the hypothesis *)
  rewrite -> H.
  reflexivity. Qed.

(* Exercise plus_id_exercise *)
Theorem plus_id_exercise : forall n m o : nat,
  n = m -> m = o -> n + m = m + o.
Proof.
  intros n m o.
  intros H.
  intros H'.
  rewrite -> H.
  rewrite -> H'.
  reflexivity. Qed.

Theorem mult_n_0_m_0 : forall p q : nat,
 (p * 0) + (q * 0) = 0.
 Proof.
  intros p q.
  rewrite <- mult_n_O.
  rewrite <- mult_n_O.
  reflexivity. Qed.

Theorem plus_1_neq_0_firsttry : forall n : nat,
  (n + 1) =? 0 = false.
Proof.
  intros n.  destruct n as [| n'] eqn:E.
  - reflexivity.
  - reflexivity. Qed.

Theorem negb_involutive : forall b : bool,
  negb (negb b) = b.
Proof.
  intros b. destruct b eqn:E.
  - reflexivity.
  - reflexivity. Qed.

Theorem andb_commutative : forall b c, andb b c = andb c b.
Proof.
  intros b c. destruct b eqn:Eb.
  - destruct c eqn:Ec.
    + reflexivity.
    + reflexivity.
  - destruct c eqn:Ec.
    + reflexivity.
    + reflexivity.
Qed.

Theorem andb_commutative' : forall b c, andb b c = andb c b.
Proof.
  intros b c. destruct b eqn:Eb.
  { destruct c eqn:Ec.
    { reflexivity. }
    { reflexivity. } }
  { destruct c eqn:Ec.
    { reflexivity. }
    { reflexivity. }
  }
Qed.

Theorem andb3_exchange : forall b c d, andb (andb b c) d = andb (andb b d) c.
Proof.
  intros b c d. destruct b eqn:Eb.
  - destruct c eqn:Ec.
    + destruct d eqn:Ed.
      * reflexivity.
      * reflexivity.
    + destruct d eqn:Ed.
      * reflexivity.
      * reflexivity.
  - destruct c eqn:Ec.
    + destruct d eqn:Ed.
      * reflexivity.
      * reflexivity.
    + destruct d eqn:Ed.
      * reflexivity.
      * reflexivity.
Qed.

Theorem andb_true_elim2 : forall b c : bool,
  andb b c = true -> c = true.
Proof.
  intros b c H.
  destruct c.
    - reflexivity.
    - rewrite <- H.
      destruct b.
      + reflexivity.
      + reflexivity.
Qed.

Theorem plus_1_neq_0' : forall n : nat,
  (n + 1) =? 0 = false.
Proof.
  intros [|n].
    - reflexivity.
    - reflexivity.
Qed.

Theorem andb_commutative'' : forall b c, andb b c = andb c b.
Proof.
  intros [] [].
    - reflexivity.
    - reflexivity.
    - reflexivity.
    - reflexivity.
Qed.

Theorem zero_nbeq_plus_1 : forall n : nat,
  0 =? (n + 1) = false.
Proof.
  intros [|n].
    - reflexivity.
    - reflexivity.
Qed.

Theorem identity_fn_applied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = x) ->
  forall (b : bool), f (f b) = b.
Proof.
  intros f H b.
  rewrite -> H.
  rewrite -> H.
  reflexivity.
Qed.


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

Ralph Matthes

2022
*)

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

Contents :

- build monoidal category in whiskered form for the pointed endofunctors through a displayed monoidal category

************************************************************)

Require Import UniMath.Foundations.PartD.
Require Import UniMath.MoreFoundations.All.

Require Import UniMath.CategoryTheory.Core.Categories.
Require Import UniMath.CategoryTheory.Core.Functors.
Require Import UniMath.CategoryTheory.FunctorCategory.
Require Import UniMath.CategoryTheory.whiskering.
Require Import UniMath.CategoryTheory.Core.NaturalTransformations.
Require UniMath.CategoryTheory.PointedFunctors.
Require UniMath.CategoryTheory.PointedFunctorsComposition.
Require Import UniMath.CategoryTheory.Monoidal.Categories.
Require Import UniMath.CategoryTheory.DisplayedCats.Core.
Require Import UniMath.CategoryTheory.DisplayedCats.Total.
Require Import UniMath.CategoryTheory.DisplayedCats.Isos.
Require Import UniMath.CategoryTheory.DisplayedCats.Constructions.
Require Import UniMath.CategoryTheory.Monoidal.Displayed.WhiskeredDisplayedBifunctors.
Require Import UniMath.CategoryTheory.Monoidal.Displayed.Monoidal.
Require Import UniMath.CategoryTheory.Monoidal.Displayed.TotalMonoidal.
Require Import UniMath.CategoryTheory.Monoidal.Examples.MonoidalPointedObjects.
Require Import UniMath.Bicategories.MonoidalCategories.EndofunctorsWhiskeredMonoidal.
Require Import UniMath.CategoryTheory.coslicecat.

Import MonoidalNotations.

Local Open Scope cat.

Section A.
Context (C : category).

  (*
  Definition pointedfunctors_disp_cat : disp_cat (cat_of_endofunctors C).
  Proof.
    use disp_struct.
    - intro F. exact (functor_identity C ⟹ pr1 F).
    - intros F G ptF ptG α. exact (∏ c : C, ptF c · pr1 α c = ptG c).
    - intros F G ptF ptG α. apply impred; intro c. apply C.
    - intros F ptF c. apply id_right.
    - abstract (intros F G H α β; cbn; intros ptF ptG ptH Hα Hβ c;
          rewrite assoc, Hα, Hβ;
                apply idpath ).
  Defined.

  Definition pointedfunctors_cat : category := total_category pointedfunctors_disp_cat.
  (** compare this with [UniMath.CategoryTheory.PointedFunctors.category_Ptd] *)

  Definition pointedfunctors_disp_tensor_data : disp_bifunctor_data (monoidal_of_endofunctors C)
    pointedfunctors_disp_cat pointedfunctors_disp_cat pointedfunctors_disp_cat.
  Proof.
    use tpair.
    - intros F G ptF ptG.
      exact (# (post_comp_functor (functor_identity C)) ptF · # (pre_comp_functor F) ptG).
      (** compare this with [UniMath.CategoryTheory.PointedFunctorsComposition.ptd_compose] *)
    - split.
      + intros F G1 G2 β ptF ptG1 ptG2 Hβ.
        cbn. intro c.
        rewrite <- Hβ.
        apply assoc'.
      + intros F1 F2 G α ptF1 ptF2 ptG Hα.
        cbn. intro c.
        rewrite <- Hα.
        do 2 rewrite <- assoc.
        apply maponpaths.
        etrans.
        { apply pathsinv0, (nat_trans_ax ptG). }
        apply idpath.
  Defined.

  Lemma pointedfunctors_disp_tensor_laws : is_disp_bifunctor pointedfunctors_disp_tensor_data.
  Proof.
    repeat split; red; intros; apply funextsec; intro; apply C.
  Qed.

  Definition pointedfunctors_disp_tensor : disp_tensor pointedfunctors_disp_cat (monoidal_of_endofunctors C) :=
    pointedfunctors_disp_tensor_data ,, pointedfunctors_disp_tensor_laws.

  Definition pointedfunctors_disp_unit : pointedfunctors_disp_cat I_{ monoidal_of_endofunctors C}
    := nat_trans_id (functor_identity C).

  Definition pointedfunctors_disp_moncat_data : disp_monoidal_data pointedfunctors_disp_cat
                                                  (monoidal_of_endofunctors C).
  Proof.
    exists pointedfunctors_disp_tensor. exists pointedfunctors_disp_unit.
    repeat split.
    - intros F ptF c. cbn. rewrite id_left; apply id_right.
    - intros F ptF c. cbn. rewrite id_left; apply id_right.
    - intros F ptF c. cbn. rewrite id_right; apply id_right.
      (* no goal left for inverse of right unitor *)
    - intros F G H ptF ptG ptH c. cbn. rewrite id_right. apply assoc'.
    - intros F G H ptF ptG ptH c. cbn. rewrite id_right. apply assoc.
  Defined.

  Lemma pointedfunctors_disp_moncat_laws : disp_monoidal_laws pointedfunctors_disp_moncat_data.
  Proof.
    repeat split; try red; try (intros; apply funextsec; intro; apply C).
  Qed.

  Definition pointedfunctors_disp_moncat : disp_monoidal pointedfunctors_disp_cat (monoidal_of_endofunctors C) :=
    pointedfunctors_disp_moncat_data ,, pointedfunctors_disp_moncat_laws.

  Definition pointedfunctors_moncat : monoidal pointedfunctors_cat := total_monoidal pointedfunctors_disp_moncat.
   *)

Definition pointedfunctors_disp_cat : disp_cat (cat_of_endofunctors C)
  := coslice_cat_disp (cat_of_endofunctors C) I_{monoidal_of_endofunctors C}.

Definition pointedfunctors_cat : category := total_category pointedfunctors_disp_cat.
Definition pointedfunctors_disp_moncat : disp_monoidal pointedfunctors_disp_cat
                                                       (monoidal_of_endofunctors C)
  := monoidal_pointed_objects_disp (monoidal_of_endofunctors C).

Definition pointedfunctors_moncat : monoidal pointedfunctors_cat
  := total_monoidal pointedfunctors_disp_moncat.

End A.


Require Export CoRN.ode.FromMetric2.
Require Export CoRN.ode.BanachFixpoint.
Require Export CoRN.ode.metric.
Require Export CoRN.ode.SimpleIntegration.
Require Export CoRN.classes.Qposclasses.
Require Export CoRN.classes.Qclasses.
Require Export CoRN.util.Qsums.
Require Export CoRN.util.Qgcd.
Require Export CoRN.util.PointFree.
Require Export CoRN.util.Extract.
Require Export CoRN.util.SetoidPermutation.
Require Export CoRN.util.Container.
Require Export CoRN.util.Qdlog.
Require Export CoRN.stdlib_omissions.Z.
Require Export CoRN.stdlib_omissions.Q.
Require Export CoRN.stdlib_omissions.Pair.
Require Export CoRN.stdlib_omissions.List.
Require Export CoRN.stdlib_omissions.P.
Require Export CoRN.stdlib_omissions.N.
Require Export CoRN.metric2.UniformContinuity.
Require Export CoRN.metric2.StepFunction.
Require Export CoRN.metric2.Limit.
Require Export CoRN.metric2.Hausdorff.
Require Export CoRN.metric2.StepFunctionMonad.
Require Export CoRN.metric2.Classification.
Require Export CoRN.metric2.CompleteProduct.
Require Export CoRN.metric2.Prelength.
Require Export CoRN.metric2.UCFnMonoid.
Require Export CoRN.metric2.Complete.
Require Export CoRN.metric2.ProductMetric.
Require Export CoRN.metric2.Metric.
Require Export CoRN.metric2.MetricMorphisms.
Require Export CoRN.metric2.StepFunctionSetoid.
Require Export CoRN.metric2.DistanceMetricSpace.
Require Export CoRN.metric2.FinEnum.
Require Export CoRN.metric2.Compact.
Require Export CoRN.metric2.Graph.
Require Export CoRN.order.PartialOrder.
Require Export CoRN.order.TotalOrder.
Require Export CoRN.order.SemiLattice.
Require Export CoRN.order.Lattice.
Require Export CoRN.transc.ArTanH.
Require Export CoRN.transc.SinCos.
Require Export CoRN.transc.PowerSeries.
Require Export CoRN.transc.Pi.
Require Export CoRN.transc.TrigMon.
Require Export CoRN.transc.MoreArcTan.
Require Export CoRN.transc.Exponential.
Require Export CoRN.transc.InvTrigonom.
Require Export CoRN.transc.RealPowers.
Require Export CoRN.transc.Trigonometric.
Require Export CoRN.transc.TaylorSeries.
Require Export CoRN.tactics.DiffTactics3.
Require Export CoRN.tactics.CornTac.
Require Export CoRN.tactics.FieldReflection.
Require Export CoRN.tactics.Step.
Require Export CoRN.tactics.DiffTactics1.
Require Export CoRN.tactics.AlgReflection.
Require Export CoRN.tactics.csetoid_rewrite.
Require Export CoRN.tactics.RingReflection.
Require Export CoRN.tactics.Qauto.
Require Export CoRN.tactics.Rational.
Require Export CoRN.tactics.DiffTactics2.
Require Export CoRN.reals.RealFuncts.
Require Export CoRN.reals.Intervals.
Require Export CoRN.reals.Series.
Require Export CoRN.reals.CReals1.
Require Export CoRN.reals.Bridges_iso.
Require Export CoRN.reals.iso_CReals.
Require Export CoRN.reals.CSumsReals.
Require Export CoRN.reals.CauchySeq.
Require Export CoRN.reals.Q_in_CReals.
Require Export CoRN.reals.fast.CRGeometricSum.
Require Export CoRN.reals.fast.CRpi_fast.
Require Export CoRN.reals.fast.CRsum.
Require Export CoRN.reals.fast.CRseries.
Require Export CoRN.reals.fast.CRabs.
Require Export CoRN.reals.fast.MultivariatePolynomials.
Require Export CoRN.reals.fast.CRAlternatingSum.
Require Export CoRN.reals.fast.CRartanh_slow.
Require Export CoRN.reals.fast.CRpi_slow.
Require Export CoRN.reals.fast.ContinuousCorrect.
Require Export CoRN.reals.fast.CRarctan_small.
Require Export CoRN.reals.fast.ModulusDerivative.
Require Export CoRN.reals.fast.CRcos.
Require Export CoRN.reals.fast.CRcorrect.
Require Export CoRN.reals.fast.uneven_CRplus.
Require Export CoRN.reals.fast.CRArith.
Require Export CoRN.reals.fast.CRpi.
Require Export CoRN.reals.fast.CRpower.
Require Export CoRN.reals.fast.CRconst.
Require Export CoRN.reals.fast.CRball.
Require Export CoRN.reals.fast.Interval.
Require Export CoRN.reals.fast.CRarctan.
Require Export CoRN.reals.fast.CRexp.
Require Export CoRN.reals.fast.Compress.
Require Export CoRN.reals.fast.CRsin.
Require Export CoRN.reals.fast.CRroot.
Require Export CoRN.reals.fast.CRtrans.
Require Export CoRN.reals.fast.CRIR.
Require Export CoRN.reals.fast.PowerBound.
Require Export CoRN.reals.fast.CRsign.
Require Export CoRN.reals.fast.CRFieldOps.
Require Export CoRN.reals.fast.CRln.
Require Export CoRN.reals.fast.LazyNat.
Require Export CoRN.reals.fast.CRGroupOps.
Require Export CoRN.reals.RealLists.
Require Export CoRN.reals.PosSeq.
Require Export CoRN.reals.Bridges_LUB.
Require Export CoRN.reals.OddPolyRootIR.
Require Export CoRN.reals.Cauchy_CReals.
Require Export CoRN.reals.CMetricFields.
Require Export CoRN.reals.CPoly_Contin.
Require Export CoRN.reals.Q_dense.
Require Export CoRN.reals.faster.ApproximateRationals.
Require Export CoRN.reals.faster.ARArith.
Require Export CoRN.reals.faster.ARAlternatingSum.
Require Export CoRN.reals.faster.ARexp.
Require Export CoRN.reals.faster.ARbigD.
Require Export CoRN.reals.faster.AQmetric.
Require Export CoRN.reals.faster.ARsign.
Require Export CoRN.reals.faster.ARroot.
Require Export CoRN.reals.RealCount.
Require Export CoRN.reals.R_morphism.
Require Export CoRN.reals.NRootIR.
Require Export CoRN.reals.IVT.
Require Export CoRN.reals.Cesaro.
Require Export CoRN.reals.Max_AbsIR.
Require Export CoRN.reals.CReals.
Require Export CoRN.model.Zmod.ZDivides.
Require Export CoRN.model.Zmod.ZGcd.
Require Export CoRN.model.Zmod.Zm.
Require Export CoRN.model.Zmod.Cmod.
Require Export CoRN.model.Zmod.IrrCrit.
Require Export CoRN.model.Zmod.ZMod.
Require Export CoRN.model.Zmod.ZBasics.
Require Export CoRN.model.lattice.CRlattice.
Require Export CoRN.model.monoids.Zmonoid.
Require Export CoRN.model.monoids.Nposmonoid.
Require Export CoRN.model.monoids.Nm_to_freem.
Require Export CoRN.model.monoids.Qmonoid.
Require Export CoRN.model.monoids.QSposmonoid.
Require Export CoRN.model.monoids.Nm_to_cycm.
Require Export CoRN.model.monoids.Qposmonoid.
Require Export CoRN.model.monoids.CRmonoid.
Require Export CoRN.model.monoids.Nmonoid.
Require Export CoRN.model.monoids.freem_to_Nm.
Require Export CoRN.model.fields.Qfield.
Require Export CoRN.model.fields.CRfield.
Require Export CoRN.model.metric2.IntegrableFunction.
Require Export CoRN.model.metric2.CRmetric.
Require Export CoRN.model.metric2.LinfMetricMonad.
Require Export CoRN.model.metric2.LinfMetric.
Require Export CoRN.model.metric2.L1metric.
Require Export CoRN.model.metric2.Qmetric.
Require Export CoRN.model.metric2.BoundedFunction.
Require Export CoRN.model.semigroups.Qpossemigroup.
Require Export CoRN.model.semigroups.QSpossemigroup.
Require Export CoRN.model.semigroups.Qsemigroup.
Require Export CoRN.model.semigroups.Nsemigroup.
Require Export CoRN.model.semigroups.CRsemigroup.
Require Export CoRN.model.semigroups.Zsemigroup.
Require Export CoRN.model.semigroups.Npossemigroup.
Require Export CoRN.model.ordfields.Qordfield.
Require Export CoRN.model.ordfields.CRordfield.
Require Export CoRN.model.structures.NNUpperR.
Require Export CoRN.model.structures.QposInf.
Require Export CoRN.model.structures.Npossec.
Require Export CoRN.model.structures.Qpossec.
Require Export CoRN.model.structures.StepQsec.
Require Export CoRN.model.structures.QnnInf.
Require Export CoRN.model.structures.Qinf.
Require Export CoRN.model.structures.Qsec.
Require Export CoRN.model.structures.OpenUnit.
Require Export CoRN.model.structures.Nsec.
Require Export CoRN.model.structures.QnonNeg.
Require Export CoRN.model.structures.Zsec.
Require Export CoRN.model.partialorder.CRpartialorder.
Require Export CoRN.model.groups.Qposgroup.
Require Export CoRN.model.groups.CRgroup.
Require Export CoRN.model.groups.Qgroup.
Require Export CoRN.model.groups.QSposgroup.
Require Export CoRN.model.groups.Zgroup.
Require Export CoRN.model.setoids.CRsetoid.
Require Export CoRN.model.setoids.decsetoid.
Require Export CoRN.model.setoids.Nfinsetoid.
Require Export CoRN.model.setoids.Zsetoid.
Require Export CoRN.model.setoids.Qsetoid.
Require Export CoRN.model.setoids.Nsetoid.
Require Export CoRN.model.setoids.Npossetoid.
Require Export CoRN.model.setoids.Zfinsetoid.
Require Export CoRN.model.setoids.Qpossetoid.
Require Export CoRN.model.reals.Cauchy_IR.
Require Export CoRN.model.reals.CRreal.
Require Export CoRN.model.totalorder.ZMinMax.
Require Export CoRN.model.totalorder.QposMinMax.
Require Export CoRN.model.totalorder.QMinMax.
Require Export CoRN.model.abgroups.QSposabgroup.
Require Export CoRN.model.abgroups.Zabgroup.
Require Export CoRN.model.abgroups.Qposabgroup.
Require Export CoRN.model.abgroups.CRabgroup.
Require Export CoRN.model.abgroups.Qabgroup.
Require Export CoRN.model.rings.Qring.
Require Export CoRN.model.rings.CRring.
Require Export CoRN.model.rings.Zring.
Require Export CoRN.metrics.IR_CPMSpace.
Require Export CoRN.metrics.ContFunctions.
Require Export CoRN.metrics.Equiv.
Require Export CoRN.metrics.CPseudoMSpaces.
Require Export CoRN.metrics.CMetricSpaces.
Require Export CoRN.metrics.LipExt.
Require Export CoRN.metrics.Prod_Sub.
Require Export CoRN.metrics.CPMSTheory.
Require Export CoRN.logic.CornBasics.
Require Export CoRN.logic.Classic.
Require Export CoRN.logic.CLogic.
Require Export CoRN.logic.PropDecid.
Require Export CoRN.logic.Stability.
Require Export CoRN.ftc.MoreIntervals.
Require Export CoRN.ftc.RefSeparating.
Require Export CoRN.ftc.FunctSequence.
Require Export CoRN.ftc.RefSepRef.
Require Export CoRN.ftc.Integral.
Require Export CoRN.ftc.Composition.
Require Export CoRN.ftc.IntervalFunct.
Require Export CoRN.ftc.FTC.
Require Export CoRN.ftc.PartFunEquality.
Require Export CoRN.ftc.Taylor.
Require Export CoRN.ftc.WeakIVT.
Require Export CoRN.ftc.FunctSums.
Require Export CoRN.ftc.StrongIVT.
Require Export CoRN.ftc.PartInterval.
Require Export CoRN.ftc.Derivative.
Require Export CoRN.ftc.CalculusTheorems.
Require Export CoRN.ftc.IntegrationRules.
Require Export CoRN.ftc.MoreIntegrals.
Require Export CoRN.ftc.DerivativeOps.
Require Export CoRN.ftc.RefLemma.
Require Export CoRN.ftc.NthDerivative.
Require Export CoRN.ftc.Continuity.
Require Export CoRN.ftc.RefSeparated.
Require Export CoRN.ftc.COrdLemmas.
Require Export CoRN.ftc.MoreFunctions.
Require Export CoRN.ftc.Partitions.
Require Export CoRN.ftc.Differentiability.
Require Export CoRN.ftc.MoreFunSeries.
Require Export CoRN.ftc.Rolle.
Require Export CoRN.ftc.FunctSeries.
Require Export CoRN.ftc.TaylorLemma.
Require Export CoRN.fta.MainLemma.
Require Export CoRN.fta.CPoly_Shift.
Require Export CoRN.fta.FTA.
Require Export CoRN.fta.KeyLemma.
Require Export CoRN.fta.CPoly_Rev.
Require Export CoRN.fta.FTAreg.
Require Export CoRN.fta.CC_Props.
Require Export CoRN.fta.CPoly_Contin1.
Require Export CoRN.fta.KneserLemma.
Require Export CoRN.coq_reals.Rreals.
Require Export CoRN.coq_reals.Rreals_iso.
Require Export CoRN.coq_reals.Rsign.
Require Export CoRN.complex.NRootCC.
Require Export CoRN.complex.CComplex.
Require Export CoRN.complex.Complex_Exponential.
Require Export CoRN.complex.AbsCC.
Require Export CoRN.algebra.CSemiGroups.
Require Export CoRN.algebra.CPolynomials.
Require Export CoRN.algebra.CRings.
Require Export CoRN.algebra.CRing_as_Ring.
Require Export CoRN.algebra.Bernstein.
Require Export CoRN.algebra.CSums.
Require Export CoRN.algebra.CPoly_ApZero.
Require Export CoRN.algebra.CornScope.
Require Export CoRN.algebra.COrdAbs.
Require Export CoRN.algebra.CAbGroups.
Require Export CoRN.algebra.CAbMonoids.
Require Export CoRN.algebra.RSetoid.
Require Export CoRN.algebra.COrdFields2.
Require Export CoRN.algebra.OperationClasses.
Require Export CoRN.algebra.Expon.
Require Export CoRN.algebra.Cauchy_COF.
Require Export CoRN.algebra.CGroups.
Require Export CoRN.algebra.CSetoidInc.
Require Export CoRN.algebra.CRing_Homomorphisms.
Require Export CoRN.algebra.CSetoids.
Require Export CoRN.algebra.COrdCauchy.
Require Export CoRN.algebra.COrdFields.
Require Export CoRN.algebra.CPoly_NthCoeff.
Require Export CoRN.algebra.CPoly_Degree.
Require Export CoRN.algebra.CFields.
Require Export CoRN.algebra.CMonoids.
Require Export CoRN.algebra.CSetoidFun.
Require Export MathClasses.misc.setoid_tactics.
Require Export MathClasses.misc.workarounds.
Require Export MathClasses.misc.stdlib_hints.
Require Export MathClasses.misc.propholds.
Require Export MathClasses.misc.workaround_tactics.
Require Export MathClasses.misc.decision.
Require Export MathClasses.misc.JMrelation.
Require Export MathClasses.misc.util.
Require Export MathClasses.functors.constant.
Require Export MathClasses.interfaces.finite_sets.
Require Export MathClasses.interfaces.rationals.
Require Export MathClasses.interfaces.abstract_algebra.
Require Export MathClasses.interfaces.monads.
Require Export MathClasses.interfaces.canonical_names.
Require Export MathClasses.interfaces.integers.
Require Export MathClasses.interfaces.universal_algebra.
Require Export MathClasses.interfaces.ua_basic.
Require Export MathClasses.interfaces.additional_operations.
Require Export MathClasses.interfaces.sequences.
Require Export MathClasses.interfaces.orders.
Require Export MathClasses.interfaces.vectorspace.
Require Export MathClasses.interfaces.functors.
Require Export MathClasses.interfaces.naturals.
Require Export MathClasses.theory.categories.
Require Export MathClasses.theory.ua_subalgebraT.
Require Export MathClasses.theory.cut_minus.
Require Export MathClasses.theory.ua_packed.
Require Export MathClasses.theory.quote_monoid.
Require Export MathClasses.theory.ua_transference.
Require Export MathClasses.theory.fields.
Require Export MathClasses.theory.rationals.
Require Export MathClasses.theory.strong_setoids.
Require Export MathClasses.theory.ua_subalgebra.
Require Export MathClasses.theory.dec_fields.
Require Export MathClasses.theory.forget_variety.
Require Export MathClasses.theory.monoid_normalization.
Require Export MathClasses.theory.series.
Require Export MathClasses.theory.int_to_nat.
Require Export MathClasses.theory.abs.
Require Export MathClasses.theory.shiftl.
Require Export MathClasses.theory.integers.
Require Export MathClasses.theory.int_pow.
Require Export MathClasses.theory.rings.
Require Export MathClasses.theory.ua_subvariety.
Require Export MathClasses.theory.jections.
Require Export MathClasses.theory.ua_congruence.
Require Export MathClasses.theory.ring_congruence.
Require Export MathClasses.theory.int_abs.
Require Export MathClasses.theory.ua_homomorphisms.
Require Export MathClasses.theory.sequences.
Require Export MathClasses.theory.ring_ideals.
Require Export MathClasses.theory.nat_pow.
Require Export MathClasses.theory.products.
Require Export MathClasses.theory.forget_algebra.
Require Export MathClasses.theory.nat_distance.
Require Export MathClasses.theory.lattices.
Require Export MathClasses.theory.ua_products.
Require Export MathClasses.theory.ua_mapped_operations.
Require Export MathClasses.theory.groups.
Require Export MathClasses.theory.functors.
Require Export MathClasses.theory.streams.
Require Export MathClasses.theory.naturals.
Require Export MathClasses.implementations.ne_list.
Require Export MathClasses.implementations.nonneg_integers_naturals.
Require Export MathClasses.implementations.ZType_integers.
Require Export MathClasses.implementations.intfrac_rationals.
Require Export MathClasses.implementations.nonneg_semiring_elements.
Require Export MathClasses.implementations.positive_semiring_elements.
Require Export MathClasses.implementations.QType_rationals.
Require Export MathClasses.implementations.stdlib_rationals.
Require Export MathClasses.implementations.fast_rationals.
Require Export MathClasses.implementations.stdlib_binary_integers.
Require Export MathClasses.implementations.peano_naturals.
Require Export MathClasses.implementations.fast_naturals.
Require Export MathClasses.implementations.fast_integers.
Require Export MathClasses.implementations.dyadics.
Require Export MathClasses.implementations.stdlib_binary_naturals.
Require Export MathClasses.implementations.bool.
Require Export MathClasses.implementations.natpair_integers.
Require Export MathClasses.implementations.polynomials.
Require Export MathClasses.implementations.NType_naturals.
Require Export MathClasses.implementations.semiring_pairs.
Require Export MathClasses.implementations.field_of_fractions.
Require Export MathClasses.implementations.nonzero_field_elements.
Require Export MathClasses.quote.classquote.
Require Export MathClasses.categories.dual.
Require Export MathClasses.categories.categories.
Require Export MathClasses.categories.setoids.
Require Export MathClasses.categories.empty.
Require Export MathClasses.categories.algebras.
Require Export MathClasses.categories.unit.
Require Export MathClasses.categories.varieties.
Require Export MathClasses.categories.JMcat.
Require Export MathClasses.categories.orders.
Require Export MathClasses.categories.product.
Require Export MathClasses.categories.functors.
Require Export MathClasses.orders.minmax.
Require Export MathClasses.orders.rationals.
Require Export MathClasses.orders.dec_fields.
Require Export MathClasses.orders.integers.
Require Export MathClasses.orders.rings.
Require Export MathClasses.orders.maps.
Require Export MathClasses.orders.nat_int.
Require Export MathClasses.orders.semirings.
Require Export MathClasses.orders.orders.
Require Export MathClasses.orders.lattices.
Require Export MathClasses.orders.naturals.
Require Export MathClasses.varieties.setoids.
Require Export MathClasses.varieties.empty.
Require Export MathClasses.varieties.closed_terms.
Require Export MathClasses.varieties.rings.
Require Export MathClasses.varieties.abgroup.
Require Export MathClasses.varieties.semirings.
Require Export MathClasses.varieties.open_terms.
Require Export MathClasses.varieties.semigroups.
Require Export MathClasses.varieties.groups.
Require Export MathClasses.varieties.monoids.