(**
Here we define the signature for the integers modulo 2.

These are defined as the following HIT:
HIT mod2 :=
| 0 : mod2
| S : mod2 → mod2
| mod : ∏ (n : mod2), S(S n) = n
| ap_mod : ∏ (n : mod2), ap S (mod n) = mod (S n)
We study the 1-truncation.
 *)
Require Import UniMath.Foundations.All.
Require Import UniMath.MoreFoundations.All.

Require Import UniMath.CategoryTheory.Core.Categories.
Require Import UniMath.Bicategories.Core.Bicat.
Require Import UniMath.Bicategories.Core.Examples.OneTypes.

Require Import prelude.all.
Require Import signature.hit_signature.
Require Import signature.hit.
Require Import algebra.one_types_polynomials.
Require Import algebra.one_types_endpoints.
Require Import algebra.one_types_homotopies.
Require Import displayed_algebras.displayed_algebra.
Require Import displayed_algebras.globe_over_lem.

Local Open Scope cat.

Definition mod2_point_constr
  : poly_code
  := C unit_one_type + I.

Definition mod2_paths : UU := unit.

Definition mod2_paths_args (j : mod2_paths) : poly_code := I.

Definition zero_e
           (P : poly_code)
  : endpoint mod2_point_constr P I
  := comp
       (comp
          (c P (tt : unit_one_type))
          (ι₁ _ _))
       constr.

Definition suc_e
           {P : poly_code}
           (e : endpoint mod2_point_constr P I)
  : endpoint mod2_point_constr P I
  := comp e (comp (ι₂ _ _) constr).

Definition mod2_paths_lhs
           (i : mod2_paths)
  : endpoint mod2_point_constr (mod2_paths_args i) I
  := suc_e (suc_e (id_e _ _)).

Definition mod2_paths_rhs
           (i : mod2_paths)
  : endpoint mod2_point_constr (mod2_paths_args i) I
  := id_e _ _.

Definition mod2_homots : UU := unit.

Definition mod2_homots_point_arg
           (i : mod2_homots)
  : poly_code
  := I.

Definition mod2_homots_point_left_endpoint
           (i : mod2_homots)
  : endpoint mod2_point_constr (mod2_homots_point_arg i) I
  := suc_e (suc_e (suc_e (id_e _ _))).

Definition mod2_homots_point_right_endpoint
           (i : mod2_homots)
  : endpoint mod2_point_constr (mod2_homots_point_arg i) I
  := suc_e (id_e _ _).

Definition mod2_e
           {i : mod2_homots}
           (e : endpoint mod2_point_constr (mod2_homots_point_arg i) I)
  : homot_endpoint
      mod2_paths_lhs
      mod2_paths_rhs
      (c (mod2_homots_point_arg i) (tt : unit_one_type))
      (c (mod2_homots_point_arg i) (tt : unit_one_type))
      (suc_e (suc_e e))
      e
  := trans_e
       (ap_e
          _
          (trans_e
             (ap_e
                _
                (inv_e (comp_id_r _)))
             (inv_e (comp_assoc _ _ _))))
       (trans_e
          (inv_e (comp_assoc _ _ _))
          (trans_e
             (path_constr tt _)
             (comp_id_r _))).

Definition ap_suc_e
           {i : mod2_homots}
           {e₁ e₂ : endpoint mod2_point_constr (mod2_homots_point_arg i) I}
           (h : homot_endpoint
                  mod2_paths_lhs
                  mod2_paths_rhs
                  (c (mod2_homots_point_arg i) (tt : unit_one_type))
                  (c (mod2_homots_point_arg i) (tt : unit_one_type))
                  e₁
                  e₂)
  : homot_endpoint
      mod2_paths_lhs
      mod2_paths_rhs
      (c (mod2_homots_point_arg i) (tt : unit_one_type))
      (c (mod2_homots_point_arg i) (tt : unit_one_type))
      (suc_e e₁)
      (suc_e e₂)
  := trans_e
       (comp_assoc _ _ _)
       (trans_e
          (ap_e _ (ap_e _ h))
          (inv_e (comp_assoc _ _ _))).

Definition mod2_homots_point_rhs
           (i : mod2_homots)
  : homot_endpoint
      mod2_paths_lhs
      mod2_paths_rhs
      (c (mod2_homots_point_arg i) (tt : unit_one_type))
      (c (mod2_homots_point_arg i) (tt : unit_one_type))
      (mod2_homots_point_left_endpoint i)
      (mod2_homots_point_right_endpoint i)
  := ap_suc_e
       (trans_e
          (inv_e (comp_id_l _))
          (trans_e
             (path_constr tt _)
             (comp_id_l _))).

Definition mod2_homots_point_lhs
           (i : mod2_homots)
  : homot_endpoint
      mod2_paths_lhs
      mod2_paths_rhs
      (c (mod2_homots_point_arg i) (tt : unit_one_type))
      (c (mod2_homots_point_arg i) (tt : unit_one_type))
      (suc_e (suc_e (suc_e (id_e _ _))))
      (suc_e (id_e _ _))
  := mod2_e (suc_e (id_e _ _)).

Definition mod2_signature
  : hit_signature.
Proof.
  simple refine (_ ,, _ ,, _ ,, _ ,, _ ,, _ ,, _ ,, _ ,, _ ,, _  ,, _ ,, _ ,, _ ,, _).
  - exact mod2_point_constr.
  - exact mod2_paths.
  - exact mod2_paths_args.
  - exact mod2_paths_lhs.
  - exact mod2_paths_rhs.
  - exact mod2_homots.
  - exact mod2_homots_point_arg.
  - exact (λ _, C unit_one_type).
  - exact (λ _, @c _ _ unit_one_type tt).
  - exact (λ _, @c _ _ unit_one_type tt).
  - exact mod2_homots_point_left_endpoint.
  - exact mod2_homots_point_right_endpoint.
  - exact mod2_homots_point_lhs.
  - exact mod2_homots_point_rhs.
Defined.

