(** Fixed precision machine words *)

Require Import Coq.Arith.Arith Coq.Arith.Div2 Coq.NArith.NArith Coq.Bool.Bool Coq.ZArith.ZArith.
Require Import Coq.Logic.Eqdep_dec Coq.Logic.EqdepFacts.
Require Import Coq.Program.Tactics Coq.Program.Equality.
Require Import Coq.setoid_ring.Ring.
Require Import Coq.setoid_ring.Ring_polynom.
Require Import bbv.Nomega.
Require Export bbv.ZLib bbv.NatLib bbv.NLib.
Require Export bbv.N_Z_nat_conversions.
Require Export bbv.DepEq bbv.DepEqNat.
Require Import bbv.ReservedNotations.

Require Import Coq.micromega.Lia.
(* 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.

(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
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 **)

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.
(* Goal: forall (n : nat) (a : word n), match n as n0 return (forall _ : word n0, Prop) with | O => fun a0 : word O => @eq (word O) a0 WO | S n0 => fun a0 : word (S n0) => @eq (word (S n0)) a0 (@WS (@whd n0 a0) n0 (@wtl n0 a0)) end a *)
  destruct a; eauto.
Qed.

Lemma shatter_word_S : forall n (a : word (S n)),
  exists b, exists c, a = WS b c.
Proof.
(* Goal: forall (n : nat) (a : word (S n)), @ex bool (fun b : bool => @ex (word n) (fun c : word n => @eq (word (S n)) a (@WS b n c))) *)
  intros n a; repeat eexists; apply (shatter_word a).
Qed.
Lemma shatter_word_0 : forall a : word 0,
  a = WO.
Proof.
(* Goal: forall a : word O, @eq (word O) a WO *)
  intros a; apply (shatter_word a).
Qed.

Hint Resolve shatter_word_0.

Definition weq : forall sz (x y : word sz), {x = y} + {x <> y}.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
  refine (fix weq sz (x : word sz) : forall y : word sz, {x = y} + {x <> y} :=
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
    match x in word sz return forall y : word sz, {x = y} + {x <> y} with
      | WO => fun _ => left _ _
      | WS b x' => fun y => if bool_dec b (whd y)
        then if weq _ x' (wtl y) then left _ _ else right _ _
        else right _ _
    end); clear weq.

(* Goal: @eq (word O) WO w *)
(* Goal: @eq (word (S n)) (@WS b n x') y *)
(* Goal: not (@eq (word (S n)) (@WS b n x') y) *)
(* Goal: not (@eq (word (S n)) (@WS b n x') y) *)
  abstract (symmetry; apply shatter_word_0).

(* Goal: @eq (word (S n)) (@WS b n x') y *)
(* Goal: not (@eq (word (S n)) (@WS b n x') y) *)
(* Goal: not (@eq (word (S n)) (@WS b n x') y) *)
  abstract (subst; symmetry; apply (shatter_word (n:=S _) _)).

  let y' := y in (* kludge around warning of mechanically generated names not playing well with [abstract] *)
  abstract (rewrite (shatter_word y'); simpl; intro H; injection H; intros;
    eauto using inj_pair2_eq_dec, eq_nat_dec).

  let y' := y in (* kludge around warning of mechanically generated names not playing well with [abstract] *)
  abstract (rewrite (shatter_word y'); simpl; intro H; injection H; auto).
Defined.

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

Module Import ArithmeticNotations.
  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.
End ArithmeticNotations.

(** * 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.

Module Import BitwiseNotations.
  Notation "l ^| r" := (@wor _ l%word r%word) : word_scope.
  Notation "l ^& r" := (@wand _ l%word r%word) : word_scope.
End BitwiseNotations.

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

Module Import ComparisonNotations.
  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.
End ComparisonNotations.

Definition wlt_dec : forall sz (l r : word sz), {l < r} + {l >= r}.
  refine (fun sz l r =>
    match N.compare (wordToN l) (wordToN r) as k return N.compare (wordToN l) (wordToN r) = k -> _ with
      | Lt => fun pf => left _ _
      | _ => fun pf => right _ _
    end (refl_equal _));
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
  abstract congruence.
Defined.

Definition wslt_dec : forall sz (l r : word sz), {l <s r} + {l >s= r}.
  refine (fun sz l r =>
    match Z.compare (wordToZ l) (wordToZ r) as c return Z.compare (wordToZ l) (wordToZ r) = c -> _ with
      | Lt => fun pf => left _ _
      | _ => fun pf => right _ _
    end (refl_equal _));
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
  abstract congruence.
Defined.

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

Module Import ConversionNotations.
  Notation "$ n" := (natToWord _ n) : word_scope.
  Notation "# n" := (wordToNat n).
End ConversionNotations.

(** * Bit shifting *)

Fact sz_minus_nshift : forall sz nshift, (nshift < sz)%nat -> sz = sz - nshift + nshift.
Proof.
(* Goal: forall (a b c : nat) (_ : le b a) (_ : lt b c) (_ : lt a c), lt (Init.Nat.sub a b) c *)
  intros; omega.
Qed.

Fact nshift_plus_nkeep : forall sz nshift, (nshift < sz)%nat -> nshift + (sz - nshift) = sz.
Proof.
(* Goal: forall (a b c : nat) (_ : le b a) (_ : lt b c) (_ : lt a c), lt (Init.Nat.sub a b) c *)
  intros; omega.
Qed.

Definition wlshift (sz : nat) (w : word sz) (n : nat) : word sz.
(* Goal: word sz *)
  refine (split1 sz n _).
(* Goal: le (Nat.pow (S (S O)) sz) (Nat.sub (Nat.add (@wordToNat sz x) (Nat.pow (S (S O)) sz)) (@wordToNat sz y)) *)
(* Goal: lt (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz y)) (Nat.pow (S (S O)) sz) *)
  rewrite plus_comm.
(* Goal: word (Nat.add n sz) *)
  exact (combine (wzero n) w).
Defined.

Definition wrshift (sz : nat) (w : word sz) (n : nat) : word sz.
(* Goal: word sz *)
  refine (split2 n sz _).
(* Goal: le (Nat.pow (S (S O)) sz) (Nat.sub (Nat.add (@wordToNat sz x) (Nat.pow (S (S O)) sz)) (@wordToNat sz y)) *)
(* Goal: lt (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz y)) (Nat.pow (S (S O)) sz) *)
  rewrite plus_comm.
(* Goal: word (Nat.add sz n) *)
  exact (combine w (wzero n)).
Defined.

Definition wrshifta (sz : nat) (w : word sz) (n : nat) : word sz.
(* Goal: word sz *)
  refine (split2 n sz _).
(* Goal: le (Nat.pow (S (S O)) sz) (Nat.sub (Nat.add (@wordToNat sz x) (Nat.pow (S (S O)) sz)) (@wordToNat sz y)) *)
(* Goal: lt (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz y)) (Nat.pow (S (S O)) sz) *)
  rewrite plus_comm.
(* Goal: word (Nat.add sz n) *)
  exact (sext w _).
Defined.

(* 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.
  refine (split1 sz n (nat_cast _ _ _)).
  apply PeanoNat.Nat.add_comm.
(* Goal: word (Nat.add n sz) *)
  exact (combine (wzero n) w).
Defined.

Definition wrshift' {sz : nat} (w : word sz) (n : nat) : word sz.
  refine (split2 n sz (nat_cast _ _ _)).
  apply PeanoNat.Nat.add_comm.
(* Goal: word (Nat.add sz n) *)
  exact (combine w (wzero n)).
Defined.

Definition wrshifta' {sz : nat} (w : word sz) (n : nat) : word sz.
  refine (split2 n sz (nat_cast _ _ _)).
  apply PeanoNat.Nat.add_comm.
(* Goal: word (Nat.add sz n) *)
  exact (sext w _).
Defined.

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.

Module Import ShiftNotations.
  Notation "l ^<< r" := (@wlshift' _ l%word r) : word_scope.
  Notation "l ^>> r" := (@wrshift' _ l%word r) : word_scope.
End ShiftNotations.

(** * Setting an individual bit *)

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


(*! Facts *)

Hint Rewrite div2_double div2_S_double: div2.
Local Hint Resolve mod2_S_double mod2_double.

Theorem eq_rect_word_offset : forall n n' offset w Heq,
  eq_rect n (fun n => word (offset + n)) w n' Heq =
  eq_rect (offset + n) (fun n => word n) w (offset + n') (eq_rect_word_offset_helper _ _ _ Heq).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.mul n' scale)) (@eq_rect nat n (fun n : nat => word (Init.Nat.mul n scale)) w n' Heq) (@eq_rect nat (Init.Nat.mul n scale) (fun n : nat => word n) w (Init.Nat.mul n' scale) (eq_rect_word_mult_helper n n' scale Heq)) *)
  destruct Heq.
(* Goal: @eq (word (Init.Nat.add offset n)) (@eq_rect nat n (fun n : nat => word (Init.Nat.add offset n)) w n (@eq_refl nat n)) (@eq_rect nat (Init.Nat.add offset n) (fun n : nat => word n) w (Init.Nat.add offset n) (eq_rect_word_offset_helper n n offset (@eq_refl nat n))) *)
  rewrite (UIP_dec eq_nat_dec (eq_rect_word_offset_helper _ _ offset eq_refl) eq_refl).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem eq_rect_word_mult : forall n n' scale w Heq,
  eq_rect n (fun n => word (n * scale)) w n' Heq =
  eq_rect (n * scale) (fun n => word n) w (n' * scale) (eq_rect_word_mult_helper _ _ _ Heq).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.mul n' scale)) (@eq_rect nat n (fun n : nat => word (Init.Nat.mul n scale)) w n' Heq) (@eq_rect nat (Init.Nat.mul n scale) (fun n : nat => word n) w (Init.Nat.mul n' scale) (eq_rect_word_mult_helper n n' scale Heq)) *)
  destruct Heq.
(* Goal: @eq (word (Init.Nat.mul n scale)) (@eq_rect nat n (fun n : nat => word (Init.Nat.mul n scale)) w n (@eq_refl nat n)) (@eq_rect nat (Init.Nat.mul n scale) (fun n : nat => word n) w (Init.Nat.mul n scale) (eq_rect_word_mult_helper n n scale (@eq_refl nat n))) *)
  rewrite (UIP_dec eq_nat_dec (eq_rect_word_mult_helper _ _ scale eq_refl) eq_refl).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem eq_rect_word_match : forall n n' (w : word n) (H : n = n'),
  match H in (_ = N) return (word N) with
  | eq_refl => w
  end = eq_rect n (fun n => word n) w n' H.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
  destruct H.
(* Goal: @eq (word n1) (split1 n1 n2' w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2') (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  rewrite <- (eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem whd_match : forall n n' (w : word (S n)) (Heq : S n = S n'),
  whd w = whd (match Heq in (_ = N) return (word N) with
               | eq_refl => w
               end).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq bool (@whd n w) (@whd n' match Heq in (eq _ N) return (word N) with | eq_refl => w end) *)
  rewrite eq_rect_word_match.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
(* Goal: forall w : word (S n), @eq bool (@whd n w) (@whd n' (@eq_rect nat (S n) (fun n : nat => word n) w (S n') Heq)) *)
  remember Heq as Heq'. clear HeqHeq'.
(* Goal: forall w : word (S n), @eq bool (@whd n w) (@whd n' (@eq_rect nat (S n) (fun n : nat => word n) w (S n') Heq')) *)
  generalize dependent Heq'.
(* Goal: forall (Heq' : @eq nat (S n) (S n')) (w : word (S n)), @eq bool (@whd n w) (@whd n' (@eq_rect nat (S n) (fun n : nat => word n) w (S n') Heq')) *)
  replace (n') with (n) by omega.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite <- (eq_rect_eq_dec eq_nat_dec). reflexivity.
Qed.

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).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  repeat match goal with
           | [ |- context[match ?pf with refl_equal => _ end] ] => generalize pf
         end.
(* Goal: forall (Heq : @eq nat (S n) (S n')) (Heq' : @eq nat n n'), @eq (word n') match Heq' in (eq _ N) return (word N) with | eq_refl => @wtl n w end (@wtl n' match Heq in (eq _ N) return (word N) with | eq_refl => w end) *)
  generalize dependent w; clear.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word n') match Heq' in (eq _ N) return (word N) with | eq_refl => @wtl n w end (@wtl n' match Heq in (eq _ N) return (word N) with | eq_refl => w end) *)
  generalize Heq Heq'.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  subst.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word n') match Heq' in (eq _ N) return (word N) with | eq_refl => @wtl n' w end (@wtl n' match Heq0 in (eq _ N) return (word N) with | eq_refl => w end) *)
  rewrite (UIP_dec eq_nat_dec Heq' (refl_equal _)).
(* Goal: @eq (word ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3)) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq0 in (eq _ N) return (word N) with | eq_refl => @WS (@whd (Nat.add (Nat.add n1 n2) n3) w) (Nat.add (Nat.add n1 n2) n3) (@wtl (Nat.add (Nat.add n1 n2) n3) w) end) (@wtl (Nat.add (Nat.add n1 n2) n3) w) *)
  rewrite (UIP_dec eq_nat_dec Heq0 (refl_equal _)).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem word0: forall (w : word 0), w = WO.
Proof.
(* Goal: forall w : word O, @eq (word O) w WO *)
  firstorder.
Qed.

Theorem wordToNat_wordToNat' : forall sz (w : word sz),
  wordToNat w = wordToNat' w.
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  induction w. auto. unfold wordToNat. simpl. rewrite mult_comm. reflexivity.
Qed.

Theorem natToWord_wordToNat : forall sz w, natToWord sz (wordToNat w) = w.
  induction w as [|b]; rewrite wordToNat_wordToNat'; intuition; f_equal; unfold natToWord, wordToNat'; fold natToWord; fold wordToNat';
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
    destruct b; f_equal; autorewrite with div2; intuition.
Qed.

Theorem roundTrip_0 : forall sz, wordToNat (natToWord sz 0) = 0.
(* Goal: forall sz : nat, @eq nat (@wordToNat sz (natToWord sz O)) O *)
  induction sz; simpl; intuition.
Qed.

Hint Rewrite roundTrip_0 : wordToNat.

Lemma wordToNat_natToWord' : forall sz w, exists k, wordToNat (natToWord sz w) + k * pow2 sz = w.
(* Goal: forall sz w : nat, @ex nat (fun k : nat => @eq nat (Init.Nat.add (@wordToNat sz (natToWord sz w)) (Init.Nat.mul k (Nat.pow (S (S O)) sz))) w) *)
  induction sz as [|sz IHsz]; simpl; intro w; intuition; repeat rewrite untimes2.

(* Goal: @ex nat (fun k : nat => @eq nat (Init.Nat.mul k (S O)) w) *)
(* Goal: @ex nat (fun k : nat => @eq nat (Init.Nat.add (if mod2 w then S (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) else Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) (Init.Nat.mul k (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz)))) w) *)
  exists w; intuition.

(* Goal: @ex nat (fun k : nat => @eq nat (Init.Nat.add (if mod2 w then S (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) else Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) (Init.Nat.mul k (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz)))) w) *)
  case_eq (mod2 w); intro Hmw.

(* Goal: forall w : word O, @eq (word O) w WO *)
  specialize (IHsz (div2 w)); firstorder.
(* Goal: @ex nat (fun k : nat => @eq nat (Init.Nat.add (S (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O)))) (Init.Nat.mul k (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz)))) w) *)
(* Goal: @ex nat (fun k : nat => @eq nat (Init.Nat.add (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) (Init.Nat.mul k (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz)))) w) *)
  rewrite wordToNat_wordToNat' in *.
  let x' := match goal with H : _ + ?x * _ = _ |- _ => x end in
  rename x' into x. (* force non-auto-generated name *)
(* Goal: @ex nat (fun k : nat => @eq nat (Init.Nat.add (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) (Init.Nat.mul k (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz)))) w) *)
  exists x; intuition.
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz z) x1) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Nat.mul (@wordToNat sz z) (@wordToNat sz y))) *)
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
  rewrite mult_assoc.
(* Goal: @eq nat (Init.Nat.add (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) (Nat.mul (Nat.mul x (S (S O))) (Nat.pow (S (S O)) sz))) w *)
  rewrite (mult_comm x 2).
(* Goal: @eq nat (Init.Nat.add (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) (Nat.mul (S (S O)) (Nat.mul x (Nat.pow (S (S O)) sz)))) w *)
  rewrite mult_comm. simpl mult at 1.
(* Goal: @eq nat (Init.Nat.add (S (Nat.add (@wordToNat' sz (natToWord sz (Nat.div2 w))) (Nat.add (@wordToNat' sz (natToWord sz (Nat.div2 w))) O))) (Nat.mul (Nat.mul (S (S O)) x) (Nat.pow (S (S O)) sz))) w *)
(* Goal: @ex nat (fun k : nat => @eq nat (Init.Nat.add (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) (Init.Nat.mul k (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz)))) w) *)
  rewrite (plus_Sn_m (2 * wordToNat' (natToWord sz (div2 w)))).
(* Goal: le (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Nat.pow (S (S O)) sz2)) *)
  rewrite <- mult_assoc.
(* Goal: @eq nat (Init.Nat.add (Nat.mul (S (S O)) (@wordToNat sz (natToWord sz (Nat.div2 w)))) (Nat.mul (S (S O)) (Nat.mul x (Nat.pow (S (S O)) sz)))) w *)
  rewrite <- mult_plus_distr_l.
(* Goal: @eq nat (S (Nat.mul (S (S O)) (Nat.add (@wordToNat' sz (natToWord sz (Nat.div2 w))) (Nat.mul x (Nat.pow (S (S O)) sz))))) w *)
(* Goal: @ex nat (fun k : nat => @eq nat (Init.Nat.add (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) (Init.Nat.mul k (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz)))) w) *)
  rewrite H; clear H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  symmetry; apply div2_odd; auto.

(* Goal: forall w : word O, @eq (word O) w WO *)
  specialize (IHsz (div2 w)); firstorder.
  let x' := match goal with H : _ + ?x * _ = _ |- _ => x end in
  rename x' into x. (* force non-auto-generated name *)
(* Goal: @ex nat (fun k : nat => @eq nat (Init.Nat.add (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) (Init.Nat.mul k (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz)))) w) *)
  exists x; intuition.
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz z) x1) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Nat.mul (@wordToNat sz z) (@wordToNat sz y))) *)
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
  rewrite mult_assoc.
(* Goal: @eq nat (Init.Nat.add (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) (Nat.mul (Nat.mul x (S (S O))) (Nat.pow (S (S O)) sz))) w *)
  rewrite (mult_comm x 2).
(* Goal: le (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Nat.pow (S (S O)) sz2)) *)
  rewrite <- mult_assoc.
(* Goal: @eq nat (Init.Nat.add (Init.Nat.mul (@wordToNat sz (natToWord sz (Nat.div2 w))) (S (S O))) (Nat.mul (S (S O)) (Nat.mul x (Nat.pow (S (S O)) sz)))) w *)
  rewrite mult_comm.
(* Goal: @eq nat (Init.Nat.add (Nat.mul (S (S O)) (@wordToNat sz (natToWord sz (Nat.div2 w)))) (Nat.mul (S (S O)) (Nat.mul x (Nat.pow (S (S O)) sz)))) w *)
  rewrite <- mult_plus_distr_l.
(* Goal: @eq nat (Nat.mul (S (S O)) (Nat.add (@wordToNat sz (natToWord sz (Nat.div2 w))) (Nat.mul x (Nat.pow (S (S O)) sz)))) w *)
  match goal with H : _ |- _ => rewrite H; clear H end.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  symmetry; apply div2_even; auto.
Qed.

Theorem wordToNat_natToWord:
  forall sz w, exists k, wordToNat (natToWord sz w) = w - k * pow2 sz /\ (k * pow2 sz <= w)%nat.
Proof.
(* Goal: forall sz w : nat, @ex nat (fun k : nat => and (@eq nat (@wordToNat sz (natToWord sz w)) (Init.Nat.sub w (Init.Nat.mul k (Nat.pow (S (S O)) sz)))) (le (Init.Nat.mul k (Nat.pow (S (S O)) sz)) w)) *)
  intros sz w; destruct (wordToNat_natToWord' sz w) as [k]; exists k; intuition.
Qed.

Lemma wordToNat_natToWord_2: forall sz w : nat,
    (w < pow2 sz)%nat -> wordToNat (natToWord sz w) = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (@wordToNat sz (natToWord sz w)) w *)
  pose proof (wordToNat_natToWord sz w).
(* Goal: @eq nat (@wordToNat sz (natToWord sz w)) w *)
  destruct H0; destruct H0.
(* Goal: @eq nat (@wordToNat sz (natToWord sz w)) w *)
  rewrite H0 in *; clear H0.
(* Goal: @eq nat (Init.Nat.sub w (Init.Nat.mul x (Nat.pow (S (S O)) sz))) w *)
  destruct x; try omega.
(* Goal: @eq nat (Init.Nat.sub w (Init.Nat.mul (S x) (Nat.pow (S (S O)) sz))) w *)
  exfalso; simpl in H1.

(* Goal: False *)
  pose proof (Lt.le_lt_trans _ _ _ H1 H).
(* Goal: False *)
  pose proof (Plus.le_plus_l (pow2 sz) (x * pow2 sz)).
(* Goal: False *)
  pose proof (Lt.le_lt_trans _ _ _ H2 H0).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma natToWord_times2: forall sz x,
  ((natToWord sz x)~0)%word = natToWord (S sz) (2 * x).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold natToWord. fold natToWord. f_equal.
  - symmetry. apply mod2_double.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - rewrite div2_double. reflexivity.
Qed.

Theorem WS_neq : forall b1 b2 sz (w1 w2 : word sz),
  (b1 <> b2 \/ w1 <> w2)
  -> WS b1 w1 <> WS b2 w2.
(* Goal: forall (b1 b2 : bool) (sz : nat) (w1 w2 : word sz) (_ : or (not (@eq bool b1 b2)) (not (@eq (word sz) w1 w2))), not (@eq (word (S sz)) (@WS b1 sz w1) (@WS b2 sz w2)) *)
  intros b1 b2 sz w1 w2 ? H0; intuition.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply (f_equal (@whd _)) in H0; tauto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply (f_equal (@wtl _)) in H0; tauto.
Qed.

Theorem weqb_true_iff : forall sz x y,
  @weqb sz x y = true <-> x = y.
Proof.
(* Goal: forall (sz : nat) (x y : word sz), iff (@eq bool (@weqb sz x y) true) (@eq (word sz) x y) *)
  induction x as [|b ? x IHx]; simpl; intros y.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  { split; auto. }
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
  { rewrite (shatter_word y) in *. simpl in *.
(* Goal: iff (@eq bool (if eqb b (@whd n y) then if @weqb n x (@wtl n y) then true else false else false) true) (@eq (word (S n)) (@WS b n x) (@WS (@whd n y) n (@wtl n y))) *)
    case_eq (eqb b (whd y)); intros H.
(* Goal: iff (@eq bool (if @weqb n x (@wtl n y) then true else false) true) (@eq (word (S n)) (@WS b n x) (@WS (@whd n y) n (@wtl n y))) *)
(* Goal: iff (@eq bool false true) (@eq (word (S n)) (@WS b n x) (@WS (@whd n y) n (@wtl n y))) *)
    case_eq (weqb x (wtl y)); intros H0.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
    split; auto; intros. rewrite eqb_true_iff in H. f_equal; eauto. eapply IHx; eauto.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
    split; intros H1; try congruence. inversion H1; clear H1; subst.
(* Goal: @eq bool false true *)
(* Goal: iff (@eq bool false true) (@eq (word (S n)) (@WS b n x) (@WS (@whd n y) n (@wtl n y))) *)
    eapply inj_pair2_eq_dec in H4. eapply IHx in H4. congruence.
(* Goal: forall x y : nat, sumbool (@eq nat x y) (not (@eq nat x y)) *)
(* Goal: iff (@eq bool false true) (@eq (word (S n)) (@WS b n x) (@WS (@whd n y) n (@wtl n y))) *)
    eapply Peano_dec.eq_nat_dec.
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
    split; intros; try congruence.
    inversion H0. apply eqb_false_iff in H. congruence. }
Qed.

Ltac shatterer := simpl; intuition;
  match goal with
    | [ w : _ |- _ ] => rewrite (shatter_word w); simpl
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  end; f_equal; auto.

Theorem combine_split : forall sz1 sz2 (w : word (sz1 + sz2)),
  combine (split1 sz1 sz2 w) (split2 sz1 sz2 w) = w.
(* Goal: forall (sz1 sz2 : nat) (w : word sz1) (z : word sz2), @eq (word sz2) (split2 sz1 sz2 (@combine sz1 w sz2 z)) z *)
  induction sz1; shatterer.
Qed.

Theorem split1_combine : forall sz1 sz2 (w : word sz1) (z : word sz2),
  split1 sz1 sz2 (combine w z) = w.
(* Goal: forall (sz1 sz2 : nat) (w : word sz1) (z : word sz2), @eq (word sz2) (split2 sz1 sz2 (@combine sz1 w sz2 z)) z *)
  induction sz1; shatterer.
Qed.

Theorem split2_combine : forall sz1 sz2 (w : word sz1) (z : word sz2),
  split2 sz1 sz2 (combine w z) = z.
(* Goal: forall (sz1 sz2 : nat) (w : word sz1) (z : word sz2), @eq (word sz2) (split2 sz1 sz2 (@combine sz1 w sz2 z)) z *)
  induction sz1; shatterer.
Qed.

Hint Rewrite combine_split.
Hint Rewrite split1_combine.
Hint Rewrite split2_combine.

Theorem combine_assoc : forall n1 (w1 : word n1) n2 n3 (w2 : word n2) (w3 : word n3) Heq,
  combine (combine w1 w2) w3
  = match Heq in _ = N return word N with
      | refl_equal => combine w1 (combine w2 w3)
    end.
(* Goal: forall (n1 : nat) (w1 : word n1) (n2 n3 : nat) (w2 : word n2) (w3 : word n3) (Heq : @eq nat (Init.Nat.add n1 (Init.Nat.add n2 n3)) (Init.Nat.add (Init.Nat.add n1 n2) n3)), @eq (word (Init.Nat.add (Init.Nat.add n1 n2) n3)) (@combine (Init.Nat.add n1 n2) (@combine n1 w1 n2 w2) n3 w3) match Heq in (eq _ N) return (word N) with | eq_refl => @combine n1 w1 (Init.Nat.add n2 n3) (@combine n2 w2 n3 w3) end *)
  induction w1 as [|?? w1 IHw1]; simpl; intros n2 n3 w2 w3 Heq; intuition.

(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite (UIP_dec eq_nat_dec Heq (refl_equal _)); reflexivity.

(* Goal: @eq (word (S (Init.Nat.add (Init.Nat.add n n2) n3))) (@WS b (Init.Nat.add (Init.Nat.add n n2) n3) (@combine (Init.Nat.add n n2) (@combine n w1 n2 w2) n3 w3)) match Heq in (eq _ N) return (word N) with | eq_refl => @WS b (Init.Nat.add n (Init.Nat.add n2 n3)) (@combine n w1 (Init.Nat.add n2 n3) (@combine n2 w2 n3 w3)) end *)
  rewrite (IHw1 _ _ _ _ (plus_assoc _ _ _)); clear IHw1.
  repeat match goal with
           | [ |- context[match ?pf with refl_equal => _ end] ] => generalize pf
         end.
(* Goal: forall (Heq : @eq nat (S (Init.Nat.add n (Init.Nat.add n2 n3))) (S (Init.Nat.add (Init.Nat.add n n2) n3))) (e : @eq nat (Nat.add n (Nat.add n2 n3)) (Nat.add (Nat.add n n2) n3)), @eq (word (S (Init.Nat.add (Init.Nat.add n n2) n3))) (@WS b (Init.Nat.add (Init.Nat.add n n2) n3) match e in (eq _ N) return (word N) with | eq_refl => @combine n w1 (Init.Nat.add n2 n3) (@combine n2 w2 n3 w3) end) match Heq in (eq _ N) return (word N) with | eq_refl => @WS b (Init.Nat.add n (Init.Nat.add n2 n3)) (@combine n w1 (Init.Nat.add n2 n3) (@combine n2 w2 n3 w3)) end *)
  generalize dependent (combine w1 (combine w2 w3)).
(* Goal: forall (w : word (Init.Nat.add n (Init.Nat.add n2 n3))) (Heq : @eq nat (S (Init.Nat.add n (Init.Nat.add n2 n3))) (S (Init.Nat.add (Init.Nat.add n n2) n3))) (e : @eq nat (Nat.add n (Nat.add n2 n3)) (Nat.add (Nat.add n n2) n3)), @eq (word (S (Init.Nat.add (Init.Nat.add n n2) n3))) (@WS b (Init.Nat.add (Init.Nat.add n n2) n3) match e in (eq _ N) return (word N) with | eq_refl => w end) match Heq in (eq _ N) return (word N) with | eq_refl => @WS b (Init.Nat.add n (Init.Nat.add n2 n3)) w end *)
  rewrite plus_assoc; intros w Heq0 e.
(* Goal: @eq (word ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3)) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq0 in (eq _ N) return (word N) with | eq_refl => @WS (@whd (Nat.add (Nat.add n1 n2) n3) w) (Nat.add (Nat.add n1 n2) n3) (@wtl (Nat.add (Nat.add n1 n2) n3) w) end) match e in (eq _ N) return (word N) with | eq_refl => @wtl (Nat.add (Nat.add n1 n2) n3) w end *)
  rewrite (UIP_dec eq_nat_dec e (refl_equal _)).
(* Goal: @eq (word ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3)) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq0 in (eq _ N) return (word N) with | eq_refl => @WS (@whd (Nat.add (Nat.add n1 n2) n3) w) (Nat.add (Nat.add n1 n2) n3) (@wtl (Nat.add (Nat.add n1 n2) n3) w) end) (@wtl (Nat.add (Nat.add n1 n2) n3) w) *)
  rewrite (UIP_dec eq_nat_dec Heq0 (refl_equal _)).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem split1_iter : forall n1 n2 n3 Heq w,
  split1 n1 n2 (split1 (n1 + n2) n3 w)
  = split1 n1 (n2 + n3) (match Heq in _ = N return word N with
                           | refl_equal => w
                         end).
Proof.
(* Goal: forall (n1 n2 n3 : nat) (Heq : @eq nat (Init.Nat.add (Init.Nat.add n1 n2) n3) (Init.Nat.add n1 (Init.Nat.add n2 n3))) (w : word (Init.Nat.add (Init.Nat.add n1 n2) n3)), @eq (word n1) (split1 n1 n2 (split1 (Init.Nat.add n1 n2) n3 w)) (split1 n1 (Init.Nat.add n2 n3) match Heq in (eq _ N) return (word N) with | eq_refl => w end) *)
  induction n1; simpl; intuition.

(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: @eq bool (@whd ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) w) (@whd ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) match Heq in (eq _ N) return (word N) with | eq_refl => w end) *)
(* Goal: @eq (word n1) (split1 n1 n2 (split1 (Init.Nat.add n1 n2) n3 (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) w))) (split1 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) match Heq in (eq _ N) return (word N) with | eq_refl => w end)) *)
  apply whd_match.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (n1 + n2 + n3 = n1 + (n2 + n3)) as Heq' by omega.
(* Goal: @eq (word n1) (split1 n1 n2 (split1 (Init.Nat.add n1 n2) n3 (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) w))) (split1 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) match Heq in (eq _ N) return (word N) with | eq_refl => w end)) *)
  rewrite IHn1 with (Heq:=Heq').
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: @eq (word (Nat.add (Nat.add n1 n2) n3)) match Nat.add_assoc n1 n2 n3 in (eq _ N) return (word N) with | eq_refl => @wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) w end (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq in (eq _ N) return (word N) with | eq_refl => w end) *)
  apply wtl_match.
Qed.

Theorem split2_iter : forall n1 n2 n3 Heq w,
  split2 n2 n3 (split2 n1 (n2 + n3) w)
  = split2 (n1 + n2) n3 (match Heq in _ = N return word N with
                           | refl_equal => w
                         end).
(* Goal: forall (n1 n2 n3 : nat) (Heq : @eq nat (Init.Nat.add n1 (Init.Nat.add n2 n3)) (Init.Nat.add (Init.Nat.add n1 n2) n3)) (w : word (Init.Nat.add n1 (Init.Nat.add n2 n3))), @eq (word n3) (split2 n2 n3 (split2 n1 (Init.Nat.add n2 n3) w)) (split2 (Init.Nat.add n1 n2) n3 match Heq in (eq _ N) return (word N) with | eq_refl => w end) *)
  induction n1 as [|n1 IHn1]; simpl; intros n2 n3 Heq w; intuition.

(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite (UIP_dec eq_nat_dec Heq (refl_equal _)); reflexivity.

(* Goal: @eq (word n3) (split2 n2 n3 (split2 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) w))) (split2 (Init.Nat.add n1 n2) n3 (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq in (eq _ N) return (word N) with | eq_refl => w end)) *)
  rewrite (IHn1 _ _ (plus_assoc _ _ _)).
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: @eq (word (Nat.add (Nat.add n1 n2) n3)) match Nat.add_assoc n1 n2 n3 in (eq _ N) return (word N) with | eq_refl => @wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) w end (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq in (eq _ N) return (word N) with | eq_refl => w end) *)
  apply wtl_match.
Qed.

Theorem split1_split2 : forall n1 n2 n3 Heq w,
  split1 n2 n3 (split2 n1 (n2 + n3) w) =
  split2 n1 n2 (split1 (n1 + n2) n3 (match Heq in _ = N return word N with
                                     | refl_equal => w
                                     end)).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction n1; simpl; intros.

(* Goal: @eq (word (Init.Nat.add n2 n3)) (@combine n2 (split1 n2 n3 w) n3 (split2 n2 n3 match Heq in (eq _ N) return (word N) with | eq_refl => w end)) w *)
(* Goal: @eq (word (Init.Nat.add n2 n3)) (@combine n2 (split1 n2 n3 (split2 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) w))) n3 (split2 (Init.Nat.add n1 n2) n3 (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq in (eq _ N) return (word N) with | eq_refl => w end))) (split2 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) w)) *)
  rewrite (UIP_dec eq_nat_dec Heq (refl_equal _)).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.

(* Goal: @eq (word n2) (split2 n1 n2 (split1 (Init.Nat.add n1 n2) n3 (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) w))) (split1 n2 n3 (split2 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) match Heq in (eq _ N) return (word N) with | eq_refl => w end))) *)
  rewrite (shatter_word w).
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (n1 + (n2 + n3) = n1 + n2 + n3) as Heq' by omega.
  rewrite <- wtl_match with (Heq':=Heq').
  rewrite <- IHn1.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
Qed.

Theorem split2_split1 : forall n1 n2 n3 Heq w,
  split2 n1 n2 (split1 (n1+n2) n3 w) =
  split1 n2 n3 (split2 n1 (n2+n3) (match Heq in _ = N return word N with
                                     | refl_equal => w
                                     end)).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction n1; simpl; intros.

(* Goal: @eq (word (Init.Nat.add n2 n3)) (@combine n2 (split1 n2 n3 w) n3 (split2 n2 n3 match Heq in (eq _ N) return (word N) with | eq_refl => w end)) w *)
(* Goal: @eq (word (Init.Nat.add n2 n3)) (@combine n2 (split1 n2 n3 (split2 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) w))) n3 (split2 (Init.Nat.add n1 n2) n3 (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq in (eq _ N) return (word N) with | eq_refl => w end))) (split2 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) w)) *)
  rewrite (UIP_dec eq_nat_dec Heq (refl_equal _)).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.

(* Goal: @eq (word n2) (split2 n1 n2 (split1 (Init.Nat.add n1 n2) n3 (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) w))) (split1 n2 n3 (split2 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) match Heq in (eq _ N) return (word N) with | eq_refl => w end))) *)
  rewrite (shatter_word w).
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (n1 + n2 + n3 = n1 + (n2 + n3)) as Heq' by omega.
  rewrite <- wtl_match with (Heq':=Heq').
  rewrite <- IHn1.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
Qed.

Theorem combine_0_n : forall sz2 (w: word 0) (v: word sz2),
  combine w v = v.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add O sz2)) (@combine O w sz2 v) v *)
  replace w with WO.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite word0; auto.
Qed.

Lemma WS_eq_rect : forall b n (w: word n) n' H H',
  eq_rect _ word (@WS b n w) _ H = @WS b n' (eq_rect _ word w _ H').
Proof.
  destruct n; intros; subst;
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    eq_rect_simpl; auto.
Qed.

Theorem combine_eq_rect2 : forall sz n n'
  (H: n = n') H'
  (a: word sz) (b: word n),
  combine a b =
    eq_rect _ word (combine a (eq_rect _ word b _ H)) _ H'.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction a; simpl; intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  eq_rect_simpl; auto.
  erewrite WS_eq_rect.
  erewrite IHa.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.

  Grab Existential Variables.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Theorem combine_n_0 : forall sz1 (w : word sz1) (v : word 0),
  combine w v = eq_rect _ word w _ (plus_n_O sz1).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction w; intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  - replace v with WO; auto.
  - simpl; rewrite IHw.
    erewrite WS_eq_rect.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
Qed.

Lemma whd_eq_rect : forall n w Heq,
  whd (eq_rect (S n) word w (S (n + 0)) Heq) =
  whd w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.mul n (S O))) (@wtl (Init.Nat.mul n (S O)) (@eq_rect nat (S n) word (@WS b n w) (S (Init.Nat.mul n (S O))) Heq)) (@eq_rect nat n word w (Init.Nat.mul n (S O)) Heq') *)
  generalize Heq.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (n + 0) with n by omega.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wtl_eq_rect : forall n w Heq Heq',
  wtl (eq_rect (S n) word w (S (n + 0)) Heq) =
  eq_rect n word (wtl w) (n + 0) Heq'.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: forall w : word (Init.Nat.add n1 n2), @eq (word n1) (split1 n1 n2 w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2) (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  generalize dependent Heq.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  rewrite <- Heq'; simpl; intros.
(* Goal: @eq (word n1) (split1 n1 n2' w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2') (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  rewrite <- (eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma whd_eq_rect_mul : forall n w Heq,
  whd (eq_rect (S n) word w (S (n * 1)) Heq) =
  whd w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.mul n (S O))) (@wtl (Init.Nat.mul n (S O)) (@eq_rect nat (S n) word (@WS b n w) (S (Init.Nat.mul n (S O))) Heq)) (@eq_rect nat n word w (Init.Nat.mul n (S O)) Heq') *)
  generalize Heq.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  replace (n * 1) with n by auto.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wtl_eq_rect_mul : forall n w b Heq Heq',
  wtl (eq_rect (S n) word (WS b w) (S (n * 1)) Heq) =
  eq_rect _ word w _ Heq'.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.mul n (S O))) (@wtl (Init.Nat.mul n (S O)) (@eq_rect nat (S n) word (@WS b n w) (S (Init.Nat.mul n (S O))) Heq)) (@eq_rect nat n word w (Init.Nat.mul n (S O)) Heq') *)
  generalize Heq.
  rewrite <- Heq'.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. eq_rect_simpl.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem split1_0 : forall n w Heq,
  split1 n 0 (eq_rect _ word w _ Heq) = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction n; intros.
(* Goal: forall w1 w2 : word O, @eq (word O) (@bitwp xorb O w1 w2) (@bitwp xorb O w2 w1) *)
(* Goal: forall w1 w2 : word (S sz), @eq (word (S sz)) (@bitwp xorb (S sz) w1 w2) (@bitwp xorb (S sz) w2 w1) *)
  shatterer.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
  erewrite wtl_eq_rect.
(* Goal: @eq (word (S (Init.Nat.add n sz))) (@WS false (Init.Nat.add n sz) (@combine n (natToWord n O) sz (@wneg sz w))) (@WS false (Init.Nat.add n sz) (@wneg (Init.Nat.add n sz) (@combine n (natToWord n O) sz w))) *)
  rewrite IHn.
  rewrite whd_eq_rect.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: forall w1 w2 : word O, @eq (word O) (@bitwp xorb O w1 w2) (@bitwp xorb O w2 w1) *)
(* Goal: forall w1 w2 : word (S sz), @eq (word (S sz)) (@bitwp xorb (S sz) w1 w2) (@bitwp xorb (S sz) w2 w1) *)
  shatterer.

  Grab Existential Variables.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Theorem split2_0 : forall n w Heq,
  split2 0 n (eq_rect _ word w _ Heq) = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem combine_end : forall n1 n2 n3 Heq w,
  combine (split1 n2 n3 (split2 n1 (n2 + n3) w))
  (split2 (n1 + n2) n3 (match Heq in _ = N return word N with
                          | refl_equal => w
                        end))
  = split2 n1 (n2 + n3) w.
(* Goal: forall (n1 n2 n3 : nat) (Heq : @eq nat (Init.Nat.add n1 (Init.Nat.add n2 n3)) (Init.Nat.add (Init.Nat.add n1 n2) n3)) (w : word (Init.Nat.add n1 (Init.Nat.add n2 n3))), @eq (word (Init.Nat.add n2 n3)) (@combine n2 (split1 n2 n3 (split2 n1 (Init.Nat.add n2 n3) w)) n3 (split2 (Init.Nat.add n1 n2) n3 match Heq in (eq _ N) return (word N) with | eq_refl => w end)) (split2 n1 (Init.Nat.add n2 n3) w) *)
  induction n1 as [|n1 IHn1]; simpl; intros n2 n3 Heq w.

(* Goal: @eq (word (Init.Nat.add n2 n3)) (@combine n2 (split1 n2 n3 w) n3 (split2 n2 n3 match Heq in (eq _ N) return (word N) with | eq_refl => w end)) w *)
(* Goal: @eq (word (Init.Nat.add n2 n3)) (@combine n2 (split1 n2 n3 (split2 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) w))) n3 (split2 (Init.Nat.add n1 n2) n3 (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq in (eq _ N) return (word N) with | eq_refl => w end))) (split2 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) w)) *)
  rewrite (UIP_dec eq_nat_dec Heq (refl_equal _)).
(* Goal: @eq (word (Init.Nat.add n1 n2)) (@combine n1 (split1 n1 n2 w) n2 (split2 n1 n2 w)) w *)
  apply combine_split.

(* Goal: @eq (word (Init.Nat.add n2 n3)) (@combine n2 (split1 n2 n3 (split2 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) w))) n3 (split2 (Init.Nat.add n1 n2) n3 (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq in (eq _ N) return (word N) with | eq_refl => w end))) (split2 n1 (Init.Nat.add n2 n3) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) n1 (Init.Nat.add n2 n3)) w)) *)
  rewrite (shatter_word w) in *.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: @eq (word (Init.Nat.add n2 n3)) (@combine n2 (split1 n2 n3 (split2 n1 (Init.Nat.add n2 n3) (@wtl (Init.Nat.add n1 (Init.Nat.add n2 n3)) w))) n3 (split2 (Init.Nat.add n1 n2) n3 (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq in (eq _ N) return (word N) with | eq_refl => @WS (@whd (Init.Nat.add n1 (Init.Nat.add n2 n3)) w) (Init.Nat.add n1 (Init.Nat.add n2 n3)) (@wtl (Init.Nat.add n1 (Init.Nat.add n2 n3)) w) end))) (split2 n1 (Init.Nat.add n2 n3) (@wtl (Init.Nat.add n1 (Init.Nat.add n2 n3)) w)) *)
  eapply trans_eq; [ | apply IHn1 with (Heq := plus_assoc _ _ _) ]; clear IHn1.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  repeat f_equal.
  repeat match goal with
           | [ |- context[match ?pf with refl_equal => _ end] ] => generalize pf
         end.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
(* Goal: forall (w : word (S (Init.Nat.add n1 (Init.Nat.add n2 n3)))) (e : @eq nat (Nat.add n1 (Nat.add n2 n3)) (Nat.add (Nat.add n1 n2) n3)) (Heq : @eq nat (S (Init.Nat.add n1 (Init.Nat.add n2 n3))) (S (Init.Nat.add (Init.Nat.add n1 n2) n3))), @eq (word ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3)) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq in (eq _ N) return (word N) with | eq_refl => @WS (@whd (Init.Nat.add n1 (Init.Nat.add n2 n3)) w) (Init.Nat.add n1 (Init.Nat.add n2 n3)) (@wtl (Init.Nat.add n1 (Init.Nat.add n2 n3)) w) end) match e in (eq _ N) return (word N) with | eq_refl => @wtl (Init.Nat.add n1 (Init.Nat.add n2 n3)) w end *)
  rewrite plus_assoc.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3)) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq0 in (eq _ N) return (word N) with | eq_refl => @WS (@whd (Nat.add (Nat.add n1 n2) n3) w) (Nat.add (Nat.add n1 n2) n3) (@wtl (Nat.add (Nat.add n1 n2) n3) w) end) match e in (eq _ N) return (word N) with | eq_refl => @wtl (Nat.add (Nat.add n1 n2) n3) w end *)
  rewrite (UIP_dec eq_nat_dec e (refl_equal _)).
(* Goal: @eq (word ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3)) (@wtl ((fix add (n m : nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end) (Init.Nat.add n1 n2) n3) match Heq0 in (eq _ N) return (word N) with | eq_refl => @WS (@whd (Nat.add (Nat.add n1 n2) n3) w) (Nat.add (Nat.add n1 n2) n3) (@wtl (Nat.add (Nat.add n1 n2) n3) w) end) (@wtl (Nat.add (Nat.add n1 n2) n3) w) *)
  rewrite (UIP_dec eq_nat_dec Heq0 (refl_equal _)).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem eq_rect_combine : forall n1 n2 n2' (w1 : word n1) (w2 : word n2') Heq,
  eq_rect (n1 + n2') (fun n => word n)
    (combine w1 w2) (n1 + n2) Heq =
  combine w1 (eq_rect n2' (fun n => word n) w2 n2 (plus_reg_l _ _ _ Heq)).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  generalize (plus_reg_l n2' n2 n1 Heq); intros.
(* Goal: forall w : word (Init.Nat.add n1 n2), @eq (word n1) (split1 n1 n2 w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2) (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  generalize dependent Heq.
(* Goal: forall Heq : @eq nat (Init.Nat.add n1 n2') (Init.Nat.add n1 n2), @eq (word (Init.Nat.add n1 n2)) (@eq_rect nat (Init.Nat.add n1 n2') (fun n : nat => word n) (@combine n1 w1 n2' w2) (Init.Nat.add n1 n2) Heq) (@combine n1 w1 n2 (@eq_rect nat n2' (fun n : nat => word n) w2 n2 e)) *)
  generalize dependent w2.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  rewrite e; intros.
(* Goal: @eq (word n1) (split1 n1 n2' w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2') (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  repeat rewrite <- (eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma eq_rect_combine_assoc' : forall a b c H wa wb wc,
  eq_rect (a + (b + c)) word (combine wa (combine wb wc)) _ H = combine (combine wa wb) wc.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  erewrite combine_assoc, eq_rect_word_match.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma eq_rect_split2_helper : forall a b c,
  a = b -> c + a = c + b.
Proof.
(* Goal: forall (a b c : nat) (_ : le b a) (_ : lt b c) (_ : lt a c), lt (Init.Nat.sub a b) c *)
  intros; omega.
Qed.

Theorem eq_rect_split2 : forall n1 n2 n2' (w : word (n1 + n2')) Heq,
  eq_rect n2' (fun n => word n)
    (split2 n1 n2' w) n2 Heq =
  split2 n1 n2 (eq_rect (n1+n2') (fun n => word n) w (n1+n2) (eq_rect_split2_helper _ Heq)).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  generalize (eq_rect_split2_helper n1 Heq); intros.
(* Goal: forall w : word (Init.Nat.add n1 n2), @eq (word n1) (split1 n1 n2 w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2) (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  generalize dependent Heq.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (n2' = n2) as H' by omega.
(* Goal: forall (w : word (Init.Nat.add n1' n2)) (Heq : @eq nat n1' n1), @eq (word n1) (@eq_rect nat n1' (fun n : nat => word n) (split1 n1' n2 w) n1 Heq) (split1 n1 n2 (@eq_rect nat (Init.Nat.add n1' n2) (fun n : nat => word n) w (Init.Nat.add n1 n2) e)) *)
  generalize dependent e.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  rewrite H'; intros.
(* Goal: @eq (word n1) (split1 n1 n2' w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2') (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  repeat rewrite <- (eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem eq_rect_split2_eq2 : forall n1 n2 n2' (w : word (n1 + n2)) Heq Heq2,
  eq_rect n2 (fun n => word n)
    (split2 n1 n2 w) n2' Heq =
  split2 n1 n2' (eq_rect (n1+n2) (fun n => word n) w (n1+n2') Heq2).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word n2') (@eq_rect nat n2 (fun n : nat => word n) (split2 n1 n2 w) n2' Heq) (split2 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2) (fun n : nat => word n) w (Init.Nat.add n1 n2') Heq2)) *)
  assert (H' := Heq).
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
(* Goal: forall w : word (Init.Nat.add n1 n2), @eq (word n1) (split1 n1 n2 w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2) (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  generalize dependent Heq.
(* Goal: forall (Heq : @eq nat n2 n2') (w : word (Init.Nat.add n1 n2)), @eq (word n2') (@eq_rect nat n2 (fun n : nat => word n) (split2 n1 n2 w) n2' Heq) (split2 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2) (fun n : nat => word n) w (Init.Nat.add n1 n2') Heq2)) *)
  generalize dependent Heq2.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  rewrite H'; intros.
(* Goal: @eq (word n1) (split1 n1 n2' w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2') (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  repeat rewrite <- (eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem eq_rect_split2_eq1 : forall n1 n1' n2 (w: word (n1 + n2)) Heq,
     split2 n1 n2 w = split2 n1' n2
        (eq_rect (n1 + n2) (fun y : nat => word y) w
     (n1' + n2) Heq).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (n1 = n1') as H' by omega.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
(* Goal: forall w : word (Init.Nat.add n1 n2), @eq (word n1) (split1 n1 n2 w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2) (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  generalize dependent Heq.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  rewrite H'; intros.
(* Goal: @eq (word n1) (split1 n1 n2' w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2') (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  rewrite <- (eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem combine_split_eq_rect2 : forall n1 n2 n2' (w : word (n1 + n2)) Heq,
  combine (split1 n1 n2 w)
          (eq_rect n2 (fun n => word n) (split2 n1 n2 w)
                   n2' Heq) =
  eq_rect (n1 + n2) (fun n => word n) w
          (n1 + n2') (eq_rect_split2_helper _ Heq).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (n2 = n2') by omega.
(* Goal: forall w : word (Init.Nat.add n1 n2), @eq (word n1) (split1 n1 n2 w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2) (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  generalize dependent Heq.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  rewrite <- H; intros.
(* Goal: @eq (word n1) (split1 n1 n2' w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2') (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  repeat rewrite <- (eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word (Init.Nat.add n1 n2)) (@combine n1 (split1 n1 n2 w) n2 (split2 n1 n2 w)) w *)
  apply combine_split.
Qed.

Lemma eq_rect_split1_helper : forall a b c,
  a = b -> a + c = b + c.
Proof.
(* Goal: forall (a b c : nat) (_ : le b a) (_ : lt b c) (_ : lt a c), lt (Init.Nat.sub a b) c *)
  intros; omega.
Qed.

Lemma eq_rect_split1_eq2_helper : forall a b c,
  a = b -> c + a = c + b.
Proof.
(* Goal: forall (a b c : nat) (_ : le b a) (_ : lt b c) (_ : lt a c), lt (Init.Nat.sub a b) c *)
  intros; omega.
Qed.

Theorem eq_rect_split1 : forall n1 n1' n2 (w : word (n1' + n2)) Heq,
  eq_rect n1' (fun n => word n)
    (split1 n1' n2 w) n1 Heq =
  split1 n1 n2 (eq_rect (n1'+n2) (fun n => word n) w (n1+n2) (eq_rect_split1_helper _ Heq)).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  generalize (eq_rect_split1_helper n2 Heq); intros.
(* Goal: forall w : word (Init.Nat.add n1 n2), @eq (word n1) (split1 n1 n2 w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2) (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  generalize dependent Heq.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (n1' = n1) as H' by omega.
(* Goal: forall (w : word (Init.Nat.add n1' n2)) (Heq : @eq nat n1' n1), @eq (word n1) (@eq_rect nat n1' (fun n : nat => word n) (split1 n1' n2 w) n1 Heq) (split1 n1 n2 (@eq_rect nat (Init.Nat.add n1' n2) (fun n : nat => word n) w (Init.Nat.add n1 n2) e)) *)
  generalize dependent e.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  rewrite H'; intros.
(* Goal: @eq (word n1) (split1 n1 n2' w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2') (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  repeat rewrite <- (eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem eq_rect_split1_eq1 : forall n1 n1' n2 (w : word (n1 + n2)) Heq Heq1,
  eq_rect n1 (fun n => word n)
    (split1 n1 n2 w) n1' Heq =
  split1 n1' n2 (eq_rect (n1+n2) (fun n => word n) w (n1'+n2) Heq1).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
(* Goal: forall w : word (Init.Nat.add n1 n2), @eq (word n1') (@eq_rect nat n1 (fun n : nat => word n) (split1 n1 n2 w) n1' Heq) (split1 n1' n2 (@eq_rect nat (Init.Nat.add n1 n2) (fun n : nat => word n) w (Init.Nat.add n1' n2) Heq1)) *)
  generalize dependent Heq1.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  rewrite Heq; intros.
(* Goal: @eq (word n1) (split1 n1 n2' w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2') (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  repeat rewrite <- (eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma split1_eq_rect_eq1_helper : forall a b c, b = a -> a + c = b + c.
Proof. intros. subst. reflexivity. Qed.

Theorem split1_eq_rect_eq1 : forall a a' b H w,
  split1 a b w = eq_rect _ word (split1 a' b
    (eq_rect _ word w _ (split1_eq_rect_eq1_helper b H))) _ H.
Proof.
(* Goal: forall (a a' b : nat) (H : @eq nat a' a) (w : word (Init.Nat.add a b)), @eq (word a) (split1 a b w) (@eq_rect nat a' word (split1 a' b (@eq_rect nat (Init.Nat.add a b) word w (Init.Nat.add a' b) (@split1_eq_rect_eq1_helper a a' b H))) a H) *)
  intros a a' b H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  subst a'; intros; eq_rect_simpl; auto.
Qed.

Theorem eq_rect_split1_eq2 : forall n1 n2 n2' (w: word (n1 + n2)) Heq,
     split1 n1 n2 w = split1 n1 n2'
        (eq_rect (n1 + n2) (fun y : nat => word y) w
     (n1 + n2') Heq).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (n2 = n2') as H' by omega.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
(* Goal: forall w : word (Init.Nat.add n1 n2), @eq (word n1) (split1 n1 n2 w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2) (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  generalize dependent Heq.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  rewrite H'; intros.
(* Goal: @eq (word n1) (split1 n1 n2' w) (split1 n1 n2' (@eq_rect nat (Init.Nat.add n1 n2') (fun y : nat => word y) w (Init.Nat.add n1 n2') Heq)) *)
  rewrite <- (eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Fact eq_rect_combine_dist_helper1 : forall a b c d, b * c = d -> (a + b) * c = a * c + d.
Proof. intros; subst. apply Nat.mul_add_distr_r. Qed.

Fact eq_rect_combine_dist_helper2 : forall a b c d, b * c = d -> a * c + d = (a + b) * c.
Proof. intros; subst. symmetry; apply Nat.mul_add_distr_r. Qed.

Theorem eq_rect_combine_dist : forall a b c d (w : word ((a + b) * c)) (H : b * c = d),
  b * c = d ->
  let H1 := (eq_rect_combine_dist_helper1 a b c H) in
  let H2 := (eq_rect_combine_dist_helper2 a b c H) in
  let w' := eq_rec ((a + b) * c) word w _ H1 in
  w = eq_rec _ word (combine (split1 (a * c) d w') (split2 (a * c) d w')) _ H2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.mul (Init.Nat.add a b) c)) w (@eq_rec nat (Init.Nat.add (Init.Nat.mul a c) d) word (@combine (Init.Nat.mul a c) (split1 (Init.Nat.mul a c) d w') d (split2 (Init.Nat.mul a c) d w')) (Init.Nat.mul (Init.Nat.add a b) c) H2) *)
  subst d.
(* Goal: @eq (word (Init.Nat.mul (Init.Nat.add a b) c)) w (@eq_rec nat (Init.Nat.add (Init.Nat.mul a c) (Init.Nat.mul b c)) word (@combine (Init.Nat.mul a c) (split1 (Init.Nat.mul a c) (Init.Nat.mul b c) w') (Init.Nat.mul b c) (split2 (Init.Nat.mul a c) (Init.Nat.mul b c) w')) (Init.Nat.mul (Init.Nat.add a b) c) H2) *)
  rewrite combine_split.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
(* Goal: forall w : word (Init.Nat.mul (Init.Nat.add a b) c), let w' := @eq_rec nat (Init.Nat.mul (Init.Nat.add a b) c) word w (Init.Nat.add (Init.Nat.mul a c) (Init.Nat.mul b c)) H1 in @eq (word (Init.Nat.mul (Init.Nat.add a b) c)) w (@eq_rect nat (Init.Nat.add (Init.Nat.mul a c) (Init.Nat.mul b c)) word w' (Init.Nat.mul (Init.Nat.add a b) c) H2) *)
  generalize dependent H2.
(* Goal: @eq nat (Nat.modulo (Nat.modulo a (Init.Nat.mul b c)) b) (Nat.modulo a b) *)
  rewrite H1.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  eq_rect_simpl; auto.
Qed.

Lemma wzero_dist : forall a b c H,
  wzero ((a + b) * c) = eq_rect _ word (wzero (a * c + b * c)) _ H.
Proof.
(* Goal: forall (a b c : nat) (H : @eq nat (Init.Nat.add (Init.Nat.mul a c) (Init.Nat.mul b c)) (Init.Nat.mul (Init.Nat.add a b) c)), @eq (word (Init.Nat.mul (Init.Nat.add a b) c)) (wzero (Init.Nat.mul (Init.Nat.add a b) c)) (@eq_rect nat (Init.Nat.add (Init.Nat.mul a c) (Init.Nat.mul b c)) word (wzero (Init.Nat.add (Init.Nat.mul a c) (Init.Nat.mul b c))) (Init.Nat.mul (Init.Nat.add a b) c) H) *)
  intros a b c H.
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
  rewrite H.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wzero_rev : forall (a b : nat) H,
   wzero (a + b) = eq_rect _ word (wzero (b + a)) _ H.
Proof. intros a b H. rewrite H. auto. Qed.

Lemma split1_zero : forall sz1 sz2, split1 sz1 sz2 (natToWord _ O) = natToWord _ O.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction sz1; auto; simpl; intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  f_equal. eauto.
Qed.

Lemma split2_zero : forall sz1 sz2, split2 sz1 sz2 (natToWord _ O) = natToWord _ O.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz1; auto.
Qed.

Theorem combine_inj : forall sz1 sz2 a b c d,
  @combine sz1 a sz2 b = @combine sz1 c sz2 d -> a = c /\ b = d.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction sz1; simpl; intros.
  - rewrite (word0 a) in *.
(* Goal: and (@eq (word O) WO c) (@eq (word sz2) b d) *)
    rewrite (word0 c) in *.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
    simpl in *.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
    intuition.
  - rewrite (shatter_word a) in *.
(* Goal: and (@eq (word (S sz1)) (@WS (@whd sz1 a) sz1 (@wtl sz1 a)) c) (@eq (word sz2) b d) *)
    rewrite (shatter_word c) in *.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
    simpl in *.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS false n (natToWord n O)) *)
    inversion H.
(* Goal: and (@eq (word (S sz1)) (@WS (@whd sz1 a) sz1 (@wtl sz1 a)) (@WS (@whd sz1 a) sz1 (@wtl sz1 c))) (@eq (word sz2) b d) *)
    apply (inj_pair2_eq_dec _ eq_nat_dec) in H2.
(* Goal: and (@eq (word (S sz1)) (@WS (@whd sz1 a) sz1 (@wtl sz1 a)) (@WS (@whd sz1 a) sz1 (@wtl sz1 c))) (@eq (word sz2) b d) *)
    destruct (IHsz1 _ _ _ _ _ H2).
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
    intuition.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    f_equal; auto.
Qed.

Theorem combine_wzero : forall sz1 sz2, combine (wzero sz1) (wzero sz2) = wzero (sz1 + sz2).
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz1; auto.
(* Goal: False *)
  unfold wzero in *.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  intros; simpl; f_equal; auto.
Qed.

Theorem combine_wones : forall sz1 sz2, combine (wones sz1) (wones sz2) = wones (sz1 + sz2).
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz1; auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  intros; simpl; f_equal; auto.
Qed.

Theorem wordToN_nat : forall sz (w : word sz), wordToN w = N_of_nat (wordToNat w).
Proof.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  induction w; intuition.
(* Goal: @eq N (@wordToN (S n) (@WS b n w)) (N.of_nat (@wordToNat (S n) (@WS b n w))) *)
  destruct b; unfold wordToN, wordToNat; fold wordToN; fold wordToNat.

(* Goal: @eq N (N.succ (N.mul (Npos (xO xH)) (@wordToN n w))) (N.of_nat (S (Init.Nat.mul (@wordToNat n w) (S (S O))))) *)
(* Goal: @eq N (N.mul (Npos (xO xH)) (@wordToN n w)) (N.of_nat (Init.Nat.mul (@wordToNat n w) (S (S O)))) *)
  rewrite N_of_S.
(* Goal: @eq N (N.mul (Npos (xO xH)) (@wordToN n w)) (N.of_nat (Init.Nat.mul (@wordToNat n w) (S (S O)))) *)
  rewrite N_of_mult.
  rewrite <- IHw.
(* Goal: @eq N (N.mul (Npos (xO xH)) (@wordToN n w)) (N.mul (@wordToN n w) (N.of_nat (S (S O)))) *)
  rewrite Nmult_comm.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.

(* Goal: @eq N (N.mul (Npos (xO xH)) (@wordToN n w)) (N.of_nat (Init.Nat.mul (@wordToNat n w) (S (S O)))) *)
  rewrite N_of_mult.
  rewrite <- IHw.
(* Goal: @eq N (N.mul (Npos (xO xH)) (@wordToN n w)) (N.mul (@wordToN n w) (N.of_nat (S (S O)))) *)
  rewrite Nmult_comm.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wordToN_to_nat sz: forall (w: word sz), BinNat.N.to_nat (wordToN w) = wordToNat w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq N N0 (@wordToN sz (wzero sz)) *)
  rewrite wordToN_nat.
(* Goal: @eq nat (@wordToNat sz (natToWord sz (Init.Nat.sub (N.to_nat (N.of_nat (Nat.pow (S (S O)) sz))) (@wordToNat sz a)))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite Nnat.Nat2N.id.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
Local Hint Extern 1 (@eq nat _ _) => omega.

Theorem mod2_S : forall n k,
  2 * k = S n
  -> mod2 n = true.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction n as [n] using strong; intros.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  destruct n; simpl in *.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  elimtype False; omega.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct n; simpl in *; auto.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  destruct k as [|k]; simpl in *.
(* Goal: False *)
  discriminate.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply H with k; auto.
Qed.

Theorem wzero'_def : forall sz, wzero' sz = wzero sz.
(* Goal: forall sz : nat, @eq nat (@wordToNat sz (natToWord sz O)) O *)
  unfold wzero; induction sz; simpl; intuition.
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
  congruence.
Qed.

Theorem posToWord_nat : forall p sz, posToWord sz p = natToWord sz (nat_of_P p).
(* Goal: forall (p : positive) (sz : nat), @eq (word sz) (posToWord sz p) (natToWord sz (Pos.to_nat p)) *)
  induction p as [ p IHp | p IHp | ]; destruct sz; simpl; intuition; f_equal; try rewrite wzero'_def in *.

(* Goal: @eq (word sz) (natToWord sz (Pos.iter_op nat Init.Nat.add p (S O))) (natToWord sz (Nat.div2 (Pos.iter_op nat Init.Nat.add p (S (S O))))) *)
(* Goal: @eq (word sz) (wzero sz) (natToWord sz O) *)
  rewrite ZL6.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  destruct (ZL4 p) as [x Heq]; rewrite Heq; simpl.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (x + S x) with (S (2 * x)) by omega.
(* Goal: @eq bool true (mod2 (S (Init.Nat.mul (S (S O)) x))) *)
(* Goal: @eq (word sz) (posToWord sz p) (natToWord sz match Pos.iter_op nat Init.Nat.add p (S (S O)) with | O => O | S n' => S (Nat.div2 n') end) *)
(* Goal: @eq bool false (mod2 (Pos.to_nat (xO p))) *)
(* Goal: @eq (word sz) (posToWord sz p) (natToWord sz (Nat.div2 (Pos.to_nat (xO p)))) *)
(* Goal: @eq (word sz) (wzero sz) (natToWord sz O) *)
  symmetry; apply mod2_S_double.

(* Goal: @eq (word sz) (posToWord sz p) (natToWord sz (Nat.div2 (Pos.to_nat (xO p)))) *)
(* Goal: @eq (word sz) (wzero sz) (natToWord sz O) *)
  rewrite IHp.
(* Goal: @eq (word sz) (natToWord sz (Pos.iter_op nat Init.Nat.add p (S O))) (natToWord sz (Nat.div2 (Pos.iter_op nat Init.Nat.add p (S (S O))))) *)
(* Goal: @eq (word sz) (wzero sz) (natToWord sz O) *)
  rewrite ZL6.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct (nat_of_P p); simpl; intuition.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (n + S n) with (S (2 * n)) by omega.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite div2_S_double; auto.

(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  unfold nat_of_P; simpl.
(* Goal: @eq (word sz) (natToWord sz (Pos.iter_op nat Init.Nat.add p (S O))) (natToWord sz (Nat.div2 (Pos.iter_op nat Init.Nat.add p (S (S O))))) *)
(* Goal: @eq (word sz) (wzero sz) (natToWord sz O) *)
  rewrite ZL6.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (nat_of_P p + nat_of_P p) with (2 * nat_of_P p) by omega.
(* Goal: @eq bool (mod2 (Init.Nat.mul (S (S O)) x)) false *)
  symmetry; apply mod2_double.

(* Goal: @eq (word sz) (posToWord sz p) (natToWord sz (Nat.div2 (Pos.to_nat (xO p)))) *)
(* Goal: @eq (word sz) (wzero sz) (natToWord sz O) *)
  rewrite IHp.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  unfold nat_of_P; simpl.
(* Goal: @eq (word sz) (natToWord sz (Pos.iter_op nat Init.Nat.add p (S O))) (natToWord sz (Nat.div2 (Pos.iter_op nat Init.Nat.add p (S (S O))))) *)
(* Goal: @eq (word sz) (wzero sz) (natToWord sz O) *)
  rewrite ZL6.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (nat_of_P p + nat_of_P p) with (2 * nat_of_P p) by omega.
(* Goal: @eq (word sz) (natToWord sz (Pos.iter_op nat Init.Nat.add p (S O))) (natToWord sz (Nat.div2 (Init.Nat.mul (S (S O)) (Pos.to_nat p)))) *)
(* Goal: @eq (word sz) (wzero sz) (natToWord sz O) *)
  rewrite div2_double.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma posToWord_sz0: forall p, posToWord 0 p = $0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold posToWord. destruct p; reflexivity.
Qed.

Theorem NToWord_nat : forall sz n, NToWord sz n = natToWord sz (nat_of_N n).
(* Goal: forall (sz : nat) (n : N), @eq (word sz) (NToWord sz n) (natToWord sz (N.to_nat n)) *)
  destruct n; simpl; intuition; try rewrite wzero'_def in *.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
(* Goal: @eq (word sz) (posToWord sz p) (natToWord sz (Pos.to_nat p)) *)
  apply posToWord_nat.
Qed.

Theorem wplus_alt : forall sz (x y : word sz), wplus x y = wplusN x y.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wplusN, wplus, wordBinN, wordBin; intros.

(* Goal: @eq (word sz) (NToWord sz (N.sub (Npow2 sz) (@wordToN sz x))) (natToWord sz (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz x))) *)
  repeat rewrite wordToN_nat; repeat rewrite NToWord_nat.
(* Goal: @eq (word sz) (natToWord sz (N.to_nat (N.add (N.of_nat (@wordToNat sz x)) (N.of_nat (@wordToNat sz y))))) (natToWord sz (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y))) *)
  rewrite nat_of_Nplus.
(* Goal: @eq (word sz) (natToWord sz (Init.Nat.mul (N.to_nat (N.of_nat (@wordToNat sz x))) (N.to_nat (N.of_nat (@wordToNat sz y))))) (natToWord sz (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz y))) *)
  repeat rewrite nat_of_N_of_nat.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem wmult_alt : forall sz (x y : word sz), wmult x y = wmultN x y.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wmultN, wmult, wordBinN, wordBin; intros.

(* Goal: @eq (word sz) (NToWord sz (N.sub (Npow2 sz) (@wordToN sz x))) (natToWord sz (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz x))) *)
  repeat rewrite wordToN_nat; repeat rewrite NToWord_nat.
(* Goal: @eq (word sz) (natToWord sz (N.to_nat (N.mul (N.of_nat (@wordToNat sz x)) (N.of_nat (@wordToNat sz y))))) (natToWord sz (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz y))) *)
  rewrite nat_of_Nmult.
(* Goal: @eq (word sz) (natToWord sz (Init.Nat.mul (N.to_nat (N.of_nat (@wordToNat sz x))) (N.to_nat (N.of_nat (@wordToNat sz y))))) (natToWord sz (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz y))) *)
  repeat rewrite nat_of_N_of_nat.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem wneg_alt : forall sz (x : word sz), wneg x = wnegN x.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wnegN, wneg; intros.
(* Goal: @eq (word sz) (NToWord sz (N.sub (Npow2 sz) (@wordToN sz x))) (natToWord sz (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz x))) *)
  repeat rewrite wordToN_nat; repeat rewrite NToWord_nat.
(* Goal: @eq (word sz) (natToWord sz (N.to_nat (N.sub (Npow2 sz) (N.of_nat (@wordToNat sz x))))) (natToWord sz (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz x))) *)
  rewrite nat_of_Nminus.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  do 2 f_equal.
(* Goal: @eq nat (N.to_nat (Npow2 sz)) (Nat.pow (S (S O)) sz) *)
(* Goal: @eq nat (N.to_nat (N.of_nat (@wordToNat sz x))) (@wordToNat sz x) *)
  apply Npow2_nat.
(* Goal: @eq nat (N.to_nat (N.of_nat (@wordToNat sz x))) (@wordToNat sz x) *)
  apply nat_of_N_of_nat.
Qed.

Theorem wminus_Alt : forall sz (x y : word sz), wminus x y = wminusN x y.
(* Goal: forall (sz : nat) (x y : word sz), @eq (word sz) (@wminus sz x y) (@wminusN sz x y) *)
  intros; unfold wminusN, wminus; rewrite wneg_alt; apply wplus_alt.
Qed.

Theorem wplus_unit : forall sz (x : word sz), natToWord sz 0 ^+ x = x.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros; rewrite wplus_alt; unfold wplusN, wordBinN; intros.
(* Goal: @eq (word sz) (natToWord sz (Init.Nat.add (@wordToNat sz (natToWord sz O)) (@wordToNat sz x))) x *)
  rewrite roundTrip_0; apply natToWord_wordToNat.
Qed.

Theorem wplus_comm : forall sz (x y : word sz), x ^+ y = y ^+ x.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  intros; repeat rewrite wplus_alt; unfold wplusN, wordBinN; f_equal; auto.
Qed.

Theorem drop_sub :
  forall sz n k,
    (k * pow2 sz <= n)%nat ->
    natToWord sz (n - k * pow2 sz) = natToWord sz n.
Proof.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  induction sz as [|sz IHsz]; simpl; intros n k *; intuition; repeat rewrite untimes2 in *; f_equal.

(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz z) x1) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Nat.mul (@wordToNat sz z) (@wordToNat sz y))) *)
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
  rewrite mult_assoc.
(* Goal: @eq (word sz) (natToWord sz (Nat.div2 (Init.Nat.sub n (Nat.mul (Nat.mul k (S (S O))) (Nat.pow (S (S O)) sz))))) (natToWord sz (Init.Nat.sub (Nat.div2 n) (Init.Nat.mul k (Nat.pow (S (S O)) sz)))) *)
(* Goal: le (Init.Nat.mul k (Nat.pow (S (S O)) sz)) (Nat.div2 n) *)
  rewrite (mult_comm k).
(* Goal: le (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Nat.pow (S (S O)) sz2)) *)
  rewrite <- mult_assoc.
(* Goal: @eq bool (mod2 (Init.Nat.sub n (Nat.mul (S (S O)) (Nat.mul k (Nat.pow (S (S O)) sz))))) (mod2 n) *)
(* Goal: @eq (word sz) (natToWord sz (Nat.div2 (Init.Nat.sub n (Init.Nat.mul k (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz)))))) (natToWord sz (Nat.div2 n)) *)
  apply drop_mod2.
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz z) x1) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Nat.mul (@wordToNat sz z) (@wordToNat sz y))) *)
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
  rewrite mult_assoc.
(* Goal: le (Nat.mul (Nat.mul (S (S O)) k) (Nat.pow (S (S O)) sz)) n *)
  rewrite (mult_comm 2).
(* Goal: le (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Nat.pow (S (S O)) sz2)) *)
  rewrite <- mult_assoc.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.

  rewrite <- (IHsz (div2 n) k).
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz z) x1) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Nat.mul (@wordToNat sz z) (@wordToNat sz y))) *)
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
  rewrite mult_assoc.
(* Goal: @eq (word sz) (natToWord sz (Nat.div2 (Init.Nat.sub n (Nat.mul (Nat.mul k (S (S O))) (Nat.pow (S (S O)) sz))))) (natToWord sz (Init.Nat.sub (Nat.div2 n) (Init.Nat.mul k (Nat.pow (S (S O)) sz)))) *)
(* Goal: le (Init.Nat.mul k (Nat.pow (S (S O)) sz)) (Nat.div2 n) *)
  rewrite (mult_comm k).
(* Goal: le (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Nat.pow (S (S O)) sz2)) *)
  rewrite <- mult_assoc.
(* Goal: @eq (word sz) (natToWord sz (Nat.div2 (Init.Nat.sub n (Nat.mul (S (S O)) (Nat.mul k (Nat.pow (S (S O)) sz)))))) (natToWord sz (Init.Nat.sub (Nat.div2 n) (Init.Nat.mul k (Nat.pow (S (S O)) sz)))) *)
(* Goal: le (Init.Nat.mul k (Nat.pow (S (S O)) sz)) (Nat.div2 n) *)
  rewrite div2_minus_2.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz z) x1) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Nat.mul (@wordToNat sz z) (@wordToNat sz y))) *)
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
  rewrite mult_assoc.
(* Goal: le (Nat.mul (Nat.mul (S (S O)) k) (Nat.pow (S (S O)) sz)) n *)
  rewrite (mult_comm 2).
(* Goal: le (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Nat.pow (S (S O)) sz2)) *)
  rewrite <- mult_assoc.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.

(* Goal: le (Init.Nat.mul k (Nat.pow (S (S O)) sz)) (Nat.div2 n) *)
  apply div2_bound.
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz z) x1) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Nat.mul (@wordToNat sz z) (@wordToNat sz y))) *)
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
  rewrite mult_assoc.
(* Goal: le (Nat.mul (Nat.mul (S (S O)) k) (Nat.pow (S (S O)) sz)) n *)
  rewrite (mult_comm 2).
(* Goal: le (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Nat.pow (S (S O)) sz2)) *)
  rewrite <- mult_assoc.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
Local Hint Extern 1 (_ <= _)%nat => omega.

Theorem wplus_assoc : forall sz (x y z : word sz), x ^+ (y ^+ z) = x ^+ y ^+ z.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros sz x y z *; repeat rewrite wplus_alt; unfold wplusN, wordBinN; intros.

  repeat match goal with
           | [ |- context[wordToNat (natToWord ?sz ?w)] ] =>
             let Heq := fresh "Heq" in
               destruct (wordToNat_natToWord sz w) as [? [Heq ?]]; rewrite Heq
         end.

  match goal with
  | [ |- context[wordToNat ?x + wordToNat ?y - ?x1 * pow2 ?sz + wordToNat ?z] ]
    => replace (wordToNat x + wordToNat y - x1 * pow2 sz + wordToNat z)
      with (wordToNat x + wordToNat y + wordToNat z - x1 * pow2 sz) by auto
  end.
  match goal with
  | [ |- context[wordToNat ?x + (wordToNat ?y + wordToNat ?z - ?x0 * pow2 ?sz)] ]
    => replace (wordToNat x + (wordToNat y + wordToNat z - x0 * pow2 sz))
      with (wordToNat x + wordToNat y + wordToNat z - x0 * pow2 sz) by auto
  end.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  repeat rewrite drop_sub; auto.
Qed.

Theorem roundTrip_1 : forall sz, wordToNat (natToWord (S sz) 1) = 1.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  induction sz; simpl in *; intuition.
Qed.

Theorem roundTrip_1': forall sz, sz <> 0 -> wordToNat (natToWord sz 1) = 1.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (ZToWord sz (Z.add (@wordToZ sz w1) (@wordToZ sz (@wneg sz w2)))) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  destruct sz.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  - tauto.
  - apply roundTrip_1.
Qed.


Theorem mod2_WS : forall sz (x : word sz) b, mod2 (wordToNat (WS b x)) = b.
(* Goal: forall (sz : nat) (x : word sz) (b : bool), @eq bool (mod2 (@wordToNat (S sz) (@WS b sz x))) b *)
  intros sz x b. rewrite wordToNat_wordToNat'.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  destruct b; simpl.

(* Goal: @eq bool match Init.Nat.add (@wordToNat sz x) (Init.Nat.add (@wordToNat sz x) O) with | O => true | S n' => mod2 n' end true *)
(* Goal: @eq bool (mod2 (Init.Nat.add (@wordToNat sz x) (Init.Nat.add (@wordToNat sz x) O))) false *)
  rewrite untimes2.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  case_eq (2 * wordToNat x); intuition.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  eapply mod2_S; eauto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite <- (mod2_double (wordToNat x)); f_equal; omega.
Qed.

Theorem div2_WS : forall sz (x : word sz) b, div2 (wordToNat (WS b x)) = wordToNat x.
(* Goal: forall (sz : nat) (x : word sz) (b : bool), @eq nat (Nat.div2 (@wordToNat (S sz) (@WS b sz x))) (@wordToNat sz x) *)
  destruct b; rewrite wordToNat_wordToNat'; unfold wordToNat'; fold wordToNat'.
(* Goal: @eq nat (Nat.div2 (S (Init.Nat.mul (S (S O)) (@wordToNat sz x)))) (@wordToNat sz x) *)
(* Goal: @eq nat (Nat.div2 (Init.Nat.mul (S (S O)) (@wordToNat sz x))) (@wordToNat sz x) *)
  apply div2_S_double.
(* Goal: @eq nat (Nat.div2 (Init.Nat.mul (S (S O)) (@wordToNat sz x))) (@wordToNat sz x) *)
  apply div2_double.
Qed.

Theorem wmult_unit : forall sz (x : word sz), natToWord sz 1 ^* x = x.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros sz x; rewrite wmult_alt; unfold wmultN, wordBinN; intros.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  destruct sz; simpl.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite (shatter_word x); reflexivity.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  rewrite roundTrip_0; simpl.
(* Goal: @eq (word (S sz)) (@WS (mod2 (Init.Nat.add (@wordToNat (S sz) x) O)) sz (natToWord sz (Nat.div2 (Init.Nat.add (@wordToNat (S sz) x) O)))) x *)
  rewrite plus_0_r.
(* Goal: @eq (word (S sz)) (@WS (mod2 (@wordToNat (S sz) x)) sz (natToWord sz (Nat.div2 (@wordToNat (S sz) x)))) x *)
  rewrite (shatter_word x).
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.

(* Goal: @eq bool (mod2 (@wordToNat (S sz) (@WS (@whd sz x) sz (@wtl sz x)))) (@whd sz x) *)
(* Goal: @eq (word sz) (natToWord sz (Nat.div2 (@wordToNat (S sz) (@WS (@whd sz x) sz (@wtl sz x))))) (@wtl sz x) *)
  apply mod2_WS.

(* Goal: @eq (word sz) (natToWord sz (Nat.div2 (@wordToNat (S sz) (@WS (@whd sz x) sz (@wtl sz x))))) (@wtl sz x) *)
  rewrite div2_WS.
(* Goal: @eq (word sz) (natToWord sz (@wordToNat sz w)) w *)
  apply natToWord_wordToNat.
Qed.

Theorem wmult_comm : forall sz (x y : word sz), x ^* y = y ^* x.
(* Goal: forall (sz : nat) (x y : word sz), @eq (word sz) (@wmult sz x y) (@wmult sz y x) *)
  intros; repeat rewrite wmult_alt; unfold wmultN, wordBinN; auto with arith.
Qed.

Theorem wmult_unit_r : forall sz (x : word sz), x ^* natToWord sz 1 = x.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wmult sz x (natToWord sz (S O))) x *)
  rewrite wmult_comm.
(* Goal: @eq (word sz) (@wmult sz (natToWord sz (S O)) x) x *)
  apply wmult_unit.
Qed.

Lemma wmult_neut_l: forall (sz : nat) (x : word sz), $0 ^* x = $0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold wmult. unfold wordBin. do 2 rewrite wordToN_nat.
  rewrite <- Nnat.Nat2N.inj_mul. rewrite roundTrip_0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite Nat.mul_0_l. simpl. rewrite wzero'_def. reflexivity.
Qed.

Lemma wmult_neut_r: forall (sz : nat) (x : word sz), x ^* $0 = $0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold wmult. unfold wordBin. do 2 rewrite wordToN_nat.
  rewrite <- Nnat.Nat2N.inj_mul. rewrite roundTrip_0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite Nat.mul_0_r. simpl. rewrite wzero'_def. reflexivity.
Qed.

Theorem wmult_assoc : forall sz (x y z : word sz), x ^* (y ^* z) = x ^* y ^* z.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros sz x y z; repeat rewrite wmult_alt; unfold wmultN, wordBinN; intros.

  repeat match goal with
           | [ |- context[wordToNat (natToWord ?sz ?w)] ] =>
             let Heq := fresh "Heq" in
               destruct (wordToNat_natToWord sz w) as [? [Heq ?]]; rewrite Heq
         end.

(* Goal: @eq (word sz) (natToWord sz (Init.Nat.mul (@wordToNat sz x) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x0 (Nat.pow (S (S O)) sz))))) (natToWord sz (Init.Nat.mul (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz y)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (@wordToNat sz z))) *)
  rewrite mult_minus_distr_l.
(* Goal: @eq (word sz) (natToWord sz (Init.Nat.mul (Init.Nat.sub (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y)) (Init.Nat.mul x0 (Nat.pow (S (S O)) sz))) (@wordToNat sz z))) (natToWord sz (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))))) *)
  rewrite mult_minus_distr_r.
  match goal with
  | [ |- natToWord _ (_ - _ * (?x0' * _)) = natToWord _ (_ - ?x1' * _ * _) ]
    => rename x0' into x0, x1' into x1 (* force the names to not be autogenerated *)
  end.
(* Goal: @eq (word sz) (natToWord sz (Nat.sub (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Nat.mul (@wordToNat sz x) (Init.Nat.mul x0 (Nat.pow (S (S O)) sz))))) (natToWord sz (Nat.sub (Nat.mul (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz y)) (@wordToNat sz z)) (Nat.mul (Init.Nat.mul x1 (Nat.pow (S (S O)) sz)) (@wordToNat sz z)))) *)
  rewrite (mult_assoc (wordToNat x) x0).
  rewrite <- (mult_assoc x1).
(* Goal: @eq (word sz) (natToWord sz (Nat.sub (Nat.mul (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y)) (@wordToNat sz z)) (Nat.mul x0 (Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz z))))) (natToWord sz (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))))) *)
  rewrite (mult_comm (pow2 sz)).
(* Goal: @eq (word sz) (natToWord sz (Nat.sub (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)))) (natToWord sz (Nat.sub (Nat.mul (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz y)) (@wordToNat sz z)) (Nat.mul x1 (Nat.mul (@wordToNat sz z) (Nat.pow (S (S O)) sz))))) *)
  rewrite (mult_assoc x1).
(* Goal: @eq (word sz) (natToWord sz (Nat.sub (Nat.mul (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y)) (@wordToNat sz z)) (Nat.mul (Nat.mul x0 (@wordToNat sz z)) (Nat.pow (S (S O)) sz)))) (natToWord sz (Init.Nat.sub (Init.Nat.sub (Init.Nat.add (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
(* Goal: @eq nat (Init.Nat.sub (Init.Nat.sub (Init.Nat.add (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))) (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
  repeat rewrite drop_sub; auto with arith.
(* Goal: le (Init.Nat.mul (Nat.mul x1 (@wordToNat sz z)) (Nat.pow (S (S O)) sz)) (Nat.mul (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz y)) (@wordToNat sz z)) *)
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
  rewrite (mult_comm x1).
  rewrite <- (mult_assoc (wordToNat x)).
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz z) x1) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
  rewrite (mult_comm (wordToNat y)).
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz z) x1) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Nat.mul (@wordToNat sz z) (@wordToNat sz y))) *)
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
  rewrite mult_assoc.
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz z) x1) (Nat.pow (S (S O)) sz)) (Nat.mul (Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (@wordToNat sz y)) *)
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz x) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (@wordToNat sz x) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) *)
  rewrite (mult_comm (wordToNat x)).
(* Goal: le (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Nat.pow (S (S O)) sz2)) *)
  repeat rewrite <- mult_assoc.
(* Goal: le (Nat.mul (@wordToNat sz z) (Nat.mul x0 (Nat.pow (S (S O)) sz))) (Nat.mul (@wordToNat sz z) (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y))) *)
(* Goal: @eq nat (Init.Nat.sub (Init.Nat.sub (Init.Nat.add (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))) (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
  auto with arith.
(* Goal: le (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Nat.pow (S (S O)) sz2)) *)
  repeat rewrite <- mult_assoc.
(* Goal: le (Nat.mul (@wordToNat sz z) (Nat.mul x0 (Nat.pow (S (S O)) sz))) (Nat.mul (@wordToNat sz z) (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y))) *)
(* Goal: @eq nat (Init.Nat.sub (Init.Nat.sub (Init.Nat.add (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))) (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
  auto with arith.
Qed.

Theorem wmult_plus_distr : forall sz (x y z : word sz), (x ^+ y) ^* z = (x ^* z) ^+ (y ^* z).
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros sz x y z; repeat rewrite wmult_alt; repeat rewrite wplus_alt; unfold wmultN, wplusN, wordBinN; intros.

  repeat match goal with
           | [ |- context[wordToNat (natToWord ?sz ?w)] ] =>
             let Heq := fresh "Heq" in
               destruct (wordToNat_natToWord sz w) as [? [Heq ?]]; rewrite Heq
         end.

(* Goal: @eq (word sz) (natToWord sz (Init.Nat.mul (Init.Nat.sub (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y)) (Init.Nat.mul x0 (Nat.pow (S (S O)) sz))) (@wordToNat sz z))) (natToWord sz (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))))) *)
  rewrite mult_minus_distr_r.
  match goal with
  | [ |- natToWord _ (_ - ?x0' * _ * _) = natToWord _ (_ - ?x1' * _ + (_ - ?x2' * _)) ]
    => rename x0' into x0, x1' into x1, x2' into x2 (* force the names to not be autogenerated *)
  end.
  rewrite <- (mult_assoc x0).
(* Goal: @eq (word sz) (natToWord sz (Nat.sub (Nat.mul (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y)) (@wordToNat sz z)) (Nat.mul x0 (Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz z))))) (natToWord sz (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))))) *)
  rewrite (mult_comm (pow2 sz)).
(* Goal: @eq (word sz) (natToWord sz (Nat.sub (Nat.mul (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y)) (@wordToNat sz z)) (Nat.mul x0 (Nat.mul (@wordToNat sz z) (Nat.pow (S (S O)) sz))))) (natToWord sz (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))))) *)
  rewrite (mult_assoc x0).

  replace (wordToNat x * wordToNat z - x1 * pow2 sz +
    (wordToNat y * wordToNat z - x2 * pow2 sz))
    with (wordToNat x * wordToNat z + wordToNat y * wordToNat z - x1 * pow2 sz - x2 * pow2 sz).
(* Goal: @eq (word sz) (natToWord sz (Nat.sub (Nat.mul (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y)) (@wordToNat sz z)) (Nat.mul (Nat.mul x0 (@wordToNat sz z)) (Nat.pow (S (S O)) sz)))) (natToWord sz (Init.Nat.sub (Init.Nat.sub (Init.Nat.add (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
(* Goal: @eq nat (Init.Nat.sub (Init.Nat.sub (Init.Nat.add (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))) (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
  repeat rewrite drop_sub; auto with arith.
(* Goal: le (Init.Nat.mul (Nat.mul x0 (@wordToNat sz z)) (Nat.pow (S (S O)) sz)) (Nat.mul (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y)) (@wordToNat sz z)) *)
(* Goal: @eq nat (Init.Nat.sub (Init.Nat.sub (Init.Nat.add (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))) (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
  rewrite (mult_comm x0).
(* Goal: le (Init.Nat.mul (Nat.mul (@wordToNat sz z) x0) (Nat.pow (S (S O)) sz)) (Nat.mul (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y)) (@wordToNat sz z)) *)
(* Goal: @eq nat (Init.Nat.sub (Init.Nat.sub (Init.Nat.add (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))) (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
  rewrite (mult_comm (wordToNat x + wordToNat y)).
  rewrite <- (mult_assoc (wordToNat z)).
(* Goal: le (Nat.mul (@wordToNat sz z) (Nat.mul x0 (Nat.pow (S (S O)) sz))) (Nat.mul (@wordToNat sz z) (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y))) *)
(* Goal: @eq nat (Init.Nat.sub (Init.Nat.sub (Init.Nat.add (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))) (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
  auto with arith.
(* Goal: @eq nat (Init.Nat.sub (Init.Nat.sub (Init.Nat.add (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))) (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
  generalize dependent (wordToNat x * wordToNat z).
(* Goal: forall (n : nat) (_ : @eq nat (@wordToNat sz (natToWord sz n)) (Init.Nat.sub n (Init.Nat.mul x1 (Nat.pow (S (S O)) sz)))) (_ : le (Init.Nat.mul x1 (Nat.pow (S (S O)) sz)) n), @eq nat (Init.Nat.sub (Init.Nat.sub (Init.Nat.add n (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))) (Init.Nat.add (Init.Nat.sub n (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
  generalize dependent (wordToNat y * wordToNat z).
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Theorem wminus_def : forall sz (x y : word sz), x ^- y = x ^+ ^~ y.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem wordToNat_bound : forall sz (w : word sz), (wordToNat w < pow2 sz)%nat.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  induction w as [|b]; simpl; intuition.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  destruct b; simpl; omega.
Qed.

Theorem natToWord_pow2 : forall sz, natToWord sz (pow2 sz) = natToWord sz 0.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  induction sz as [|sz]; simpl; intuition.

(* Goal: @eq (word (S sz)) (@WS (mod2 (Nat.add (Nat.pow (S (S O)) sz) (Nat.add (Nat.pow (S (S O)) sz) O))) sz (natToWord sz (Nat.div2 (Nat.add (Nat.pow (S (S O)) sz) (Nat.add (Nat.pow (S (S O)) sz) O))))) (@WS false sz (natToWord sz O)) *)
  generalize (div2_double (pow2 sz)); simpl; intro Hr; rewrite Hr; clear Hr.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  generalize (mod2_double (pow2 sz)); auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Theorem wminus_inv : forall sz (x : word sz), x ^+ ^~ x = wzero sz.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros sz x; rewrite wneg_alt; rewrite wplus_alt; unfold wnegN, wplusN, wzero, wordBinN; intros.

  repeat match goal with
           | [ |- context[wordToNat (natToWord ?sz ?w)] ] =>
             let Heq := fresh "Heq" in
               destruct (wordToNat_natToWord sz w) as [? [Heq ?]]; rewrite Heq
         end.

  match goal with
  | [ |- context[wordToNat ?x + (pow2 ?sz - wordToNat ?x - ?x0 * pow2 ?sz)] ]
    => replace (wordToNat x + (pow2 sz - wordToNat x - x0 * pow2 sz))
      with (pow2 sz - x0 * pow2 sz)
  end.
(* Goal: le (Nat.mul (@wordToNat sz z) (Nat.mul x0 (Nat.pow (S (S O)) sz))) (Nat.mul (@wordToNat sz z) (Init.Nat.add (@wordToNat sz x) (@wordToNat sz y))) *)
(* Goal: @eq nat (Init.Nat.sub (Init.Nat.sub (Init.Nat.add (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z))) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz))) (Init.Nat.add (Init.Nat.sub (Init.Nat.mul (@wordToNat sz x) (@wordToNat sz z)) (Init.Nat.mul x1 (Nat.pow (S (S O)) sz))) (Init.Nat.sub (Init.Nat.mul (@wordToNat sz y) (@wordToNat sz z)) (Init.Nat.mul x2 (Nat.pow (S (S O)) sz)))) *)
  rewrite drop_sub; auto with arith.
(* Goal: @eq (word sz) (natToWord sz (Nat.pow (S (S O)) sz)) (natToWord sz O) *)
(* Goal: @eq nat (Init.Nat.sub (Nat.pow (S (S O)) sz) (Init.Nat.mul x0 (Nat.pow (S (S O)) sz))) (Init.Nat.add (@wordToNat sz x) (Init.Nat.sub (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz x)) (Init.Nat.mul x0 (Nat.pow (S (S O)) sz)))) *)
  apply natToWord_pow2.
(* Goal: @eq nat (Init.Nat.sub (Nat.pow (S (S O)) sz) (Init.Nat.mul x0 (Nat.pow (S (S O)) sz))) (Init.Nat.add (@wordToNat sz x) (Init.Nat.sub (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz x)) (Init.Nat.mul x0 (Nat.pow (S (S O)) sz)))) *)
  generalize (wordToNat_bound x).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wminus_diag: forall sz (w: word sz),
    w ^- w = $0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold wminus. apply wminus_inv.
Qed.

(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
Lemma wneg_0_wminus: forall {sz: nat} (x: word sz),
    ^~ x = $0 ^- x.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <- wplus_unit at 1.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Definition wring (sz : nat) : ring_theory (wzero sz) (wone sz) (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz) (@eq _) :=
  mk_rt _ _ _ _ _ _ _
  (@wplus_unit _) (@wplus_comm _) (@wplus_assoc _)
  (@wmult_unit _) (@wmult_comm _) (@wmult_assoc _)
  (@wmult_plus_distr _) (@wminus_def _) (@wminus_inv _).

Theorem weqb_sound : forall sz (x y : word sz), weqb x y = true -> x = y.
Proof.
(* Goal: forall (sz : nat) (x y : word sz) (_ : @eq bool (@weqb sz x y) true), @eq (word sz) x y *)
  eapply weqb_true_iff.
Qed.

Arguments weqb_sound : clear implicits.

Lemma weqb_eq: forall sz (a b: word sz), a = b -> weqb a b = true.
Proof. intros. rewrite weqb_true_iff. assumption. Qed.

Lemma weqb_ne: forall sz (a b: word sz), a <> b -> weqb a b = false.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. destruct (weqb a b) eqn: E.
  - rewrite weqb_true_iff in E. contradiction.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - reflexivity.
Qed.

Lemma weqb_false: forall sz (a b: word sz), weqb a b = false -> a <> b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. destruct (weqb a b) eqn: E.
  - discriminate.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  - intro C. subst. rewrite weqb_eq in E; congruence.
Qed.

Ltac is_nat_cst n :=
  match eval hnf in n with
    | O => constr:(true)
    | S ?n' => is_nat_cst n'
    | _ => constr:(false)
  end.

Ltac isWcst w :=
  match eval hnf in w with
    | WO => constr:(true)
    | WS ?b ?w' =>
      match eval hnf in b with
        | true => isWcst w'
        | false => isWcst w'
        | _ => constr:(false)
      end
    | natToWord _ ?n => is_nat_cst n
    | _ => constr:(false)
  end.

Ltac wcst w :=
  let b := isWcst w in
    match b with
      | true => w
      | _ => constr:(NotConstant)
    end.

(* Here's how you can add a ring for a specific bit-width.
   There doesn't seem to be a polymorphic method, so this code really does need to be copied. *)

(*
Definition wring8 := wring 8.
Add Ring wring8 : wring8 (decidable (weqb_sound 8), constants [wcst]).
*)

Ltac noptac x := idtac.

Ltac PackWring sz F :=
  let RNG := (fun proj => proj
    inv_morph_nothing inv_morph_nothing noptac noptac
    (word sz) (@eq (word sz)) (wzero sz) (wone sz)
    (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz)
    (BinNums.Z) (BinNums.N) (id_phi_N)
    (pow_N (wone sz) (@wmult sz))
    (ring_correct (@Eqsth (word sz))
                  (Eq_ext _ _ _)
                  (Rth_ARth (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz))
                  (gen_phiZ_morph (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz))
                  (pow_N_th _ _ (@Eqsth (word sz)))
                  (triv_div_th (@Eqsth (word sz))
                               (Eq_ext _ _ _)
                               (Rth_ARth (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz))
                               (gen_phiZ_morph (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz)))
    )
    tt) in
  F RNG (@nil (word sz)) (@nil (word sz)).

Ltac ring_sz sz := PackWring sz Ring_gen.

Fact bitwp_wtl : forall sz (w w' : word (S sz)) op, bitwp op (wtl w) (wtl w') = wtl (bitwp op w w').
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@bitwp op sz (@wtl sz w) (@wtl sz w')) (@wtl sz (@bitwp op (S sz) w w')) *)
  rewrite (shatter_word w), (shatter_word w').
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma split1_bitwp_dist : forall sz1 sz2 w w' op,
  split1 sz1 sz2 (bitwp op w w') = bitwp op (split1 sz1 sz2 w) (split1 sz1 sz2 w').
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz1; intros; auto.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite (shatter_word w), (shatter_word w'); auto.
  rewrite <- IHsz1, bitwp_wtl.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma split2_bitwp_dist : forall sz1 sz2 w w' op,
  split2 sz1 sz2 (bitwp op w w') = bitwp op (split2 sz1 sz2 w) (split2 sz1 sz2 w').
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz1; intros; auto.
  simpl; rewrite <- IHsz1, bitwp_wtl.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma combine_bitwp : forall sz1 sz2 (wa wa' : word sz1) (wb wb' : word sz2) op,
  combine (bitwp op wa wa') (bitwp op wb wb') = bitwp op (combine wa wb) (combine wa' wb').
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz1; intros; rewrite (shatter_word wa), (shatter_word wa'); simpl; f_equal; auto.
Qed.

Lemma eq_rect_bitwp : forall a b Heq f w1 w2,
  bitwp f w1 w2 = eq_rect a word (
    bitwp f (eq_rect b word w1 a Heq) (eq_rect b word w2 a Heq)) b (eq_sym Heq).
Proof.
(* Goal: forall (a b : nat) (Heq : @eq nat b a) (f : forall (_ : bool) (_ : bool), bool) (w1 w2 : word b), @eq (word b) (@bitwp f b w1 w2) (@eq_rect nat a word (@bitwp f a (@eq_rect nat b word w1 a Heq) (@eq_rect nat b word w2 a Heq)) b (@eq_sym nat b a Heq)) *)
  intros a b H; subst a.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  intros; eq_rect_simpl; reflexivity.
Qed.

Fact eq_rect_bitwp' : forall a b Heq f w1 w2,
  eq_rect b word (bitwp f w1 w2) a Heq = bitwp f (eq_rect b word w1 a Heq) (eq_rect b word w2 a Heq).
Proof.
(* Goal: forall (a b : nat) (Heq : @eq nat b a) (f : forall (_ : bool) (_ : bool), bool) (w1 w2 : word b), @eq (word a) (@eq_rect nat b word (@bitwp f b w1 w2) a Heq) (@bitwp f a (@eq_rect nat b word w1 a Heq) (@eq_rect nat b word w2 a Heq)) *)
  intros a b H1; subst a.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  intros; eq_rect_simpl; reflexivity.
Qed.

Fact eq_rect_bitwp_1 : forall a b Heq f w1 w2,
  bitwp f (eq_rect a word w1 b Heq) w2 = eq_rect a word (bitwp f w1 (eq_rect b word w2 a (eq_sym Heq))) b Heq.
Proof.
(* Goal: forall (a b : nat) (Heq : @eq nat a b) (f : forall (_ : bool) (_ : bool), bool) (w1 : word a) (w2 : word b), @eq (word b) (@bitwp f b (@eq_rect nat a word w1 b Heq) w2) (@eq_rect nat a word (@bitwp f a w1 (@eq_rect nat b word w2 a (@eq_sym nat a b Heq))) b Heq) *)
  intros a b H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  subst a; intros; eq_rect_simpl; auto.
Qed.

Theorem wnot_wnot'_equiv : forall sz (w : word sz), wnot w = wnot' w.
Proof.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@wnot' (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)) (@combine sz1 (@wnot' sz1 w1) sz2 (@wnot' sz2 w2)) *)
  unfold wnot'.
(* Goal: forall w1 w2 : word O, @eq (word O) (@bitwp xorb O w1 w2) (@bitwp xorb O w2 w1) *)
(* Goal: forall w1 w2 : word (S sz), @eq (word (S sz)) (@bitwp xorb (S sz) w1 w2) (@bitwp xorb (S sz) w2 w1) *)
  induction sz; intros w; shatterer.
Qed.

Theorem wnot_split1 : forall sz1 sz2 w, wnot (split1 sz1 sz2 w) = split1 sz1 sz2 (wnot w).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@wnot (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)) (@combine sz1 (@wnot sz1 w1) sz2 (@wnot sz2 w2)) *)
  repeat rewrite wnot_wnot'_equiv.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@wnot' (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)) (@combine sz1 (@wnot' sz1 w1) sz2 (@wnot' sz2 w2)) *)
  unfold wnot'.
  erewrite <- split1_combine with (w := wones _).
  rewrite <- split1_bitwp_dist, combine_wones.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem wnot_split2 : forall sz1 sz2 w, wnot (split2 sz1 sz2 w) = split2 sz1 sz2 (wnot w).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@wnot (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)) (@combine sz1 (@wnot sz1 w1) sz2 (@wnot sz2 w2)) *)
  repeat rewrite wnot_wnot'_equiv.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@wnot' (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)) (@combine sz1 (@wnot' sz1 w1) sz2 (@wnot' sz2 w2)) *)
  unfold wnot'.
  erewrite <- split2_combine with (z := wones _).
  rewrite <- split2_bitwp_dist, combine_wones.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem wnot_combine : forall sz1 sz2 (w1 : word sz1) (w2 : word sz2),
  wnot (combine w1 w2) = combine (wnot w1) (wnot w2).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@wnot (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)) (@combine sz1 (@wnot sz1 w1) sz2 (@wnot sz2 w2)) *)
  repeat rewrite wnot_wnot'_equiv.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@wnot' (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)) (@combine sz1 (@wnot' sz1 w1) sz2 (@wnot' sz2 w2)) *)
  unfold wnot'.
  rewrite <- combine_wones, combine_bitwp.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem wnot_zero: forall sz, wnot (wzero sz) = wones sz.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz; simpl; f_equal; eauto.
Qed.

Theorem wnot_ones : forall sz, wnot (wones sz) = wzero sz.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz; simpl; f_equal; try rewrite IHsz; eauto.
Qed.

Theorem wnot_eq_rect : forall a b H (w : word a), wnot (eq_rect a word w b H) = eq_rect a word (wnot w) b H.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  subst b; eq_rect_simpl; auto.
Qed.

Theorem wor_unit : forall sz (x : word sz), wzero sz ^| x = x.
Proof.
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
  unfold wzero, wor; induction x; simpl; intuition congruence.
Qed.

Theorem wor_comm : forall sz (x y : word sz), x ^| y = y ^| x.
Proof.
(* Goal: forall (sz : nat) (x y z : word sz), @eq (word sz) (@wor sz x (@wor sz y z)) (@wor sz (@wor sz x y) z) *)
  unfold wor; induction x; intro y; rewrite (shatter_word y); simpl; intuition; f_equal; auto with bool.
Qed.

Theorem wor_assoc : forall sz (x y z : word sz), x ^| (y ^| z) = x ^| y ^| z.
Proof.
(* Goal: forall (sz : nat) (x y z : word sz), @eq (word sz) (@wor sz x (@wor sz y z)) (@wor sz (@wor sz x y) z) *)
  unfold wor; induction x; intro y; rewrite (shatter_word y); simpl; intuition; f_equal; auto with bool.
Qed.

Theorem wand_unit : forall sz (x : word sz), wones sz ^& x = x.
Proof.
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
  unfold wand; induction x; simpl; intuition congruence.
Qed.

Theorem wand_kill : forall sz (x : word sz), wzero sz ^& x = wzero sz.
Proof.
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
  unfold wzero, wand; induction x; simpl; intuition congruence.
Qed.

Theorem wand_comm : forall sz (x y : word sz), x ^& y = y ^& x.
Proof.
(* Goal: forall (sz : nat) (x y z : word sz), @eq (word sz) (@wand sz x (@wand sz y z)) (@wand sz (@wand sz x y) z) *)
  unfold wand; induction x; intro y; rewrite (shatter_word y); simpl; intuition; f_equal; auto with bool.
Qed.

Theorem wand_assoc : forall sz (x y z : word sz), x ^& (y ^& z) = x ^& y ^& z.
Proof.
(* Goal: forall (sz : nat) (x y z : word sz), @eq (word sz) (@wand sz x (@wand sz y z)) (@wand sz (@wand sz x y) z) *)
  unfold wand; induction x; intro y; rewrite (shatter_word y); simpl; intuition; f_equal; auto with bool.
Qed.

Theorem wand_or_distr : forall sz (x y z : word sz), (x ^| y) ^& z = (x ^& z) ^| (y ^& z).
Proof.
(* Goal: forall (sz : nat) (x y z : word sz), @eq (word sz) (@wand sz (@wor sz x y) z) (@wor sz (@wand sz x z) (@wand sz y z)) *)
  unfold wand, wor; induction x; intro y; rewrite (shatter_word y); intro z; rewrite (shatter_word z); simpl; intuition; f_equal; auto with bool.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  destruct (whd y); destruct (whd z); destruct b; reflexivity.
Qed.

Lemma wor_wones : forall sz w, wones sz ^| w = wones sz.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  unfold wor; induction sz; intros; simpl; auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite IHsz; auto.
Qed.

Lemma wor_wzero : forall sz w, wzero sz ^| w = w.
Proof.
(* Goal: forall w1 w2 : word O, @eq (word O) (@bitwp xorb O w1 w2) (@bitwp xorb O w2 w1) *)
(* Goal: forall w1 w2 : word (S sz), @eq (word (S sz)) (@bitwp xorb (S sz) w1 w2) (@bitwp xorb (S sz) w2 w1) *)
  unfold wor; induction sz; shatterer.
Qed.

Lemma wand_wones : forall sz w, wones sz ^& w = w.
Proof.
(* Goal: forall w1 w2 : word O, @eq (word O) (@bitwp xorb O w1 w2) (@bitwp xorb O w2 w1) *)
(* Goal: forall w1 w2 : word (S sz), @eq (word (S sz)) (@bitwp xorb (S sz) w1 w2) (@bitwp xorb (S sz) w2 w1) *)
  unfold wand; induction sz; shatterer.
Qed.

Lemma wand_wzero : forall sz w, wzero sz ^& w = wzero sz.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite <- wzero'_def.
(* Goal: forall w1 w2 : word O, @eq (word O) (@bitwp xorb O w1 w2) (@bitwp xorb O w2 w1) *)
(* Goal: forall w1 w2 : word (S sz), @eq (word (S sz)) (@bitwp xorb (S sz) w1 w2) (@bitwp xorb (S sz) w2 w1) *)
  unfold wand; induction sz; shatterer.
Qed.

Lemma wxor_wones : forall sz w, wxor (wones sz) w = wnot w.
Proof.
(* Goal: forall w1 w2 : word O, @eq (word O) (@bitwp xorb O w1 w2) (@bitwp xorb O w2 w1) *)
(* Goal: forall w1 w2 : word (S sz), @eq (word (S sz)) (@bitwp xorb (S sz) w1 w2) (@bitwp xorb (S sz) w2 w1) *)
  unfold wxor; induction sz; shatterer.
Qed.

Lemma wxor_wzero : forall sz w, wxor (wzero sz) w = w.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  unfold wxor; induction sz; shatterer; destruct (whd w); auto.
Qed.

Lemma wxor_comm : forall sz (w1 w2 : word sz), wxor w1 w2 = wxor w2 w1.
Proof.
(* Goal: forall w1 w2 : word O, @eq (word O) (@bitwp xorb O w1 w2) (@bitwp xorb O w2 w1) *)
(* Goal: forall w1 w2 : word (S sz), @eq (word (S sz)) (@bitwp xorb (S sz) w1 w2) (@bitwp xorb (S sz) w2 w1) *)
  unfold wxor; induction sz. shatterer.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite (shatter_word w1), (shatter_word w2).
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: @eq (word (S sz)) (@WS (xorb (@whd sz w1) (@whd sz w2)) sz (@bitwp xorb sz (@wtl sz w1) (@wtl sz w2))) (@WS (xorb (@whd sz w2) (@whd sz w1)) sz (@bitwp xorb sz (@wtl sz w2) (@wtl sz w1))) *)
  rewrite xorb_comm, IHsz.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wxor_assoc : forall sz (w1 w2 w3 : word sz), wxor w1 (wxor w2 w3) = wxor (wxor w1 w2) w3.
Proof.
(* Goal: forall (sz : nat) (w1 w2 w3 : word sz), @eq (word sz) (@wxor sz w1 (@wxor sz w2 w3)) (@wxor sz (@wxor sz w1 w2) w3) *)
  unfold wxor.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz; intros; rewrite (shatter_word w1), (shatter_word w2), (shatter_word w3); auto.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  simpl; f_equal.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite xorb_assoc_reverse; auto.
(* Goal: @eq nat (Init.Nat.mul (@wordToNat (S sz) (wpow2 sz)) (S (S O))) (Nat.add (Nat.pow (S (S O)) sz) (Nat.add (Nat.pow (S (S O)) sz) O)) *)
  rewrite IHsz.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wor_wone : forall sz (w : word sz) b,
  WS b w ^| wone _ = WS true w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  compute [wone natToWord wor]. simpl.
(* Goal: @eq (word (S (Init.Nat.add d sz))) (@WS false (Init.Nat.add d sz) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n)))) (@wneg (S (Init.Nat.add d sz)) (@WS false (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n)))) *)
  fold natToWord.
(* Goal: @eq N (@wordToN sz (natToWord sz O)) N0 *)
  change (natToWord sz 0) with (wzero sz).
(* Goal: @eq (word (S sz)) (@WS (orb b true) sz (@bitwp orb sz w (wzero sz))) (@WS true sz w) *)
  rewrite orb_true_r.
(* Goal: @eq (word (S sz)) (@WS true sz (@bitwp orb sz w (wzero sz))) (@WS true sz w) *)
  rewrite wor_comm, wor_wzero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wand_wone : forall sz (w : word sz) b,
  WS b w ^& wone _ = WS b (wzero _).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  compute [wone natToWord wand]. simpl.
(* Goal: @eq (word (S (Init.Nat.add d sz))) (@WS false (Init.Nat.add d sz) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n)))) (@wneg (S (Init.Nat.add d sz)) (@WS false (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n)))) *)
  fold natToWord.
(* Goal: @eq N (@wordToN sz (natToWord sz O)) N0 *)
  change (natToWord sz 0) with (wzero sz).
(* Goal: @eq (word (S sz)) (@WS (andb b true) sz (@bitwp andb sz w (wzero sz))) (@WS b sz (wzero sz)) *)
  rewrite andb_true_r.
(* Goal: @eq (word (S sz)) (@WS b sz (@bitwp andb sz w (wzero sz))) (@WS b sz (wzero sz)) *)
  rewrite wand_comm, wand_wzero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wxor_wone : forall sz (w : word sz) b,
  wxor (WS b w) (wone _) = WS (negb b) w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  compute [wone natToWord wxor]. simpl.
(* Goal: @eq (word (S (Init.Nat.add d sz))) (@WS false (Init.Nat.add d sz) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n)))) (@wneg (S (Init.Nat.add d sz)) (@WS false (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n)))) *)
  fold natToWord.
(* Goal: @eq N (@wordToN sz (natToWord sz O)) N0 *)
  change (natToWord sz 0) with (wzero sz).
(* Goal: @eq (word (S sz)) (@WS (xorb b true) sz (@bitwp xorb sz w (wzero sz))) (@WS (negb b) sz w) *)
  rewrite xorb_true_r.
(* Goal: @eq (word (S sz)) (@WS (negb b) sz (@bitwp xorb sz w (wzero sz))) (@WS (negb b) sz w) *)
  rewrite wxor_comm, wxor_wzero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Definition wbring (sz : nat) : semi_ring_theory (wzero sz) (wones sz) (@wor sz) (@wand sz) (@eq _) :=
  mk_srt _ _ _ _ _
  (@wor_unit _) (@wor_comm _) (@wor_assoc _)
  (@wand_unit _) (@wand_kill _) (@wand_comm _) (@wand_assoc _)
  (@wand_or_distr _).

(** * Inequality proofs *)

(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
Ltac word_simpl := unfold sext, zext, wzero in *; simpl in *.

Ltac word_eq := ring.

Ltac word_eq1 := match goal with
                   | _ => ring
                   | [ H : _ = _ |- _ ] => ring [H]
                 end.

Theorem word_neq : forall sz (w1 w2 : word sz),
  w1 ^- w2 <> wzero sz
  -> w1 <> w2.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  intros; intro; subst.
(* Goal: @eq (word sz) a b *)
  unfold wminus in H.
(* Goal: False *)
  rewrite wminus_inv in H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  tauto.
Qed.

(* Goal: False *)
Ltac word_neq := apply word_neq; let H := fresh "H" in intro H; simpl in H; ring_simplify in H; try discriminate.

Ltac word_contra := match goal with
                      | [ H : _ <> _ |- False ] => apply H; ring
                    end.

Ltac word_contra1 := match goal with
                       | [ H : _ <> _ |- False ] => apply H;
                         match goal with
                           | _ => ring
                           | [ H' : _ = _ |- _ ] => ring [H']
                         end
                     end.

Lemma not_wlt_ge : forall sz (l r : word sz),
  ((l < r) -> False) -> (r <= l).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  case_eq (wlt_dec l r); intros;
    try contradiction;
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    auto.
Qed.

Lemma not_wle_gt : forall sz (l r : word sz),
  ((l <= r) -> False) -> (r < l).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  case_eq (wlt_dec r l); intros;
    try contradiction;
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    auto.
Qed.

Lemma lt_le : forall sz (a b : word sz),
  a < b -> a <= b.
Proof.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  unfold wlt, N.lt. intros sz a b H H0. rewrite N.compare_antisym in H0. rewrite H in H0. simpl in *. congruence.
Qed.

Lemma eq_le : forall sz (a b : word sz),
  a = b -> a <= b.
Proof.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  intros; subst. unfold wlt, N.lt. rewrite N.compare_refl. congruence.
Qed.

Lemma wordToN_inj : forall sz (a b : word sz),
  wordToN a = wordToN b -> a = b.
Proof.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  induction a; intro b0; rewrite (shatter_word b0); intuition.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  simpl in H.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  destruct b; destruct (whd b0); intros.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal. eapply IHa. eapply N.succ_inj in H.
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
  destruct (wordToN a); destruct (wordToN (wtl b0)); try congruence.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS false n (natToWord n O)) *)
  destruct (wordToN (wtl b0)); destruct (wordToN a); inversion H.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS false n (natToWord n O)) *)
  destruct (wordToN (wtl b0)); destruct (wordToN a); inversion H.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal. eapply IHa.
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
  destruct (wordToN a); destruct (wordToN (wtl b0)); try congruence.
Qed.

Lemma wordToNat_inj : forall sz (a b : word sz),
  wordToNat a = wordToNat b -> a = b.
Proof.
(* Goal: forall (sz : nat) (a b : word sz) (_ : @eq nat (@wordToNat sz a) (@wordToNat sz b)), @eq (word sz) a b *)
  intros; apply wordToN_inj.
(* Goal: @eq N N0 (@wordToN sz (wzero sz)) *)
  repeat rewrite wordToN_nat.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply Nat2N.inj_iff; auto.
Qed.

Lemma unique_inverse : forall sz (a b1 b2 : word sz),
  a ^+ b1 = wzero _ ->
  a ^+ b2 = wzero _ ->
  b1 = b2.
Proof.
(* Goal: forall (sz : nat) (a b1 b2 : word sz) (_ : @eq (word sz) (@wplus sz a b1) (wzero sz)) (_ : @eq (word sz) (@wplus sz a b2) (wzero sz)), @eq (word sz) b1 b2 *)
  intros sz a b1 b2 H *.
(* Goal: forall _ : @eq (word sz) (@wplus sz a b2) (wzero sz), @eq (word sz) b1 b2 *)
  transitivity (b1 ^+ wzero _).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wplus_comm. rewrite wplus_unit. auto.
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
  transitivity (b1 ^+ (a ^+ b2)). congruence.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) y2)) y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wplus_assoc.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite (wplus_comm b1). rewrite H. rewrite wplus_unit. auto.
Qed.

Lemma sub_0_eq : forall sz (a b : word sz),
  a ^- b = wzero _ -> a = b.
Proof.
(* Goal: forall (sz : nat) (a b : word sz) (_ : @eq (word sz) (@wminus sz a b) (wzero sz)), @eq (word sz) a b *)
  intros sz a b H. destruct (weq (wneg b) (wneg a)) as [e|n].
(* Goal: @eq (word sz) a b *)
(* Goal: @eq (word sz) a b *)
  transitivity (a ^+ (^~ b ^+ b)).
(* Goal: @eq (word sz) (@wplus sz a (@wplus sz (@wneg sz b) b)) a *)
  rewrite (wplus_comm (^~ b)). rewrite wminus_inv.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wplus_comm. rewrite wplus_unit. auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite e. rewrite wplus_assoc. rewrite wminus_inv. rewrite wplus_unit. auto.
(* Goal: @eq (word sz) a b *)
  unfold wminus in H.
(* Goal: @eq (word sz) a b *)
  generalize (unique_inverse a (wneg a) (^~ b)).
(* Goal: forall _ : forall (_ : @eq (word sz) (@wplus sz a (@wneg sz a)) (wzero sz)) (_ : @eq (word sz) (@wplus sz a (@wneg sz b)) (wzero sz)), @eq (word sz) (@wneg sz a) (@wneg sz b), @eq (word sz) a b *)
  intro H0. elimtype False. apply n. symmetry; apply H0.
(* Goal: @eq (word sz) (@wplus sz (@wneg sz w) (@wneg sz (@wneg sz w))) (wzero sz) *)
  apply wminus_inv.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma le_neq_lt : forall sz (a b : word sz),
  b <= a -> a <> b -> b < a.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  intros sz a b H H0; destruct (wlt_dec b a) as [?|n]; auto.
(* Goal: @wlt sz b a *)
  elimtype False. apply H0. unfold wlt, N.lt in *.
(* Goal: @eq (word sz) a b *)
  eapply wordToN_inj. eapply Ncompare_eq_correct.
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
  case_eq ((wordToN a ?= wordToN b)%N); auto; try congruence.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  intros H1. rewrite N.compare_antisym in n. rewrite H1 in n. simpl in *. congruence.
Qed.


Hint Resolve word_neq lt_le eq_le sub_0_eq le_neq_lt : worder.

Ltac shatter_word x :=
  match type of x with
    | word 0 => try rewrite (shatter_word_0 x) in *
    | word (S ?N) =>
      let x' := fresh in
      let H := fresh in
      destruct (@shatter_word_S N x) as [ ? [ x' H ] ];
      rewrite H in *; clear H; shatter_word x'
  end.


(** Uniqueness of equality proofs **)
Lemma rewrite_weq : forall sz (a b : word sz)
  (pf : a = b),
  weq a b = left _ pf.
Proof.
(* Goal: forall (sz : nat) (a b : word sz) (pf : @eq (word sz) a b), @eq (sumbool (@eq (word sz) a b) (not (@eq (word sz) a b))) (@weq sz a b) (@left (@eq (word sz) a b) (not (@eq (word sz) a b)) pf) *)
  intros sz a b *; destruct (weq a b); try solve [ elimtype False; auto ].
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: @eq (@eq (word sz) a b) e pf *)
  eapply UIP_dec. eapply weq.
Qed.


(** * Some more useful derived facts *)

Lemma natToWord_plus : forall sz n m, natToWord sz (n + m) = natToWord _ n ^+ natToWord _ m.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct sz as [|sz]; intros n m; intuition.
(* Goal: @eq (word (S sz)) (natToWord (S sz) (Init.Nat.add n m)) (@wplus (S sz) (natToWord (S sz) n) (natToWord (S sz) m)) *)
  rewrite wplus_alt.
(* Goal: @eq (word (S sz)) (natToWord (S sz) (Init.Nat.add n m)) (@wplusN (S sz) (natToWord (S sz) n) (natToWord (S sz) m)) *)
  unfold wplusN, wordBinN.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct (wordToNat_natToWord (S sz) n); intuition.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct (wordToNat_natToWord (S sz) m); intuition.
(* Goal: @eq nat (Nat.mul (S (S O)) (Nat.add (@wordToNat sz (natToWord sz (Nat.div2 w))) (Nat.mul x (Nat.pow (S (S O)) sz)))) w *)
  do 2 match goal with H : _ |- _ => rewrite H; clear H end.
  match goal with
  | [ |- context[?n - ?x * pow2 (S ?sz) + (?m - ?x0 * pow2 (S ?sz))] ]
    => replace (n - x * pow2 (S sz) + (m - x0 * pow2 (S sz))) with (n + m - x * pow2 (S sz) - x0 * pow2 (S sz))
      by omega
  end.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  repeat rewrite drop_sub; auto; omega.
Qed.

Lemma natToWord_S : forall sz n, natToWord sz (S n) = natToWord _ 1 ^+ natToWord _ n.
(* Goal: forall sz n : nat, @eq (word sz) (natToWord sz (S n)) (@wplus sz (natToWord sz (S O)) (natToWord sz n)) *)
  intros sz n; change (S n) with (1 + n); apply natToWord_plus.
Qed.

Theorem natToWord_inj : forall sz n m, natToWord sz n = natToWord sz m
  -> (n < pow2 sz)%nat
  -> (m < pow2 sz)%nat
  -> n = m.
(* Goal: forall (sz n m : nat) (_ : @eq (word sz) (natToWord sz n) (natToWord sz m)) (_ : lt n (Nat.pow (S (S O)) sz)) (_ : lt m (Nat.pow (S (S O)) sz)), @eq nat n m *)
  intros sz n m H H0 H1.
(* Goal: @eq nat n m *)
  apply (f_equal (@wordToNat _)) in H.
(* Goal: @eq nat n m *)
  destruct (wordToNat_natToWord sz n) as [x H2].
(* Goal: @eq nat n m *)
  destruct (wordToNat_natToWord sz m) as [x0 H3].
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  intuition.
  match goal with
  | [ H : wordToNat ?x = wordToNat ?y, H' : wordToNat ?x = ?a, H'' : wordToNat ?y = ?b |- _ ]
    => let H0 := fresh in assert (H0 : a = b) by congruence; clear H H' H''; rename H0 into H
  end.
(* Goal: @eq nat n m *)
  assert (x = 0).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct x; auto.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  simpl in *.
(* Goal: @eq nat (@wordToNat sz (natToWord sz n)) n *)
  generalize dependent (x * pow2 sz).
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
(* Goal: @eq nat n m *)
  assert (x0 = 0).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct x0; auto.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  simpl in *.
(* Goal: @eq nat (S x0) O *)
(* Goal: @eq nat n m *)
  generalize dependent (x0 * pow2 sz).
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  subst; simpl in *; omega.
Qed.

Lemma wordToNat_natToWord_idempotent : forall sz n,
  (N.of_nat n < Npow2 sz)%N
  -> wordToNat (natToWord sz n) = n.
(* Goal: forall (sz n : nat) (_ : N.lt (N.of_nat n) (Npow2 sz)), @eq nat (@wordToNat sz (natToWord sz n)) n *)
  intros sz n H.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct (wordToNat_natToWord sz n) as [x]; intuition.
(* Goal: @eq nat (@wordToNat sz (natToWord sz n)) n *)
  destruct x as [|x].
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  simpl in *; omega.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  simpl in *.
(* Goal: lt (@wordToNat sz a) (@wordToNat sz b) *)
  apply Nlt_out in H.
(* Goal: @eq nat (@wordToNat sz (natToWord sz n)) n *)
  autorewrite with N in *.
(* Goal: @eq nat (@wordToNat sz (natToWord sz n)) n *)
  rewrite Npow2_nat in *.
(* Goal: @eq nat (@wordToNat sz (natToWord sz n)) n *)
  generalize dependent (x * pow2 sz).
(* Goal: forall (a b c : nat) (_ : le b a) (_ : lt b c) (_ : lt a c), lt (Init.Nat.sub a b) c *)
  intros; omega.
Qed.

Lemma wplus_cancel : forall sz (a b c : word sz),
  a ^+ c = b ^+ c
  -> a = b.
(* Goal: forall (sz : nat) (a b c : word sz) (_ : @eq (word sz) (@wplus sz a c) (@wplus sz b c)), @eq (word sz) a b *)
  intros sz a b c H.
(* Goal: @eq (word sz) a b *)
  apply (f_equal (fun x => x ^+ ^~ c)) in H.
  repeat rewrite <- wplus_assoc in H.
(* Goal: False *)
  rewrite wminus_inv in H.
(* Goal: @eq (word sz) a b *)
  repeat rewrite (wplus_comm _ (wzero sz)) in H.
(* Goal: @eq (word sz) a b *)
  repeat rewrite wplus_unit in H.
(* Goal: False *)
  assumption.
Qed.

Lemma wminus_plus_distr:
  forall {sz} (x y z: word sz), x ^- (y ^+ z) = x ^- y ^- z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wminus sz x (@wplus sz y z)) (@wminus sz (@wminus sz x y) z) *)
  apply wplus_cancel with (c:= y ^+ z).
  rewrite wminus_def, <-wplus_assoc.
(* Goal: @eq (word sz) (@wplus sz x (@wplus sz (@wneg sz (@wplus sz y z)) (@wplus sz y z))) (@wplus sz (@wminus sz (@wminus sz x y) z) (@wplus sz y z)) *)
  rewrite wplus_comm with (y:= y ^+ z), wminus_inv.
(* Goal: @eq (word sz) (@wplus sz x (wzero sz)) (@wplus sz (@wminus sz (@wminus sz x y) z) (@wplus sz y z)) *)
  rewrite wplus_comm with (x:= x), wplus_unit.
  rewrite !wminus_def, <-wplus_assoc.
(* Goal: @eq (word sz) x (@wplus sz (@wplus sz x (@wneg sz y)) (@wplus sz (@wneg sz z) (@wplus sz y z))) *)
  rewrite wplus_assoc with (x:= ^~ z).
(* Goal: @eq (word sz) x (@wplus sz (@wplus sz x (@wneg sz y)) (@wplus sz (@wplus sz (@wneg sz z) y) z)) *)
  rewrite wplus_comm with (x:= ^~ z).
  rewrite <-wplus_assoc with (x:= y).
(* Goal: @eq (word sz) x (@wplus sz (@wplus sz x (@wneg sz y)) (@wplus sz y (@wplus sz (@wneg sz z) z))) *)
  rewrite wplus_comm with (x:= ^~ z), wminus_inv.
(* Goal: @eq (word sz) x (@wplus sz (@wplus sz x (@wneg sz y)) (@wplus sz y (wzero sz))) *)
  rewrite wplus_comm with (x:= y), wplus_unit.
  rewrite <-wplus_assoc.
(* Goal: @eq (word sz) x (@wplus sz x (@wplus sz (@wneg sz y) y)) *)
  rewrite wplus_comm with (x:= ^~ y), wminus_inv.
(* Goal: @eq (word sz) x (@wplus sz x (wzero sz)) *)
  rewrite wplus_comm, wplus_unit.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wminus_wplus_undo: forall sz (a b: word sz),
    a ^- b ^+ b = a.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (S sz)) w1 (@wminus (S sz) w2 (natToWord (S sz) (Nat.pow (S (S O)) sz))) *)
  rewrite wminus_def.
  rewrite <- wplus_assoc.
(* Goal: @eq (word sz) (@wplus sz a (@wplus sz (@wneg sz b) b)) a *)
  rewrite (wplus_comm (^~ b)).
(* Goal: @eq (word sz) (@wplus sz c (@wplus sz b (@wneg sz b))) c *)
  rewrite wminus_inv.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) y2 y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wplus_comm.
(* Goal: @eq (word sz) (@wplus sz (natToWord sz wn) (natToWord sz (S O))) (@wplus sz (wzero sz) w) *)
  rewrite wplus_unit.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wneg_zero:
  forall {sz} (w: word sz), ^~ w = (natToWord sz 0) -> w = natToWord sz 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) w (natToWord sz O) *)
  apply wplus_cancel with (c:= ^~ w).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wminus_inv, wplus_unit; auto.
Qed.

Lemma wneg_idempotent:
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
  forall {sz} (w: word sz), ^~ (^~ w) = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz') n1 n2 *)
  apply sub_0_eq.
(* Goal: @eq (word (S sz)) w1 (@wminus (S sz) w2 (natToWord (S sz) (Nat.pow (S (S O)) sz))) *)
  rewrite wminus_def.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) y2 y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wplus_comm.
(* Goal: @eq (word sz) (@wplus sz (@wneg sz w) (@wneg sz (@wneg sz w))) (wzero sz) *)
  apply wminus_inv.
Qed.

Lemma wneg_zero': forall sz,
  wneg (natToWord sz 0) = natToWord sz 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. apply wneg_zero. apply wneg_idempotent.
Qed.

(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
Lemma wplus_one_neq: forall {sz} (w: word (S sz)), w ^+ (natToWord (S sz) 1) <> w.
Proof.
(* Goal: forall (sz : nat) (w : word (S sz)), not (@eq (word (S sz)) (@wplus (S sz) w (natToWord (S sz) (S O))) w) *)
  intros; intro Hx.
(* Goal: False *)
  rewrite wplus_comm in Hx.
  assert ((natToWord (S sz) 1) ^+ w ^- w = w ^- w) by (rewrite Hx; reflexivity).
(* Goal: False *)
  clear Hx.
(* Goal: False *)
  do 2 rewrite wminus_def in H.
  rewrite <-wplus_assoc in H.
(* Goal: False *)
  rewrite wminus_inv in H.
(* Goal: False *)
  rewrite wplus_comm, wplus_unit in H.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS false n (natToWord n O)) *)
  inversion H.
Qed.

Lemma wneg_one_pow2_minus_one: forall {sz}, wordToNat (^~ (natToWord sz 1)) = pow2 sz - 1.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct sz; auto.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wneg; intros.
(* Goal: @eq nat (@wordToNat (S sz) (NToWord (S sz) (N.sub (Npow2 (S sz)) (@wordToN (S sz) (natToWord (S sz) (S O)))))) (Init.Nat.sub (Nat.pow (S (S O)) (S sz)) (S O)) *)
  rewrite wordToN_nat, roundTrip_1.
(* Goal: @eq nat (@wordToNat (S sz) (NToWord (S sz) (N.sub (Npow2 (S sz)) (N.of_nat (S O))))) (Init.Nat.sub (Nat.pow (S (S O)) (S sz)) (S O)) *)
  simpl BinNat.N.of_nat.
(* Goal: @eq nat (@wordToNat (S sz) (NToWord (S sz) (N.sub (Npow2 (S sz)) (Npos xH)))) (Init.Nat.sub (Nat.pow (S (S O)) (S sz)) (S O)) *)
  rewrite NToWord_nat, Nnat.N2Nat.inj_sub, Npow2_nat.
(* Goal: @eq nat (@wordToNat (S sz) (natToWord (S sz) (Init.Nat.sub (Nat.pow (S (S O)) (S sz)) (N.to_nat (Npos xH))))) (Init.Nat.sub (Nat.pow (S (S O)) (S sz)) (S O)) *)
  apply wordToNat_natToWord_2.
(* Goal: lt (Init.Nat.sub (Nat.pow (S (S O)) (S sz)) (S O)) (Nat.pow (S (S O)) (S sz)) *)
  pose (pow2_zero (S sz)).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wones_pow2_minus_one: forall {sz}, wordToNat (wones sz) = pow2 sz - 1.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz; simpl; auto.
(* Goal: @eq nat (S (Init.Nat.mul (@wordToNat sz (wones sz)) (S (S O)))) (Init.Nat.sub (Nat.add (Nat.pow (S (S O)) sz) (Nat.add (Nat.pow (S (S O)) sz) O)) (S O)) *)
  rewrite IHsz; pose (pow2_zero sz).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
Lemma pow2_minus_one_wones: forall {sz} (w: word sz),
    wordToNat w = pow2 sz - 1 -> w = wones sz.
Proof.
  intros; rewrite <-wones_pow2_minus_one in H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply wordToNat_inj; auto.
Qed.

Lemma wones_natToWord: forall sz,
  wones sz = $ (pow2 sz - 1).
Proof.
(* Goal: False *)
  induction sz.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - reflexivity.
  - unfold wones. fold wones. rewrite IHsz.
(* Goal: @eq (word (S (Init.Nat.add d sz))) (@WS false (Init.Nat.add d sz) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n)))) (@wneg (S (Init.Nat.add d sz)) (@WS false (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n)))) *)
    unfold natToWord at 2. fold natToWord. f_equal.
    + rewrite mod2sub.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      * simpl. rewrite mod2_pow2_twice. reflexivity.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      * pose proof (zero_lt_pow2 (S sz)). omega.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
    + f_equal. unfold pow2 at 2. fold pow2.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
      rewrite <- (div2_S_double (pow2 sz - 1)). f_equal.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      pose proof (zero_lt_pow2 sz). omega.
Qed.

(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
Lemma wones_wneg_one: forall {sz}, wones sz = ^~ (natToWord sz 1).
Proof.
(* Goal: forall sz : nat, @eq (word sz) (wones sz) (@wneg sz (natToWord sz (S O))) *)
  intros; apply wordToNat_inj.
(* Goal: @eq nat (@wordToNat sz (wones sz)) (@wordToNat sz (@wneg sz (natToWord sz (S O)))) *)
  rewrite wneg_one_pow2_minus_one.
(* Goal: @eq (word (S O)) (split2 sz (S O) (natToWord (Init.Nat.add sz (S O)) (Init.Nat.add (Init.Nat.add (@wordToNat sz (wones sz)) (Init.Nat.mul (Nat.pow (S (S O)) sz) O)) (Init.Nat.add (@wordToNat sz w) (Init.Nat.mul (Nat.pow (S (S O)) sz) O))))) (@WS true O WO) *)
  rewrite wones_pow2_minus_one.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wordToNat_natToWord_pred:
  forall {sz} (w: word sz), w <> wzero sz ->
                            pred (wordToNat w) =
                            wordToNat (w ^- (natToWord sz 1)).
Proof.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  intros; remember (wordToNat w) as wn; destruct wn; simpl in *.
  - elim H.
(* Goal: @eq (word sz) (@wlshift sz (natToWord sz O) n) (natToWord sz O) *)
    apply wordToNat_inj.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    rewrite roundTrip_0; auto.
  - apply natToWord_inj with (sz:= sz).
    + rewrite natToWord_wordToNat.
(* Goal: @eq (word sz) (natToWord sz wn) (@wminus sz w (natToWord sz (S O))) *)
      apply wplus_cancel with (c:= (natToWord sz 1)).
      rewrite wminus_def, <-wplus_assoc.
(* Goal: @eq (word sz) (@wplus sz (natToWord sz wn) (natToWord sz (S O))) (@wplus sz w (@wplus sz (@wneg sz (natToWord sz (S O))) (natToWord sz (S O)))) *)
      rewrite wplus_comm with (x:= ^~ (natToWord sz 1)).
(* Goal: @eq (word sz) (@wplus sz c (@wplus sz b (@wneg sz b))) c *)
      rewrite wminus_inv.
(* Goal: @eq (word sz) (@wplus sz (natToWord sz wn) (natToWord sz (S O))) (@wplus sz w (wzero sz)) *)
      rewrite wplus_comm with (x:= w).
(* Goal: @eq (word sz) (@wplus sz (natToWord sz wn) (natToWord sz (S O))) (@wplus sz (wzero sz) w) *)
      rewrite wplus_unit.
      rewrite wplus_comm, <-natToWord_S.
(* Goal: @eq (word sz) (@wlshift sz (natToWord sz O) n) (natToWord sz O) *)
      apply wordToNat_inj.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      rewrite wordToNat_natToWord_2; auto.
(* Goal: lt (S wn) (Nat.pow (S (S O)) sz) *)
      rewrite Heqwn.
(* Goal: lt (@wordToNat sz w) (Nat.pow (S (S O)) sz) *)
      apply wordToNat_bound.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + pose proof (wordToNat_bound w); omega.
    + apply wordToNat_bound.
Qed.

Lemma natToWord_mult : forall sz n m, natToWord sz (n * m) = natToWord _ n ^* natToWord _ m.
Proof.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct sz; intuition.
(* Goal: @eq (word (S sz)) (natToWord (S sz) (Init.Nat.mul n m)) (@wmult (S sz) (natToWord (S sz) n) (natToWord (S sz) m)) *)
  rewrite wmult_alt.
(* Goal: @eq (word (S sz)) (natToWord (S sz) (Init.Nat.mul n m)) (@wmultN (S sz) (natToWord (S sz) n) (natToWord (S sz) m)) *)
  unfold wmultN, wordBinN.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct (wordToNat_natToWord (S sz) n); intuition.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct (wordToNat_natToWord (S sz) m); intuition.
(* Goal: @eq (word (S sz)) (natToWord (S sz) (Init.Nat.mul n m)) (natToWord (S sz) (Init.Nat.mul (@wordToNat (S sz) (natToWord (S sz) n)) (@wordToNat (S sz) (natToWord (S sz) m)))) *)
  rewrite H0; rewrite H2; clear H0 H2.
  replace ((n - x * pow2 (S sz)) * (m - x0 * pow2 (S sz)))
    with ((n - x * pow2 (S sz)) * m - (n - x * pow2 (S sz)) * (x0 * pow2 (S sz)))
    by (rewrite Nat.mul_sub_distr_l; auto).
(* Goal: @eq (word (S sz)) (natToWord (S sz) (Nat.mul m n)) (natToWord (S sz) (Init.Nat.sub (Init.Nat.mul m n) (Init.Nat.mul m (Init.Nat.mul x (Nat.pow (S (S O)) (S sz)))))) *)
(* Goal: le (Init.Nat.mul (Nat.mul (Init.Nat.sub n (Init.Nat.mul x (Nat.pow (S (S O)) (S sz)))) x0) (Nat.pow (S (S O)) (S sz))) (Init.Nat.mul (Init.Nat.sub n (Init.Nat.mul x (Nat.pow (S (S O)) (S sz)))) m) *)
  rewrite mult_assoc; rewrite drop_sub.
(* Goal: @eq (word (S sz)) (natToWord (S sz) (Init.Nat.mul n m)) (natToWord (S sz) (Init.Nat.mul (Init.Nat.sub n (Init.Nat.mul x (Nat.pow (S (S O)) (S sz)))) m)) *)
(* Goal: le (Init.Nat.mul (Nat.mul (Init.Nat.sub n (Init.Nat.mul x (Nat.pow (S (S O)) (S sz)))) x0) (Nat.pow (S (S O)) (S sz))) (Init.Nat.mul (Init.Nat.sub n (Init.Nat.mul x (Nat.pow (S (S O)) (S sz)))) m) *)
  repeat rewrite mult_comm with (m:=m).
  replace (m * (n - x * pow2 (S sz)))
    with (m * n - m * (x * pow2 (S sz)))
    by (rewrite Nat.mul_sub_distr_l; auto).
(* Goal: @eq (word (S sz)) (natToWord (S sz) (Nat.mul m n)) (natToWord (S sz) (Init.Nat.sub (Init.Nat.mul m n) (Init.Nat.mul m (Init.Nat.mul x (Nat.pow (S (S O)) (S sz)))))) *)
(* Goal: le (Init.Nat.mul (Nat.mul (Init.Nat.sub n (Init.Nat.mul x (Nat.pow (S (S O)) (S sz)))) x0) (Nat.pow (S (S O)) (S sz))) (Init.Nat.mul (Init.Nat.sub n (Init.Nat.mul x (Nat.pow (S (S O)) (S sz)))) m) *)
  rewrite mult_assoc; rewrite drop_sub.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite <- mult_assoc; apply Nat.mul_le_mono_l; auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite <- mult_assoc; apply Nat.mul_le_mono_l; auto.
Qed.

Lemma wlt_lt: forall sz (a b : word sz), a < b ->
  (wordToNat a < wordToNat b)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: le (@wordToNat sz a) (@wordToNat sz b) *)
  unfold wlt in H.
  repeat rewrite wordToN_nat in *.
(* Goal: lt (@wordToNat sz a) (@wordToNat sz b) *)
  apply Nlt_out in H.
  repeat rewrite Nat2N.id in *.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma wle_le: forall sz (a b : word sz), (a <= b)%word ->
  (wordToNat a <= wordToNat b)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: le (@wordToNat sz a) (@wordToNat sz b) *)
  unfold wlt in H.
  repeat rewrite wordToN_nat in *.
(* Goal: le (@wordToNat sz a) (@wordToNat sz b) *)
  apply Nge_out in H.
  repeat rewrite Nat2N.id in *.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma wlt_lt': forall sz a b, (a < pow2 sz)%nat
  -> natToWord sz a < b
  -> (wordToNat (natToWord sz a) < wordToNat b)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: forall (x y : word sz) (_ : @wlt sz x y), lt (@wordToNat sz x) (@wordToNat sz y) *)
  apply wlt_lt.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma lt_word_lt_nat : forall (sz:nat) (n:word sz) (m:nat),
  (n < (natToWord sz m))%word ->
  (wordToNat n < m)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (S sz)) n (natToWord (S sz) O) *)
  apply wlt_lt in H.
(* Goal: le (@wordToNat sz n) m *)
  destruct (wordToNat_natToWord' sz m).
  rewrite <- H0.
  apply lt_plus_trans with (p := x * pow2 sz).
(* Goal: False *)
  assumption.
Qed.

Lemma le_word_le_nat : forall (sz:nat) (n:word sz) (m:nat),
  (n <= (natToWord sz m))%word ->
  (wordToNat n <= m)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: le (@wordToNat sz n) m *)
  apply wle_le in H.
(* Goal: le (@wordToNat sz n) m *)
  destruct (wordToNat_natToWord' sz m).
  rewrite <- H0.
  apply le_plus_trans with (p := x * pow2 sz).
(* Goal: False *)
  assumption.
Qed.

(* Chain [lt_word_lt_nat] and [Nat.lt_le_incl]
    Avoids using [Hint Resolve Nat.lt_le_incl] for this specific lemma,
    though this may be a premature optimization. *)
Lemma lt_word_le_nat : forall (sz:nat) (n:word sz) (m:nat),
  (n < (natToWord sz m))%word ->
  (wordToNat n <= m)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: le (@wordToNat sz n) m *)
  apply lt_word_lt_nat in H.
(* Goal: le (@wordToNat sz n) m *)
  apply Nat.lt_le_incl.
(* Goal: False *)
  assumption.
Qed.

Hint Resolve lt_word_le_nat.

Lemma wordToNat_natToWord_idempotent' : forall sz n,
  (n < pow2 sz)%nat
  -> wordToNat (natToWord sz n) = n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct (wordToNat_natToWord sz n); intuition.
(* Goal: @eq nat (@wordToNat sz (natToWord sz n)) n *)
  destruct x.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  simpl in *; omega.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  simpl in *.
(* Goal: @eq nat (@wordToNat sz (natToWord sz n)) n *)
  generalize dependent (x * pow2 sz).
(* Goal: forall (a b c : nat) (_ : le b a) (_ : lt b c) (_ : lt a c), lt (Init.Nat.sub a b) c *)
  intros; omega.
Qed.

Lemma le_word_le_nat': forall (sz:nat) n m,
  (n < pow2 sz)%nat ->
  (natToWord sz n <= m)%word ->
  (n <= wordToNat m)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: le n (@wordToNat sz m) *)
  apply wle_le in H0.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wordToNat_natToWord_idempotent' in H0; auto.
Qed.

Lemma wordToNat_natToWord_bound : forall sz n (bound : word sz),
  (n <= wordToNat bound)%nat
  -> wordToNat (natToWord sz n) = n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (@wordToNat sz (natToWord sz n)) n *)
  apply wordToNat_natToWord_idempotent'.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  eapply le_lt_trans; eauto.
(* Goal: lt (@wordToNat sz w) (Nat.pow (S (S O)) sz) *)
  apply wordToNat_bound.
Qed.

Lemma wordToNat_natToWord_le : forall sz n,
  (wordToNat (natToWord sz n) <= n)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  case_eq (lt_dec n (pow2 sz)); intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wordToNat_natToWord_idempotent'; auto.
  eapply le_trans.
(* Goal: le (@wordToNat sz n) m *)
  apply Nat.lt_le_incl.
(* Goal: lt (@wordToNat sz w) (Nat.pow (S (S O)) sz) *)
  apply wordToNat_bound.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wordToNat_natToWord_lt : forall sz n b,
  (n < b -> wordToNat (natToWord sz n) < b)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  eapply le_lt_trans.
  apply wordToNat_natToWord_le.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma wordToNat_eq_natToWord : forall sz (w : word sz) n,
  wordToNat w = n
  -> w = natToWord sz n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite <- H. rewrite natToWord_wordToNat. auto.
Qed.

Lemma wlt_lt_bound: forall sz (a : word sz) (b bound : nat),
  (a < natToWord sz b)%word
  -> (b <= wordToNat (natToWord sz bound))%nat
  -> (wordToNat a < b)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (S sz)) n (natToWord (S sz) O) *)
  apply wlt_lt in H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  erewrite wordToNat_natToWord_bound in H; eauto.
Qed.

Lemma natplus1_wordplus1_eq:
  forall sz (a bound : word sz),
    (0 < sz)%nat ->
    (a < bound)%word ->
    (wordToNat a) + 1 = wordToNat (a ^+ (natToWord sz 1)).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  rewrite wplus_alt. unfold wplusN, wordBinN. simpl.
  assert ((1 < pow2 sz)%nat).
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS false n (natToWord n O)) *)
  inversion H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  simpl; auto.
  apply one_lt_pow2.
  erewrite wordToNat_natToWord_bound.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wordToNat_natToWord_idempotent' by auto.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
(* Goal: @eq (word (S sz)) n (natToWord (S sz) O) *)
  apply wlt_lt in H0.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wordToNat_natToWord_idempotent' by auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  instantiate (1:=bound). omega.
Qed.

Lemma lt_wlt: forall sz (n : word sz) m, (wordToNat n < wordToNat m)%nat ->
  n < m.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: not (@wlt sz a b) *)
  unfold wlt.
(* Goal: @eq N N0 (@wordToN sz (wzero sz)) *)
  repeat rewrite wordToN_nat.
(* Goal: N.lt (Npos p) (Npow2 (S sz)) *)
  apply Nlt_in.
(* Goal: @eq nat (N.to_nat (N.of_nat (@wordToNat sz y))) (N.to_nat (N.of_nat (@wordToNat sz (natToWord sz O)))) *)
  repeat rewrite Nat2N.id.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma le_wle: forall sz (n : word sz) m, (wordToNat n <= wordToNat m)%nat ->
  n <= m.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: not (@wlt sz a b) *)
  unfold wlt.
(* Goal: @eq N N0 (@wordToN sz (wzero sz)) *)
  repeat rewrite wordToN_nat.
(* Goal: not (N.lt (N.of_nat (@wordToNat sz m)) (N.of_nat (@wordToNat sz n))) *)
  apply N.le_ngt.
(* Goal: N.le (N.of_nat (@wordToNat sz n)) (N.of_nat (@wordToNat sz m)) *)
  apply N.ge_le.
(* Goal: N.ge (N.of_nat (@wordToNat sz m)) (N.of_nat (@wordToNat sz n)) *)
  apply Nge_in.
(* Goal: @eq nat (N.to_nat (N.of_nat (@wordToNat sz y))) (N.to_nat (N.of_nat (@wordToNat sz (natToWord sz O)))) *)
  repeat rewrite Nat2N.id.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma wlt_wle_incl : forall sz (a b : word sz),
  (a < b)%word -> (a <= b)%word.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (S sz)) n (natToWord (S sz) O) *)
  apply wlt_lt in H.
(* Goal: not (@wlt sz b a) *)
  apply le_wle.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wminus_Alt2: forall sz x y, y <= x ->
  @wminusN sz x y = wordBinN minus x y.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wminusN sz x y) (@wordBinN Init.Nat.sub sz x y) *)
  unfold wminusN, wplusN, wnegN, wordBinN.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  destruct (weq y (natToWord sz 0)); subst.

(* Goal: @eq N N0 (N.of_nat (@wordToNat sz (wzero sz))) *)
  rewrite roundTrip_0.
  repeat rewrite <- minus_n_O.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite <- drop_sub with (k:=1) (n:=pow2 sz); try omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (pow2 sz - 1 * pow2 sz) with (0) by omega.
(* Goal: @eq N N0 (N.of_nat (@wordToNat sz (wzero sz))) *)
  rewrite roundTrip_0.
  rewrite <- plus_n_O.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.

  rewrite wordToNat_natToWord_idempotent' with (n:=pow2 sz - wordToNat y).
  rewrite <- drop_sub with (k:=1).
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
  rewrite <- plus_n_O.
  replace (wordToNat x + (pow2 sz - wordToNat y) - pow2 sz) with (wordToNat x - wordToNat y).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
(* Goal: @eq nat (Init.Nat.sub (@wordToNat sz x) (@wordToNat sz y)) (Init.Nat.sub (Init.Nat.add (@wordToNat sz x) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz y))) (Nat.pow (S (S O)) sz)) *)
(* Goal: le (Init.Nat.mul (S O) (Nat.pow (S (S O)) sz)) (Init.Nat.add (@wordToNat sz x) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz y))) *)
(* Goal: lt (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz y)) (Nat.pow (S (S O)) sz) *)
  rewrite Nat.add_sub_assoc.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.

(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  remember (wordToNat_bound y); omega.

(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl. rewrite <- plus_n_O.
(* Goal: le (Nat.pow (S (S O)) sz) (Init.Nat.add (@wordToNat sz x) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz y))) *)
(* Goal: lt (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz y)) (Nat.pow (S (S O)) sz) *)
  rewrite Nat.add_sub_assoc; [| remember (wordToNat_bound y); omega ].
(* Goal: le (Nat.pow (S (S O)) sz) (Nat.sub (Nat.add (@wordToNat sz x) (Nat.pow (S (S O)) sz)) (@wordToNat sz y)) *)
(* Goal: lt (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz y)) (Nat.pow (S (S O)) sz) *)
  rewrite plus_comm.
  rewrite <- Nat.add_sub_assoc.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.

(* Goal: le (@wordToNat sz y) (@wordToNat sz x) *)
(* Goal: lt (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz y)) (Nat.pow (S (S O)) sz) *)
  apply Nat.nlt_ge.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold not in *; intros.
(* Goal: P O (@WS b O WO) *)
  apply H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply lt_wlt; auto.

(* Goal: lt (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz y)) (Nat.pow (S (S O)) sz) *)
  apply Nat.sub_lt.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  remember (wordToNat_bound y); omega.

(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (wordToNat y <> 0); try omega.

(* Goal: not (@eq nat (@wordToNat sz y) O) *)
  assert (wordToN y <> wordToN (natToWord sz 0)).
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold not in *. intros. apply n.
(* Goal: @eq (word sz) (NToWord sz (N.sub n (N.mul k (Npow2 sz)))) (NToWord sz n) *)
  apply wordToN_inj.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.

(* Goal: not (@eq nat (@wordToNat sz y) O) *)
  repeat rewrite wordToN_nat in H0.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold not in *. intros. apply H0.
(* Goal: @eq N (N.of_nat (@wordToNat sz (natToWord sz (N.to_nat n)))) (N.sub n (N.mul (N.of_nat k) (Npow2 sz))) *)
  apply N2Nat.inj.
(* Goal: @eq nat (N.to_nat (N.of_nat (@wordToNat sz y))) (N.to_nat (N.of_nat (@wordToNat sz (natToWord sz O)))) *)
  repeat rewrite Nat2N.id.
(* Goal: @eq N N0 (N.of_nat (@wordToNat sz (wzero sz))) *)
  rewrite roundTrip_0.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Theorem wlt_wf:
  forall sz, well_founded (@wlt sz).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @well_founded (word sz) (@wlt sz) *)
  eapply well_founded_lt_compat with (f:=@wordToNat sz).
(* Goal: forall (x y : word sz) (_ : @wlt sz x y), lt (@wordToNat sz x) (@wordToNat sz y) *)
  apply wlt_lt.
Qed.

Ltac wlt_ind :=
  match goal with
  | [ |- forall (n: word ?len), ?P ] =>
    refine (well_founded_ind (@wlt_wf len) (fun n => P) _)
  end.

Theorem wordToNat_plusone: forall sz w w', w < w' ->
  wordToNat (w ^+ natToWord sz 1) = S (wordToNat w).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.

(* Goal: @eq (word sz) (ZToWord sz (Z.add (@wordToZ sz w1) (@wordToZ sz (@wneg sz w2)))) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  destruct sz.
(* Goal: @eq Z match @wordToN (S sz) (@wneg (S sz) (natToWord (S sz) (Pos.to_nat p))) with | N0 => Z0 | Npos x => Zpos x end (Zneg p) *)
  exfalso.
  rewrite word0 with (w:=w') in H.
  rewrite word0 with (w:=w) in H.
(* Goal: @eq (word (S sz)) n (natToWord (S sz) O) *)
  apply wlt_lt in H.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.

(* Goal: @eq (word (S sz)) (natToWord (S sz) (Init.Nat.add n m)) (@wplus (S sz) (natToWord (S sz) n) (natToWord (S sz) m)) *)
  rewrite wplus_alt.
(* Goal: @eq (word (S sz)) (natToWord (S sz) (Init.Nat.add n m)) (@wplusN (S sz) (natToWord (S sz) n) (natToWord (S sz) m)) *)
  unfold wplusN, wordBinN.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (natToWord (Init.Nat.add sz1 sz2) (Init.Nat.sub (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2)) (Init.Nat.sub (Nat.pow (S (S O)) sz1) (Init.Nat.sub (Nat.pow (S (S O)) sz1) (S n))))) (natToWord (Init.Nat.add sz1 sz2) (Init.Nat.sub (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2)) (@wordToNat (Init.Nat.add sz1 sz2) (natToWord (Init.Nat.add sz1 sz2) (S n))))) *)
  rewrite wordToNat_natToWord_idempotent'.

(* Goal: @eq nat (@wordToNat (S sz) n) (S (@wordToNat (S sz) (natToWord (S sz) (Init.Nat.sub (@wordToNat (S sz) n) (@wordToNat (S sz) (natToWord (S sz) (S O))))))) *)
(* Goal: not (@wlt (S sz) n (natToWord (S sz) (S O))) *)
  rewrite roundTrip_1.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.

  eapply Nat.le_lt_trans; [| apply wordToNat_bound ].
  rewrite wordToNat_natToWord_idempotent';
    [| erewrite <- roundTrip_1 at 1; apply wordToNat_bound ].
(* Goal: @eq (word (S sz)) n (natToWord (S sz) O) *)
  apply wlt_lt in H.
  instantiate (1:=w').
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.


Theorem wordToNat_minus_one': forall sz n, n <> natToWord sz 0 ->
  S (wordToNat (n ^- natToWord sz 1)) = wordToNat n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (ZToWord sz (Z.add (@wordToZ sz w1) (@wordToZ sz (@wneg sz w2)))) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  destruct sz.
(* Goal: @eq nat (S (@wordToNat O (@wminus O n (natToWord O (S O))))) (@wordToNat O n) *)
(* Goal: @eq nat (S (@wordToNat (S sz) (@wminus (S sz) n (natToWord (S sz) (S O))))) (@wordToNat (S sz) n) *)
  rewrite word0 with (w:=n) in H.
(* Goal: @eq nat (S (@wordToNat O (@wminus O n (natToWord O (S O))))) (@wordToNat O n) *)
(* Goal: @eq nat (S (@wordToNat (S sz) (@wminus (S sz) n (natToWord (S sz) (S O))))) (@wordToNat (S sz) n) *)
  rewrite word0 with (w:=natToWord 0 0) in H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  exfalso; auto.

(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct (weq n (natToWord (S sz) 0)); intuition.
(* Goal: @eq nat (@wordToNat (S sz) n) (S (@wordToNat (S sz) (@wminus (S sz) n (natToWord (S sz) (S O))))) *)
  rewrite wminus_Alt.
(* Goal: @eq nat (@wordToNat (S sz) n) (S (@wordToNat (S sz) (@wminusN (S sz) n (natToWord (S sz) (S O))))) *)
  rewrite wminus_Alt2.
(* Goal: @eq nat (@wordToNat (S sz) n) (S (@wordToNat (S sz) (@wordBinN Init.Nat.sub (S sz) n (natToWord (S sz) (S O))))) *)
(* Goal: not (@wlt (S sz) n (natToWord (S sz) (S O))) *)
  unfold wordBinN.
(* Goal: @eq nat (@wordToNat (S sz) n) (S (@wordToNat (S sz) (natToWord (S sz) (Init.Nat.sub (@wordToNat (S sz) n) (@wordToNat (S sz) (natToWord (S sz) (S O))))))) *)
(* Goal: not (@wlt (S sz) n (natToWord (S sz) (S O))) *)
  rewrite roundTrip_1.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  erewrite wordToNat_natToWord_bound with (bound:=n); try omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (wordToNat n <> 0); try omega.
(* Goal: not (@wlt (S sz) n (natToWord (S sz) (S O))) *)
  unfold not; intros; apply n0; clear n0.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite <- H0; rewrite natToWord_wordToNat; auto.
(* Goal: not (@wlt (S sz) n (natToWord (S sz) (S O))) *)
  unfold not; intros; apply n0; clear n0.
(* Goal: @eq (word (S sz)) n (natToWord (S sz) O) *)
  apply wlt_lt in H0.
(* Goal: @eq (word (S sz)) n (natToWord (S sz) O) *)
  replace n with (natToWord (S sz) (wordToNat n)) by (rewrite natToWord_wordToNat; auto).
  f_equal; rewrite roundTrip_1 in *.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Theorem wordToNat_minus_one: forall sz n, n <> natToWord sz 0 ->
  wordToNat (n ^- natToWord sz 1) = wordToNat n - 1.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  erewrite Nat.succ_inj with (n2 := wordToNat (n ^- (natToWord sz 1))); auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wordToNat_minus_one'; auto.
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  assert (wordToNat n <> 0).
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  intuition.
  erewrite <- roundTrip_0 with (sz := sz) in H0.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply wordToNat_inj in H0; tauto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma lt_minus : forall a b c,
  (b <= a -> b < c -> a < c -> a - b < c)%nat.
Proof.
(* Goal: forall (a b c : nat) (_ : le b a) (_ : lt b c) (_ : lt a c), lt (Init.Nat.sub a b) c *)
  intros; omega.
Qed.

Lemma wminus_minus : forall sz (a b : word sz),
  b <= a
  -> wordToNat (a ^- b) = wordToNat a - wordToNat b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (@wordToNat (S sz) n) (S (@wordToNat (S sz) (@wminus (S sz) n (natToWord (S sz) (S O))))) *)
  rewrite wminus_Alt.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wminus_Alt2; auto.
(* Goal: @eq nat (@wordToNat (S sz) n) (S (@wordToNat (S sz) (@wordBinN Init.Nat.sub (S sz) n (natToWord (S sz) (S O))))) *)
(* Goal: not (@wlt (S sz) n (natToWord (S sz) (S O))) *)
  unfold wordBinN.
(* Goal: @eq nat (@wordToNat sz (natToWord sz n)) n *)
  eapply wordToNat_natToWord_idempotent'.
(* Goal: lt (Init.Nat.sub (@wordToNat sz a) (@wordToNat sz b)) (Nat.pow (S (S O)) sz) *)
  apply lt_minus.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply wle_le; auto.
(* Goal: lt (@wordToNat sz w) (Nat.pow (S (S O)) sz) *)
  apply wordToNat_bound.
(* Goal: lt (@wordToNat sz w) (Nat.pow (S (S O)) sz) *)
  apply wordToNat_bound.
Qed.

Lemma wminus_minus': forall (sz : nat) (a b : word sz),
    (#b <= #a)%nat ->
    #(a ^- b) = #a - #b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. apply wminus_minus.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
  unfold wlt. intro C.
(* Goal: False *)
  apply Nlt_out in C.
  rewrite! wordToN_to_nat in *.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wordToNat_neq_inj: forall sz (a b : word sz),
  a <> b <-> wordToNat a <> wordToNat b.
Proof.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  split; intuition.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply wordToNat_inj in H0; auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  subst; auto.
Qed.

Lemma natToWord_discriminate: forall sz, (sz > 0)%nat -> natToWord sz 0 <> natToWord sz 1.
Proof.
(* Goal: not (@eq (word sz) (natToWord sz O) (wones sz)) *)
  unfold not.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: False *)
  induction sz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
(* Goal: False *)
  unfold natToWord in H0; fold natToWord in H0.
(* Goal: False *)
  discriminate H0.
Qed.

(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
Definition bit_dec : forall (a : word 1), {a = $0} + {a = $1}.
(* Goal: forall _ : @eq (word (S sz)) (@wminus (S sz) w1 (natToWord (S sz) (Nat.pow (S (S O)) sz))) w2, @eq (word (S sz)) w1 (@wminus (S sz) w2 (natToWord (S sz) (Nat.pow (S (S O)) sz))) *)
  intro.
(* Goal: sumbool (@eq (word (S O)) a (natToWord (S O) O)) (@eq (word (S O)) a (natToWord (S O) (S O))) *)
  rewrite (shatter_word a).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  replace (wtl a) with WO by auto.
(* Goal: sumbool (@eq (word (S O)) (@WS (@whd O a) O WO) (natToWord (S O) O)) (@eq (word (S O)) (@WS (@whd O a) O WO) (natToWord (S O) (S O))) *)
  destruct (whd a).
(* Goal: sumbool (@eq (word (S O)) (@WS true O WO) (natToWord (S O) O)) (@eq (word (S O)) (@WS true O WO) (natToWord (S O) (S O))) *)
(* Goal: sumbool (@eq (word (S O)) (@WS false O WO) (natToWord (S O) O)) (@eq (word (S O)) (@WS false O WO) (natToWord (S O) (S O))) *)
  right; apply eq_refl.
(* Goal: sumbool (@eq (word (S O)) (@WS false O WO) (natToWord (S O) O)) (@eq (word (S O)) (@WS false O WO) (natToWord (S O) (S O))) *)
  left; apply eq_refl.
Defined.

Lemma neq0_wneq0: forall sz (n : word sz),
  wordToNat n <> 0  <-> n <> $0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  split; intros.
(* Goal: not (@eq (word sz) n (natToWord sz O)) *)
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
  apply wordToNat_neq_inj.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite roundTrip_0; auto.
(* Goal: gt (@wordToNat sz n) O *)
  apply wordToNat_neq_inj in H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite roundTrip_0 in H; auto.
Qed.

Lemma gt0_wneq0: forall sz (n : word sz),
  (wordToNat n > 0)%nat <-> n <> $0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  split; intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  apply neq0_wneq0; omega.
(* Goal: gt (@wordToNat sz n) O *)
  apply wordToNat_neq_inj in H.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite roundTrip_0 in H; omega.
Qed.

Lemma weq_minus1_wlt: forall sz (a b : word sz),
  (a <> $0 -> a ^- $1 = b -> a > b)%word.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  apply lt_wlt; subst.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wordToNat_minus_one; auto.
(* Goal: lt (Init.Nat.sub (@wordToNat sz a) (S O)) (@wordToNat sz a) *)
  apply gt0_wneq0 in H.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wordnat_minus1_eq : forall sz n (w : word sz),
  (n > 0)%nat
  -> n = wordToNat w
  -> n - 1 = wordToNat (w ^- $1).
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  intros; rewrite wordToNat_minus_one; auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply gt0_wneq0; subst; auto.
Qed.

Theorem wlshift_0 : forall sz (w : word sz), @wlshift sz w 0 = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (@wordToNat sz (@wlshift sz (natToWord sz O) n)) (@wordToNat sz (natToWord sz O)) *)
  unfold wlshift.
(* Goal: @eq (word sz) (split1 sz O (@eq_rec_r nat (Nat.add O sz) (fun n : nat => word n) (@combine O (wzero O) sz w) (Nat.add sz O) (Nat.add_comm sz O))) w *)
  eapply split1_0.
Qed.

Theorem wrshift_0 : forall sz (w : word sz), @wrshift sz w 0 = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wnot sz (@wrshift sz w n)) (split2 n sz (@eq_rect nat (Init.Nat.add sz n) word (@combine sz (@wnot sz w) n (wones n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) *)
  unfold wrshift.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: @eq (word sz) (@eq_rec_r nat (Nat.add sz O) (fun n : nat => word n) (@combine sz w O (wzero O)) sz (Nat.add_comm O sz)) w *)
  rewrite combine_n_0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  eq_rect_simpl. reflexivity.
Qed.

Theorem wlshift_gt : forall sz n (w : word sz), (n > sz)%nat ->
  wlshift w n = wzero sz.
Proof.
  intros sz n w H.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
  remember (n - sz) as e.
  assert (n = sz + e) by omega; subst n.
  intros w.
(* Goal: @eq nat (@wordToNat sz (@wlshift sz (natToWord sz O) n)) (@wordToNat sz (natToWord sz O)) *)
  unfold wlshift.
  rewrite <- combine_wzero.
  erewrite combine_assoc, eq_rect_word_match.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
  rewrite eq_rect_combine.
  apply split1_combine.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  Grab Existential Variables. omega.
Qed.

Theorem wrshift_gt : forall sz n (w : word sz), (n > sz)%nat ->
  wrshift w n = wzero sz.
Proof.
  intros sz n w H.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
  remember (n - sz) as e.
  assert (n = sz + e) by omega; subst n.
  intros w.
(* Goal: @eq (word sz) (@wnot sz (@wrshift sz w n)) (split2 n sz (@eq_rect nat (Init.Nat.add sz n) word (@combine sz (@wnot sz w) n (wones n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) *)
  unfold wrshift.
  erewrite wzero_rev, <- combine_wzero.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
  rewrite <- eq_rect_word_match, <- eq_rect_combine, eq_rect_word_match.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
  rewrite eq_rect_combine_assoc', split2_combine.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  Grab Existential Variables. omega.
Qed.

Theorem wlshift_bitwp : forall sz (w1 w2 : word sz) f n,
  wlshift (bitwp f w1 w2) n = split1 sz n (
    eq_rec _ word (combine (wzero n) (bitwp f w1 w2)) _ (eq_sym (Nat.add_comm sz n))).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (@wordToNat sz (@wlshift sz (natToWord sz O) n)) (@wordToNat sz (natToWord sz O)) *)
  unfold wlshift.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem wrshift_bitwp : forall sz (w1 w2 : word sz) f n,
  wrshift (bitwp f w1 w2) n = split2 n sz (
    eq_rect _ word (combine (bitwp f w1 w2) (wzero n)) _ (eq_sym (Nat.add_comm n sz))).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wnot sz (@wrshift sz w n)) (split2 n sz (@eq_rect nat (Init.Nat.add sz n) word (@combine sz (@wnot sz w) n (wones n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) *)
  unfold wrshift.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem wnot_wlshift : forall sz (w : word sz) n,
  wnot (wlshift w n) = split1 sz n (eq_rect _ word (combine (wones n) (wnot w)) _ (eq_sym (Nat.add_comm sz n))).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (@wordToNat sz (@wlshift sz (natToWord sz O) n)) (@wordToNat sz (natToWord sz O)) *)
  unfold wlshift.
(* Goal: @eq (word sz) (@wnot sz (split1 sz n (@eq_rec_r nat (Nat.add n sz) (fun n : nat => word n) (@combine n (wzero n) sz w) (Nat.add sz n) (Nat.add_comm sz n)))) (split1 sz n (@eq_rect nat (Init.Nat.add n sz) word (@combine n (wones n) sz (@wnot sz w)) (Nat.add sz n) (@eq_sym nat (Nat.add sz n) (Nat.add n sz) (Nat.add_comm sz n)))) *)
  rewrite wnot_split1.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
(* Goal: @eq (word sz) (split2 n sz (@wnot (Init.Nat.add n sz) (@eq_rect nat (Nat.add sz n) (fun y : nat => word y) (@combine sz w n (wzero n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz))))) (split2 n sz (@eq_rect nat (Init.Nat.add sz n) word (@combine sz (@wnot sz w) n (wones n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) *)
  rewrite wnot_eq_rect.
(* Goal: @eq (word sz) (split2 n sz (@eq_rect nat (Nat.add sz n) word (@wnot (Nat.add sz n) (@combine sz w n (wzero n))) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) (split2 n sz (@eq_rect nat (Init.Nat.add sz n) word (@combine sz (@wnot sz w) n (wones n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) *)
  rewrite wnot_combine.
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O)))))) (@wnot sz (natToWord sz O))) (natToWord sz (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O)))))) *)
(* Goal: @eq bool (andb (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n1))) (negb (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n2))))) (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n1))) *)
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n1)))) (@wnot sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n2)))))) (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n1)))) *)
  rewrite wnot_zero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem wnot_wrshift : forall sz (w : word sz) n,
  wnot (wrshift w n) = split2 n sz (eq_rect _ word (combine (wnot w) (wones n)) _ (eq_sym (Nat.add_comm n sz))).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wnot sz (@wrshift sz w n)) (split2 n sz (@eq_rect nat (Init.Nat.add sz n) word (@combine sz (@wnot sz w) n (wones n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) *)
  unfold wrshift.
(* Goal: @eq (word sz) (@wnot sz (split2 n sz (@eq_rec_r nat (Nat.add sz n) (fun n : nat => word n) (@combine sz w n (wzero n)) (Nat.add n sz) (Nat.add_comm n sz)))) (split2 n sz (@eq_rect nat (Init.Nat.add sz n) word (@combine sz (@wnot sz w) n (wones n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) *)
  rewrite wnot_split2.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
(* Goal: @eq (word sz) (split2 n sz (@wnot (Init.Nat.add n sz) (@eq_rect nat (Nat.add sz n) (fun y : nat => word y) (@combine sz w n (wzero n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz))))) (split2 n sz (@eq_rect nat (Init.Nat.add sz n) word (@combine sz (@wnot sz w) n (wones n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) *)
  rewrite wnot_eq_rect.
(* Goal: @eq (word sz) (split2 n sz (@eq_rect nat (Nat.add sz n) word (@wnot (Nat.add sz n) (@combine sz w n (wzero n))) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) (split2 n sz (@eq_rect nat (Init.Nat.add sz n) word (@combine sz (@wnot sz w) n (wones n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) *)
  rewrite wnot_combine.
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O)))))) (@wnot sz (natToWord sz O))) (natToWord sz (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O)))))) *)
(* Goal: @eq bool (andb (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n1))) (negb (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n2))))) (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n1))) *)
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n1)))) (@wnot sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n2)))))) (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n1)))) *)
  rewrite wnot_zero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wlshift_alt: forall sz n (a: word sz),
    wlshift' a n = wlshift a n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold wlshift, wlshift'.
  unfold eq_rec_r.
  unfold eq_rec.
  erewrite nat_cast_proof_irrel.
(* Goal: @eq (word sz) (@nat_cast word (Init.Nat.add sz1 sz2) sz e (@sext sz1 (@wneg sz1 (natToWord sz1 n)) sz2)) (@wneg sz (natToWord sz n)) *)
  rewrite nat_cast_eq_rect.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Theorem div2_pow2_twice: forall n,
  Nat.div2 (pow2 n + (pow2 n + 0)) = pow2 n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (pow2 n + (pow2 n + 0)) with (2 * pow2 n) by omega.
(* Goal: le (Init.Nat.mul (S (S O)) m) (S (Init.Nat.mul (S (S O)) (Nat.div2 (Init.Nat.mul (S (S O)) m)))) *)
  rewrite Nat.div2_double.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Theorem zero_or_wordToNat_S: forall sz (n : word sz),
  n = $0 \/
  exists nn, wordToNat n = S nn /\ wordToNat (n ^- $1) = nn.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (ZToWord sz (Z.add (@wordToZ sz w1) (@wordToZ sz (@wneg sz w2)))) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  destruct sz.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  left. rewrite (word0 n). auto.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct (weq n $0); intuition.
(* Goal: or (@eq (word (S sz)) n (natToWord (S sz) O)) (@ex nat (fun nn : nat => and (@eq nat (@wordToNat (S sz) n) (S nn)) (@eq nat (@wordToNat (S sz) (@wminus (S sz) n (natToWord (S sz) (S O)))) nn))) *)
  right.
  exists (wordToNat (n ^- $1)); intuition.
(* Goal: @eq nat (@wordToNat (S sz) n) (S (@wordToNat (S sz) (@wminus (S sz) n (natToWord (S sz) (S O))))) *)
  rewrite wminus_Alt.
(* Goal: @eq nat (@wordToNat (S sz) n) (S (@wordToNat (S sz) (@wminusN (S sz) n (natToWord (S sz) (S O))))) *)
  rewrite wminus_Alt2.
(* Goal: @eq nat (@wordToNat (S sz) n) (S (@wordToNat (S sz) (@wordBinN Init.Nat.sub (S sz) n (natToWord (S sz) (S O))))) *)
(* Goal: not (@wlt (S sz) n (natToWord (S sz) (S O))) *)
  unfold wordBinN.
(* Goal: @eq nat (@wordToNat (S sz) n) (S (@wordToNat (S sz) (natToWord (S sz) (Init.Nat.sub (@wordToNat (S sz) n) (@wordToNat (S sz) (natToWord (S sz) (S O))))))) *)
(* Goal: not (@wlt (S sz) n (natToWord (S sz) (S O))) *)
  rewrite roundTrip_1.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  erewrite wordToNat_natToWord_bound with (bound:=n); try omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (wordToNat n <> 0); try omega.
(* Goal: not (@wlt (S sz) n (natToWord (S sz) (S O))) *)
  unfold not; intros; apply n0; clear n0.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite <- H. rewrite natToWord_wordToNat; auto.
(* Goal: not (@wlt (S sz) n (natToWord (S sz) (S O))) *)
  unfold not; intros; apply n0; clear n0.
(* Goal: @eq (word (S sz)) n (natToWord (S sz) O) *)
  apply wlt_lt in H.
(* Goal: @eq (word (S sz)) n (natToWord (S sz) O) *)
  replace n with (natToWord (S sz) (wordToNat n)) by (rewrite natToWord_wordToNat; auto).
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
  rewrite roundTrip_1 in *.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Theorem wbit_or_same : forall sz sz' (n : word sz'), (wordToNat n < sz)%nat
  -> (wbit sz n) ^| (wbit sz n) <> wzero sz.
Proof.
(* Goal: not (@eq (word sz) (natToWord sz O) (wones sz)) *)
  unfold not.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  induction sz; intros; try omega.
  unfold wbit, wzero, wor in *.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  simpl in *.
(* Goal: False *)
  destruct (zero_or_wordToNat_S n).
(* Goal: False *)
  subst; rewrite roundTrip_0 in *. discriminate.
(* Goal: False *)
  destruct H1. destruct H1.
  rewrite H1 in *.
(* Goal: False *)
  inversion H0.
(* Goal: False *)
  apply (inj_pair2_eq_dec _ eq_nat_dec) in H5.
(* Goal: False *)
  rewrite div2_pow2_twice in H5.
  repeat rewrite <- H2 in H5.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  eapply IHsz; eauto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Theorem wbit_or_other : forall sz sz' (n1 n2 : word sz'), (wordToNat n1 < sz)%nat
  -> (wordToNat n2 < sz)%nat
  -> (n1 <> n2)
  -> (wbit sz n1) ^& (wbit sz n2) = wzero sz.
Proof.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  induction sz; intros; try omega.
(* Goal: @eq (word (S sz)) (@wand (S sz) (@wbit (S sz) sz' n1) (@wbit (S sz) sz' n2)) (wzero (S sz)) *)
  unfold wbit, wzero, wand.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
  destruct (zero_or_wordToNat_S n1); destruct (zero_or_wordToNat_S n2);
(* Goal: @eq N N0 (N.of_nat (@wordToNat sz (wzero sz))) *)
    try congruence; destruct_conjs; subst; try rewrite roundTrip_0.

(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  repeat rewrite H4; simpl; repeat rewrite mod2_pow2_twice; f_equal.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wand_kill; auto.

(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  repeat rewrite H4; simpl; repeat rewrite mod2_pow2_twice; f_equal.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wand_comm; rewrite wand_kill; auto.

(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  repeat rewrite H4; repeat rewrite H6; simpl.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  repeat rewrite mod2_pow2_twice; f_equal.
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O))))) (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O))))) O)))) (@wnot sz (natToWord sz (Nat.div2 (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n2 (natToWord sz' (S O))))) (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n2 (natToWord sz' (S O))))) O)))))) (natToWord sz (Nat.div2 (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O))))) (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O))))) O)))) *)
  repeat rewrite div2_pow2_twice.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  eapply IHsz; try omega.

(* Goal: not (@eq (word sz') (@wminus sz' n1 (natToWord sz' (S O))) (@wminus sz' n2 (natToWord sz' (S O)))) *)
  apply word_neq.
  unfold not in *; intros; apply H1; clear H1.
  apply sub_0_eq; rewrite <- H2.
(* Goal: @eq (word sz') (@wminus sz' n1 n2) (@wminus sz' (@wminus sz' n1 (natToWord sz' (S O))) (@wminus sz' n2 (natToWord sz' (S O)))) *)
  ring_sz sz'.
Qed.

Theorem wbit_and_not: forall sz sz' (n : word sz'), (wordToNat n < sz)%nat
  -> (wbit sz n) ^& wnot (wbit sz n) = wzero sz.
Proof.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  induction sz; intros; try omega.
(* Goal: @eq (word (S sz)) (@wand (S sz) (@wbit (S sz) sz' n1) (@wnot (S sz) (@wbit (S sz) sz' n2))) (@wbit (S sz) sz' n1) *)
  unfold wbit, wzero, wand, wnot.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: @eq bool (andb (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n))) (negb (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n))))) false *)
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n)))) ((fix wnot (sz : nat) (w : word sz) {struct w} : word sz := match w in (word n) return (word n) with | WO => WO | @WS b n w' => @WS (negb b) n (wnot n w') end) sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n)))))) (natToWord sz O) *)
  apply andb_negb_r.

(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  destruct (zero_or_wordToNat_S n); subst.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  rewrite roundTrip_0; simpl.
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz O) ((fix wnot (sz : nat) (w : word sz) {struct w} : word sz := match w in (word n) return (word n) with | WO => WO | @WS b n w' => @WS (negb b) n (wnot n w') end) sz (natToWord sz O))) (natToWord sz O) *)
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n)))) ((fix wnot (sz : nat) (w : word sz) {struct w} : word sz := match w in (word n) return (word n) with | WO => WO | @WS b n w' => @WS (negb b) n (wnot n w') end) sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n)))))) (natToWord sz O) *)
  apply wand_kill.

(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n)))) ((fix wnot (sz : nat) (w : word sz) {struct w} : word sz := match w in (word n) return (word n) with | WO => WO | @WS b n w' => @WS (negb b) n (wnot n w') end) sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n)))))) (natToWord sz O) *)
  do 2 destruct H0.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  rewrite H0; simpl.
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.add (Nat.pow (S (S O)) x) (Nat.add (Nat.pow (S (S O)) x) O)))) ((fix wnot (sz : nat) (w : word sz) {struct w} : word sz := match w in (word n) return (word n) with | WO => WO | @WS b n w' => @WS (negb b) n (wnot n w') end) sz (natToWord sz (Nat.div2 (Nat.add (Nat.pow (S (S O)) x) (Nat.add (Nat.pow (S (S O)) x) O)))))) (natToWord sz O) *)
  rewrite div2_pow2_twice.
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.pow (S (S O)) x)) ((fix wnot (sz : nat) (w : word sz) {struct w} : word sz := match w in (word n) return (word n) with | WO => WO | @WS b n w' => @WS (negb b) n (wnot n w') end) sz (natToWord sz (Nat.pow (S (S O)) x)))) (natToWord sz O) *)
  fold wnot.
  rewrite <- H1.
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n (natToWord sz' (S O)))))) (@wnot sz (natToWord sz (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n (natToWord sz' (S O)))))))) (natToWord sz O) *)
  eapply IHsz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Theorem wbit_and_not_other: forall sz sz' (n1 n2 : word sz'), (wordToNat n1 < sz)%nat
  -> (wordToNat n2 < sz)%nat
  -> n1 <> n2
  -> (wbit sz n1) ^& wnot (wbit sz n2) = wbit sz n1.
Proof.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  induction sz; intros; try omega.
(* Goal: @eq (word (S sz)) (@wand (S sz) (@wbit (S sz) sz' n1) (@wnot (S sz) (@wbit (S sz) sz' n2))) (@wbit (S sz) sz' n1) *)
  unfold wbit, wzero, wand, wnot.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
  destruct (zero_or_wordToNat_S n1); destruct (zero_or_wordToNat_S n2);
    try congruence; destruct_conjs; subst; fold wnot; try rewrite roundTrip_0; simpl;
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
    f_equal.

(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite H4; simpl; rewrite mod2_pow2_twice; auto.
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz O) ((fix wnot (sz : nat) (w : word sz) {struct w} : word sz := match w in (word n) return (word n) with | WO => WO | @WS b n w' => @WS (negb b) n (wnot n w') end) sz (natToWord sz O))) (natToWord sz O) *)
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n)))) ((fix wnot (sz : nat) (w : word sz) {struct w} : word sz := match w in (word n) return (word n) with | WO => WO | @WS b n w' => @WS (negb b) n (wnot n w') end) sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n)))))) (natToWord sz O) *)
  rewrite H4; simpl; rewrite div2_pow2_twice; apply wand_kill.

(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite H4; simpl; rewrite mod2_pow2_twice; auto.
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.add (Nat.pow (S (S O)) x) (Nat.add (Nat.pow (S (S O)) x) O)))) ((fix wnot (sz : nat) (w : word sz) {struct w} : word sz := match w in (word n) return (word n) with | WO => WO | @WS b n w' => @WS (negb b) n (wnot n w') end) sz (natToWord sz (Nat.div2 (Nat.add (Nat.pow (S (S O)) x) (Nat.add (Nat.pow (S (S O)) x) O)))))) (natToWord sz O) *)
  rewrite H4; simpl; rewrite div2_pow2_twice.
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O)))))) (@wnot sz (natToWord sz O))) (natToWord sz (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O)))))) *)
(* Goal: @eq bool (andb (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n1))) (negb (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n2))))) (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n1))) *)
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n1)))) (@wnot sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n2)))))) (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n1)))) *)
  rewrite wnot_zero. rewrite wand_comm. apply wand_unit.

(* Goal: @eq bool (andb (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n1))) (negb (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n2))))) (mod2 (Nat.pow (S (S O)) (@wordToNat sz' n1))) *)
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n1)))) (@wnot sz (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n2)))))) (natToWord sz (Nat.div2 (Nat.pow (S (S O)) (@wordToNat sz' n1)))) *)
  rewrite H4; simpl; rewrite mod2_pow2_twice; simpl; apply andb_true_r.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  rewrite H4; rewrite H6; simpl.
(* Goal: @eq (word sz) (@bitwp andb sz (natToWord sz (Nat.div2 (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O))))) (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O))))) O)))) (@wnot sz (natToWord sz (Nat.div2 (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n2 (natToWord sz' (S O))))) (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n2 (natToWord sz' (S O))))) O)))))) (natToWord sz (Nat.div2 (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O))))) (Nat.add (Nat.pow (S (S O)) (@wordToNat sz' (@wminus sz' n1 (natToWord sz' (S O))))) O)))) *)
  repeat rewrite div2_pow2_twice.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  apply IHsz; try omega.

(* Goal: not (@eq (word sz') (@wminus sz' n1 (natToWord sz' (S O))) (@wminus sz' n2 (natToWord sz' (S O)))) *)
  apply word_neq.
  unfold not in *; intros; apply H1.
(* Goal: @eq (word sz') n1 n2 *)
  apply sub_0_eq.
  rewrite <- H2.
(* Goal: @eq (word sz') (@wminus sz' n1 n2) (@wminus sz' (@wminus sz' n1 (natToWord sz' (S O))) (@wminus sz' n2 (natToWord sz' (S O)))) *)
  ring_sz sz'.
Qed.

Lemma wordToNat_wzero:
  forall sz, wordToNat (wzero sz) = 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wzero; intros.
(* Goal: @eq nat (@wordToNat sz (natToWord sz O)) O *)
  apply roundTrip_0.
Qed.

Lemma wordToN_wzero:
  forall sz, wordToN (wzero sz) = 0%N.
Proof.
(* Goal: @eq N N0 (@wordToN sz (wzero sz)) *)
  intros; rewrite wordToN_nat.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (wzero n)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz w))) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz w)) *)
  rewrite wordToNat_wzero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma combine_zero:
  forall n m, combine (natToWord n 0) (natToWord m 0) = natToWord _ 0.
Proof.
(* Goal: forall n m : nat, @eq (word (Init.Nat.add n m)) (@combine n (natToWord n O) m (natToWord m O)) (natToWord (Init.Nat.add n m) O) *)
  induction n; simpl; intros; [reflexivity|].
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite IHn; reflexivity.
Qed.

Lemma combine_one:
  forall n m, combine (natToWord (S n) 1) (natToWord m 0) = natToWord _ 1.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  cbn; intros.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite combine_zero; reflexivity.
Qed.

Lemma wmsb_wzero':
  forall sz, wmsb (wzero' sz) false = false.
Proof. induction sz; auto. Qed.

Lemma wmsb_wzero:
  forall sz, wmsb (wzero sz) false = false.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <-wzero'_def.
(* Goal: @eq bool (@wmsb sz (wzero' sz) false) false *)
  apply wmsb_wzero'.
Qed.

Lemma wmsb_wones:
  forall sz, wmsb (wones (S sz)) false = true.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz; cbn; auto.
Qed.

Lemma wmsb_0: forall sz (m: word (S sz)) default,
  (# m < pow2 sz)%nat ->
  @wmsb (S sz) m default = false.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction sz; intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  - simpl in *. assert (#m = 0) as N by omega.
    rewrite <- (roundTrip_0 1) in N.
(* Goal: @eq bool (@wmsb (S O) m default) false *)
    apply wordToNat_inj in N. subst m.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    simpl. reflexivity.
  - pose proof (shatter_word_S m) as P.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
    destruct P as [b [m0 E]]. subst.
(* Goal: @eq bool (@wmsb (S (S sz)) (@WS b (S sz) m0) default) true *)
    unfold wmsb. fold wmsb.
(* Goal: @eq bool (@wmsb (S sz) m0 b) true *)
    apply IHsz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    simpl in H. destruct b; omega.
Qed.

Lemma wmsb_1: forall sz (m: word (S sz)) default,
  pow2 sz <= # m < 2 * pow2 sz ->
  @wmsb (S sz) m default = true.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction sz; intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  - simpl in *. assert (#m = 1) as N by omega.
    rewrite <- (roundTrip_1 1) in N.
(* Goal: @eq bool (@wmsb (S O) m default) true *)
    apply (wordToNat_inj m ($ 1)) in N. subst m.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    simpl. reflexivity.
  - pose proof (shatter_word_S m) as P.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
    destruct P as [b [m0 E]]. subst.
(* Goal: @eq bool (@wmsb (S (S sz)) (@WS b (S sz) m0) default) true *)
    unfold wmsb. fold wmsb.
(* Goal: @eq bool (@wmsb (S sz) m0 b) true *)
    apply IHsz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    simpl in H. destruct b; omega.
Qed.

Lemma wmsb_0_natToWord: forall sz n default,
  (2 * n < pow2 (S sz))%nat ->
  @wmsb (S sz) (natToWord (S sz) n) default = false.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. apply wmsb_0.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pose proof (wordToNat_natToWord_le (S sz) n). unfold pow2 in H. fold pow2 in H. omega.
Qed.

Lemma wmsb_1_natToWord: forall sz n default,
  pow2 sz <= n < 2 * pow2 sz ->
  @wmsb (S sz) (natToWord (S sz) n) default = true.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. apply wmsb_1.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite wordToNat_natToWord_idempotent'; simpl; omega.
Qed.

Lemma wordToN_wzero':
  forall sz, wordToN (wzero' sz) = 0%N.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz; simpl; auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite IHsz; auto.
Qed.

Lemma wordToZ_wzero':
  forall sz, wordToZ (wzero' sz) = 0%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wordToZ; intros.
(* Goal: @eq Z (if @wmsb (S sz) (wzero' (S sz)) false then match @wordToN (S sz) (@wneg (S sz) (wzero' (S sz))) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (wzero' (S sz)) with | N0 => Z0 | Npos x => Zpos x end) Z0 *)
  rewrite wmsb_wzero'.
(* Goal: @eq Z match @wordToN (S sz) (wzero' (S sz)) with | N0 => Z0 | Npos x => Zpos x end Z0 *)
  rewrite wordToN_wzero'.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wordToZ_wzero:
  forall sz, wordToZ (wzero sz) = 0%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wordToZ; intros.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add (Init.Nat.add sz (S n1)) n2) (if @wmsb (S n1) (wzero (S n1)) false then @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wones n2) else @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wzero n2))) *)
  rewrite wmsb_wzero.
(* Goal: @eq (word sz) (NToWord sz (N.add (@wordToN sz (wzero sz)) (@wordToN sz w))) w *)
  rewrite wordToN_wzero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wmsb_existT: (* Note: not axiom free *)
  forall sz1 (w1: word sz1) sz2 (w2: word sz2),
    existT word _ w1 = existT word _ w2 ->
    forall b, wmsb w1 b = wmsb w2 b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  assert (sz1 = sz2) by (apply eq_sigT_fst in H; auto); subst.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  destruct_existT; reflexivity.
Qed.

Lemma destruct_word_S: forall sz (w: word (S sz)),
    exists v b, w = WS b v.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  refine (match w with
          | WO => _
          | WS b v => _
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
          end); unfold IDProp; eauto.
Qed.

Lemma induct_word_S: forall (P : forall n : nat, word (S n) -> Prop),
    (forall b, P 0 (WS b WO)) ->
    (forall b b0 n (w : word n), P n (WS b0 w) -> P (S n) (WS b (WS b0 w))) ->
    forall (n : nat) (w : word (S n)), P n w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction n; intros.
  - destruct (destruct_word_S w) as [v [b E]]. subst w.
(* Goal: @eq (word sz) (@wtl sz (@combine (S O) (@WS b O v) sz y)) y *)
    rewrite (word0 v).
(* Goal: P O (@WS b O WO) *)
    apply H.
  - destruct (destruct_word_S w) as [v [b E]]. subst w.
(* Goal: P (S n) (@WS b (S n) v) *)
    destruct (destruct_word_S v) as [w [b0 E]]. subst v.
(* Goal: P (S n) (@WS b (S n) (@WS b0 n w)) *)
    apply H0.
(* Goal: P n (@WS b0 n w) *)
    apply IHn.
Qed.

Lemma wmsb_ws:
  forall sz (w: word (S sz)) b a, wmsb (WS b w) a = wmsb w a.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. cbn.
(* Goal: @eq bool (@wmsb (S sz) w b) (@wmsb (S sz) w a) *)
  destruct (destruct_word_S w) as [v [c E]].
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (ZToWord sz (Z.opp (@wordToZ sz (ZToWord sz x)))) *)
  rewrite E.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wmsb_extz:
  forall sz (w: word sz) n,
    wmsb (extz w n) false = wmsb w false.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction n; intros; auto.
Qed.

Lemma wmsb_default:
  forall sz (w: word sz) b1 b2,
    sz <> 0 -> wmsb w b1 = wmsb w b2.
Proof.
(* Goal: forall (sz : nat) (w : word sz) (b1 b2 : bool) (_ : not (@eq nat sz O)), @eq bool (@wmsb sz w b1) (@wmsb sz w b2) *)
  dependent induction w; intros; intuition idtac.
Qed.

Lemma wmsb_nat_cast:
  forall sz1 (w: word sz1) sz2 (Hsz: sz1 = sz2) b,
    wmsb w b = wmsb (nat_cast word Hsz w) b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  destruct sz1; intros.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - subst sz2. reflexivity.
  - destruct sz2; [discriminate|].
(* Goal: @eq nat (@wordToNat sz2 (split2 (S sz1) sz2 w)) (Nat.div (@wordToNat (Init.Nat.add (S sz1) sz2) w) (Nat.pow (S (S O)) (S sz1))) *)
    destruct (destruct_word_S w) as [v [b0 E]]. subst w.
(* Goal: @eq bool (@wmsb (S sz1) (@WS b0 sz1 v) b) (@wmsb (S sz2) (@nat_cast word (S sz1) (S sz2) Hsz (@WS b0 sz1 v)) b) *)
    pose proof (eq_add_S sz1 sz2 Hsz) as Hsz'.
(* Goal: @eq bool (@wmsb (S sz1) (@WS b0 sz1 v) b) (@wmsb (S sz2) (@nat_cast word (S sz1) (S sz2) Hsz (@WS b0 sz1 v)) b) *)
    subst sz2.
(* Goal: @eq (word sz) (@nat_cast word (Init.Nat.add sz1 sz2) sz e (@sext sz1 (@wneg sz1 (natToWord sz1 n)) sz2)) (@wneg sz (natToWord sz n)) *)
    rewrite nat_cast_eq_rect.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
    f_equal.
(* Goal: @eq (word (S sz1)) (@WS b0 sz1 v) (@eq_rect nat (S sz1) word (@WS b0 sz1 v) (S sz1) Hsz) *)
    erewrite (WS_eq_rect _ _ _ eq_refl).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
Qed.

Lemma wmsb_eq_rect:
  forall sz1 (w: word sz1) sz2 (Hsz: sz1 = sz2) b,
    wmsb w b = wmsb (eq_rect _ word w _ Hsz) b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite <- nat_cast_eq_rect. apply wmsb_nat_cast.
Qed.

Local Arguments nat_cast: simpl never.

Lemma nat_cast_inj: forall sz sz' (p: sz = sz') (w1 w2: word sz),
    nat_cast word p w1 = nat_cast word p w2 ->
    w1 = w2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. destruct p. rewrite? nat_cast_same in H. assumption.
Qed.

Lemma wtl_nat_cast_WS: forall n m (q: n = m) (p: S n = S m) (w: word n) (b: bool),
    wtl (nat_cast word p (WS b w)) =
    nat_cast word q w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros n m. destruct q. intros.
(* Goal: @eq (word n) (@wtl n (@nat_cast word (S n) (S n) p (@WS b n w))) (@nat_cast word n n (@eq_refl nat n) w) *)
  rewrite nat_cast_same.
(* Goal: @eq (word n) (@wtl n (@nat_cast word (S n) (S n) p (@WS b n w))) w *)
  transitivity (wtl (WS b w)); [|reflexivity].
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
  rewrite <- nat_cast_same.
(* Goal: @eq (word (S n)) (@nat_cast word (S n) (S n) p (@WS b n w)) (@nat_cast word (S n) (S n) (@eq_refl nat (S n)) (@WS b n w)) *)
  apply nat_cast_proof_irrel.
Qed.

Lemma wmsb_split2': forall sz (w: word (S sz)) b,
  wmsb w b = negb (weqb (split2 sz 1 (nat_cast _ (eq_sym (Nat.add_1_r sz)) w)) (natToWord _ 0)).
Proof.
  apply (induct_word_S (fun sz w => forall b, wmsb w b =
     negb (weqb (split2 sz 1 (nat_cast _ (eq_sym (Nat.add_1_r sz)) w)) (natToWord _ 0))));
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - destruct b; reflexivity.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  - cbn in *. rewrite (H false). repeat f_equal.
(* Goal: forall (sz : nat) (w1 w2 : word sz), @eq nat (@wordToNat sz (@wmult sz w1 w2)) (Nat.modulo (Init.Nat.mul (@wordToNat sz w1) (@wordToNat sz w2)) (Nat.pow (S (S O)) sz)) *)
    clear.
    apply (nat_cast_inj (Nat.add_1_r n)).
    erewrite wtl_nat_cast_WS.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
Qed.

Lemma wmsb_split2:
  forall sz (w: word (sz + 1)) b,
    wmsb w b = if weq (split2 _ 1 w) (natToWord _ 0) then false else true.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq bool (@wmsb (Init.Nat.add sz (S O)) w b) (if @weq (S O) (split2 sz (S O) w) (natToWord (S O) O) then false else true) *)
  pose proof (@wmsb_split2' sz). specialize (H (nat_cast _ (Nat.add_1_r sz) w) b).
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  simpl in H.
(* Goal: @eq bool (@wmsb (Init.Nat.add sz (S O)) w b) (if @weq (S O) (split2 sz (S O) w) (natToWord (S O) O) then false else true) *)
  rewrite nat_cast_fuse in H.
  rewrite <- (nat_cast_proof_irrel word _ _ eq_refl) in H.
(* Goal: @eq bool (@wmsb (Init.Nat.add sz (S O)) w b) (if @weq (S O) (split2 sz (S O) w) (natToWord (S O) O) then false else true) *)
  rewrite nat_cast_same in H.
(* Goal: @eq bool (@wmsb (Init.Nat.add sz (S O)) w b) (if @weq (S O) (split2 sz (S O) w) (natToWord (S O) O) then false else true) *)
  destruct (weq (split2 sz 1 w) $ (0)).
  - rewrite e in H. simpl in H. rewrite <- H. clear.
(* Goal: @eq bool (@wmsb (Init.Nat.add sz (S O)) w b) (@wmsb (S sz) (@nat_cast word (Nat.add sz (S O)) (S sz) (Nat.add_1_r sz) w) b) *)
    apply wmsb_nat_cast.
  - simpl in n. apply weqb_ne in n. rewrite n in H. simpl in H. rewrite <- H. clear.
(* Goal: @eq bool (@wmsb (Init.Nat.add sz (S O)) w b) (@wmsb (S sz) (@nat_cast word (Nat.add sz (S O)) (S sz) (Nat.add_1_r sz) w) b) *)
    apply wmsb_nat_cast.
Qed.

Lemma wmsb_true_split2_wones:
  forall sz (w: word (sz + 1)) b,
    wmsb w b = true ->
    wones 1 = split2 sz 1 w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (S O)) (wones (S O)) (split2 sz (S O) w) *)
  pose proof (wmsb_split2 _ w b).
(* Goal: @eq (word (S O)) (wones (S O)) (split2 sz (S O) w) *)
  destruct (weq _ _).
  - rewrite H in H0; discriminate.
  - clear -n.
(* Goal: @eq (word (S O)) (wones (S O)) (split2 sz (S O) w) *)
    remember (split2 sz 1 w) as ww; clear Heqww w.
(* Goal: @eq (word (S O)) (wones (S O)) ww *)
    destruct (destruct_word_S ww) as [w [b E]]. subst ww.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
    rewrite (word0 w) in *. clear w. simpl in *. destruct b; congruence.
Qed.

Lemma wmsb_false_split2_wzero:
  forall sz (w: word (sz + 1)) b,
    wmsb w b = false ->
    wzero 1 = split2 sz 1 w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (S O)) (wones (S O)) (split2 sz (S O) w) *)
  pose proof (wmsb_split2 _ w b).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct (weq _ _); auto.
(* Goal: False *)
  rewrite H in H0; discriminate.
Qed.

Lemma wmsb_split1_sext:
  forall sz (w: word (sz + 1)),
    wmsb w false = wmsb (split1 _ 1 w) false ->
    exists sw, sext sw 1 = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold sext; intros.
(* Goal: @ex (word sz) (fun sw : word sz => @eq (word (Init.Nat.add sz (S O))) (if @wmsb sz sw false then @combine sz sw (S O) (wones (S O)) else @combine sz sw (S O) (wzero (S O))) w) *)
  pose proof (combine_split _ _ w) as Hw.
  rewrite <-Hw; rewrite <-Hw in H at 2; clear Hw.
(* Goal: @ex (word sz) (fun sw : word sz => @eq (word (Init.Nat.add sz (S O))) (if @wmsb sz sw false then @combine sz sw (S O) (wones (S O)) else @combine sz sw (S O) (wzero (S O))) (@combine sz (split1 sz (S O) w) (S O) (split2 sz (S O) w))) *)
  rewrite split1_combine in H.
(* Goal: @ex (word sz) (fun sw : word sz => @eq (word (Init.Nat.add sz (S O))) (if @wmsb sz sw false then @combine sz sw (S O) (wones (S O)) else @combine sz sw (S O) (wzero (S O))) (@combine sz (split1 sz (S O) w) (S O) (split2 sz (S O) w))) *)
  exists (split1 sz 1 w).
(* Goal: @eq (word (Init.Nat.add sz (S O))) (if @wmsb sz (split1 sz (S O) w) false then @combine sz (split1 sz (S O) w) (S O) (wones (S O)) else @combine sz (split1 sz (S O) w) (S O) (wzero (S O))) (@combine sz (split1 sz (S O) w) (S O) (split2 sz (S O) w)) *)
  destruct (wmsb (split1 sz 1 w) false).
  - rewrite <-wmsb_true_split2_wones with (b:= false) by assumption.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
  - rewrite <-wmsb_false_split2_wzero with (b:= false) by assumption.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
Qed.

Lemma wmsb_combine_WO:
  forall sz (w: word sz) b,
    wmsb (combine w WO) b = wmsb w b.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  dependent induction w; cbn; intros; auto.
Qed.

Lemma wmsb_combine:
  forall sz1 sz2 (w1: word sz1) (w2: word sz2) b1 b2,
    sz2 <> 0 ->
    wmsb (combine w1 w2) b1 = wmsb w2 b2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  dependent induction w1; cbn; intros.
  - auto using wmsb_default.
  - auto using IHw1.
Qed.

Lemma wmsb_combine_existT: (* Note: not axiom free *)
  forall sz (w: word sz) sz1 (w1: word sz1) sz2 (w2: word sz2) b1 b2,
    sz2 <> 0 ->
    existT word _ w = existT word _ (combine w1 w2) ->
    wmsb w b1 = wmsb w2 b2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  pose proof (eq_sigT_fst H0); subst.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS (orb b (@whd n w2)) n (natToWord n O)) *)
  destruct_existT.
(* Goal: @eq bool (@wmsb (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) b1) (@wmsb sz2 w2 b2) *)
  auto using wmsb_combine.
Qed.

Lemma wmsb_zext:
  forall sz (w: word sz) b n, n <> 0 -> wmsb (zext w n) b = false.
Proof.
(* Goal: forall (sz : nat) (w : word sz) (b : bool) (n : nat) (_ : not (@eq nat n O)), @eq bool (@wmsb (Init.Nat.add sz n) (@zext sz w n) b) false *)
  destruct n; cbn; intros; [elim H; reflexivity|].
(* Goal: @eq bool (@wmsb (Init.Nat.add sz (S n)) (@zext sz w (S n)) b) false *)
  unfold zext.
(* Goal: False *)
  erewrite wmsb_combine with (b2:= false) by discriminate.
(* Goal: @eq bool (@wmsb (S n) (wzero (S n)) false) false *)
  apply wmsb_wzero.
Qed.

Lemma wordToN_zext:
  forall sz (w: word sz) n,
    wordToN (zext w n) = wordToN w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  dependent induction w; cbn; intros.
  - induction n; cbn; intros; [reflexivity|].
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    unfold wzero in IHn; rewrite IHn; reflexivity.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - rewrite IHw; reflexivity.
Qed.

Lemma wordToNat_zext:
  forall sz (w: word sz) n,
    wordToNat (zext w n) = wordToNat w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  dependent induction w; cbn; intros.
  - induction n; cbn; intros; [reflexivity|].
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    unfold wzero in IHn; rewrite IHn; reflexivity.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - rewrite IHw; reflexivity.
Qed.

Lemma zext_wordToNat_equal_Z:
  forall sz (w: word sz) n,
    n <> 0 -> wordToZ (zext w n) = Z.of_nat (wordToNat w).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wordToZ, zext; intros.
(* Goal: False *)
  rewrite wmsb_combine with (b2:= false) by assumption.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add (Init.Nat.add sz (S n1)) n2) (if @wmsb (S n1) (wzero (S n1)) false then @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wones n2) else @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wzero n2))) *)
  rewrite wmsb_wzero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  replace (combine w (wzero n)) with (zext w n) by reflexivity.
(* Goal: @eq Z match @wordToN (Init.Nat.add sz n) (@zext sz w n) with | N0 => Z0 | Npos x => Zpos x end (Z.of_nat (@wordToNat sz w)) *)
  rewrite wordToN_zext.
(* Goal: @eq N N0 (@wordToN sz (wzero sz)) *)
  rewrite wordToN_nat.
  rewrite <-nat_N_Z.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  unfold Z.of_N; reflexivity.
Qed.

Lemma wordToN_WS_0:
  forall sz (w: word sz), wordToN w~0 = (2 * wordToN w)%N.
Proof. reflexivity. Qed.

Lemma wordToN_WS_1:
  forall sz (w: word sz), wordToN w~1 = (2 * wordToN w + 1)%N.
Proof.
(* Goal: @eq Z (@wordToZ (S (S sz)) (@wplus (S (S sz)) (@WS true (S sz) w1) (@wneg (S (S sz)) (@WS false (S sz) w2)))) (Z.add (Z.mul (Zpos (xO xH)) (@wordToZ (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)))) (Zpos xH)) *)
  intros; cbn.
(* Goal: @eq N (N.succ match @wordToN sz w with | N0 => N0 | Npos q => Npos (xO q) end) (N.add match @wordToN sz w with | N0 => N0 | Npos q => Npos (xO q) end (Npos xH)) *)
  unfold N.succ_double.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  destruct (wordToN w); reflexivity.
Qed.

Lemma NToWord_WS_0:
  forall sz n, NToWord (S sz) (2 * n) = (NToWord sz n)~0.
Proof.
(* Goal: forall (sz : nat) (n : N), @eq (word (S sz)) (NToWord (S sz) (N.add (N.mul (Npos (xO xH)) n) (Npos xH))) (@WS true sz (NToWord sz n)) *)
  destruct n; intros; [reflexivity|].
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  replace (2 * N.pos p)%N with (N.pos (p~0)) by reflexivity.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma NToWord_WS_1:
  forall sz n, NToWord (S sz) (2 * n + 1) = (NToWord sz n)~1.
Proof.
(* Goal: forall (sz : nat) (n : N), @eq (word (S sz)) (NToWord (S sz) (N.add (N.mul (Npos (xO xH)) n) (Npos xH))) (@WS true sz (NToWord sz n)) *)
  destruct n; intros; [reflexivity|].
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  replace (2 * N.pos p)%N with (N.pos (p~0)) by reflexivity.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wneg_WS_0:
  forall sz (w: word sz), wneg w~0 = (wneg w)~0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wneg; intros.
(* Goal: N.le (N.mul (Npos (xO xH)) (Npow2 n)) (@wordToN (S (S n)) (@WS false (S n) (@WS b0 n w))) *)
  rewrite wordToN_WS_0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  replace (Npow2 (S sz)) with (2 * Npow2 sz)%N by reflexivity.
  rewrite <-N.mul_sub_distr_l.
(* Goal: @eq (word (S sz)) (NToWord (S sz) (N.mul (Npos (xO xH)) (N.sub (Npow2 sz) (@wordToN sz w)))) (@WS false sz (NToWord sz (N.sub (Npow2 sz) (@wordToN sz w)))) *)
  apply NToWord_WS_0.
Qed.

Lemma NToWord_wordToN:
  forall sz (w: word sz), NToWord sz (wordToN w) = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq N (@wordToN sz (NToWord sz n)) n *)
  rewrite wordToN_nat, NToWord_nat.
(* Goal: @eq nat (@wordToNat sz (natToWord sz (N.to_nat n))) (Init.Nat.sub (N.to_nat n) (Init.Nat.mul (N.to_nat (N.of_nat k)) (N.to_nat (Npow2 sz)))) *)
  rewrite Nat2N.id.
(* Goal: @eq (word sz) (natToWord sz (@wordToNat sz w)) w *)
  apply natToWord_wordToNat.
Qed.

Lemma roundTripN_0:
  forall sz, wordToN (NToWord sz 0) = 0%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq N (@wordToN sz (NToWord sz n)) n *)
  rewrite wordToN_nat, NToWord_nat.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite roundTrip_0; reflexivity.
Qed.

Lemma wordToN_NToWord:
  forall sz n,
  exists k, wordToN (NToWord sz n) = (n - k * Npow2 sz)%N /\ (k * Npow2 sz <= n)%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq N (@wordToN sz (NToWord sz n)) n *)
  rewrite wordToN_nat, NToWord_nat.
(* Goal: @ex N (fun k : N => and (@eq N (N.of_nat (@wordToNat sz (natToWord sz (N.to_nat n)))) (N.sub n (N.mul k (Npow2 sz)))) (N.le (N.mul k (Npow2 sz)) n)) *)
  pose proof (wordToNat_natToWord sz (N.to_nat n)).
(* Goal: @ex N (fun k : N => and (@eq N (N.of_nat (@wordToNat sz (natToWord sz (N.to_nat n)))) (N.sub n (N.mul k (Npow2 sz)))) (N.le (N.mul k (Npow2 sz)) n)) *)
  destruct H as [k [? ?]].
(* Goal: @ex N (fun k : N => and (@eq N (N.of_nat (@wordToNat sz (natToWord sz (N.to_nat n)))) (N.sub n (N.mul k (Npow2 sz)))) (N.le (N.mul k (Npow2 sz)) n)) *)
  exists (N.of_nat k).
(* Goal: and (Z.le Z0 (Z.of_N (@wordToN sz a))) (Z.lt (Z.of_N (@wordToN sz a)) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  split.
  - apply N2Nat.inj.
(* Goal: @eq nat (N.to_nat (N.of_nat (@wordToNat sz (natToWord sz (N.to_nat n))))) (N.to_nat (N.sub n (N.mul (N.of_nat k) (Npow2 sz)))) *)
    rewrite Nat2N.id, N2Nat.inj_sub, N2Nat.inj_mul.
(* Goal: @eq nat (@wordToNat sz (natToWord sz (N.to_nat n))) (Init.Nat.sub (N.to_nat n) (Init.Nat.mul (N.to_nat (N.of_nat k)) (N.to_nat (Npow2 sz)))) *)
    rewrite Nat2N.id.
(* Goal: @eq nat (@wordToNat sz (NToWord sz n)) (Nat.modulo (N.to_nat n) (N.to_nat (Npow2 sz))) *)
    rewrite Npow2_nat.
(* Goal: False *)
    assumption.
  - rewrite nat_compare_le, Nat2N.inj_compare in H0.
    rewrite Nat2N.inj_mul, <-Npow2_nat in H0.
(* Goal: N.le (N.mul (N.of_nat k) (Npow2 sz)) n *)
    do 2 rewrite N2Nat.id in H0.
(* Goal: False *)
    assumption.
Qed.

Lemma wordToN_NToWord_2:
  forall sz n, (n < Npow2 sz)%N -> wordToN (NToWord sz n) = n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq N (@wordToN sz (NToWord sz n)) n *)
  rewrite wordToN_nat, NToWord_nat.
(* Goal: @eq N (N.of_nat (@wordToNat sz (natToWord sz (N.to_nat n)))) n *)
  rewrite wordToNat_natToWord_2.
  - apply N2Nat.id.
  - rewrite <-Npow2_nat.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    apply Nlt_out; auto.
Qed.

Lemma wordToN_bound:
  forall sz (w: word sz), (wordToN w < Npow2 sz)%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq N N0 (@wordToN sz (wzero sz)) *)
  rewrite wordToN_nat.
(* Goal: N.lt (Npos p) (Npow2 (S sz)) *)
  apply Nlt_in.
(* Goal: lt (N.to_nat (N.of_nat (@wordToNat sz w))) (N.to_nat (Npow2 sz)) *)
  rewrite Npow2_nat, Nat2N.id.
(* Goal: lt (@wordToNat sz w) (Nat.pow (S (S O)) sz) *)
  apply wordToNat_bound.
Qed.

Lemma wordToN_plus: forall sz (a b: word sz),
    (wordToN a + wordToN b < Npow2 sz)%N ->
    wordToN (a ^+ b) = (wordToN a + wordToN b)%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold wplus, wordBin.
(* Goal: False *)
  rewrite wordToN_NToWord_2 by assumption.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wordToN_mult: forall sz (a b: word sz),
    (wordToN a * wordToN b < Npow2 sz)%N ->
    wordToN (a ^* b) = (wordToN a * wordToN b)%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold wmult, wordBin.
(* Goal: False *)
  rewrite wordToN_NToWord_2 by assumption.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wnot_def:
  forall sz (w: word sz), wnot w = NToWord sz (Npow2 sz - wordToN w - 1).
Proof.
(* Goal: forall (sz : nat) (w : word sz), @eq (word sz) (@wnot sz w) (NToWord sz (N.sub (N.sub (Npow2 sz) (@wordToN sz w)) (Npos xH))) *)
  dependent induction w; cbn; [reflexivity|].
(* Goal: @eq Z (@wordToZ (S (S sz)) (@wplus (S (S sz)) (@WS true (S sz) w1) (@wneg (S (S sz)) (@WS false (S sz) w2)))) (Z.add (Z.mul (Zpos (xO xH)) (@wordToZ (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)))) (Zpos xH)) *)
  destruct b; cbn.
  - rewrite IHw; clear IHw.
    rewrite <-NToWord_WS_0.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
    f_equal.
(* Goal: @eq N (N.mul (Npos (xO xH)) (N.sub (N.sub (Npow2 n) (@wordToN n w)) (Npos xH))) (N.sub (N.sub match Npow2 n with | N0 => N0 | Npos q => Npos (xO q) end (N.succ match @wordToN n w with | N0 => N0 | Npos q => Npos (xO q) end)) (Npos xH)) *)
    destruct (Npow2 n); [reflexivity|].
(* Goal: @eq Z (Z.of_nat (N.to_nat (@wordToN sz w))) match @wordToN sz w with | N0 => Z0 | Npos x => Zpos x end *)
    destruct (wordToN w).
    + change (N.pos p~0) with (2 * N.pos p)%N.
(* Goal: @eq N (N.add (N.mul (Npos (xO xH)) (N.sub (N.sub (Npos p) N0) (Npos xH))) (Npos xH)) (N.sub (N.sub (N.mul (Npos (xO xH)) (Npos p)) N0) (Npos xH)) *)
      do 2 rewrite N.mul_sub_distr_l.
      do 2 rewrite <-N.sub_add_distr.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
    + change (N.pos p~0) with (2 * N.pos p)%N.
      change (N.pos p0~0) with (2 * N.pos p0)%N.
      rewrite <-N.add_1_l.
(* Goal: @eq N (N.add (N.mul (Npos (xO xH)) (N.sub (N.sub (Npos p) N0) (Npos xH))) (Npos xH)) (N.sub (N.sub (N.mul (Npos (xO xH)) (Npos p)) N0) (Npos xH)) *)
      do 2 rewrite N.mul_sub_distr_l.
      do 2 rewrite <-N.sub_add_distr.
(* Goal: @eq (word (S sz)) (@WS true sz (NToWord sz (N.add (@wordToN sz w1) (@wordToN sz w2)))) (NToWord (S sz) (N.add (N.mul (Npos (xO xH)) (@wordToN sz w1)) (N.add (Npos xH) (N.mul (Npos (xO xH)) (@wordToN sz w2))))) *)
      rewrite N.add_comm with (n:= 1%N).
      rewrite <-N.add_assoc.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
  - rewrite IHw; clear IHw.
    rewrite <-NToWord_WS_1.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
    f_equal.
(* Goal: @eq Z match N.sub (Npow2 sz) (@wordToN sz w) with | N0 => Z0 | Npos x => Zneg x end (Z.sub (Z.of_N (@wordToN sz w)) (Z.of_N (Npow2 sz))) *)
    pose proof (wordToN_bound w).
    remember (Npow2 n) as pn; destruct pn;
      [exfalso; eapply Npow2_not_zero; eauto|clear Heqpn].
(* Goal: @eq Z (Z.of_nat (N.to_nat (@wordToN sz w))) match @wordToN sz w with | N0 => Z0 | Npos x => Zpos x end *)
    destruct (wordToN w).
    + change (N.pos p~0) with (2 * N.pos p)%N.
(* Goal: @eq N (N.add (N.mul (Npos (xO xH)) (N.sub (N.sub (Npos p) N0) (Npos xH))) (Npos xH)) (N.sub (N.sub (N.mul (Npos (xO xH)) (Npos p)) N0) (Npos xH)) *)
      do 2 rewrite N.mul_sub_distr_l.
      do 2 rewrite <-N.sub_add_distr.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      destruct p; cbn; reflexivity.
    + change (N.pos p~0) with (2 * N.pos p)%N.
      change (N.pos p0~0) with (2 * N.pos p0)%N.
(* Goal: @eq (word sz) a (NToWord sz (N.mul (@wordToN sz b) (N.sub k (N.mul (N.div k (Npow2 sz)) (Npow2 sz))))) *)
      rewrite N.mul_sub_distr_l.
      rewrite <-N.mul_sub_distr_l with (n:= N.pos p).
      assert (exists pp, N.pos p - N.pos p0 = N.pos pp)%N.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { apply N.sub_gt in H.
        destruct (N.pos p - N.pos p0)%N; [intuition idtac|].
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
        eexists; reflexivity.
      }
(* Goal: @eq N (N.add (N.sub (N.mul (Npos (xO xH)) (N.sub (Npos p) (Npos p0))) (N.mul (Npos (xO xH)) (Npos xH))) (Npos xH)) (N.sub (N.mul (Npos (xO xH)) (N.sub (Npos p) (Npos p0))) (Npos xH)) *)
      destruct H0; rewrite H0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      destruct x; cbn; reflexivity.
Qed.

Lemma wneg_wnot:
  forall sz (w: word sz), wnot w = wneg w ^- (natToWord _ 1).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wneg; intros.
(* Goal: @eq Z match N.add (N.mul (Npos (xO xH)) (@wordToN (S sz) (@wnot (S sz) (@WS b sz w)))) (Npos xH) with | N0 => Z0 | Npos x => Zneg x end (Z.add (Z.mul (Zpos (xO xH)) match @wordToN (S sz) (@wneg (S sz) (@WS b sz w)) with | N0 => Z0 | Npos x => Zneg x end) (Zpos xH)) *)
  rewrite wnot_def.

(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  destruct (weq w (wzero _)); subst.

  - rewrite wordToN_nat.
(* Goal: @eq Z (@wordToZ (S (S sz)) (@wplus (S (S sz)) (@WS true (S sz) w1) (@wneg (S (S sz)) (@WS false (S sz) w2)))) (Z.add (Z.mul (Zpos (xO xH)) (@wordToZ (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)))) (Zpos xH)) *)
    unfold wzero; rewrite roundTrip_0; cbn.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.sub (N.mul c d) N0) d)) (natToWord sz O) *)
    rewrite N.sub_0_r.
(* Goal: @eq (word sz) (NToWord sz (N.sub p (Npos xH))) (@wminus sz (NToWord sz p) (natToWord sz (S O))) *)
    do 2 rewrite NToWord_nat.
(* Goal: @eq (word sz) (natToWord sz (N.to_nat (N.sub (Npow2 sz) (Npos xH)))) (@wminus sz (natToWord sz (N.to_nat (Npow2 sz))) (natToWord sz (S O))) *)
    rewrite Npow2_nat, natToWord_pow2, N2Nat.inj_sub.
(* Goal: @eq (word sz) (natToWord sz (Init.Nat.sub (N.to_nat p) (N.to_nat (Npos xH)))) (@wminus sz (natToWord sz (N.to_nat p)) (natToWord sz (S O))) *)
    change (N.to_nat 1%N) with 1.
(* Goal: @eq nat (@wordToNat sz (NToWord sz n)) (Nat.modulo (N.to_nat n) (N.to_nat (Npow2 sz))) *)
    rewrite Npow2_nat.
(* Goal: @eq (word sz) (@wlshift sz (natToWord sz O) n) (natToWord sz O) *)
    apply wordToNat_inj.
(* Goal: @eq nat (@wordToNat sz (natToWord sz (Init.Nat.sub (Nat.pow (S (S O)) sz) (S O)))) (@wordToNat sz (@wminus sz (natToWord sz O) (natToWord sz (S O)))) *)
    rewrite wordToNat_natToWord_2 by (pose proof (zero_lt_pow2 sz); omega).
(* Goal: @eq nat (Init.Nat.sub (Nat.pow (S (S O)) sz) (S O)) (@wordToNat sz (@wminus sz (natToWord sz O) (natToWord sz (S O)))) *)
    unfold wminus.
    rewrite wplus_unit, <-wones_wneg_one.
(* Goal: @eq nat (Init.Nat.sub (Nat.pow (S (S O)) sz) (S O)) (@wordToNat sz (wones sz)) *)
    apply eq_sym, wones_pow2_minus_one.

  - pose proof (wordToN_bound w).
    assert (Npow2 sz - wordToN w < Npow2 sz)%N.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
    { apply N.sub_lt.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      { apply N.lt_le_incl; auto. }
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { assert (wordToN w <> 0)%N.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
        { replace 0%N with (wordToN (wzero sz)).
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
          { intro Hx; elim n.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
            apply wordToN_inj; auto.
          }
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
          { rewrite wordToN_nat.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
            unfold wzero; rewrite roundTrip_0; reflexivity.
          }
        }
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        nomega.
      }
    }
(* Goal: @eq (word sz) (NToWord sz (N.sub (N.sub (Npow2 sz) (@wordToN sz w)) (Npos xH))) (@wminus sz (NToWord sz (N.sub (Npow2 sz) (@wordToN sz w))) (natToWord sz (S O))) *)
    apply N.sub_gt in H.
    remember (Npow2 sz - wordToN w)%N as p; clear Heqp.
(* Goal: @eq (word sz) (NToWord sz (N.sub p (Npos xH))) (@wminus sz (NToWord sz p) (natToWord sz (S O))) *)
    do 2 rewrite NToWord_nat.
(* Goal: @eq (word sz) (natToWord sz (N.to_nat (N.sub p (Npos xH)))) (@wminus sz (natToWord sz (N.to_nat p)) (natToWord sz (S O))) *)
    rewrite N2Nat.inj_sub.
(* Goal: @eq (word sz) (natToWord sz (Init.Nat.sub (N.to_nat p) (N.to_nat (Npos xH)))) (@wminus sz (natToWord sz (N.to_nat p)) (natToWord sz (S O))) *)
    change (N.to_nat 1%N) with 1.
    assert (N.to_nat p < pow2 sz)%nat
      by (rewrite <-Npow2_nat; apply Nlt_out; auto); clear H0.
    assert (N.to_nat p <> 0)
      by (change 0 with (N.to_nat 0%N); intro Hx; elim H; apply N2Nat.inj; auto); clear H.
(* Goal: @eq (word sz) (@wlshift sz (natToWord sz O) n) (natToWord sz O) *)
    apply wordToNat_inj.
    rewrite <-wordToNat_natToWord_pred.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + do 2 rewrite wordToNat_natToWord_2 by omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      omega.
    + intro Hx; elim H0.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      apply natToWord_inj with (sz:= sz); try omega.
(* Goal: False *)
      assumption.
Qed.

Lemma wzero_wneg:
  forall n, wneg (wzero n) = wzero n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word n) (@wneg n (wzero n)) (wzero n) *)
  pose proof (wminus_inv (wzero n)).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wplus_unit in H; auto.
Qed.

Lemma pow2_wneg:
  forall sz, wneg (natToWord (S sz) (pow2 sz)) = natToWord (S sz) (pow2 sz).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wneg; intros.
  rewrite <-Npow2_nat, <-NToWord_nat.
  rewrite wordToN_NToWord_2
    by (apply Nlt_in; do 2 rewrite Npow2_nat;
        pose proof (zero_lt_pow2 sz); simpl; omega).
(* Goal: @eq Z (Z.mul (Zneg xH) (Z.of_N (Npow2 (S sz)))) (Z.mul (Zpos (xO xH)) (Z.sub (Z.of_N (Npow2 sz)) (Z.of_N (Npow2 (S sz))))) *)
  rewrite Npow2_S.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  f_equal; nomega.
Qed.

Lemma wneg_WS_1:
  forall sz (w: word sz), wneg w~1 = (wnot w)~1.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (NToWord sz (N.sub n (N.mul k (Npow2 sz)))) (NToWord sz n) *)
  apply wordToN_inj.
(* Goal: @eq Z match N.add (N.mul (Npos (xO xH)) (@wordToN (S sz) (@wnot (S sz) (@WS b sz w)))) (Npos xH) with | N0 => Z0 | Npos x => Zneg x end (Z.add (Z.mul (Zpos (xO xH)) match @wordToN (S sz) (@wneg (S sz) (@WS b sz w)) with | N0 => Z0 | Npos x => Zneg x end) (Zpos xH)) *)
  simpl; rewrite wnot_def.
(* Goal: @eq nat (@wordToNat sz (@wneg sz a)) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  unfold wneg.
  rewrite wordToN_NToWord_2
    by (apply N.sub_lt; [apply N.lt_le_incl, wordToN_bound|nomega]).
(* Goal: @eq (word sz) a (NToWord sz (N.mul (@wordToN sz b) (@wordToN sz (NToWord sz (N.sub k (N.mul (N.div k (Npow2 sz)) (Npow2 sz))))))) *)
  rewrite wordToN_NToWord_2.
  - rewrite wordToN_WS_1.
    change (Npow2 (S sz)) with (2 * Npow2 sz)%N.
(* Goal: @eq N (N.sub (N.mul (Npos (xO xH)) (Npow2 sz)) (N.add (N.mul (Npos (xO xH)) (@wordToN sz w)) (Npos xH))) (N.succ match N.sub (N.sub (Npow2 sz) (@wordToN sz w)) (Npos xH) with | N0 => N0 | Npos q => Npos (xO q) end) *)
    rewrite N.sub_add_distr.
    rewrite <-N.mul_sub_distr_l.
    assert (Npow2 sz - wordToN w <> 0)%N
      by (pose proof (wordToN_bound w); nomega).
    remember (Npow2 sz - wordToN w)%N as n; clear Heqn.
(* Goal: @eq Z match N.add (N.mul (Npos (xO xH)) (N.sub n (Npos xH))) (Npos xH) with | N0 => Z0 | Npos x => Zneg x end (Z.add (Z.mul (Zpos (xO xH)) match n with | N0 => Z0 | Npos x => Zneg x end) (Zpos xH)) *)
    destruct n; [intuition idtac|].
    remember (N.pos p - 1)%N as pp; destruct pp.
    + apply eq_sym, N.sub_0_le in Heqpp.
(* Goal: @eq N (N.sub (N.mul (Npos (xO xH)) (Npos p)) (Npos xH)) (N.succ N0) *)
      apply N.le_1_r in Heqpp; destruct Heqpp; [discriminate|].
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      rewrite H0; reflexivity.
    + change (N.pos p0~0) with (2 * N.pos p0)%N.
(* Goal: @eq N (N.sub (N.mul (Npos (xO xH)) (Npos p)) (Npos xH)) (N.succ (N.mul (Npos (xO xH)) (Npos p0))) *)
      rewrite Heqpp.
      rewrite <-N.add_1_r.
(* Goal: @eq (word sz) a (NToWord sz (N.mul (@wordToN sz b) (N.sub k (N.mul (N.div k (Npow2 sz)) (Npow2 sz))))) *)
      rewrite N.mul_sub_distr_l.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      clear; destruct p; cbn; reflexivity.
  - rewrite <-N.sub_add_distr.
(* Goal: N.lt (N.sub (Npow2 sz) (N.add (@wordToN sz w) (Npos xH))) (Npow2 sz) *)
    apply N.sub_lt; [|nomega].
(* Goal: @eq Z match N.sub (Npow2 sz) (@wordToN sz w) with | N0 => Z0 | Npos x => Zneg x end (Z.sub (Z.of_N (@wordToN sz w)) (Z.of_N (Npow2 sz))) *)
    pose proof (wordToN_bound w).
(* Goal: N.le (N.add (@wordToN sz w) (Npos xH)) (Npow2 sz) *)
    apply N.le_succ_l in H.
(* Goal: False *)
    rewrite N.add_1_r; assumption.
Qed.

Lemma wordToZ_WS_0:
  forall sz (w: word sz), wordToZ w~0 = (2 * wordToZ w)%Z.
Proof.
(* Goal: forall (sz : nat) (w : word sz), @eq Z (@wordToZ (S sz) (@WS false sz w)) (Z.mul (Zpos (xO xH)) (@wordToZ sz w)) *)
  dependent destruction w; [reflexivity|].
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (S sz) w)) (Z.lt (@wordToZ (S sz) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  unfold wordToZ.
(* Goal: @eq (word (Init.Nat.add (S (S sz)) n)) (if @wmsb (S (S sz)) (@WS b (S sz) w) false then @combine (S (S sz)) (@WS b (S sz) w) n (wones n) else @combine (S (S sz)) (@WS b (S sz) w) n (wzero n)) (@WS b (Init.Nat.add (S sz) n) (if @wmsb (S sz) w false then @combine (S sz) w n (wones n) else @combine (S sz) w n (wzero n))) *)
  rewrite wmsb_ws.
(* Goal: @eq Z (if @wmsb (S n) (@WS b n w) false then match @wordToN (S (S n)) (@wneg (S (S n)) (@WS false (S n) (@WS b n w))) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S (S n)) (@WS false (S n) (@WS b n w)) with | N0 => Z0 | Npos x => Zpos x end) (Z.mul (Zpos (xO xH)) (if @wmsb (S n) (@WS b n w) false then match @wordToN (S n) (@wneg (S n) (@WS b n w)) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S n) (@WS b n w) with | N0 => Z0 | Npos x => Zpos x end)) *)
  destruct (wmsb (WS b w) false).
  - rewrite wneg_WS_0.
(* Goal: N.le (N.mul (Npos (xO xH)) (Npow2 n)) (@wordToN (S (S n)) (@WS false (S n) (@WS b0 n w))) *)
    rewrite wordToN_WS_0.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    destruct (wordToN (wneg (WS b w))); cbn; omega.
  - rewrite wordToN_WS_0.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    destruct (wordToN (WS b w)); cbn; omega.
Qed.

Lemma wordToZ_WS_1:
  forall sz (w: word (S sz)), wordToZ w~1 = (2 * wordToZ w + 1)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. destruct (destruct_word_S w) as [v [b E]]. rewrite E. clear w E. rename v into w.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (S sz) w)) (Z.lt (@wordToZ (S sz) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  unfold wordToZ.
(* Goal: @eq (word (Init.Nat.add (S (S sz)) n)) (if @wmsb (S (S sz)) (@WS b (S sz) w) false then @combine (S (S sz)) (@WS b (S sz) w) n (wones n) else @combine (S (S sz)) (@WS b (S sz) w) n (wzero n)) (@WS b (Init.Nat.add (S sz) n) (if @wmsb (S sz) w false then @combine (S sz) w n (wones n) else @combine (S sz) w n (wzero n))) *)
  rewrite wmsb_ws.
(* Goal: @eq Z (if @wmsb (S sz) (@WS b sz w) false then match @wordToN (S (S sz)) (@wneg (S (S sz)) (@WS true (S sz) (@WS b sz w))) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S (S sz)) (@WS true (S sz) (@WS b sz w)) with | N0 => Z0 | Npos x => Zpos x end) (Z.add (Z.mul (Zpos (xO xH)) (if @wmsb (S sz) (@WS b sz w) false then match @wordToN (S sz) (@wneg (S sz) (@WS b sz w)) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (@WS b sz w) with | N0 => Z0 | Npos x => Zpos x end)) (Zpos xH)) *)
  remember (wmsb (WS b w) false) as msb.
(* Goal: @eq Z (if msb then match @wordToN (S sz) (natToWord (S sz) (Pos.to_nat p)) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (@wneg (S sz) (natToWord (S sz) (Pos.to_nat p))) with | N0 => Z0 | Npos x => Zpos x end) (Zneg p) *)
  destruct msb.
  - rewrite wneg_WS_1.
(* Goal: N.le (N.mul (Npos (xO xH)) (Npow2 n)) (@wordToN (S (S n)) (@WS true (S n) (@WS b0 n w))) *)
    rewrite wordToN_WS_1.
(* Goal: @eq Z match N.add (N.mul (Npos (xO xH)) (@wordToN (S sz) (@wnot (S sz) (@WS b sz w)))) (Npos xH) with | N0 => Z0 | Npos x => Zneg x end (Z.add (Z.mul (Zpos (xO xH)) match @wordToN (S sz) (@wneg (S sz) (@WS b sz w)) with | N0 => Z0 | Npos x => Zneg x end) (Zpos xH)) *)
    rewrite wnot_def.
(* Goal: @eq nat (@wordToNat sz (@wneg sz a)) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
    unfold wneg.

    assert (Npow2 (S sz) - wordToN (WS b w) <> 0)%N.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    { pose proof (wordToN_bound (WS b w)); nomega. }
    assert (Npow2 (S sz) - wordToN (WS b w) < Npow2 (S sz))%N.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
    { apply N.sub_lt.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { apply N.lt_le_incl, wordToN_bound. }
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { assert (wordToN (WS b w) <> 0)%N.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
        { replace 0%N with (wordToN (wzero (S sz))).
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
          { intro Hx.
(* Goal: False *)
            apply wordToN_inj in Hx.
(* Goal: False *)
            rewrite Hx in Heqmsb.
(* Goal: False *)
            rewrite wmsb_wzero in Heqmsb; discriminate.
          }
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
          { rewrite wordToN_nat.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
            unfold wzero; rewrite roundTrip_0; reflexivity.
          }
        }
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        nomega.
      }
    }
    remember (Npow2 (S sz) - wordToN (WS b w))%N as n; clear Heqn.

(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    rewrite wordToN_NToWord_2 by nomega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    rewrite wordToN_NToWord_2 by nomega.
(* Goal: @eq Z match N.add (N.mul (Npos (xO xH)) (N.sub n (Npos xH))) (Npos xH) with | N0 => Z0 | Npos x => Zneg x end (Z.add (Z.mul (Zpos (xO xH)) match n with | N0 => Z0 | Npos x => Zneg x end) (Zpos xH)) *)
    destruct n; [intuition idtac|].
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    destruct p; cbn; reflexivity.

  - rewrite wordToN_WS_1.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    destruct (wordToN (WS b w)); cbn; omega.
Qed.

Lemma wordToZ_WS_1':
  forall sz (w: word (sz + 1)), wordToZ w~1 = (2 * wordToZ w + 1)%Z.
Proof.
(* Goal: forall (sz : nat) (w1 w2 : word (Init.Nat.add sz (S O))) (_ : not (@eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (S O)) (@wminus (Init.Nat.add sz (S O)) w2 w1)) (@existT nat word (S sz) (wpow2 sz)))), @eq Z (@wordToZ (Init.Nat.add sz (S O)) (@wminus (Init.Nat.add sz (S O)) w1 w2)) (Z.opp (@wordToZ (Init.Nat.add sz (S O)) (@wminus (Init.Nat.add sz (S O)) w2 w1))) *)
  intro sz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (sz + 1) with (S sz) by omega.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z (@wordToZ (S (S sz)) (@WS true (S sz) w)) (Z.add (Z.mul (Zpos (xO xH)) (@wordToZ (S sz) w)) (Zpos xH)) *)
  apply wordToZ_WS_1.
Qed.

Lemma wordToZ_inj:
  forall sz (w1 w2: word sz),
    wordToZ w1 = wordToZ w2 -> w1 = w2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wordToZ; intros.
(* Goal: @eq (word sz) w1 w2 *)
  remember (wmsb w1 false) as msb1.
(* Goal: @eq (word sz) w1 w2 *)
  remember (wmsb w2 false) as msb2.
(* Goal: @eq (word sz) w1 w2 *)
  destruct msb1, msb2.
  - remember (wordToN (wneg w1)) as wn1.
(* Goal: @eq (word sz) w1 w2 *)
    remember (wordToN (wneg w2)) as wn2.
(* Goal: False *)
    destruct wn1, wn2; try discriminate.
    + assert (wneg w1 = wneg w2).
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { apply wordToN_inj.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
        rewrite <-Heqwn1, <-Heqwn2; reflexivity.
      }
      rewrite <-wneg_idempotent with (w:= w1).
      rewrite <-wneg_idempotent with (w:= w2).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      rewrite H0; reflexivity.
    + inversion H; subst; clear H.
(* Goal: @eq (word sz) w1 w2 *)
      assert (wneg w1 = wneg w2).
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { apply wordToN_inj.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
        rewrite <-Heqwn1, <-Heqwn2; reflexivity.
      }
      rewrite <-wneg_idempotent with (w:= w1).
      rewrite <-wneg_idempotent with (w:= w2).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      rewrite H; reflexivity.
  - remember (wordToN (wneg w1)) as wn1.
(* Goal: @eq (word sz) w1 w2 *)
    remember (wordToN w2) as wn2.
(* Goal: False *)
    destruct wn1, wn2; try discriminate.
    rewrite <-wordToN_wzero with (sz:= sz) in Heqwn1, Heqwn2.
(* Goal: @eq (word sz) w1 w2 *)
    apply wordToN_inj in Heqwn1.
(* Goal: @eq (word sz) w1 w2 *)
    apply wordToN_inj in Heqwn2.
(* Goal: @eq (word sz) w1 w2 *)
    assert (w1 = wzero sz).
    { rewrite <-wneg_idempotent with (w:= w1), <-Heqwn1.
(* Goal: @eq (word sz) (@wneg sz (wzero sz)) (wzero sz) *)
      apply wzero_wneg.
    }
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    subst; reflexivity.
  - remember (wordToN w1) as wn1.
(* Goal: @eq (word sz) w1 w2 *)
    remember (wordToN (wneg w2)) as wn2.
(* Goal: False *)
    destruct wn1, wn2; try discriminate.
    rewrite <-wordToN_wzero with (sz:= sz) in Heqwn1, Heqwn2.
(* Goal: @eq (word sz) w1 w2 *)
    apply wordToN_inj in Heqwn1.
(* Goal: @eq (word sz) w1 w2 *)
    apply wordToN_inj in Heqwn2.
(* Goal: @eq (word sz) w1 w2 *)
    assert (w2 = wzero sz).
    { rewrite <-wneg_idempotent with (w:= w2), <-Heqwn2.
(* Goal: @eq (word sz) (@wneg sz (wzero sz)) (wzero sz) *)
      apply wzero_wneg.
    }
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    subst; reflexivity.
  - remember (wordToN w1) as wn1.
(* Goal: @eq (word sz) w1 w2 *)
    remember (wordToN w2) as wn2.
(* Goal: False *)
    destruct wn1, wn2; try discriminate.
    + rewrite <-wordToN_wzero with (sz:= sz) in Heqwn1, Heqwn2.
(* Goal: @eq (word sz) w1 w2 *)
      rewrite Heqwn1 in Heqwn2.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      apply wordToN_inj in Heqwn2; auto.
    + inversion H; subst; clear H.
(* Goal: @eq (word sz) w1 w2 *)
      rewrite Heqwn1 in Heqwn2.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      apply wordToN_inj in Heqwn2; auto.
Qed.

Lemma wordToZ_wones:
  forall sz, sz <> 0 -> wordToZ (wones sz) = (-1)%Z.
Proof.
(* Goal: forall (sz : nat) (_ : not (@eq nat sz O)), @eq Z (@wordToZ sz (wones sz)) (Zneg xH) *)
  induction sz; intros; [elim H; reflexivity|].
(* Goal: @eq Z (@wordToZ (S sz) (wones (S sz))) (Zneg xH) *)
  simpl; destruct sz; [reflexivity|].
(* Goal: @eq Z (@wordToZ (S (S sz)) (@WS true (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)))) (Z.add match @wordToZ (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)) with | Z0 => Z0 | Zpos y' => Zpos (xO y') | Zneg y' => Zneg (xO y') end (Zpos xH)) *)
  rewrite wordToZ_WS_1.
(* Goal: False *)
  rewrite IHsz by discriminate.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wordToNat_eq_rect:
  forall sz (w: word sz) nsz Hsz,
    wordToNat (eq_rect _ word w nsz Hsz) = wordToNat w.
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  intros; subst; simpl; reflexivity.
Qed.

Lemma wordToNat_existT:
  forall sz1 (w1: word sz1) sz2 (w2: word sz2) (Hsz: sz1 = sz2),
    wordToNat w1 = wordToNat w2 ->
    existT word _ w1 = existT word _ w2.
Proof.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  intros; subst.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  apply wordToNat_inj in H; subst.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma existT_wordToNat: (* Note: not axiom free *)
  forall sz1 (w1: word sz1) sz2 (w2: word sz2),
    existT word _ w1 = existT word _ w2 ->
    wordToNat w1 = wordToNat w2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  pose proof (eq_sigT_fst H); subst.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  destruct_existT; reflexivity.
Qed.

Lemma wordToZ_eq_rect:
  forall sz (w: word sz) nsz Hsz,
    wordToZ (eq_rect _ word w nsz Hsz) = wordToZ w.
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  intros; subst; simpl; reflexivity.
Qed.

Lemma wordToZ_existT:
  forall sz1 (w1: word sz1) sz2 (w2: word sz2) (Hsz: sz1 = sz2),
    wordToZ w1 = wordToZ w2 ->
    existT word _ w1 = existT word _ w2.
Proof.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  intros; subst.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  apply wordToZ_inj in H; subst.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma existT_wordToZ: (* Note: not axiom free *)
  forall sz1 (w1: word sz1) sz2 (w2: word sz2),
    existT word _ w1 = existT word _ w2 ->
    wordToZ w1 = wordToZ w2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  pose proof (eq_sigT_fst H); subst.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS (orb b (@whd n w2)) n (natToWord n O)) *)
  destruct_existT.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wplus_WS_0:
  forall sz (w1 w2: word sz) b, WS b (w1 ^+ w2) = WS b w1 ^+ w2~0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wplus, wordBin; intros.
(* Goal: N.le (N.mul (Npos (xO xH)) (Npow2 n)) (@wordToN (S (S n)) (@WS false (S n) (@WS b0 n w))) *)
  rewrite wordToN_WS_0.
(* Goal: gt (if b then S (Init.Nat.mul (@wordToNat n w) (S (S O))) else Init.Nat.mul (@wordToNat n w) (S (S O))) O *)
  destruct b.
  - rewrite wordToN_WS_1.
    rewrite <-N.add_assoc.
(* Goal: @eq (word (S sz)) (@WS true sz (NToWord sz (N.add (@wordToN sz w1) (@wordToN sz w2)))) (NToWord (S sz) (N.add (N.mul (Npos (xO xH)) (@wordToN sz w1)) (N.add (Npos xH) (N.mul (Npos (xO xH)) (@wordToN sz w2))))) *)
    rewrite N.add_comm with (n:= 1%N).
(* Goal: @eq (word (S sz)) (@WS true sz (NToWord sz (N.add (@wordToN sz w1) (@wordToN sz w2)))) (NToWord (S sz) (N.add (N.mul (Npos (xO xH)) (@wordToN sz w1)) (N.add (N.mul (Npos (xO xH)) (@wordToN sz w2)) (Npos xH)))) *)
    rewrite N.add_assoc.
    rewrite <-N.mul_add_distr_l.
(* Goal: @eq (word (S sz)) (@WS true sz (NToWord sz (N.add (@wordToN sz w1) (@wordToN sz w2)))) (NToWord (S sz) (N.add (N.mul (Npos (xO xH)) (N.add (@wordToN sz w1) (@wordToN sz w2))) (Npos xH))) *)
    apply eq_sym, NToWord_WS_1.
  - rewrite wordToN_WS_0.
    rewrite <-N.mul_add_distr_l.
(* Goal: @eq (word (S sz)) (@WS false sz (NToWord sz (N.add (@wordToN sz w1) (@wordToN sz w2)))) (NToWord (S sz) (N.mul (Npos (xO xH)) (N.add (@wordToN sz w1) (@wordToN sz w2)))) *)
    apply eq_sym, NToWord_WS_0.
Qed.

Corollary wplus_WS_0':
  forall sz (w1 w2: word sz) b, WS b (w1 ^+ w2) = w1~0 ^+ WS b w2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (S sz)) (@WS b sz (@wplus sz w1 w2)) (@wplus (S sz) (@WS false sz w1) (@WS b sz w2)) *)
  rewrite wplus_comm with (x:= w1).
(* Goal: @eq (word (S sz)) (@WS b sz (@wplus sz w2 w1)) (@wplus (S sz) (@WS false sz w1) (@WS b sz w2)) *)
  rewrite wplus_comm with (x:= w1~0).
(* Goal: @eq (word (S sz)) (@WS b sz (@wplus sz w2 w1)) (@wplus (S sz) (@WS b sz w2) (@WS false sz w1)) *)
  apply wplus_WS_0.
Qed.

Lemma wpow2_pow2:
  forall sz, wordToNat (wpow2 sz) = pow2 sz.
Proof.
(* Goal: forall sz : nat, @eq (word (S sz)) (@wneg (S sz) (wpow2 sz)) (wpow2 sz) *)
  induction sz; simpl; intros; [reflexivity|].
(* Goal: @eq nat (Init.Nat.mul (@wordToNat (S sz) (wpow2 sz)) (S (S O))) (Nat.add (Nat.pow (S (S O)) sz) (Nat.add (Nat.pow (S (S O)) sz) O)) *)
  rewrite IHsz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wpow2_Npow2:
  forall sz, wordToN (wpow2 sz) = Npow2 sz.
Proof.
(* Goal: forall sz : nat, @eq (word (S sz)) (@wneg (S sz) (wpow2 sz)) (wpow2 sz) *)
  induction sz; simpl; intros; [reflexivity|].
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite IHsz; reflexivity.
Qed.

Lemma wpow2_wneg:
  forall sz, wneg (wpow2 sz) = wpow2 sz.
Proof.
(* Goal: forall sz : nat, @eq (word (S sz)) (@wneg (S sz) (wpow2 sz)) (wpow2 sz) *)
  induction sz; simpl; intros; [reflexivity|].
(* Goal: @eq (word (S (Init.Nat.add d sz))) (@WS false (Init.Nat.add d sz) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n)))) (@wneg (S (Init.Nat.add d sz)) (@WS false (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n)))) *)
  rewrite wneg_WS_0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite IHsz; reflexivity.
Qed.

Lemma wpow2_wmsb:
  forall sz, wmsb (wpow2 sz) false = true.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction sz; simpl; intros; auto.
Qed.

Lemma wmsb_wnot:
  forall sz (w: word (S sz)) b1 b2,
    wmsb (wnot w) b1 = negb (wmsb w b2).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  apply (induct_word_S (fun sz w => forall b1 b2, wmsb (wnot w) b1 = negb (wmsb w b2))); intros.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - reflexivity.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  - simpl. apply (H true true).
Qed.

Lemma wmsb_wneg_true:
  forall sz (w: word (S sz)),
    w <> wpow2 sz ->
    forall b1 b2,
      wmsb w b1 = true ->
      wmsb (wneg w) b2 = false.
Proof.
  apply (induct_word_S (fun sz w => w <> wpow2 sz -> forall b1 b2, wmsb w b1 = true ->
                                                     wmsb (^~ w) b2 = false)); intros;
    [simpl in *; subst; elim H; reflexivity|].
(* Goal: gt (if b then S (Init.Nat.mul (@wordToNat n w) (S (S O))) else Init.Nat.mul (@wordToNat n w) (S (S O))) O *)
  destruct b.
  - rewrite wneg_WS_1.
(* Goal: @eq (word (Init.Nat.add (S (S sz)) n)) (if @wmsb (S (S sz)) (@WS b (S sz) w) false then @combine (S (S sz)) (@WS b (S sz) w) n (wones n) else @combine (S (S sz)) (@WS b (S sz) w) n (wzero n)) (@WS b (Init.Nat.add (S sz) n) (if @wmsb (S sz) w false then @combine (S sz) w n (wones n) else @combine (S sz) w n (wzero n))) *)
    rewrite wmsb_ws.
(* Goal: @eq bool (@wmsb (S n) (@wnot (S n) (@WS b0 n w)) b2) true *)
    rewrite wmsb_wnot with (b2:= false).
(* Goal: False *)
    simpl; apply negb_false_iff; assumption.
  - rewrite wneg_WS_0.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    eapply H with (b1 := false); eauto.
(* Goal: not (@eq N (@wordToN (S sz) (natToWord (S sz) (Pos.to_nat p))) N0) *)
    intro Hx. elim H0.
    clear -Hx.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    simpl; rewrite Hx; reflexivity.
Qed.

Lemma wmsb_wneg_false:
  forall sz (w: word (S sz)),
    wordToNat w <> 0 ->
    forall b1 b2,
      wmsb w b1 = false ->
      wmsb (wneg w) b2 = true.
Proof.
  apply (induct_word_S (fun sz w => #w <> 0 -> forall b1 b2, wmsb w b1 = false ->
                                                             wmsb (^~ w) b2 = true)); intros;
    [simpl in *; subst; elim H; reflexivity|].
(* Goal: gt (if b then S (Init.Nat.mul (@wordToNat n w) (S (S O))) else Init.Nat.mul (@wordToNat n w) (S (S O))) O *)
  destruct b.
  - rewrite wneg_WS_1.
(* Goal: @eq (word (Init.Nat.add (S (S sz)) n)) (if @wmsb (S (S sz)) (@WS b (S sz) w) false then @combine (S (S sz)) (@WS b (S sz) w) n (wones n) else @combine (S (S sz)) (@WS b (S sz) w) n (wzero n)) (@WS b (Init.Nat.add (S sz) n) (if @wmsb (S sz) w false then @combine (S sz) w n (wones n) else @combine (S sz) w n (wzero n))) *)
    rewrite wmsb_ws.
(* Goal: @eq bool (@wmsb (S n) (@wnot (S n) (@WS b0 n w)) b2) true *)
    rewrite wmsb_ws in H1.
(* Goal: @eq bool (@wmsb (S n) (@wnot (S n) (@WS b0 n w)) b2) true *)
    rewrite wmsb_wnot with (b2:= false).
(* Goal: False *)
    apply negb_true_iff; assumption.
  - rewrite wneg_WS_0.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    eapply H with (b1:= false); eauto.
(* Goal: not (@eq nat (@wordToNat (S n) (@WS b0 n w)) O) *)
    intro Hx; elim H0.
    clear -Hx.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    simpl in *; omega.
Qed.

Lemma zext_WO_wzero:
  forall n, zext WO n = wzero n.
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wmsb_wneg_zext: (* Note: not axiom free *)
  forall sz (w: word sz) b n,
    n <> 0 -> wordToNat w <> 0 ->
    wmsb (wneg (zext w n)) b = true.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq bool (@wmsb (Init.Nat.add sz n) (@wneg (Init.Nat.add sz n) (@zext sz w n)) b) true *)
  dependent destruction w; [elim H0; reflexivity|].
(* Goal: @eq bool (@wmsb (Init.Nat.add (S n) n0) (@wneg (Init.Nat.add (S n) n0) (@zext (S n) (@WS b n w) n0)) b0) true *)
  apply wmsb_wneg_false with (b1:= false).
  - rewrite <-wordToNat_zext with (n:= n0) in H0.
(* Goal: False *)
    assumption.
  - apply wmsb_zext; assumption.
Qed.

Lemma wminus_WS_pos:
  forall sz (w1 w2: word (S sz)),
    wordToZ (WS true w1 ^- WS false w2) =
    (2 * wordToZ (w1 ^- w2) + 1)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wminus; intros.
(* Goal: @eq Z (@wordToZ (S (S sz)) (@wplus (S (S sz)) (@WS true (S sz) w1) (@wneg (S (S sz)) (@WS false (S sz) w2)))) (Z.add (Z.mul (Zpos (xO xH)) (@wordToZ (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)))) (Zpos xH)) *)
  cbn.
(* Goal: @eq (word (S (Init.Nat.add d sz))) (@WS false (Init.Nat.add d sz) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n)))) (@wneg (S (Init.Nat.add d sz)) (@WS false (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n)))) *)
  rewrite wneg_WS_0.
  rewrite <-wplus_WS_0.
(* Goal: @eq Z (@wordToZ (S (S sz)) (@WS true (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)))) (Z.add match @wordToZ (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)) with | Z0 => Z0 | Zpos y' => Zpos (xO y') | Zneg y' => Zneg (xO y') end (Zpos xH)) *)
  rewrite wordToZ_WS_1.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wminus_WS_pos':
  forall sz (w1 w2: word (sz + 1)),
    wordToZ (WS true w1 ^- WS false w2) =
    (2 * wordToZ (w1 ^- w2) + 1)%Z.
Proof.
(* Goal: forall (sz : nat) (w1 w2 : word (Init.Nat.add sz (S O))) (_ : not (@eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (S O)) (@wminus (Init.Nat.add sz (S O)) w2 w1)) (@existT nat word (S sz) (wpow2 sz)))), @eq Z (@wordToZ (Init.Nat.add sz (S O)) (@wminus (Init.Nat.add sz (S O)) w1 w2)) (Z.opp (@wordToZ (Init.Nat.add sz (S O)) (@wminus (Init.Nat.add sz (S O)) w2 w1))) *)
  intro sz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (sz + 1) with (S sz) by omega.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z (@wordToZ (S (S sz)) (@wminus (S (S sz)) (@WS true (S sz) w1) (@WS false (S sz) w2))) (Z.add (Z.mul (Zpos (xO xH)) (@wordToZ (S sz) (@wminus (S sz) w1 w2))) (Zpos xH)) *)
  apply wminus_WS_pos.
Qed.

Lemma wtl_combine:
  forall (x: word 1) sz (y: word sz),
    wtl (combine x y) = y.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wtl sz (@combine (S O) x sz y)) y *)
  destruct (destruct_word_S x) as [v [b E]]. subst x.
(* Goal: @eq (word sz) (@wtl sz (@combine (S O) (@WS b O v) sz y)) y *)
  rewrite (word0 v).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma extz_combine:
  forall sz (w: word sz) n, extz w n = combine (natToWord n 0) w.
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma combine_assoc_existT:
  forall sz1 (w1: word sz1) sz2 (w2: word sz2) sz3 (w3: word sz3),
    existT word (sz1 + (sz2 + sz3)) (combine w1 (combine w2 w3)) =
    existT word (sz1 + sz2 + sz3) (combine (combine w1 w2) w3).
Proof.
(* Goal: forall (sz1 : nat) (w1 : word sz1) (sz2 : nat) (w2 : word sz2) (sz3 : nat) (w3 : word sz3), @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz1 (Init.Nat.add sz2 sz3)) (@combine sz1 w1 (Init.Nat.add sz2 sz3) (@combine sz2 w2 sz3 w3))) (@existT nat word (Init.Nat.add (Init.Nat.add sz1 sz2) sz3) (@combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) sz3 w3)) *)
  intros; apply EqdepFacts.eq_sigT_sig_eq.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (Hsz: sz1 + (sz2 + sz3) = sz1 + sz2 + sz3) by omega.
(* Goal: @ex (@eq nat sz nsz) (fun Hsz2 : @eq nat sz nsz => @eq (word (Init.Nat.add nsz n)) (@eq_rect nat (Init.Nat.add sz n) word (@sext sz w n) (Init.Nat.add nsz n) Hsz1) (@sext nsz (@eq_rect nat sz word w nsz Hsz2) n)) *)
  exists Hsz.
(* Goal: @eq (word (Init.Nat.add (Init.Nat.add sz1 sz2) sz3)) (@eq_rect nat (Init.Nat.add sz1 (Init.Nat.add sz2 sz3)) word (@combine sz1 w1 (Init.Nat.add sz2 sz3) (@combine sz2 w2 sz3 w3)) (Init.Nat.add (Init.Nat.add sz1 sz2) sz3) Hsz) (@combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) sz3 w3) *)
  rewrite (combine_assoc w1 w2 w3 Hsz).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma sext_combine: (* Note: not axiom free *)
  forall sz n (w: word (sz + n)) sz1 (w1: word sz1)
         sz2 (Hsz2: sz2 <> 0) (w2: word sz2),
    existT word _ w = existT word _ (combine w1 (sext w2 n)) ->
    exists sw, w = sext sw n /\ existT word _ sw = existT word _ (combine w1 w2).
Proof.
(* Goal: forall (sz n : nat) (w : word (Init.Nat.add sz n)) (sz1 : nat) (w1 : word sz1) (sz2 : nat) (_ : not (@eq nat sz2 O)) (w2 : word sz2) (_ : @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz n) w) (@existT nat word (Init.Nat.add sz1 (Init.Nat.add sz2 n)) (@combine sz1 w1 (Init.Nat.add sz2 n) (@sext sz2 w2 n)))), @ex (word sz) (fun sw : word sz => and (@eq (word (Init.Nat.add sz n)) w (@sext sz sw n)) (@eq (@sigT nat word) (@existT nat word sz sw) (@existT nat word (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)))) *)
  intros; unfold sext in H.
(* Goal: @ex (word sz) (fun sw : word sz => and (@eq (word (Init.Nat.add sz n)) w (@sext sz sw n)) (@eq (@sigT nat word) (@existT nat word sz sw) (@existT nat word (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)))) *)
  remember (wmsb w2 false) as msb2; destruct msb2.
  - rewrite combine_assoc_existT in H.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
    assert (sz = sz1 + sz2) by (apply eq_sigT_fst in H; omega); subst.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS (orb b (@whd n w2)) n (natToWord n O)) *)
    destruct_existT.
(* Goal: @ex (word (Init.Nat.add sz1 sz2)) (fun sw : word (Init.Nat.add sz1 sz2) => and (@eq (word (Init.Nat.add (Init.Nat.add sz1 sz2) n)) (@combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n (wzero n)) (@sext (Init.Nat.add sz1 sz2) sw n)) (@eq (@sigT nat word) (@existT nat word (Init.Nat.add sz1 sz2) sw) (@existT nat word (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)))) *)
    exists (combine w1 w2).
(* Goal: and (@eq (word (Init.Nat.add (Init.Nat.add sz1 sz2) n)) (@combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n (wzero n)) (@sext (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n)) (@eq (@sigT nat word) (@existT nat word (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)) (@existT nat word (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2))) *)
    split; [|reflexivity].
(* Goal: @eq (word (Init.Nat.add sz O)) (@sext sz v O) (@nat_cast word sz (Init.Nat.add sz O) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) O (@eq_refl nat O)) v) *)
    unfold sext.
(* Goal: @eq (word (Init.Nat.add (Init.Nat.add sz1 sz2) n)) (@combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n (wones n)) (if @wmsb (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) false then @combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n (wones n) else @combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n (wzero n)) *)
    dependent destruction w2; [discriminate|].
(* Goal: False *)
    rewrite wmsb_combine with (b2:= false) by discriminate.
    rewrite <-Heqmsb2.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
  - rewrite combine_assoc_existT in H.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
    assert (sz = sz1 + sz2) by (apply eq_sigT_fst in H; omega); subst.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS (orb b (@whd n w2)) n (natToWord n O)) *)
    destruct_existT.
(* Goal: @ex (word (Init.Nat.add sz1 sz2)) (fun sw : word (Init.Nat.add sz1 sz2) => and (@eq (word (Init.Nat.add (Init.Nat.add sz1 sz2) n)) (@combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n (wzero n)) (@sext (Init.Nat.add sz1 sz2) sw n)) (@eq (@sigT nat word) (@existT nat word (Init.Nat.add sz1 sz2) sw) (@existT nat word (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)))) *)
    exists (combine w1 w2).
(* Goal: and (@eq (word (Init.Nat.add (Init.Nat.add sz1 sz2) n)) (@combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n (wzero n)) (@sext (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n)) (@eq (@sigT nat word) (@existT nat word (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)) (@existT nat word (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2))) *)
    split; [|reflexivity].
(* Goal: @eq (word (Init.Nat.add sz O)) (@sext sz v O) (@nat_cast word sz (Init.Nat.add sz O) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) O (@eq_refl nat O)) v) *)
    unfold sext.
(* Goal: @eq (word (Init.Nat.add (Init.Nat.add sz1 sz2) n)) (@combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n (wzero n)) (if @wmsb (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) false then @combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n (wones n) else @combine (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2) n (wzero n)) *)
    dependent destruction w2; [intuition idtac|].
(* Goal: False *)
    rewrite wmsb_combine with (b2:= false) by discriminate.
    rewrite <-Heqmsb2.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
Qed.

Lemma wplus_wzero_1:
  forall sz (w: word sz), w ^+ (wzero _) = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wplus, wordBin; intros.
(* Goal: @eq (word sz) (NToWord sz (N.add (@wordToN sz (wzero sz)) (@wordToN sz w))) w *)
  rewrite wordToN_wzero.
(* Goal: @eq (word sz) (NToWord sz (N.add (@wordToN sz w) N0)) w *)
  rewrite N.add_0_r.
(* Goal: @eq (word sz) (NToWord sz (@wordToN sz a)) a *)
  apply NToWord_wordToN.
Qed.

Lemma wplus_wzero_2:
  forall sz (w: word sz), (wzero _) ^+ w = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wplus, wordBin; intros.
(* Goal: @eq (word sz) (NToWord sz (N.add (@wordToN sz (wzero sz)) (@wordToN sz w))) w *)
  rewrite wordToN_wzero.
(* Goal: @eq (word sz) (NToWord sz (N.add N0 (@wordToN sz w))) w *)
  rewrite N.add_0_l.
(* Goal: @eq (word sz) (NToWord sz (@wordToN sz a)) a *)
  apply NToWord_wordToN.
Qed.

Lemma combine_wplus_1:
  forall sl (w1: word sl) su (w2 w3: word su),
    combine w1 (w2 ^+ w3) = combine w1 w2 ^+ extz w3 sl.
Proof.
(* Goal: forall (sl : nat) (w1 : word sl) (su : nat) (w2 w3 : word su), @eq (word (Init.Nat.add sl su)) (@combine sl w1 su (@wplus su w2 w3)) (@wplus (Init.Nat.add sl su) (@combine sl w1 su w2) (@extz su w3 sl)) *)
  dependent induction w1; intros; [reflexivity|].
(* Goal: @eq (word (Init.Nat.add (S n) su)) (@combine (S n) (@WS b n w1) su (@wplus su w2 w3)) (@wplus (Init.Nat.add (S n) su) (@combine (S n) (@WS b n w1) su w2) (@extz su w3 (S n))) *)
  cbn; rewrite IHw1.
  rewrite <-wplus_WS_0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite extz_combine; reflexivity.
Qed.

Lemma combine_wplus_2:
  forall sl (w1: word sl) su (w2 w3: word su),
    combine w1 (w2 ^+ w3) = extz w2 sl ^+ combine w1 w3.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) y2 y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wplus_comm.
(* Goal: @eq (word (Init.Nat.add sl su)) (@combine sl w1 su (@wplus su w3 w2)) (@wplus (Init.Nat.add sl su) (@extz su w2 sl) (@combine sl w1 su w3)) *)
  rewrite combine_wplus_1.
(* Goal: @eq (word sz) (@wplus sz (@wneg sz w1) w2) (@wplus sz w2 (@wneg sz w1)) *)
  apply wplus_comm.
Qed.

Lemma existT_wplus:
  forall sz (w1 w2: word sz) sz' (w3 w4: word sz'),
    existT word _ w1 = existT word _ w3 ->
    existT word _ w2 = existT word _ w4 ->
    existT word _ (w1 ^+ w2) = existT word _ (w3 ^+ w4).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (@sigT nat word) (@existT nat word sz (@wminus sz w1 w2)) (@existT nat word sz' (@wminus sz' w3 w4)) *)
  rewrite eq_sigT_sig_eq in H; destruct H as [Hsz1 ?].
(* Goal: @eq (@sigT nat word) (@existT nat word sz (@wminus sz w1 w2)) (@existT nat word sz' (@wminus sz' w3 w4)) *)
  rewrite eq_sigT_sig_eq in H0; destruct H0 as [Hsz2 ?].
  subst; do 2 rewrite <-(eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma existT_wminus:
  forall sz (w1 w2: word sz) sz' (w3 w4: word sz'),
    existT word _ w1 = existT word _ w3 ->
    existT word _ w2 = existT word _ w4 ->
    existT word _ (w1 ^- w2) = existT word _ (w3 ^- w4).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (@sigT nat word) (@existT nat word sz (@wminus sz w1 w2)) (@existT nat word sz' (@wminus sz' w3 w4)) *)
  rewrite eq_sigT_sig_eq in H; destruct H as [Hsz1 ?].
(* Goal: @eq (@sigT nat word) (@existT nat word sz (@wminus sz w1 w2)) (@existT nat word sz' (@wminus sz' w3 w4)) *)
  rewrite eq_sigT_sig_eq in H0; destruct H0 as [Hsz2 ?].
  subst; do 2 rewrite <-(eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.


Lemma existT_sext:
  forall sz1 (w1: word sz1) sz2 (w2: word sz2) n,
    existT word _ w1 = existT word _ w2 ->
    existT word _ (sext w1 n) = existT word _ (sext w2 n).
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  intros; inversion H; reflexivity.
Qed.

Lemma existT_extz:
  forall sz1 (w1: word sz1) sz2 (w2: word sz2) n,
    existT word _ w1 = existT word _ w2 ->
    existT word _ (extz w1 n) = existT word _ (extz w2 n).
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  intros; inversion H; reflexivity.
Qed.

Lemma existT_wrshifta:
  forall sz1 (w1: word sz1) sz2 (w2: word sz2) n,
    existT word _ w1 = existT word _ w2 ->
    existT word _ (wrshifta w1 n) = existT word _ (wrshifta w2 n).
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  intros; inversion H; reflexivity.
Qed.

Lemma existT_wlshift:
  forall sz1 (w1: word sz1) sz2 (w2: word sz2) n,
    existT word _ w1 = existT word _ w2 ->
    existT word _ (wlshift w1 n) = existT word _ (wlshift w2 n).
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  intros; inversion H; reflexivity.
Qed.

Lemma eq_rect_wplus:
  forall sz (w1 w2: word sz) sz' Hsz,
    eq_rect sz word (w1 ^+ w2) sz' Hsz =
    (eq_rect sz word w1 sz' Hsz) ^+ (eq_rect sz word w2 sz' Hsz).
Proof.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  intros; subst.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  eq_rect_simpl; reflexivity.
Qed.

Lemma eq_rect_2:
  forall sz (pa: word sz) sz' Heq1 Heq2,
    eq_rect sz' word (eq_rect sz word pa sz' Heq1) sz Heq2 = pa.
Proof.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  intros; subst.
  do 2 rewrite <-(eq_rect_eq_dec eq_nat_dec).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wzero_eq_rect:
  forall sz1 sz2 Heq,
    eq_rect sz1 word (wzero sz1) sz2 Heq = wzero sz2.
Proof.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  intros; subst.
(* Goal: @eq (word sz2) (@eq_rect nat sz2 word (wzero sz2) sz2 (@eq_refl nat sz2)) (wzero sz2) *)
  apply eq_sym, (eq_rect_eq_dec eq_nat_dec).
Qed.

Lemma wrshifta_0:
  forall sz (w: word sz), wrshifta w 0 = w.
Proof.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  unfold wrshifta; intros; simpl.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@eq_rec_r nat (Nat.add n sz) (fun n : nat => word n) (@combine n (wzero n) sz (natToWord sz O)) (Nat.add sz n) (Nat.add_comm sz n))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  unfold eq_rec_r, eq_rec.
(* Goal: @eq (word (Init.Nat.add sz O)) (@sext sz v O) (@nat_cast word sz (Init.Nat.add sz O) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) O (@eq_refl nat O)) v) *)
  unfold sext.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (if @wmsb sz w false then @combine sz w n (wones n) else @combine sz w n (wzero n))) (Nat.pow (S (S O)) sz)) (@wordToNat sz w) *)
  destruct (wmsb w false).
  - cbn; rewrite combine_n_0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    rewrite eq_rect_2; reflexivity.
  - cbn; rewrite combine_n_0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    rewrite eq_rect_2; reflexivity.
Qed.

Lemma wrshifta_WO:
  forall n, wrshifta WO n = WO.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wrshifta; cbn; intros.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@eq_rec_r nat (Nat.add n sz) (fun n : nat => word n) (@combine n (wzero n) sz (natToWord sz O)) (Nat.add sz n) (Nat.add_comm sz n))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  unfold eq_rec_r, eq_rec.
(* Goal: @eq (word sz) (split2 n sz (@eq_rect nat (Nat.add sz n) (fun y : nat => word y) (wzero (Init.Nat.add sz n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) (wzero sz) *)
  rewrite wzero_eq_rect.
  rewrite <-combine_wzero.
(* Goal: @eq (word sz) (split2 n sz (@combine n (wzero n) sz (wzero sz))) (wzero sz) *)
  rewrite split2_combine.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma split2_WO:
  forall n w, split2 n 0 w = WO.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction n; cbn; intros; auto.
Qed.

Lemma sext_wzero:
  forall sz n, sext (wzero sz) n = wzero (sz + n).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold sext; intros.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add (Init.Nat.add sz (S n1)) n2) (if @wmsb (S n1) (wzero (S n1)) false then @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wones n2) else @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wzero n2))) *)
  rewrite wmsb_wzero.
(* Goal: @eq (word (Init.Nat.add sz n)) (@combine sz (wzero sz) n (wzero n)) (wzero (Init.Nat.add sz n)) *)
  apply combine_wzero.
Qed.

Lemma wrshifta_wzero:
  forall sz n, wrshifta (wzero sz) n = wzero _.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z (@wordToZ (S (S sz)) (@wplus (S (S sz)) (@WS true (S sz) w1) (@wneg (S (S sz)) (@WS false (S sz) w2)))) (Z.add (Z.mul (Zpos (xO xH)) (@wordToZ (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)))) (Zpos xH)) *)
  unfold wrshifta; cbn.
(* Goal: @eq (word sz) (split2 n sz (@eq_rec_r nat (Nat.add sz n) (fun n : nat => word n) (@sext sz (wzero sz) n) (Nat.add n sz) (Nat.add_comm n sz))) (wzero sz) *)
  rewrite sext_wzero.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@eq_rec_r nat (Nat.add n sz) (fun n : nat => word n) (@combine n (wzero n) sz (natToWord sz O)) (Nat.add sz n) (Nat.add_comm sz n))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  unfold eq_rec_r, eq_rec.
(* Goal: @eq (word sz) (split2 n sz (@eq_rect nat (Nat.add sz n) (fun y : nat => word y) (wzero (Init.Nat.add sz n)) (Nat.add n sz) (@eq_sym nat (Nat.add n sz) (Nat.add sz n) (Nat.add_comm n sz)))) (wzero sz) *)
  rewrite wzero_eq_rect.
  rewrite <-combine_wzero.
(* Goal: @eq (word sz) (split2 n sz (@combine n (wzero n) sz (wzero sz))) (wzero sz) *)
  rewrite split2_combine.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma extz_sext:
  forall sz (w: word sz) n1 n2,
    existT word _ (extz (sext w n1) n2) =
    existT word _ (sext (extz w n2) n1).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  dependent destruction w; cbn; intros.
  - unfold wzero, extz, sext.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (@combine (S n1) (wzero (S n1)) n2 (wzero n2)))) *)
    rewrite combine_wzero.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (@combine (S n1) (wzero (S n1)) n2 (wzero n2)))) *)
    rewrite combine_wzero.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add (Init.Nat.add sz (S n1)) n2) (if @wmsb (S n1) (wzero (S n1)) false then @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wones n2) else @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wzero n2))) *)
    rewrite wmsb_wzero.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (@combine (S n1) (wzero (S n1)) n2 (wzero n2)))) *)
    rewrite combine_wzero.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    replace (n2 + 0 + n1) with (n2 + n1) by omega.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
  - unfold wzero, extz, sext.
(* Goal: False *)
    rewrite wmsb_combine with (b2:= false) by discriminate.
    destruct (wmsb (WS b w) false);
      try (rewrite <-combine_assoc_existT; reflexivity).
Qed.

Lemma sext_WS:
  forall sz (w: word (S sz)) b n,
    sext (WS b w) n = WS b (sext w n).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold sext; intros.
(* Goal: @eq (word (Init.Nat.add (S (S sz)) n)) (if @wmsb (S (S sz)) (@WS b (S sz) w) false then @combine (S (S sz)) (@WS b (S sz) w) n (wones n) else @combine (S (S sz)) (@WS b (S sz) w) n (wzero n)) (@WS b (Init.Nat.add (S sz) n) (if @wmsb (S sz) w false then @combine (S sz) w n (wones n) else @combine (S sz) w n (wzero n))) *)
  rewrite wmsb_ws.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  destruct (wmsb w false); reflexivity.
Qed.

Lemma sext_wordToZ:
  forall sz n (w: word sz),
    wordToZ (sext w n) = wordToZ w.
Proof.
(* Goal: forall (sz n : nat) (w : word sz), @eq Z (@wordToZ (Init.Nat.add sz n) (@sext sz w n)) (@wordToZ sz w) *)
  dependent induction w; cbn; intros; [apply wordToZ_wzero|].
(* Goal: @eq Z (@wordToZ (S (Init.Nat.add n0 n)) (@sext (S n0) (@WS b n0 w) n)) (@wordToZ (S n0) (@WS b n0 w)) *)
  dependent destruction w.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  - unfold sext; simpl.
(* Goal: @eq Z (@wordToZ (S (S sz)) (@wplus (S (S sz)) (@WS true (S sz) w1) (@wneg (S (S sz)) (@WS false (S sz) w2)))) (Z.add (Z.mul (Zpos (xO xH)) (@wordToZ (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)))) (Zpos xH)) *)
    destruct b; cbn.
(* Goal: False *)
    + rewrite wordToZ_wones by discriminate.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    + rewrite wordToZ_wzero; reflexivity.
  - remember (WS b0 w) as ww; clear Heqww.
(* Goal: @eq Z (@wordToZ (S (Init.Nat.add (S n0) n)) (@sext (S (S n0)) (@WS b (S n0) ww) n)) (@wordToZ (S (S n0)) (@WS b (S n0) ww)) *)
    rewrite sext_WS.
(* Goal: gt (if b then S (Init.Nat.mul (@wordToNat n w) (S (S O))) else Init.Nat.mul (@wordToNat n w) (S (S O))) O *)
    destruct b.
    + change (S n0 + n) with (S (n0 + n)) in *.
(* Goal: @eq Z (@wordToZ (S (S sz)) (@WS true (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)))) (Z.add match @wordToZ (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)) with | Z0 => Z0 | Zpos y' => Zpos (xO y') | Zneg y' => Zneg (xO y') end (Zpos xH)) *)
      repeat rewrite wordToZ_WS_1.
(* Goal: @eq Z (Z.mul (Zpos (xO xH)) (@wordToZ (S (Init.Nat.add n0 n)) (@sext (S n0) ww n))) (Z.mul (Zpos (xO xH)) (@wordToZ (S n0) ww)) *)
      rewrite IHw.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
    + change (S n0 + n) with (S (n0 + n)) in *.
(* Goal: @eq Z (@wordToZ (S (S (Init.Nat.add n0 n))) (@WS false (S (Init.Nat.add n0 n)) (@sext (S n0) ww n))) (@wordToZ (S (S n0)) (@WS false (S n0) ww)) *)
      repeat rewrite wordToZ_WS_0.
(* Goal: @eq Z (Z.mul (Zpos (xO xH)) (@wordToZ (S (Init.Nat.add n0 n)) (@sext (S n0) ww n))) (Z.mul (Zpos (xO xH)) (@wordToZ (S n0) ww)) *)
      rewrite IHw.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
Qed.

Lemma sext_natToWord': forall sz1 sz2 n,
  (2 * n < pow2 sz1)%nat ->
  sext (natToWord sz1 n) sz2 = natToWord (sz1 + sz2) n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction sz1; intros.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  - simpl. unfold sext. simpl. unfold wzero. unfold pow2 in *.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    assert (n=0) by omega. subst n. reflexivity.
  - unfold sext in *.
    assert (@wmsb (S sz1) (natToWord (S sz1) n) false = false) as E by
      (apply wmsb_0_natToWord; assumption).
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (ZToWord sz (Z.opp (@wordToZ sz (ZToWord sz x)))) *)
    rewrite E. clear E.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
    simpl. unfold natToWord. f_equal. fold natToWord.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@combine sz1 (natToWord sz1 (Nat.div2 n)) sz2 (wones sz2)) (natToWord (Init.Nat.add sz1 sz2) (Nat.div2 b)) *)
    specialize (IHsz1 sz2 (Nat.div2 n)).
    rewrite <- IHsz1.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
    + assert (@wmsb sz1 (natToWord sz1 (Nat.div2 n)) false = false) as E. {
(* Goal: @eq bool (@wmsb sz1 (natToWord sz1 O) false) false *)
        destruct sz1.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
        - reflexivity.
        - apply wmsb_0_natToWord. unfold pow2 in *. fold pow2 in *.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
          assert ((2 * Nat.div2 n <= n)%nat) by apply two_times_div2_bound. omega.
      }
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      rewrite E. clear E. reflexivity.
    + replace (pow2 (S sz1)) with (2 * (pow2 sz1)) in H.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      * assert ((2 * Nat.div2 n <= n)%nat) by apply two_times_div2_bound. omega.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      * reflexivity.
Qed.

Lemma sext_natToWord: forall sz2 sz1 sz n (e: sz1 + sz2 = sz),
  (2 * n < pow2 sz1)%nat ->
  eq_rect (sz1 + sz2) word (sext (natToWord sz1 n) sz2) sz e = natToWord sz n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite sext_natToWord' by assumption. rewrite e. reflexivity.
Qed.

Lemma sext_wneg_natToWord'': forall sz1 sz2 n,
  pow2 sz1 <= 2 * n < pow2 (S sz1) ->
  sext (natToWord sz1 n) sz2 = natToWord (sz1 + sz2) (pow2 (sz1+sz2) - (pow2 sz1 - n)).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction sz1; intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  - unfold pow2 in H. omega. (* contradiction *)
  - unfold sext in *.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
    assert (@wmsb (S sz1) (natToWord (S sz1) n) false = true) as E. {
(* Goal: @eq bool (@wmsb (S sz1) (natToWord (S sz1) n) false) true *)
      apply wmsb_1.
      rewrite wordToNat_natToWord_idempotent';
      (unfold pow2 in *; fold pow2 in *; omega).
    }
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (ZToWord sz (Z.opp (@wordToZ sz (ZToWord sz x)))) *)
    rewrite E.
    match goal with
    | |- _ = $ ?a => remember a as b
    end.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
    simpl. unfold natToWord. f_equal.
    + subst b. rewrite mod2sub.
(* Goal: @eq bool (mod2 n) (xorb (mod2 (Nat.pow (S (S O)) (Init.Nat.add (S sz1) sz2))) (mod2 (Init.Nat.sub (Nat.pow (S (S O)) (S sz1)) n))) *)
      * rewrite mod2sub.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        { replace (S sz1 + sz2) with (S (sz1 + sz2)) by omega.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
          simpl.
(* Goal: @eq bool true (xorb (mod2 (Nat.add (Nat.pow (S (S O)) sz) (Nat.add (Nat.pow (S (S O)) sz) O))) true) *)
          do 2 rewrite mod2_pow2_twice.
(* Goal: @eq bool (mod2 n) (xorb false (xorb false (mod2 n))) *)
          do 2 rewrite Bool.xorb_false_l.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
          reflexivity.
        }
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        simpl in *. omega.
      * rewrite pow2_add_mul in *. unfold pow2 in *. fold pow2 in *.
        apply Nat.le_trans with (m := 2 * pow2 sz1); [omega|].
(* Goal: le (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) (Nat.pow (S (S O)) sz2)) *)
        rewrite <- mult_assoc.
(* Goal: le (Nat.mul (Nat.pow (S (S O)) sz1) (S O)) (Init.Nat.mul (Nat.pow (S (S O)) sz1) (Nat.pow (S (S O)) sz2)) *)
        apply mult_le_compat_l.
        rewrite <- Nat.mul_1_r at 1.
(* Goal: le (Nat.mul (Nat.pow (S (S O)) sz1) (S O)) (Init.Nat.mul (Nat.pow (S (S O)) sz1) (Nat.pow (S (S O)) sz2)) *)
        apply mult_le_compat_l.
(* Goal: le (S O) (Nat.pow (S (S O)) sz2) *)
        apply one_le_pow2.
(* Goal: @eq (word (S (Init.Nat.add d sz))) (@WS false (Init.Nat.add d sz) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n)))) (@wneg (S (Init.Nat.add d sz)) (@WS false (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n)))) *)
    + fold natToWord.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@combine sz1 (natToWord sz1 (Nat.div2 n)) sz2 (wones sz2)) (natToWord (Init.Nat.add sz1 sz2) (Nat.div2 b)) *)
      specialize (IHsz1 sz2 (Nat.div2 n)).
      assert (Nat.div2 b = pow2 (sz1 + sz2) - (pow2 sz1 - (Nat.div2 n))) as D2. {
(* Goal: @eq nat (Nat.div2 (Init.Nat.sub (Nat.mul (S (S O)) (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2))) (Init.Nat.sub (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) n))) (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2)) (Nat.pow (S (S O)) sz1)) (Nat.div2 n)) *)
        rewrite minus_minus.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        - subst b. replace (S sz1 + sz2) with (S (sz1 + sz2)) by omega.
(* Goal: @eq nat (Nat.div2 (Init.Nat.sub (Nat.mul (S (S O)) ((fix pow (n m : nat) {struct m} : nat := match m with | O => S O | S m0 => Nat.mul n (pow n m0) end) (S (S O)) (Init.Nat.add sz1 sz2))) (Init.Nat.sub (Nat.mul (S (S O)) ((fix pow (n m : nat) {struct m} : nat := match m with | O => S O | S m0 => Nat.mul n (pow n m0) end) (S (S O)) sz1)) n))) (Init.Nat.add (Init.Nat.sub ((fix pow (n m : nat) {struct m} : nat := match m with | O => S O | S m0 => Nat.mul n (pow n m0) end) (S (S O)) (Init.Nat.add sz1 sz2)) ((fix pow (n m : nat) {struct m} : nat := match m with | O => S O | S m0 => Nat.mul n (pow n m0) end) (S (S O)) sz1)) (Nat.div2 n)) *)
          unfold pow2. fold pow2.
(* Goal: @eq nat (Nat.div2 (Init.Nat.sub (Nat.mul (S (S O)) (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2))) (Init.Nat.sub (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) n))) (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2)) (Nat.pow (S (S O)) sz1)) (Nat.div2 n)) *)
          rewrite minus_minus.
          * rewrite <- Nat.mul_sub_distr_l.
            rewrite <- (Nat.add_comm n).
(* Goal: @eq nat (Nat.div2 (Nat.add n (Nat.mul (S (S O)) (Nat.sub (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2)) (Nat.pow (S (S O)) sz1))))) (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2)) (Nat.pow (S (S O)) sz1)) (Nat.div2 n)) *)
            rewrite div2_plus_2.
(* Goal: @eq nat (Init.Nat.add (Nat.div2 n) (Nat.sub (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2)) (Nat.pow (S (S O)) sz1))) (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2)) (Nat.pow (S (S O)) sz1)) (Nat.div2 n)) *)
            apply Nat.add_comm.
          * rewrite pow2_add_mul. clear IHsz1. unfold pow2 in *. fold pow2 in *.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (Z.of_nat (N.to_nat (Npos p)))) (Z.lt (Z.of_nat (N.to_nat (Npos p))) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
            split; [omega|].
(* Goal: le (Nat.mul (Nat.pow (S (S O)) sz1) (S O)) (Init.Nat.mul (Nat.pow (S (S O)) sz1) (Nat.pow (S (S O)) sz2)) *)
            apply mult_le_compat_l.
            rewrite <- Nat.mul_1_r at 1.
(* Goal: le (Nat.mul (Nat.pow (S (S O)) sz1) (S O)) (Init.Nat.mul (Nat.pow (S (S O)) sz1) (Nat.pow (S (S O)) sz2)) *)
            apply mult_le_compat_l.
(* Goal: le (S O) (Nat.pow (S (S O)) sz2) *)
            apply one_le_pow2.
        - unfold pow2 in H. fold pow2 in H.
(* Goal: and (Z.le Z0 (Z.of_N (@wordToN sz a))) (Z.lt (Z.of_N (@wordToN sz a)) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
          split.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
          * pose proof (@div2_compat_lt_l (pow2 sz1) n) as P. omega.
          * rewrite pow2_add_mul. clear IHsz1.
            rewrite <- Nat.mul_1_r at 1.
(* Goal: le (Nat.mul (Nat.pow (S (S O)) sz1) (S O)) (Init.Nat.mul (Nat.pow (S (S O)) sz1) (Nat.pow (S (S O)) sz2)) *)
            apply mult_le_compat_l.
(* Goal: le (S O) (Nat.pow (S (S O)) sz2) *)
            apply one_le_pow2.
      }
(* Goal: @eq (word sz) (ZToWord sz (Z.sub a b)) (ZToWord sz (Z.sub (Z.sub a (Z.mul k1 (Z.of_N (Npow2 sz)))) (@wordToZ sz (ZToWord sz b)))) *)
      rewrite D2.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@combine sz1 (natToWord sz1 (Nat.div2 n)) sz2 (wones sz2)) (natToWord (Init.Nat.add sz1 sz2) (Init.Nat.sub (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2)) (Init.Nat.sub (Nat.pow (S (S O)) sz1) (Nat.div2 n)))) *)
      destruct sz1 as [|sz1'].
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
      * simpl in H. assert (n=1) by omega. subst n. simpl in D2. simpl.
(* Goal: @eq (word sz2) (wones sz2) (natToWord sz2 (Init.Nat.sub (Nat.pow (S (S O)) sz2) (S O))) *)
        apply wones_natToWord.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      * assert (n <= S (2 * Nat.div2 n))%nat. {
(* Goal: @eq (word (Init.Nat.add O sz2)) (@combine O (natToWord O (Nat.div2 n)) sz2 (wones sz2)) (natToWord (Init.Nat.add O sz2) (Init.Nat.sub (Nat.pow (S (S O)) (Init.Nat.add O sz2)) (Init.Nat.sub (Nat.pow (S (S O)) O) (Nat.div2 n)))) *)
          destruct (even_odd_destruct n) as [[m C]|[m C]]; subst n.
          - rewrite Nat.div2_double. constructor. constructor.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
          - replace (2 * m + 1) with (S (2 * m)) by omega. rewrite Nat.div2_succ_double.
(* Goal: forall sz : nat, @ring_morph (word sz) (ZToWord sz Z0) (ZToWord sz (Zpos xH)) (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz) (@eq (word sz)) Z Z0 (Zpos xH) Z.add Z.mul Z.sub Z.opp Z.eqb (ZToWord sz) *)
            constructor.
        }
       rewrite <- IHsz1.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
        { assert (@wmsb (S sz1') (natToWord (S sz1') (Nat.div2 n)) false = true) as F. {
(* Goal: @eq bool (@wmsb (S sz1') (natToWord (S sz1') (Nat.div2 n)) false) true *)
          apply wmsb_1_natToWord.
          unfold pow2 in *. fold pow2 in *.
          assert (2 * Nat.div2 n <= n)%nat by apply two_times_div2_bound.
          clear -H H0 H1.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
          omega. }
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
          { rewrite F. reflexivity. }
        }
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
        { assert (2 * Nat.div2 n <= n)%nat by apply two_times_div2_bound.
          clear -H H0 H1.
          unfold pow2 in *. fold pow2 in *.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
          omega. }
Qed.

Lemma sext_wneg_natToWord': forall sz1 sz2 n,
  (2 * n < pow2 sz1)%nat ->
  sext (wneg (natToWord sz1 n)) sz2 = wneg (natToWord (sz1 + sz2) n).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite wneg_alt. unfold wnegN.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@sext sz1 (natToWord sz1 (Init.Nat.sub (Nat.pow (S (S O)) sz1) (@wordToNat sz1 (natToWord sz1 n)))) sz2) (@wneg (Init.Nat.add sz1 sz2) (natToWord (Init.Nat.add sz1 sz2) n)) *)
  destruct n as [|n].
  - rewrite roundTrip_0. rewrite Nat.sub_0_r. rewrite natToWord_pow2.
(* Goal: @eq (word (Init.Nat.add sz O)) (@sext sz v O) (@nat_cast word sz (Init.Nat.add sz O) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) O (@eq_refl nat O)) v) *)
    unfold sext.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
    assert (wmsb (natToWord sz1 0) false = false) as W. {
(* Goal: @eq bool (@wmsb sz1 (natToWord sz1 O) false) false *)
      destruct sz1.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      + simpl. reflexivity.
(* Goal: False *)
      + apply wmsb_0_natToWord. assumption.
    }
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (if @wmsb sz1 (natToWord sz1 O) false then @combine sz1 (natToWord sz1 O) sz2 (wones sz2) else @combine sz1 (natToWord sz1 O) sz2 (wzero sz2)) (@wneg (Init.Nat.add sz1 sz2) (natToWord (Init.Nat.add sz1 sz2) O)) *)
    rewrite W.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (@combine (S n1) (wzero (S n1)) n2 (wzero n2)))) *)
    rewrite combine_wzero.
(* Goal: @eq (word sz) a (NToWord sz (@wordToN sz a)) *)
    symmetry.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (@wneg (Init.Nat.add sz1 sz2) (natToWord (Init.Nat.add sz1 sz2) O)) (wzero (Init.Nat.add sz1 sz2)) *)
    apply wneg_zero'.
  - rewrite sext_wneg_natToWord''.
    + rewrite wneg_alt. unfold wnegN.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      rewrite wordToNat_natToWord_idempotent' by omega.
(* Goal: @eq (word (Init.Nat.add sz1 sz2)) (natToWord (Init.Nat.add sz1 sz2) (Init.Nat.sub (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2)) (Init.Nat.sub (Nat.pow (S (S O)) sz1) (Init.Nat.sub (Nat.pow (S (S O)) sz1) (S n))))) (natToWord (Init.Nat.add sz1 sz2) (Init.Nat.sub (Nat.pow (S (S O)) (Init.Nat.add sz1 sz2)) (@wordToNat (Init.Nat.add sz1 sz2) (natToWord (Init.Nat.add sz1 sz2) (S n))))) *)
      rewrite wordToNat_natToWord_idempotent'.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      * replace (pow2 sz1 - (pow2 sz1 - S n)) with (S n) by omega.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
        reflexivity.
      * rewrite pow2_add_mul.
(* Goal: lt (S n) (Init.Nat.mul (Nat.pow (S (S O)) sz1) (Nat.pow (S (S O)) sz2)) *)
        apply Nat.le_trans with (m := pow2 sz1); [omega|].
        rewrite <- Nat.mul_1_r at 1.
(* Goal: le (Nat.mul (Nat.pow (S (S O)) sz1) (S O)) (Init.Nat.mul (Nat.pow (S (S O)) sz1) (Nat.pow (S (S O)) sz2)) *)
        apply mult_le_compat_l.
(* Goal: le (S O) (Nat.pow (S (S O)) sz2) *)
        apply one_le_pow2.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + rewrite wordToNat_natToWord_idempotent' by omega.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
      simpl. omega.
Qed.

Lemma sext_wneg_natToWord: forall sz2 sz1 sz n (e: sz1 + sz2 = sz),
  (2 * n < pow2 sz1)%nat ->
  eq_rect (sz1 + sz2) word (sext (wneg (natToWord sz1 n)) sz2) sz e = wneg (natToWord sz n).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite sext_wneg_natToWord' by assumption. rewrite e. reflexivity.
Qed.

Lemma wordToNat_split1:
  forall sz1 sz2 (w: word (sz1 + sz2)),
    wordToNat (split1 _ _ w) =
    Nat.modulo (wordToNat w) (pow2 sz1).
Proof.
(* Goal: forall (sz1 sz2 : nat) (w : word (Init.Nat.add sz1 sz2)), @eq nat (@wordToNat sz1 (split1 sz1 sz2 w)) (Nat.modulo (@wordToNat (Init.Nat.add sz1 sz2) w) (Nat.pow (S (S O)) sz1)) *)
  induction sz1; intros; [reflexivity|].
(* Goal: @eq nat (@wordToNat sz2 (split2 (S sz1) sz2 w)) (Nat.div (@wordToNat (Init.Nat.add (S sz1) sz2) w) (Nat.pow (S (S O)) (S sz1))) *)
  destruct (destruct_word_S w) as [v [b E]].
  match type of v with
  | word ?x => change x with (sz1 + sz2) in *
  end.
(* Goal: @eq nat (@wordToNat sz2 (split2 (S sz1) sz2 w)) (Nat.div (@wordToNat (Init.Nat.add (S sz1) sz2) w) (Nat.pow (S (S O)) (S sz1))) *)
  subst w. rename v into w.
(* Goal: @eq nat (@wordToNat (S sz1) (split1 (S sz1) sz2 (@WS b (Init.Nat.add sz1 sz2) w))) (Nat.modulo (@wordToNat (Init.Nat.add (S sz1) sz2) (@WS b (Init.Nat.add sz1 sz2) w)) (Nat.pow (S (S O)) (S sz1))) *)
  simpl; rewrite IHsz1.
(* Goal: @eq nat (if b then S (Init.Nat.mul (Nat.modulo (@wordToNat (Init.Nat.add sz1 sz2) w) (Nat.pow (S (S O)) sz1)) (S (S O))) else Init.Nat.mul (Nat.modulo (@wordToNat (Init.Nat.add sz1 sz2) w) (Nat.pow (S (S O)) sz1)) (S (S O))) (Nat.modulo (if b then S (Init.Nat.mul (@wordToNat (Init.Nat.add sz1 sz2) w) (S (S O))) else Init.Nat.mul (@wordToNat (Init.Nat.add sz1 sz2) w) (S (S O))) (Nat.add (Nat.pow (S (S O)) sz1) (Nat.add (Nat.pow (S (S O)) sz1) O))) *)
  pose proof (zero_lt_pow2 sz1).
(* Goal: gt (if b then S (Init.Nat.mul (@wordToNat n w) (S (S O))) else Init.Nat.mul (@wordToNat n w) (S (S O))) O *)
  destruct b.
  - change (pow2 sz1 + (pow2 sz1 + 0)) with (2 * pow2 sz1).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    replace (S (wordToNat w * 2)) with (1 + 2 * wordToNat w) by omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    rewrite Nat.add_mod by omega.
(* Goal: @eq nat (S (Init.Nat.mul (Nat.modulo (@wordToNat (Init.Nat.add sz1 sz2) w) (Nat.pow (S (S O)) sz1)) (S (S O)))) (Nat.modulo (Nat.add (Nat.modulo (S O) (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1))) (Nat.modulo (Init.Nat.mul (S (S O)) (@wordToNat (Init.Nat.add sz1 sz2) w)) (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)))) (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1))) *)
    rewrite Nat.mul_mod_distr_l; [|omega|discriminate].
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    rewrite Nat.mod_1_l by omega.
(* Goal: @eq nat (@wordToNat (Init.Nat.add (S n) sz2) (@combine (S n) (@WS b n w1) sz2 w2)) (Init.Nat.add (@wordToNat (S n) (@WS b n w1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) n)) (@wordToNat sz2 w2))) *)
    rewrite Nat.mul_comm with (n:= 2).
    change (1 + wordToNat w mod pow2 sz1 * 2) with (S (wordToNat w mod pow2 sz1 * 2)).
(* Goal: @eq nat (S (Init.Nat.mul (Nat.modulo (@wordToNat (Init.Nat.add sz1 sz2) w) (Nat.pow (S (S O)) sz1)) (S (S O)))) (Nat.modulo (S (Init.Nat.mul (Nat.modulo (@wordToNat (Init.Nat.add sz1 sz2) w) (Nat.pow (S (S O)) sz1)) (S (S O)))) (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1))) *)
    apply eq_sym, Nat.mod_small.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    assert (pow2 sz1 <> 0) by omega.
(* Goal: lt (S (Init.Nat.mul (Nat.modulo (@wordToNat (Init.Nat.add sz1 sz2) w) (Nat.pow (S (S O)) sz1)) (S (S O)))) (Init.Nat.mul (S (S O)) (Nat.pow (S (S O)) sz1)) *)
    pose proof (Nat.mod_upper_bound (wordToNat w) (pow2 sz1) H0).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    omega.
  - change (pow2 sz1 + (pow2 sz1 + 0)) with (2 * pow2 sz1).
(* Goal: @eq nat (@wordToNat (Init.Nat.add (S n) sz2) (@combine (S n) (@WS b n w1) sz2 w2)) (Init.Nat.add (@wordToNat (S n) (@WS b n w1)) (Init.Nat.mul (Nat.mul (S (S O)) (Nat.pow (S (S O)) n)) (@wordToNat sz2 w2))) *)
    rewrite Nat.mul_comm with (n:= 2).
(* Goal: @eq nat (Init.Nat.mul (Nat.modulo (@wordToNat (Init.Nat.add sz1 sz2) w) (Nat.pow (S (S O)) sz1)) (S (S O))) (Nat.modulo (Init.Nat.mul (@wordToNat (Init.Nat.add sz1 sz2) w) (S (S O))) (Nat.mul (Nat.pow (S (S O)) sz1) (S (S O)))) *)
    rewrite Nat.mul_mod_distr_r; [|omega|discriminate].
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
Qed.

Lemma wordToNat_split2:
  forall sz1 sz2 (w: word (sz1 + sz2)),
    wordToNat (split2 _ _ w) =
    Nat.div (wordToNat w) (pow2 sz1).
Proof.
  induction sz1; intros;
    [rewrite Nat.div_1_r; reflexivity|].
(* Goal: @eq nat (@wordToNat sz2 (split2 (S sz1) sz2 w)) (Nat.div (@wordToNat (Init.Nat.add (S sz1) sz2) w) (Nat.pow (S (S O)) (S sz1))) *)
  destruct (destruct_word_S w) as [v [b E]].
  match type of v with
  | word ?x => change x with (sz1 + sz2) in *
  end.
(* Goal: @eq nat (@wordToNat sz2 (split2 (S sz1) sz2 w)) (Nat.div (@wordToNat (Init.Nat.add (S sz1) sz2) w) (Nat.pow (S (S O)) (S sz1))) *)
  subst w. rename v into w.
  change (split2 (S sz1) sz2 (WS b w))
    with (split2 sz1 sz2 w).
(* Goal: @eq nat (@wordToNat sz2 (split2 sz1 sz2 w)) (Nat.div (@wordToNat (Init.Nat.add (S sz1) sz2) (@WS b (Init.Nat.add sz1 sz2) w)) (Nat.pow (S (S O)) (S sz1))) *)
  rewrite IHsz1.
(* Goal: gt (if b then S (Init.Nat.mul (@wordToNat n w) (S (S O))) else Init.Nat.mul (@wordToNat n w) (S (S O))) O *)
  destruct b.
  - unfold pow2; fold pow2.
    replace (@wordToNat (S sz1 + sz2) w~1)
      with (1 + 2 * wordToNat w) by (simpl; omega).
    rewrite <-Nat.div_div;
      [|discriminate|pose proof (zero_lt_pow2 sz1); omega].
(* Goal: False *)
    rewrite Nat.mul_comm, Nat.div_add by discriminate.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    rewrite Nat.div_small with (b := 2) by omega.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
  - unfold pow2; fold pow2.
    replace (@wordToNat (S sz1 + sz2) w~0)
      with (2 * wordToNat w) by (simpl; omega).
    rewrite Nat.div_mul_cancel_l;
      [|pose proof (zero_lt_pow2 sz1); omega|discriminate].
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
Qed.

Lemma wordToNat_wrshifta:
  forall sz (w: word sz) n,
    wordToNat (wrshifta w n) =
    Nat.div (wordToNat (sext w n)) (pow2 n).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wrshifta; intros.
(* Goal: @eq nat (@wordToNat (S O) (split2 sz (S O) (natToWord (Init.Nat.add sz (S O)) n))) (S O) *)
  rewrite wordToNat_split2.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@eq_rec_r nat (Nat.add n sz) (fun n : nat => word n) (@combine n (wzero n) sz (natToWord sz O)) (Nat.add sz n) (Nat.add_comm sz n))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  unfold eq_rec_r, eq_rec.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@eq_rect nat (Nat.add n sz) (fun y : nat => word y) (@combine n (wzero n) sz w) (Nat.add sz n) (@eq_sym nat (Nat.add sz n) (Nat.add n sz) (Nat.add_comm sz n)))) (Nat.pow (S (S O)) sz)) (Nat.mul (Nat.modulo (@wordToNat sz w) (Nat.pow (S (S O)) (Init.Nat.sub sz n))) (Nat.pow (S (S O)) n)) *)
  rewrite wordToNat_eq_rect.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wordToNat_combine:
  forall sz1 (w1: word sz1) sz2 (w2: word sz2),
    wordToNat (combine w1 w2) =
    wordToNat w1 + pow2 sz1 * wordToNat w2.
Proof.
(* Goal: forall (sz1 : nat) (w1 : word sz1) (sz2 : nat) (w2 : word sz2), @eq nat (@wordToNat (Init.Nat.add sz1 sz2) (@combine sz1 w1 sz2 w2)) (Init.Nat.add (@wordToNat sz1 w1) (Init.Nat.mul (Nat.pow (S (S O)) sz1) (@wordToNat sz2 w2))) *)
  dependent induction w1; intros; [simpl; omega|].
(* Goal: @eq nat (Nat.div2 (Init.Nat.sub (Nat.mul (S (S O)) ((fix pow (n m : nat) {struct m} : nat := match m with | O => S O | S m0 => Nat.mul n (pow n m0) end) (S (S O)) (Init.Nat.add sz1 sz2))) (Init.Nat.sub (Nat.mul (S (S O)) ((fix pow (n m : nat) {struct m} : nat := match m with | O => S O | S m0 => Nat.mul n (pow n m0) end) (S (S O)) sz1)) n))) (Init.Nat.add (Init.Nat.sub ((fix pow (n m : nat) {struct m} : nat := match m with | O => S O | S m0 => Nat.mul n (pow n m0) end) (S (S O)) (Init.Nat.add sz1 sz2)) ((fix pow (n m : nat) {struct m} : nat := match m with | O => S O | S m0 => Nat.mul n (pow n m0) end) (S (S O)) sz1)) (Nat.div2 n)) *)
  unfold pow2; fold pow2.
  rewrite Nat.mul_comm with (n:= 2). (* to avoid [simpl] *)
(* Goal: gt (if b then S (Init.Nat.mul (@wordToNat n w) (S (S O))) else Init.Nat.mul (@wordToNat n w) (S (S O))) O *)
  simpl; destruct b.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  - rewrite IHw1; simpl.
    rewrite Nat.mul_comm with (n:= pow2 n * 2).
(* Goal: @eq nat (Init.Nat.mul (Init.Nat.add (@wordToNat n w1) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz2 w2))) (S (S O))) (Init.Nat.add (Init.Nat.mul (@wordToNat n w1) (S (S O))) (Nat.mul (@wordToNat sz2 w2) (Init.Nat.mul (Nat.pow (S (S O)) n) (S (S O))))) *)
    rewrite Nat.mul_assoc.
    rewrite <-Nat.mul_add_distr_r.
(* Goal: @eq nat (Init.Nat.mul (Init.Nat.add (@wordToNat n w1) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz2 w2))) (S (S O))) (Nat.mul (Nat.add (@wordToNat n w1) (Nat.mul (@wordToNat sz2 w2) (Nat.pow (S (S O)) n))) (S (S O))) *)
    rewrite Nat.mul_comm with (n:= pow2 n).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
  - rewrite IHw1.
    rewrite Nat.mul_comm with (n:= pow2 n * 2).
(* Goal: @eq nat (Init.Nat.mul (Init.Nat.add (@wordToNat n w1) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz2 w2))) (S (S O))) (Init.Nat.add (Init.Nat.mul (@wordToNat n w1) (S (S O))) (Nat.mul (@wordToNat sz2 w2) (Init.Nat.mul (Nat.pow (S (S O)) n) (S (S O))))) *)
    rewrite Nat.mul_assoc.
    rewrite <-Nat.mul_add_distr_r.
(* Goal: @eq nat (Init.Nat.mul (Init.Nat.add (@wordToNat n w1) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz2 w2))) (S (S O))) (Nat.mul (Nat.add (@wordToNat n w1) (Nat.mul (@wordToNat sz2 w2) (Nat.pow (S (S O)) n))) (S (S O))) *)
    rewrite Nat.mul_comm with (n:= pow2 n).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
Qed.

Lemma wordToNat_wlshift:
  forall sz (w: word sz) n,
    wordToNat (wlshift w n) =
    Nat.mul (Nat.modulo (wordToNat w) (pow2 (sz - n))) (pow2 n).
Proof.
(* Goal: forall (sz : nat) (w : word sz) (n : nat), @eq nat (@wordToNat sz (@wlshift sz w n)) (Nat.mul (Nat.modulo (@wordToNat sz w) (Nat.pow (S (S O)) (Init.Nat.sub sz n))) (Nat.pow (S (S O)) n)) *)
  intros; destruct (le_dec n sz).

(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  - unfold wlshift; intros.
(* Goal: @eq (word sz1) (natToWord sz1 (@wordToNat sz1 (split1 sz1 sz2 (@wplus (Init.Nat.add sz1 sz2) (@combine sz1 w11 sz2 w12) (@combine sz1 w21 sz2 w22))))) (@wplus sz1 w11 w21) *)
    rewrite wordToNat_split1.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@eq_rec_r nat (Nat.add n sz) (fun n : nat => word n) (@combine n (wzero n) sz (natToWord sz O)) (Nat.add sz n) (Nat.add_comm sz n))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
    unfold eq_rec_r, eq_rec.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@eq_rect nat (Nat.add n sz) (fun y : nat => word y) (@combine n (wzero n) sz w) (Nat.add sz n) (@eq_sym nat (Nat.add sz n) (Nat.add n sz) (Nat.add_comm sz n)))) (Nat.pow (S (S O)) sz)) (Nat.mul (Nat.modulo (@wordToNat sz w) (Nat.pow (S (S O)) (Init.Nat.sub sz n))) (Nat.pow (S (S O)) n)) *)
    rewrite wordToNat_eq_rect.
(* Goal: @eq nat (@wordToNat (Nat.add sz (S O)) (@combine sz (split1 sz (S O) ww) (S O) (split2 sz (S O) ww))) (@wordToNat sz (split1 sz (S O) ww)) *)
    rewrite wordToNat_combine.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
    rewrite wordToNat_wzero; simpl.
    replace (pow2 sz) with (pow2 (sz - n + n)) by (f_equal; omega).
(* Goal: @eq nat (Nat.modulo (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (@wordToNat (Init.Nat.add ssu sn) wu))) (Nat.pow (S (S O)) (Init.Nat.add sl ssu))) (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (Nat.modulo (@wordToNat (Init.Nat.add ssu sn) wu) (Nat.pow (S (S O)) ssu)))) *)
    rewrite pow2_add_mul.
    rewrite Nat.mul_comm with (n:= pow2 (sz - n)).
    rewrite Nat.mul_mod_distr_l;
      [|pose proof (zero_lt_pow2 (sz - n)); omega
       |pose proof (zero_lt_pow2 n); omega].
(* Goal: @eq nat (Nat.mul (@wordToNat sz w) (Nat.pow (S (S O)) n)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz w)) *)
    apply Nat.mul_comm.

(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  - assert (n > sz)%nat by omega.
(* Goal: False *)
    rewrite wlshift_gt by assumption.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    replace (sz - n) with 0 by omega.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    rewrite wordToNat_wzero; simpl; reflexivity.
Qed.

Lemma wordToNat_extz:
  forall sz (w: word sz) n,
    wordToNat (extz w n) = pow2 n * wordToNat w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold extz; intros.
(* Goal: @eq nat (@wordToNat (Nat.add sz (S O)) (@combine sz (split1 sz (S O) ww) (S O) (split2 sz (S O) ww))) (@wordToNat sz (split1 sz (S O) ww)) *)
  rewrite wordToNat_combine.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (wzero n)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz w))) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz w)) *)
  rewrite wordToNat_wzero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma extz_is_mult_pow2: forall sz n d,
  extz (natToWord sz n) d = natToWord (d + sz) (pow2 d * n).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. induction d.
  - unfold extz.
(* Goal: @eq (word (Init.Nat.add O sz)) (@combine O (wzero O) sz (@wneg sz (natToWord sz n))) (@wneg (Init.Nat.add O sz) (natToWord (Init.Nat.add O sz) (Init.Nat.mul (Nat.pow (S (S O)) O) n))) *)
    rewrite combine_0_n.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
    simpl.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
    f_equal.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    omega.
  - unfold extz in *.
    change (pow2 (S d) * n) with (2 * pow2 d * n).
    rewrite <- Nat.mul_assoc.
    change ((S d) + sz) with (S (d + sz)) in *.
    rewrite <- natToWord_times2.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
    simpl.
(* Goal: @eq (word (S (Init.Nat.add d sz))) (@WS false (Init.Nat.add d sz) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n)))) (@wneg (S (Init.Nat.add d sz)) (@WS false (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n)))) *)
    fold natToWord.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
    f_equal.
(* Goal: @eq (word (Init.Nat.add d sz)) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n))) (@wneg (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n))) *)
    exact IHd.
Qed.

Lemma extz_is_mult_pow2_neg: forall sz n d,
  extz (wneg (natToWord sz n)) d = wneg (natToWord (d + sz) (pow2 d * n)).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. induction d.
  - unfold extz.
(* Goal: @eq (word (Init.Nat.add O sz)) (@combine O (wzero O) sz (@wneg sz (natToWord sz n))) (@wneg (Init.Nat.add O sz) (natToWord (Init.Nat.add O sz) (Init.Nat.mul (Nat.pow (S (S O)) O) n))) *)
    rewrite combine_0_n.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
    simpl.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
    f_equal. f_equal.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    omega.
  - unfold extz in *.
    change (pow2 (S d) * n) with (2 * pow2 d * n).
    rewrite <- Nat.mul_assoc.
    change ((S d) + sz) with (S (d + sz)) in *.
    rewrite <- natToWord_times2.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
    simpl.
(* Goal: @eq (word (S (Init.Nat.add d sz))) (@WS false (Init.Nat.add d sz) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n)))) (@wneg (S (Init.Nat.add d sz)) (@WS false (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n)))) *)
    fold natToWord.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
    f_equal.
(* Goal: @eq (word (S (Init.Nat.add d sz))) (@WS false (Init.Nat.add d sz) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n)))) (@wneg (S (Init.Nat.add d sz)) (@WS false (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n)))) *)
    rewrite wneg_WS_0.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
    f_equal.
(* Goal: @eq (word (Init.Nat.add d sz)) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n))) (@wneg (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n))) *)
    exact IHd.
Qed.

Lemma wordToNat_sext_bypass:
  forall sz1 (w1: word sz1) sz2 (w2: word sz2) (Hsz: sz1 = sz2) n,
    wordToNat w1 = wordToNat w2 ->
    wordToNat (sext w1 n) = wordToNat (sext w2 n).
Proof.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  intros; subst.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  apply wordToNat_inj in H; subst.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma combine_sext:
  forall sz1 (w1: word sz1) sz2 (w2: word (S sz2)) n,
    existT word _ (combine w1 (sext w2 n)) =
    existT word _ (sext (combine w1 w2) n).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold sext; intros.
(* Goal: False *)
  rewrite wmsb_combine with (b2:= false) by discriminate.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz1 (Init.Nat.add (S sz2) n)) (@combine sz1 w1 (Init.Nat.add (S sz2) n) (if @wmsb (S sz2) w2 false then @combine (S sz2) w2 n (wones n) else @combine (S sz2) w2 n (wzero n)))) (@existT nat word (Init.Nat.add (Init.Nat.add sz1 (S sz2)) n) (if @wmsb (S sz2) w2 false then @combine (Init.Nat.add sz1 (S sz2)) (@combine sz1 w1 (S sz2) w2) n (wones n) else @combine (Init.Nat.add sz1 (S sz2)) (@combine sz1 w1 (S sz2) w2) n (wzero n))) *)
  destruct (wmsb w2 false); apply combine_assoc_existT.
Qed.

Lemma extz_extz:
  forall sz (w: word sz) n1 n2,
    existT word _ (extz (extz w n1) n2) =
    existT word _ (extz w (n2 + n1)).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold extz; cbn; intros.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add n2 (Init.Nat.add n1 sz)) (@combine n2 (wzero n2) (Init.Nat.add n1 sz) (@combine n1 (wzero n1) sz w))) (@existT nat word (Init.Nat.add (Init.Nat.add n2 n1) sz) (@combine (Init.Nat.add n2 n1) (wzero (Init.Nat.add n2 n1)) sz w)) *)
  rewrite combine_assoc_existT.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (@combine (S n1) (wzero (S n1)) n2 (wzero n2)))) *)
  rewrite combine_wzero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wrshifta_extz_sext: (* Note: not axiom free *)
  forall sz (w: word sz) n1 n2,
    existT word _ (wrshifta (extz w (n1 + n2)) n1) =
    existT word _ (sext (extz w n2) n1).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <-extz_sext.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add (Init.Nat.add n1 n2) sz) (@wrshifta (Init.Nat.add (Init.Nat.add n1 n2) sz) (@extz sz w (Init.Nat.add n1 n2)) n1)) (@existT nat word (Init.Nat.add n2 (Init.Nat.add sz n1)) (@extz (Init.Nat.add sz n1) (@sext sz w n1) n2)) *)
  apply wordToNat_existT; [omega|].
(* Goal: @eq nat (@wordToNat (Init.Nat.add (Init.Nat.add n1 n2) sz) (@wrshifta (Init.Nat.add (Init.Nat.add n1 n2) sz) (@extz sz w (Init.Nat.add n1 n2)) n1)) (@wordToNat (Init.Nat.add n2 (Init.Nat.add sz n1)) (@extz (Init.Nat.add sz n1) (@sext sz w n1) n2)) *)
  rewrite wordToNat_wrshifta.

  replace (wordToNat (sext (extz w (n1 + n2)) n1))
    with (wordToNat (sext (extz (extz w n2) n1) n1)).
  - replace (wordToNat (sext (extz (extz w n2) n1) n1))
      with (wordToNat (extz (sext (extz w n2) n1) n1))
      by apply existT_wordToNat, extz_sext.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add n1 (Init.Nat.add (Init.Nat.add n2 sz) n1)) (@extz (Init.Nat.add (Init.Nat.add n2 sz) n1) (@sext (Init.Nat.add n2 sz) (@extz sz w n2) n1) n1)) (Nat.pow (S (S O)) n1)) (@wordToNat (Init.Nat.add n2 (Init.Nat.add sz n1)) (@extz (Init.Nat.add sz n1) (@sext sz w n1) n2)) *)
    do 2 rewrite wordToNat_extz.
    rewrite Nat.mul_comm, Nat.div_mul
      by (pose proof (zero_lt_pow2 n1); omega).
    replace (wordToNat (sext (extz w n2) n1))
      with (wordToNat (extz (sext w n1) n2))
      by apply existT_wordToNat, extz_sext.
(* Goal: @eq nat (Nat.mul (Nat.modulo (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (@wordToNat (Init.Nat.add ssu sn) wu))) (Nat.pow (S (S O)) (Init.Nat.sub (Init.Nat.add sl (Init.Nat.add ssu sn)) sn))) (Nat.pow (S (S O)) sn)) (@wordToNat (Init.Nat.add sn (Init.Nat.add sl ssu)) (@extz (Init.Nat.add sl ssu) (@combine sl wl ssu (split1 ssu sn wu)) sn)) *)
    rewrite wordToNat_extz.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
  - apply wordToNat_sext_bypass; [omega|].
(* Goal: @eq nat (@wordToNat (Init.Nat.add n1 (Init.Nat.add n2 sz)) (@extz (Init.Nat.add n2 sz) (@extz sz w n2) n1)) (@wordToNat (Init.Nat.add (Init.Nat.add n1 n2) sz) (@extz sz w (Init.Nat.add n1 n2))) *)
    apply existT_wordToNat.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add n1 (Init.Nat.add n2 sz)) (@extz (Init.Nat.add n2 sz) (@extz sz w n2) n1)) (@existT nat word (Init.Nat.add (Init.Nat.add n1 n2) sz) (@extz sz w (Init.Nat.add n1 n2))) *)
    apply extz_extz.
Qed.

Lemma wordToNat_sext_modulo:
  forall sz (w: word sz) n,
    Nat.modulo (wordToNat (sext w n)) (pow2 sz) = wordToNat w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold sext; intros.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (if @wmsb sz w false then @combine sz w n (wones n) else @combine sz w n (wzero n))) (Nat.pow (S (S O)) sz)) (@wordToNat sz w) *)
  pose proof (zero_lt_pow2 sz).
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (if @wmsb sz w false then @combine sz w n (wones n) else @combine sz w n (wzero n))) (Nat.pow (S (S O)) sz)) (@wordToNat sz w) *)
  destruct (wmsb w false).
  - rewrite wordToNat_combine.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    rewrite Nat.mul_comm, Nat.mod_add by omega.
(* Goal: @eq nat (Nat.modulo (@wordToNat sz w) (Nat.pow (S (S O)) sz)) (@wordToNat sz w) *)
    apply Nat.mod_small.
(* Goal: lt (@wordToNat sz w) (Nat.pow (S (S O)) sz) *)
    apply wordToNat_bound.
  - rewrite wordToNat_combine.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    rewrite Nat.mul_comm, Nat.mod_add by omega.
(* Goal: @eq nat (Nat.modulo (@wordToNat sz w) (Nat.pow (S (S O)) sz)) (@wordToNat sz w) *)
    apply Nat.mod_small.
(* Goal: lt (@wordToNat sz w) (Nat.pow (S (S O)) sz) *)
    apply wordToNat_bound.
Qed.

Lemma wlshift_sext_extz:
  forall sz (w: word sz) n,
    existT word _ (wlshift (sext w n) n) =
    existT word _ (extz w n).
Proof.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add (Init.Nat.add n1 n2) sz) (@wrshifta (Init.Nat.add (Init.Nat.add n1 n2) sz) (@extz sz w (Init.Nat.add n1 n2)) n1)) (@existT nat word (Init.Nat.add n2 (Init.Nat.add sz n1)) (@extz (Init.Nat.add sz n1) (@sext sz w n1) n2)) *)
  intros; apply wordToNat_existT; [omega|].
(* Goal: @eq nat (@wordToNat (Init.Nat.add sl (Init.Nat.add ssu sn)) (@wlshift (Init.Nat.add sl (Init.Nat.add ssu sn)) (@combine sl wl (Init.Nat.add ssu sn) wu) sn)) (@wordToNat (Init.Nat.add sn (Init.Nat.add sl ssu)) (@extz (Init.Nat.add sl ssu) (@combine sl wl ssu (split1 ssu sn wu)) sn)) *)
  rewrite wordToNat_wlshift.
(* Goal: @eq nat (Nat.mul (Nat.modulo (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (@wordToNat (Init.Nat.add ssu sn) wu))) (Nat.pow (S (S O)) (Init.Nat.sub (Init.Nat.add sl (Init.Nat.add ssu sn)) sn))) (Nat.pow (S (S O)) sn)) (@wordToNat (Init.Nat.add sn (Init.Nat.add sl ssu)) (@extz (Init.Nat.add sl ssu) (@combine sl wl ssu (split1 ssu sn wu)) sn)) *)
  rewrite wordToNat_extz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (sz + n - n) with sz by omega.
(* Goal: @eq nat (Nat.mul (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@sext sz w n)) (Nat.pow (S (S O)) sz)) (Nat.pow (S (S O)) n)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz w)) *)
  rewrite wordToNat_sext_modulo.
(* Goal: @eq nat (Nat.mul (@wordToNat sz w) (Nat.pow (S (S O)) n)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz w)) *)
  apply Nat.mul_comm.
Qed.

Lemma wlshift_combine_extz:
  forall sn sl (wl: word sl) ssu (wu: word (ssu + sn)),
    existT word (sl + (ssu + sn)) (wlshift (combine wl wu) sn) =
    existT word (sn + (sl + ssu)) (extz (combine wl (split1 ssu _ wu)) sn).
Proof.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add (Init.Nat.add n1 n2) sz) (@wrshifta (Init.Nat.add (Init.Nat.add n1 n2) sz) (@extz sz w (Init.Nat.add n1 n2)) n1)) (@existT nat word (Init.Nat.add n2 (Init.Nat.add sz n1)) (@extz (Init.Nat.add sz n1) (@sext sz w n1) n2)) *)
  intros; apply wordToNat_existT; [omega|].
(* Goal: @eq nat (@wordToNat (Init.Nat.add sl (Init.Nat.add ssu sn)) (@wlshift (Init.Nat.add sl (Init.Nat.add ssu sn)) (@combine sl wl (Init.Nat.add ssu sn) wu) sn)) (@wordToNat (Init.Nat.add sn (Init.Nat.add sl ssu)) (@extz (Init.Nat.add sl ssu) (@combine sl wl ssu (split1 ssu sn wu)) sn)) *)
  rewrite wordToNat_wlshift.
(* Goal: @eq nat (@wordToNat (Nat.add sz (S O)) (@combine sz (split1 sz (S O) ww) (S O) (split2 sz (S O) ww))) (@wordToNat sz (split1 sz (S O) ww)) *)
  rewrite wordToNat_combine.
(* Goal: @eq nat (Nat.mul (Nat.modulo (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (@wordToNat (Init.Nat.add ssu sn) wu))) (Nat.pow (S (S O)) (Init.Nat.sub (Init.Nat.add sl (Init.Nat.add ssu sn)) sn))) (Nat.pow (S (S O)) sn)) (@wordToNat (Init.Nat.add sn (Init.Nat.add sl ssu)) (@extz (Init.Nat.add sl ssu) (@combine sl wl ssu (split1 ssu sn wu)) sn)) *)
  rewrite wordToNat_extz.
(* Goal: @eq nat (@wordToNat (Nat.add sz (S O)) (@combine sz (split1 sz (S O) ww) (S O) (split2 sz (S O) ww))) (@wordToNat sz (split1 sz (S O) ww)) *)
  rewrite wordToNat_combine.
(* Goal: @eq (word sz1) (natToWord sz1 (@wordToNat sz1 (split1 sz1 sz2 (@wplus (Init.Nat.add sz1 sz2) (@combine sz1 w11 sz2 w12) (@combine sz1 w21 sz2 w22))))) (@wplus sz1 w11 w21) *)
  rewrite wordToNat_split1.

(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (sl + (ssu + sn) - sn) with (sl + ssu) by omega.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  rewrite Nat.mul_comm; f_equal.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (@wordToNat (Init.Nat.add ssu sn) wu))) (Nat.pow (S (S O)) (Init.Nat.add sl ssu))) (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (Nat.modulo (@wordToNat (Init.Nat.add ssu sn) wu) (Nat.pow (S (S O)) ssu)))) *)
  rewrite pow2_add_mul.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (@wordToNat (Init.Nat.add ssu sn) wu))) (Init.Nat.mul (Nat.pow (S (S O)) sl) (Nat.pow (S (S O)) ssu))) (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (Nat.modulo (@wordToNat (Init.Nat.add ssu sn) wu) (Nat.pow (S (S O)) ssu)))) *)
  pose proof (zero_lt_pow2 sl).
(* Goal: @eq nat (Nat.modulo (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (@wordToNat (Init.Nat.add ssu sn) wu))) (Init.Nat.mul (Nat.pow (S (S O)) sl) (Nat.pow (S (S O)) ssu))) (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (Nat.modulo (@wordToNat (Init.Nat.add ssu sn) wu) (Nat.pow (S (S O)) ssu)))) *)
  pose proof (zero_lt_pow2 ssu).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite Nat.mod_mul_r; try omega.
(* Goal: @eq nat (Nat.add (Nat.modulo (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (@wordToNat (Init.Nat.add ssu sn) wu))) (Nat.pow (S (S O)) sl)) (Nat.mul (Nat.pow (S (S O)) sl) (Nat.modulo (Nat.div (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (@wordToNat (Init.Nat.add ssu sn) wu))) (Nat.pow (S (S O)) sl)) (Nat.pow (S (S O)) ssu)))) (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (Nat.modulo (@wordToNat (Init.Nat.add ssu sn) wu) (Nat.pow (S (S O)) ssu)))) *)
  rewrite Nat.mul_comm with (n:= pow2 sl) at 1.
(* Goal: @eq nat (Nat.add (Nat.modulo (Init.Nat.add (@wordToNat sl wl) (Nat.mul (@wordToNat (Init.Nat.add ssu sn) wu) (Nat.pow (S (S O)) sl))) (Nat.pow (S (S O)) sl)) (Nat.mul (Nat.pow (S (S O)) sl) (Nat.modulo (Nat.div (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (@wordToNat (Init.Nat.add ssu sn) wu))) (Nat.pow (S (S O)) sl)) (Nat.pow (S (S O)) ssu)))) (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (Nat.modulo (@wordToNat (Init.Nat.add ssu sn) wu) (Nat.pow (S (S O)) ssu)))) *)
  rewrite Nat.mod_add; [|omega].
(* Goal: lt (@wordToNat sz w) (Nat.pow (S (S O)) sz) *)
  rewrite Nat.mod_small by apply wordToNat_bound.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  do 3 f_equal.
(* Goal: @eq nat (Nat.div (Init.Nat.add (@wordToNat sl wl) (Init.Nat.mul (Nat.pow (S (S O)) sl) (@wordToNat (Init.Nat.add ssu sn) wu))) (Nat.pow (S (S O)) sl)) (@wordToNat (Init.Nat.add ssu sn) wu) *)
  rewrite Nat.mul_comm, Nat.div_add; [|omega].
(* Goal: lt (@wordToNat sz w) (Nat.pow (S (S O)) sz) *)
  rewrite Nat.div_small by apply wordToNat_bound.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma extz_sext_eq_rect:
  forall sz (w: word sz) n1 n2 nsz Hnsz1,
  exists Hnsz2,
    eq_rect (n2 + (sz + n1)) word (extz (sext w n1) n2) nsz Hnsz1 =
    eq_rect (n2 + sz + n1) word (sext (extz w n2) n1) nsz Hnsz2.
Proof.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  intros; subst; simpl.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (Hsz: n2 + sz + n1 = n2 + (sz + n1)) by omega.
(* Goal: @ex (@eq nat sz nsz) (fun Hsz2 : @eq nat sz nsz => @eq (word (Init.Nat.add nsz n)) (@eq_rect nat (Init.Nat.add sz n) word (@sext sz w n) (Init.Nat.add nsz n) Hsz1) (@sext nsz (@eq_rect nat sz word w nsz Hsz2) n)) *)
  exists Hsz.
(* Goal: @eq (word (Init.Nat.add n2 (Init.Nat.add sz n1))) (@extz (Init.Nat.add sz n1) (@sext sz w n1) n2) (@eq_rect nat (Init.Nat.add (Init.Nat.add n2 sz) n1) word (@sext (Init.Nat.add n2 sz) (@extz sz w n2) n1) (Init.Nat.add n2 (Init.Nat.add sz n1)) Hsz) *)
  pose proof (extz_sext w n1 n2).
(* Goal: @eq (word (Init.Nat.add n2 (Init.Nat.add sz n1))) (@extz (Init.Nat.add sz n1) (@sext sz w n1) n2) (@eq_rect nat (Init.Nat.add (Init.Nat.add n2 sz) n1) word (@sext (Init.Nat.add n2 sz) (@extz sz w n2) n1) (Init.Nat.add n2 (Init.Nat.add sz n1)) Hsz) *)
  pose proof (eq_sigT_snd H).
  rewrite <-H0.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma sext_zero:
  forall n m, sext (natToWord n 0) m = natToWord _ 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold sext; intros.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add (Init.Nat.add sz (S n1)) n2) (if @wmsb (S n1) (wzero (S n1)) false then @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wones n2) else @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wzero n2))) *)
  rewrite wmsb_wzero.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (@combine (S n1) (wzero (S n1)) n2 (wzero n2)))) *)
  rewrite combine_wzero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma sext_split1:
  forall sz (w: word sz) n,
    split1 sz _ (sext w n) = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold sext; intros.
  destruct (wmsb w false); apply split1_combine.
Qed.

Lemma sext_sext:
  forall sz (w: word sz) n1 n2,
    existT word _ (sext w (n1 + n2)) = existT word _ (sext (sext w n1) n2).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold sext; intros.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add n1 n2)) (if @wmsb sz w false then @combine sz w (Init.Nat.add n1 n2) (wones (Init.Nat.add n1 n2)) else @combine sz w (Init.Nat.add n1 n2) (wzero (Init.Nat.add n1 n2)))) (@existT nat word (Init.Nat.add (Init.Nat.add sz n1) n2) (if @wmsb (Init.Nat.add sz n1) (if @wmsb sz w false then @combine sz w n1 (wones n1) else @combine sz w n1 (wzero n1)) false then @combine (Init.Nat.add sz n1) (if @wmsb sz w false then @combine sz w n1 (wones n1) else @combine sz w n1 (wzero n1)) n2 (wones n2) else @combine (Init.Nat.add sz n1) (if @wmsb sz w false then @combine sz w n1 (wones n1) else @combine sz w n1 (wzero n1)) n2 (wzero n2))) *)
  remember (wmsb w false) as wmsb; destruct wmsb.
  - destruct n1 as [|n1].
    + cbn; rewrite wmsb_combine_WO, <-Heqwmsb.
      rewrite <-combine_assoc_existT.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
(* Goal: False *)
    + rewrite wmsb_combine with (b2:= false) by discriminate.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wones (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add (Init.Nat.add sz (S n1)) n2) (if @wmsb (S n1) (wones (S n1)) false then @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wones (S n1))) n2 (wones n2) else @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wones (S n1))) n2 (wzero n2))) *)
      rewrite wmsb_wones.
      rewrite <-combine_assoc_existT.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wones (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (@combine (S n1) (wones (S n1)) n2 (wones n2)))) *)
      rewrite combine_wones.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
  - destruct n1 as [|n1].
    + cbn; rewrite wmsb_combine_WO, <-Heqwmsb.
      rewrite <-combine_assoc_existT.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
(* Goal: False *)
    + rewrite wmsb_combine with (b2:= false) by discriminate.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add (Init.Nat.add sz (S n1)) n2) (if @wmsb (S n1) (wzero (S n1)) false then @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wones n2) else @combine (Init.Nat.add sz (S n1)) (@combine sz w (S n1) (wzero (S n1))) n2 (wzero n2))) *)
      rewrite wmsb_wzero.
      rewrite <-combine_assoc_existT.
(* Goal: @eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (wzero (Init.Nat.add (S n1) n2)))) (@existT nat word (Init.Nat.add sz (Init.Nat.add (S n1) n2)) (@combine sz w (Init.Nat.add (S n1) n2) (@combine (S n1) (wzero (S n1)) n2 (wzero n2)))) *)
      rewrite combine_wzero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
Qed.

Lemma wneg_wordToN:
  forall sz (w: word sz),
    wordToN w <> 0%N ->
    wordToN (wneg w) = (Npow2 sz - wordToN w)%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wneg; intros.
(* Goal: @eq (word sz) a (NToWord sz (N.mul (@wordToN sz b) (@wordToN sz (NToWord sz (N.sub k (N.mul (N.div k (Npow2 sz)) (Npow2 sz))))))) *)
  rewrite wordToN_NToWord_2.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - reflexivity.
  - pose proof (wordToN_bound w).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    nomega.
Qed.

Lemma Nmul_two:
  forall n, (n + n = 2 * n)%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct n; simpl; auto.
(* Goal: @eq N (Npos (Pos.add p p)) (Npos (xO p)) *)
  rewrite Pos.add_diag.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wmsb_false_bound:
  forall sz (w: word (S sz)),
    wmsb w false = false -> (wordToN w < Npow2 sz)%N.
Proof.
  apply (induct_word_S (fun sz w => wmsb w false = false -> (wordToN w < Npow2 sz)%N));
    [simpl; intros; subst; nomega|].
(* Goal: forall (b b0 : bool) (n : nat) (w : word n) (_ : forall _ : @eq bool (@wmsb (S n) (@WS b0 n w) false) true, N.le (Npow2 n) (@wordToN (S n) (@WS b0 n w))) (_ : @eq bool (@wmsb (S (S n)) (@WS b (S n) (@WS b0 n w)) false) true), N.le (Npow2 (S n)) (@wordToN (S (S n)) (@WS b (S n) (@WS b0 n w))) *)
  intros; rewrite Npow2_S, Nmul_two.
(* Goal: N.le (N.mul (Npos (xO xH)) (Npow2 n)) (@wordToN (S (S n)) (@WS b (S n) (@WS b0 n w))) *)
  specialize (H H0).
(* Goal: gt (if b then S (Init.Nat.mul (@wordToNat n w) (S (S O))) else Init.Nat.mul (@wordToNat n w) (S (S O))) O *)
  destruct b.
  - rewrite wordToN_WS_1.
(* Goal: N.lt (N.add (N.mul (Npos (xO xH)) (@wordToN (S n) (@WS b0 n w))) (Npos xH)) (N.mul (Npos (xO xH)) (Npow2 n)) *)
    rewrite N.add_comm.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    apply N.mul_2_mono_l; auto.
  - rewrite wordToN_WS_0.
(* Goal: N.lt (N.mul (Npos (xO xH)) (@wordToN (S n) (@WS b0 n w))) (N.mul (Npos (xO xH)) (Npow2 n)) *)
    apply N.mul_lt_mono_pos_l; [nomega|].
(* Goal: False *)
    assumption.
Qed.

Lemma wmsb_true_bound:
  forall sz (w: word (S sz)),
    wmsb w false = true -> (Npow2 sz <= wordToN w)%N.
Proof.
  apply (induct_word_S (fun sz w => wmsb w false = true -> (Npow2 sz <= wordToN w)%N));
    [simpl; intros; subst; reflexivity|].
(* Goal: forall (b b0 : bool) (n : nat) (w : word n) (_ : forall _ : @eq bool (@wmsb (S n) (@WS b0 n w) false) true, N.le (Npow2 n) (@wordToN (S n) (@WS b0 n w))) (_ : @eq bool (@wmsb (S (S n)) (@WS b (S n) (@WS b0 n w)) false) true), N.le (Npow2 (S n)) (@wordToN (S (S n)) (@WS b (S n) (@WS b0 n w))) *)
  intros; rewrite Npow2_S, Nmul_two.
(* Goal: N.le (N.mul (Npos (xO xH)) (Npow2 n)) (@wordToN (S (S n)) (@WS b (S n) (@WS b0 n w))) *)
  specialize (H H0).
(* Goal: gt (if b then S (Init.Nat.mul (@wordToNat n w) (S (S O))) else Init.Nat.mul (@wordToNat n w) (S (S O))) O *)
  destruct b.
  - rewrite wordToN_WS_1.
(* Goal: N.le (N.mul (Npos (xO xH)) (Npow2 n)) (N.add (N.mul (Npos (xO xH)) (@wordToN (S n) (@WS b0 n w))) (Npos xH)) *)
    apply N.mul_le_mono_nonneg_l with (p:= 2%N) in H; [|compute; discriminate].
(* Goal: N.le (N.mul (Npos (xO xH)) (Npow2 n)) (N.add (N.mul (Npos (xO xH)) (@wordToN (S n) (@WS b0 n w))) (Npos xH)) *)
    rewrite N.add_1_r.
(* Goal: N.le (N.mul (Npos (xO xH)) (Npow2 n)) (N.succ (N.mul (Npos (xO xH)) (@wordToN (S n) (@WS b0 n w)))) *)
    apply N.le_le_succ_r.
(* Goal: False *)
    assumption.
  - rewrite wordToN_WS_0.
(* Goal: N.le (N.mul (Npos (xO xH)) (Npow2 n)) (N.mul (Npos (xO xH)) (@wordToN (S n) (@WS b0 n w))) *)
    apply N.mul_le_mono_nonneg_l; [compute; discriminate|].
(* Goal: False *)
    assumption.
Qed.

Lemma ZToWord_wordToZ:
  forall sz (w: word sz), ZToWord sz (wordToZ w) = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold ZToWord, wordToZ; intros.
(* Goal: @eq Z (if msb then match @wordToN (S sz) (natToWord (S sz) (Pos.to_nat p)) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (@wneg (S sz) (natToWord (S sz) (Pos.to_nat p))) with | N0 => Z0 | Npos x => Zpos x end) (Zneg p) *)
  remember (wmsb w false) as msb; destruct msb.
  - remember (wordToN (wneg w)) as ww.
(* Goal: @eq (word sz) match match ww with | N0 => Z0 | Npos x => Zpos x end with | Z0 => wzero' sz | Zpos x => posToWord sz x | Zneg x => @wneg sz (posToWord sz x) end w *)
    destruct ww.
    + assert (wneg w = wzero _).
      { apply wordToN_inj; rewrite <-Heqww.
(* Goal: @eq N N0 (@wordToN sz (wzero sz)) *)
        rewrite wordToN_nat.
(* Goal: @eq N N0 (N.of_nat (@wordToNat sz (wzero sz))) *)
        rewrite roundTrip_0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
        reflexivity.
      }
(* Goal: @eq (word sz) (wzero' sz) w *)
      rewrite wzero'_def.
      rewrite <-wneg_idempotent, H.
(* Goal: @eq (word sz) (wzero sz) (@wneg sz (wzero sz)) *)
      apply eq_sym, wzero_wneg.
    + assert (wneg w = NToWord _ (N.pos p)).
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { apply wordToN_inj; rewrite Heqww.
(* Goal: @eq N (@wordToN sz w) (@wordToN sz (NToWord sz (@wordToN sz w))) *)
        rewrite NToWord_wordToN.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
        reflexivity.
      }
      rewrite <-wneg_idempotent, H.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
  - remember (wordToN w) as ww.
(* Goal: @eq (word sz) match match ww with | N0 => Z0 | Npos x => Zpos x end with | Z0 => wzero' sz | Zpos x => posToWord sz x | Zneg x => @wneg sz (posToWord sz x) end w *)
    destruct ww.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
    + assert (w = wzero _); subst.
      { apply wordToN_inj; rewrite <-Heqww.
(* Goal: @eq N N0 (@wordToN sz (wzero sz)) *)
        rewrite wordToN_nat.
(* Goal: @eq N N0 (N.of_nat (@wordToNat sz (wzero sz))) *)
        rewrite roundTrip_0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
        reflexivity.
      }
(* Goal: @eq (word sz) (wzero' sz) (wzero sz) *)
      apply wzero'_def.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
    + assert (w = NToWord _ (N.pos p)); subst.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { apply wordToN_inj; rewrite Heqww.
(* Goal: @eq N (@wordToN sz w) (@wordToN sz (NToWord sz (@wordToN sz w))) *)
        rewrite NToWord_wordToN.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
        reflexivity.
      }
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
Qed.

Lemma wordToZ_ZToWord:
  forall z sz,
    (- Z.of_nat (pow2 sz) <= z < Z.of_nat (pow2 sz))%Z ->
    wordToZ (ZToWord (S sz) z) = z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wordToZ, ZToWord; intros.
(* Goal: @eq Z (if @wmsb (S sz) match z with | Z0 => wzero' (S sz) | Zpos x => posToWord (S sz) x | Zneg x => @wneg (S sz) (posToWord (S sz) x) end false then match @wordToN (S sz) (@wneg (S sz) match z with | Z0 => wzero' (S sz) | Zpos x => posToWord (S sz) x | Zneg x => @wneg (S sz) (posToWord (S sz) x) end) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) match z with | Z0 => wzero' (S sz) | Zpos x => posToWord (S sz) x | Zneg x => @wneg (S sz) (posToWord (S sz) x) end with | N0 => Z0 | Npos x => Zpos x end) z *)
  destruct z.
  - rewrite wmsb_wzero'.
(* Goal: @eq Z match @wordToN (S sz) (wzero' (S sz)) with | N0 => Z0 | Npos x => Zpos x end Z0 *)
    rewrite wordToN_wzero'.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.

  - rewrite posToWord_nat.
(* Goal: @eq Z (if @wmsb (S sz) (natToWord (S sz) (Pos.to_nat p)) false then match @wordToN (S sz) (@wneg (S sz) (natToWord (S sz) (Pos.to_nat p))) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (natToWord (S sz) (Pos.to_nat p)) with | N0 => Z0 | Npos x => Zpos x end) (Zpos p) *)
    remember (wmsb (natToWord (S sz) (Pos.to_nat p)) false) as msb.
(* Goal: @eq Z (if msb then match @wordToN (S sz) (natToWord (S sz) (Pos.to_nat p)) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (@wneg (S sz) (natToWord (S sz) (Pos.to_nat p))) with | N0 => Z0 | Npos x => Zpos x end) (Zneg p) *)
    destruct msb.
    + exfalso.
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
      simpl in H; destruct H.
(* Goal: False *)
      apply eq_sym, wmsb_true_bound in Heqmsb.
      rewrite <-positive_N_nat, <-NToWord_nat in Heqmsb.
      rewrite <-positive_nat_Z in H0.
(* Goal: N.lt (Npos p) (Npow2 (S sz)) *)
      apply Nat2Z.inj_lt in H0.
      rewrite <-positive_N_nat, <-Npow2_nat in H0.
(* Goal: False *)
      apply Nlt_in in H0.
(* Goal: N.le (@wordToN (S sz) (NToWord (S sz) (Npos p))) (Npow2 sz) *)
      pose proof (wordToN_NToWord (S sz) (N.pos p)).
(* Goal: False *)
      destruct H1 as [k [? ?]].
(* Goal: False *)
      rewrite H1 in Heqmsb.
      assert (N.pos p - k * Npow2 (S sz) <= N.pos p)%N by apply N.le_sub_l.
(* Goal: False *)
      assert (Npow2 sz <= N.pos p)%N by (etransitivity; eassumption).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      apply N.le_ngt in H4; auto.
    + rewrite wordToN_nat, wordToNat_natToWord_2.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      * rewrite positive_nat_N; reflexivity.
      * rewrite <-Npow2_nat, <-positive_N_nat.
(* Goal: lt (N.to_nat (Npos p)) (N.to_nat (Npow2 (S sz))) *)
        apply Nlt_out.
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
        destruct H.
        rewrite <-N2Z.inj_pos, <-N_nat_Z in H0.
(* Goal: N.lt (Npos p) (Npow2 (S sz)) *)
        apply Nat2Z.inj_lt in H0.
        rewrite <-Npow2_nat in H0.
(* Goal: N.lt (Npos p) (Npow2 (S sz)) *)
        apply Nlt_in.
(* Goal: lt (N.to_nat (Npos p)) (N.to_nat (Npow2 (S sz))) *)
        rewrite Npow2_S, N2Nat.inj_add.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        omega.

  - rewrite wneg_idempotent.
(* Goal: @eq Z (if @wmsb (S sz) (@wneg (S sz) (posToWord (S sz) p)) false then match @wordToN (S sz) (posToWord (S sz) p) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (@wneg (S sz) (posToWord (S sz) p)) with | N0 => Z0 | Npos x => Zpos x end) (Zneg p) *)
    rewrite posToWord_nat.
(* Goal: @eq Z (if @wmsb (S sz) (@wneg (S sz) (natToWord (S sz) (Pos.to_nat p))) false then match @wordToN (S sz) (natToWord (S sz) (Pos.to_nat p)) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (@wneg (S sz) (natToWord (S sz) (Pos.to_nat p))) with | N0 => Z0 | Npos x => Zpos x end) (Zneg p) *)
    remember (wmsb (wneg (natToWord (S sz) (Pos.to_nat p))) false) as msb.
(* Goal: @eq Z (if msb then match @wordToN (S sz) (natToWord (S sz) (Pos.to_nat p)) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (@wneg (S sz) (natToWord (S sz) (Pos.to_nat p))) with | N0 => Z0 | Npos x => Zpos x end) (Zneg p) *)
    destruct msb.
    + rewrite wordToN_nat, wordToNat_natToWord_2.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      * rewrite positive_nat_N; reflexivity.
      * rewrite <-Npow2_nat, <-positive_N_nat.
(* Goal: lt (N.to_nat (Npos p)) (N.to_nat (Npow2 (S sz))) *)
        apply Nlt_out.
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
        destruct H.
(* Goal: lt (Pos.to_nat p) (Nat.pow (S (S O)) (S sz)) *)
        apply Z.opp_le_mono in H.
(* Goal: lt (Pos.to_nat p) (Nat.pow (S (S O)) (S sz)) *)
        rewrite Pos2Z.opp_neg, Z.opp_involutive in H.
        rewrite <-N2Z.inj_pos, <-N_nat_Z in H.
(* Goal: lt (Pos.to_nat p) (Nat.pow (S (S O)) (S sz)) *)
        apply Nat2Z.inj_le in H.
        rewrite <-Npow2_nat in H.
(* Goal: N.lt (Npos p) (Npow2 (S sz)) *)
        apply Nlt_in.
(* Goal: lt (N.to_nat (Npos p)) (N.to_nat (Npow2 (S sz))) *)
        rewrite Npow2_S, N2Nat.inj_add.
(* Goal: lt (N.to_nat (Npos p)) (Init.Nat.add (N.to_nat (Npow2 sz)) (N.to_nat (Npow2 sz))) *)
        assert (N.to_nat (Npow2 sz) > 0)%nat by (rewrite Npow2_nat; apply pow2_zero).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        omega.
    + exfalso.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
      simpl in H.
(* Goal: False *)
      apply eq_sym, wmsb_false_bound in Heqmsb.
(* Goal: False *)
      rewrite wneg_wordToN in Heqmsb.
      * rewrite Npow2_S in Heqmsb.
        rewrite <-N.add_0_r in Heqmsb.
        rewrite <-N.add_sub_assoc in Heqmsb.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
        { apply N.add_lt_mono_l in Heqmsb.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
          exfalso; eapply N.nlt_0_r; eauto.
        }
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
        { destruct H.
(* Goal: lt (Pos.to_nat p) (Nat.pow (S (S O)) (S sz)) *)
          apply Z.opp_le_mono in H.
(* Goal: lt (Pos.to_nat p) (Nat.pow (S (S O)) (S sz)) *)
          rewrite Pos2Z.opp_neg, Z.opp_involutive in H.
          rewrite <-N2Z.inj_pos, <-N_nat_Z in H.
(* Goal: lt (Pos.to_nat p) (Nat.pow (S (S O)) (S sz)) *)
          apply Nat2Z.inj_le in H.
(* Goal: lt (Pos.to_nat p) (Nat.pow (S (S O)) (S sz)) *)
          rewrite positive_N_nat in H.
          rewrite <-positive_N_nat, <-NToWord_nat.
(* Goal: N.le (@wordToN (S sz) (NToWord (S sz) (Npos p))) (Npow2 sz) *)
          pose proof (wordToN_NToWord (S sz) (N.pos p)).
(* Goal: @eq nat (Nat.modulo (Nat.modulo a (Init.Nat.mul b c)) b) (Nat.modulo a b) *)
          destruct H1 as [k [? ?]]; rewrite H1.
(* Goal: N.le (N.sub (Npos p) (N.mul k (Npow2 (S sz)))) (Npow2 sz) *)
          etransitivity; [apply N.le_sub_l|].
          rewrite <-Npow2_nat in H.
          rewrite <-positive_N_nat in H.
(* Goal: N.le (Npos p) (Npow2 sz) *)
          unfold N.le; rewrite N2Nat.inj_compare.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
          apply nat_compare_le; auto.
        }
      * intro Hx.
(* Goal: False *)
        replace 0%N with (wordToN (wzero (S sz))) in Hx by apply wordToN_wzero.
(* Goal: False *)
        apply wordToN_inj in Hx.
        assert (wordToNat (natToWord (S sz) (Pos.to_nat p)) = 0)
          by (rewrite Hx; apply wordToNat_wzero).
(* Goal: False *)
        rewrite wordToNat_natToWord_2 in H0.
        { clear -H0.
(* Goal: False *)
          induction p; simpl in H0; try discriminate.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
          elim IHp; rewrite Pos2Nat.inj_xO in H0; omega.
        }
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
        { destruct H.
(* Goal: lt (Pos.to_nat p) (Nat.pow (S (S O)) (S sz)) *)
          apply Z.opp_le_mono in H.
(* Goal: lt (Pos.to_nat p) (Nat.pow (S (S O)) (S sz)) *)
          rewrite Pos2Z.opp_neg, Z.opp_involutive in H.
          rewrite <-N2Z.inj_pos, <-N_nat_Z in H.
(* Goal: lt (Pos.to_nat p) (Nat.pow (S (S O)) (S sz)) *)
          apply Nat2Z.inj_le in H.
(* Goal: lt (Pos.to_nat p) (Nat.pow (S (S O)) (S sz)) *)
          rewrite positive_N_nat in H.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
          simpl.
(* Goal: lt (S O) (Nat.add (Nat.pow (S (S O)) sz) (Nat.add (Nat.pow (S (S O)) sz) O)) *)
          pose proof (pow2_zero sz).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
          omega.
        }
Qed.

Lemma wordToZ_ZToWord'': forall (sz: nat),
    (0 < sz)%nat ->
    forall n: Z,
      (- 2 ^ (Z.of_nat sz - 1) <= n < 2 ^ (Z.of_nat sz - 1))%Z ->
      wordToZ (ZToWord sz n) = n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (Z.le (Z.opp (Z.pow (Zpos (xO xH)) (Z.sub (Z.of_nat sz) (Zpos xH)))) (@wordToZ sz w)) (Z.lt (@wordToZ sz w) (Z.pow (Zpos (xO xH)) (Z.sub (Z.of_nat sz) (Zpos xH)))) *)
  destruct sz; [lia|].
(* Goal: @eq Z (@wordToZ (S sz) (ZToWord (S sz) n)) n *)
  apply wordToZ_ZToWord.
  replace (Z.of_nat (S sz) - 1)%Z with (Z.of_nat sz) in * by lia.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) n) (Z.lt n (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  rewrite Nat2Z.inj_pow.
(* Goal: False *)
  assumption.
Qed.

Lemma wordToZ_wordToN:
  forall sz (w: word sz),
    wordToZ w = (Z.of_N (wordToN w) - Z.of_N (if wmsb w false then Npow2 sz else 0))%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wordToZ; intros.
  remember (wmsb w false) as msb; destruct msb;
    [|simpl; rewrite Z.sub_0_r; reflexivity].
  destruct (weq w (wzero _)); subst;
    [rewrite wmsb_wzero in Heqmsb; discriminate|].
(* Goal: @eq Z match @wordToN sz (@wneg sz w) with | N0 => Z0 | Npos x => Zneg x end (Z.sub (Z.of_N (@wordToN sz w)) (Z.of_N (Npow2 sz))) *)
  rewrite wneg_wordToN.
  - pose proof (wordToN_bound w).
    replace (Z.of_N (wordToN w) - Z.of_N (Npow2 sz))%Z
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      with (- (Z.of_N (Npow2 sz) - Z.of_N (wordToN w)))%Z by omega.
    rewrite <-N2Z.inj_sub by (apply N.lt_le_incl; assumption).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    clear; destruct (Npow2 sz - wordToN w)%N; reflexivity.
  - intro Hx; elim n.
    rewrite <-wordToN_wzero with (sz:= sz) in Hx.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    apply wordToN_inj in Hx; auto.
Qed.

Lemma ZToWord_Z_of_N:
  forall sz n,
    ZToWord sz (Z.of_N n) = NToWord sz n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold ZToWord, NToWord; intros.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  destruct n; reflexivity.
Qed.

Lemma ZToWord_Z_of_nat: forall sz x, ZToWord sz (Z.of_nat x) = natToWord sz x.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <- nat_N_Z.
(* Goal: @eq (word sz) (ZToWord sz (Z.of_N (@wordToN sz a))) a *)
  rewrite ZToWord_Z_of_N.
(* Goal: @eq nat (@wordToNat sz (NToWord sz (N.sub (N.of_nat (Nat.pow (S (S O)) sz)) (@wordToN sz a)))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite NToWord_nat.
(* Goal: @eq nat (@wordToNat sz (natToWord sz (Init.Nat.sub (N.to_nat (N.of_nat (Nat.pow (S (S O)) sz))) (@wordToNat sz a)))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite Nnat.Nat2N.id.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma natToWord_Z_to_nat: forall sz n,
    (0 <= n)%Z ->
    natToWord sz (Z.to_nat n) = ZToWord sz n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite <- ZToWord_Z_of_nat.
(* Goal: False *)
  rewrite Z2Nat.id by assumption.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma ZToWord_sz0: forall z, ZToWord 0 z = $0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold ZToWord. destruct z; try rewrite posToWord_sz0; reflexivity.
Qed.

Lemma ZToWord_0: forall sz, ZToWord sz 0 = wzero sz.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold ZToWord. apply wzero'_def.
Qed.

(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
Lemma ZToWord_1{sz : nat}: ZToWord sz 1 = wone sz.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <- natToWord_Z_to_nat by (cbv; discriminate).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma natToWord_pow2_add:
  forall sz n,
    natToWord sz (n + pow2 sz) = natToWord sz n.
Proof.
(* Goal: forall sz n : nat, @eq (word sz) (natToWord sz (Init.Nat.add n (Nat.pow (S (S O)) sz))) (natToWord sz n) *)
  induction sz; intros; [reflexivity|].
(* Goal: @eq (word (S sz)) (natToWord (S sz) (Init.Nat.add n (Nat.pow (S (S O)) (S sz)))) (natToWord (S sz) n) *)
  unfold natToWord, pow2; fold natToWord pow2.
(* Goal: @eq (word (S sz)) (@WS (mod2 (Init.Nat.add n (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz)))) sz (natToWord sz (Nat.div2 (Init.Nat.add n (Nat.mul (S (S O)) (Nat.pow (S (S O)) sz)))))) (@WS (mod2 n) sz (natToWord sz (Nat.div2 n))) *)
  rewrite drop_mod2_add, div2_plus_2, IHsz.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma nat_add_pow2_wzero:
  forall sz n1 n2,
    n1 + n2 = pow2 sz ->
    natToWord sz n1 ^+ natToWord sz n2 = wzero sz.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <-natToWord_plus, H.
(* Goal: @eq (word sz) (natToWord sz (Nat.pow (S (S O)) sz)) (wzero sz) *)
  rewrite natToWord_pow2.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma Npos_Npow2_wzero:
  forall sz p1 p2,
    N.pos (p1 + p2) = Npow2 sz ->
    posToWord sz p1 ^+ posToWord sz p2 = wzero sz.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z (if @wmsb (S sz) (@wneg (S sz) (posToWord (S sz) p)) false then match @wordToN (S sz) (posToWord (S sz) p) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (@wneg (S sz) (posToWord (S sz) p)) with | N0 => Z0 | Npos x => Zpos x end) (Zneg p) *)
  do 2 rewrite posToWord_nat.
  assert (Pos.to_nat p1 + Pos.to_nat p2 = pow2 sz).
  { rewrite <-Pos2Nat.inj_add, <-Npow2_nat.
    rewrite <-positive_N_nat.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    rewrite H; reflexivity.
  }
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply nat_add_pow2_wzero; auto.
Qed.

Lemma ZToWord_Npow2_sub:
  forall sz z,
    ZToWord sz (z - Z.of_N (Npow2 sz)) = ZToWord sz z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold ZToWord; intros.
  remember (z - Z.of_N (Npow2 sz))%Z as zz.
(* Goal: @eq Z (if @wmsb (S sz) match z with | Z0 => wzero' (S sz) | Zpos x => posToWord (S sz) x | Zneg x => @wneg (S sz) (posToWord (S sz) x) end false then match @wordToN (S sz) (@wneg (S sz) match z with | Z0 => wzero' (S sz) | Zpos x => posToWord (S sz) x | Zneg x => @wneg (S sz) (posToWord (S sz) x) end) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) match z with | Z0 => wzero' (S sz) | Zpos x => posToWord (S sz) x | Zneg x => @wneg (S sz) (posToWord (S sz) x) end with | N0 => Z0 | Npos x => Zpos x end) z *)
  destruct z.
  - destruct zz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + assert (Z.of_N (Npow2 sz) = 0)%Z by omega.
      change 0%Z with (Z.of_N 0%N) in H.
      apply N2Z.inj in H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      exfalso; eapply Npow2_not_zero; eauto.
    + pose proof (N2Z.is_nonneg (Npow2 sz)).
      destruct (Z.of_N (Npow2 sz)); simpl in Heqzz, H;
(* Goal: False *)
        try discriminate.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      pose proof (Pos2Z.neg_is_neg p0); omega.
    + assert (Z.of_N (Npow2 sz) = Z.pos p).
      { rewrite Z.sub_0_l, <-Pos2Z.opp_pos in Heqzz.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
        apply Z.opp_inj in Heqzz; auto.
      }
      rewrite <-N2Z.inj_pos in H.
      apply N2Z.inj in H.
      rewrite posToWord_nat, <-positive_N_nat, <-H.
      rewrite Npow2_nat, natToWord_pow2.
      rewrite wzero_wneg.
      apply eq_sym, wzero'_def.

  - destruct zz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + assert (Z.of_N (Npow2 sz) = Z.pos p) by omega.
      rewrite <-N2Z.inj_pos in H.
      apply N2Z.inj in H.
      rewrite posToWord_nat, <-positive_N_nat, <-H.
      rewrite Npow2_nat, natToWord_pow2.
(* Goal: @eq (word sz) (wzero' sz) (wzero sz) *)
      apply wzero'_def.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + assert (Z.pos p = Z.pos p0 + Z.of_N (Npow2 sz))%Z by omega.
      do 2 rewrite <-N2Z.inj_pos in H.
      rewrite <-N2Z.inj_add in H.
      apply N2Z.inj in H.
      apply eq_sym.
      do 2 rewrite posToWord_nat, <-positive_N_nat.
      rewrite H, N2Nat.inj_add, Npow2_nat.
      apply natToWord_pow2_add.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + assert (Z.pos p - Z.neg p0 = Z.of_N (Npow2 sz))%Z by omega.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
      simpl in H.
      remember (Npow2 sz) as n; destruct n;
        [exfalso; eapply Npow2_not_zero; eauto|].
(* Goal: @eq (word sz) w1 w2 *)
      rewrite N2Z.inj_pos in H; inversion H; subst; clear H.
      apply eq_sym, sub_0_eq.
      rewrite wminus_def, wneg_idempotent.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      apply Npos_Npow2_wzero; auto.

  - destruct zz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + assert (Z.neg p = Z.of_N (Npow2 sz))%Z by omega.
      pose proof (N2Z.is_nonneg (Npow2 sz)).
      rewrite <-H in H0.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      pose proof (Pos2Z.neg_is_neg p); omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + assert (Z.neg p = Z.pos p0 + Z.of_N (Npow2 sz))%Z by omega.
      pose proof (N2Z.is_nonneg (Npow2 sz)).
      destruct (Z.of_N (Npow2 sz)); simpl in H;
(* Goal: False *)
        try discriminate.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      pose proof (Pos2Z.neg_is_neg p1); omega.
    + assert (Pos.to_nat p0 = Pos.to_nat p + pow2 sz).
      { rewrite <-Npow2_nat.
        do 2 rewrite <-positive_N_nat.
        rewrite <-N2Nat.inj_add.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
        f_equal.
        pose proof (N2Z.is_nonneg (Npow2 sz)).
(* Goal: @eq Z (if @wmsb (S sz) match z with | Z0 => wzero' (S sz) | Zpos x => posToWord (S sz) x | Zneg x => @wneg (S sz) (posToWord (S sz) x) end false then match @wordToN (S sz) (@wneg (S sz) match z with | Z0 => wzero' (S sz) | Zpos x => posToWord (S sz) x | Zneg x => @wneg (S sz) (posToWord (S sz) x) end) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) match z with | Z0 => wzero' (S sz) | Zpos x => posToWord (S sz) x | Zneg x => @wneg (S sz) (posToWord (S sz) x) end with | N0 => Z0 | Npos x => Zpos x end) z *)
        remember (Z.of_N (Npow2 sz)) as z; destruct z.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
        { change 0%Z with (Z.of_N 0) in Heqz.
          apply N2Z.inj in Heqz.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
          exfalso; eapply Npow2_not_zero; eauto.
        }
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
        { simpl in Heqzz; inversion Heqzz; subst.
          rewrite <-N2Z.inj_pos in Heqz.
          apply N2Z.inj in Heqz.
          rewrite <-Heqz.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
          reflexivity.
        }
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        { pose proof (Zlt_neg_0 p1); omega. }
      }
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
      f_equal.
(* Goal: @eq Z (if @wmsb (S sz) (@wneg (S sz) (posToWord (S sz) p)) false then match @wordToN (S sz) (posToWord (S sz) p) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (@wneg (S sz) (posToWord (S sz) p)) with | N0 => Z0 | Npos x => Zpos x end) (Zneg p) *)
      do 2 rewrite posToWord_nat.
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
      rewrite H.
      apply natToWord_pow2_add.
Qed.

Lemma wplus_wplusZ:
  forall sz (w1 w2: word sz),
    w1 ^+ w2 = wplusZ w1 w2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wplus, wplusZ, wordBin, wordBinZ; intros.
(* Goal: @eq (word sz) (NToWord sz (N.mul (@wordToN sz w1) (@wordToN sz w2))) (ZToWord sz (Z.mul (@wordToZ sz w1) (@wordToZ sz w2))) *)
  do 2 rewrite wordToZ_wordToN.
  match goal with
  | [ |- context[(?z1 - ?z2 + (?z3 - ?z4))%Z] ] =>
    replace (z1 - z2 + (z3 - z4))%Z with (z1 + z3 - z2 - z4)%Z by omega
  end.
  rewrite <-N2Z.inj_add.
(* Goal: @eq (word sz) (NToWord sz (N.add (@wordToN sz w1) (@wordToN sz w2))) (ZToWord sz (Z.sub (Z.sub (Z.of_N (N.add (@wordToN sz w1) (@wordToN sz w2))) (Z.of_N (if @wmsb sz w1 false then Npow2 sz else N0))) (Z.of_N (if @wmsb sz w2 false then Npow2 sz else N0)))) *)
  destruct (wmsb w1 false); destruct (wmsb w2 false).
  - simpl; do 2 rewrite ZToWord_Npow2_sub.
(* Goal: @eq (word sz) (NToWord sz (N.add (@wordToN sz w1) (@wordToN sz w2))) (ZToWord sz (Z.of_N (N.add (@wordToN sz w1) (@wordToN sz w2)))) *)
    apply eq_sym, ZToWord_Z_of_N.
  - simpl; rewrite Z.sub_0_r, ZToWord_Npow2_sub.
(* Goal: @eq (word sz) (NToWord sz (N.add (@wordToN sz w1) (@wordToN sz w2))) (ZToWord sz (Z.of_N (N.add (@wordToN sz w1) (@wordToN sz w2)))) *)
    apply eq_sym, ZToWord_Z_of_N.
  - simpl; rewrite Z.sub_0_r, ZToWord_Npow2_sub.
(* Goal: @eq (word sz) (NToWord sz (N.add (@wordToN sz w1) (@wordToN sz w2))) (ZToWord sz (Z.of_N (N.add (@wordToN sz w1) (@wordToN sz w2)))) *)
    apply eq_sym, ZToWord_Z_of_N.
  - simpl; do 2 rewrite Z.sub_0_r.
(* Goal: @eq (word sz) (NToWord sz (N.add (@wordToN sz w1) (@wordToN sz w2))) (ZToWord sz (Z.of_N (N.add (@wordToN sz w1) (@wordToN sz w2)))) *)
    apply eq_sym, ZToWord_Z_of_N.
Qed.

Lemma ZToWord_Npow2_sub_k : forall (sz : nat) (z : Z) (k: nat),
    ZToWord sz (z - Z.of_nat k * Z.of_N (Npow2 sz)) = ZToWord sz z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. induction k.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  - simpl. f_equal. omega.
  - rewrite <- IHk.
    replace (z - Z.of_nat (S k) * Z.of_N (Npow2 sz))%Z
       with ((z - Z.of_nat k * Z.of_N (Npow2 sz)) - Z.of_N (Npow2 sz))%Z by nia.
(* Goal: @eq (word sz) (ZToWord sz (Z.sub (Z.sub z (Z.mul (Z.of_nat k) (Z.of_N (Npow2 sz)))) (Z.of_N (Npow2 sz)))) (ZToWord sz (Z.sub z (Z.mul (Z.of_nat k) (Z.of_N (Npow2 sz))))) *)
    apply ZToWord_Npow2_sub.
Qed.

Lemma ZToWord_Npow2_add_k : forall (sz : nat) (z : Z) (k: nat),
    ZToWord sz (z + Z.of_nat k * Z.of_N (Npow2 sz)) = ZToWord sz z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  replace z with (z + Z.of_nat k * Z.of_N (Npow2 sz) - Z.of_nat k * Z.of_N (Npow2 sz))%Z at 2
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    by omega.
(* Goal: @eq (word sz) a (NToWord sz (@wordToN sz a)) *)
  symmetry.
(* Goal: @eq (word sz) (ZToWord sz (Z.sub z (Z.mul (Z.of_nat (Pos.to_nat p)) (Z.of_N (Npow2 sz))))) (ZToWord sz z) *)
  apply ZToWord_Npow2_sub_k.
Qed.

Lemma ZToWord_Npow2_sub_z : forall (sz : nat) (z : Z) (k: Z),
    ZToWord sz (z - k * Z.of_N (Npow2 sz)) = ZToWord sz z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. destruct k.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  - simpl. f_equal. omega.
  - rewrite <- positive_nat_Z. apply ZToWord_Npow2_sub_k.
  - rewrite <- Pos2Z.opp_pos.
    replace (z - - Z.pos p * Z.of_N (Npow2 sz))%Z
       with (z +   Z.pos p * Z.of_N (Npow2 sz))%Z by nia.
    rewrite <- positive_nat_Z. apply ZToWord_Npow2_add_k.
Qed.

Lemma ZToWord_Npow2_add_k':  forall sz z k,
    ZToWord sz (z + k * Z.of_N (Npow2 sz)) = ZToWord sz z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. assert (0 <= k \/ k < 0)%Z as C by lia. destruct C as [C | C].
  - pose proof (ZToWord_Npow2_add_k sz z (Z.to_nat k)) as Q.
(* Goal: False *)
    rewrite Znat.Z2Nat.id in Q; assumption.
  - pose proof (ZToWord_Npow2_sub_k sz z (Z.to_nat (- k))) as Q.
(* Goal: @eq (word sz) (ZToWord sz (Z.add z (Z.mul k (Z.of_N (Npow2 sz))))) (ZToWord sz z) *)
    rewrite Znat.Z2Nat.id in Q by lia.
    rewrite <- Q.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
    f_equal.
(* Goal: @eq Z (Z.add z (Z.mul k (Z.of_N (Npow2 sz)))) (Z.sub z (Z.mul (Z.opp k) (Z.of_N (Npow2 sz)))) *)
    lia.
Qed.

Lemma wordToZ_ZToWord': forall sz w,
    exists k, wordToZ (ZToWord sz w) = (w - k * Z.of_N (Npow2 sz))%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (ZToWord sz (Z.add (@wordToZ sz w1) (@wordToZ sz (@wneg sz w2)))) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  destruct sz.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  - simpl. exists w%Z. rewrite ZToWord_sz0. rewrite wordToZ_wzero. omega.
  - exists ((w + Z.of_nat (pow2 sz)) / Z.of_N (Npow2 (S sz)))%Z.
    erewrite <- ZToWord_Npow2_sub_z.
    rewrite wordToZ_ZToWord.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    + reflexivity.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + replace w with ((- Z.of_nat (pow2 sz)) + (w + Z.of_nat (pow2 sz)))%Z at 1 3 by omega.
      rewrite <- Z.add_sub_assoc.
      replace (Z.of_N (Npow2 (S sz))) with (2 * Z.of_nat (pow2 sz))%Z.
      * remember (Z.of_nat (pow2 sz)) as M.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
        assert (M > 0)%Z. {
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
          subst. destruct (pow2 sz) eqn: E.
          - exfalso. eapply pow2_ne_zero. exact E.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
          - simpl. constructor.
        }
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        rewrite <- Zdiv.Zmod_eq_full by omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        pose proof (Zdiv.Z_mod_lt (w + M) (2 * M)). omega.
      * rewrite <- Npow2_nat. rewrite N_nat_Z.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        rewrite Npow2_S. rewrite N2Z.inj_add. omega.
Qed.

Lemma ZToWord_plus: forall sz a b, ZToWord sz (a + b) = ZToWord sz a ^+ ZToWord sz b.
Proof.
(* Goal: not (@eq nat (@wordToNat sz n) O) *)
(* Goal: @eq nat (S (Init.Nat.sub (@wordToNat sz n) (S O))) (@wordToNat sz n) *)
  destruct sz as [|sz]; intros n m; intuition.
(* Goal: @eq (word sz) (@wplus sz w1 (@wneg sz w2)) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  rewrite wplus_wplusZ.
(* Goal: @eq (word sz) (@wplusZ sz w1 (@wneg sz w2)) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  unfold wplusZ, wordBinZ.
(* Goal: @eq (word (S sz)) (ZToWord (S sz) (Z.add n m)) (ZToWord (S sz) (Z.add (@wordToZ (S sz) (ZToWord (S sz) n)) (@wordToZ (S sz) (ZToWord (S sz) m)))) *)
  destruct (wordToZ_ZToWord' (S sz) n) as [k1 D1].
(* Goal: @eq (word (S sz)) (ZToWord (S sz) (Z.add n m)) (ZToWord (S sz) (Z.add (@wordToZ (S sz) (ZToWord (S sz) n)) (@wordToZ (S sz) (ZToWord (S sz) m)))) *)
  destruct (wordToZ_ZToWord' (S sz) m) as [k2 D2].
(* Goal: @eq (word sz) (ZToWord sz (Z.sub a b)) (ZToWord sz (Z.sub (@wordToZ sz (ZToWord sz a)) (@wordToZ sz (ZToWord sz b)))) *)
  rewrite D1.
(* Goal: @eq (word sz) (ZToWord sz (Z.sub a b)) (ZToWord sz (Z.sub (Z.sub a (Z.mul k1 (Z.of_N (Npow2 sz)))) (@wordToZ sz (ZToWord sz b)))) *)
  rewrite D2.
  replace (n - k1 * Z.of_N (Npow2 (S sz)) + (m - k2 * Z.of_N (Npow2 (S sz))))%Z
     with (n + m - (k1 + k2) * Z.of_N (Npow2 (S sz)))%Z by nia.
(* Goal: @eq (word sz) a (NToWord sz (@wordToN sz a)) *)
  symmetry.
(* Goal: @eq (word sz) (ZToWord sz (Z.sub (Z.sub a b) (Z.mul (Z.sub k1 k2) (Z.of_N (Npow2 sz))))) (ZToWord sz (Z.sub a b)) *)
  apply ZToWord_Npow2_sub_z.
Qed.

Lemma wplus_Z:  forall sz (a b : word sz),
    a ^+ b = ZToWord sz (wordToZ a + wordToZ b).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite ZToWord_plus. rewrite! ZToWord_wordToZ. reflexivity.
Qed.

Lemma else_0_to_ex_N: forall (b: bool) (a: N),
    exists k, (if b then a else 0%N) = (k * a)%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. destruct b.
  - exists 1%N. nia.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - exists 0%N. reflexivity.
Qed.

Local Lemma wmultZ_helper: forall a b k1 k2 p,
    ((a - k1 * p) * (b - k2 * p) = a * b - (k1 * b + k2 * a - k1 * k2 * p) * p)%Z.
Proof. intros. nia. Qed.

Lemma wmult_wmultZ: forall (sz : nat) (w1 w2 : word sz), w1 ^* w2 = wmultZ w1 w2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wmultZ, wmult, wordBinZ, wordBin. intros.
(* Goal: @eq (word sz) (NToWord sz (N.mul (@wordToN sz w1) (@wordToN sz w2))) (ZToWord sz (Z.mul (@wordToZ sz w1) (@wordToZ sz w2))) *)
  do 2 rewrite wordToZ_wordToN.
(* Goal: @eq (word sz) (NToWord sz (N.mul (@wordToN sz w1) (@wordToN sz w2))) (ZToWord sz (Z.mul (Z.sub (Z.of_N (@wordToN sz w1)) (Z.of_N (if @wmsb sz w1 false then Npow2 sz else N0))) (Z.sub (Z.of_N (@wordToN sz w2)) (Z.of_N (if @wmsb sz w2 false then Npow2 sz else N0))))) *)
  destruct (else_0_to_ex_N (wmsb w1 false) (Npow2 sz)) as [k1 E1]. rewrite E1. clear E1.
(* Goal: @eq (word sz) (NToWord sz (N.mul (@wordToN sz w1) (@wordToN sz w2))) (ZToWord sz (Z.mul (Z.sub (Z.of_N (@wordToN sz w1)) (Z.of_N (N.mul k1 (Npow2 sz)))) (Z.sub (Z.of_N (@wordToN sz w2)) (Z.of_N (if @wmsb sz w2 false then Npow2 sz else N0))))) *)
  destruct (else_0_to_ex_N (wmsb w2 false) (Npow2 sz)) as [k2 E2]. rewrite E2. clear E2.
(* Goal: @eq (word sz) (NToWord sz (N.mul (@wordToN sz w1) (@wordToN sz w2))) (ZToWord sz (Z.mul (Z.sub (Z.of_N (@wordToN sz w1)) (Z.of_N (N.mul k1 (Npow2 sz)))) (Z.sub (Z.of_N (@wordToN sz w2)) (Z.of_N (N.mul k2 (Npow2 sz)))))) *)
  do 2 rewrite N2Z.inj_mul.
(* Goal: @eq (word sz) (ZToWord sz (Z.mul a b)) (ZToWord sz (Z.mul (Z.sub a (Z.mul k1 (Z.of_N (Npow2 sz)))) (Z.sub b (Z.mul k2 (Z.of_N (Npow2 sz)))))) *)
  rewrite wmultZ_helper.
  rewrite <- N2Z.inj_mul.
(* Goal: @eq (word sz) (NToWord sz (N.mul (@wordToN sz w1) (@wordToN sz w2))) (ZToWord sz (Z.sub (Z.of_N (N.mul (@wordToN sz w1) (@wordToN sz w2))) (Z.mul (Z.sub (Z.add (Z.mul (Z.of_N k1) (Z.of_N (@wordToN sz w2))) (Z.mul (Z.of_N k2) (Z.of_N (@wordToN sz w1)))) (Z.mul (Z.mul (Z.of_N k1) (Z.of_N k2)) (Z.of_N (Npow2 sz)))) (Z.of_N (Npow2 sz))))) *)
  rewrite ZToWord_Npow2_sub_z.
(* Goal: @eq (word sz) (ZToWord sz (Z.of_N (@wordToN sz a))) a *)
  rewrite ZToWord_Z_of_N.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma ZToWord_mult: forall sz a b, ZToWord sz (a * b) = ZToWord sz a ^* ZToWord sz b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite wmult_wmultZ. unfold wmultZ, wordBinZ.
(* Goal: @eq (word sz) (ZToWord sz (Z.sub a b)) (ZToWord sz (Z.sub (@wordToZ sz (ZToWord sz a)) (@wordToZ sz (ZToWord sz b)))) *)
  destruct (wordToZ_ZToWord' sz a) as [k1 D1]. rewrite D1. clear D1.
(* Goal: @eq (word sz) (ZToWord sz (Z.sub a b)) (ZToWord sz (Z.sub (Z.sub a (Z.mul k1 (Z.of_N (Npow2 sz)))) (@wordToZ sz (ZToWord sz b)))) *)
  destruct (wordToZ_ZToWord' sz b) as [k2 D2]. rewrite D2. clear D2.
(* Goal: @eq (word sz) (ZToWord sz (Z.mul a b)) (ZToWord sz (Z.mul (Z.sub a (Z.mul k1 (Z.of_N (Npow2 sz)))) (Z.sub b (Z.mul k2 (Z.of_N (Npow2 sz)))))) *)
  rewrite wmultZ_helper.
(* Goal: @eq (word sz) a (NToWord sz (@wordToN sz a)) *)
  symmetry.
(* Goal: @eq (word sz) (ZToWord sz (Z.sub (Z.sub a b) (Z.mul (Z.sub k1 k2) (Z.of_N (Npow2 sz))))) (ZToWord sz (Z.sub a b)) *)
  apply ZToWord_Npow2_sub_z.
Qed.

Lemma wmult_Z:  forall sz (a b : word sz),
    a ^* b = ZToWord sz (wordToZ a * wordToZ b).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite ZToWord_mult. rewrite! ZToWord_wordToZ. reflexivity.
Qed.

Lemma wordToZ_wplus_bound:
  forall sz (w1 w2: word (S sz)),
    (- Z.of_nat (pow2 sz) <= wordToZ w1 + wordToZ w2 < Z.of_nat (pow2 sz))%Z ->
    (wordToZ w1 + wordToZ w2 = wordToZ (w1 ^+ w2))%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wplus sz w1 (@wneg sz w2)) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  rewrite wplus_wplusZ.
(* Goal: @eq (word sz) (@wplusZ sz w1 (@wneg sz w2)) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  unfold wplusZ, wordBinZ.
  remember (wordToZ w1 + wordToZ w2)%Z as z; clear Heqz.
(* Goal: False *)
  apply eq_sym, wordToZ_ZToWord; assumption.
Qed.

Lemma wordToZ_wplus_bound':
  forall sz (w1 w2: word sz),
    sz <> 0 ->
    (- Z.of_nat (pow2 (pred sz)) <= wordToZ w1 + wordToZ w2 < Z.of_nat (pow2 (pred sz)))%Z ->
    (wordToZ w1 + wordToZ w2 = wordToZ (w1 ^+ w2))%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @ex (word sz) (fun sw : word sz => @eq (word (Init.Nat.add sz n)) w (@sext sz sw n)) *)
  destruct sz; [exfalso; auto|clear H].
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply wordToZ_wplus_bound; auto.
Qed.

Lemma wordToZ_size':
  forall sz (w: word (S sz)),
    (- Z.of_nat (pow2 sz) <= wordToZ w < Z.of_nat (pow2 sz))%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wordToZ; intros.
(* Goal: @eq Z (if msb then match @wordToN (S sz) (natToWord (S sz) (Pos.to_nat p)) with | N0 => Z0 | Npos x => Zneg x end else match @wordToN (S sz) (@wneg (S sz) (natToWord (S sz) (Pos.to_nat p))) with | N0 => Z0 | Npos x => Zpos x end) (Zneg p) *)
  remember (wmsb w false) as msb; destruct msb.
  - destruct (weq w (wpow2 _)).
    + subst; rewrite wpow2_wneg.
(* Goal: @eq Z (Z.mul (Zneg xH) (Z.of_N (Npow2 (S sz)))) (Z.mul (Zpos (xO xH)) (Z.sub (Z.of_N (@wordToN (S sz) (wpow2 sz))) (Z.of_N (Npow2 (S sz))))) *)
      rewrite wpow2_Npow2.
      remember (Npow2 sz) as np.
      destruct np; [exfalso; eapply Npow2_not_zero; eauto|].
(* Goal: and (Z.le Z0 (Z.of_N (@wordToN sz a))) (Z.lt (Z.of_N (@wordToN sz a)) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
      split.
      * rewrite <-Pos2Z.opp_pos, <-N2Z.inj_pos.
        rewrite Heqnp.
        rewrite <-Npow2_nat.
        rewrite N_nat_Z.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
        reflexivity.
      * etransitivity.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
        { apply Pos2Z.neg_is_neg. }
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
        { change 0%Z with (Z.of_nat 0).
          apply Nat2Z.inj_lt.
          apply zero_lt_pow2.
        }
    + assert (wordToN (wneg w) < Npow2 sz)%N.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { apply wmsb_false_bound.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
        eapply wmsb_wneg_true; eauto.
      }
      remember (wordToN (wneg w)) as ww; clear Heqww.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
      destruct ww; simpl.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      * split; try omega.
        change 0%Z with (Z.of_nat 0).
        apply Nat2Z.inj_lt.
        apply zero_lt_pow2.
      * split.
        { rewrite <-Pos2Z.opp_pos, <-N2Z.inj_pos.
          rewrite <-Npow2_nat.
          rewrite N_nat_Z.
          rewrite <-Z.opp_le_mono.
          apply N2Z.inj_le.
          apply N.lt_le_incl.
(* Goal: False *)
          assumption.
        }
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
        { etransitivity.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
          { apply Pos2Z.neg_is_neg. }
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
          { change 0%Z with (Z.of_nat 0).
            apply Nat2Z.inj_lt.
            apply zero_lt_pow2.
          }
        }
  - apply eq_sym, wmsb_false_bound in Heqmsb.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
    destruct (wordToN w); simpl.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    * split; try omega.
      change 0%Z with (Z.of_nat 0).
      apply Nat2Z.inj_lt.
      apply zero_lt_pow2.
    * split.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { etransitivity.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
        { apply Z.opp_nonpos_nonneg.
          change 0%Z with (Z.of_nat 0).
          apply Nat2Z.inj_le.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
          pose proof (zero_lt_pow2 sz); omega.
        }
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        { pose proof (Pos2Z.is_pos p); omega. }
      }
      { rewrite <-N2Z.inj_pos.
        rewrite <-Npow2_nat.
        rewrite N_nat_Z.
(* Goal: N.lt n (Npow2 sz) *)
        apply N2Z.inj_lt.
(* Goal: False *)
        assumption.
      }
Qed.

Lemma wordToZ_size:
  forall sz (w: word (S sz)),
    (Z.abs (wordToZ w) <= Z.of_nat (pow2 sz))%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: Z.le (Z.abs (@wordToZ (S sz) w)) (Z.of_nat (Nat.pow (S (S O)) sz)) *)
  pose proof (wordToZ_size' w).
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
  destruct H.
(* Goal: Z.le (Z.abs (@wordToZ (S sz) w)) (Z.of_nat (Nat.pow (S (S O)) sz)) *)
  apply Z.abs_le.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  split; omega.
Qed.

Lemma wordToZ_size'': forall (sz : nat),
    (0 < sz)%nat ->
    forall  w : word sz,
      (- 2 ^ (Z.of_nat sz - 1) <= wordToZ w < 2 ^ (Z.of_nat sz - 1))%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (Z.le (Z.opp (Z.pow (Zpos (xO xH)) (Z.sub (Z.of_nat sz) (Zpos xH)))) (@wordToZ sz w)) (Z.lt (@wordToZ sz w) (Z.pow (Zpos (xO xH)) (Z.sub (Z.of_nat sz) (Zpos xH)))) *)
  destruct sz; [lia|].
(* Goal: and (Z.le (Z.opp (Z.pow (Zpos (xO xH)) (Z.sub (Z.of_nat (S sz)) (Zpos xH)))) (@wordToZ (S sz) w)) (Z.lt (@wordToZ (S sz) w) (Z.pow (Zpos (xO xH)) (Z.sub (Z.of_nat (S sz)) (Zpos xH)))) *)
  pose proof (@wordToZ_size' sz w) as P.
  replace (Z.of_nat (S sz) - 1)%Z with (Z.of_nat sz) by lia.
(* Goal: and (Z.le (Z.opp (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (@wordToZ (S sz) w)) (Z.lt (@wordToZ (S sz) w) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  rewrite Nat2Z.inj_pow in P.
(* Goal: and (Z.le (Z.opp (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (@wordToZ (S sz) w)) (Z.lt (@wordToZ (S sz) w) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  exact P.
Qed.

Lemma wneg_wzero:
  forall sz (w: word sz), wneg w = wzero sz -> w = wzero sz.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) w (wzero sz) *)
  pose proof (wminus_inv w).
(* Goal: @eq (word sz) w (wzero sz) *)
  rewrite H in H0.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  rewrite wplus_comm, wplus_unit in H0; subst.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wmsb_false_pos:
  forall sz (w: word sz),
    wmsb w false = false <-> (wordToZ w >= 0)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wordToZ; split; intros.
  - rewrite H.
(* Goal: @eq Z (Z.of_nat (N.to_nat (@wordToN sz w))) match @wordToN sz w with | N0 => Z0 | Npos x => Zpos x end *)
    destruct (wordToN w).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + pose proof (Zgt_pos_0 p); omega.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  - remember (wmsb w false) as b; destruct b; auto.
(* Goal: Z.lt match @wordToN sz (@wneg sz w) with | N0 => Z0 | Npos x => Zneg x end Z0 *)
    remember (wordToN (wneg w)) as n; destruct n.
    + replace 0%N with (wordToN (wzero sz)) in Heqn.
      * apply wordToN_inj in Heqn.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
        apply eq_sym, wneg_wzero in Heqn; subst.
(* Goal: False *)
        rewrite wmsb_wzero in Heqb; discriminate.
      * rewrite <-wzero'_def.
(* Goal: @eq N (@wordToN sz (wzero' sz)) N0 *)
        apply wordToN_wzero'.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + exfalso; pose proof (Zlt_neg_0 p); omega.
Qed.

Lemma wmsb_true_neg:
  forall sz (w: word sz),
    wmsb w false = true <-> (wordToZ w < 0)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wordToZ; split; intros.
  - rewrite H.
(* Goal: Z.lt match @wordToN sz (@wneg sz w) with | N0 => Z0 | Npos x => Zneg x end Z0 *)
    remember (wordToN (wneg w)) as n; destruct n.
    + replace 0%N with (wordToN (wzero sz)) in Heqn.
      * apply wordToN_inj in Heqn.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
        apply eq_sym, wneg_wzero in Heqn; subst.
(* Goal: False *)
        rewrite wmsb_wzero in H; discriminate.
      * rewrite <-wzero'_def.
(* Goal: @eq N (@wordToN sz (wzero' sz)) N0 *)
        apply wordToN_wzero'.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + pose proof (Zlt_neg_0 p); omega.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  - remember (wmsb w false) as b; destruct b; auto.
(* Goal: @eq bool false true *)
    remember (wordToN w) as n; destruct n.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + pose proof (Zgt_pos_0 p); omega.
Qed.

Lemma wordToZ_distr_diff_wmsb:
  forall sz (w1 w2: word sz),
    wmsb w1 false = negb (wmsb w2 false) ->
    wordToZ (w1 ^+ w2) = (wordToZ w1 + wordToZ w2)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  destruct sz;
    [rewrite (shatter_word w1), (shatter_word w2); reflexivity|].
(* Goal: @eq Z (@wordToZ (S sz) (@wplus (S sz) w1 w2)) (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2)) *)
  eapply eq_sym, wordToZ_wplus_bound.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2))) (Z.lt (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2)) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  pose proof (wordToZ_size' w1).
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2))) (Z.lt (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2)) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  pose proof (wordToZ_size' w2).
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2))) (Z.lt (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2)) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  remember (wmsb w1 false) as msb1; destruct msb1.
  - apply eq_sym, wmsb_true_neg in Heqmsb1.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2))) (Z.lt (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2)) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
    apply eq_sym, negb_true_iff, wmsb_false_pos in H.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2))) (Z.lt (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2)) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
    destruct H0, H1.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    split; omega.
  - apply eq_sym, wmsb_false_pos in Heqmsb1.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2))) (Z.lt (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2)) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
    apply eq_sym, negb_false_iff, wmsb_true_neg in H.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2))) (Z.lt (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2)) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
    destruct H0, H1.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    split; omega.
Qed.

Lemma sext_wplus_wordToZ_distr:
  forall sz (w1 w2: word sz) n,
    n <> 0 -> wordToZ (sext w1 n ^+ sext w2 n) =
              (wordToZ (sext w1 n) + wordToZ (sext w2 n))%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z (@wordToZ (Init.Nat.add sz n) (@wplus (Init.Nat.add sz n) (@sext sz w1 n) (@sext sz w2 n))) (Z.add (@wordToZ (Init.Nat.add sz n) (@sext sz w1 n)) (@wordToZ (Init.Nat.add sz n) (@sext sz w2 n))) *)
  destruct n; [exfalso; auto|clear H].
(* Goal: @eq Z (@wordToZ (Init.Nat.add sz (S n)) (@wplus (Init.Nat.add sz (S n)) (@sext sz w1 (S n)) (@sext sz w2 (S n)))) (Z.add (@wordToZ (Init.Nat.add sz (S n)) (@sext sz w1 (S n))) (@wordToZ (Init.Nat.add sz (S n)) (@sext sz w2 (S n)))) *)
  apply eq_sym, wordToZ_wplus_bound'; [omega|].

(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) (Init.Nat.pred (Init.Nat.add sz (S n)))))) (Z.add (@wordToZ (Init.Nat.add sz (S n)) (@sext sz w1 (S n))) (@wordToZ (Init.Nat.add sz (S n)) (@sext sz w2 (S n))))) (Z.lt (Z.add (@wordToZ (Init.Nat.add sz (S n)) (@sext sz w1 (S n))) (@wordToZ (Init.Nat.add sz (S n)) (@sext sz w2 (S n)))) (Z.of_nat (Nat.pow (S (S O)) (Init.Nat.pred (Init.Nat.add sz (S n)))))) *)
  do 2 rewrite sext_wordToZ.
(* Goal: @eq (word sz) (ZToWord sz (Z.add (@wordToZ sz w1) (@wordToZ sz (@wneg sz w2)))) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  destruct sz.
  - rewrite (shatter_word w1), (shatter_word w2).
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) (Init.Nat.pred (Init.Nat.add O (S n)))))) (Z.add (@wordToZ O WO) (@wordToZ O WO))) (Z.lt (Z.add (@wordToZ O WO) (@wordToZ O WO)) (Z.of_nat (Nat.pow (S (S O)) (Init.Nat.pred (Init.Nat.add O (S n)))))) *)
    cbn; split; try (pose proof (pow2_zero n); omega).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  - replace (pred (S sz + S n)) with (S (sz + n)) by omega.
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
    pose proof (wordToZ_size' w1); destruct H.
(* Goal: False *)
    pose proof (wordToZ_size' w2); destruct H1.
(* Goal: and (Z.le Z0 (Z.of_N (@wordToN sz a))) (Z.lt (Z.of_N (@wordToN sz a)) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
    split.
    + rewrite pow2_S_z.
(* Goal: Z.le (Z.opp (Z.mul (Zpos (xO xH)) (Z.of_nat (Nat.pow (S (S O)) (Init.Nat.add sz n))))) (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2)) *)
      etransitivity; [|apply Z.add_le_mono; eassumption].
      rewrite <-Z.add_diag, Z.opp_add_distr.
      apply Z.add_le_mono;
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        rewrite <-Z.opp_le_mono; apply Nat2Z.inj_le, pow2_le; omega.
    + rewrite pow2_S_z.
(* Goal: Z.lt (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2)) (Z.mul (Zpos (xO xH)) (Z.of_nat (Nat.pow (S (S O)) (Init.Nat.add sz n)))) *)
      eapply Z.lt_le_trans; [apply Z.add_lt_mono; eassumption|].
      rewrite <-Z.add_diag.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      apply Z.add_le_mono; apply Nat2Z.inj_le, pow2_le; omega.
Qed.

Lemma sext_wplus_wordToZ_distr_existT: (* Note: not axiom free *)
  forall sz (w1 w2: word sz) ssz (sw1 sw2: word ssz) n,
    existT word _ w1 = existT word _ (sext sw1 n) ->
    existT word _ w2 = existT word _ (sext sw2 n) ->
    n <> 0 -> wordToZ (w1 ^+ w2) = (wordToZ w1 + wordToZ w2)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  assert (sz = ssz + n) by (apply eq_sigT_fst in H; auto); subst.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS (orb b (@whd n w2)) n (natToWord n O)) *)
  destruct_existT.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply sext_wplus_wordToZ_distr; auto.
Qed.

Lemma split1_existT: (* Note: not axiom free *)
  forall n sz1 (w1: word (n + sz1)) sz2 (w2: word (n + sz2)),
    existT word _ w1 = existT word _ w2 ->
    split1 n _ w1 = split1 n _ w2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  assert (sz1 = sz2) by (apply eq_sigT_fst in H; omega); subst.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS (orb b (@whd n w2)) n (natToWord n O)) *)
  destruct_existT.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma word_combinable:
  forall sz1 sz2 (w: word (sz1 + sz2)),
  exists w1 w2, w = combine w1 w2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @ex (word sz1) (fun w1 : word sz1 => @ex (word sz2) (fun w2 : word sz2 => @eq (word (Init.Nat.add sz1 sz2)) w (@combine sz1 w1 sz2 w2))) *)
  exists (split1 _ _ w), (split2 _ _ w).
(* Goal: and (Z.le Z0 (Z.of_N (@wordToN sz a))) (Z.lt (Z.of_N (@wordToN sz a)) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  apply eq_sym, combine_split.
Qed.

Lemma split1_combine_existT: (* Note: not axiom free *)
  forall sz n (w: word (n + sz)) sl (wl: word (n + sl)) su (wu: word su),
    existT word _ w = existT word _ (combine wl wu) ->
    split1 n _ w = split1 n _ wl.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word n) (split1 n sz w) (split1 n sl wl) *)
  pose proof (word_combinable _ _ w).
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  destruct H0 as [? [? ?]]; subst.
(* Goal: @eq (word n) (split1 n sz (@combine n x sz x0)) (split1 n sl wl) *)
  pose proof (word_combinable _ _ wl).
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  destruct H0 as [? [? ?]]; subst.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  assert (sz = sl + su) by (apply eq_sigT_fst in H; omega); subst.
(* Goal: @eq (word n) (split1 n (Init.Nat.add sl su) (@combine n x (Init.Nat.add sl su) x0)) (split1 n sl (@combine n x1 sl x2)) *)
  pose proof (word_combinable _ _ x0).
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  destruct H0 as [? [? ?]]; subst.
(* Goal: @eq (word n) (split1 n (Init.Nat.add sl su) (@combine n x (Init.Nat.add sl su) (@combine sl x3 su x4))) (split1 n sl (@combine n x1 sl x2)) *)
  do 2 rewrite split1_combine.
(* Goal: @eq (word n) x x1 *)
  rewrite combine_assoc_existT in H.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS (orb b (@whd n w2)) n (natToWord n O)) *)
  destruct_existT.
  assert (split1 _ _ (split1 _ _ (combine (combine x x3) x4)) =
          split1 _ _ (split1 _ _ (combine (combine x1 x2) wu)))
    by (rewrite H; reflexivity).
(* Goal: @eq (word n) x x1 *)
  repeat rewrite split1_combine in H0.
(* Goal: False *)
  assumption.
Qed.

Lemma extz_pow2_wordToZ:
  forall sz (w: word sz) n,
    wordToZ (extz w n) = (wordToZ w * Z.of_nat (pow2 n))%Z.
Proof.
(* Goal: forall (sz : nat) (w : word sz) (n : nat), @eq Z (@wordToZ (Init.Nat.add n sz) (@extz sz w n)) (Z.mul (@wordToZ sz w) (Z.of_nat (Nat.pow (S (S O)) n))) *)
  induction n; [cbn; omega|].
(* Goal: @eq Z (@wordToZ (Init.Nat.add (S n) sz) (@extz sz w (S n))) (Z.mul (@wordToZ sz w) (Z.of_nat (Nat.pow (S (S O)) (S n)))) *)
  rewrite pow2_S_z.
(* Goal: @eq Z (@wordToZ (Init.Nat.add (S n) sz) (@extz sz w (S n))) (Z.mul (@wordToZ sz w) (Z.mul (Zpos (xO xH)) (Z.of_nat (Nat.pow (S (S O)) n)))) *)
  change (wordToZ (extz w (S n))) with (wordToZ (combine (natToWord n 0) w)~0).
(* Goal: @eq Z (@wordToZ (S (Init.Nat.add n sz)) (@WS false (Init.Nat.add n sz) (@combine n (natToWord n O) sz w))) (Z.mul (@wordToZ sz w) (Z.mul (Zpos (xO xH)) (Z.of_nat (Nat.pow (S (S O)) n)))) *)
  rewrite wordToZ_WS_0.
(* Goal: @eq (word (S (Init.Nat.add n sz))) (@WS false (Init.Nat.add n sz) (@combine n (natToWord n O) sz (@wneg sz w))) (@WS false (Init.Nat.add n sz) (@wneg (Init.Nat.add n sz) (@combine n (natToWord n O) sz w))) *)
  unfold extz, wzero in IHn.
(* Goal: @eq (word (S (Init.Nat.add n sz))) (@WS false (Init.Nat.add n sz) (@combine n (natToWord n O) sz (@wneg sz w))) (@WS false (Init.Nat.add n sz) (@wneg (Init.Nat.add n sz) (@combine n (natToWord n O) sz w))) *)
  rewrite IHn.
(* Goal: @eq Z (Z.mul (Zpos (xO xH)) (Z.mul (@wordToZ sz w) (Z.of_nat (Nat.pow (S (S O)) n)))) (Z.mul (@wordToZ sz w) (Z.mul (Zpos (xO xH)) (Z.of_nat (Nat.pow (S (S O)) n)))) *)
  rewrite Z.mul_assoc.
(* Goal: @eq Z (Z.mul (Z.mul (Zpos (xO xH)) (@wordToZ sz w)) (Z.of_nat (Nat.pow (S (S O)) n))) (Z.mul (@wordToZ sz w) (Z.mul (Zpos (xO xH)) (Z.of_nat (Nat.pow (S (S O)) n)))) *)
  rewrite Z.mul_comm with (n:= 2%Z).
(* Goal: @eq Z (Z.mul (Z.mul (@wordToZ sz w) (Zpos (xO xH))) (Z.of_nat (Nat.pow (S (S O)) n))) (Z.mul (@wordToZ sz w) (Z.mul (Zpos (xO xH)) (Z.of_nat (Nat.pow (S (S O)) n)))) *)
  apply eq_sym, Z.mul_assoc.
Qed.

Lemma extz_wneg:
  forall sz (w: word sz) n,
    extz (wneg w) n = wneg (extz w n).
Proof.
(* Goal: forall (sz : nat) (w : word sz) (n : nat), @eq (word (Init.Nat.add n sz)) (@extz sz (@wneg sz w) n) (@wneg (Init.Nat.add n sz) (@extz sz w n)) *)
  induction n; intros; [reflexivity|].
(* Goal: @eq (word (S (Init.Nat.add d sz))) (@WS false (Init.Nat.add d sz) (@combine d (natToWord d O) sz (@wneg sz (natToWord sz n)))) (@wneg (S (Init.Nat.add d sz)) (@WS false (Init.Nat.add d sz) (natToWord (Init.Nat.add d sz) (Nat.mul (Nat.pow (S (S O)) d) n)))) *)
  cbn; rewrite wneg_WS_0.
(* Goal: @eq (word (S (Init.Nat.add n sz))) (@WS false (Init.Nat.add n sz) (@combine n (natToWord n O) sz (@wneg sz w))) (@WS false (Init.Nat.add n sz) (@wneg (Init.Nat.add n sz) (@combine n (natToWord n O) sz w))) *)
  unfold extz, wzero in IHn.
(* Goal: @eq (word (S (Init.Nat.add n sz))) (@WS false (Init.Nat.add n sz) (@combine n (natToWord n O) sz (@wneg sz w))) (@WS false (Init.Nat.add n sz) (@wneg (Init.Nat.add n sz) (@combine n (natToWord n O) sz w))) *)
  rewrite IHn.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wneg_wordToZ:
  forall sz (w: word (S sz)),
    w <> wpow2 sz ->
    wordToZ (wneg w) = (- wordToZ w)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  assert (wordToZ (wneg w) + wordToZ w = 0)%Z.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
  { destruct (weq w (wzero _)).
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
    { subst; rewrite wzero_wneg, wordToZ_wzero.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
      reflexivity.
    }
    { rewrite <-wordToZ_distr_diff_wmsb.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { rewrite wplus_comm, wminus_inv.
(* Goal: @eq Z (@wordToZ (S sz) (wzero (S sz))) Z0 *)
        apply wordToZ_wzero.
      }
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { remember (wmsb w false) as msb; destruct msb.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
        { eapply wmsb_wneg_true; eauto. }
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
        { eapply wmsb_wneg_false; eauto.
(* Goal: not (@eq nat (@wordToNat (S sz) w) O) *)
          intro Hx; elim n.
(* Goal: @eq (word sz) (@wlshift sz (natToWord sz O) n) (natToWord sz O) *)
          apply wordToNat_inj.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
          rewrite wordToNat_wzero, Hx; reflexivity.
        }
      }
    }
  }
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wneg_wordToZ':
  forall sz (w: word (S sz)) z,
    w <> wpow2 sz ->
    (z + wordToZ (wneg w))%Z = (z - wordToZ w)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: False *)
  rewrite wneg_wordToZ by assumption.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wneg_wplus_distr:
  forall sz (w1 w2: word sz),
    wneg (w1 ^+ w2) = wneg w1 ^+ wneg w2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  apply wplus_cancel with (c:= w1 ^+ w2).
(* Goal: @eq (word sz) (@wplus sz (@wneg sz (@wplus sz w1 w2)) (@wplus sz w1 w2)) (@wplus sz (@wplus sz (@wneg sz w1) (@wneg sz w2)) (@wplus sz w1 w2)) *)
  rewrite wplus_comm, wminus_inv.
(* Goal: @eq (word sz) (wzero sz) (@wplus sz (@wplus sz (@wneg sz w1) (@wneg sz w2)) (@wplus sz w1 w2)) *)
  rewrite wplus_comm, wplus_assoc.
  rewrite <-wplus_assoc with (x:= w1).
(* Goal: @eq (word sz) (wzero sz) (@wplus sz (@wplus sz w1 (@wplus sz w2 (@wneg sz w1))) (@wneg sz w2)) *)
  rewrite wplus_comm with (x:= w2).
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) y2)) y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wplus_assoc.
(* Goal: @eq (word sz) (@wplus sz c (@wplus sz b (@wneg sz b))) c *)
  rewrite wminus_inv.
(* Goal: @eq (word sz) (wzero sz) (@wplus sz (@wplus sz (wzero sz) w2) (@wneg sz w2)) *)
  rewrite wplus_wzero_2.
(* Goal: @eq (word sz) (@wplus sz c (@wplus sz b (@wneg sz b))) c *)
  rewrite wminus_inv.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wminus_wneg:
  forall sz (w1 w2: word sz),
    wneg (w1 ^- w2) = w2 ^- w1.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wminus; intros.
(* Goal: @eq (word sz) (@wneg sz (@wplus sz w1 (@wneg sz w2))) (@wplus sz w2 (@wneg sz w1)) *)
  rewrite wneg_wplus_distr.
(* Goal: @eq (word sz) (@wplus sz (@wneg sz w1) (@wneg sz (@wneg sz w2))) (@wplus sz w2 (@wneg sz w1)) *)
  rewrite wneg_idempotent.
(* Goal: @eq (word sz) (@wplus sz (@wneg sz w1) w2) (@wplus sz w2 (@wneg sz w1)) *)
  apply wplus_comm.
Qed.

Lemma wminus_wordToZ:
  forall sz (w1 w2: word (S sz)),
    w2 ^- w1 <> wpow2 sz ->
    wordToZ (w1 ^- w2) = (- wordToZ (w2 ^- w1))%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <-wneg_idempotent with (w:= w1 ^- w2).
(* Goal: @eq Z (@wordToZ (S sz) (@wneg (S sz) (@wneg (S sz) (@wminus (S sz) w1 w2)))) (Z.opp (@wordToZ (S sz) (@wminus (S sz) w2 w1))) *)
  rewrite wminus_wneg.
(* Goal: False *)
  rewrite wneg_wordToZ by assumption.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wminus_wordToZ':
  forall sz (w1 w2: word (sz + 1)),
    existT word _ (w2 ^- w1) <> existT word _ (wpow2 sz) ->
    wordToZ (w1 ^- w2) = (- wordToZ (w2 ^- w1))%Z.
Proof.
(* Goal: forall (sz : nat) (w1 w2 : word (Init.Nat.add sz (S O))) (_ : not (@eq (@sigT nat word) (@existT nat word (Init.Nat.add sz (S O)) (@wminus (Init.Nat.add sz (S O)) w2 w1)) (@existT nat word (S sz) (wpow2 sz)))), @eq Z (@wordToZ (Init.Nat.add sz (S O)) (@wminus (Init.Nat.add sz (S O)) w1 w2)) (Z.opp (@wordToZ (Init.Nat.add sz (S O)) (@wminus (Init.Nat.add sz (S O)) w2 w1))) *)
  intro sz.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (sz + 1) with (S sz) by omega.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z (@wordToZ (S sz) (@wminus (S sz) w1 w2)) (Z.opp (@wordToZ (S sz) (@wminus (S sz) w2 w1))) *)
  apply wminus_wordToZ.
(* Goal: @eq nat O (@wordToNat sz (@wminus sz w (natToWord sz (S O)))) *)
  intro Hx; elim H.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite Hx; reflexivity.
Qed.

Lemma wminus_wminusZ: forall (sz : nat) (w1 w2 : word sz), w1 ^- w2 = wminusZ w1 w2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wminusZ, wminus, wordBinZ. intros. rewrite <- Z.add_opp_r.
(* Goal: @eq (word sz) (@wplus sz w1 (@wneg sz w2)) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  rewrite wplus_wplusZ. unfold wplusZ, wordBinZ.
(* Goal: @eq (word sz) (ZToWord sz (Z.add (@wordToZ sz w1) (@wordToZ sz (@wneg sz w2)))) (ZToWord sz (Z.add (@wordToZ sz w1) (Z.opp (@wordToZ sz w2)))) *)
  destruct sz.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - do 2 rewrite ZToWord_sz0. reflexivity.
  - destruct (weq w2 (wpow2 sz)).
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
    + subst. rewrite wpow2_wneg.
      replace (wordToZ w1 + - wordToZ (wpow2 sz))%Z
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
         with (wordToZ w1 + wordToZ (wpow2 sz) - 2 * wordToZ (wpow2 sz))%Z by omega.
      replace (2 * wordToZ (wpow2 sz))%Z with (- 1 * Z.of_N (Npow2 (S sz)))%Z.
(* Goal: @eq (word sz) a (NToWord sz (@wordToN sz a)) *)
      * symmetry. apply ZToWord_Npow2_sub_z.
      * rewrite wordToZ_wordToN.
(* Goal: @eq Z (Z.mul (Zneg xH) (Z.of_N (Npow2 (S sz)))) (Z.mul (Zpos (xO xH)) (Z.sub (Z.of_N (@wordToN (S sz) (wpow2 sz))) (Z.of_N (if @wmsb (S sz) (wpow2 sz) false then Npow2 (S sz) else N0)))) *)
        rewrite wpow2_wmsb.
(* Goal: @eq Z (Z.mul (Zneg xH) (Z.of_N (Npow2 (S sz)))) (Z.mul (Zpos (xO xH)) (Z.sub (Z.of_N (@wordToN (S sz) (wpow2 sz))) (Z.of_N (Npow2 (S sz))))) *)
        rewrite wpow2_Npow2.
(* Goal: @eq Z (Z.mul (Zneg xH) (Z.of_N (Npow2 (S sz)))) (Z.mul (Zpos (xO xH)) (Z.sub (Z.of_N (Npow2 sz)) (Z.of_N (Npow2 (S sz))))) *)
        rewrite Npow2_S.
(* Goal: @eq Z (Z.mul (Zneg xH) (Z.of_N (N.add (Npow2 sz) (Npow2 sz)))) (Z.mul (Zpos (xO xH)) (Z.sub (Z.of_N (Npow2 sz)) (Z.of_N (N.add (Npow2 sz) (Npow2 sz))))) *)
        rewrite N2Z.inj_add.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        omega.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    + rewrite wneg_wordToZ by assumption. reflexivity.
Qed.

Local Lemma wminusZ_helper: forall a b k1 k2 p,
    ((a - k1 * p) - (b - k2 * p) = a - b - (k1 - k2) * p)%Z.
Proof. intros. nia. Qed.

Lemma ZToWord_minus: forall sz a b, ZToWord sz (a - b) = ZToWord sz a ^- ZToWord sz b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite wminus_wminusZ. unfold wminusZ, wordBinZ.
(* Goal: @eq (word sz) (ZToWord sz (Z.sub a b)) (ZToWord sz (Z.sub (@wordToZ sz (ZToWord sz a)) (@wordToZ sz (ZToWord sz b)))) *)
  destruct (wordToZ_ZToWord' sz a) as [k1 D1]. rewrite D1. clear D1.
(* Goal: @eq (word sz) (ZToWord sz (Z.sub a b)) (ZToWord sz (Z.sub (Z.sub a (Z.mul k1 (Z.of_N (Npow2 sz)))) (@wordToZ sz (ZToWord sz b)))) *)
  destruct (wordToZ_ZToWord' sz b) as [k2 D2]. rewrite D2. clear D2.
(* Goal: @eq (word sz) (ZToWord sz (Z.sub a b)) (ZToWord sz (Z.sub (Z.sub a (Z.mul k1 (Z.of_N (Npow2 sz)))) (Z.sub b (Z.mul k2 (Z.of_N (Npow2 sz)))))) *)
  rewrite wminusZ_helper.
(* Goal: @eq (word sz) a (NToWord sz (@wordToN sz a)) *)
  symmetry.
(* Goal: @eq (word sz) (ZToWord sz (Z.sub (Z.sub a b) (Z.mul (Z.sub k1 k2) (Z.of_N (Npow2 sz))))) (ZToWord sz (Z.sub a b)) *)
  apply ZToWord_Npow2_sub_z.
Qed.

Lemma wminus_Z: forall sz (a b : word sz),
    a ^- b = ZToWord sz (wordToZ a - wordToZ b).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite ZToWord_minus. rewrite! ZToWord_wordToZ. reflexivity.
Qed.

(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
Lemma ZToWord_opp_wneg{sz: nat}: forall (x: Z),
    ZToWord sz (- x) = ^~ (ZToWord sz x).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (@wneg sz (ZToWord sz x)) *)
  rewrite wneg_0_wminus.
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (@wminus sz (natToWord sz O) (ZToWord sz x)) *)
  rewrite wminus_wminusZ.
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (@wminusZ sz (natToWord sz O) (ZToWord sz x)) *)
  unfold wminusZ, wordBinZ.
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (ZToWord sz (Z.sub (@wordToZ sz (natToWord sz O)) (@wordToZ sz (ZToWord sz x)))) *)
  rewrite wordToZ_wzero.
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (ZToWord sz (Z.sub Z0 (@wordToZ sz (ZToWord sz x)))) *)
  rewrite (Z.sub_0_l (wordToZ (ZToWord sz x))).
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (ZToWord sz (Z.opp (@wordToZ sz (ZToWord sz x)))) *)
  destruct (wordToZ_ZToWord' sz x) as [k E].
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (ZToWord sz (Z.opp (@wordToZ sz (ZToWord sz x)))) *)
  rewrite E.
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (ZToWord sz (Z.opp (Z.sub x (Z.mul k (Z.of_N (Npow2 sz)))))) *)
  rewrite Z.opp_sub_distr.
(* Goal: @eq (word sz) (ZToWord sz (Z.opp x)) (ZToWord sz (Z.add (Z.opp x) (Z.mul k (Z.of_N (Npow2 sz))))) *)
  rewrite ZToWord_Npow2_add_k'.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
Lemma Zeqb_true_ZToWord: forall {sz: nat} (x y: Z),
    (x =? y)%Z = true ->
    ZToWord sz x = ZToWord sz y.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. apply Z.eqb_eq in H. congruence.
Qed.

Lemma word_ring_theory_Z: forall (sz: nat),
    ring_theory (ZToWord sz 0) (ZToWord sz 1)
                (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz) eq.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @ring_theory (word sz) (ZToWord sz Z0) (ZToWord sz (Zpos xH)) (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz) (@eq (word sz)) *)
  rewrite ZToWord_0.
(* Goal: @ring_theory (word sz) (wzero sz) (ZToWord sz (Zpos xH)) (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz) (@eq (word sz)) *)
  rewrite ZToWord_1.
(* Goal: @ring_theory (word sz) (wzero sz) (wone sz) (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz) (@eq (word sz)) *)
  apply wring.
Qed.

Lemma word_ring_morph_Z: forall (sz: nat),
    ring_morph (ZToWord sz 0) (ZToWord sz 1) (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz)
               eq 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Z.eqb
               (ZToWord sz).
Proof.
(* Goal: forall sz : nat, @ring_morph (word sz) (ZToWord sz Z0) (ZToWord sz (Zpos xH)) (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz) (@eq (word sz)) Z Z0 (Zpos xH) Z.add Z.mul Z.sub Z.opp Z.eqb (ZToWord sz) *)
  constructor.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  + reflexivity.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  + reflexivity.
  + exact (@ZToWord_plus sz).
  + exact (@ZToWord_minus sz).
  + exact (@ZToWord_mult sz).
  + exact (@ZToWord_opp_wneg sz).
  + exact (@Zeqb_true_ZToWord sz).
Qed.

Lemma extz_zero:
  forall sz n, extz (natToWord sz 0) n = wzero _.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wzero; intros.
(* Goal: @eq (word (Init.Nat.add n sz)) (@extz sz (natToWord sz O) n) (natToWord (Init.Nat.add n sz) O) *)
  rewrite extz_combine.
(* Goal: @eq (word (Init.Nat.add n sz)) (@combine n (natToWord n O) sz (natToWord sz O)) (natToWord (Init.Nat.add n sz) O) *)
  apply combine_zero.
Qed.

Lemma sext_eq_rect:
  forall sz (w: word sz) n nsz Hsz1,
  exists Hsz2,
    eq_rect (sz + n) word (sext w n) (nsz + n) Hsz1 =
    sext (eq_rect sz word w nsz Hsz2) n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (Hsz: sz = nsz) by omega.
(* Goal: @ex (@eq nat sz nsz) (fun Hsz2 : @eq nat sz nsz => @eq (word (Init.Nat.add nsz n)) (@eq_rect nat (Init.Nat.add sz n) word (@sext sz w n) (Init.Nat.add nsz n) Hsz1) (@sext nsz (@eq_rect nat sz word w nsz Hsz2) n)) *)
  exists Hsz.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  subst; simpl.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  eq_rect_simpl.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wmsb_sext:
  forall sz (w: word sz) n,
    wmsb (sext w n) false = wmsb w false.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold sext; intros.
(* Goal: @eq (word sz) match match ww with | N0 => Z0 | Npos x => Zpos x end with | Z0 => wzero' sz | Zpos x => posToWord sz x | Zneg x => @wneg sz (posToWord sz x) end w *)
  remember (wmsb w false) as ww; destruct ww.
  - destruct n; cbn.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    + rewrite wmsb_combine_WO; auto.
    + rewrite wmsb_combine with (b2:= false) by discriminate; cbn.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      clear; induction n; cbn; auto.
  - destruct n; cbn.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    + rewrite wmsb_combine_WO; auto.
    + rewrite wmsb_combine with (b2:= false) by discriminate; cbn.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      clear; induction n; cbn; auto.
Qed.

Lemma wmsb_wlshift_sext: (* Note: not axiom free *)
  forall sz (w: word sz) n,
    wmsb (sext w n) false = wmsb (wlshift (sext w n) n) false.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq bool (@wmsb (Init.Nat.add sz n) (@sext sz w n) false) (@wmsb (Init.Nat.add sz n) (@wlshift (Init.Nat.add sz n) (@sext sz w n) n) false) *)
  pose proof (wlshift_sext_extz w n).
(* Goal: @eq bool (@wmsb (Init.Nat.add sz n) (@sext sz w n) false) (@wmsb (Init.Nat.add sz n) (@wlshift (Init.Nat.add sz n) (@sext sz w n) n) false) *)
  apply wmsb_existT with (b:= false) in H.
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
  rewrite H.
(* Goal: @eq bool (@wmsb (Init.Nat.add sz n) (@sext sz w n) false) (@wmsb (Init.Nat.add n sz) (@extz sz w n) false) *)
  rewrite wmsb_sext.
(* Goal: @eq bool (@wmsb sz w false) (@wmsb (Init.Nat.add n sz) (@extz sz w n) false) *)
  rewrite wmsb_extz.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wordToZ_wordToNat_pos:
  forall sz (w: word sz),
    wmsb w false = false ->
    Z.of_nat (wordToNat w) = wordToZ w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold wordToZ; intros.
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
  rewrite H.
  rewrite <-wordToN_to_nat.
(* Goal: @eq Z (Z.of_nat (N.to_nat (@wordToN sz w))) match @wordToN sz w with | N0 => Z0 | Npos x => Zpos x end *)
  destruct (wordToN w).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - reflexivity.
  - simpl; apply positive_nat_Z.
Qed.

Corollary wmsb_Zabs_pos:
  forall sz (w: word sz),
    wmsb w false = false -> Z.abs (wordToZ w) = wordToZ w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z (Z.abs (@wordToZ sz w)) (@wordToZ sz w) *)
  apply wmsb_false_pos in H.
(* Goal: @eq Z (Z.abs (@wordToZ sz w)) (Z.opp (@wordToZ sz w)) *)
  unfold Z.abs.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct (wordToZ w); auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pose proof (Zlt_neg_0 p); omega.
Qed.

Corollary wmsb_Zabs_neg:
  forall sz (w: word sz),
    wmsb w false = true -> (Z.abs (wordToZ w) = - wordToZ w)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z (Z.abs (@wordToZ sz w)) (Z.opp (@wordToZ sz w)) *)
  apply wmsb_true_neg in H.
(* Goal: @eq Z (Z.abs (@wordToZ sz w)) (Z.opp (@wordToZ sz w)) *)
  unfold Z.abs.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct (wordToZ w); auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pose proof (Zgt_pos_0 p); omega.
Qed.

Lemma wordToN_combine:
  forall sz1 (w1: word sz1) sz2 (w2: word sz2),
    wordToN (combine w1 w2) = (wordToN w1 + Npow2 sz1 * wordToN w2)%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq N N0 (@wordToN sz (wzero sz)) *)
  repeat rewrite wordToN_nat.
(* Goal: @eq nat (@wordToNat sz (NToWord sz (N.sub (Npow2 sz) (@wordToN sz a)))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite pow2_N.
  rewrite <-Nat2N.inj_mul, <-Nat2N.inj_add.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  rewrite wordToNat_combine; reflexivity.
Qed.

Lemma word_exists_bound:
  forall sz z,
    (- Z.of_nat (pow2 sz) <= z < Z.of_nat (pow2 sz))%Z ->
    exists w: word (S sz), wordToZ w = z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @ex (word (S sz)) (fun w : word (S sz) => @eq Z (@wordToZ (S sz) w) z) *)
  exists (ZToWord (S sz) z).
(* Goal: False *)
  apply wordToZ_ZToWord; assumption.
Qed.

Lemma sext_size:
  forall sz n (w: word (sz + n)),
    sz <> 0 ->
    (- Z.of_nat (pow2 (sz - 1)) <= wordToZ w < Z.of_nat (pow2 (sz - 1)))%Z ->
    exists sw, w = sext sw n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @ex (word sz) (fun sw : word sz => @eq (word (Init.Nat.add sz n)) w (@sext sz sw n)) *)
  destruct sz; [exfalso; auto|clear H].
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  simpl in *.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (sz - 0) with sz in H0 by omega.
(* Goal: @ex (word (S sz)) (fun sw : word (S sz) => @eq (word (S (Init.Nat.add sz n))) w (@sext (S sz) sw n)) *)
  apply word_exists_bound in H0.
(* Goal: @ex (word (S sz)) (fun sw : word (S sz) => @eq (word (S (Init.Nat.add sz n))) w (@sext (S sz) sw n)) *)
  destruct H0 as [sw ?].
(* Goal: @ex (word (S sz)) (fun sw : word (S sz) => @eq (word (S (Init.Nat.add sz n))) w (@sext (S sz) sw n)) *)
  exists sw.
(* Goal: @eq (word (Init.Nat.add sz O)) (@combine sz w O WO) (@eq_rect nat sz word w (Nat.add sz O) (Nat.add_comm O sz)) *)
  apply wordToZ_inj.
  change (S (sz + n)) with (S sz + n).
(* Goal: @eq Z (@wordToZ (Init.Nat.add (S sz) n) w) (@wordToZ (Init.Nat.add (S sz) n) (@sext (S sz) sw n)) *)
  rewrite sext_wordToZ.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma wordToZ_combine_WO:
  forall sz (w: word sz),
    wordToZ (combine w WO) = wordToZ w.
Proof.
(* Goal: forall (sz : nat) (w : word sz), @eq Z (@wordToZ (Init.Nat.add sz O) (@combine sz w O WO)) (@wordToZ sz w) *)
  dependent induction w; [reflexivity|].
(* Goal: gt (if b then S (Init.Nat.mul (@wordToNat n w) (S (S O))) else Init.Nat.mul (@wordToNat n w) (S (S O))) O *)
  simpl; destruct b.
  - destruct n; [rewrite (shatter_word w); reflexivity|].
    change (S n + 0) with (S (n + 0)) in *.
(* Goal: @eq Z (@wordToZ (S (S sz)) (@WS true (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)))) (Z.add match @wordToZ (S sz) (@wplus (S sz) w1 (@wneg (S sz) w2)) with | Z0 => Z0 | Zpos y' => Zpos (xO y') | Zneg y' => Zneg (xO y') end (Zpos xH)) *)
    do 2 rewrite wordToZ_WS_1.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    rewrite IHw; reflexivity.
  - do 2 rewrite wordToZ_WS_0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    rewrite IHw; reflexivity.
Qed.

Lemma combine_WO:
  forall sz (w: word sz),
    combine w WO = eq_rect _ word w _ (Nat.add_comm 0 sz).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz O)) (@combine sz w O WO) (@eq_rect nat sz word w (Nat.add sz O) (Nat.add_comm O sz)) *)
  apply wordToZ_inj.
(* Goal: @eq Z (@wordToZ (Init.Nat.add sz O) (@combine sz w O WO)) (@wordToZ (Init.Nat.add sz O) (@eq_rect nat sz word w (Nat.add sz O) (Nat.add_comm O sz))) *)
  rewrite wordToZ_eq_rect.
(* Goal: @eq Z (@wordToZ (Init.Nat.add sz O) (@combine sz w O WO)) (@wordToZ sz w) *)
  apply wordToZ_combine_WO.
Qed.

Lemma zext_zero:
  forall sz (w: word sz),
    zext w 0 = eq_rect _ word w _ (Nat.add_comm 0 sz).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  unfold zext; intros.
(* Goal: @eq (word (Init.Nat.add sz O)) (@combine sz w O (wzero O)) (@eq_rect nat sz word w (Nat.add sz O) (Nat.add_comm O sz)) *)
  apply combine_WO.
Qed.

Lemma wmsb_false_wordToNat_eq:
  forall sz (w: word (S sz)),
    wmsb w false = false ->
    wordToNat w = wordToNat (split1 sz _ (eq_rect _ word w _ (Nat.add_comm 1 sz))).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (@wordToNat (S sz) w) (@wordToNat sz (split1 sz (S O) (@eq_rect nat (S sz) word w (Nat.add sz (S O)) (Nat.add_comm (S O) sz)))) *)
  remember (eq_rect _ word w _ (Nat.add_comm 1 sz)) as ww.
  assert (wmsb ww false = false) by (subst; rewrite <-wmsb_eq_rect; assumption).
(* Goal: @eq nat (@wordToNat (S sz) w) (@wordToNat sz (split1 sz (S O) ww)) *)
  replace (wordToNat w) with (wordToNat ww) by (subst; rewrite wordToNat_eq_rect; reflexivity).
(* Goal: @eq nat (@wordToNat (Nat.add sz (S O)) ww) (@wordToNat sz (split1 sz (S O) ww)) *)
  clear Heqww H w.
(* Goal: @eq nat (@wordToNat (Nat.add sz (S O)) ww) (@wordToNat sz (split1 sz (S O) ww)) *)
  apply wmsb_false_split2_wzero in H0.
  rewrite <-combine_split with (w:= ww) at 1.
(* Goal: @eq nat (@wordToNat (Nat.add sz (S O)) (@combine sz (split1 sz (S O) ww) (S O) (split2 sz (S O) ww))) (@wordToNat sz (split1 sz (S O) ww)) *)
  rewrite wordToNat_combine.
  rewrite <-H0.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  cbn; omega.
Qed.

Lemma wordToZ_bound_weakened:
  forall z n, (Z.abs z < n)%Z -> (- n <= z < n)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (Z.le (Z.opp n) z) (Z.lt z n) *)
  apply Z.abs_lt in H.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma zext_size:
  forall sz n (w: word (sz + n)),
    (- Z.of_nat (pow2 sz) <= wordToZ w < Z.of_nat (pow2 sz))%Z ->
    wmsb w false = false ->
    exists sw, w = zext sw n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  destruct n.
  - exists (eq_rect _ word w _ (Nat.add_comm _ _)).
    rewrite zext_zero.
    apply eq_sym, eq_rect_2.
  - apply word_exists_bound in H.
    destruct H as [ssw ?].
    assert (wmsb ssw false = false).
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
    { apply wmsb_false_pos; apply wmsb_false_pos in H0.
(* Goal: False *)
      rewrite H; assumption.
    }
    eexists.
(* Goal: @eq (word (Init.Nat.add sz O)) (@combine sz w O WO) (@eq_rect nat sz word w (Nat.add sz O) (Nat.add_comm O sz)) *)
    apply wordToZ_inj.
(* Goal: False *)
    rewrite zext_wordToNat_equal_Z by discriminate.
    rewrite <-H.
    rewrite <-wordToZ_wordToNat_pos by assumption.
(* Goal: False *)
    rewrite wmsb_false_wordToNat_eq by assumption.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
Qed.

Lemma zext_size_1: (* Note: not axiom free *)
  forall sz (w: word (sz + 1)),
    wmsb w false = false ->
    exists sw, w = zext sw 1.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply zext_size; auto.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (Init.Nat.add sz (S O)) w)) (Z.lt (@wordToZ (Init.Nat.add sz (S O)) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  generalize dependent w.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  replace (sz + 1) with (S sz) by omega.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (@wordToZ (S sz) w)) (Z.lt (@wordToZ (S sz) w) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  unfold wordToZ.
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
  rewrite H.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) match @wordToN (S sz) w with | N0 => Z0 | Npos x => Zpos x end) (Z.lt match @wordToN (S sz) w with | N0 => Z0 | Npos x => Zpos x end (Z.of_nat (Nat.pow (S (S O)) sz))) *)
  apply wmsb_false_bound in H.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  remember (wordToN w) as n; destruct n; simpl.
  - split.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + pose proof (pow2_zero sz); omega.
  - rewrite <-N2Z.inj_pos.
    rewrite <-N_nat_Z.
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (Z.of_nat (N.to_nat (Npos p)))) (Z.lt (Z.of_nat (N.to_nat (Npos p))) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
    split; [omega|].
(* Goal: Z.lt (Z.of_nat (N.to_nat (Npos p))) (Z.of_nat (Nat.pow (S (S O)) sz)) *)
    apply inj_lt.
    rewrite <-Npow2_nat.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    apply Nlt_out; auto.
Qed.

Lemma sext_wplus_exist:
  forall sz (w1 w2: word sz) n,
  exists w: word (S sz),
    existT word _ (sext w1 (S n) ^+ sext w2 (S n)) =
    existT word _ (sext w n).
Proof.
  intros; eexists.
  apply wordToZ_existT; [omega|].
(* Goal: False *)
  rewrite sext_wplus_wordToZ_distr by discriminate.
(* Goal: @eq Z (@wordToZ (Init.Nat.add (S sz) n) w) (@wordToZ (Init.Nat.add (S sz) n) (@sext (S sz) sw n)) *)
  do 3 rewrite sext_wordToZ.
  assert (- Z.of_nat (pow2 sz) <= wordToZ w1 + wordToZ w2 < Z.of_nat (pow2 sz))%Z.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
  { clear n.
    dependent destruction w1.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    { rewrite (shatter_word w2); cbn; omega. }
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
    { remember (WS b w1) as ww1; clear Heqww1 w1 b.
      pose proof (wordToZ_size' ww1).
(* Goal: and (Z.le (Z.opp (Z.of_nat (Nat.pow (S (S O)) sz))) (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2))) (Z.lt (Z.add (@wordToZ (S sz) w1) (@wordToZ (S sz) w2)) (Z.of_nat (Nat.pow (S (S O)) sz))) *)
      pose proof (wordToZ_size' w2).
      destruct H, H0.
(* Goal: and (Z.le Z0 (Z.of_N (@wordToN sz a))) (Z.lt (Z.of_N (@wordToN sz a)) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
      split.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      { simpl; do 2 rewrite Nat2Z.inj_add; omega. }
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      { simpl; do 2 rewrite Nat2Z.inj_add; omega. }
    }
  }
  apply wordToZ_ZToWord in H.
  rewrite <-H.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

(* Don't allow simpl to expand out these functions *)
Arguments natToWord : simpl never.
Arguments weq : simpl never.

(* Making wlt_dec opaque is necessary to prevent the [exact H] in the
 * example below from blowing up..
 *)
Global Opaque wlt_dec.
Definition test_wlt_f (a : nat) (b : nat) : nat :=
  if wlt_dec (natToWord 64 a) $0 then 0 else 0.
Theorem test_wlt_f_example: forall x y z, test_wlt_f x y = 0 -> test_wlt_f x z = 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (test_wlt_f x z) O *)
  exact H.
Qed.

Lemma wordToNat_eq1: forall sz (a b: word sz), a = b -> wordToNat a = wordToNat b.
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  intros; subst; reflexivity.
Qed.

Lemma wordToNat_eq2: forall sz (a b: word sz), wordToNat a = wordToNat b -> a = b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <- natToWord_wordToNat with (w := a).
  rewrite <- natToWord_wordToNat with (w := b).
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
  rewrite H.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wordToNat_lt1: forall sz (a b: word sz), a < b -> (wordToNat a < wordToNat b)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_nomega.
(* Goal: ge (@wordToNat sz a) (@wordToNat sz b) *)
  repeat rewrite wordToN_to_nat in H.
(* Goal: False *)
  assumption.
Qed.

Lemma wordToNat_lt2: forall sz (a b: word sz), (wordToNat a < wordToNat b)%nat -> a < b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_nomega.
(* Goal: ge (N.to_nat (@wordToN sz a)) (N.to_nat (@wordToN sz b)) *)
  repeat rewrite wordToN_to_nat.
(* Goal: False *)
  assumption.
Qed.

Lemma wordToNat_gt1: forall sz (a b: word sz), a > b -> (wordToNat a > wordToNat b)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_nomega.
(* Goal: ge (@wordToNat sz a) (@wordToNat sz b) *)
  repeat rewrite wordToN_to_nat in H.
(* Goal: False *)
  assumption.
Qed.

Lemma wordToNat_gt2: forall sz (a b: word sz), (wordToNat a > wordToNat b)%nat -> a > b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_nomega.
(* Goal: ge (N.to_nat (@wordToN sz a)) (N.to_nat (@wordToN sz b)) *)
  repeat rewrite wordToN_to_nat.
(* Goal: False *)
  assumption.
Qed.

Lemma wordToNat_le1: forall sz (a b: word sz), a <= b -> (wordToNat a <= wordToNat b)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_nomega.
(* Goal: ge (@wordToNat sz a) (@wordToNat sz b) *)
  repeat rewrite wordToN_to_nat in H.
(* Goal: False *)
  assumption.
Qed.

Lemma wordToNat_le2: forall sz (a b: word sz), (wordToNat a <= wordToNat b)%nat -> a <= b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_nomega.
(* Goal: ge (N.to_nat (@wordToN sz a)) (N.to_nat (@wordToN sz b)) *)
  repeat rewrite wordToN_to_nat.
(* Goal: False *)
  assumption.
Qed.

Lemma wordToNat_ge1: forall sz (a b: word sz), a >= b -> (wordToNat a >= wordToNat b)%nat.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_nomega.
(* Goal: ge (@wordToNat sz a) (@wordToNat sz b) *)
  repeat rewrite wordToN_to_nat in H.
(* Goal: False *)
  assumption.
Qed.

Lemma wordToNat_ge2: forall sz (a b: word sz), (wordToNat a >= wordToNat b)%nat -> a >= b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_nomega.
(* Goal: ge (N.to_nat (@wordToN sz a)) (N.to_nat (@wordToN sz b)) *)
  repeat rewrite wordToN_to_nat.
(* Goal: False *)
  assumption.
Qed.

Lemma wordToNat_neq1: forall sz (a b: word sz), a <> b -> wordToNat a <> wordToNat b.
Proof.
(* Goal: not (@eq (word sz) (natToWord sz O) (wones sz)) *)
  unfold not.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: False *)
  apply wordToNat_eq2 in H0.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  tauto.
Qed.

Lemma wordToNat_neq2: forall sz (a b: word sz), wordToNat a <> wordToNat b -> a <> b.
Proof.
(* Goal: not (@eq (word sz) (natToWord sz O) (wones sz)) *)
  unfold not.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  subst.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  tauto.
Qed.

Lemma wordToNat_wplus': forall sz (a b: word sz),
    (#a + #b < pow2 sz)%nat ->
    #(a ^+ b) = #a + #b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <-? wordToN_to_nat in *.
  rewrite <-? Nnat.N2Nat.inj_add in *.
  rewrite <- Npow2_nat in *.
(* Goal: @eq nat (N.to_nat (@wordToN sz (@wmult sz a b))) (N.to_nat (N.mul (@wordToN sz a) (@wordToN sz b))) *)
  apply Nlt_in in H.
(* Goal: False *)
  rewrite wordToN_plus by assumption.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wordToNat_wplus'': forall sz (a: word sz) (b: nat),
    (#a + b < pow2 sz)%nat -> #(a ^+ $b) = #a + b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite wordToNat_wplus';
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite wordToNat_natToWord_2; omega.
Qed.

Lemma wordToNat_wmult': forall sz (a b: word sz),
    (#a * #b < pow2 sz)%nat ->
    #(a ^* b) = #a * #b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <-? wordToN_to_nat in *.
  rewrite <-? Nnat.N2Nat.inj_mul in *.
  rewrite <- Npow2_nat in *.
(* Goal: @eq nat (N.to_nat (@wordToN sz (@wmult sz a b))) (N.to_nat (N.mul (@wordToN sz a) (@wordToN sz b))) *)
  apply Nlt_in in H.
(* Goal: False *)
  rewrite wordToN_mult by assumption.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wordNotNot: forall sz (a b: word sz), (a <> b -> False) -> a = b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct (weq a b); subst; tauto.
Qed.

Ltac pre_word_omega :=
  unfold wzero, wone in *;
  repeat match goal with
           | H: @eq ?T ?a ?b |- _ =>
             match T with
               | word ?sz =>
                 apply (@wordToNat_eq1 sz a b) in H;
                   rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H;
                   simpl in H
             end
           | |- @eq ?T ?a ?b =>
             match T with
               | word ?sz =>
                 apply (@wordToNat_eq2 sz a b);
                   rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one;
                   simpl
             end
           | H: ?a < ?b |- _ =>
             apply wordToNat_lt1 in H;
               rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H;
               simpl in H
           | |- ?a < ?b =>
             apply wordToNat_lt2;
               rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one;
               simpl
           | H: ?a > ?b |- _ =>
             apply wordToNat_gt1 in H;
               rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H;
               simpl in H
           | |- ?a > ?b =>
             apply wordToNat_gt2;
               rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one;
               simpl
           | H: ?a <= ?b |- _ =>
             apply wordToNat_le1 in H;
               rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H;
               simpl in H
           | |- ?a <= ?b =>
             apply wordToNat_le2;
               rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one;
               simpl
           | H: ?a > ?b -> False |- _ =>
             apply wordToNat_le1 in H;
               rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H;
               simpl in H
           | |- ?a > ?b -> False =>
             apply wordToNat_le2;
               rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one;
               simpl
           | H: ?a < ?b -> False |- _ =>
             apply wordToNat_ge1 in H;
               rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H;
               simpl in H
           | |- ?a < ?b -> False =>
             apply wordToNat_ge2;
               rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one;
               simpl
           | H: not (@eq ?T ?a ?b) |- _ =>
             match T with
               | word ?sz =>
                 apply (@wordToNat_neq1 sz a b) in H;
                   rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H;
                   simpl in H
             end
           | |- not (@eq ?T ?a ?b) =>
             match T with
               | word ?sz =>
                 apply (@wordToNat_neq2 sz a b);
                   rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one;
                   simpl
             end
           | H: @eq ?T ?a ?b -> False |- _ =>
             match T with
               | word ?sz =>
                 apply (@wordToNat_neq1 sz a b) in H;
                   rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H;
                   simpl in H
             end
           | |- @eq ?T ?a ?b -> False =>
             match T with
               | word ?sz =>
                 apply (@wordToNat_neq2 sz a b);
                   rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one;
                   simpl
             end
           | H: (@eq ?T ?a ?b -> False) -> False |- _ =>
             match T with
               | word ?sz =>
                 apply (@wordNotNot sz a b) in H
             end
           | H: (not (@eq ?T ?a ?b)) -> False |- _ =>
             match T with
               | word ?sz =>
                 apply (@wordNotNot sz a b) in H
             end
           | H: not (@eq ?T ?a ?b -> False) |- _ =>
             match T with
               | word ?sz =>
                 apply (@wordNotNot sz a b) in H
             end
           | H: not (not (@eq ?T ?a ?b)) |- _ =>
             match T with
               | word ?sz =>
                 apply (@wordNotNot sz a b) in H
             end
         end.


(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
Ltac word_omega := pre_word_omega; omega.



Lemma word_le_ge_eq sz (w1 w2: word sz): w1 <= w2 -> w1 >= w2 -> w1 = w2.
Proof.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  intros; word_omega.
Qed.

Lemma word_le_zero sz (w: word sz): w <= wzero sz -> w = wzero sz.
Proof.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  intros; word_omega.
Qed.

Close Scope word_scope.

Open Scope word_scope.
Local Open Scope nat.

Lemma wzero_wones: forall sz, sz >= 1 ->
                              natToWord sz 0 <> wones sz.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: not (@eq (word sz) (natToWord sz O) (wones sz)) *)
  unfold not.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: False *)
  pose proof (f_equal (@wordToNat sz) H0) as sth.
(* Goal: False *)
  unfold wzero in *.
  rewrite roundTrip_0 in *.
(* Goal: False *)
  rewrite wones_pow2_minus_one in sth.
(* Goal: False *)
  destruct sz; [omega | ].
(* Goal: False *)
  pose proof (NatLib.one_lt_pow2 sz).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wzero_wplus: forall sz w, wzero sz ^+ w = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wplus sz (wzero sz) w) w *)
  unfold wzero.
(* Goal: @eq (word sz) (@wplus sz (natToWord sz O) w) w *)
  apply wplus_unit.
Qed.

Lemma wordToNat_nonZero sz (w: word sz):
  w <> wzero sz -> wordToNat w > 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction w; simpl; unfold wzero; simpl; intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  - tauto.
  - destruct b.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + omega.
    + assert (sth: w <> (natToWord n 0)).
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { intro.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
        subst.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
        tauto.
      }
(* Goal: gt (Init.Nat.mul (@wordToNat n w) (S (S O))) O *)
      assert (sth2: wordToNat w <> 0).
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { intro sth3.
(* Goal: False *)
        specialize (IHw sth).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        omega.
      }
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      omega.
Qed.

Lemma split2_pow2: forall sz n,
    2 ^ sz <= n < 2 ^ S sz ->
    wordToNat (split2 sz 1 (natToWord (sz + 1) n)) = 1.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (@wordToNat (S O) (split2 sz (S O) (natToWord (Init.Nat.add sz (S O)) n))) (S O) *)
  rewrite wordToNat_split2.
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  simpl in *.
  rewrite Nat.add_0_r in *.
  (* pose proof (wordToNat_natToWord sz n). *)
(* Goal: @eq nat (Nat.div (@wordToNat (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) n)) (Nat.pow (S (S O)) sz)) (S O) *)
  rewrite wordToNat_natToWord_bound with (bound := wones _).
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
  - destruct H.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    assert (sth: pow2 sz <> 0) by omega.
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
    pose proof (Nat.div_le_mono _ _ (pow2 sz) sth H) as sth2.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    rewrite Nat.div_same in sth2 by auto.
(* Goal: lt (Init.Nat.add (Init.Nat.add (@wordToNat sz w1) (@wordToNat sz w2)) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Nat.add (Nat.pow (S (S O)) sz) (Nat.mul (Nat.pow (S (S O)) sz) (Init.Nat.sub (Nat.pow (S (S O)) sz') (S O)))) *)
    apply Nat.lt_le_pred in H0.
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
    pose proof (Nat.div_le_mono _ _ (pow2 sz) sth H0) as sth3.
    rewrite <- Nat.sub_1_r in sth3.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    assert (sth4: pow2 sz = 1 * pow2 sz) by omega.
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
    rewrite sth4 in sth3 at 2.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    assert (sth5: 1 * pow2 sz + pow2 sz - 1 = 1 * pow2 sz + (pow2 sz - 1)) by omega.
(* Goal: @eq nat (Nat.div n (Nat.pow (S (S O)) sz)) (S O) *)
    rewrite sth5 in sth3.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    rewrite Nat.div_add_l in sth3 by omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    rewrite Nat.div_small with (a := pow2 sz - 1) in sth3 by omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    omega.
  - rewrite wones_pow2_minus_one.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    assert (sth: sz + 1 = S sz) by omega.
(* Goal: @eq (word sz) (@wplus sz (@wplus sz a c) a') (@wplus sz (@wplus sz b c) b') *)
    rewrite sth.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
    simpl.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    omega.
Qed.

Lemma combine_wones_WO sz:
  forall w, w <> wzero sz -> split2 sz 1 (combine (wones sz) ($ 0) ^+ combine w ($ 0)) = WO~1.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  match goal with
  | |- split2 _ _ (?a ^+ ?b) = _ =>
    rewrite <- (@natToWord_wordToNat _ a);
      rewrite <- (@natToWord_wordToNat _ b)
  end.
  rewrite <- natToWord_plus.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Nat.add n sz) (@combine n (wzero n) sz (natToWord sz O))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  rewrite ?wordToNat_combine.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: @eq (word (S O)) (split2 sz (S O) (natToWord (Init.Nat.add sz (S O)) (Init.Nat.add (Init.Nat.add (@wordToNat sz (wones sz)) (Init.Nat.mul (Nat.pow (S (S O)) sz) O)) (Init.Nat.add (@wordToNat sz w) (Init.Nat.mul (Nat.pow (S (S O)) sz) O))))) (@WS true O WO) *)
  rewrite wones_pow2_minus_one.
(* Goal: @eq (word (S O)) (split2 sz (S O) (natToWord (Init.Nat.add sz (S O)) (Init.Nat.add (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) sz) (S O)) (Init.Nat.mul (Nat.pow (S (S O)) sz) O)) (Init.Nat.add (@wordToNat sz w) (Init.Nat.mul (Nat.pow (S (S O)) sz) O))))) (@WS true O WO) *)
  pose proof (wordToNat_bound w) as sth.
(* Goal: @eq (word (S O)) (split2 sz (S O) (natToWord (Init.Nat.add sz (S O)) (Init.Nat.add (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) sz) (S O)) (Init.Nat.mul (Nat.pow (S (S O)) sz) O)) (Init.Nat.add (@wordToNat sz w) (Init.Nat.mul (Nat.pow (S (S O)) sz) O))))) (@WS true O WO) *)
  pose proof (wordToNat_nonZero H).
  assert (sth2: 2^sz <= 2 ^ sz - 1 + wordToNat w < 2 ^ (S sz)). {
(* Goal: and (le (Nat.pow (S (S O)) sz) (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) sz) (S O)) (@wordToNat sz w))) (lt (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) sz) (S O)) (@wordToNat sz w)) (Nat.pow (S (S O)) (S sz))) *)
    pose proof (pow2_zero sz) as sth3.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    split; simpl; omega.
  }
(* Goal: @eq (word (S O)) (split2 sz (S O) (natToWord (Init.Nat.add sz (S O)) (Init.Nat.add (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) sz) (S O)) (Init.Nat.mul (Nat.pow (S (S O)) sz) O)) (Init.Nat.add (@wordToNat sz w) (Init.Nat.mul (Nat.pow (S (S O)) sz) O))))) (@WS true O WO) *)
  apply split2_pow2 in sth2.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) O)) (Nat.pow (S (S O)) sz)) O *)
  rewrite Nat.mul_0_r.
(* Goal: @eq (word (S O)) (split2 sz (S O) (natToWord (Init.Nat.add sz (S O)) (Init.Nat.add (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) sz) (S O)) O) (Init.Nat.add (@wordToNat sz w) O)))) (@WS true O WO) *)
  rewrite ?Nat.add_0_r.
(* Goal: @eq (word (S O)) (split2 sz (S O) (natToWord (Init.Nat.add sz (S O)) (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) sz) (S O)) (@wordToNat sz w)))) (@WS true O WO) *)
  apply (f_equal (natToWord 1)) in sth2.
(* Goal: @eq (word (S O)) (split2 sz (S O) (natToWord (Init.Nat.add sz (S O)) (Init.Nat.add (Init.Nat.sub (Nat.pow (S (S O)) sz) (S O)) (@wordToNat sz w)))) (@WS true O WO) *)
  rewrite natToWord_wordToNat in sth2.
(* Goal: False *)
  assumption.
Qed.

Lemma wordToNat_plus sz (w1 w2: word sz):
  natToWord sz (wordToNat w1 + wordToNat w2) = w1 ^+ w2.
Proof.
(* Goal: @wlt no (@wplus no (natToWord no (S O)) (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end))) (natToWord no (Init.Nat.add (S O) ni)) *)
  rewrite natToWord_plus.
(* Goal: @eq (word sz1) (@wplus sz1 (natToWord sz1 (@wordToNat sz1 w11)) (natToWord sz1 (@wordToNat sz1 w21))) (@wplus sz1 w11 w21) *)
  rewrite ?natToWord_wordToNat.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma wordToNat_natToWord_eqn sz:
  forall n,
    wordToNat (natToWord sz n) = n mod (pow2 sz).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (@wordToNat sz (natToWord sz n)) (Nat.modulo n (Nat.pow (S (S O)) sz)) *)
  pose proof (wordToNat_natToWord sz n).
(* Goal: @eq nat (@wordToNat sz (natToWord sz n)) (Nat.modulo n (Nat.pow (S (S O)) sz)) *)
  destruct H as [? [? ?]].
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
  rewrite H.
  assert (sth: pow2 sz * x = x * pow2 sz) by (apply Nat.mul_comm).
  rewrite <- sth in *.
(* Goal: @eq nat (Init.Nat.sub n (Init.Nat.mul (Nat.pow (S (S O)) sz) x)) (Nat.modulo n (Nat.pow (S (S O)) sz)) *)
  clear sth.
(* Goal: @eq nat (Init.Nat.sub n (Init.Nat.mul (Nat.pow (S (S O)) sz) x)) (Nat.modulo n (Nat.pow (S (S O)) sz)) *)
  pose proof (wordToNat_bound (natToWord sz n)).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  apply (Nat.mod_unique n (pow2 sz) x (n - pow2 sz * x)); try omega.
Qed.

Lemma mod_factor a b c:
  b <> 0 ->
  c <> 0 ->
  (a mod (b * c)) mod b = a mod b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (Nat.modulo (Nat.modulo a (Init.Nat.mul b c)) b) (Nat.modulo a b) *)
  pose proof (Nat.mod_mul_r a _ _ H H0).
(* Goal: @eq nat (Nat.modulo (Nat.modulo a (Init.Nat.mul b c)) b) (Nat.modulo a b) *)
  rewrite H1.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite Nat.add_mod_idemp_l by auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite Nat.add_mod by auto.
  assert (sth: b * ((a/b) mod c) = (a/b) mod c * b) by (apply Nat.mul_comm).
(* Goal: @eq (word sz) (@wplus sz (@wplus sz a c) a') (@wplus sz (@wplus sz b c) b') *)
  rewrite sth.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite Nat.mod_mul by auto.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) O) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  rewrite Nat.add_0_r.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite Nat.mod_mod by auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma split1_combine_wplus sz1 sz2 (w11 w21: word sz1) (w12 w22: word sz2):
  split1 _ _ (combine w11 w12 ^+ combine w21 w22) = w11 ^+ w21.
Proof.
  rewrite <- natToWord_wordToNat at 1.
(* Goal: @eq (word sz1) (natToWord sz1 (@wordToNat sz1 (split1 sz1 sz2 (@wplus (Init.Nat.add sz1 sz2) (@combine sz1 w11 sz2 w12) (@combine sz1 w21 sz2 w22))))) (@wplus sz1 w11 w21) *)
  rewrite wordToNat_split1.
  rewrite <- wordToNat_plus.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Nat.add n sz) (@combine n (wzero n) sz (natToWord sz O))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  rewrite ?wordToNat_combine.
  assert (sth: #w11 + pow2 sz1 * #w12 + (#w21 + pow2 sz1 * #w22) = #w11 + #w21 + pow2 sz1 * (#w12 + #w22)) by ring.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz a))) (Nat.pow (S (S O)) sz)) (Nat.modulo (Init.Nat.mul (@wordToNat sz a) (@wordToNat sz (natToWord sz (Nat.pow (S (S O)) n)))) (Nat.pow (S (S O)) sz)) *)
  rewrite wordToNat_natToWord_eqn.
(* Goal: @eq (word sz) (@wplus sz (@wplus sz a c) a') (@wplus sz (@wplus sz b c) b') *)
  rewrite sth.
(* Goal: lt (Init.Nat.add (Init.Nat.add (@wordToNat sz w1) (@wordToNat sz w2)) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Nat.pow (S (S O)) (Init.Nat.add sz sz')) *)
  rewrite Nat.pow_add_r.
(* Goal: @eq (word sz1) (natToWord sz1 (Nat.modulo (Nat.modulo (Init.Nat.add (Init.Nat.add (@wordToNat sz1 w11) (@wordToNat sz1 w21)) (Init.Nat.mul (Nat.pow (S (S O)) sz1) (Init.Nat.add (@wordToNat sz2 w12) (@wordToNat sz2 w22)))) (Nat.mul (Nat.pow (S (S O)) sz1) (Nat.pow (S (S O)) sz2))) (Nat.pow (S (S O)) sz1))) (@wplus sz1 w11 w21) *)
  assert (pow2 sz1 <> 0) by (pose proof (pow2_zero sz1); intro; omega).
(* Goal: @eq (word sz1) (natToWord sz1 (Nat.modulo (Nat.modulo (Init.Nat.add (Init.Nat.add (@wordToNat sz1 w11) (@wordToNat sz1 w21)) (Init.Nat.mul (Nat.pow (S (S O)) sz1) (Init.Nat.add (@wordToNat sz2 w12) (@wordToNat sz2 w22)))) (Nat.mul (Nat.pow (S (S O)) sz1) (Nat.pow (S (S O)) sz2))) (Nat.pow (S (S O)) sz1))) (@wplus sz1 w11 w21) *)
  assert (pow2 sz2 <> 0) by (pose proof (pow2_zero sz2); intro; omega).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite mod_factor by auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite Nat.add_mod by auto.
  assert (sth2: pow2 sz1 * (# w12 + #w22) = (#w12 + #w22) * pow2 sz1) by ring.
(* Goal: @eq (word sz1) (natToWord sz1 (Nat.modulo (Nat.add (Nat.modulo (Init.Nat.add (@wordToNat sz1 w11) (@wordToNat sz1 w21)) (Nat.pow (S (S O)) sz1)) (Nat.modulo (Init.Nat.mul (Nat.pow (S (S O)) sz1) (Init.Nat.add (@wordToNat sz2 w12) (@wordToNat sz2 w22))) (Nat.pow (S (S O)) sz1))) (Nat.pow (S (S O)) sz1))) (@wplus sz1 w11 w21) *)
  rewrite sth2.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite Nat.mod_mul by auto.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) O) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  rewrite Nat.add_0_r.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite Nat.mod_mod by auto.
  rewrite <- wordToNat_natToWord_eqn.
(* Goal: @eq (word sz1) (natToWord sz1 (@wordToNat sz1 (natToWord sz1 (Init.Nat.add (@wordToNat sz1 w11) (@wordToNat sz1 w21))))) (@wplus sz1 w11 w21) *)
  rewrite natToWord_wordToNat.
(* Goal: @wlt no (@wplus no (natToWord no (S O)) (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end))) (natToWord no (Init.Nat.add (S O) ni)) *)
  rewrite natToWord_plus.
(* Goal: @eq (word sz1) (@wplus sz1 (natToWord sz1 (@wordToNat sz1 w11)) (natToWord sz1 (@wordToNat sz1 w21))) (@wplus sz1 w11 w21) *)
  rewrite ?natToWord_wordToNat.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma div_2 a b:
  b <> 0 ->
  a < b * 2 ->
  a >= b ->
  a / b = 1.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (sth: b * 1 <= a) by omega.
(* Goal: @eq nat (Nat.div a b) (S O) *)
  pose proof (Nat.div_le_lower_bound a b 1 H sth).
(* Goal: @eq nat (Nat.div a b) (S O) *)
  pose proof (Nat.div_lt_upper_bound a b 2 H H0).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma mod_sub a b:
  b <> 0 ->
  a < b * 2 ->
  a >= b ->
  a mod b = a - b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite Nat.mod_eq; auto.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  repeat f_equal.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite div_2 by auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite Nat.mul_1_r; auto.
Qed.

Lemma wordToNat_wneg_non_0 sz: forall (a: word sz),
    a <> natToWord _ 0 ->
    # (wneg a) = pow2 sz - #a.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq nat (@wordToNat sz (@wneg sz a)) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  unfold wneg.
(* Goal: @eq nat (@wordToNat sz (NToWord sz (N.sub (Npow2 sz) (@wordToN sz a)))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite pow2_N.
(* Goal: @eq nat (@wordToNat sz (NToWord sz (N.sub (N.of_nat (Nat.pow (S (S O)) sz)) (@wordToN sz a)))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite NToWord_nat.
(* Goal: @eq nat (@wordToNat sz (natToWord sz (N.to_nat (N.sub (N.of_nat (Nat.pow (S (S O)) sz)) (@wordToN sz a))))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite Nnat.N2Nat.inj_sub.
(* Goal: @eq nat (N.to_nat (@wordToN sz (NToWord sz n))) (N.to_nat (N.modulo n (Npow2 sz))) *)
  rewrite wordToN_to_nat.
(* Goal: @eq nat (@wordToNat sz (natToWord sz (Init.Nat.sub (N.to_nat (N.of_nat (Nat.pow (S (S O)) sz))) (@wordToNat sz a)))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite Nnat.Nat2N.id.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wordToNat_natToWord_idempotent'; auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  assert (#a <> 0) by word_omega.
(* Goal: lt (S O) (Nat.add (Nat.pow (S (S O)) sz) (Nat.add (Nat.pow (S (S O)) sz) O)) *)
  pose proof (pow2_zero sz).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wordToNat_wnot sz: forall (a: word sz),
    # (wnot a) = pow2 sz - #a - 1.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z match N.add (N.mul (Npos (xO xH)) (@wordToN (S sz) (@wnot (S sz) (@WS b sz w)))) (Npos xH) with | N0 => Z0 | Npos x => Zneg x end (Z.add (Z.mul (Zpos (xO xH)) match @wordToN (S sz) (@wneg (S sz) (@WS b sz w)) with | N0 => Z0 | Npos x => Zneg x end) (Zpos xH)) *)
  rewrite wnot_def.
(* Goal: @eq nat (@wordToNat sz (NToWord sz (N.sub (Npow2 sz) (@wordToN sz a)))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite pow2_N.
(* Goal: @eq nat (@wordToNat sz (NToWord sz (N.sub (N.of_nat (Nat.pow (S (S O)) sz)) (@wordToN sz a)))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite NToWord_nat.
(* Goal: @eq nat (@wordToNat sz (natToWord sz (N.to_nat (N.sub (N.of_nat (Nat.pow (S (S O)) sz)) (@wordToN sz a))))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite Nnat.N2Nat.inj_sub.
(* Goal: @eq nat (@wordToNat sz (natToWord sz (N.to_nat (N.sub (N.of_nat (Nat.pow (S (S O)) sz)) (@wordToN sz a))))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite Nnat.N2Nat.inj_sub.
(* Goal: @eq nat (N.to_nat (@wordToN sz (NToWord sz n))) (N.to_nat (N.modulo n (Npow2 sz))) *)
  rewrite wordToN_to_nat.
(* Goal: @eq nat (@wordToNat sz (natToWord sz (Init.Nat.sub (N.to_nat (N.of_nat (Nat.pow (S (S O)) sz))) (@wordToNat sz a)))) (Init.Nat.sub (Nat.pow (S (S O)) sz) (@wordToNat sz a)) *)
  rewrite Nnat.Nat2N.id.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wordToNat_natToWord_idempotent'; auto.
(* Goal: lt (S O) (Nat.add (Nat.pow (S (S O)) sz) (Nat.add (Nat.pow (S (S O)) sz) O)) *)
  pose proof (pow2_zero sz).
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  unfold Pos.to_nat; simpl.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wzero_wor: forall sz w, w ^| wzero sz = w.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wor sz w (wzero sz)) w *)
  rewrite wor_comm.
(* Goal: @eq (word sz) (@wor sz (wzero sz) w) w *)
  rewrite wor_wzero.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma bool_prop1: forall a b, a && negb (a && b) = a && negb b.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct a, b; simpl; auto.
Qed.

Lemma wordToNat_wplus sz (w1 w2: word sz):
  #(w1 ^+ w2) = (#w1 + #w2) mod (pow2 sz).
Proof.
  rewrite <- (natToWord_wordToNat w1) at 1.
  rewrite <- (natToWord_wordToNat w2) at 1.
  rewrite <- natToWord_plus.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz a))) (Nat.pow (S (S O)) sz)) (Nat.modulo (Init.Nat.mul (@wordToNat sz a) (@wordToNat sz (natToWord sz (Nat.pow (S (S O)) n)))) (Nat.pow (S (S O)) sz)) *)
  rewrite wordToNat_natToWord_eqn.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma wordToNat_wmult : forall (sz : nat) (w1 w2 : word sz),
    #(w1 ^* w2) = (#w1 * #w2) mod pow2 sz.
Proof using .
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  clear. intros.
  rewrite <- (natToWord_wordToNat w1) at 1.
  rewrite <- (natToWord_wordToNat w2) at 1.
  rewrite <- natToWord_mult.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz a))) (Nat.pow (S (S O)) sz)) (Nat.modulo (Init.Nat.mul (@wordToNat sz a) (@wordToNat sz (natToWord sz (Nat.pow (S (S O)) n)))) (Nat.pow (S (S O)) sz)) *)
  rewrite wordToNat_natToWord_eqn.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wor_r_wzero_1 sz: (* Note: not axiom free *)
  forall w1 w2,
    w1 ^| w2 = natToWord sz 0 ->
    w2 = natToWord sz 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction w1; simpl; auto; intros.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  pose proof (shatter_word w2) as sth.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  simpl in sth.
  rewrite sth in *.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  unfold wor in H.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  simpl in H.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  unfold natToWord in H.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  unfold natToWord.
  fold (natToWord n (Nat.div2 0)) in *.
  unfold Nat.div2, mod2 in *.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS false n (natToWord n O)) *)
  inversion H.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS (orb b (@whd n w2)) n (natToWord n O)) *)
  destruct_existT.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS (orb b (@whd n w2)) n (natToWord n O)) *)
  rewrite (IHw1 _ H2).
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct b, (whd w2); auto.
Qed.

Lemma wor_r_wzero_2 sz: (* Note: not axiom free *)
  forall w1 w2,
    w1 ^| w2 = natToWord sz 0 ->
    w1 = natToWord sz 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction w1; simpl; auto; intros.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  pose proof (shatter_word w2) as sth.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  simpl in sth.
  rewrite sth in *.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  unfold wor in H.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  simpl in H.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  unfold natToWord in H.
(* Goal: @eq (word (S n)) (@WS b n w1) (natToWord (S n) O) *)
  unfold natToWord.
  fold (natToWord n (Nat.div2 0)) in *.
  unfold Nat.div2, mod2 in *.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS false n (natToWord n O)) *)
  inversion H.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS (orb b (@whd n w2)) n (natToWord n O)) *)
  destruct_existT.
(* Goal: @eq (word (S n)) (@WS b n w1) (@WS (orb b (@whd n w2)) n (natToWord n O)) *)
  rewrite (IHw1 _ H2).
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct b, (whd w2); auto.
Qed.

Fixpoint countLeadingZerosWord ni no: word ni -> word no :=
  match ni return word ni -> word no with
  | 0 => fun _ => $ 0
  | S m => fun e =>
             if (weq (split2 m 1 (nat_cast (fun n => word n) (eq_sym (Nat.add_1_r m)) e)) WO~0)
             then $ 1 ^+ @countLeadingZerosWord m no (split1 m 1 (nat_cast (fun n => word n) (eq_sym (Nat.add_1_r m)) e))
             else $ 0
  end.


Lemma countLeadingZerosWord_le_len no ni:
  ni < pow2 no ->
  forall w: word ni, (countLeadingZerosWord no w <= natToWord _ ni)%word.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction ni; simpl; auto; intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  - word_omega.
  - match goal with
    | |- ((if ?P then _ else _) <= _)%word => destruct P; simpl; auto
    end; [| word_omega].
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    assert (sth: ni < pow2 no) by omega.
(* Goal: @wlt no (@wplus no (natToWord no (S O)) (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end))) (natToWord no (S ni)) *)
    specialize (IHni sth).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    assert (sth1: natToWord no (S ni) = natToWord no (1 + ni)) by auto.
(* Goal: @wlt no (@wplus no (natToWord no (S O)) (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end))) (natToWord no (S ni)) *)
    rewrite sth1.
(* Goal: @wlt no (@wplus no (natToWord no (S O)) (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end))) (natToWord no (Init.Nat.add (S O) ni)) *)
    rewrite natToWord_plus.
    match goal with
    | |- ((_ ^+ countLeadingZerosWord no ?P) <= _)%word => specialize (IHni P)
    end.
    match goal with
    | |- (?a ^+ ?b <= ?c ^+ ?d)%word =>
      rewrite (wplus_comm a b); rewrite (wplus_comm c d)
    end.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    pre_word_omega.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
    assert (sth2: no > 0). {
(* Goal: gt no O *)
      destruct no; [|omega].
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      destruct ni; simpl in *; try omega.
    }
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    rewrite <- ?(@natplus1_wordplus1_eq _ _ (wones no)); auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + pre_word_omega.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz a))) (Nat.pow (S (S O)) sz)) (Nat.modulo (Init.Nat.mul (@wordToNat sz a) (@wordToNat sz (natToWord sz (Nat.pow (S (S O)) n)))) (Nat.pow (S (S O)) sz)) *)
      rewrite wordToNat_natToWord_eqn.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      rewrite Nat.mod_small; auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + pre_word_omega.
(* Goal: lt (@wordToNat no (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end))) (Init.Nat.sub (Nat.pow (S (S O)) no) (S O)) *)
      rewrite wordToNat_natToWord_eqn in IHni.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      rewrite Nat.mod_small in IHni; auto.
Qed.

Lemma countLeadingZerosWord_le_len_nat no ni:
  ni < pow2 no ->
  forall w: word ni, #(countLeadingZerosWord no w) <= ni.
Proof.
(* Goal: forall (_ : lt ni (Nat.pow (S (S O)) no)) (w : word ni), le (@wordToNat no (@countLeadingZerosWord ni no w)) ni *)
  intros H w.
(* Goal: le (@wordToNat no (@countLeadingZerosWord ni no w)) ni *)
  pose proof (countLeadingZerosWord_le_len H w) as sth.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_word_omega.
(* Goal: False *)
  rewrite wordToNat_natToWord_idempotent' in * by assumption.
(* Goal: False *)
  assumption.
Qed.


Lemma wordToNat_zero sz: forall (w: word sz), #w = 0 -> w = natToWord _ 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) w (natToWord sz O) *)
  apply (f_equal (natToWord sz)) in H.
(* Goal: @eq (word sz) w (natToWord sz O) *)
  rewrite natToWord_wordToNat in H.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma wordToNat_notZero sz: forall (w: word sz), #w <> 0 -> w <> natToWord _ 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: forall _ : @eq (word (S sz)) (@wminus (S sz) w1 (natToWord (S sz) (Nat.pow (S (S O)) sz))) w2, @eq (word (S sz)) w1 (@wminus (S sz) w2 (natToWord (S sz) (Nat.pow (S (S O)) sz))) *)
  intro.
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  subst.
(* Goal: False *)
  pose proof (wordToNat_wzero sz); unfold wzero in *.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  tauto.
Qed.


Lemma natToWord_nzero sz x:
  0 < x ->
  x < pow2 sz ->
  natToWord sz x <> natToWord sz 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_word_omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite wordToNat_natToWord_idempotent'; omega.
Qed.

Lemma pow2_lt_pow2_S:
  forall n, pow2 n < pow2 (n+1).
Proof.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  induction n; simpl; omega.
Qed.

Lemma combine_shiftl_plus_n n x:
  x < pow2 n ->
  (combine (natToWord n x) WO~1) = (natToWord (n + 1) (pow2 n)) ^+ natToWord (n + 1) x.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz))) (wzero (Init.Nat.add sz (S O))) *)
  apply wordToNat_eq2.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Nat.add n sz) (@combine n (wzero n) sz (natToWord sz O))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  rewrite ?wordToNat_combine.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite ?wordToNat_natToWord_idempotent'; simpl; auto.
  rewrite <- wordToNat_plus.
(* Goal: @eq nat (Init.Nat.add x (Init.Nat.mul (Nat.pow (S (S O)) n) (S O))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) (Init.Nat.add (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) (Nat.pow (S (S O)) n))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x))))) *)
  pose proof (pow2_lt_pow2_S n) as sth.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite ?wordToNat_natToWord_idempotent'; simpl; try omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite ?wordToNat_natToWord_idempotent'; simpl; try omega.
(* Goal: lt (Init.Nat.add (Nat.pow (S (S O)) n) x) (Nat.pow (S (S O)) (Init.Nat.add n (S O))) *)
  apply Nat.lt_add_lt_sub_l.
(* Goal: lt x (Nat.sub (Nat.pow (S (S O)) (Init.Nat.add n (S O))) (Nat.pow (S (S O)) n)) *)
  rewrite Nat.add_1_r.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma combine_natToWord_wzero n:
  forall x,
    x < pow2 n ->
    combine (natToWord n x) (natToWord 1 0) = natToWord (n+1) x.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz))) (wzero (Init.Nat.add sz (S O))) *)
  apply wordToNat_eq2.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Nat.add n sz) (@combine n (wzero n) sz (natToWord sz O))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  rewrite ?wordToNat_combine.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  simpl.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) O)) (Nat.pow (S (S O)) sz)) O *)
  rewrite Nat.mul_0_r.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) O) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  rewrite Nat.add_0_r.
(* Goal: @eq nat (@wordToNat n (natToWord n x)) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  pose proof (pow2_lt_pow2_S n) as sth2.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite ?wordToNat_natToWord_idempotent' by omega.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma word_cancel_l sz (a b c: word sz):
  a = b -> c ^+ a = c ^+ b.
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  intro H; rewrite H; reflexivity.
Qed.


Lemma word_cancel_r sz (a b c: word sz):
  a = b -> a ^+ c = b ^+ c.
Proof.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  intro H; rewrite H; reflexivity.
Qed.

Lemma word_cancel_m sz (a b c a' b': word sz):
  a ^+ a' = b ^+ b'-> a ^+ c ^+ a' = b ^+ c ^+ b'.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  assert (sth: a ^+ c ^+ a' = a ^+ a'^+ c ).
  rewrite <- wplus_assoc.
(* Goal: @eq (word sz) (@wplus sz a (@wplus sz c a')) (@wplus sz (@wplus sz a a') c) *)
(* Goal: @eq (word sz) (@wplus sz (@wplus sz a c) a') (@wplus sz (@wplus sz b c) b') *)
  rewrite wplus_comm with (y := a').
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) y2)) y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wplus_assoc.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
(* Goal: @eq (word sz) (@wplus sz (@wplus sz a c) a') (@wplus sz (@wplus sz b c) b') *)
  rewrite sth.
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
  rewrite H.
  rewrite <- wplus_assoc.
(* Goal: @eq (word sz) (@wplus sz b (@wplus sz b' c)) (@wplus sz (@wplus sz b c) b') *)
  rewrite wplus_comm with (x := b').
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) y2)) y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wplus_assoc.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma move_wplus_wminus sz (a b c: word sz):
  a ^+ b = c <-> a = c ^- b.
Proof.
(* Goal: forall _ : @eq (word (S sz)) (@wminus (S sz) w1 (natToWord (S sz) (Nat.pow (S (S O)) sz))) w2, @eq (word (S sz)) w1 (@wminus (S sz) w2 (natToWord (S sz) (Nat.pow (S (S O)) sz))) *)
  split; intro.
  + rewrite <- H.
(* Goal: @eq (word (S sz)) w1 (@wminus (S sz) w2 (natToWord (S sz) (Nat.pow (S (S O)) sz))) *)
    rewrite wminus_def.
    rewrite <- wplus_assoc.
(* Goal: @eq (word sz) (@wplus sz c (@wplus sz b (@wneg sz b))) c *)
    rewrite wminus_inv.
(* Goal: @eq (word sz) (@wplus sz c (wzero sz)) c *)
    rewrite wplus_wzero_1.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
  + rewrite H.
(* Goal: @eq (word (S sz)) w1 (@wminus (S sz) w2 (natToWord (S sz) (Nat.pow (S (S O)) sz))) *)
    rewrite wminus_def.
    rewrite <- wplus_assoc.
(* Goal: @eq (word sz) (@wplus sz c (@wplus sz (@wneg sz b) b)) c *)
    rewrite wplus_comm with (x:= ^~b).
(* Goal: @eq (word sz) (@wplus sz c (@wplus sz b (@wneg sz b))) c *)
    rewrite wminus_inv.
(* Goal: @eq (word sz) (@wplus sz c (wzero sz)) c *)
    rewrite wplus_wzero_1.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
Qed.

Lemma move_wplus_pow2 sz (w1 w2: word (S sz)):
  w1 = w2 ^+ $(pow2 sz) <->
  w1 ^+ $(pow2 sz) = w2.
Proof.
(* Goal: and (Z.le Z0 (Z.of_N (@wordToN sz a))) (Z.lt (Z.of_N (@wordToN sz a)) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  split.
  + intro.
(* Goal: @eq (word (S sz)) w1 (@wminus (S sz) w2 (natToWord (S sz) (Nat.pow (S (S O)) sz))) *)
    apply move_wplus_wminus.
(* Goal: @eq (word (S sz)) w1 (@wminus (S sz) w2 (natToWord (S sz) (Nat.pow (S (S O)) sz))) *)
    rewrite wminus_def.
(* Goal: @eq (word (S sz)) w1 (@wminus (S sz) w2 (@wneg (S sz) (natToWord (S sz) (Nat.pow (S (S O)) sz)))) *)
    rewrite pow2_wneg.
(* Goal: False *)
    assumption.
  + intro.
(* Goal: @eq (word (S sz)) w1 (@wplus (S sz) w2 (natToWord (S sz) (Nat.pow (S (S O)) sz))) *)
    apply move_wplus_wminus in H.
    rewrite <- pow2_wneg.
(* Goal: False *)
    assumption.
Qed.

Lemma move_wminus_pow2 sz (w1 w2: word (S sz)):
  w1 = w2 ^- $(pow2 sz) <->
  w1 ^- $(pow2 sz) = w2.
Proof.
(* Goal: and (Z.le Z0 (Z.of_N (@wordToN sz a))) (Z.lt (Z.of_N (@wordToN sz a)) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  split.
  + intro.
    apply <- move_wplus_wminus.
(* Goal: @eq (word (S sz)) w1 (@wminus (S sz) w2 (@wneg (S sz) (natToWord (S sz) (Nat.pow (S (S O)) sz)))) *)
    rewrite pow2_wneg.
(* Goal: False *)
    assumption.
  + intro.
(* Goal: @eq (word (S sz)) w1 (@wminus (S sz) w2 (natToWord (S sz) (Nat.pow (S (S O)) sz))) *)
    apply move_wplus_wminus.
    rewrite <- pow2_wneg.
    rewrite <- wminus_def.
(* Goal: False *)
    assumption.
Qed.

Lemma pow2_wzero sz :
  $(pow2 sz) = wzero sz.
Proof.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz))) (wzero (Init.Nat.add sz (S O))) *)
  apply wordToNat_eq2.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz a))) (Nat.pow (S (S O)) sz)) (Nat.modulo (Init.Nat.mul (@wordToNat sz a) (@wordToNat sz (natToWord sz (Nat.pow (S (S O)) n)))) (Nat.pow (S (S O)) sz)) *)
  rewrite wordToNat_natToWord_eqn.
(* Goal: @eq nat (Nat.modulo (Nat.pow (S (S O)) sz) (Nat.pow (S (S O)) sz)) (@wordToNat sz (wzero sz)) *)
  rewrite Nat.mod_same.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wordToNat_wzero; auto.
(* Goal: not (@eq nat (Nat.pow (S (S O)) sz) O) *)
  pose proof (zero_lt_pow2 sz) as sth.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma pow2_wplus_wzero sz:
  $(pow2 sz) ^+ $(pow2 sz) = wzero (sz + 1).
Proof.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz))) (wzero (Init.Nat.add sz (S O))) *)
  apply wordToNat_eq2.
  rewrite <- natToWord_plus.
  rewrite <- mul2_add.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  assert (pow2_1_mul: pow2 1 = 2) by auto.
  rewrite <- pow2_1_mul at 2.
  rewrite <- pow2_add_mul.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite pow2_wzero; auto.
Qed.

Lemma wplus_wplus_pow2 sz (x1 x2 y1 y2: word (sz + 1)):
  x1 = y1 ^+ $(pow2 sz) ->
  x2 = y2 ^+ $(pow2 sz) ->
  x1 ^+ x2 = y1 ^+ y2.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
  rewrite H.
  rewrite <- wplus_assoc.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) y2 y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wplus_comm.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) x2) y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wplus_comm in H0.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) x2) y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite H0.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) y2)) y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wplus_assoc.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (@wplus (Init.Nat.add sz (S O)) (@wplus (Init.Nat.add sz (S O)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz)) (natToWord (Init.Nat.add sz (S O)) (Nat.pow (S (S O)) sz))) y2) y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite pow2_wplus_wzero.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) (@wplus (Init.Nat.add sz (S O)) (wzero (Init.Nat.add sz (S O))) y2) y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wzero_wplus.
(* Goal: @eq (word (Init.Nat.add sz (S O))) (@wplus (Init.Nat.add sz (S O)) y2 y1) (@wplus (Init.Nat.add sz (S O)) y1 y2) *)
  rewrite wplus_comm.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.



Lemma wlt_meaning sz (w1 w2: word sz):
  (w1 < w2)%word <-> #w1 < #w2.
Proof.
(* Goal: iff (@wlt sz w1 w2) (lt (@wordToNat sz w1) (@wordToNat sz w2)) *)
  pose proof (@wordToNat_gt1 sz w2 w1).
(* Goal: iff (@wlt sz w1 w2) (lt (@wordToNat sz w1) (@wordToNat sz w2)) *)
  pose proof (@wordToNat_gt2 sz w2 w1).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  tauto.
Qed.

Lemma combine_wplus sz (w1 w2: word sz):
  #w1 + #w2 < pow2 sz ->
  forall sz' (w': word sz'),
    combine (w1 ^+ w2) w' = combine w1 w' ^+ combine w2 ($ 0).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_word_omega.
  rewrite wordToNat_wplus in *.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Nat.add n sz) (@combine n (wzero n) sz (natToWord sz O))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  rewrite ?wordToNat_combine.
(* Goal: @eq nat (Init.Nat.add (@wordToNat sz (@wplus sz w1 w2)) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Nat.modulo (Init.Nat.add (Init.Nat.add (@wordToNat sz w1) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Init.Nat.add (@wordToNat sz w2) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' (natToWord sz' O))))) (Nat.pow (S (S O)) (Init.Nat.add sz sz'))) *)
  rewrite wordToNat_natToWord_idempotent' by (apply pow2_zero).
(* Goal: @eq nat (S O) (Init.Nat.add (@wordToNat sz (natToWord sz (S O))) (Init.Nat.mul (Nat.pow (S (S O)) sz) O)) *)
  rewrite Nat.mul_0_r, Nat.add_0_r.
(* Goal: @eq nat (Init.Nat.add (@wordToNat sz (@wplus sz w1 w2)) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Nat.modulo (Init.Nat.add (Init.Nat.add (@wordToNat sz w1) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (@wordToNat sz w2)) (Nat.pow (S (S O)) (Init.Nat.add sz sz'))) *)
  rewrite wordToNat_wplus.
(* Goal: False *)
  rewrite Nat.mod_small by assumption.
  assert (sth: #w1 + #w2 + pow2 sz * #w' = #w1 + pow2 sz * #w' + #w2) by ring.
  rewrite <- sth; clear sth.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite Nat.mod_small; auto.
(* Goal: lt (Init.Nat.add (Init.Nat.add (@wordToNat sz w1) (@wordToNat sz w2)) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Nat.pow (S (S O)) (Init.Nat.add sz sz')) *)
  rewrite Nat.pow_add_r.
  assert (sth: pow2 sz' = 1 + (pow2 sz' - 1)) by (pose proof (pow2_zero sz'); omega).
(* Goal: @eq nat (Init.Nat.sub n (Init.Nat.mul (Nat.pow (S (S O)) sz) x)) (Nat.modulo n (Nat.pow (S (S O)) sz)) *)
  rewrite sth; clear sth.
(* Goal: lt (Init.Nat.add (Init.Nat.add (@wordToNat sz w1) (@wordToNat sz w2)) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Nat.mul (Nat.pow (S (S O)) sz) (Init.Nat.add (S O) (Init.Nat.sub (Nat.pow (S (S O)) sz') (S O)))) *)
  rewrite Nat.mul_add_distr_l.
(* Goal: lt (Init.Nat.add (Init.Nat.add (@wordToNat sz w1) (@wordToNat sz w2)) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Nat.add (Nat.mul (Nat.pow (S (S O)) sz) (S O)) (Nat.mul (Nat.pow (S (S O)) sz) (Init.Nat.sub (Nat.pow (S (S O)) sz') (S O)))) *)
  rewrite Nat.mul_1_r.
(* Goal: lt (Init.Nat.add (Init.Nat.add (@wordToNat sz w1) (@wordToNat sz w2)) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Nat.add (Nat.pow (S (S O)) sz) (Nat.mul (Nat.pow (S (S O)) sz) (Init.Nat.sub (Nat.pow (S (S O)) sz') (S O)))) *)
  pose proof (wordToNat_bound w').
(* Goal: lt (S O) (Nat.add (Nat.pow (S (S O)) sz) (Nat.add (Nat.pow (S (S O)) sz) O)) *)
  pose proof (pow2_zero sz).
(* Goal: lt (Init.Nat.add (Init.Nat.add (@wordToNat sz w1) (@wordToNat sz w2)) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Nat.add (Nat.pow (S (S O)) sz) (Nat.mul (Nat.pow (S (S O)) sz) (Init.Nat.sub (Nat.pow (S (S O)) sz') (S O)))) *)
  apply Nat.lt_le_pred in H0.
(* Goal: lt (Init.Nat.add (Init.Nat.add (@wordToNat sz w1) (@wordToNat sz w2)) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Nat.add (Nat.pow (S (S O)) sz) (Nat.mul (Nat.pow (S (S O)) sz) (Init.Nat.sub (Nat.pow (S (S O)) sz') (S O)))) *)
  rewrite pred_of_minus in H0.
(* Goal: lt (Init.Nat.add (Init.Nat.add (@wordToNat sz w1) (@wordToNat sz w2)) (Init.Nat.mul (Nat.pow (S (S O)) sz) (@wordToNat sz' w'))) (Nat.add (Nat.pow (S (S O)) sz) (Nat.mul (Nat.pow (S (S O)) sz) (Init.Nat.sub (Nat.pow (S (S O)) sz') (S O)))) *)
  pose proof (mult_le_compat_l _ _ (pow2 sz) H0).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma word1_neq (w: word 1):
  w <> WO~0 ->
  w <> WO~1 ->
  False.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  shatter_word w; intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct x; tauto.
Qed.

Lemma combine_1 sz:
  sz > 1 ->
  natToWord (sz + 1) 1 = combine ($ 1) WO~0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <- natToWord_wordToNat.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  rewrite wordToNat_combine; simpl.
(* Goal: @eq nat (S O) (Init.Nat.add (@wordToNat sz (natToWord sz (S O))) (Init.Nat.mul (Nat.pow (S (S O)) sz) O)) *)
  rewrite Nat.mul_0_r, Nat.add_0_r.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite wordToNat_natToWord_idempotent'; auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  destruct sz; simpl; try omega.
(* Goal: lt (S O) (Nat.add (Nat.pow (S (S O)) sz) (Nat.add (Nat.pow (S (S O)) sz) O)) *)
  pose proof (pow2_zero sz).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wordToNat_cast ni no (pf: ni = no):
  forall w,
    #w = #(match pf in _ = Y return _ Y with
           | eq_refl => w
           end).
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct pf; intros; auto.
Qed.


Lemma countLeadingZerosWord_lt_len no ni:
  ni < pow2 no ->
  forall w: word ni,
    w <> wzero ni ->
    (countLeadingZerosWord no w < natToWord _ ni)%word.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction ni; auto; intros.
  - shatter_word w.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    tauto.
  - unfold countLeadingZerosWord; fold countLeadingZerosWord.
(* Goal: @wlt no (if @weq (S O) (split2 ni (S O) (@nat_cast (fun n : nat => word n) (S ni) (Nat.add ni (S O)) (@eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni)) w)) (@WS false O WO) then @wplus no (natToWord no (S O)) (@countLeadingZerosWord ni no (split1 ni (S O) (@nat_cast (fun n : nat => word n) (S ni) (Nat.add ni (S O)) (@eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni)) w))) else natToWord no O) (natToWord no (S ni)) *)
    rewrite nat_cast_cast.
    match goal with
    | |- ((if ?P then _ else _) < _)%word => destruct P; simpl; auto
    end.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + assert (sth: ni < pow2 no) by omega.
(* Goal: @wlt no (@wplus no (natToWord no (S O)) (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end))) (natToWord no (S ni)) *)
      specialize (IHni sth).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      assert (sth1: natToWord no (S ni) = natToWord no (1 + ni)) by auto.
(* Goal: @wlt no (@wplus no (natToWord no (S O)) (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end))) (natToWord no (S ni)) *)
      rewrite sth1.
(* Goal: @wlt no (@wplus no (natToWord no (S O)) (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end))) (natToWord no (Init.Nat.add (S O) ni)) *)
      rewrite natToWord_plus.
      match goal with
      | |- ((_ ^+ countLeadingZerosWord no ?P) < _)%word => specialize (IHni P)
      end.
      match goal with
      | |- (?a ^+ ?b < ?c ^+ ?d)%word =>
        rewrite (wplus_comm a b); rewrite (wplus_comm c d)
      end.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      pre_word_omega.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      assert (sth2: no > 0). {
(* Goal: gt no O *)
        destruct no; [|omega].
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        destruct ni; simpl in *; try omega.
      }
(* Goal: lt (@wordToNat no (@wplus no (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end)) (natToWord no (S O)))) (@wordToNat no (@wplus no (natToWord no ni) (natToWord no (S O)))) *)
      apply wordToNat_zero in e.
      match type of IHni with
      | split1 ni 1 ?P <> _ -> _ =>
        assert (sth3: #P <> 0) by (rewrite <- wordToNat_cast; auto);
          apply wordToNat_notZero in sth3;
          rewrite <- (combine_split ni 1 P) in sth3
      end.
      rewrite e in *.
      match type of sth3 with
      | combine ?P _ <> _ => destruct (weq P (natToWord _ 0));
                               [rewrite e0 in *; rewrite combine_zero in sth3; tauto|]
      end.
(* Goal: lt (@wordToNat no (@wplus no (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end)) (natToWord no (S O)))) (@wordToNat no (@wplus no (natToWord no ni) (natToWord no (S O)))) *)
      specialize (IHni n).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
      rewrite <- ?(@natplus1_wordplus1_eq _ _ (wones no)); auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      * pre_word_omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      * pre_word_omega.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz a))) (Nat.pow (S (S O)) sz)) (Nat.modulo (Init.Nat.mul (@wordToNat sz a) (@wordToNat sz (natToWord sz (Nat.pow (S (S O)) n)))) (Nat.pow (S (S O)) sz)) *)
        rewrite wordToNat_natToWord_eqn.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
        rewrite Nat.mod_small; auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      *  pre_word_omega.
(* Goal: lt (@wordToNat no (@countLeadingZerosWord ni no (split1 ni (S O) match @eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni) in (eq _ Y) return (word Y) with | eq_refl => w end))) (Init.Nat.sub (Nat.pow (S (S O)) no) (S O)) *)
         rewrite wordToNat_natToWord_eqn in IHni.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
         rewrite Nat.mod_small in IHni; auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    + pre_word_omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      rewrite wordToNat_natToWord_idempotent'; auto; try omega.
Qed.


Fixpoint countLeadingZerosWord_nat ni: word ni -> nat :=
  match ni return word ni -> nat with
  | 0 => fun _ => 0
  | S m => fun e =>
             if (weq (split2 m 1 (nat_cast (fun n => word n) (eq_sym (Nat.add_1_r m)) e)) WO~0)
             then 1 + @countLeadingZerosWord_nat m (split1 m 1 (nat_cast (fun n => word n) (eq_sym (Nat.add_1_r m)) e))
             else 0
  end.

Lemma countLeadingZerosWord_nat_correct ni:
  forall no (w: word ni),
    ni < pow2 no ->
    #(countLeadingZerosWord no w) = countLeadingZerosWord_nat w.
Proof.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  induction ni; intros; simpl; auto.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  - rewrite ?wordToNat_natToWord_idempotent'; auto.
  - match goal with
    | |- # (if ?P then _ else _) = if ?P then _ else _ => destruct P
    end.
    + rewrite <- wordToNat_plus.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      rewrite ?wordToNat_natToWord_idempotent'; try omega.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
      * simpl;f_equal.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
        rewrite IHni; auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
      * rewrite ?wordToNat_natToWord_idempotent'; try omega.
        match goal with
        | |- 1 + #(countLeadingZerosWord no ?x) < _ => pose proof (@countLeadingZerosWord_le_len_nat no ni ltac:(omega) x) as sth
        end.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        omega.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
    + rewrite roundTrip_0; auto.
Qed.

Lemma countLeadingZerosWord_nat_le_len ni (w: word ni):
  countLeadingZerosWord_nat w <= ni.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  induction ni; simpl; auto; intros.
  match goal with
  | |- ((if ?P then _ else _) <= _) => destruct P; simpl; auto
  end.
(* Goal: le (S (@countLeadingZerosWord_nat ni (split1 ni (S O) (@nat_cast (fun n : nat => word n) (S ni) (Nat.add ni (S O)) (@eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni)) w)))) (S ni) *)
  apply Le.le_n_S.
(* Goal: le (@countLeadingZerosWord_nat ni (split1 ni (S O) (@nat_cast (fun n : nat => word n) (S ni) (Nat.add ni (S O)) (@eq_sym nat (Nat.add ni (S O)) (S ni) (Nat.add_1_r ni)) w))) ni *)
  eapply IHni.
Qed.

Lemma countLeadingZerosWord_enough_size ni no no' (pf: ni < pow2 no) (pf': ni < pow2 no'): forall (w: word ni),
    #(countLeadingZerosWord no w) =
    #(countLeadingZerosWord no' w).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  rewrite ?countLeadingZerosWord_nat_correct; auto.
Qed.

(* Usually this kind of lemmas would need a guarantee that "(wordToN a mod wordToN b)%N"
   does not overflow, but fortunately this can never overflow.
   And also, we don't need to prevent b from being 0. *)
Lemma wordToN_mod: forall sz (a b: word sz),
    wordToN (a ^% b) = (wordToN a mod wordToN b)%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold wmod, wordBin.
  rewrite wordToN_NToWord_2; [ reflexivity | ].
  destruct (wordToN b) eqn: E.
(* Goal: @eq nat (Init.Nat.add (@wordToNat n (natToWord n x)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat (S O) (natToWord (S O) O)))) (@wordToNat (Init.Nat.add n (S O)) (natToWord (Init.Nat.add n (S O)) x)) *)
  - unfold N.modulo, N.div_eucl. destruct (wordToN a) eqn: F; simpl.
    + apply Npow2_pos.
    + rewrite <- F. apply wordToN_bound.
  - eapply N.lt_trans.
(* Goal: @eq (word sz) (ZToWord sz x) (ZToWord sz y) *)
    + apply N.mod_upper_bound. congruence.
    + rewrite <- E. apply wordToN_bound.
Qed.

Lemma wordToNat_mod: forall sz (a b: word sz),
    b <> $0 ->
    #(a ^% b) = #a mod #b.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <-? wordToN_to_nat in *.
  rewrite <-? N2Nat.inj_mod in *.
  - rewrite wordToN_mod by assumption.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    reflexivity.
  - intro. apply H. replace 0%N with (wordToN (natToWord sz 0)) in H0.
    + apply wordToN_inj. exact H0.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
    + erewrite <- wordToN_wzero. reflexivity.
Qed.

Lemma wlshift_mul_pow2: forall sz n (a: word sz),
    wlshift a n = a ^* $ (pow2 n).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wlshift sz (natToWord sz O) n) (natToWord sz O) *)
  apply wordToNat_inj.
(* Goal: @eq nat (@wordToNat sz (@wlshift sz (natToWord sz O) n)) (@wordToNat sz (natToWord sz O)) *)
  unfold wlshift.
(* Goal: @eq nat (@wordToNat sz (split1 sz n (@eq_rec_r nat (Nat.add n sz) (fun n : nat => word n) (@combine n (wzero n) sz (natToWord sz O)) (Nat.add sz n) (Nat.add_comm sz n)))) (@wordToNat sz (natToWord sz O)) *)
  rewrite? wordToNat_split1.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@eq_rec_r nat (Nat.add n sz) (fun n : nat => word n) (@combine n (wzero n) sz (natToWord sz O)) (Nat.add sz n) (Nat.add_comm sz n))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  unfold eq_rec_r, eq_rec.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@eq_rect nat (Nat.add n sz) (fun y : nat => word y) (@combine n (wzero n) sz (natToWord sz O)) (Nat.add sz n) (@eq_sym nat (Nat.add sz n) (Nat.add n sz) (Nat.add_comm sz n)))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  rewrite? wordToNat_eq_rect.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Nat.add n sz) (@combine n (wzero n) sz (natToWord sz O))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  rewrite? wordToNat_combine.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add (@wordToNat n (wzero n)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz (natToWord sz O)))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  rewrite? wordToNat_wzero.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz a))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (@wmult sz a (natToWord sz (Nat.pow (S (S O)) n)))) *)
  rewrite wordToNat_wmult.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz a))) (Nat.pow (S (S O)) sz)) (Nat.modulo (Init.Nat.mul (@wordToNat sz a) (@wordToNat sz (natToWord sz (Nat.pow (S (S O)) n)))) (Nat.pow (S (S O)) sz)) *)
  rewrite wordToNat_natToWord_eqn.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz a))) (Nat.pow (S (S O)) sz)) (Nat.modulo (Init.Nat.mul (@wordToNat sz a) (Nat.modulo (Nat.pow (S (S O)) n) (Nat.pow (S (S O)) sz))) (Nat.pow (S (S O)) sz)) *)
  rewrite Nat.add_0_l.
(* Goal: @eq nat (Nat.modulo (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz a)) (Nat.pow (S (S O)) sz)) (Nat.modulo (Init.Nat.mul (@wordToNat sz a) (Nat.modulo (Nat.pow (S (S O)) n) (Nat.pow (S (S O)) sz))) (Nat.pow (S (S O)) sz)) *)
  rewrite Nat.mul_mod_idemp_r by (apply pow2_ne_zero).
(* Goal: @eq nat (Nat.modulo (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz a)) (Nat.pow (S (S O)) sz)) (Nat.modulo (Nat.mul (@wordToNat sz a) (Nat.pow (S (S O)) n)) (Nat.pow (S (S O)) sz)) *)
  rewrite Nat.mul_comm.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wlshift_mul_Zpow2: forall sz n (a: word sz),
    (0 <= n)%Z ->
    wlshift a (Z.to_nat n) = a ^* ZToWord sz (2 ^ n).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite wlshift_mul_pow2. f_equal.
(* Goal: @eq (word sz) (natToWord sz (Nat.pow (S (S O)) (Z.to_nat n))) (ZToWord sz (Z.pow (Zpos (xO xH)) n)) *)
  change 2 with (Z.to_nat 2).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite <- Z2Nat.inj_pow by omega.
(* Goal: @eq (word sz) (natToWord sz (Z.to_nat (Z.pow (Zpos (xO xH)) n))) (ZToWord sz (Z.pow (Zpos (xO xH)) n)) *)
  apply natToWord_Z_to_nat.
(* Goal: Z.le Z0 (Z.pow (Zpos (xO xH)) n) *)
  apply Z.pow_nonneg.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  omega.
Qed.

Lemma wlshift_distr_plus: forall sz n (a b: word sz),
    wlshift (a ^+ b) n = wlshift a n ^+ wlshift b n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wlshift sz (@wlshift sz a n1) n2) (@wlshift sz a (Init.Nat.add n1 n2)) *)
  rewrite? wlshift_mul_pow2.
(* Goal: @eq (word sz) (@wmult sz (@wplus sz x y) z) (@wplus sz (@wmult sz x z) (@wmult sz y z)) *)
  apply wmult_plus_distr.
Qed.

Lemma wlshift'_distr_plus: forall sz n (a b: word sz),
    wlshift' (a ^+ b) n = wlshift' a n ^+ wlshift' b n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite? wlshift_alt. apply wlshift_distr_plus.
Qed.

Lemma wlshift_iter: forall sz n1 n2 (a: word sz),
    wlshift (wlshift a n1) n2 = wlshift a (n1 + n2).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite? wlshift_mul_pow2.
  rewrite <- wmult_assoc.
  rewrite <- natToWord_mult.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  do 2 f_equal.
(* Goal: @eq (word sz) a (NToWord sz (@wordToN sz a)) *)
  symmetry.
(* Goal: @eq nat (Nat.pow (S (S O)) (Init.Nat.add n1 n2)) (Init.Nat.mul (Nat.pow (S (S O)) n1) (Nat.pow (S (S O)) n2)) *)
  apply Nat.pow_add_r.
Qed.

Lemma wlshift'_iter: forall sz n1 n2 (a: word sz),
    wlshift' (wlshift' a n1) n2 = wlshift' a (n1 + n2).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite? wlshift_alt. apply wlshift_iter.
Qed.

Lemma wlshift_zero: forall sz n, wlshift $0 n = natToWord sz 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (@wlshift sz (natToWord sz O) n) (natToWord sz O) *)
  apply wordToNat_inj.
(* Goal: @eq nat (@wordToNat sz (@wlshift sz (natToWord sz O) n)) (@wordToNat sz (natToWord sz O)) *)
  unfold wlshift.
(* Goal: @eq nat (@wordToNat sz (split1 sz n (@eq_rec_r nat (Nat.add n sz) (fun n : nat => word n) (@combine n (wzero n) sz (natToWord sz O)) (Nat.add sz n) (Nat.add_comm sz n)))) (@wordToNat sz (natToWord sz O)) *)
  rewrite? wordToNat_split1.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@eq_rec_r nat (Nat.add n sz) (fun n : nat => word n) (@combine n (wzero n) sz (natToWord sz O)) (Nat.add sz n) (Nat.add_comm sz n))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  unfold eq_rec_r, eq_rec.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Init.Nat.add sz n) (@eq_rect nat (Nat.add n sz) (fun y : nat => word y) (@combine n (wzero n) sz (natToWord sz O)) (Nat.add sz n) (@eq_sym nat (Nat.add sz n) (Nat.add n sz) (Nat.add_comm sz n)))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  rewrite? wordToNat_eq_rect.
(* Goal: @eq nat (Nat.modulo (@wordToNat (Nat.add n sz) (@combine n (wzero n) sz (natToWord sz O))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  rewrite? wordToNat_combine.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add (@wordToNat n (wzero n)) (Init.Nat.mul (Nat.pow (S (S O)) n) (@wordToNat sz (natToWord sz O)))) (Nat.pow (S (S O)) sz)) (@wordToNat sz (natToWord sz O)) *)
  rewrite? wordToNat_wzero.
(* Goal: @eq nat (Nat.modulo (Init.Nat.add O (Init.Nat.mul (Nat.pow (S (S O)) n) O)) (Nat.pow (S (S O)) sz)) O *)
  rewrite Nat.mul_0_r.
  change (0 + 0) with 0.
(* Goal: @eq nat (Nat.modulo O (Nat.pow (S (S O)) sz)) O *)
  rewrite Nat.mod_0_l by (apply pow2_ne_zero).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wlshift'_zero: forall sz n, wlshift' $0 n = natToWord sz 0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite? wlshift_alt. apply wlshift_zero.
Qed.

Lemma sext_natToWord_nat_cast: forall sz2 sz1 sz n (e: sz1 + sz2 = sz),
  2 * n < pow2 sz1 ->
  nat_cast word e (sext (natToWord sz1 n) sz2) = natToWord sz n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite nat_cast_eq_rect. apply sext_natToWord. assumption.
Qed.

Lemma sext_neg_natToWord_nat_cast: forall sz2 sz1 sz n (e: sz1 + sz2 = sz),
  2 * n < pow2 sz1 ->
  nat_cast word e (sext (wneg (natToWord sz1 n)) sz2) = wneg (natToWord sz n).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite nat_cast_eq_rect. apply sext_wneg_natToWord. assumption.
Qed.

Lemma sext0: forall sz0 sz (v: word sz) (e: sz0 = 0),
  sext v sz0 = nat_cast word (eq_ind_r (fun sz0 : nat => sz = sz + sz0) (plus_n_O sz) e) v.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. subst.
(* Goal: @eq (word (Init.Nat.add sz O)) (@sext sz v O) (@nat_cast word sz (Init.Nat.add sz O) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) O (@eq_refl nat O)) v) *)
  unfold sext.
  destruct (wmsb v false) eqn: E;
    simpl; rewrite combine_n_0; rewrite <- nat_cast_eq_rect; apply nat_cast_proof_irrel.
Qed.

Lemma wordToN_wordToZ: forall (sz : nat) (w : word sz),
    wordToN w = Z.to_N (wordToZ w + Z.of_N (if wmsb w false then Npow2 sz else 0%N)).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq N (@wordToN sz w) (Z.to_N (Z.add (@wordToZ sz w) (Z.of_N (if @wmsb sz w false then Npow2 sz else N0)))) *)
  rewrite (wordToZ_wordToN w).
(* Goal: @eq N (@wordToN sz w) (Z.to_N (Z.add (Z.sub (Z.of_N (@wordToN sz w)) (Z.of_N (if @wmsb sz w false then Npow2 sz else N0))) (Z.of_N (if @wmsb sz w false then Npow2 sz else N0)))) *)
  remember (if wmsb w false then Npow2 sz else 0%N) as c; clear Heqc.
(* Goal: @eq N (@wordToN sz w) (Z.to_N (Z.add (Z.sub (Z.of_N (@wordToN sz w)) (Z.of_N c)) (Z.of_N c))) *)
  rewrite Z.sub_add.
(* Goal: @eq (word sz) a (NToWord sz (@wordToN sz a)) *)
  symmetry.
(* Goal: @eq N (Z.to_N (Z.of_N (@wordToN sz w))) (@wordToN sz w) *)
  apply N2Z.id.
Qed.

Lemma uwordToZ_ZToWord_0: forall (sz : nat) (z : Z),
    (0 <= z < Z.of_N (Npow2 sz))%Z ->
    uwordToZ (ZToWord sz z) = z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (ZToWord sz (@uwordToZ sz a)) a *)
  unfold uwordToZ.
(* Goal: @eq Z (Z.of_N (@wordToN sz (ZToWord sz z))) z *)
  pose proof (Z2N.id _ (proj1 H)).
(* Goal: @eq Z (Z.of_N (@wordToN sz (ZToWord sz z))) z *)
  remember (Z.to_N z) as n; clear Heqn. subst z.
(* Goal: @eq Z (Z.of_N (@wordToN sz (ZToWord sz (Z.of_N n)))) (Z.of_N n) *)
  apply proj2 in H.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: @eq (word sz) (ZToWord sz (Z.of_N (@wordToN sz a))) a *)
  rewrite ZToWord_Z_of_N.
(* Goal: @eq N (@wordToN sz (NToWord sz n)) n *)
  apply wordToN_NToWord_2.
(* Goal: N.lt n (Npow2 sz) *)
  apply N2Z.inj_lt.
(* Goal: False *)
  assumption.
Qed.

Lemma uwordToZ_ZToWord: forall (sz : nat) (z : Z),
    (0 <= z < 2 ^ (Z.of_nat sz))%Z ->
    uwordToZ (ZToWord sz z) = z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. apply uwordToZ_ZToWord_0.
(* Goal: and (Z.le Z0 z) (Z.lt z (Z.of_N (Npow2 sz))) *)
  intuition idtac.
(* Goal: Z.lt z (Z.of_N (Npow2 sz)) *)
  change 2%Z with (Z.of_nat 2) in H1.
  rewrite <- Nat2Z.inj_pow in H1.
  rewrite <- N_nat_Z.
(* Goal: @eq nat (@wordToNat sz (NToWord sz n)) (Nat.modulo (N.to_nat n) (N.to_nat (Npow2 sz))) *)
  rewrite Npow2_nat.
(* Goal: False *)
  assumption.
Qed.

Lemma NToWord_Z_to_N: forall sz n,
    (0 <= n)%Z ->
    NToWord sz (Z.to_N n) = ZToWord sz n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
  rewrite <- ZToWord_Z_of_N.
(* Goal: False *)
  rewrite Z2N.id by assumption.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma uwordToZ_ZToWord_k: forall (sz : nat) (n : Z),
    (0 <= n)%Z ->
    exists k, uwordToZ (ZToWord sz n) = (n - k * 2 ^ Z.of_nat sz)%Z /\ (k * 2 ^ Z.of_nat sz <= n)%Z.
Proof.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
  intros *. intro C.
(* Goal: @eq (word sz) (ZToWord sz (@uwordToZ sz a)) a *)
  unfold uwordToZ.
(* Goal: @ex Z (fun k : Z => and (@eq Z (Z.of_N (@wordToN sz (ZToWord sz n))) (Z.sub n (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) (Z.le (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) n)) *)
  pose proof (wordToN_NToWord sz (Z.to_N n)) as P.
(* Goal: @eq Z (@uwordToZ sz (ZToWord sz z)) (Z.modulo z (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  destruct P as [k [P Q]].
(* Goal: @ex Z (fun k : Z => and (@eq Z (Z.of_N (@wordToN sz (ZToWord sz n))) (Z.sub n (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) (Z.le (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) n)) *)
  exists (Z.of_N k).
(* Goal: False *)
  rewrite NToWord_Z_to_N in P by assumption.
(* Goal: and (@eq Z (Z.of_N (@wordToN sz (ZToWord sz n))) (Z.sub n (Z.mul (Z.of_N k) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) (Z.le (Z.mul (Z.of_N k) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) n) *)
  rewrite P. clear P.
  rewrite <- Z_of_N_Npow2 in *.
  rewrite <- N2Z.inj_mul.
(* Goal: False *)
  rewrite N2Z.inj_sub by assumption.
(* Goal: and (@eq Z (Z.sub (Z.of_N (Z.to_N n)) (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply N2Z.inj_le in Q.
(* Goal: False *)
  rewrite Z2N.id in * by assumption.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  auto.
Qed.

Lemma Zpow2_pos: forall n, (2 ^ Z.of_nat n > 0)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. pose proof (Z.pow_pos_nonneg 2 (Z.of_nat n)). omega.
Qed.

Lemma uwordToZ_bound: forall sz (a: word sz),
    (0 <= uwordToZ a < 2 ^ Z.of_nat sz)%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (ZToWord sz (@uwordToZ sz a)) a *)
  unfold uwordToZ.
(* Goal: and (Z.le Z0 (Z.of_N (@wordToN sz a))) (Z.lt (Z.of_N (@wordToN sz a)) (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  split.
  + apply N2Z.is_nonneg.
  + pose proof (wordToN_bound a) as P.
(* Goal: Z.lt (Z.of_N (@wordToN sz a)) (Z.pow (Zpos (xO xH)) (Z.of_nat sz)) *)
    apply N2Z.inj_lt in P.
(* Goal: Z.lt (Z.of_N (@wordToN sz a)) (Z.pow (Zpos (xO xH)) (Z.of_nat sz)) *)
    rewrite Z_of_N_Npow2 in P.
(* Goal: False *)
    assumption.
Qed.

Lemma uwordToZ_ZToWord_mod: forall (sz : nat) (z : Z),
    (0 <= z)%Z ->
    uwordToZ (ZToWord sz z) = (z mod 2 ^ (Z.of_nat sz))%Z.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z (@uwordToZ sz (ZToWord sz z)) (Z.modulo z (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  pose proof (uwordToZ_ZToWord_k sz H) as P.
(* Goal: @eq Z (@uwordToZ sz (ZToWord sz z)) (Z.modulo z (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  destruct P as [k [P Q]].
(* Goal: @eq Z (@uwordToZ sz (ZToWord sz z)) (Z.modulo z (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  pose proof (uwordToZ_bound (ZToWord sz z)) as B.
  rewrite P in *. clear P.
(* Goal: @eq Z (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz)))) (Z.modulo z (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) *)
  rewrite Zmod_eq by (apply Zpow2_pos).
  pose proof (Z.div_unique_pos z (2 ^ Z.of_nat sz) k (z - k * 2 ^ Z.of_nat sz)) as U.
(* Goal: @eq Z (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz)))) (Z.sub z (Z.mul (Z.div z (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.pow (Zpos (xO xH)) (Z.of_nat sz)))) *)
  rewrite U.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - reflexivity.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  - omega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  - rewrite Z.mul_comm. omega.
Qed.

Lemma ZToWord_uwordToZ: forall sz (a: word sz),
    ZToWord sz (uwordToZ a) = a.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (ZToWord sz (@uwordToZ sz a)) a *)
  unfold uwordToZ.
(* Goal: @eq (word sz) (ZToWord sz (Z.of_N (@wordToN sz a))) a *)
  rewrite ZToWord_Z_of_N.
(* Goal: @eq (word sz) (NToWord sz (@wordToN sz a)) a *)
  apply NToWord_wordToN.
Qed.

Lemma wordToN_neq_0: forall sz (b : word sz),
    b <> $0 ->
    wordToN b <> 0%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
  intro C.
(* Goal: P O (@WS b O WO) *)
  apply H.
(* Goal: @eq (word sz) (NToWord sz (N.sub n (N.mul k (Npow2 sz)))) (NToWord sz n) *)
  apply wordToN_inj.
  erewrite <- wordToN_wzero in C.
  unfold wzero in C.
  exact C.
Qed.

(* These counterexamples will hopefully be found by users who use commands
   such as "Search ((_ ^+ _) ^% _)" *)
Lemma wmod_plus_distr_does_not_hold: ~ forall sz (a b m: word sz),
    m <> $0 ->
    (a ^+ b) ^% m = ((a ^% m) ^+ (b ^% m)) ^% m.
Proof.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
  intro C.
(* Goal: False *)
  specialize (C 4 $9 $11 $7). cbv in C.
  match type of C with (?A -> _) => assert A by (intro; discriminate) end.
(* Goal: False *)
  specialize (C H). discriminate.
Qed.

Lemma wmul_mod_distr_does_not_hold: ~ forall sz (a b n: word sz),
    n <> $0 ->
    (a ^* b) ^% n = ((a ^% n) ^* (b ^% n)) ^% n.
Proof.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
  intro C.
(* Goal: False *)
  specialize (C 4 $9 $11 $7). cbv in C.
  match type of C with (?A -> _) => assert A by (intro; discriminate) end.
(* Goal: False *)
  specialize (C H). discriminate.
Qed.

Lemma Nmod_0_r: forall a : N, (a mod 0)%N = a.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. destruct a; reflexivity.
Qed.

Lemma wordToN_0: forall sz,
    wordToN (natToWord sz 0) = 0%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. change (natToWord sz 0) with (wzero sz).
(* Goal: @eq N (@wordToN sz (wzero sz)) N0 *)
  apply wordToN_wzero.
Qed.

Lemma NToWord_0: forall sz,
    NToWord sz 0 = $ (0).
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. change 0%nat with (N.to_nat 0).
(* Goal: @eq (word sz) (NToWord sz N0) (natToWord sz (N.to_nat N0)) *)
  apply NToWord_nat.
Qed.

Lemma wmod_0_r: forall sz (a: word sz), a ^% $0 = a.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold wmod, wordBin.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz (natToWord sz O)) (@wordToN sz m))) (natToWord sz O) *)
  rewrite wordToN_0.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz a) N0)) a *)
  rewrite Nmod_0_r.
(* Goal: @eq (word sz) (NToWord sz (@wordToN sz a)) a *)
  apply NToWord_wordToN.
Qed.

Lemma wordToN_NToWord_eqn: forall sz (n : N),
    wordToN (NToWord sz n) = (n mod Npow2 sz)%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq N (@wordToN sz (NToWord sz (N.sub n (N.mul k (Npow2 sz))))) (@wordToN sz (NToWord sz n)) *)
  pose proof (Npow2_not_zero sz).
(* Goal: @eq N (@wordToN sz (NToWord sz n)) (N.modulo n (Npow2 sz)) *)
  apply Nnat.N2Nat.inj.
(* Goal: @eq nat (N.to_nat (@wordToN sz (NToWord sz n))) (N.to_nat (N.modulo n (Npow2 sz))) *)
  rewrite wordToN_to_nat.
(* Goal: False *)
  rewrite N2Nat.inj_mod by assumption.
(* Goal: @eq nat (@wordToNat sz (NToWord sz n)) (Nat.modulo (N.to_nat n) (N.to_nat (Npow2 sz))) *)
  rewrite Npow2_nat.
  rewrite <- wordToNat_natToWord_eqn.
  rewrite <- NToWord_nat.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma Nminus_mod_idemp_r: forall a b n : N,
    (n <> 0)%N ->
    (b <= a)%N ->
    ((a - b mod n) mod n)%N = ((a - b) mod n)%N.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq N (N.modulo (N.sub a (N.modulo b n)) n) (N.modulo (N.sub a b) n) *)
  apply N2Z.inj.
(* Goal: False *)
  rewrite? N2Z.inj_mod by assumption.
(* Goal: @eq Z (Z.modulo (Z.of_N (N.sub a (N.modulo b n))) (Z.of_N n)) (Z.modulo (Z.of_N (N.sub a b)) (Z.of_N n)) *)
  pose proof (N.mod_le b n H).
(* Goal: @eq Z (Z.modulo (Z.of_N (N.sub a (N.modulo b n))) (Z.of_N n)) (Z.modulo (Z.of_N (N.sub a b)) (Z.of_N n)) *)
  rewrite N2Z.inj_sub by (eapply N.le_trans; eassumption).
(* Goal: False *)
  rewrite N2Z.inj_sub by assumption.
(* Goal: False *)
  rewrite? N2Z.inj_mod by assumption.
(* Goal: @eq Z (Z.modulo (Z.sub (Z.of_N a) (Z.modulo (Z.of_N b) (Z.of_N n))) (Z.of_N n)) (Z.modulo (Z.sub (Z.of_N a) (Z.of_N b)) (Z.of_N n)) *)
  apply Zdiv.Zminus_mod_idemp_r.
Qed.

Lemma drop_sub_N: forall sz (n k : N),
    (k * Npow2 sz <= n)%N ->
    NToWord sz (n - k * Npow2 sz) = NToWord sz n.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word sz) (NToWord sz (N.sub n (N.mul k (Npow2 sz)))) (NToWord sz n) *)
  apply wordToN_inj.
(* Goal: @eq N (@wordToN sz (NToWord sz (N.sub n (N.mul k (Npow2 sz))))) (@wordToN sz (NToWord sz n)) *)
  pose proof (Npow2_not_zero sz).
(* Goal: @eq N (@wordToN sz (NToWord sz (N.sub n (N.mul k (Npow2 sz))))) (@wordToN sz (NToWord sz n)) *)
  do 2 rewrite wordToN_NToWord_eqn.
  rewrite <- Nminus_mod_idemp_r by assumption.
(* Goal: False *)
  rewrite N.mod_mul by assumption.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.sub (N.mul c d) N0) d)) (natToWord sz O) *)
  rewrite N.sub_0_r.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  reflexivity.
Qed.

Lemma wmod_divides: forall sz (a b: word sz),
    a ^% b = $0 ->
    exists k, a = b ^* k.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. destruct (weq b $0).
  - subst b. rewrite wmod_0_r in *. subst a. exists (natToWord sz 0).
(* Goal: @eq (word sz) a (NToWord sz (@wordToN sz a)) *)
    symmetry. apply wmult_neut_r.
  - unfold wmod, wmult, wordBin in *.
(* Goal: @ex (word sz) (fun k : word sz => @eq (word sz) a (NToWord sz (N.mul (@wordToN sz b) (@wordToN sz k)))) *)
    pose proof (N.mod_divides (wordToN a) (wordToN b)) as P.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz a) (@wordToN sz a))) (natToWord sz O) *)
    apply wordToN_neq_0 in n.
(* Goal: @ex (word sz) (fun k : word sz => @eq (word sz) a (NToWord sz (N.mul (@wordToN sz b) (@wordToN sz k)))) *)
    specialize (P n).
(* Goal: @ex (word sz) (fun k : word sz => @eq (word sz) a (NToWord sz (N.mul (@wordToN sz b) (@wordToN sz k)))) *)
    destruct P as [ [k P] _].
    + apply (f_equal (@wordToN sz)) in H.
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
      rewrite wordToN_NToWord_2 in H.
(* Goal: @eq N (N.modulo (@wordToN sz a) (@wordToN sz b)) N0 *)
      * rewrite H. apply wordToN_0.
      * pose proof (wordToN_bound a). remember (wordToN a) as c. clear Heqc a.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.mul c (@wordToN sz b)))) (@wordToN sz b))) (natToWord sz O) *)
        pose proof (wordToN_bound b). remember (wordToN b) as d. clear Heqd b.
(* Goal: N.lt (N.modulo c d) (Npow2 sz) *)
        pose proof (N.mod_upper_bound c d n).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
        nomega.
    + exists (NToWord sz (k - k / (Npow2 sz) * Npow2 sz)).
(* Goal: @eq (word sz) a (NToWord sz (N.mul (@wordToN sz b) (@wordToN sz (NToWord sz (N.sub k (N.mul (N.div k (Npow2 sz)) (Npow2 sz))))))) *)
      rewrite wordToN_NToWord_2.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
      { rewrite N.mul_sub_distr_l.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.sub (N.mul c d) (N.modulo (N.mul k0 (N.mul k d)) d)) d)) (natToWord sz O) *)
        rewrite N.mul_assoc.
(* Goal: @eq (word sz) a (NToWord sz (N.sub (N.mul (@wordToN sz b) k) (N.mul (N.mul (@wordToN sz b) (N.div k (Npow2 sz))) (Npow2 sz)))) *)
        rewrite drop_sub_N.
        - rewrite <- P. symmetry. apply NToWord_wordToN.
        - rewrite <- N.mul_assoc.
          rewrite <- (N.mul_comm (Npow2 sz)).
(* Goal: N.le (N.mul (@wordToN sz b) (N.mul (Npow2 sz) (N.div k (Npow2 sz)))) (N.mul (@wordToN sz b) k) *)
          apply N.mul_le_mono_l.
(* Goal: N.le (N.mul (Npow2 sz) (N.div k (Npow2 sz))) k *)
          apply (N.mul_div_le k (Npow2 sz)).
(* Goal: not (@eq N (Npow2 sz) N0) *)
          apply Npow2_not_zero.
      }
      { rewrite <- N.mul_comm. rewrite <- N.mod_eq by (apply Npow2_not_zero).
        apply N.mod_upper_bound. apply Npow2_not_zero. }
Qed.

Lemma wmod_divides_other_direction_does_not_hold: ~ forall sz (a b: word sz),
    b <> $0 ->
    (exists k, a = b ^* k) ->
    a ^% b = $0.
Proof.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
  intro C. specialize (C 4 $14 $5).
  match type of C with (?A -> _) => assert A by (intro; discriminate) end.
(* Goal: False *)
  specialize (C H).
  match type of C with (?A -> _) => assert A as B end.
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - exists (natToWord 4 6). reflexivity.
  - specialize (C B). cbv in C. discriminate.
Qed.

Lemma wmod_mul_does_not_hold: ~ forall sz (a b: word sz),
    b <> $0 ->
    (a ^* b) ^% b = $0.
Proof.
(* Goal: not (@eq N (@wordToN sz b) N0) *)
  intro C.
(* Goal: False *)
  specialize (C 4 $6 $5).
  match type of C with (?A -> _) => assert A by (intro; discriminate) end.
(* Goal: False *)
  specialize (C H).
(* Goal: False *)
  cbv in C.
(* Goal: False *)
  discriminate.
Qed.

Lemma wmult_plus_distr_l: forall (sz : nat) (x y z : word sz),
    z ^* (x ^+ y) = z ^* x ^+ z ^* y.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. rewrite! (wmult_comm z).
(* Goal: @eq (word sz) (@wmult sz (@wplus sz x y) z) (@wplus sz (@wmult sz x z) (@wmult sz y z)) *)
  apply wmult_plus_distr.
Qed.

Lemma wmod_same: forall sz (a: word sz), a ^% a = $0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. destruct (weq a $0).
(* Goal: @eq (word sz) (natToWord sz O) (natToWord sz O) *)
  - subst a. rewrite wmod_0_r in *. reflexivity.
  - unfold wmod, wordBin. apply wordToN_neq_0 in n. rewrite N.mod_same by assumption.
(* Goal: @eq (word sz) (NToWord sz N0) (natToWord sz O) *)
    apply NToWord_0.
Qed.

Lemma wmod_0_l: forall sz (m: word sz),
    $0 ^% m = $0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. unfold wmod, wordBin.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz (natToWord sz O)) (@wordToN sz m))) (natToWord sz O) *)
  rewrite wordToN_0.
(* Goal: @eq (word sz) (NToWord sz (N.modulo N0 (@wordToN sz m))) (natToWord sz O) *)
  destruct (N.eq_dec (wordToN m) 0%N).
  - rewrite e. change (0 mod 0)%N with 0%N. apply NToWord_0.
  - rewrite N.mod_0_l by assumption. apply NToWord_0.
Qed.

Lemma wmod_plus_distr: forall sz (a b m: word sz),
    (exists k, (wordToN m * k)%N = Npow2 sz) ->
    (a ^+ b) ^% m = ((a ^% m) ^+ (b ^% m)) ^% m.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. destruct H as [k E].
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
  assert (wordToN m <> 0%N) as H. {
(* Goal: not (@eq N (@wordToN sz b) N0) *)
    intro C. rewrite C in E. simpl in E. symmetry in E.
(* Goal: False *)
    apply Npow2_not_zero in E.
(* Goal: False *)
    assumption.
  }
(* Goal: @eq (word sz) (@wmod sz (@wplus sz a b) m) (@wmod sz (@wplus sz (@wmod sz a m) (@wmod sz b m)) m) *)
  unfold wplus, wmod, wordBin.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.mul (@wordToN sz a) (@wordToN sz b)))) (@wordToN sz b))) (natToWord sz O) *)
  pose proof (wordToN_bound a). remember (wordToN a) as c. clear Heqc a.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.mul c (@wordToN sz b)))) (@wordToN sz b))) (natToWord sz O) *)
  pose proof (wordToN_bound b). remember (wordToN b) as d. clear Heqd b.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.add c d))) (@wordToN sz m))) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.add (@wordToN sz (NToWord sz (N.modulo c (@wordToN sz m)))) (@wordToN sz (NToWord sz (N.modulo d (@wordToN sz m))))))) (@wordToN sz m))) *)
  pose proof (wordToN_bound m). remember (wordToN m) as n. clear Heqn m.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.add c d))) n)) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.add (@wordToN sz (NToWord sz (N.modulo c n))) (@wordToN sz (NToWord sz (N.modulo d n)))))) n)) *)
  pose proof (N.mod_upper_bound c n H).
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.add c d))) n)) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.add (@wordToN sz (NToWord sz (N.modulo c n))) (@wordToN sz (NToWord sz (N.modulo d n)))))) n)) *)
  pose proof (N.mod_upper_bound d n H).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite (@wordToN_NToWord_2 sz (c mod n)) by nomega.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  rewrite (@wordToN_NToWord_2 sz (d mod n)) by nomega.
  repeat match goal with
  | |- context [wordToN (NToWord ?sz ?n)] =>
    let k := fresh "k" in
    let E := fresh "E" in
    let B := fresh "B" in
    destruct (wordToN_NToWord sz n) as [ k [E B] ];
    rewrite E in *; clear E
  end.
  rewrite <- E in *.
  rewrite <- Nminus_mod_idemp_r by assumption.
  rewrite <- (@Nminus_mod_idemp_r (c mod n + d mod n)) by assumption.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.sub (N.add c d) (N.modulo (N.mul k0 (N.mul n k)) n)) n)) (NToWord sz (N.modulo (N.sub (N.add (N.modulo c n) (N.modulo d n)) (N.modulo (N.mul k1 (N.mul n k)) n)) n)) *)
  rewrite (N.mul_comm n k).
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.sub (N.mul c d) (N.modulo (N.mul k0 (N.mul k d)) d)) d)) (natToWord sz O) *)
  do 2 rewrite N.mul_assoc.
(* Goal: False *)
  do 2 rewrite N.mod_mul by assumption.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.sub (N.mul c d) N0) d)) (natToWord sz O) *)
  do 2 rewrite N.sub_0_r.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.add c d) n)) (NToWord sz (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n)) *)
  f_equal.
(* Goal: @eq N (N.modulo (N.add c d) n) (N.modulo (N.add (N.modulo c n) (N.modulo d n)) n) *)
  apply N.add_mod.
(* Goal: False *)
  assumption.
Qed.

Lemma wmod_mul: forall sz (a b: word sz),
    (exists k, (wordToN b * k)%N = Npow2 sz) ->
    (a ^* b) ^% b = $0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros. destruct H as [k E].
(* Goal: not (@eq N (@wordToN sz b) N0) *)
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
  assert (wordToN b <> 0%N) as H. {
(* Goal: not (@eq N (@wordToN sz b) N0) *)
    intro C. rewrite C in E. simpl in E. symmetry in E.
(* Goal: False *)
    apply Npow2_not_zero in E.
(* Goal: False *)
    assumption.
  }
(* Goal: @eq (word sz) (@wmod sz (@wmult sz a b) b) (natToWord sz O) *)
  unfold wmult, wmod, wordBin.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.mul (@wordToN sz a) (@wordToN sz b)))) (@wordToN sz b))) (natToWord sz O) *)
  pose proof (wordToN_bound a). remember (wordToN a) as c. clear Heqc a.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.mul c (@wordToN sz b)))) (@wordToN sz b))) (natToWord sz O) *)
  pose proof (wordToN_bound b). remember (wordToN b) as d. clear Heqd b.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (@wordToN sz (NToWord sz (N.mul c d))) d)) (natToWord sz O) *)
  pose proof (N.mod_upper_bound c d H).
  repeat match goal with
  | |- context [wordToN (NToWord ?sz ?n)] =>
    let k := fresh "k" in
    let E := fresh "E" in
    let B := fresh "B" in
    destruct (wordToN_NToWord sz n) as [ k [E B] ];
    rewrite E in *; clear E
  end.
  rewrite <- E in *.
  rewrite <- Nminus_mod_idemp_r by assumption.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.sub (N.mul c d) (N.modulo (N.mul k0 (N.mul d k)) d)) d)) (natToWord sz O) *)
  rewrite (N.mul_comm d k).
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.sub (N.mul c d) (N.modulo (N.mul k0 (N.mul k d)) d)) d)) (natToWord sz O) *)
  rewrite N.mul_assoc.
(* Goal: False *)
  rewrite N.mod_mul by assumption.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.sub (N.mul c d) N0) d)) (natToWord sz O) *)
  rewrite N.sub_0_r.
(* Goal: False *)
  rewrite N.mul_mod by assumption.
(* Goal: False *)
  rewrite N.mod_same by assumption.
(* Goal: @eq (word sz) (NToWord sz (N.modulo (N.mul (N.modulo c d) N0) d)) (natToWord sz O) *)
  rewrite N.mul_0_r.
(* Goal: False *)
  rewrite N.mod_0_l by assumption.
(* Goal: @eq (word sz) (NToWord sz N0) (natToWord sz O) *)
  apply NToWord_0.
Qed.

Lemma combine_zero_general sz1 sz2:
  forall (w: word sz1) (b: word sz2), (combine w b = $ 0 -> w = $ 0 /\ b = $ 0)%word.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_word_omega.
  rewrite wordToNat_combine in *.
(* Goal: @eq Z (Z.add z (Z.mul k (Z.of_N (Npow2 sz)))) (Z.sub z (Z.mul (Z.opp k) (Z.of_N (Npow2 sz)))) *)
  assert (sth1: wordToNat w = 0) by lia.
(* Goal: and (@eq (word sz1) w (natToWord sz1 O)) (@eq (word sz2) b (natToWord sz2 O)) *)
  pose proof (pow2_zero sz1) as sth2.
(* Goal: lt (@wordToNat sz2 x2) (@wordToNat sz2 y2) *)
  assert (sth3: wordToNat b = 0) by nia.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  split; eapply wordToNat_zero; eauto.
Qed.

Lemma combine_lt sz1 sz2:
  forall (w1 w2: word sz1) (b1 b2: word sz2), (combine w1 b1 < combine w2 b2 ->
                                               b1 <= b2)%word.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_word_omega.
  rewrite ?wordToNat_combine in *.
(* Goal: or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  pose proof (pow2_zero sz1).
(* Goal: le (@wordToNat sz2 b1) (@wordToNat sz2 b2) *)
  pose proof (wordToNat_bound w1).
(* Goal: le (@wordToNat sz2 b1) (@wordToNat sz2 b2) *)
  pose proof (wordToNat_bound w2).
(* Goal: lt (@wordToNat sz2 x2) (@wordToNat sz2 y2) *)
  nia.
Qed.

Lemma split2_le sz1 sz2:
  forall (w1 w2: word (sz1 + sz2)), (w1 <= w2 ->
                                     split2 _ _ w1 <= split2 _ _ w2)%word.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_word_omega.
(* Goal: le (@wordToNat sz2 (split2 sz1 sz2 w1)) (@wordToNat sz2 (split2 sz1 sz2 w2)) *)
  rewrite ?wordToNat_split2.
(* Goal: or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  pose proof (pow2_zero sz1).
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  apply Nat.div_le_mono; auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  Omega.omega.
Qed.

Lemma word1_neq': forall w : word 1, w <> WO~1 -> w = WO~0.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq (word (S O)) w (@WS false O WO) *)
  shatter_word w.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  destruct x; auto; tauto.
Qed.

Lemma combine_ge sz1 sz2 (x1 y1: word sz1) (x2 y2: word sz2):
  (combine x1 x2 <= combine y1 y2 ->
   x2 < y2 \/ (x2 = y2 /\ x1 <= y1))%word.
Proof.
(* Goal: forall _ : not (@wlt (Init.Nat.add sz1 sz2) (@combine sz1 y1 sz2 y2) (@combine sz1 x1 sz2 x2)), or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  intros.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
  pre_word_omega.
  rewrite ?wordToNat_combine in *.
(* Goal: or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  pose proof (pow2_zero sz1).
(* Goal: or (@wlt sz2 x2 y2) (and (@eq (word sz2) x2 y2) (not (@wlt sz1 y1 x1))) *)
  pose proof (pow2_zero sz2).
(* Goal: @eq (word (Init.Nat.add sz sz0)) (@sext sz v sz0) (@nat_cast word sz (Init.Nat.add sz sz0) (@eq_ind_r nat O (fun sz0 : nat => @eq nat sz (Init.Nat.add sz sz0)) (plus_n_O sz) sz0 e) v) *)
  destruct (weq x2 y2); subst.
(* Goal: and (@eq Z (Z.sub n (Z.of_N (N.mul k (Npow2 sz)))) (Z.sub n (Z.of_N (N.mul k (Npow2 sz))))) (Z.le (Z.of_N (N.mul k (Npow2 sz))) n) *)
  - right; split; auto.
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    word_omega.
  - left.
(* Goal: @wlt sz2 x2 y2 *)
    pose proof (wordToNat_bound x1).
(* Goal: @wlt sz2 x2 y2 *)
    pose proof (wordToNat_bound y1).
(* Goal: @eq Z z (Z.add (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))) (Z.sub z (Z.mul k (Z.pow (Zpos (xO xH)) (Z.of_nat sz))))) *)
    pre_word_omega.
(* Goal: lt (@wordToNat sz2 x2) (@wordToNat sz2 y2) *)
    nia.
Qed.



Local Close Scope nat.
Close Scope word_scope.

Module Notations.
  Export ArithmeticNotations.
  Export BitwiseNotations.
  Export ComparisonNotations.
  Export ConversionNotations.
  Export ShiftNotations.
End Notations.
