Definition weq : forall sz (x y : word sz), {x = y} + {x <> y}.Fixpoint weqb sz (x : word sz) : word sz -> bool :=
  match x in word sz return word sz -> bool with
    | WO => fun _ => true
    | WS b x' => fun y =>
      if eqb b (whd y)
      then if @weqb _ x' (wtl y) then true else false
      else false
  end.(** * Combining and splitting *)

Fixpoint combine (sz1 : nat) (w : word sz1) : forall sz2, word sz2 -> word (sz1 + sz2) :=
  match w in word sz1 return forall sz2, word sz2 -> word (sz1 + sz2) with
    | WO => fun _ w' => w'
    | WS b w' => fun _ w'' => WS b (combine w' w'')
  end.Fixpoint split1 (sz1 sz2 : nat) : word (sz1 + sz2) -> word sz1 :=
  match sz1 with
    | O => fun _ => WO
    | S sz1' => fun w => WS (whd w) (split1 sz1' sz2 (wtl w))
  end.Fixpoint split2 (sz1 sz2 : nat) : word (sz1 + sz2) -> word sz2 :=
  match sz1 with
    | O => fun w => w
    | S sz1' => fun w => split2 sz1' sz2 (wtl w)
  end.(** * Extension operators *)

Definition sext (sz : nat) (w : word sz) (sz' : nat) : word (sz + sz') :=
  if wmsb w false then
    combine w (wones sz')
  else
    combine w (wzero sz').Definition zext (sz : nat) (w : word sz) (sz' : nat) : word (sz + sz') :=
  combine w (wzero sz').(** * Arithmetic *)

Definition wneg sz (x : word sz) : word sz :=
  NToWord sz (Npow2 sz - wordToN x).Definition wordBin (f : N -> N -> N) sz (x y : word sz) : word sz :=
  NToWord sz (f (wordToN x) (wordToN y)).Definition wplus := wordBin Nplus.Definition wmult := wordBin Nmult.Definition wdiv := wordBin N.div.Definition wmod := wordBin Nmod.Definition wmult' sz (x y : word sz) : word sz :=
  split2 sz sz (NToWord (sz + sz) (Nmult (wordToN x) (wordToN y))).Definition wminus sz (x y : word sz) : word sz := wplus x (wneg y).Definition wnegN sz (x : word sz) : word sz :=
  natToWord sz (pow2 sz - wordToNat x).Definition wordBinN (f : nat -> nat -> nat) sz (x y : word sz) : word sz :=
  natToWord sz (f (wordToNat x) (wordToNat y)).Definition wplusN := wordBinN plus.Definition wmultN := wordBinN mult.Definition wmultN' sz (x y : word sz) : word sz :=
  split2 sz sz (natToWord (sz + sz) (mult (wordToNat x) (wordToNat y))).Definition wminusN sz (x y : word sz) : word sz := wplusN x (wnegN y).Notation "w ~ 1" := (WS true w) : word_scope.Notation "w ~ 0" := (WS false w) : word_scope.Notation "^~" := wneg : word_scope.Notation "l ^+ r" := (@wplus _ l%word r%word) : word_scope.Notation "l ^* r" := (@wmult _ l%word r%word) : word_scope.Notation "l ^- r" := (@wminus _ l%word r%word) : word_scope.Notation "l ^/ r" := (@wdiv _ l%word r%word) : word_scope.Notation "l ^% r" := (@wmod _ l%word r%word) : word_scope.(** * Bitwise operators *)

Fixpoint wnot sz (w : word sz) : word sz :=
  match w with
    | WO => WO
    | WS b w' => WS (negb b) (wnot w')
  end.Fixpoint bitwp (f : bool -> bool -> bool) sz (w1 : word sz) : word sz -> word sz :=
  match w1 with
    | WO => fun _ => WO
    | WS b w1' => fun w2 => WS (f b (whd w2)) (bitwp f w1' (wtl w2))
  end.Definition wnot' sz := bitwp xorb (wones sz).Definition wor := bitwp orb.Definition wand := bitwp andb.Definition wxor := bitwp xorb.Notation "l ^| r" := (@wor _ l%word r%word) : word_scope.Notation "l ^& r" := (@wand _ l%word r%word) : word_scope.(** * Conversion to and from [Z] *)

Definition wordToZ sz (w : word sz) : Z :=
  if wmsb w false then
    (** Negative **)
    match wordToN (wneg w) with
    | N0 => 0%Z
    | Npos x => Zneg x
    end
  else
    (** Positive **)
    match wordToN w with
    | N0 => 0%Z
    | Npos x => Zpos x
    end.Definition uwordToZ sz (w : word sz) : Z := Z.of_N (wordToN w).Definition ZToWord (sz : nat) (z : Z) : word sz :=
  match z with
  | Z0 => wzero' sz
  | Zpos x => posToWord sz x
  | Zneg x => wneg (posToWord sz x)
  end.(** * Arithmetic by [Z] *)

Definition wordBinZ (f : Z -> Z -> Z) sz (x y : word sz) : word sz :=
  ZToWord sz (f (wordToZ x) (wordToZ y)).Definition wplusZ := wordBinZ Z.add.Definition wminusZ := wordBinZ Z.sub.Definition wmultZ := wordBinZ Z.mul.Definition wmultZsu sz (x y : word sz) :=
  ZToWord sz (Z.mul (wordToZ x) (Z.of_N (wordToN y))).Definition wdivZ := wordBinZ Z.quot.Definition wdivZsu sz (x y : word sz) :=
  ZToWord sz (Z.div (wordToZ x) (Z.of_N (wordToN y))).Definition wremZ := wordBinZ Z.rem.Definition wremZsu sz (x y : word sz) :=
  ZToWord sz (Z.modulo (wordToZ x) (Z.of_N (wordToN y))).(** * Comparison predicates and deciders *)

Definition wlt sz (l r : word sz) : Prop :=
  N.lt (wordToN l) (wordToN r).Definition wslt sz (l r : word sz) : Prop :=
  Z.lt (wordToZ l) (wordToZ r).Notation "w1 > w2" := (@wlt _ w2%word w1%word) : word_scope.Notation "w1 >= w2" := (~(@wlt _ w1%word w2%word)) : word_scope.Notation "w1 < w2" := (@wlt _ w1%word w2%word) : word_scope.Notation "w1 <= w2" := (~(@wlt _ w2%word w1%word)) : word_scope.Notation "w1 '>s' w2" := (@wslt _ w2%word w1%word) : word_scope.Notation "w1 '>s=' w2" := (~(@wslt _ w1%word w2%word)) : word_scope.Notation "w1 '<s' w2" := (@wslt _ w1%word w2%word) : word_scope.Notation "w1 '<s=' w2" := (~(@wslt _ w2%word w1%word)) : word_scope.Definition wlt_dec : forall sz (l r : word sz), {l < r} + {l >= r}.Definition wslt_dec : forall sz (l r : word sz), {l <s r} + {l >s= r}.Definition wltb{sz: nat}(l r: word sz): bool := BinNat.N.ltb (wordToN l) (wordToN r).Definition wsltb{sz: nat}(l r: word sz): bool := Z.ltb (wordToZ l) (wordToZ r).Notation "$ n" := (natToWord _ n) : word_scope.Notation "# n" := (wordToNat n).(** * Bit shifting *)

Fact sz_minus_nshift : forall sz nshift, (nshift < sz)%nat -> sz = sz - nshift + nshift.Fact nshift_plus_nkeep : forall sz nshift, (nshift < sz)%nat -> nshift + (sz - nshift) = sz.Definition wlshift (sz : nat) (w : word sz) (n : nat) : word sz.Definition wrshift (sz : nat) (w : word sz) (n : nat) : word sz.Definition wrshifta (sz : nat) (w : word sz) (n : nat) : word sz.(* Redefine shifts so that they do not use eq_rect, which matches on add_comm,
   which is an opaque proof, which makes cbv blow up.
   If you ever want to reduce terms inside Coq with cbv, you should use the
   shifts below!  *)

Definition wlshift' {sz : nat} (w : word sz) (n : nat) : word sz.Definition wrshift' {sz : nat} (w : word sz) (n : nat) : word sz.Definition wrshifta' {sz : nat} (w : word sz) (n : nat) : word sz.Definition extz {sz} (w: word sz) (n: nat) := combine (wzero n) w.Fixpoint wpow2 sz: word (S sz) :=
  match sz with
  | O => WO~1
  | S sz' => (wpow2 sz')~0
  end.Notation "l ^<< r" := (@wlshift' _ l%word r) : word_scope.Notation "l ^>> r" := (@wrshift' _ l%word r) : word_scope.(** * Setting an individual bit *)

Definition wbit sz sz' (n : word sz') := natToWord sz (pow2 (wordToNat n)).

Theorem wtl_match : forall n n' (w : word (S n)) (Heq : S n = S n') (Heq' : n = n'), (match Heq' in (_ = N) return (word N) with | eq_refl => wtl w end) = wtl (match Heq in (_ = N) return (word N) with | eq_refl => w end).