Section Mod2AlgebraProjections.
  Variable (X : hit_algebra_one_types mod2_signature).

  Definition mod2_carrier
    : one_type
    := pr111 X.

  Definition mod2_Z
    : mod2_carrier
    := pr211 X (inl tt).

  Definition mod2_S
    : mod2_carrier → mod2_carrier
    := λ x, pr211 X (inr x).

  Definition mod2_mod
    : ∏ (x : mod2_carrier), mod2_S (mod2_S x) = x
    := pr21 X tt.

  Definition mod2_ap_mod
    : ∏ (n : mod2_carrier),
      maponpaths mod2_S (mod2_mod n)
      =
      mod2_mod (mod2_S n).
  Proof.
    intro n.
    refine (!(maponpathscomp inr (pr211 X) (mod2_mod n)) @_).
    refine (_@ pathscomp0rid _).
    refine (_@ !(pr2 X tt n (idpath _))).
    refine (_@ !(pathscomp0rid _)).
    rewrite pathscomp0rid.
    apply idpath.
  Defined.
End Mod2AlgebraProjections.

Section Mod2Induction.
  Context {X : hit_algebra_one_types mod2_signature}
          (Y : alg_carrier X → one_type)
          (YZ : Y (mod2_Z X))
          (YS : ∏ (n : alg_carrier X), Y n → Y (mod2_S X n))
          (Ymod : ∏ (n : alg_carrier X) (y : Y n),
                  @PathOver _ _ _ (mod2_mod X n) Y (YS _ (YS n y)) y)
          (Yap_mod : ∏ (n : alg_carrier X)
                       (nn : Y n),
                     globe_over
                       Y
                       (mod2_ap_mod X n)
                       (@apd_2 _ _ _ Y (mod2_S X) YS _ _ (mod2_mod X n) _ _ (Ymod n nn))
                       (Ymod (mod2_S X n) (YS n nn))).

  Local Definition cY
    : ∏ (x : poly_act (point_constr mod2_signature) (alg_carrier X)),
      poly_dact (point_constr mod2_signature) Y x → Y (alg_constr X x).
  Proof.
    intros x xx.
    induction x as [ | x].
    - induction a.
      exact YZ.
    - exact (YS x xx).
  Defined.

  Definition make_mod2_disp_algebra
    : disp_algebra X.
  Proof.
    use make_disp_algebra.
    - exact Y.
    - exact cY.
    - intros j x y.
      induction j.
      exact (Ymod x y).
    - abstract
        (intros j n nn p pp ;
         induction j ;
         refine (globe_over_move_globe_one_type _ _) ;
         [ apply (pr111 X)
         | refine (concat_globe_over
                     (globe_over_compose_left'
                        _
                        (globe_over_id_left _))
                     _) ;
           refine (concat_globe_over
                     (globe_over_compose_left'
                        _
                        (globe_over_id_right _))
                     _) ;
           refine (inv_globe_over _) ;
           refine (concat_globe_over
                     (globe_over_id_left _)
                     _) ;
           refine (concat_globe_over
                     (globe_over_id_right _)
                     _) ;
           refine (concat_globe_over
                     (apd2_comp dep_inr_fun _ _)
                     _) ;
           refine (concat_globe_over
                     (@apd2_globe_over
                        _ _ Y Y
                        _ YS
                        _ _ _ _ _ _ _ _ _
                        (concat_globe_over
                           (globe_over_id_left _)
                           (globe_over_id_right _)))
                     _) ;
           refine (concat_globe_over
                     (Yap_mod n nn)
                     _) ;
           refine (inv_globe_over _) ;
           apply globe_over_id_left]).
  Defined.

  Variable (HX : is_HIT mod2_signature X).

  (** Induction principle *)
  Definition mod2_ind_disp_algebra_map
    : disp_algebra_map make_mod2_disp_algebra
    := HX make_mod2_disp_algebra.

  Definition mod2_ind
    : ∏ (x : alg_carrier X), Y x
    := pr1 mod2_ind_disp_algebra_map.

  Definition mod2_ind_Z
    : mod2_ind (mod2_Z X) = YZ
    := pr12 mod2_ind_disp_algebra_map (inl tt).

  Definition mod2_ind_S
             (n : alg_carrier X)
    : mod2_ind (mod2_S X n) = YS n (mod2_ind n)
    := pr12 mod2_ind_disp_algebra_map (inr n).

  Definition mod2_ind_mod
             (n : alg_carrier X)
    : PathOver_square
        _
        (idpath _)
        (apd (pr1 mod2_ind_disp_algebra_map) (alg_path X tt n))
        (Ymod n (pr1 mod2_ind_disp_algebra_map n))
        (pr12 mod2_ind_disp_algebra_map
              (inr ((pr211 X) (inr n)))
         @ maponpaths
             (λ x : Y ((pr211 X) (inr n)), YS ((pr211 X) (inr n)) x)
             ((pr12 mod2_ind_disp_algebra_map) (inr n)))
        (idpath (pr1 mod2_ind_disp_algebra_map n)).
  Proof.
    pose (pr22 mod2_ind_disp_algebra_map tt n) as p.
    simpl in p.
    cbn in p.
    rewrite !pathscomp0rid in p.
    exact p.
  Qed.
End Mod2Induction.


Require Export P02.

(** **** Problem #3 : 2 stars (mult_S_1) *)
Theorem mult_S_1 : forall n m : nat,
  m = S n ->
  m * (1 + n) = m * m.
Proof.
  intros n m.
  intros K.
  rewrite -> K.
  reflexivity.
Qed.

(*-- Check --*)

Check mult_S_1 : forall n m : nat,
  m = S n ->
  m * (1 + n) = m * m.


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

 Displayed monoidal categories

 In this file, we define the notion of a displayed monoidal category. The style of
 the definition is similar to the definition of a monoidal category.

Note: after refactoring on March 10, 2023, the prior Git history of this development is found via
git log -- UniMath/CategoryTheory/Monoidal/DisplayedMonoidalWhiskered.v

 *********************************************************************************)
Require Import UniMath.Foundations.All.
Require Import UniMath.MoreFoundations.All.
Require Import UniMath.CategoryTheory.Core.Categories.
Require Import UniMath.CategoryTheory.Core.Functors.
Require Import UniMath.CategoryTheory.Core.Isos.
Require Import UniMath.CategoryTheory.Core.NaturalTransformations.
Require Import UniMath.CategoryTheory.Monoidal.WhiskeredBifunctors.
Require Import UniMath.CategoryTheory.Monoidal.Categories.
Require Import UniMath.CategoryTheory.Monoidal.Displayed.WhiskeredDisplayedBifunctors.
Require Import UniMath.CategoryTheory.DisplayedCats.Core.
Require Import UniMath.CategoryTheory.DisplayedCats.Functors.
Require Import UniMath.CategoryTheory.DisplayedCats.Constructions.
Require Import UniMath.CategoryTheory.DisplayedCats.Isos.
Require Import UniMath.CategoryTheory.DisplayedCats.NaturalTransformations.

