(* -*- coding: utf-8 -*- *)
(************************************************************************)
(*         *      The Rocq Prover / The Rocq Development Team           *)
(*  v      *         Copyright INRIA, CNRS and contributors             *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)
Require Export BinNums.
Equalities Orders OrdersFacts GenericMinMax PeanoNat.
Require Export BinPosDef.
(**********************************************************************)
(** * Binary positive numbers, operations and properties *)
(**********************************************************************)
(** Initial development by Pierre Crégut, CNET, Lannion, France *)
(** The type [positive] and its constructors [xI] and [xO] and [xH] are now defined in [BinNums.v] *)
Local Open Scope positive_scope.
(** Every definitions and early properties about positive numbers are placed in a module [Pos] for qualification purpose. *)
Module Pos
<: UsualOrderedTypeFull
<: UsualDecidableTypeFull
<: TotalOrder.
(** * Definitions of operations, now in a separate file *)
Include BinPosDef.Pos.
(** In functor applications that follow, we only inline t and eq *)
Set Inline Level 30.
(** * Logical Predicates *)
Definition eq := @Logic.eq positive.
Definition eq_equiv := @eq_equivalence positive.
Include BackportEq.
Definition lt x y := (x ?= y) = Lt.
Definition gt x y := (x ?= y) = Gt.
Definition le x y := (x ?= y) <> Gt.
Definition ge x y := (x ?= y) <> Lt.
Infix "<=" := le : positive_scope.
Infix "<" := lt : positive_scope.
Infix ">=" := ge : positive_scope.
Infix ">" := gt : positive_scope.
Notation "x <= y <= z" := (x <= y /\ y <= z) : positive_scope.
Notation "x <= y < z" := (x <= y /\ y < z) : positive_scope.
Notation "x < y < z" := (x < y /\ y < z) : positive_scope.
Notation "x < y <= z" := (x < y /\ y <= z) : positive_scope.
(**********************************************************************)
(** * Properties of operations over positive numbers *)
(** ** Decidability of equality on binary positive numbers *)

(* Specifications: *)
Lemma eq_dec : forall x y:positive, {x = y} + {x <> y}.
Lemma succ_discr p : p <> succ p.
(** ** Successor and double *)
Lemma pred_double_spec p : pred_double p = pred (p~0).
Lemma succ_pred_double p : succ (pred_double p) = p~0.
Lemma pred_double_succ p : pred_double (succ p) = p~1.
Lemma double_succ p : (succ p)~0 = succ (succ p~0).
Lemma pred_double_xO_discr p : pred_double p <> p~0.
(** ** Successor and predecessor *)
Lemma succ_not_1 p : succ p <> 1.
Lemma pred_succ p : pred (succ p) = p.
Lemma succ_pred_or p : p = 1 \/ succ (pred p) = p.
Lemma succ_pred p : p <> 1 -> succ (pred p) = p.
(** ** Injectivity of successor *)
Lemma succ_inj p q : succ p = succ q -> p = q.
(** ** Predecessor to [N] *)
Lemma pred_N_succ p : pred_N (succ p) = Npos p.
(**********************************************************************)
(** * Properties of addition on binary positive numbers *)
(** ** Specification of [succ] in term of [add] *)
Lemma add_1_r p : p + 1 = succ p.
Lemma add_1_l p : 1 + p = succ p.
(** ** Specification of [add_carry] *)
Theorem add_carry_spec p q : add_carry p q = succ (p + q).
(** ** Commutativity *)
Theorem add_comm p q : p + q = q + p.
(** ** Permutation of [add] and [succ] *)
Theorem add_succ_r p q : p + succ q = succ (p + q).
Theorem add_succ_l p q : succ p + q = succ (p + q).
(** ** No neutral elements for addition *)
Lemma add_no_neutral p q : q + p <> p.
(** ** Simplification *)
Lemma add_carry_add p q r s :
add_carry p r = add_carry q s -> p + r = q + s.
Lemma add_reg_r p q r : p + r = q + r -> p = q.
Lemma add_reg_l p q r : p + q = p + r -> q = r.
Lemma add_cancel_r p q r : p + r = q + r <-> p = q.
Lemma add_cancel_l p q r : r + p = r + q <-> p = q.
Lemma add_carry_reg_r p q r :
add_carry p r = add_carry q r -> p = q.
Lemma add_carry_reg_l p q r :
add_carry p q = add_carry p r -> q = r.