From Undecidability Require Export ArithPrelim. (* [nia] etc. *)
From Coq Require Export BinPos.
(* Compute 42. (* default number notation is still for [nat] *) *)
Local Open Scope positive_scope.
(* Local Set Printing All. *)
(* Compute 42 % positive. *)
(* Compute 42 : positive. *)
(* Local Unset Printing All. *)
(* Big binary numbers are not a problem for Coq *)
(* Compute (42 ^ 42) % positive. *)
(* Number of bits required to represent this big number *)
(* Compute Pos.size_nat (42 ^ 42). *)
(* ** General definitions and lemmas on binary numbers *)
(* Append a lower-order bit *)
Definition append_bit (p : positive) (b : bool) := if b then p~1 else p~0.
Notation "p ~~ b" := (append_bit p b) (at level 7, left associativity, format "p '~~' b") : positive_scope.
Definition bitToSigPos (b : bool) : sigPos := if b then sigPos_xI else sigPos_xO.
Definition bitToSigPos' (b : bool) : sigPos^+ := inr (bitToSigPos b).
(* [bits_to_pos] Computes the [positive] that is represented by the bitstring [true :: bits], where [true] is the HSB *)
Fixpoint bits_to_pos' (bits : list bool) : positive :=
match bits with
| nil => 1
| b :: bits' => (bits_to_pos' bits') ~~ b
end.
Definition bits_to_pos (bits : list bool) := bits_to_pos' (rev bits).
(* Compute bits_to_pos [false; true; false; true; false]. (* 42 *) *)
(* Compute bits_to_pos [false; true; false; true; true]. (* 43 -> last bit is LSB *) *)
intros.
rewrite pos_to_bits_append_bits. now rewrite bits_to_pos_to_bits.
Qed.
(* We should have enough lemmas for [bits_to_pos] now. *)
Arguments bits_to_pos : simpl never.
Fixpoint pushHSB (p : positive) (b : bool) : positive :=
match p with
| p' ~ 1 => (pushHSB p' b) ~ 1
| p' ~ 0 => (pushHSB p' b) ~ 0
| 1 => 1 ~~ b
end.
(* Compute pushHSB 42 true. (* 42 + 64 = 106 *) *)
(* Compute pushHSB 42 false. (* 42 + 64 - 32 = 74 *) *)
(* Shifting bits left and right *)
Fixpoint shift_left (p : positive) (n : nat) :=
match n with
| O => p
| S n' => shift_left (p~0) n'
end.
Definition removeLSB (p : positive) : positive :=
match p with
| 1 => 1
| p~0 => p
| p~1 => p
end.
Fixpoint shift_right (p : positive) (n : nat) :=
match n with
| O => p
| S n' => shift_right (removeLSB p) n'
end.
(* Number of non-HSB bits *)
Fixpoint pos_size (p : positive) : nat :=
match p with
| 1 => 0
| p~1 => S (pos_size p)
| p~0 => S (pos_size p)
end.

(* Note that this doesn't hold for [<=] *)
Lemma pos_size_lt (p1 p2 : positive) :
(pos_size p1 < pos_size p2) % nat ->
p1 < p2.