Local Open Scope cat.
Local Open Scope mor_disp_scope.

Import MonoidalNotations.
Import DisplayedBifunctorNotations.

Section DisplayedMonoidalCategories.

  Definition disp_tensor
             {C : category}
             (D : disp_cat C)
             (M : monoidal C)
    : UU
    := disp_bifunctor M D D D.

  Identity Coercion disptensor_into_dispbifunctor : disp_tensor >-> disp_bifunctor.

  Definition disp_leftunitor_data
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DT : disp_tensor D M)
             (i : D I_{M})
    : UU
    := ∏ (x : C) (xx : D x), i ⊗⊗_{DT} xx -->[lu^{M}_{x}] xx.

  Definition disp_leftunitorinv_data
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DT : disp_tensor D M)
             (i : D I_{M})
    : UU
    := ∏ (x : C) (xx : D x), xx -->[luinv^{M}_{x}] i ⊗⊗_{DT} xx.

  Definition disp_rightunitor_data
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DT : disp_tensor D M)
             (i : D I_{M})
    : UU
    := ∏ (x : C) (xx : D x), xx ⊗⊗_{DT} i -->[ru^{M}_{x}] xx.

  Definition disp_rightunitorinv_data
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DT : disp_tensor D M)
             (i : D I_{M})
    : UU
    := ∏ (x : C) (xx : D x), xx -->[ruinv^{M}_{x}] xx ⊗⊗_{DT} i.

  Definition disp_associator_data
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DT : disp_tensor D M)
    : UU
    := ∏ (x y z : C) (xx : D x) (yy : D y) (zz : D z),
       (xx ⊗⊗_{DT} yy) ⊗⊗_{DT} zz
       -->[α^{M}_{x,y,z}]
       xx ⊗⊗_{DT} (yy ⊗⊗_{DT} zz).

  Definition disp_associatorinv_data
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DT : disp_tensor D M)
    : UU
    := ∏ (x y z : C) (xx : D x) (yy : D y) (zz : D z),
       xx ⊗⊗_{DT} (yy ⊗⊗_{DT} zz)
       -->[αinv_{M} x y z]
       (xx ⊗⊗_{DT} yy) ⊗⊗_{DT} zz.

  Definition disp_monoidal_data
             {C : category}
             (D : disp_cat C)
             (M : monoidal C)
    : UU
    := ∑ (DT : disp_tensor D M)
         (i : D I_{M}),
       (disp_leftunitor_data DT i)
       × (disp_leftunitorinv_data DT i)
       × (disp_rightunitor_data DT i)
       × (disp_rightunitorinv_data DT i)
       × (disp_associator_data DT)
       × (disp_associatorinv_data DT).

  Definition disp_monoidal_tensor
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DMD : disp_monoidal_data D M)
    : disp_tensor D M
    := pr1 DMD.

  Coercion disp_monoidal_tensor : disp_monoidal_data >-> disp_tensor.

  Definition disp_monoidal_unit
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DMD : disp_monoidal_data D M)
    : D I_{M}
    := pr12 DMD.

  Notation "dI_{ DMD }" := (disp_monoidal_unit DMD).

  Definition disp_monoidal_leftunitor
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DMD : disp_monoidal_data D M)
    : disp_leftunitor_data DMD dI_{DMD}
    := pr122 DMD.

  Notation "dlu_{ DMD }" := (disp_monoidal_leftunitor DMD).

  Definition disp_monoidal_leftunitorinv
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DMD : disp_monoidal_data D M)
    : disp_leftunitorinv_data DMD dI_{DMD}
    := pr1 (pr222 DMD).

  Notation "dluinv_{ DMD }" := (disp_monoidal_leftunitorinv DMD).

  Definition disp_monoidal_rightunitor
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DMD : disp_monoidal_data D M)
    : disp_rightunitor_data DMD dI_{DMD}
    := pr12 (pr222 DMD).

  Notation "dru_{ DMD }" := (disp_monoidal_rightunitor DMD).

  Definition disp_monoidal_rightunitorinv
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DMD : disp_monoidal_data D M)
    : disp_rightunitorinv_data DMD dI_{DMD}
    := pr122 (pr222 DMD).

  Notation "druinv_{ DMD }" := (disp_monoidal_rightunitorinv DMD).

  Definition disp_monoidal_associator
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DMD : disp_monoidal_data D M)
    : disp_associator_data DMD
    := pr1 (pr222 (pr222 DMD)).

  Notation "dα_{ DMD }" := (disp_monoidal_associator DMD).

  Definition disp_monoidal_associatorinv
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DMD : disp_monoidal_data D M)
    : disp_associatorinv_data DMD
    := pr2 (pr222 (pr222 DMD)).

  Notation "dαinv_{ DMD }" := (disp_monoidal_associatorinv DMD).

  (** PROPERTIES **)

  Definition disp_leftunitor_nat
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {i : D I_{M}}
             (dlu : disp_leftunitor_data DT i)
    : UU
    := ∏ (x y : C)
         (f : C⟦x,y⟧)
         (xx : D x) (yy : D y)
         (ff : xx -->[f] yy),
       (i ⊗⊗^{DT}_{l} ff) ;; (dlu y yy)
       =
       transportb
         _
         (pr1 (monoidal_leftunitorlaw M) _ _ _)
         (dlu x xx ;; ff).

  Definition disp_leftunitor_iso
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {i : D I_{M}}
             (dlu : disp_leftunitor_data DT i)
             (dluinv : disp_leftunitorinv_data DT i)
    : UU
    := ∏ (x : C) (xx : D x),
       is_disp_inverse
         (pr2 (monoidal_leftunitorlaw M) x)
         (dlu x xx)
         (dluinv x xx).

  Definition disp_leftunitor_law
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {i : D I_{M}}
             (dlu : disp_leftunitor_data DT i)
             (dluinv : disp_leftunitorinv_data DT i)
    : UU
    := disp_leftunitor_nat dlu × disp_leftunitor_iso dlu dluinv.

  Definition disp_leftunitorlaw_nat
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {i : D I_{M}}
             {dlu : disp_leftunitor_data DT i}
             {dluinv : disp_leftunitorinv_data DT i}
             (dlun : disp_leftunitor_law dlu dluinv)
    : disp_leftunitor_nat dlu
    := pr1 dlun.

  Definition disp_leftunitorlaw_iso
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {i : D I_{M}}
             {dlu : disp_leftunitor_data DT i}
             {dluinv : disp_leftunitorinv_data DT i}
             (dlui : disp_leftunitor_law dlu dluinv)
    : disp_leftunitor_iso dlu dluinv
    := pr2 dlui.

  Definition disp_rightunitor_nat
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {i : D I_{M}}
             (dru : disp_rightunitor_data DT i)
    : UU
    := ∏ (x y : C)
         (f : C⟦x,y⟧)
         (xx : D x) (yy : D y)
         (ff : xx -->[f] yy),
       (ff ⊗⊗^{DT}_{r} i) ;; (dru y yy)
       =
       transportb
         _
         (pr1 (monoidal_rightunitorlaw M) _ _ _)
         (dru x xx ;; ff).

  Definition disp_rightunitor_iso
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {i : D I_{M}}
             (dru : disp_rightunitor_data DT i)
             (druinv : disp_rightunitorinv_data DT i)
    : UU
    := ∏ (x : C) (xx : D x),
       is_disp_inverse
         (pr2 (monoidal_rightunitorlaw M) x)
         (dru x xx)
         (druinv x xx).

  Definition disp_rightunitor_law
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {i : D I_{M}}
             (dru : disp_rightunitor_data DT i)
             (druinv : disp_rightunitorinv_data DT i)
    : UU
    := disp_rightunitor_nat dru × disp_rightunitor_iso dru druinv.

  Definition disp_rightunitorlaw_nat
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {i : D I_{M}}
             {dru : disp_rightunitor_data DT i}
             {druinv : disp_rightunitorinv_data DT i}
             (drun : disp_rightunitor_law dru druinv)
    : disp_rightunitor_nat dru
    := pr1 drun.

  Definition disp_rightunitorlaw_iso
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {i : D I_{M}}
             {dru : disp_rightunitor_data DT i}
             {druinv : disp_rightunitorinv_data DT i}
             (drui : disp_rightunitor_law dru druinv)
    : disp_rightunitor_iso dru druinv
    := pr2 drui.

  Definition disp_associator_nat_leftwhisker
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             (dα : disp_associator_data DT)
    : UU
    := ∏ (x y z1 z2 : C)
         (h : C⟦z1,z2⟧)
         (xx : D x)
         (yy : D y)
         (zz1 : D z1)
         (zz2 : D z2)
         (hh : zz1-->[h] zz2),
       (dα _ _ _ xx yy zz1) ;; (xx ⊗⊗^{DT}_{l} (yy ⊗⊗^{DT}_{l} hh))
       =
       transportb
         _
         ((associatorlaw_natleft (monoidal_associatorlaw M)) x y z1 z2 h)
         (((xx ⊗⊗_{DT} yy) ⊗⊗^{DT}_{l} hh) ;; (dα _ _ _ xx yy zz2)).

  Definition disp_associator_nat_rightwhisker
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             (dα : disp_associator_data DT)
    : UU
    := ∏ (x1 x2 y z : C)
         (f : C⟦x1,x2⟧)
         (xx1 : D x1) (xx2 : D x2) (yy : D y) (zz : D z)
         (ff : xx1-->[f] xx2),
       (dα _ _ _ xx1 yy zz) ;; (ff ⊗⊗^{DT}_{r} (yy ⊗⊗_{DT} zz))
       =
       transportb
         _
         ((associatorlaw_natright (monoidal_associatorlaw M)) x1 x2 y z f)
         (((ff ⊗⊗^{DT}_{r} yy) ⊗⊗^{DT}_{r} zz) ;; (dα _ _ _ xx2 yy zz)).

  Definition disp_associator_nat_leftrightwhisker
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             (dα : disp_associator_data DT)
    : UU
    := ∏ (x y1 y2 z : C)
         (g : C⟦y1,y2⟧)
         (xx : D x) (yy1 : D y1) (yy2 : D y2) (zz : D z)
         (gg : yy1-->[g] yy2),
       (dα _ _ _ xx yy1 zz) ;; (xx ⊗⊗^{DT}_{l} (gg ⊗⊗^{DT}_{r} zz))
       =
       transportb
         _
         ((associatorlaw_natleftright (monoidal_associatorlaw M)) x y1 y2 z g)
         (((xx ⊗⊗^{DT}_{l} gg) ⊗⊗^{DT}_{r} zz) ;; (dα _ _ _ xx yy2 zz)).

  Definition disp_associator_nat'
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {dα : disp_associator_data DT}
             (dtl :  disp_associator_nat_leftwhisker dα)
             (dtr : disp_associator_nat_rightwhisker dα)
             (dtlr : disp_associator_nat_leftrightwhisker dα)
    : ∏ (x1 x2 y1 y2 z1 z2 : C)
        (xx1 : D x1) (xx2 : D x2)
        (yy1 : D y1) (yy2 : D y2)
        (zz1 : D z1) (zz2 : D z2)
        (f : C⟦x1,x2⟧)
        (g : C⟦y1,y2⟧)
        (h : C⟦z1,z2⟧)
        (ff : xx1-->[f] xx2)
        (gg : yy1 -->[g] yy2)
        (hh : zz1 -->[h] zz2),
       ((dα _ _ _ xx1 yy1 zz1) ;; (ff ⊗⊗^{DT} (gg ⊗⊗^{DT} hh)))
       =
       transportb
         _
         (associator_nat2
            M
            f g h)
         (((ff ⊗⊗^{DT} gg) ⊗⊗^{DT} hh) ;; dα _ _ _ xx2 yy2 zz2).
  Proof.
    intros.
    unfold dispfunctoronmorphisms1.
    etrans. { apply assoc_disp. }
    rewrite dtr.
    etrans. {
      apply maponpaths.
      apply mor_disp_transportf_postwhisker.
    }
    rewrite transport_b_f.
    apply transportf_transpose_left.
    etrans. { apply assoc_disp_var. }
    apply transportf_transpose_left.
    rewrite transport_b_b.
    rewrite transport_b_b.

    etrans. {
      apply maponpaths_1.
      apply maponpaths_1.
      apply disp_bifunctor_leftcomp.
    }
    etrans. {
      apply maponpaths.
      apply mor_disp_transportf_prewhisker.
    }
    etrans. {
      apply maponpaths_1.
      rewrite assoc_disp.
      rewrite dtlr.
      apply transport_f_b.
    }

    etrans. {
      apply maponpaths.
      apply maponpaths.
      apply mor_disp_transportf_postwhisker.
    }
    etrans. {
      apply maponpaths.
      apply transport_f_f.
    }
    etrans. { apply mor_disp_transportf_prewhisker. }
    apply transportf_transpose_left.

    etrans.
    {
      apply maponpaths_1.
      rewrite assoc_disp_var.
      apply maponpaths_1.
      apply maponpaths_1.
      apply dtl.
    }
    etrans. { apply mor_disp_transportf_prewhisker. }
    apply transportf_transpose_left.
    etrans. {
      apply maponpaths.
      apply mor_disp_transportf_prewhisker.
    }
    etrans. { apply mor_disp_transportf_prewhisker. }
    apply transportf_transpose_left.
    rewrite assoc_disp.
    etrans. {
      apply maponpaths.
      apply maponpaths_2.
      apply (pathsinv0
               (transportb_transpose_left
                  (disp_bifunctor_rightcomp DT _ _ _ _ _ _ _ _ _ _ _ _))).
    }
    rewrite transport_b_b.
    rewrite transport_b_b.
    rewrite transport_b_b.
    etrans. {
      apply maponpaths.
      apply mor_disp_transportf_postwhisker.
    }
    rewrite transport_b_f.
    apply transportf_transpose_left.
    rewrite transport_b_b.

    etrans. { apply assoc_disp. }
    apply transportb_transpose_left.

    use pathsinv0.
    rewrite transport_f_b.
    apply transportf_set.
    apply homset_property.
  Qed.

  Definition disp_associator_iso
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             (dα : disp_associator_data DT)
             (dαinv : disp_associatorinv_data DT)
    : UU
    := ∏ (x y z : C)
         (xx : D x)
         (yy : D y)
         (zz : D z),
       is_disp_inverse
         (pr222 (monoidal_associatorlaw M) x y z)
         (dα _ _ _ xx yy zz)
         (dαinv _ _ _ xx yy zz).

  Definition disp_associator_law
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             (dα : disp_associator_data DT)
             (dαinv : disp_associatorinv_data DT)
    : UU
    := (disp_associator_nat_leftwhisker dα)
       × (disp_associator_nat_rightwhisker dα)
       × (disp_associator_nat_leftrightwhisker dα)
       × (disp_associator_iso dα dαinv).

  Definition disp_associatorlaw_natleft
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {dα : disp_associator_data DT}
             {dαinv : disp_associatorinv_data DT}
             (dαl : disp_associator_law dα dαinv)
    : disp_associator_nat_leftwhisker dα
    := pr1 dαl.

  Definition disp_associatorlaw_natright
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {dα : disp_associator_data DT}
             {dαinv : disp_associatorinv_data DT}
             (dαl : disp_associator_law dα dαinv)
    : disp_associator_nat_rightwhisker dα
    := pr12 dαl.

  Definition disp_associatorlaw_natleftright
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {dα : disp_associator_data DT}
             {dαinv : disp_associatorinv_data DT}
             (dαl : disp_associator_law dα dαinv)
    : disp_associator_nat_leftrightwhisker dα
    := pr122 dαl.

  Definition disp_associatorlaw_iso
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {dα : disp_associator_data DT}
             {dαinv : disp_associatorinv_data DT}
             (dαl : disp_associator_law dα dαinv)
    : disp_associator_iso dα dαinv
    := pr222 dαl.

  Definition disp_triangle_identity
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             {i : D I_{M}}
             (dlu : disp_leftunitor_data DT i)
             (dru : disp_rightunitor_data DT i)
             (dα : disp_associator_data DT)
    : UU
    := ∏ (x y : C) (xx : D x) (yy : D y),
       ((dα x I_{M} y xx i yy) ;; (xx ⊗⊗^{DT}_{l} dlu y yy ))
       =
       transportb
         _
         ((monoidal_triangleidentity M) x y)
         ((dru x xx) ⊗⊗^{DT}_{r} yy).

  Definition disp_pentagon_identity
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             {DT : disp_tensor D M}
             (dα : disp_associator_data DT)
    : UU
    := ∏ (w x y z : C)
         (ww : D w)
         (xx : D x)
         (yy : D y)
         (zz : D z),
       ((dα _ _ _ ww xx yy) ⊗⊗^{DT}_{r} zz)
       ;; (dα _ _ _ ww (xx ⊗⊗_{DT} yy) zz)
       ;; (ww ⊗⊗^{DT}_{l} (dα _ _ _ xx yy zz))
       =
       transportb
         _
         ((monoidal_pentagonidentity M) w x y z)
         ((dα _ _ _ (ww ⊗⊗_{DT} xx) yy zz) ;; (dα _ _ _ ww xx (yy ⊗⊗_{DT} zz))).

  Definition disp_monoidal_laws
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DMD :  disp_monoidal_data D M)
    : UU
    := (disp_leftunitor_law dlu_{DMD} dluinv_{DMD})
       × (disp_rightunitor_law dru_{DMD} druinv_{DMD})
       × (disp_associator_law dα_{DMD} dαinv_{DMD})
       × (disp_triangle_identity dlu_{DMD} dru_{DMD} dα_{DMD})
       × (disp_pentagon_identity dα_{DMD}).

  Definition disp_monoidal
             {C : category}
             (D : disp_cat C)
             (M : monoidal C)
    : UU
    := ∑ (MD : disp_monoidal_data D M), (disp_monoidal_laws MD).

  Definition disp_monoidal_mondata
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_monoidal_data D M
    := pr1 DM.

  Coercion disp_monoidal_mondata : disp_monoidal >-> disp_monoidal_data.

  Definition disp_monoidal_monlaws
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_monoidal_laws DM
    := pr2 DM.

  Definition disp_monoidal_leftunitorlaw
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_leftunitor_law dlu_{DM} dluinv_{DM}
    := pr1 (disp_monoidal_monlaws DM).

  Definition disp_monoidal_leftunitornat
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_leftunitor_nat dlu_{DM}
    := disp_leftunitorlaw_nat (disp_monoidal_leftunitorlaw DM).

  Definition disp_monoidal_leftunitoriso
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_leftunitor_iso dlu_{DM} dluinv_{DM}
    := disp_leftunitorlaw_iso (disp_monoidal_leftunitorlaw DM).

  Definition disp_monoidal_rightunitorlaw
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_rightunitor_law dru_{DM} druinv_{DM}
    := pr12 (disp_monoidal_monlaws DM).

  Definition disp_monoidal_rightunitornat
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_rightunitor_nat dru_{DM}
    := disp_rightunitorlaw_nat (disp_monoidal_rightunitorlaw DM).

  Definition disp_monoidal_rightunitoriso
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_rightunitor_iso dru_{DM} druinv_{DM}
    := disp_rightunitorlaw_iso (disp_monoidal_rightunitorlaw DM).

  Definition disp_monoidal_associatorlaw
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_associator_law dα_{DM} dαinv_{DM}
    := pr122 (disp_monoidal_monlaws DM).

  Definition disp_monoidal_associatornatleft
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_associator_nat_leftwhisker dα_{DM}
    := disp_associatorlaw_natleft (disp_monoidal_associatorlaw DM).

  Definition disp_monoidal_associatornatright
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_associator_nat_rightwhisker dα_{DM}
    := disp_associatorlaw_natright (disp_monoidal_associatorlaw DM).

  Definition disp_monoidal_associatornatleftright
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_associator_nat_leftrightwhisker dα_{DM}
    := disp_associatorlaw_natleftright (disp_monoidal_associatorlaw DM).

  Definition disp_monoidal_associatoriso
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_associator_iso dα_{DM} dαinv_{DM}
    := disp_associatorlaw_iso (disp_monoidal_associatorlaw DM).

  Definition disp_monoidal_triangleidentity
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_triangle_identity dlu_{DM} dru_{DM} dα_{DM}
    := pr1 (pr222 (disp_monoidal_monlaws DM)).

  Definition disp_monoidal_pentagonidentity
             {C : category}
             {D : disp_cat C}
             {M : monoidal C}
             (DM : disp_monoidal D M)
    : disp_pentagon_identity dα_{DM}
    := pr2 (pr222 (disp_monoidal_monlaws DM)).

  Lemma isaprop_disp_monoidal_laws
        {C : category}
        {D : disp_cat C}
        {M : monoidal C}
        (DM : disp_monoidal_data D M)
    : isaprop (disp_monoidal_laws DM).
  Proof.
    repeat (apply isapropdirprod)
    ; repeat (apply impred ; intro)
    ; repeat (try apply D)
    ; repeat (apply isaprop_is_disp_inverse).
  Qed.
