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).

Lemma peano_equiv (P:positive->Type) (a:P 1) (f:forall p, P p -> P (succ p)) p :
PeanoView_iter P a f p (peanoView p) = peano_rect P a f p.