(* The type (register n) represents integers who can write with n binary
  digits, i.e integers beetween 0 and 2^n - 1. The least significative 
  digit is on top :
    (regS true (regS true (regS false regO))) is 011 (binary) or 3 
    (regS false (regS false (regS true regO))) is 100 (binary) or 4
*)

Inductive register : nat -> Set :=
  | regO : register 0
  | regS : forall m : nat, bool -> register m -> register (S m).(* The type (register n) represents integers who can write with n binary
  digits, i.e integers beetween 0 and 2^n - 1. The least significative 
  digit is on top :
    (regS true (regS true (regS false regO))) is 011 (binary) or 3 
    (regS false (regS false (regS true regO))) is 100 (binary) or 4
*)

Inductive register : nat -> Set :=
  | regO : register 0
  | regS : forall m : nat, bool -> register m -> register (S m).(* The type (register n) represents integers who can write with n binary
  digits, i.e integers beetween 0 and 2^n - 1. The least significative 
  digit is on top :
    (regS true (regS true (regS false regO))) is 011 (binary) or 3 
    (regS false (regS false (regS true regO))) is 100 (binary) or 4
*)

Inductive register : nat -> Set :=
  | regO : register 0
  | regS : forall m : nat, bool -> register m -> register (S m).(* 0 and max number represented by a register number *)

Definition register_zero :=
  nat_rec register regO (fun m : nat => regS m false).Definition register_max := nat_rec register regO (fun m : nat => regS m true).Fixpoint is_register_zero (n : nat) (x : register n) {struct x} : bool :=
  match x with
  | regO => true
  | regS m b y => if b then false else is_register_zero m y
  end.Definition is_register_max (n : nat) (x : register n) :=
  match x with
  | regO => true
  | regS m b y => if b then is_register_zero m y else false
  end.(*******
(* Decidable equality on registers *)
Fixpoint eq_register[n:nat; x:(register n); m:nat; y:(register m)] : bool :=
  Cases x y of
    regO regO => true
  | (regS n' bx x') (regS m' by y') => 
      (andb (eqb bx by) (eq_register n' x' m' y'))
  | _ _ => false
  end.
(* Egality of registers of same lenght *)
Definition eq_reg := [n:nat][x,y:(register n)](eq_register n x n y).

(* Alphabetic order on registers *)
Fixpoint lt_register[n:nat; x:(register n); m:nat; y:(register m)] : bool :=
  Cases x y of
    regO regO => false
  | (regS n' bx x') (regS m' by y') => 
      (orb (ifb bx false by) (lt_register n' x' m' y'))
  | regO (regS m' by y') => true
  | (regS n' bx x') regO => false
  end.
(* Order on registers of same lenght *)
Definition lt_reg := [n:nat][x,y:(register n)](lt_register n x n y).
********)

Fixpoint entier_of_register (n : nat) (x : register n) {struct x} : N :=
  match x with
  | regO => 0%N
  | regS m b y =>
      if b
      then Ndouble_plus_one (entier_of_register m y)
      else Ndouble (entier_of_register m y)
  end.Definition Z_of_register (n : nat) (x : register n) :=
  BinInt.Z_of_N (entier_of_register n x).(********
Lemma eq_register_correct : (n:nat)(x:(register n))(m:nat)(y:(register m))
  (eq_register n x m y)=(Case (%(Z_of_register n x) ?= (Z_of_register m y)) 
      	       	       	   of true false false end).
Lemma lt_register_correct : (n:nat)(x:(register n))(m:nat)(y:(register m))
  (lt_register n x m y)=(Case (%(Z_of_register n x) ?= (Z_of_register m y)) 
      	       	       	   of false true false end).
*********)

Definition sign_of (b : bool) := if b then 1%Z else (-1)%Z.(* This function only reads the n less significative bits of x, or
  all bits of x if x has less than n digits. *)
(* In normal use of this function, we've always x < 2^n or
  x = 2^n + y when y<2^n *)

Fixpoint register_of_pos (n : nat) (x : positive) {struct x} : 
 register n :=
  match n as x return (register x) with
  | O => regO
  | S m =>
      match x with
      | xH => regS m true (register_zero m)
      | xI y => regS m true (register_of_pos m y)
      | xO y => regS m false (register_of_pos m y)
      end
  end.Definition register_of_entier (n : nat) (x : N) :=
  match x return (register n) with
  | N0 => register_zero n
  | Npos p => register_of_pos n p
  end.Definition register_of_Z (n : nat) (z : Z) : register n :=
  register_of_entier n (BinInt.Zabs_N z).

(* Specifications: *)
Lemma register_of_entier_bij2 : forall (n : nat) (x : register n), register_of_entier n (entier_of_register n x) = x.