End DisplayedMonoidalCategories.

Module DisplayedMonoidalNotations.
  Notation "dI_{ M }" := (disp_monoidal_unit M).
  Notation "dlu^{ M }" := (disp_monoidal_leftunitor M).
  Notation "dru^{ M }" := (disp_monoidal_rightunitor M).
  Notation "dα^{ M }" := (disp_monoidal_associator M).

  Notation "dluinv^{ M }" := (disp_monoidal_leftunitorinv M).
  Notation "druinv^{ M }" := (disp_monoidal_rightunitorinv M).
  Notation "dαinv^{ M }" := (disp_monoidal_associatorinv M).

  Notation "dlu^{ M }_{ xx }" := (disp_monoidal_leftunitor M _ xx).
  Notation "dru^{ M }_{ xx }" := (disp_monoidal_rightunitor M _ xx).
  Notation "dα^{ M }_{ xx , yy , zz }" := (disp_monoidal_associator M _ _ _ xx yy zz).

  Notation "dluinv^{ M }_{ xx }" := (disp_monoidal_leftunitorinv M _ xx).
  Notation "druinv^{ M }_{ xx }" := (disp_monoidal_rightunitorinv M _ xx).
  Notation "dαinv^{ M }_{ xx , yy , zz }" := (disp_monoidal_associatorinv M _ _ _ xx yy zz).
