(** Fixed precision machine words *)
Require Export bbv.ZLib bbv.NatLib bbv.NLib.
Require Export bbv.N_Z_nat_conversions.
Require Export bbv.DepEq bbv.DepEqNat.
(* for nia (integer arithmetic with multiplications that omega cannot solve *)
Set Implicit Arguments.
(*! Definitions *)
(** * [word] *)
Inductive word : nat -> Set :=
| WO : word O
| WS : bool -> forall n, word n -> word (S n).
Delimit Scope word_scope with word.
Bind Scope word_scope with word.
(* This scope will be closed at the end of the file. *)
(* Coq trunk seems to inherit open scopes across imports? *)
Open Scope word_scope.
(** * Conversion to and from [nat] (or [N]), zero and one *)
Fixpoint wordToNat sz (w : word sz) : nat :=
match w with
| WO => O
| WS false w' => (wordToNat w') * 2
| WS true w' => S (wordToNat w' * 2)
end.
Fixpoint wordToNat' sz (w : word sz) : nat :=
match w with
| WO => O
| WS false w' => 2 * wordToNat w'
| WS true w' => S (2 * wordToNat w')
end.
Fixpoint natToWord (sz n : nat) : word sz :=
match sz with
| O => WO
| S sz' => WS (mod2 n) (natToWord sz' (div2 n))
end.
Fixpoint wordToN sz (w : word sz) : N :=
match w with
| WO => 0
| WS false w' => 2 * wordToN w'
| WS true w' => N.succ (2 * wordToN w')
end%N.
Definition wzero sz := natToWord sz 0.
Fixpoint wzero' (sz : nat) : word sz :=
match sz with
| O => WO
| S sz' => WS false (wzero' sz')
end.
Fixpoint posToWord (sz : nat) (p : positive) {struct p} : word sz :=
match sz with
| O => WO
| S sz' =>
match p with
| xI p' => WS true (posToWord sz' p')
| xO p' => WS false (posToWord sz' p')
| xH => WS true (wzero' sz')
end
end.
Definition NToWord (sz : nat) (n : N) : word sz :=
match n with
| N0 => wzero' sz
| Npos p => posToWord sz p
end.
Definition wone sz := natToWord sz 1.
Fixpoint wones (sz : nat) : word sz :=
match sz with
| O => WO
| S sz' => WS true (wones sz')
end.
(** * MSB, LSB, head, and tail *)
Fixpoint wmsb sz (w : word sz) (a : bool) : bool :=
match w with
| WO => a
| WS b x => wmsb x b
end.
Definition wlsb sz (w: word (S sz)) :=
match w with
| WO => idProp
| WS b _ => b
end.
Definition whd sz (w : word (S sz)) : bool :=
match w in word sz' return match sz' with
| O => unit
| S _ => bool
end with
| WO => tt
| WS b _ => b
end.
Definition wtl sz (w : word (S sz)) : word sz :=
match w in word sz' return match sz' with
| O => unit
| S sz'' => word sz''
end with
| WO => tt
| WS _ w' => w'
end.
Fixpoint rep_bit (n : nat) (b : word 1) : word n :=
match n as n0 return (word n0) with
| 0 => WO
| S n0 => WS (whd b) (rep_bit n0 b)
end.
(** * Shattering (to define [weq]) and decidable equality **)

(* Specifications: *)
Lemma shatter_word : forall n (a : word n),
match n return word n -> Prop with
| O => fun a => a = WO
| S _ => fun a => a = WS (whd a) (wtl a)
end a.