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 *)
(** ** Successor and double *)
(** ** Successor and predecessor *)
(** ** Injectivity of successor *)
(** ** Predecessor to [N] *)
(**********************************************************************)
(** * Properties of addition on binary positive numbers *)
(** ** Specification of [succ] in term of [add] *)
(** ** Specification of [add_carry] *)
(** ** Commutativity *)
(** ** Permutation of [add] and [succ] *)
(** ** Simplification *)
(** ** Addition is associative *)
(** ** Commutation of addition and double *)
(** ** Miscellaneous *)
(**********************************************************************)
(** * Peano induction and recursion on binary positive positive numbers *)
(** The Peano-like recursor function for [positive] (due to Daniel Schepler) *)
Fixpoint peano_rect (P:positive->Type) (a:P 1)
(f: forall p:positive, P p -> P (succ p)) (p:positive) : P p :=
let f2 := peano_rect (fun p:positive => P (p~0)) (f _ a)
(fun (p:positive) (x:P (p~0)) => f _ (f _ x))
in
match p with
| q~1 => f _ (f2 q)
| q~0 => f2 q
| 1 => a
end.
Definition peano_rec (P:positive->Set) := peano_rect P.
(** Peano induction *)
Definition peano_ind (P:positive->Prop) := peano_rect P.
(** Peano case analysis *)
(** Earlier, the Peano-like recursor was built and proved in a way due to Conor McBride, see "The view from the left" *)
Inductive PeanoView : positive -> Type :=
| PeanoOne : PeanoView 1
| PeanoSucc : forall p, PeanoView p -> PeanoView (succ p).
Fixpoint peanoView_xO p (q:PeanoView p) : PeanoView (p~0) :=
match q in PeanoView x return PeanoView (x~0) with
| PeanoOne => PeanoSucc _ PeanoOne
| PeanoSucc _ q => PeanoSucc _ (PeanoSucc _ (peanoView_xO _ q))
end.
Fixpoint peanoView_xI p (q:PeanoView p) : PeanoView (p~1) :=
match q in PeanoView x return PeanoView (x~1) with
| PeanoOne => PeanoSucc _ (PeanoSucc _ PeanoOne)
| PeanoSucc _ q => PeanoSucc _ (PeanoSucc _ (peanoView_xI _ q))
end.
Fixpoint peanoView p : PeanoView p :=
match p return PeanoView p with
| 1 => PeanoOne
| p~0 => peanoView_xO p (peanoView p)
| p~1 => peanoView_xI p (peanoView p)
end.
Definition PeanoView_iter (P:positive->Type)
(a:P 1) (f:forall p, P p -> P (succ p)) :=
(fix iter p (q:PeanoView p) : P p :=
match q in PeanoView p return P p with
| PeanoOne => a
| PeanoSucc _ q => f _ (iter _ q)
end).
(**********************************************************************)
(** * Properties of multiplication on binary positive numbers *)
(** ** One is neutral for multiplication *)
(** ** Right reduction properties for multiplication *)
(** ** Commutativity of multiplication *)
(** ** Distributivity of multiplication over addition *)
(** ** Associativity of multiplication *)
(** ** Successor and multiplication *)
(** ** Parity properties of multiplication *)
(** ** Simplification properties of multiplication *)
(** ** Inversion of multiplication *)
Notation mul_eq_1 := mul_eq_1_l.
(** ** Square *)
(** ** Properties of [iter] *)
(** ** Properties of power *)
(** ** Properties of square *)
(** ** Properties of [sub_mask] *)
Inductive SubMaskSpec (p q : positive) : mask -> Prop :=
| SubIsNul : p = q -> SubMaskSpec p q IsNul
| SubIsPos : forall r, q + r = p -> SubMaskSpec p q (IsPos r)
| SubIsNeg : forall r, p + r = q -> SubMaskSpec p q IsNeg.
(*********************************************************************)
(** * Properties of boolean comparisons *)
(** More about [eqb] *)
Include BoolEqualityFacts.
(**********************************************************************)
(** * Properties of comparison on binary positive numbers *)
(** First, we express [compare_cont] in term of [compare] *)
Definition switch_Eq c c' :=
match c' with
| Eq => c
| Lt => Lt
| Gt => Gt
end.
(** From this general result, we now describe particular cases of [compare_cont p q c = c'] : - When [c=Eq], this is directly [compare] - When [c<>Eq], we'll show first that [c'<>Eq] - That leaves only 4 lemmas for [c] and [c'] being [Lt] or [Gt] *)
(** We can express recursive equations for [compare] *)
(** Alternative characterisation of strict order in term of addition *)
(** Basic facts about [compare_cont] *)
(** Basic facts about [compare] *)
(** ** Comparison and the successor *)
(** ** 1 is the least positive number *)
(** ** Properties of the order *)
Instance lt_strorder : StrictOrder lt.
Instance le_preorder : PreOrder le.
(** ** Comparison and addition *)
(** ** Order and addition *)
(** ** Comparison and multiplication *)
(** ** Order and multiplication *)
(**********************************************************************)
(** * Properties of subtraction on binary positive numbers *)
(** ** Properties of subtraction without underflow *)
(** Recursive equations for [sub] *)
(** Properties of subtraction with underflow *)
(** ** Results concerning [size] and [size_nat] *)
(** ** Properties of [min] and [max] *)
(** First, the specification *)
(** We hence obtain all the generic properties of [min] and [max]. *)
Include UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties.
Ltac order := Private_Tac.order.
(** Minimum, maximum and constant one *)
(** ** Results concerning [iter_op] *)
(** ** Results about [of_nat] and [of_succ_nat] *)
(** ** Correctness proofs for the square root function *)
Inductive SqrtSpec : positive*mask -> positive -> Prop :=
| SqrtExact s x : x=s*s -> SqrtSpec (s,IsNul) x
| SqrtApprox s r x : x=s*s+r -> r <= s~0 -> SqrtSpec (s,IsPos r) x.
(** ** Correctness proofs for the gcd function *)
(** The first component of ggcd is gcd *)
(** The other components of ggcd are indeed the correct factors. *)
Ltac destr_pggcdn IHn :=
match goal with |- context [ ggcdn _ ?x ?y ] =>
generalize (IHn x y); destruct ggcdn as (g,(u,v)); simpl
end.
(** We can use this fact to prove a part of the gcd correctness *)
(** We now prove directly that gcd is the greatest amongst common divisors *)

Lemma gcdn_greatest : forall n a b, (size_nat a + size_nat b <= n)%nat ->
forall p, (p|a) -> (p|b) -> (p|gcdn n a b).