End DisplayedMonoidalNotations.


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

Require Import ZArith_base.
Open Local Scope Z_scope.

(** Factorization lemmas *)

Theorem Zred_factor0 : forall n:Z, n = n * 1.
  intro x; rewrite (Zmult_1_r x); reflexivity.
Qed.

Theorem Zred_factor1 : forall n:Z, n + n = n * 2.
Proof.
  exact Zplus_diag_eq_mult_2.
Qed.

Theorem Zred_factor2 : forall n m:Z, n + n * m = n * (1 + m).
Proof.
  intros x y; pattern x at 1 in |- *; rewrite <- (Zmult_1_r x);
    rewrite <- Zmult_plus_distr_r; trivial with arith.
Qed.

Theorem Zred_factor3 : forall n m:Z, n * m + n = n * (1 + m).
Proof.
  intros x y; pattern x at 2 in |- *; rewrite <- (Zmult_1_r x);
    rewrite <- Zmult_plus_distr_r; rewrite Zplus_comm;
      trivial with arith.
Qed.

Theorem Zred_factor4 : forall n m p:Z, n * m + n * p = n * (m + p).
Proof.
  intros x y z; symmetry  in |- *; apply Zmult_plus_distr_r.
Qed.

Theorem Zred_factor5 : forall n m:Z, n * 0 + m = m.
Proof.
  intros x y; rewrite <- Zmult_0_r_reverse; auto with arith.
Qed.

Theorem Zred_factor6 : forall n:Z, n = n + 0.
Proof.
  intro; rewrite Zplus_0_r; trivial with arith.
Qed.

(** Other specific variants of theorems dedicated for the Omega tactic *)

Lemma new_var : forall x : Z, exists y : Z, x = y.
intros x; exists x; trivial with arith.
Qed.

Lemma OMEGA1 : forall x y : Z, x = y -> 0 <= x -> 0 <= y.
intros x y H; rewrite H; auto with arith.
Qed.

Lemma OMEGA2 : forall x y : Z, 0 <= x -> 0 <= y -> 0 <= x + y.
exact Zplus_le_0_compat.
Qed.

Lemma OMEGA3 : forall x y k : Z, k > 0 -> x = y * k -> x = 0 -> y = 0.

intros x y k H1 H2 H3; apply (Zmult_integral_l k);
 [ unfold not in |- *; intros H4; absurd (k > 0);
    [ rewrite H4; unfold Zgt in |- *; simpl in |- *; discriminate
    | assumption ]
 | rewrite <- H2; assumption ].
Qed.

Lemma OMEGA4 : forall x y z : Z, x > 0 -> y > x -> z * y + x <> 0.

unfold not in |- *; intros x y z H1 H2 H3; cut (y > 0);
 [ intros H4; cut (0 <= z * y + x);
    [ intros H5; generalize (Zmult_le_approx y z x H4 H2 H5); intros H6;
       absurd (z * y + x > 0);
       [ rewrite H3; unfold Zgt in |- *; simpl in |- *; discriminate
       | apply Zle_gt_trans with x;
          [ pattern x at 1 in |- *; rewrite <- (Zplus_0_l x);
             apply Zplus_le_compat_r; rewrite Zmult_comm;
             generalize H4; unfold Zgt in |- *; case y;
             [ simpl in |- *; intros H7; discriminate H7
             | intros p H7; rewrite <- (Zmult_0_r (Zpos p));
                unfold Zle in |- *; rewrite Zcompare_mult_compat;
                exact H6
             | simpl in |- *; intros p H7; discriminate H7 ]
          | assumption ] ]
    | rewrite H3; unfold Zle in |- *; simpl in |- *; discriminate ]
 | apply Zgt_trans with x; [ assumption | assumption ] ].
Qed.

Lemma OMEGA5 : forall x y z : Z, x = 0 -> y = 0 -> x + y * z = 0.

intros x y z H1 H2; rewrite H1; rewrite H2; simpl in |- *; trivial with arith.
Qed.

Lemma OMEGA6 : forall x y z : Z, 0 <= x -> y = 0 -> 0 <= x + y * z.

intros x y z H1 H2; rewrite H2; simpl in |- *; rewrite Zplus_0_r; assumption.
Qed.

Lemma OMEGA7 :
 forall x y z t : Z, z > 0 -> t > 0 -> 0 <= x -> 0 <= y -> 0 <= x * z + y * t.

intros x y z t H1 H2 H3 H4; rewrite <- (Zplus_0_l 0); apply Zplus_le_compat;
 apply Zmult_gt_0_le_0_compat; assumption.
Qed.

Lemma OMEGA8 : forall x y : Z, 0 <= x -> 0 <= y -> x = - y -> x = 0.

intros x y H1 H2 H3; elim (Zle_lt_or_eq 0 x H1);
 [ intros H4; absurd (0 < x);
    [ change (0 >= x) in |- *; apply Zle_ge; apply Zplus_le_reg_l with y;
       rewrite H3; rewrite Zplus_opp_r; rewrite Zplus_0_r;
       assumption
    | assumption ]
 | intros H4; rewrite H4; trivial with arith ].
Qed.

Lemma OMEGA9 : forall x y z t : Z, y = 0 -> x = z -> y + (- x + z) * t = 0.

intros x y z t H1 H2; rewrite H2; rewrite Zplus_opp_l; rewrite Zmult_0_l;
 rewrite Zplus_0_r; assumption.
Qed.

Lemma OMEGA10 :
 forall v c1 c2 l1 l2 k1 k2 : Z,
 (v * c1 + l1) * k1 + (v * c2 + l2) * k2 =
 v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2).

intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
 repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
 rewrite (Zplus_permute (l1 * k1) (v * c2 * k2)); trivial with arith.
Qed.

Lemma OMEGA11 :
 forall v1 c1 l1 l2 k1 : Z,
 (v1 * c1 + l1) * k1 + l2 = v1 * (c1 * k1) + (l1 * k1 + l2).

intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
 repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
 trivial with arith.
Qed.

Lemma OMEGA12 :
 forall v2 c2 l1 l2 k2 : Z,
 l1 + (v2 * c2 + l2) * k2 = v2 * (c2 * k2) + (l1 + l2 * k2).

intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
 repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
 rewrite Zplus_permute; trivial with arith.
Qed.

Lemma OMEGA13 :
 forall (v l1 l2 : Z) (x : positive),
 v * Zpos x + l1 + (v * Zneg x + l2) = l1 + l2.

intros; rewrite Zplus_assoc; rewrite (Zplus_comm (v * Zpos x) l1);
 rewrite (Zplus_assoc_reverse l1); rewrite <- Zmult_plus_distr_r;
 rewrite <- Zopp_neg; rewrite (Zplus_comm (- Zneg x) (Zneg x));
 rewrite Zplus_opp_r; rewrite Zmult_0_r; rewrite Zplus_0_r;
 trivial with arith.
Qed.

Lemma OMEGA14 :
 forall (v l1 l2 : Z) (x : positive),
 v * Zneg x + l1 + (v * Zpos x + l2) = l1 + l2.

intros; rewrite Zplus_assoc; rewrite (Zplus_comm (v * Zneg x) l1);
 rewrite (Zplus_assoc_reverse l1); rewrite <- Zmult_plus_distr_r;
 rewrite <- Zopp_neg; rewrite Zplus_opp_r; rewrite Zmult_0_r;
 rewrite Zplus_0_r; trivial with arith.
Qed.
Lemma OMEGA15 :
 forall v c1 c2 l1 l2 k2 : Z,
 v * c1 + l1 + (v * c2 + l2) * k2 = v * (c1 + c2 * k2) + (l1 + l2 * k2).

intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
 repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
 rewrite (Zplus_permute l1 (v * c2 * k2)); trivial with arith.
Qed.

Lemma OMEGA16 : forall v c l k : Z, (v * c + l) * k = v * (c * k) + l * k.

intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
 repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
 trivial with arith.
Qed.

Lemma OMEGA17 : forall x y z : Z, Zne x 0 -> y = 0 -> Zne (x + y * z) 0.

unfold Zne, not in |- *; intros x y z H1 H2 H3; apply H1;
 apply Zplus_reg_l with (y * z); rewrite Zplus_comm;
 rewrite H3; rewrite H2; auto with arith.
Qed.

Lemma OMEGA18 : forall x y k : Z, x = y * k -> Zne x 0 -> Zne y 0.

unfold Zne, not in |- *; intros x y k H1 H2 H3; apply H2; rewrite H1;
 rewrite H3; auto with arith.
Qed.

Lemma OMEGA19 : forall x : Z, Zne x 0 -> 0 <= x + -1 \/ 0 <= x * -1 + -1.

unfold Zne in |- *; intros x H; elim (Zle_or_lt 0 x);
 [ intros H1; elim Zle_lt_or_eq with (1 := H1);
    [ intros H2; left; change (0 <= Zpred x) in |- *; apply Zsucc_le_reg;
       rewrite <- Zsucc_pred; apply Zlt_le_succ; assumption
    | intros H2; absurd (x = 0); auto with arith ]
 | intros H1; right; rewrite <- Zopp_eq_mult_neg_1; rewrite Zplus_comm;
    apply Zle_left; apply Zsucc_le_reg; simpl in |- *;
    apply Zlt_le_succ; auto with arith ].
Qed.

Lemma OMEGA20 : forall x y z : Z, Zne x 0 -> y = 0 -> Zne (x + y * z) 0.

unfold Zne, not in |- *; intros x y z H1 H2 H3; apply H1; rewrite H2 in H3;
 simpl in H3; rewrite Zplus_0_r in H3; trivial with arith.
Qed.

Definition fast_Zplus_comm (x y : Z) (P : Z -> Prop)
  (H : P (y + x)) := eq_ind_r P H (Zplus_comm x y).

Definition fast_Zplus_assoc_reverse (n m p : Z) (P : Z -> Prop)
  (H : P (n + (m + p))) := eq_ind_r P H (Zplus_assoc_reverse n m p).

Definition fast_Zplus_assoc (n m p : Z) (P : Z -> Prop)
  (H : P (n + m + p)) := eq_ind_r P H (Zplus_assoc n m p).

Definition fast_Zplus_permute (n m p : Z) (P : Z -> Prop)
  (H : P (m + (n + p))) := eq_ind_r P H (Zplus_permute n m p).

Definition fast_OMEGA10 (v c1 c2 l1 l2 k1 k2 : Z) (P : Z -> Prop)
  (H : P (v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2))) :=
  eq_ind_r P H (OMEGA10 v c1 c2 l1 l2 k1 k2).

Definition fast_OMEGA11 (v1 c1 l1 l2 k1 : Z) (P : Z -> Prop)
  (H : P (v1 * (c1 * k1) + (l1 * k1 + l2))) :=
  eq_ind_r P H (OMEGA11 v1 c1 l1 l2 k1).
Definition fast_OMEGA12 (v2 c2 l1 l2 k2 : Z) (P : Z -> Prop)
  (H : P (v2 * (c2 * k2) + (l1 + l2 * k2))) :=
  eq_ind_r P H (OMEGA12 v2 c2 l1 l2 k2).

Definition fast_OMEGA15 (v c1 c2 l1 l2 k2 : Z) (P : Z -> Prop)
  (H : P (v * (c1 + c2 * k2) + (l1 + l2 * k2))) :=
  eq_ind_r P H (OMEGA15 v c1 c2 l1 l2 k2).
Definition fast_OMEGA16 (v c l k : Z) (P : Z -> Prop)
  (H : P (v * (c * k) + l * k)) := eq_ind_r P H (OMEGA16 v c l k).

Definition fast_OMEGA13 (v l1 l2 : Z) (x : positive) (P : Z -> Prop)
  (H : P (l1 + l2)) := eq_ind_r P H (OMEGA13 v l1 l2 x).

Definition fast_OMEGA14 (v l1 l2 : Z) (x : positive) (P : Z -> Prop)
  (H : P (l1 + l2)) := eq_ind_r P H (OMEGA14 v l1 l2 x).
Definition fast_Zred_factor0 (x : Z) (P : Z -> Prop)
  (H : P (x * 1)) := eq_ind_r P H (Zred_factor0 x).

Definition fast_Zopp_eq_mult_neg_1 (x : Z) (P : Z -> Prop)
  (H : P (x * -1)) := eq_ind_r P H (Zopp_eq_mult_neg_1 x).

Definition fast_Zmult_comm (x y : Z) (P : Z -> Prop)
  (H : P (y * x)) := eq_ind_r P H (Zmult_comm x y).

Definition fast_Zopp_plus_distr (x y : Z) (P : Z -> Prop)
  (H : P (- x + - y)) := eq_ind_r P H (Zopp_plus_distr x y).

Definition fast_Zopp_involutive (x : Z) (P : Z -> Prop) (H : P x) :=
  eq_ind_r P H (Zopp_involutive x).

Definition fast_Zopp_mult_distr_r (x y : Z) (P : Z -> Prop)
  (H : P (x * - y)) := eq_ind_r P H (Zopp_mult_distr_r x y).

Definition fast_Zmult_plus_distr_l (n m p : Z) (P : Z -> Prop)
  (H : P (n * p + m * p)) := eq_ind_r P H (Zmult_plus_distr_l n m p).
Definition fast_Zmult_opp_comm (x y : Z) (P : Z -> Prop)
  (H : P (x * - y)) := eq_ind_r P H (Zmult_opp_comm x y).

Definition fast_Zmult_assoc_reverse (n m p : Z) (P : Z -> Prop)
  (H : P (n * (m * p))) := eq_ind_r P H (Zmult_assoc_reverse n m p).

Definition fast_Zred_factor1 (x : Z) (P : Z -> Prop)
  (H : P (x * 2)) := eq_ind_r P H (Zred_factor1 x).

Definition fast_Zred_factor2 (x y : Z) (P : Z -> Prop)
  (H : P (x * (1 + y))) := eq_ind_r P H (Zred_factor2 x y).

Definition fast_Zred_factor3 (x y : Z) (P : Z -> Prop)
  (H : P (x * (1 + y))) := eq_ind_r P H (Zred_factor3 x y).

Definition fast_Zred_factor4 (x y z : Z) (P : Z -> Prop)
  (H : P (x * (y + z))) := eq_ind_r P H (Zred_factor4 x y z).

Definition fast_Zred_factor5 (x y : Z) (P : Z -> Prop)
  (H : P y) := eq_ind_r P H (Zred_factor5 x y).

Definition fast_Zred_factor6 (x : Z) (P : Z -> Prop)
  (H : P (x + 0)) := eq_ind_r P H (Zred_factor6 x).

Theorem intro_Z :
  forall n:nat,  exists y : Z, Z_of_nat n = y /\ 0 <= y * 1 + 0.
Proof.
  intros n; exists (Z_of_nat n); split; trivial.
  rewrite Zmult_1_r, Zplus_0_r. apply Zle_0_nat.
Qed.