(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 2 of the License, or  *)
(*  (at your option) any later version.  This file is also distributed *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

(** Formalizations of machine integers modulo $2^N$ #2<sup>N</sup>#. *)

Require Import Eqdep_dec Zquot Zwf.
Require Import Coqlib.
Require Archi.

(** * Comparisons *)

Inductive comparison : Type :=
  | Ceq : comparison               (**r same *)
  | Cne : comparison               (**r different *)
  | Clt : comparison               (**r less than *)
  | Cle : comparison               (**r less than or equal *)
  | Cgt : comparison               (**r greater than *)
  | Cge : comparison.              (**r greater than or equal *)

Definition negate_comparison (c: comparison): comparison :=
  match c with
  | Ceq => Cne
  | Cne => Ceq
  | Clt => Cge
  | Cle => Cgt
  | Cgt => Cle
  | Cge => Clt
  end.

Definition swap_comparison (c: comparison): comparison :=
  match c with
  | Ceq => Ceq
  | Cne => Cne
  | Clt => Cgt
  | Cle => Cge
  | Cgt => Clt
  | Cge => Cle
  end.

(** * Parameterization by the word size, in bits. *)

Module Type WORDSIZE.
  Parameter wordsize: nat.
  Axiom wordsize_not_zero: wordsize <> 0%nat.
End WORDSIZE.

(* To avoid useless definitions of inductors in extracted code. *)
Local Unset Elimination Schemes.
Local Unset Case Analysis Schemes.

Module Make(WS: WORDSIZE).

Definition wordsize: nat := WS.wordsize.
Definition zwordsize: Z := Z.of_nat wordsize.
Definition modulus : Z := two_power_nat wordsize.
Definition half_modulus : Z := modulus / 2.
Definition max_unsigned : Z := modulus - 1.
Definition max_signed : Z := half_modulus - 1.
Definition min_signed : Z := - half_modulus.

Remark wordsize_pos: zwordsize > 0.
Proof.
(* Goal: Z.gt zwordsize Z0 *)
  unfold zwordsize, wordsize. generalize WS.wordsize_not_zero. omega.
Qed.

Remark modulus_power: modulus = two_p zwordsize.
Proof.
(* Goal: Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub modulus (Zpos xH))) *)
  unfold modulus. apply two_power_nat_two_p.
Qed.

Remark modulus_pos: modulus > 0.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite modulus_power. apply two_p_gt_ZERO. generalize wordsize_pos; omega.
Qed.

(** * Representation of machine integers *)

(** A machine integer (type [int]) is represented as a Coq arbitrary-precision
  integer (type [Z]) plus a proof that it is in the range 0 (included) to
  [modulus] (excluded). *)

Record int: Type := mkint { intval: Z; intrange: -1 < intval < modulus }.

(** Fast normalization modulo [2^wordsize] *)

(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
Fixpoint P_mod_two_p (p: positive) (n: nat) {struct n} : Z :=
  match n with
  | O => 0
  | S m =>
      match p with
      | xH => 1
      | xO q => Z.double (P_mod_two_p q m)
      | xI q => Z.succ_double (P_mod_two_p q m)
      end
  end.

Definition Z_mod_modulus (x: Z) : Z :=
  match x with
  | Z0 => 0
  | Zpos p => P_mod_two_p p wordsize
  | Zneg p => let r := P_mod_two_p p wordsize in if zeq r 0 then 0 else modulus - r
  end.

Lemma P_mod_two_p_range:
  forall n p, 0 <= P_mod_two_p p n < two_power_nat n.
Proof.
(* Goal: forall (n : nat) (p : positive), @ex Z (fun y : Z => @eq Z (Zpos p) (Z.add (Z.mul y (two_power_nat n)) (P_mod_two_p p n))) *)
  induction n; simpl; intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - rewrite two_power_nat_O. omega.
  - rewrite two_power_nat_S. destruct p.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + generalize (IHn p). rewrite Z.succ_double_spec. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + generalize (IHn p). rewrite Z.double_spec. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + generalize (two_power_nat_pos n). omega.
Qed.

Lemma P_mod_two_p_eq:
  forall n p, P_mod_two_p p n = (Zpos p) mod (two_power_nat n).
Proof.
  assert (forall n p, exists y, Zpos p = y * two_power_nat n + P_mod_two_p p n).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  {
(* Goal: forall (n : nat) (p : positive), @ex Z (fun y : Z => @eq Z (Zpos p) (Z.add (Z.mul y (two_power_nat n)) (P_mod_two_p p n))) *)
    induction n; simpl; intros.
    - rewrite two_power_nat_O. exists (Zpos p). ring.
    - rewrite two_power_nat_S. destruct p.
      + destruct (IHn p) as [y EQ]. exists y.
        change (Zpos p~1) with (2 * Zpos p + 1). rewrite EQ.
(* Goal: @Logic.eq Z (Z.succ_double x) (Z.add (Z.mul (Zpos (xO xH)) x) (Zpos xH)) *)
        rewrite Z.succ_double_spec. ring.
      + destruct (IHn p) as [y EQ]. exists y.
(* Goal: @Logic.eq Z (Z.mul x (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k modulus) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
        change (Zpos p~0) with (2 * Zpos p). rewrite EQ.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
        rewrite (Z.double_spec (P_mod_two_p p n)). ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      + exists 0; omega.
  }
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @eq Z (P_mod_two_p p n) (Z.modulo (Zpos p) (two_power_nat n)) *)
  destruct (H n p) as [y EQ].
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  symmetry. apply Zmod_unique with y. auto. apply P_mod_two_p_range.
Qed.

Lemma Z_mod_modulus_range:
  forall x, 0 <= Z_mod_modulus x < modulus.
Proof.
(* Goal: forall x : Z, and (Z.le Z0 (Z_mod_modulus x)) (Z.lt (Z_mod_modulus x) modulus) *)
  intros; unfold Z_mod_modulus.
(* Goal: P x *)
  destruct x.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - generalize modulus_pos; omega.
  - apply P_mod_two_p_range.
  - set (r := P_mod_two_p p wordsize).
(* Goal: and (Z.le Z0 (P_mod_two_p p wordsize)) (Z.lt (P_mod_two_p p wordsize) modulus) *)
    assert (0 <= r < modulus) by apply P_mod_two_p_range.
(* Goal: @Logic.eq Z (Z.div (Z.add x (Z.sub y (Zpos xH))) y) (Z.add q (if zeq r Z0 then Z0 else Zpos xH)) *)
    destruct (zeq r 0).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + generalize modulus_pos; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + omega.
Qed.

Lemma Z_mod_modulus_range':
  forall x, -1 < Z_mod_modulus x < modulus.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. generalize (Z_mod_modulus_range x); omega.
Qed.

Lemma Z_mod_modulus_eq:
  forall x, Z_mod_modulus x = x mod modulus.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold Z_mod_modulus. destruct x.
  - rewrite Zmod_0_l. auto.
  - apply P_mod_two_p_eq.
  - generalize (P_mod_two_p_range wordsize p) (P_mod_two_p_eq wordsize p).
(* Goal: Logic.and (Z.le (Z.opp (two_power_nat wordsize)) (Z.sub (unsigned x) modulus)) (Z.lt (Z.sub (unsigned x) modulus) Z0) *)
(* Goal: Z.ge i (Z.of_nat wordsize) *)
    fold modulus. intros A B.
(* Goal: @eq Z (if zeq (P_mod_two_p p wordsize) Z0 then Z0 else Z.sub modulus (P_mod_two_p p wordsize)) (Z.modulo (Zneg p) modulus) *)
    exploit (Z_div_mod_eq (Zpos p) modulus). apply modulus_pos. intros C.
(* Goal: @eq Z (if zeq (P_mod_two_p p wordsize) Z0 then Z0 else Z.sub modulus (P_mod_two_p p wordsize)) (Z.modulo (Zneg p) modulus) *)
    set (q := Zpos p / modulus) in *.
(* Goal: @eq Z (if zeq (P_mod_two_p p wordsize) Z0 then Z0 else Z.sub modulus (P_mod_two_p p wordsize)) (Z.modulo (Zneg p) modulus) *)
    set (r := P_mod_two_p p wordsize) in *.
    rewrite <- B in C.
    change (Z.neg p) with (- (Z.pos p)). destruct (zeq r 0).
    + symmetry. apply Zmod_unique with (-q). rewrite C; rewrite e. ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      generalize modulus_pos; omega.
    + symmetry. apply Zmod_unique with (-q - 1). rewrite C. ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      omega.
Qed.

(** The [unsigned] and [signed] functions return the Coq integer corresponding
  to the given machine integer, interpreted as unsigned or signed
  respectively. *)

Definition unsigned (n: int) : Z := intval n.

Definition signed (n: int) : Z :=
  let x := unsigned n in
  if zlt x half_modulus then x else x - modulus.

(** Conversely, [repr] takes a Coq integer and returns the corresponding
  machine integer.  The argument is treated modulo [modulus]. *)

Definition repr (x: Z) : int :=
  mkint (Z_mod_modulus x) (Z_mod_modulus_range' x).

Definition zero := repr 0.
Definition one  := repr 1.
Definition mone := repr (-1).
Definition iwordsize := repr zwordsize.

Lemma mkint_eq:
  forall x y Px Py, x = y -> mkint x Px = mkint y Py.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. subst y.
(* Goal: @eq int (mkint x Px) (mkint x Py) *)
  assert (forall (n m: Z) (P1 P2: n < m), P1 = P2).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  {
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
    unfold Z.lt; intros.
(* Goal: @eq (@eq Datatypes.comparison (Z.compare n m) Lt) P1 P2 *)
    apply eq_proofs_unicity.
(* Goal: forall x y : Datatypes.comparison, or (@eq Datatypes.comparison x y) (not (@eq Datatypes.comparison x y)) *)
    intros c1 c2. destruct c1; destruct c2; (left; reflexivity) || (right; congruence).
  }
(* Goal: @eq int (mkint x Px) (mkint x Py) *)
  destruct Px as [Px1 Px2]. destruct Py as [Py1 Py2].
(* Goal: @eq int (mkint x (@conj (Z.lt (Zneg xH) x) (Z.lt x modulus) Px1 Px2)) (mkint x (@conj (Z.lt (Zneg xH) x) (Z.lt x modulus) Py1 Py2)) *)
  rewrite (H _ _ Px1 Py1).
(* Goal: @eq int (mkint x (@conj (Z.lt (Zneg xH) x) (Z.lt x modulus) Py1 Px2)) (mkint x (@conj (Z.lt (Zneg xH) x) (Z.lt x modulus) Py1 Py2)) *)
  rewrite (H _ _ Px2 Py2).
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  reflexivity.
Qed.

Lemma eq_dec: forall (x y: int), {x = y} + {x <> y}.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct x; destruct y. destruct (zeq intval0 intval1).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  left. apply mkint_eq. auto.
(* Goal: Logic.or (@Logic.eq int x zero) (@Logic.eq bool (testbit x (Z.pred (size x))) true) *)
  right. red; intro. injection H. exact n.
Defined.

(** * Arithmetic and logical operations over machine integers *)

Definition eq (x y: int) : bool :=
  if zeq (unsigned x) (unsigned y) then true else false.
Definition lt (x y: int) : bool :=
  if zlt (signed x) (signed y) then true else false.
Definition ltu (x y: int) : bool :=
  if zlt (unsigned x) (unsigned y) then true else false.

Definition neg (x: int) : int := repr (- unsigned x).

Definition add (x y: int) : int :=
  repr (unsigned x + unsigned y).
Definition sub (x y: int) : int :=
  repr (unsigned x - unsigned y).
Definition mul (x y: int) : int :=
  repr (unsigned x * unsigned y).

Definition divs (x y: int) : int :=
  repr (Z.quot (signed x) (signed y)).
Definition mods (x y: int) : int :=
  repr (Z.rem (signed x) (signed y)).

Definition divu (x y: int) : int :=
  repr (unsigned x / unsigned y).
Definition modu (x y: int) : int :=
  repr ((unsigned x) mod (unsigned y)).

(** Bitwise boolean operations. *)

Definition and (x y: int): int := repr (Z.land (unsigned x) (unsigned y)).
Definition or (x y: int): int := repr (Z.lor (unsigned x) (unsigned y)).
Definition xor (x y: int) : int := repr (Z.lxor (unsigned x) (unsigned y)).

Definition not (x: int) : int := xor x mone.

(** Shifts and rotates. *)

Definition shl (x y: int): int := repr (Z.shiftl (unsigned x) (unsigned y)).
Definition shru (x y: int): int := repr (Z.shiftr (unsigned x) (unsigned y)).
Definition shr (x y: int): int := repr (Z.shiftr (signed x) (unsigned y)).

Definition rol (x y: int) : int :=
  let n := (unsigned y) mod zwordsize in
  repr (Z.lor (Z.shiftl (unsigned x) n) (Z.shiftr (unsigned x) (zwordsize - n))).
Definition ror (x y: int) : int :=
  let n := (unsigned y) mod zwordsize in
  repr (Z.lor (Z.shiftr (unsigned x) n) (Z.shiftl (unsigned x) (zwordsize - n))).

Definition rolm (x a m: int): int := and (rol x a) m.

(** Viewed as signed divisions by powers of two, [shrx] rounds towards
  zero, while [shr] rounds towards minus infinity. *)

Definition shrx (x y: int): int :=
  divs x (shl one y).

(** High half of full multiply. *)

Definition mulhu (x y: int): int := repr ((unsigned x * unsigned y) / modulus).
Definition mulhs (x y: int): int := repr ((signed x * signed y) / modulus).

(** Condition flags *)

Definition negative (x: int): int :=
  if lt x zero then one else zero.

Definition add_carry (x y cin: int): int :=
  if zlt (unsigned x + unsigned y + unsigned cin) modulus then zero else one.

Definition add_overflow (x y cin: int): int :=
  let s := signed x + signed y + signed cin in
  if zle min_signed s && zle s max_signed then zero else one.

Definition sub_borrow (x y bin: int): int :=
  if zlt (unsigned x - unsigned y - unsigned bin) 0 then one else zero.

Definition sub_overflow (x y bin: int): int :=
  let s := signed x - signed y - signed bin in
  if zle min_signed s && zle s max_signed then zero else one.

(** [shr_carry x y] is 1 if [x] is negative and at least one 1 bit is shifted away. *)

Definition shr_carry (x y: int) : int :=
  if lt x zero && negb (eq (and x (sub (shl one y) one)) zero)
  then one else zero.

(** Zero and sign extensions *)

Definition Zshiftin (b: bool) (x: Z) : Z :=
  if b then Z.succ_double x else Z.double x.

(** In pseudo-code:
<<
    Fixpoint Zzero_ext (n: Z) (x: Z) : Z :=
      if zle n 0 then
        0
      else
        Zshiftin (Z.odd x) (Zzero_ext (Z.pred n) (Z.div2 x)).
    Fixpoint Zsign_ext (n: Z) (x: Z) : Z :=
      if zle n 1 then
        if Z.odd x then -1 else 0
      else
        Zshiftin (Z.odd x) (Zzero_ext (Z.pred n) (Z.div2 x)).
>>
  We encode this [nat]-like recursion using the [Z.iter] iteration
  function, in order to make the [Zzero_ext] and [Zsign_ext]
  functions efficiently executable within Coq.
*)

Definition Zzero_ext (n: Z) (x: Z) : Z :=
  Z.iter n
    (fun rec x => Zshiftin (Z.odd x) (rec (Z.div2 x)))
    (fun x => 0)
    x.

Definition Zsign_ext (n: Z) (x: Z) : Z :=
  Z.iter (Z.pred n)
    (fun rec x => Zshiftin (Z.odd x) (rec (Z.div2 x)))
    (fun x => if Z.odd x then -1 else 0)
    x.

Definition zero_ext (n: Z) (x: int) : int := repr (Zzero_ext n (unsigned x)).

Definition sign_ext (n: Z) (x: int) : int := repr (Zsign_ext n (unsigned x)).

(** Decomposition of a number as a sum of powers of two. *)

(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
Fixpoint Z_one_bits (n: nat) (x: Z) (i: Z) {struct n}: list Z :=
  match n with
  | O => nil
  | S m =>
      if Z.odd x
      then i :: Z_one_bits m (Z.div2 x) (i+1)
      else Z_one_bits m (Z.div2 x) (i+1)
  end.

Definition one_bits (x: int) : list int :=
  List.map repr (Z_one_bits wordsize (unsigned x) 0).

(** Recognition of powers of two. *)

Definition is_power2 (x: int) : option int :=
  match Z_one_bits wordsize (unsigned x) 0 with
  | i :: nil => Some (repr i)
  | _ => None
  end.

(** Comparisons. *)

Definition cmp (c: comparison) (x y: int) : bool :=
  match c with
  | Ceq => eq x y
  | Cne => negb (eq x y)
  | Clt => lt x y
  | Cle => negb (lt y x)
  | Cgt => lt y x
  | Cge => negb (lt x y)
  end.

Definition cmpu (c: comparison) (x y: int) : bool :=
  match c with
  | Ceq => eq x y
  | Cne => negb (eq x y)
  | Clt => ltu x y
  | Cle => negb (ltu y x)
  | Cgt => ltu y x
  | Cge => negb (ltu x y)
  end.

Definition is_false (x: int) : Prop := x = zero.
Definition is_true  (x: int) : Prop := x <> zero.
Definition notbool  (x: int) : int  := if eq x zero then one else zero.

(** x86-style extended division and modulus *)

Definition divmodu2 (nhi nlo: int) (d: int) : option (int * int) :=
  if eq_dec d zero then None else
   (let (q, r) := Z.div_eucl (unsigned nhi * modulus + unsigned nlo) (unsigned d) in
    if zle q max_unsigned then Some(repr q, repr r) else None).

Definition divmods2 (nhi nlo: int) (d: int) : option (int * int) :=
  if eq_dec d zero then None else
   (let (q, r) := Z.quotrem (signed nhi * modulus + unsigned nlo) (signed d) in
    if zle min_signed q && zle q max_signed then Some(repr q, repr r) else None).

(** * Properties of integers and integer arithmetic *)

(** ** Properties of [modulus], [max_unsigned], etc. *)

Remark half_modulus_power:
  half_modulus = two_p (zwordsize - 1).
Proof.
(* Goal: Z.lt (two_p uy) modulus *)
(* Goal: @Logic.eq int (add x (sub (shl one y) one)) (add x (shru mone (sub iwordsize y))) *)
  unfold half_modulus. rewrite modulus_power.
  set (ws1 := zwordsize - 1).
(* Goal: @Logic.eq Z (Z.div (two_p zwordsize) (Zpos (xO xH))) (two_p ws1) *)
  replace (zwordsize) with (Z.succ ws1).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite two_p_S. rewrite Z.mul_comm. apply Z_div_mult. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold ws1. generalize wordsize_pos; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold ws1. omega.
Qed.

Remark half_modulus_modulus: modulus = 2 * half_modulus.
Proof.
(* Goal: Z.lt (two_p uy) modulus *)
(* Goal: @Logic.eq int (add x (sub (shl one y) one)) (add x (shru mone (sub iwordsize y))) *)
  rewrite half_modulus_power. rewrite modulus_power.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite <- two_p_S. apply f_equal. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize wordsize_pos; omega.
Qed.

(** Relative positions, from greatest to smallest:
<<
      max_unsigned
      max_signed
      2*wordsize-1
      wordsize
      0
      min_signed
>>
*)

Remark half_modulus_pos: half_modulus > 0.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite half_modulus_power. apply two_p_gt_ZERO. generalize wordsize_pos; omega.
Qed.

Remark min_signed_neg: min_signed < 0.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold min_signed. generalize half_modulus_pos. omega.
Qed.

Remark max_signed_pos: max_signed >= 0.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold max_signed. generalize half_modulus_pos. omega.
Qed.

Remark wordsize_max_unsigned: zwordsize <= max_unsigned.
Proof.
(* Goal: Z.le zwordsize max_unsigned *)
  assert (zwordsize < modulus).
(* Goal: Z.lt (two_p uy) modulus *)
(* Goal: @Logic.eq int (add x (sub (shl one y) one)) (add x (shru mone (sub iwordsize y))) *)
    rewrite modulus_power. apply two_p_strict.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize wordsize_pos. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold max_unsigned. omega.
Qed.

Remark two_wordsize_max_unsigned: 2 * zwordsize - 1 <= max_unsigned.
Proof.
  assert (2 * zwordsize - 1 < modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite modulus_power. apply two_p_strict_2. generalize wordsize_pos; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold max_unsigned; omega.
Qed.

Remark max_signed_unsigned: max_signed < max_unsigned.
Proof.
(* Goal: Z.lt max_signed max_unsigned *)
  unfold max_signed, max_unsigned. rewrite half_modulus_modulus.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize half_modulus_pos. omega.
Qed.

Lemma unsigned_repr_eq:
  forall x, unsigned (repr x) = Z.modulo x modulus.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. simpl. apply Z_mod_modulus_eq.
Qed.

Lemma signed_repr_eq:
  forall x, signed (repr x) = if zlt (Z.modulo x modulus) half_modulus then Z.modulo x modulus else Z.modulo x modulus - modulus.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold signed. rewrite unsigned_repr_eq. auto.
Qed.

(** ** Modulo arithmetic *)

(** We define and state properties of equality and arithmetic modulo a
  positive integer. *)

Section EQ_MODULO.

Variable modul: Z.
Hypothesis modul_pos: modul > 0.

Definition eqmod (x y: Z) : Prop := exists k, x = k * modul + y.

Lemma eqmod_refl: forall x, eqmod x x.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros; red. exists 0. omega.
Qed.

Lemma eqmod_refl2: forall x y, x = y -> eqmod x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. subst y. apply eqmod_refl.
Qed.

Lemma eqmod_sym: forall x y, eqmod x y -> eqmod y x.
Proof.
  intros x y [k EQ]; red. exists (-k). subst x. ring.
Qed.

Lemma eqmod_trans: forall x y z, eqmod x y -> eqmod y z -> eqmod x z.
Proof.
(* Goal: forall (x y z : Z) (_ : eqmod x y) (_ : eqmod y z), eqmod x z *)
  intros x y z [k1 EQ1] [k2 EQ2]; red.
  exists (k1 + k2). subst x; subst y. ring.
Qed.

Lemma eqmod_small_eq:
  forall x y, eqmod x y -> 0 <= x < modul -> 0 <= y < modul -> x = y.
Proof.
(* Goal: forall (x y : Z) (_ : eqmod x y) (_ : Logic.and (Z.le Z0 x) (Z.lt x modul)) (_ : Logic.and (Z.le Z0 y) (Z.lt y modul)), @Logic.eq Z x y *)
  intros x y [k EQ] I1 I2.
(* Goal: @Logic.eq Z x y *)
  generalize (Zdiv_unique _ _ _ _ EQ I2). intro.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite (Zdiv_small x modul I1) in H. subst k. omega.
Qed.

Lemma eqmod_mod_eq:
  forall x y, eqmod x y -> x mod modul = y mod modul.
Proof.
(* Goal: Z.le (size x) n *)
(* Goal: Z.le (size x) n *)
  intros x y [k EQ]. subst x.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Z.add_comm. apply Z_mod_plus. auto.
Qed.

Lemma eqmod_mod:
  forall x, eqmod x (x mod modul).
Proof.
(* Goal: forall i : Z, agree64 (repr i) (Int64.repr i) *)
  intros; red. exists (x / modul).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Z.mul_comm. apply Z_div_mod_eq. auto.
Qed.

Lemma eqmod_add:
  forall a b c d, eqmod a b -> eqmod c d -> eqmod (a + c) (b + d).
Proof.
(* Goal: forall (a b c d : Z) (_ : eqmod a c) (_ : eqmod b d), eqmod (Z.mul a b) (Z.mul c d) *)
  intros a b c d [k1 EQ1] [k2 EQ2]; red.
  subst a; subst c. exists (k1 + k2). ring.
Qed.

Lemma eqmod_neg:
  forall x y, eqmod x y -> eqmod (-x) (-y).
Proof.
  intros x y [k EQ]; red. exists (-k). rewrite EQ. ring.
Qed.

Lemma eqmod_sub:
  forall a b c d, eqmod a b -> eqmod c d -> eqmod (a - c) (b - d).
Proof.
(* Goal: forall (a b c d : Z) (_ : eqmod a c) (_ : eqmod b d), eqmod (Z.mul a b) (Z.mul c d) *)
  intros a b c d [k1 EQ1] [k2 EQ2]; red.
  subst a; subst c. exists (k1 - k2). ring.
Qed.

Lemma eqmod_mult:
  forall a b c d, eqmod a c -> eqmod b d -> eqmod (a * b) (c * d).
Proof.
(* Goal: forall (a b c d : Z) (_ : eqmod a c) (_ : eqmod b d), eqmod (Z.mul a b) (Z.mul c d) *)
  intros a b c d [k1 EQ1] [k2 EQ2]; red.
(* Goal: @ex Z (fun k : Z => @Logic.eq Z (Z.mul a b) (Z.add (Z.mul k modul) (Z.mul c d))) *)
  subst a; subst b.
  exists (k1 * k2 * modul + c * k2 + k1 * d).
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  ring.
Qed.

End EQ_MODULO.

Lemma eqmod_divides:
  forall n m x y, eqmod n x y -> Z.divide m n -> eqmod m x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct H as [k1 EQ1]. destruct H0 as [k2 EQ2].
  exists (k1*k2). rewrite <- Z.mul_assoc. rewrite <- EQ2. auto.
Qed.

(** We then specialize these definitions to equality modulo
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  $2^{wordsize}$ #2<sup>wordsize</sup>#. *)

Hint Resolve modulus_pos: ints.

Definition eqm := eqmod modulus.

Lemma eqm_refl: forall x, eqm x x.
Proof (eqmod_refl modulus).
Hint Resolve eqm_refl: ints.

Lemma eqm_refl2:
  forall x y, x = y -> eqm x y.
Proof (eqmod_refl2 modulus).
Hint Resolve eqm_refl2: ints.

Lemma eqm_sym: forall x y, eqm x y -> eqm y x.
Proof (eqmod_sym modulus).
Hint Resolve eqm_sym: ints.

Lemma eqm_trans: forall x y z, eqm x y -> eqm y z -> eqm x z.
Proof (eqmod_trans modulus).
Hint Resolve eqm_trans: ints.

Lemma eqm_small_eq:
  forall x y, eqm x y -> 0 <= x < modulus -> 0 <= y < modulus -> x = y.
Proof (eqmod_small_eq modulus).
Hint Resolve eqm_small_eq: ints.

Lemma eqm_add:
  forall a b c d, eqm a b -> eqm c d -> eqm (a + c) (b + d).
Proof (eqmod_add modulus).
Hint Resolve eqm_add: ints.

Lemma eqm_neg:
  forall x y, eqm x y -> eqm (-x) (-y).
Proof (eqmod_neg modulus).
Hint Resolve eqm_neg: ints.

Lemma eqm_sub:
  forall a b c d, eqm a b -> eqm c d -> eqm (a - c) (b - d).
Proof (eqmod_sub modulus).
Hint Resolve eqm_sub: ints.

Lemma eqm_mult:
  forall a b c d, eqm a c -> eqm b d -> eqm (a * b) (c * d).
Proof (eqmod_mult modulus).
Hint Resolve eqm_mult: ints.

(** ** Properties of the coercions between [Z] and [int] *)

Lemma eqm_samerepr: forall x y, eqm x y -> repr x = repr y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold repr. apply mkint_eq.
(* Goal: @Logic.eq Z (Z_mod_modulus x) (Z_mod_modulus y) *)
  rewrite !Z_mod_modulus_eq. apply eqmod_mod_eq. auto with ints. exact H.
Qed.

Lemma eqm_unsigned_repr:
  forall z, eqm z (unsigned (repr z)).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold eqm; intros. rewrite unsigned_repr_eq. apply eqmod_mod. auto with ints.
Qed.
Hint Resolve eqm_unsigned_repr: ints.

Lemma eqm_unsigned_repr_l:
  forall a b, eqm a b -> eqm (unsigned (repr a)) b.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply eqm_trans with a.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply eqm_sym. apply eqm_unsigned_repr. auto.
Qed.
Hint Resolve eqm_unsigned_repr_l: ints.

Lemma eqm_unsigned_repr_r:
  forall a b, eqm a b -> eqm a (unsigned (repr b)).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply eqm_trans with b. auto.
(* Goal: eqm (two_p (Int.unsigned y)) (unsigned (repr (two_p (Int.unsigned y)))) *)
(* Goal: Z.le Z0 (Int.unsigned y) *)
  apply eqm_unsigned_repr.
Qed.
Hint Resolve eqm_unsigned_repr_r: ints.

Lemma eqm_signed_unsigned:
  forall x, eqm (signed x) (unsigned x).
Proof.
(* Goal: forall _ : @Logic.eq bool false (if zlt (unsigned (and x y)) half_modulus then false else true), Z.ge (signed (and x y)) Z0 *)
(* Goal: Logic.and (Z.le Z0 (Z.sub zwordsize (Zpos xH))) (Z.lt (Z.sub zwordsize (Zpos xH)) zwordsize) *)
  intros; red. unfold signed. set (y := unsigned x).
(* Goal: forall _ : @Logic.eq Z (unsigned n) (two_p (Int.unsigned logn)), @Logic.eq int (divu x n) (shru' x logn) *)
  case (zlt y half_modulus); intro.
  apply eqmod_refl. red; exists (-1); ring.
Qed.

Theorem unsigned_range:
  forall i, 0 <= unsigned i < modulus.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct i. simpl. omega.
Qed.
Hint Resolve unsigned_range: ints.

Theorem unsigned_range_2:
  forall i, 0 <= unsigned i <= max_unsigned.
Proof.
(* Goal: Logic.and (Z.le Z0 (Int64.unsigned n)) (Z.le (Int64.unsigned n) max_unsigned) *)
  intro; unfold max_unsigned.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (unsigned_range i). omega.
Qed.
Hint Resolve unsigned_range_2: ints.

Theorem signed_range:
  forall i, min_signed <= signed i <= max_signed.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold signed.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (unsigned_range i). set (n := unsigned i). intros.
(* Goal: forall _ : @Logic.eq Z (unsigned n) (two_p (Int.unsigned logn)), @Logic.eq int (divu x n) (shru' x logn) *)
  case (zlt n half_modulus); intro.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold max_signed. generalize min_signed_neg. omega.
(* Goal: forall _ : Logic.and (Z.le min_signed (signed X)) (Z.le (signed X) max_signed), Logic.and (Z.le (Z.opp half_modulus) (signed X)) (Z.lt (signed X) half_modulus) *)
(* Goal: Z.le Z0 (Z.sub n (Zpos xH)) *)
(* Goal: Z.le Z0 (Z.sub zwordsize n) *)
(* Goal: Logic.and (Z.le min_signed (Z.div (signed X) (two_p (unsigned (repr (Z.sub zwordsize n)))))) (Z.le (Z.div (signed X) (two_p (unsigned (repr (Z.sub zwordsize n))))) max_signed) *)
  unfold min_signed, max_signed.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite half_modulus_modulus in *. omega.
Qed.

Theorem repr_unsigned:
  forall i, repr (unsigned i) = i.
Proof.
(* Goal: @Logic.eq int (mkint intval0 intrange0) (mkint intval1 intrange1) *)
  destruct i; simpl. unfold repr. apply mkint_eq.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Z_mod_modulus_eq. apply Zmod_small; omega.
Qed.
Hint Resolve repr_unsigned: ints.

Lemma repr_signed:
  forall i, repr (signed i) = i.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. transitivity (repr (unsigned i)).
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  apply eqm_samerepr. apply eqm_signed_unsigned. auto with ints.
Qed.
Hint Resolve repr_signed: ints.

Opaque repr.

Lemma eqm_repr_eq: forall x y, eqm x (unsigned y) -> repr x = y.
Proof.
  intros. rewrite <- (repr_unsigned y). apply eqm_samerepr; auto.
Qed.

Theorem unsigned_repr:
  forall z, 0 <= z <= max_unsigned -> unsigned (repr z) = z.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite unsigned_repr_eq.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply Zmod_small. unfold max_unsigned in H. omega.
Qed.
Hint Resolve unsigned_repr: ints.

Theorem signed_repr:
  forall z, min_signed <= z <= max_signed -> signed (repr z) = z.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold signed. destruct (zle 0 z).
(* Goal: @Logic.eq Z (if zlt (unsigned (repr z)) half_modulus then unsigned (repr z) else Z.sub (unsigned (repr z)) modulus) z *)
(* Goal: @Logic.eq Z (if zlt (unsigned (repr z)) half_modulus then unsigned (repr z) else Z.sub (unsigned (repr z)) modulus) z *)
  replace (unsigned (repr z)) with z.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true. auto. unfold max_signed in H. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  symmetry. apply unsigned_repr. generalize max_signed_unsigned. omega.
  pose (z' := z + modulus).
(* Goal: @Logic.eq Z (if zlt (unsigned (repr z)) half_modulus then unsigned (repr z) else Z.sub (unsigned (repr z)) modulus) z *)
  replace (repr z) with (repr z').
(* Goal: @Logic.eq Z (if zlt (unsigned (repr z')) half_modulus then unsigned (repr z') else Z.sub (unsigned (repr z')) modulus) z *)
(* Goal: @Logic.eq int (repr z') (repr z) *)
  replace (unsigned (repr z')) with z'.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false. unfold z'. omega.
(* Goal: Z.ge z' half_modulus *)
(* Goal: @Logic.eq Z z' (unsigned (repr z')) *)
(* Goal: @Logic.eq int (repr z') (repr z) *)
  unfold z'. unfold min_signed in H.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite half_modulus_modulus. omega.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  symmetry. apply unsigned_repr.
(* Goal: Logic.and (Z.le Z0 z') (Z.le z' max_unsigned) *)
(* Goal: @Logic.eq int (repr z') (repr z) *)
  unfold z', max_unsigned. unfold min_signed, max_signed in H.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite half_modulus_modulus. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply eqm_samerepr. unfold z'; red. exists 1. omega.
Qed.

Theorem signed_eq_unsigned:
  forall x, unsigned x <= max_signed -> signed x = unsigned x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold signed. destruct (zlt (unsigned x) half_modulus).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto. unfold max_signed in H. omegaContradiction.
Qed.

Theorem signed_positive:
  forall x, signed x >= 0 <-> unsigned x <= max_signed.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold signed, max_signed.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (unsigned_range x) half_modulus_modulus half_modulus_pos; intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt (unsigned x) half_modulus); omega.
Qed.

(** ** Properties of zero, one, minus one *)

Theorem unsigned_zero: unsigned zero = 0.
Proof.
(* Goal: @Logic.eq Z (unsigned (repr (Z.sub (Z.opp (unsigned x)) (Zpos xH)))) (Z.sub max_unsigned (unsigned x)) *)
  unfold zero; rewrite unsigned_repr_eq. apply Zmod_0_l.
Qed.

Theorem unsigned_one: unsigned one = 1.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold one; rewrite unsigned_repr_eq. apply Zmod_small. split. omega.
(* Goal: Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub modulus (Zpos xH))) *)
  unfold modulus. replace wordsize with (S(Init.Nat.pred wordsize)).
(* Goal: Logic.and (Z.le Z0 (unsigned x)) (Z.lt (unsigned x) (two_power_nat (S ws1))) *)
  rewrite two_power_nat_S. generalize (two_power_nat_pos (Init.Nat.pred wordsize)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize wordsize_pos. unfold zwordsize. omega.
Qed.

Theorem unsigned_mone: unsigned mone = modulus - 1.
Proof.
(* Goal: @Logic.eq Z (unsigned (repr (Z.sub (Z.opp (unsigned x)) (Zpos xH)))) (Z.sub max_unsigned (unsigned x)) *)
  unfold mone; rewrite unsigned_repr_eq.
  replace (-1) with ((modulus - 1) + (-1) * modulus).
(* Goal: @Logic.eq Z (Z.modulo (Z.sub i (unsigned n)) zwordsize) (Z.sub i (unsigned n)) *)
(* Goal: Logic.and (Z.le Z0 (Z.sub i (unsigned n))) (Z.lt (Z.sub i (unsigned n)) zwordsize) *)
  rewrite Z_mod_plus_full. apply Zmod_small.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize modulus_pos. omega. omega.
Qed.

Theorem signed_zero: signed zero = 0.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold signed. rewrite unsigned_zero. apply zlt_true. generalize half_modulus_pos; omega.
Qed.

Theorem signed_one: zwordsize > 1 -> signed one = 1.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold signed. rewrite unsigned_one. apply zlt_true. 
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  change 1 with (two_p 0). rewrite half_modulus_power. apply two_p_monotone_strict. omega. 
Qed.

Theorem signed_mone: signed mone = -1.
Proof.
(* Goal: forall _ : @Logic.eq bool false (if zlt (unsigned (and x y)) half_modulus then false else true), Z.ge (signed (and x y)) Z0 *)
(* Goal: Logic.and (Z.le Z0 (Z.sub zwordsize (Zpos xH))) (Z.lt (Z.sub zwordsize (Zpos xH)) zwordsize) *)
  unfold signed. rewrite unsigned_mone.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite half_modulus_modulus. generalize half_modulus_pos. omega.
Qed.

Theorem one_not_zero: one <> zero.
Proof.
(* Goal: Logic.not (@Logic.eq int one zero) *)
  assert (unsigned one <> unsigned zero).
(* Goal: Logic.not (@Logic.eq Z (unsigned one) (unsigned zero)) *)
(* Goal: Logic.not (@Logic.eq int one zero) *)
  rewrite unsigned_one; rewrite unsigned_zero; congruence.
(* Goal: @Logic.eq BinNums.Z (Z.add (Int.unsigned y) (Int.unsigned z)) (Z.add (unsigned y') (unsigned z')) *)
  congruence.
Qed.

Theorem unsigned_repr_wordsize:
  unsigned iwordsize = zwordsize.
Proof.
(* Goal: @Logic.eq Z (unsigned (repr (Z.sub (Z.opp (unsigned x)) (Zpos xH)))) (Z.sub max_unsigned (unsigned x)) *)
  unfold iwordsize; rewrite unsigned_repr_eq. apply Zmod_small.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize wordsize_pos wordsize_max_unsigned; unfold max_unsigned; omega.
Qed.

(** ** Properties of equality *)

Theorem eq_sym:
  forall x y, eq x y = eq y x.
Proof.
(* Goal: forall _ : @Logic.eq Z (unsigned n) (two_p (Int.unsigned logn)), @Logic.eq int (divu x n) (shru' x logn) *)
  intros; unfold eq. case (zeq (unsigned x) (unsigned y)); intro.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite e. rewrite zeq_true. auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite zeq_false. auto. auto.
Qed.

Theorem eq_spec: forall (x y: int), if eq x y then x = y else x <> y.
Proof.
(* Goal: forall _ : @Logic.eq Z (unsigned n) (two_p (Int.unsigned logn)), @Logic.eq int (divu x n) (shru' x logn) *)
  intros; unfold eq. case (eq_dec x y); intro.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  subst y. rewrite zeq_true. auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite zeq_false. auto.
(* Goal: Logic.not (@Logic.eq Z (unsigned x) (unsigned y)) *)
  destruct x; destruct y.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  simpl. red; intro. elim n. apply mkint_eq. auto.
Qed.

Theorem eq_true: forall x, eq x x = true.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (eq_spec x x); case (eq x x); intros; congruence.
Qed.

Theorem eq_false: forall x y, x <> y -> eq x y = false.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (eq_spec x y); case (eq x y); intros; congruence.
Qed.

Theorem eq_signed:
  forall x y, eq x y = if zeq (signed x) (signed y) then true else false.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. predSpec eq eq_spec x y.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  subst x. rewrite zeq_true; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct (zeq (signed x) (signed y)); auto.
  elim H. rewrite <- (repr_signed x). rewrite <- (repr_signed y). congruence.
Qed.

(** ** Properties of addition *)

Theorem add_unsigned: forall x y, add x y = repr (unsigned x + unsigned y).
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
Proof. intros; reflexivity.
Qed.

Theorem add_signed: forall x y, add x y = repr (signed x + signed y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite add_unsigned. apply eqm_samerepr.
(* Goal: eqmod modulus (signed (sign_ext n x)) (unsigned (sign_ext n x)) *)
(* Goal: Z.divide (two_p n) modulus *)
(* Goal: eqmod (two_p n) (unsigned (sign_ext n x)) (unsigned x) *)
  apply eqm_add; apply eqm_sym; apply eqm_signed_unsigned.
Qed.

Theorem add_commut: forall x y, add x y = add y x.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
Proof. intros; unfold add. decEq. omega. Qed.

Theorem add_zero: forall x, add x zero = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold add. rewrite unsigned_zero.
(* Goal: @Logic.eq Z (two_p x) (Z.add (two_p (Z.succ (Z.sub x (Zpos xH)))) Z0) *)
(* Goal: Z.le Z0 (Z.sub x (Zpos xH)) *)
(* Goal: @Logic.eq (list Z) (if Z.odd (two_p x) then @cons Z i (Z_one_bits n (Z.div2 (two_p x)) (Z.add i (Zpos xH))) else Z_one_bits n (Z.div2 (two_p x)) (Z.add i (Zpos xH))) (@cons Z (Z.add i x) (@nil Z)) *)
  rewrite Z.add_0_r. apply repr_unsigned.
Qed.

Theorem add_zero_l: forall x, add zero x = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite add_commut. apply add_zero.
Qed.

Theorem add_assoc: forall x y z, add (add x y) z = add x (add y z).
Proof.
(* Goal: forall x y z : int, @Logic.eq int (add (add x y) z) (add x (add y z)) *)
  intros; unfold add.
(* Goal: eqm (unsigned x) (Z.add (unsigned (repr (Z.mul (unsigned (repr (Z.div (unsigned x) (unsigned y)))) (unsigned y)))) (unsigned (repr (Z.modulo (unsigned x) (unsigned y))))) *)
  set (x' := unsigned x).
(* Goal: eqm x' (Z.add (unsigned (repr (Z.mul (unsigned (repr (Z.div x' (unsigned y)))) (unsigned y)))) (unsigned (repr (Z.modulo x' (unsigned y))))) *)
  set (y' := unsigned y).
(* Goal: eqm (Z.mul (unsigned (repr (Z.add x' y'))) (unsigned z)) (Z.add (unsigned (repr (Z.mul x' (unsigned z)))) (unsigned (repr (Z.mul y' (unsigned z))))) *)
  set (z' := unsigned z).
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr.
  apply eqm_trans with ((x' + y') + z').
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  auto with ints.
  rewrite <- Z.add_assoc. auto with ints.
Qed.

Theorem add_permut: forall x y z, add x (add y z) = add y (add x z).
Proof.
  intros. rewrite (add_commut y z). rewrite <- add_assoc. apply add_commut.
Qed.

Theorem add_neg_zero: forall x, add x (neg x) = zero.
Proof.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  intros; unfold add, neg, zero. apply eqm_samerepr.
  replace 0 with (unsigned x + (- (unsigned x))).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  auto with ints. omega.
Qed.

Theorem unsigned_add_carry:
  forall x y,
  unsigned (add x y) = unsigned x + unsigned y - unsigned (add_carry x y zero) * modulus.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq Z (Z.modulo (Z.sub i (unsigned zero)) zwordsize) i *)
  unfold add, add_carry. rewrite unsigned_zero. rewrite Z.add_0_r.
(* Goal: @Logic.eq Z (unsigned (repr (Z.sub (Z.opp (unsigned x)) (Zpos xH)))) (Z.sub max_unsigned (unsigned x)) *)
  rewrite unsigned_repr_eq.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (unsigned_range x) (unsigned_range y). intros.
  destruct (zlt (unsigned x + unsigned y) modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite unsigned_zero. apply Zmod_unique with 0. omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite unsigned_one. apply Zmod_unique with 1. omega. omega.
Qed.

Corollary unsigned_add_either:
  forall x y,
  unsigned (add x y) = unsigned x + unsigned y
  \/ unsigned (add x y) = unsigned x + unsigned y - modulus.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite unsigned_add_carry. unfold add_carry.
(* Goal: @Logic.eq Z (Z.modulo (Z.sub i (unsigned zero)) zwordsize) i *)
  rewrite unsigned_zero. rewrite Z.add_0_r.
  destruct (zlt (unsigned x + unsigned y) modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite unsigned_zero. left; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite unsigned_one. right; omega.
Qed.

(** ** Properties of negation *)

Theorem neg_repr: forall z, neg (repr z) = repr (-z).
Proof.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  intros; unfold neg. apply eqm_samerepr. auto with ints.
Qed.

Theorem neg_zero: neg zero = zero.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold neg. rewrite unsigned_zero. auto.
Qed.

Theorem neg_involutive: forall x, neg (neg x) = x.
Proof.
(* Goal: forall z : Z, @Logic.eq int (neg (repr z)) (repr (Z.opp z)) *)
  intros; unfold neg.
(* Goal: @Logic.eq int (repr (Int64.unsigned (Int64.repr (unsigned n)))) n *)
  apply eqm_repr_eq. eapply eqm_trans. apply eqm_neg.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply eqm_unsigned_repr_l. apply eqm_refl. apply eqm_refl2. omega.
Qed.

Theorem neg_add_distr: forall x y, neg(add x y) = add (neg x) (neg y).
Proof.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  intros; unfold neg, add. apply eqm_samerepr.
  apply eqm_trans with (- (unsigned x + unsigned y)).
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  auto with ints.
  replace (- (unsigned x + unsigned y))
     with ((- unsigned x) + (- unsigned y)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  auto with ints. omega.
Qed.

(** ** Properties of subtraction *)

Theorem sub_zero_l: forall x, sub x zero = x.
Proof.
(* Goal: @Logic.eq Z (Z.modulo (Z.sub i (unsigned zero)) zwordsize) i *)
  intros; unfold sub. rewrite unsigned_zero.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  replace (unsigned x - 0) with (unsigned x) by omega. apply repr_unsigned.
Qed.

Theorem sub_zero_r: forall x, sub zero x = neg x.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  intros; unfold sub, neg. rewrite unsigned_zero. auto.
Qed.

Theorem sub_add_opp: forall x y, sub x y = add x (neg y).
Proof.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  intros; unfold sub, add, neg. apply eqm_samerepr.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  apply eqm_add; auto with ints.
Qed.

Theorem sub_idem: forall x, sub x x = zero.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros; unfold sub. unfold zero. decEq. omega.
Qed.

Theorem sub_add_l: forall x y z, sub (add x y) z = add (sub x z) y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. repeat rewrite sub_add_opp.
(* Goal: @Logic.eq bool (negb (eq x y)) (negb (eq y x)) *)
  repeat rewrite add_assoc. decEq. apply add_commut.
Qed.

Theorem sub_add_r: forall x y z, sub x (add y z) = add (sub x z) (neg y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. repeat rewrite sub_add_opp.
(* Goal: @Logic.eq int (add (neg y) (add x (neg z))) (add (add x (neg z)) (neg y)) *)
  rewrite neg_add_distr. rewrite add_permut. apply add_commut.
Qed.

Theorem sub_shifted:
  forall x y z,
  sub (add x z) (add y z) = sub x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite sub_add_opp. rewrite neg_add_distr.
(* Goal: @Logic.eq int (neg x) (add (add (neg x) mone) one) *)
  rewrite add_assoc.
(* Goal: @Logic.eq int (add x (add z (add (neg y) (neg z)))) (sub x y) *)
  rewrite (add_commut (neg y) (neg z)).
  rewrite <- (add_assoc z). rewrite add_neg_zero.
(* Goal: @Logic.eq int (add x (add zero (neg y))) (sub x y) *)
  rewrite (add_commut zero). rewrite add_zero.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  symmetry. apply sub_add_opp.
Qed.

Theorem sub_signed:
  forall x y, sub x y = repr (signed x - signed y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold sub. apply eqm_samerepr.
(* Goal: eqmod modulus (signed (sign_ext n x)) (unsigned (sign_ext n x)) *)
(* Goal: Z.divide (two_p n) modulus *)
(* Goal: eqmod (two_p n) (unsigned (sign_ext n x)) (unsigned x) *)
  apply eqm_sub; apply eqm_sym; apply eqm_signed_unsigned.
Qed.

Theorem unsigned_sub_borrow:
  forall x y,
  unsigned (sub x y) = unsigned x - unsigned y + unsigned (sub_borrow x y zero) * modulus.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq Z (Z.modulo (Z.sub i (unsigned zero)) zwordsize) i *)
  unfold sub, sub_borrow. rewrite unsigned_zero. rewrite Z.sub_0_r.
(* Goal: @Logic.eq Z (unsigned (repr (Z.sub (Z.opp (unsigned x)) (Zpos xH)))) (Z.sub max_unsigned (unsigned x)) *)
  rewrite unsigned_repr_eq.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (unsigned_range x) (unsigned_range y). intros.
  destruct (zlt (unsigned x - unsigned y) 0).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite unsigned_one. apply Zmod_unique with (-1). omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite unsigned_zero. apply Zmod_unique with 0. omega. omega.
Qed.

(** ** Properties of multiplication *)

Theorem mul_commut: forall x y, mul x y = mul y x.
Proof.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  intros; unfold mul. decEq. ring.
Qed.

Theorem mul_zero: forall x, mul x zero = zero.
Proof.
(* Goal: @Logic.eq Z (Z.modulo (Z.sub i (unsigned zero)) zwordsize) i *)
  intros; unfold mul. rewrite unsigned_zero.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  unfold zero. decEq. ring.
Qed.

Theorem mul_one: forall x, mul x one = x.
Proof.
(* Goal: @Logic.eq int (repr (Z.sub (unsigned (repr (two_p uy))) (unsigned one))) (shru mone (repr (Z.sub (unsigned iwordsize) (unsigned y)))) *)
  intros; unfold mul. rewrite unsigned_one.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  transitivity (repr (unsigned x)). decEq. ring.
(* Goal: @Logic.eq int (repr (unsigned a)) a *)
  apply repr_unsigned.
Qed.

Theorem mul_mone: forall x, mul x mone = neg x.
Proof.
(* Goal: eqm Z0 (Z.add (unsigned mone) (unsigned one)) *)
  intros; unfold mul, neg. rewrite unsigned_mone.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  replace (-unsigned x) with (0 - unsigned x) by omega.
  replace (unsigned x * (modulus - 1)) with (unsigned x * modulus - unsigned x) by ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply eqm_sub. exists (unsigned x). omega. apply eqm_refl.
Qed.

Theorem mul_assoc: forall x y z, mul (mul x y) z = mul x (mul y z).
Proof.
(* Goal: forall x y : int, @Logic.eq int (mul x y) (repr (Z.mul (signed x) (signed y))) *)
  intros; unfold mul.
(* Goal: eqm (unsigned x) (Z.add (unsigned (repr (Z.mul (unsigned (repr (Z.div (unsigned x) (unsigned y)))) (unsigned y)))) (unsigned (repr (Z.modulo (unsigned x) (unsigned y))))) *)
  set (x' := unsigned x).
(* Goal: eqm x' (Z.add (unsigned (repr (Z.mul (unsigned (repr (Z.div x' (unsigned y)))) (unsigned y)))) (unsigned (repr (Z.modulo x' (unsigned y))))) *)
  set (y' := unsigned y).
(* Goal: eqm (Z.mul (unsigned (repr (Z.add x' y'))) (unsigned z)) (Z.add (unsigned (repr (Z.mul x' (unsigned z)))) (unsigned (repr (Z.mul y' (unsigned z))))) *)
  set (z' := unsigned z).
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr. apply eqm_trans with ((x' * y') * z').
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  auto with ints.
  rewrite <- Z.mul_assoc. auto with ints.
Qed.

Theorem mul_add_distr_l:
  forall x y z, mul (add x y) z = add (mul x z) (mul y z).
Proof.
(* Goal: forall x y z : int, @Logic.eq int (mul (add x y) z) (add (mul x z) (mul y z)) *)
  intros; unfold mul, add.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr.
(* Goal: eqm (unsigned x) (Z.add (unsigned (repr (Z.mul (unsigned (repr (Z.div (unsigned x) (unsigned y)))) (unsigned y)))) (unsigned (repr (Z.modulo (unsigned x) (unsigned y))))) *)
  set (x' := unsigned x).
(* Goal: eqm x' (Z.add (unsigned (repr (Z.mul (unsigned (repr (Z.div x' (unsigned y)))) (unsigned y)))) (unsigned (repr (Z.modulo x' (unsigned y))))) *)
  set (y' := unsigned y).
(* Goal: eqm (Z.mul (unsigned (repr (Z.add x' y'))) (unsigned z)) (Z.add (unsigned (repr (Z.mul x' (unsigned z)))) (unsigned (repr (Z.mul y' (unsigned z))))) *)
  set (z' := unsigned z).
  apply eqm_trans with ((x' + y') * z').
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  auto with ints.
  replace ((x' + y') * z') with (x' * z' + y' * z').
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  auto with ints.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  ring.
Qed.

Theorem mul_add_distr_r:
  forall x y z, mul x (add y z) = add (mul x y) (mul x z).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite mul_commut. rewrite mul_add_distr_l.
(* Goal: @Logic.eq int (add (mul y x) (mul z x)) (add (mul x y) (mul x z)) *)
  decEq; apply mul_commut.
Qed.

Theorem neg_mul_distr_l:
  forall x y, neg(mul x y) = mul (neg x) y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold mul, neg.
(* Goal: eqm (unsigned x) (Z.add (unsigned (repr (Z.mul (unsigned (repr (Z.div (unsigned x) (unsigned y)))) (unsigned y)))) (unsigned (repr (Z.modulo (unsigned x) (unsigned y))))) *)
  set (x' := unsigned x).  set (y' := unsigned y).
  apply eqm_samerepr. apply eqm_trans with (- (x' * y')).
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  auto with ints.
  replace (- (x' * y')) with ((-x') * y') by ring.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  auto with ints.
Qed.

Theorem neg_mul_distr_r:
   forall x y, neg(mul x y) = mul x (neg y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite (mul_commut x y). rewrite (mul_commut x (neg y)).
(* Goal: @Logic.eq int (neg (mul y x)) (mul (neg y) x) *)
  apply neg_mul_distr_l.
Qed.

Theorem mul_signed:
  forall x y, mul x y = repr (signed x * signed y).
Proof.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  intros; unfold mul. apply eqm_samerepr.
(* Goal: eqmod modulus (signed (sign_ext n x)) (unsigned (sign_ext n x)) *)
(* Goal: Z.divide (two_p n) modulus *)
(* Goal: eqmod (two_p n) (unsigned (sign_ext n x)) (unsigned x) *)
  apply eqm_mult; apply eqm_sym; apply eqm_signed_unsigned.
Qed.

(** ** Properties of division and modulus *)

Lemma modu_divu_Euclid:
  forall x y, y <> zero -> x = add (mul (divu x y) y) (modu x y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold add, mul, divu, modu.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  transitivity (repr (unsigned x)). auto with ints.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr.
(* Goal: eqm (unsigned x) (Z.add (unsigned (repr (Z.mul (unsigned (repr (Z.div (unsigned x) (unsigned y)))) (unsigned y)))) (unsigned (repr (Z.modulo (unsigned x) (unsigned y))))) *)
  set (x' := unsigned x). set (y' := unsigned y).
  apply eqm_trans with ((x' / y') * y' + x' mod y').
(* Goal: @Logic.eq Z p (Z.add (Z.mul ph Int.modulus) pl) *)
  apply eqm_refl2. rewrite Z.mul_comm. apply Z_div_mod_eq.
(* Goal: forall _ : @Logic.eq Z (unsigned n) (two_p (Int.unsigned logn)), @Logic.eq int (divu x n) (shru' x logn) *)
  generalize (unsigned_range y); intro.
(* Goal: Logic.not (@Logic.eq Z (unsigned (repr (Z.add (unsigned x) (unsigned d)))) (unsigned (repr (Z.add (unsigned y) (unsigned d))))) *)
  assert (unsigned y <> 0). red; intro.
  elim H. rewrite <- (repr_unsigned y). unfold zero. congruence.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold y'. omega.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  auto with ints.
Qed.

Theorem modu_divu:
  forall x y, y <> zero -> modu x y = sub x (mul (divu x y) y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
  assert (forall a b c, a = add b c -> c = sub a b).
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. subst a. rewrite sub_add_l. rewrite sub_idem.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite add_commut. rewrite add_zero. auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply H0. apply modu_divu_Euclid. auto.
Qed.

Lemma mods_divs_Euclid:
  forall x y, x = add (mul (divs x y) y) (mods x y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold add, mul, divs, mods.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  transitivity (repr (signed x)). auto with ints.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr.
(* Goal: @Logic.eq Z (Z.opp (signed x)) (Z.quot (signed x) (Zneg xH)) *)
  set (x' := signed x). set (y' := signed y).
  apply eqm_trans with ((Z.quot x' y') * y' + Z.rem x' y').
(* Goal: @Logic.eq Z p (Z.add (Z.mul ph Int.modulus) pl) *)
  apply eqm_refl2. rewrite Z.mul_comm. apply Z.quot_rem'.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  apply eqm_add; auto with ints.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  apply eqm_unsigned_repr_r. apply eqm_mult; auto with ints.
(* Goal: eqmod modulus (signed (sign_ext n x)) (unsigned (sign_ext n x)) *)
(* Goal: Z.divide (two_p n) modulus *)
(* Goal: eqmod (two_p n) (unsigned (sign_ext n x)) (unsigned x) *)
  unfold y'. apply eqm_signed_unsigned.
Qed.

Theorem mods_divs:
  forall x y, mods x y = sub x (mul (divs x y) y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
  assert (forall a b c, a = add b c -> c = sub a b).
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. subst a. rewrite sub_add_l. rewrite sub_idem.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite add_commut. rewrite add_zero. auto.
(* Goal: P n *)
  apply H. apply mods_divs_Euclid.
Qed.

Theorem divu_one:
  forall x, divu x one = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold divu; intros. rewrite unsigned_one. rewrite Zdiv_1_r. apply repr_unsigned.
Qed.

Theorem divs_one:
  forall x, zwordsize > 1 -> divs x one = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold divs; intros. rewrite signed_one. rewrite Z.quot_1_r. apply repr_signed. auto.
Qed.

Theorem modu_one:
  forall x, modu x one = zero.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite modu_divu. rewrite divu_one. rewrite mul_one. apply sub_idem.
(* Goal: Logic.not (@Logic.eq int one zero) *)
  apply one_not_zero.
Qed.

Theorem divs_mone:
  forall x, divs x mone = neg x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold divs, neg; intros.
(* Goal: @Logic.eq Z (Z.add (Z.mul (signed mone) modulus) (Z.add (signed n) modulus)) (signed n) *)
(* Goal: @Logic.eq Z (Z.add (Z.mul (signed zero) modulus) (signed n)) (signed n) *)
  rewrite signed_mone.
  replace (Z.quot (signed x) (-1)) with (- (signed x)).
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr. apply eqm_neg. apply eqm_signed_unsigned.
(* Goal: @Logic.eq Z (Z.opp (signed x)) (Z.quot (signed x) (Zneg xH)) *)
  set (x' := signed x).
(* Goal: @Logic.eq Z (Z.opp x') (Z.quot x' (Zneg xH)) *)
  set (one := 1).
  change (-1) with (- one). rewrite Zquot_opp_r.
(* Goal: @Logic.eq Z (Z.opp x') (Z.opp (Z.quot x' one)) *)
  assert (Z.quot x' one = x').
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  symmetry. apply Zquot_unique_full with 0. red.
(* Goal: Logic.or (Logic.and (Z.le Z0 x') (Logic.and (Z.le Z0 Z0) (Z.lt Z0 (Z.abs one)))) (Logic.and (Z.le x' Z0) (Logic.and (Z.lt (Z.opp (Z.abs one)) Z0) (Z.le Z0 Z0))) *)
(* Goal: @Logic.eq Z x' (Z.add (Z.mul one x') Z0) *)
(* Goal: @Logic.eq Z (Z.opp x') (Z.opp (Z.quot x' one)) *)
  change (Z.abs one) with 1.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zle 0 x'). left. omega. right. omega.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  unfold one; ring.
(* Goal: @Logic.eq BinNums.Z (Z.add (Int.unsigned y) (Int.unsigned z)) (Z.add (unsigned y') (unsigned z')) *)
  congruence.
Qed.

Theorem mods_mone:
  forall x, mods x mone = zero.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite mods_divs. rewrite divs_mone.
  rewrite <- neg_mul_distr_l. rewrite mul_mone. rewrite neg_involutive. apply sub_idem.
Qed.

Theorem divmodu2_divu_modu:
  forall n d,
  d <> zero -> divmodu2 zero n d = Some (divu n d, modu n d).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold divmodu2, divu, modu; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite dec_eq_false by auto.
  set (N := unsigned zero * modulus + unsigned n).
(* Goal: @Logic.eq (option (prod int int)) (let (q, r) := Z.div_eucl N (unsigned d) in if zle q max_unsigned then @Some (prod int int) (@pair int int (repr q) (repr r)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr (Z.div (unsigned n) (unsigned d))) (repr (Z.modulo (unsigned n) (unsigned d))))) *)
  assert (E1: unsigned n = N) by (unfold N; rewrite unsigned_zero; ring). rewrite ! E1.
(* Goal: @Logic.eq (option (prod int int)) (let (q, r) := Z.div_eucl N (unsigned d) in if zle q max_unsigned then @Some (prod int int) (@pair int int (repr q) (repr r)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr (Z.div N (unsigned d))) (repr (Z.modulo N (unsigned d))))) *)
  set (D := unsigned d).
(* Goal: @Logic.eq (option (prod int int)) (let (q, r) := Z.div_eucl N D in if zle q max_unsigned then @Some (prod int int) (@pair int int (repr q) (repr r)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr (Z.div N D)) (repr (Z.modulo N D)))) *)
  set (Q := N / D); set (R := N mod D).
(* Goal: @Logic.eq (option (prod int int)) (let (q, r) := Z.div_eucl N D in if zle q max_unsigned then @Some (prod int int) (@pair int int (repr q) (repr r)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr Q) (repr R))) *)
  assert (E2: Z.div_eucl N D = (Q, R)).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { unfold Q, R, Z.div, Z.modulo. destruct (Z.div_eucl N D); auto. }
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite E2. rewrite zle_true. auto.
(* Goal: Z.le Q max_unsigned *)
  assert (unsigned d <> 0).
  { red; intros. elim H. rewrite <- (repr_unsigned d). rewrite H0; auto. }
(* Goal: Z.le Q max_unsigned *)
  assert (0 < D).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  { unfold D. generalize (unsigned_range d); intros. omega. }
(* Goal: Z.le Q max_unsigned *)
  assert (0 <= Q <= max_unsigned).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { unfold Q. apply Zdiv_interval_2.
    rewrite <- E1; apply unsigned_range_2.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    omega. unfold max_unsigned; generalize modulus_pos; omega. omega. }
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Lemma unsigned_signed:
  forall n, unsigned n = if lt n zero then signed n + modulus else signed n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold lt. rewrite signed_zero. unfold signed.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (unsigned_range n). rewrite half_modulus_modulus. intros.
(* Goal: @Logic.eq Z (unsigned n) (if if zlt (if zlt (unsigned n) half_modulus then unsigned n else Z.sub (unsigned n) (Z.mul (Zpos (xO xH)) half_modulus)) Z0 then true else false then Z.add (if zlt (unsigned n) half_modulus then unsigned n else Z.sub (unsigned n) (Z.mul (Zpos (xO xH)) half_modulus)) (Z.mul (Zpos (xO xH)) half_modulus) else if zlt (unsigned n) half_modulus then unsigned n else Z.sub (unsigned n) (Z.mul (Zpos (xO xH)) half_modulus)) *)
  destruct (zlt (unsigned n) half_modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
- rewrite zlt_false by omega. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
- rewrite zlt_true by omega. ring.
Qed.

Theorem divmods2_divs_mods:
  forall n d,
  d <> zero -> n <> repr min_signed \/ d <> mone ->
  divmods2 (if lt n zero then mone else zero) n d = Some (divs n d, mods n d).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold divmods2, divs, mods; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite dec_eq_false by auto.
  set (N := signed (if lt n zero then mone else zero) * modulus + unsigned n).
(* Goal: @Logic.eq (option (prod int int)) (let (q, r) := Z.quotrem N (signed d) in if andb (@proj_sumbool (Z.le min_signed q) (Z.gt min_signed q) (zle min_signed q)) (@proj_sumbool (Z.le q max_signed) (Z.gt q max_signed) (zle q max_signed)) then @Some (prod int int) (@pair int int (repr q) (repr r)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr (Z.quot (signed n) (signed d))) (repr (Z.rem (signed n) (signed d))))) *)
  set (D := signed d).
(* Goal: @Logic.eq (option (prod int int)) (let (q, r) := Z.quotrem N D in if andb (@proj_sumbool (Z.le min_signed q) (Z.gt min_signed q) (zle min_signed q)) (@proj_sumbool (Z.le q max_signed) (Z.gt q max_signed) (zle q max_signed)) then @Some (prod int int) (@pair int int (repr q) (repr r)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr (Z.quot (signed n) D)) (repr (Z.rem (signed n) D)))) *)
  assert (D <> 0).
  { unfold D; red; intros. elim H. rewrite <- (repr_signed d). rewrite H1; auto. }
(* Goal: @Logic.eq (option (prod int int)) (let (q, r) := Z.quotrem N D in if andb (@proj_sumbool (Z.le min_signed q) (Z.gt min_signed q) (zle min_signed q)) (@proj_sumbool (Z.le q max_signed) (Z.gt q max_signed) (zle q max_signed)) then @Some (prod int int) (@pair int int (repr q) (repr r)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr (Z.quot (signed n) D)) (repr (Z.rem (signed n) D)))) *)
  assert (N = signed n).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { unfold N. rewrite unsigned_signed. destruct (lt n zero).
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
    rewrite signed_mone. ring.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
    rewrite signed_zero. ring. }
(* Goal: @Logic.eq (option (prod int int)) (let (q, r) := Z.quotrem N D in if andb (@proj_sumbool (Z.le min_signed q) (Z.gt min_signed q) (zle min_signed q)) (@proj_sumbool (Z.le q max_signed) (Z.gt q max_signed) (zle q max_signed)) then @Some (prod int int) (@pair int int (repr q) (repr r)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr (Z.quot (signed n) D)) (repr (Z.rem (signed n) D)))) *)
  set (Q := Z.quot N D); set (R := Z.rem N D).
(* Goal: @Logic.eq (option (prod int int)) (let (q, r) := Z.quotrem N D in if andb (@proj_sumbool (Z.le min_signed q) (Z.gt min_signed q) (zle min_signed q)) (@proj_sumbool (Z.le q max_signed) (Z.gt q max_signed) (zle q max_signed)) then @Some (prod int int) (@pair int int (repr q) (repr r)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr (Z.quot (signed n) D)) (repr (Z.rem (signed n) D)))) *)
  assert (E2: Z.quotrem N D = (Q, R)).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { unfold Q, R, Z.quot, Z.rem. destruct (Z.quotrem N D); auto. }
(* Goal: @Logic.eq (option (prod int int)) (let (q, r) := Z.quotrem N D in if andb (@proj_sumbool (Z.le min_signed q) (Z.gt min_signed q) (zle min_signed q)) (@proj_sumbool (Z.le q max_signed) (Z.gt q max_signed) (zle q max_signed)) then @Some (prod int int) (@pair int int (repr q) (repr r)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr (Z.quot (signed n) D)) (repr (Z.rem (signed n) D)))) *)
  rewrite E2.
(* Goal: @Logic.eq (option (prod int int)) (if andb (@proj_sumbool (Z.le min_signed Q) (Z.gt min_signed Q) (zle min_signed Q)) (@proj_sumbool (Z.le Q max_signed) (Z.gt Q max_signed) (zle Q max_signed)) then @Some (prod int int) (@pair int int (repr Q) (repr R)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr (Z.quot (signed n) D)) (repr (Z.rem (signed n) D)))) *)
  assert (min_signed <= N <= max_signed) by (rewrite H2; apply signed_range).
(* Goal: @Logic.eq (option (prod int int)) (if andb (@proj_sumbool (Z.le min_signed Q) (Z.gt min_signed Q) (zle min_signed Q)) (@proj_sumbool (Z.le Q max_signed) (Z.gt Q max_signed) (zle Q max_signed)) then @Some (prod int int) (@pair int int (repr Q) (repr R)) else @None (prod int int)) (@Some (prod int int) (@pair int int (repr (Z.quot (signed n) D)) (repr (Z.rem (signed n) D)))) *)
  assert (min_signed <= Q <= max_signed).
  { unfold Q. destruct (zeq D 1); [ | destruct (zeq D (-1))].
  - (* D = 1 *)
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    rewrite e. rewrite Z.quot_1_r; auto.
  - (* D = -1 *)
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite e. change (-1) with (Z.opp 1). rewrite Z.quot_opp_r by omega.
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (Zpos xH))) x *)
    rewrite Z.quot_1_r.
(* Goal: Logic.and (Z.le min_signed (Z.opp N)) (Z.le (Z.opp N) max_signed) *)
    assert (N <> min_signed).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
    { red; intros; destruct H0.
    + elim H0. rewrite <- (repr_signed n). rewrite <- H2. rewrite H4. auto.
    + elim H0. rewrite <- (repr_signed d). unfold D in e; rewrite e; auto. }
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    unfold min_signed, max_signed in *. omega.
  - (* |D| > 1 *)
(* Goal: Logic.and (Z.le min_signed (Z.quot N D)) (Z.le (Z.quot N D) max_signed) *)
    assert (Z.abs (Z.quot N D) < half_modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    { rewrite <- Z.quot_abs by omega. apply Zquot_lt_upper_bound.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      xomega. xomega.
(* Goal: Z.lt (Z.abs N) (Z.mul half_modulus (Z.abs D)) *)
      apply Z.le_lt_trans with (half_modulus * 1).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      rewrite Z.mul_1_r. unfold min_signed, max_signed in H3; xomega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      apply Zmult_lt_compat_l. generalize half_modulus_pos; omega. xomega. }
(* Goal: Logic.and (Z.le min_signed (Z.quot N D)) (Z.le (Z.quot N D) max_signed) *)
    rewrite Z.abs_lt in H4.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    unfold min_signed, max_signed; omega.
  }
(* Goal: forall _ : Logic.and (Z.le Z0 (Int.unsigned x)) (Z.lt (Int.unsigned x) (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))) xH))), Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) xH)) (Zpos xH))) *)
  unfold proj_sumbool; rewrite ! zle_true by omega; simpl.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold Q, R; rewrite H2; auto.
Qed.

(** ** Bit-level properties *)

(** ** Properties of bit-level operations over [Z] *)

Remark Ztestbit_0: forall n, Z.testbit 0 n = false.
Proof Z.testbit_0_l.

Remark Ztestbit_1: forall n, Z.testbit 1 n = zeq n 0.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct n; simpl; auto.
Qed.

Remark Ztestbit_m1: forall n, 0 <= n -> Z.testbit (-1) n = true.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct n; simpl; auto.
Qed.

Remark Zshiftin_spec:
  forall b x, Zshiftin b x = 2 * x + (if b then 1 else 0).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold Zshiftin; intros. destruct b.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - rewrite Z.succ_double_spec. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - rewrite Z.double_spec. omega.
Qed.

Remark Zshiftin_inj:
  forall b1 x1 b2 x2,
  Zshiftin b1 x1 = Zshiftin b2 x2 -> b1 = b2 /\ x1 = x2.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite !Zshiftin_spec in H.
(* Goal: Logic.and (@Logic.eq bool b1 b2) (@Logic.eq Z x1 x2) *)
  destruct b1; destruct b2.
(* Goal: Logic.and (@Logic.eq bool false false) (@Logic.eq Z x1 x2) *)
  split; [auto|omega].
(* Goal: @Logic.eq (list Z) (@nil Z) (@cons Z (Z.add i x) (@nil Z)) *)
(* Goal: @Logic.eq (list Z) (if Z.odd (two_p x) then @cons Z i (Z_one_bits n (Z.div2 (two_p x)) (Z.add i (Zpos xH))) else Z_one_bits n (Z.div2 (two_p x)) (Z.add i (Zpos xH))) (@cons Z (Z.add i x) (@nil Z)) *)
  omegaContradiction.
(* Goal: @Logic.eq (list Z) (@nil Z) (@cons Z (Z.add i x) (@nil Z)) *)
(* Goal: @Logic.eq (list Z) (if Z.odd (two_p x) then @cons Z i (Z_one_bits n (Z.div2 (two_p x)) (Z.add i (Zpos xH))) else Z_one_bits n (Z.div2 (two_p x)) (Z.add i (Zpos xH))) (@cons Z (Z.add i x) (@nil Z)) *)
  omegaContradiction.
(* Goal: Logic.and (@Logic.eq bool false false) (@Logic.eq Z x1 x2) *)
  split; [auto|omega].
Qed.

Remark Zdecomp:
  forall x, x = Zshiftin (Z.odd x) (Z.div2 x).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct x; simpl.
  - auto.
  - destruct p; auto.
  - destruct p; auto. simpl. rewrite Pos.pred_double_succ. auto.
Qed.

Remark Ztestbit_shiftin:
  forall b x n,
  0 <= n ->
  Z.testbit (Zshiftin b x) n = if zeq n 0 then b else Z.testbit x (Z.pred n).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite Zshiftin_spec. destruct (zeq n 0).
  - subst n. destruct b.
    + apply Z.testbit_odd_0.
    + rewrite Z.add_0_r. apply Z.testbit_even_0.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - assert (0 <= Z.pred n) by omega.
(* Goal: @Logic.eq bool (Z.testbit (Z.add (Z.mul (Zpos (xO xH)) x) (if b then Zpos xH else Z0)) n) (Z.testbit x (Z.pred n)) *)
    set (n' := Z.pred n) in *.
(* Goal: @Logic.eq bool (Z.testbit (Z.add (Z.mul (Zpos (xO xH)) x) (if b then Zpos xH else Z0)) n) (Z.testbit x n') *)
    replace n with (Z.succ n') by (unfold n'; omega).
(* Goal: @Logic.eq Z (Zsize (Zshiftin b (Zpos p))) (Z.succ (Zsize (Zpos p))) *)
    destruct b.
    + apply Z.testbit_odd_succ; auto.
    + rewrite Z.add_0_r. apply Z.testbit_even_succ; auto.
Qed.

Remark Ztestbit_shiftin_base:
  forall b x, Z.testbit (Zshiftin b x) 0 = b.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. rewrite Ztestbit_shiftin. apply zeq_true. omega.
Qed.

Remark Ztestbit_shiftin_succ:
  forall b x n, 0 <= n -> Z.testbit (Zshiftin b x) (Z.succ n) = Z.testbit x n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite Ztestbit_shiftin. rewrite zeq_false. rewrite Z.pred_succ. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega.
Qed.

Remark Ztestbit_eq:
  forall n x, 0 <= n ->
  Z.testbit x n = if zeq n 0 then Z.odd x else Z.testbit (Z.div2 x) (Z.pred n).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite (Zdecomp x) at 1. apply Ztestbit_shiftin; auto.
Qed.

Remark Ztestbit_base:
  forall x, Z.testbit x 0 = Z.odd x.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. rewrite Ztestbit_eq. apply zeq_true. omega.
Qed.

Remark Ztestbit_succ:
  forall n x, 0 <= n -> Z.testbit x (Z.succ n) = Z.testbit (Z.div2 x) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega.
Qed.

Lemma eqmod_same_bits:
  forall n x y,
  (forall i, 0 <= i < Z.of_nat n -> Z.testbit x i = Z.testbit y i) ->
  eqmod (two_power_nat n) x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  induction n; intros.
  - change (two_power_nat 0) with 1. exists (x-y); ring.
  - rewrite two_power_nat_S.
(* Goal: eqmod (Z.mul (Zpos (xO xH)) (two_power_nat n)) x y *)
    assert (eqmod (two_power_nat n) (Z.div2 x) (Z.div2 y)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      apply IHn. intros. rewrite <- !Ztestbit_succ. apply H. rewrite Nat2Z.inj_succ; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      omega. omega.
(* Goal: eqmod (Z.mul (Zpos (xO xH)) (two_power_nat n)) x y *)
  destruct H0 as [k EQ].
(* Goal: eqm (Z.mul x (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) *)
  exists k. rewrite (Zdecomp x). rewrite (Zdecomp y).
(* Goal: @Logic.eq Z (Zshiftin (Z.odd x) (Z.div2 x)) (Z.add (Z.mul k (Z.mul (Zpos (xO xH)) (two_power_nat n))) (Zshiftin (Z.odd y) (Z.div2 y))) *)
  replace (Z.odd y) with (Z.odd x).
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  rewrite EQ. rewrite !Zshiftin_spec. ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  exploit (H 0). rewrite Nat2Z.inj_succ; omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite !Ztestbit_base. auto.
Qed.

Lemma eqm_same_bits:
  forall x y,
  (forall i, 0 <= i < zwordsize -> Z.testbit x i = Z.testbit y i) ->
  eqm x y.
Proof (eqmod_same_bits wordsize).

Lemma same_bits_eqmod:
  forall n x y i,
  eqmod (two_power_nat n) x y -> 0 <= i < Z.of_nat n ->
  Z.testbit x i = Z.testbit y i.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  induction n; intros.
  - simpl in H0. omegaContradiction.
  - rewrite Nat2Z.inj_succ in H0. rewrite two_power_nat_S in H.
(* Goal: @Logic.eq bool (Z.testbit x i) (Z.testbit y i) *)
    rewrite !(Ztestbit_eq i); intuition.
(* Goal: eqm (Z.mul x (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) *)
    destruct H as [k EQ].
    assert (EQ': Zshiftin (Z.odd x) (Z.div2 x) =
                 Zshiftin (Z.odd y) (k * two_power_nat n + Z.div2 y)).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
    {
(* Goal: @Logic.eq Z (Zshiftin (Z.odd x) (Z.div2 x)) (Zshiftin (Z.odd y) (Z.add (Z.mul k (two_power_nat n)) (Z.div2 y))) *)
      rewrite (Zdecomp x) in EQ. rewrite (Zdecomp y) in EQ.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
      rewrite EQ. rewrite !Zshiftin_spec. ring.
    }
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    exploit Zshiftin_inj; eauto. intros [A B].
(* Goal: @Logic.eq bool (if zeq i Z0 then Z.odd x0 else Z.testbit (Z.iter (Z.pred x1) (forall _ : Z, Z) (fun (rec : forall _ : Z, Z) (x : Z) => Zshiftin (Z.odd x) (rec (Z.div2 x))) (fun x : Z => if Z.odd x then Zneg xH else Z0) (Z.div2 x0)) (Z.pred i)) (Z.testbit x0 (if zlt i x then i else Z.sub x (Zpos xH))) *)
(* Goal: Z.le Z0 i *)
(* Goal: Z.le Z0 (Z.pred x1) *)
(* Goal: @Logic.eq Z (Z.succ (Z.pred x1)) x1 *)
    destruct (zeq i 0).
    + auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + apply IHn. exists k; auto. omega.
Qed.

Lemma same_bits_eqm:
  forall x y i,
  eqm x y ->
  0 <= i < zwordsize ->
  Z.testbit x i = Z.testbit y i.
Proof (same_bits_eqmod wordsize).

Remark two_power_nat_infinity:
  forall x, 0 <= x -> exists n, x < two_power_nat n.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  intros x0 POS0; pattern x0; apply natlike_ind; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  exists O. compute; auto.
(* Goal: Logic.and (Z.le Z0 (unsigned x)) (Z.lt (unsigned x) (two_power_nat (S ws1))) *)
  intros. destruct H0 as [n LT]. exists (S n). rewrite two_power_nat_S.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (two_power_nat_pos n). omega.
Qed.

Lemma equal_same_bits:
  forall x y,
  (forall i, 0 <= i -> Z.testbit x i = Z.testbit y i) ->
  x = y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
  set (z := if zlt x y then y - x else x - y).
(* Goal: @Logic.eq Z x y *)
  assert (0 <= z).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    unfold z; destruct (zlt x y); omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  exploit (two_power_nat_infinity z); auto. intros [n LT].
(* Goal: @Logic.eq Z x y *)
  assert (eqmod (two_power_nat n) x y).
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
    apply eqmod_same_bits. intros. apply H. tauto.
(* Goal: @Logic.eq Z x y *)
  assert (eqmod (two_power_nat n) z 0).
(* Goal: @Logic.eq Z (unsigned (sub (repr (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) z)) (Int.unsigned (Int.sub (Int.repr (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) y)) *)
    unfold z. destruct (zlt x y).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    replace 0 with (y - y) by omega. apply eqmod_sub. apply eqmod_refl. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    replace 0 with (x - x) by omega. apply eqmod_sub. apply eqmod_refl. apply eqmod_sym; auto.
(* Goal: @Logic.eq Z x y *)
  assert (z = 0).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    apply eqmod_small_eq with (two_power_nat n). auto. omega. generalize (two_power_nat_pos n); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold z in H3. destruct (zlt x y); omega.
Qed.

Lemma Z_one_complement:
  forall i, 0 <= i ->
  forall x, Z.testbit (-x-1) i = negb (Z.testbit x i).
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  intros i0 POS0. pattern i0. apply Zlt_0_ind; auto.
(* Goal: forall (x : Z) (_ : forall (y : Z) (_ : Logic.and (Z.le Z0 y) (Z.lt y x)) (x0 : Z), @Logic.eq bool (Z.testbit (Z.sub (Z.opp x0) (Zpos xH)) y) (negb (Z.testbit x0 y))) (_ : Z.le Z0 x) (x0 : Z), @Logic.eq bool (Z.testbit (Z.sub (Z.opp x0) (Zpos xH)) x) (negb (Z.testbit x0 x)) *)
  intros i IND POS x.
(* Goal: @Logic.eq bool (Z.testbit (Z.sub (Z.opp x) (Zpos xH)) i) (negb (Z.testbit x i)) *)
  rewrite (Zdecomp x). set (y := Z.div2 x).
  replace (- Zshiftin (Z.odd x) y - 1)
     with (Zshiftin (negb (Z.odd x)) (- y - 1)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite !Ztestbit_shiftin; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zeq i 0). auto. apply IND. omega.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  rewrite !Zshiftin_spec. destruct (Z.odd x); simpl negb; ring.
Qed.

Lemma Ztestbit_above:
  forall n x i,
  0 <= x < two_power_nat n ->
  i >= Z.of_nat n ->
  Z.testbit x i = false.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  induction n; intros.
  - change (two_power_nat 0) with 1 in H.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    replace x with 0 by omega.
(* Goal: @Logic.eq bool (Z.testbit Z0 i) false *)
    apply Z.testbit_0_l.
  - rewrite Nat2Z.inj_succ in H0. rewrite Ztestbit_eq. rewrite zeq_false.
(* Goal: @Logic.eq Z (Z.mul (Z.div2 x) (two_p (Z.add i (Zpos xH)))) (powerserie (Z_one_bits n (Z.div2 x) (Z.add i (Zpos xH)))) *)
(* Goal: @Logic.eq Z (Z.mul x (two_p i)) (powerserie (if Z.odd x then @cons Z i (Z_one_bits n (Z.div2 x) (Z.add i (Zpos xH))) else Z_one_bits n (Z.div2 x) (Z.add i (Zpos xH)))) *)
    apply IHn. rewrite two_power_nat_S in H. rewrite (Zdecomp x) in H.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite Zshiftin_spec in H. destruct (Z.odd x); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    omega. omega. omega.
Qed.

Lemma Ztestbit_above_neg:
  forall n x i,
  -two_power_nat n <= x < 0 ->
  i >= Z.of_nat n ->
  Z.testbit x i = true.
Proof.
  intros. set (y := -x-1).
(* Goal: @Logic.eq bool (Z.testbit x i) true *)
  assert (Z.testbit y i = false).
(* Goal: @Logic.eq bool (Z.testbit y i) false *)
(* Goal: @Logic.eq bool (Z.testbit x i) true *)
    apply Ztestbit_above with n.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    unfold y; omega. auto.
(* Goal: @Logic.eq bool (Z.testbit x i) true *)
  unfold y in H1. rewrite Z_one_complement in H1.
  change true with (negb false). rewrite <- H1. rewrite negb_involutive; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Lemma Zsign_bit:
  forall n x,
  0 <= x < two_power_nat (S n) ->
  Z.testbit x (Z.of_nat n) = if zlt x (two_power_nat n) then false else true.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  induction n; intros.
  - change (two_power_nat 1) with 2 in H.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    assert (x = 0 \/ x = 1) by omega.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
    destruct H0; subst x; reflexivity.
  - rewrite Nat2Z.inj_succ. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ.
(* Goal: Logic.and (Z.le Z0 (unsigned x)) (Z.lt (unsigned x) (two_power_nat (S ws1))) *)
    rewrite IHn. rewrite two_power_nat_S.
(* Goal: Logic.and (Z.le Z0 (Zshiftin (Z.odd x0) (Z.modulo x1 (two_p x)))) (Z.lt (Zshiftin (Z.odd x0) (Z.modulo x1 (two_p x))) (Z.mul (Zpos (xO xH)) (two_p x))) *)
    destruct (zlt (Z.div2 x) (two_power_nat n)); rewrite (Zdecomp x); rewrite Zshiftin_spec.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite zlt_true. auto. destruct (Z.odd x); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite zlt_false. auto. destruct (Z.odd x); omega.
(* Goal: Logic.and (Z.le Z0 (Z.div2 x)) (Z.lt (Z.div2 x) (two_power_nat n)) *)
(* Goal: Z.ge (Z.pred i) (Z.of_nat n) *)
(* Goal: Logic.not (@Logic.eq Z i Z0) *)
(* Goal: Z.le Z0 i *)
    rewrite (Zdecomp x) in H; rewrite Zshiftin_spec in H.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite two_power_nat_S in H. destruct (Z.odd x); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    omega. omega.
Qed.

Lemma Zshiftin_ind:
  forall (P: Z -> Prop),
  P 0 ->
  (forall b x, 0 <= x -> P x -> P (Zshiftin b x)) ->
  forall x, 0 <= x -> P x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct x.
  - auto.
  - induction p.
    + change (P (Zshiftin true (Z.pos p))). auto.
    + change (P (Zshiftin false (Z.pos p))). auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + change (P (Zshiftin true 0)). apply H0. omega. auto.
  - compute in H1. intuition congruence.
Qed.

Lemma Zshiftin_pos_ind:
  forall (P: Z -> Prop),
  P 1 ->
  (forall b x, 0 < x -> P x -> P (Zshiftin b x)) ->
  forall x, 0 < x -> P x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct x; simpl in H1; try discriminate.
(* Goal: P (Zpos p) *)
  induction p.
    + change (P (Zshiftin true (Z.pos p))). auto.
    + change (P (Zshiftin false (Z.pos p))). auto.
    + auto.
Qed.

Lemma Ztestbit_le:
  forall x y,
  0 <= y ->
  (forall i, 0 <= i -> Z.testbit x i = true -> Z.testbit y i = true) ->
  x <= y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros x y0 POS0; revert x; pattern y0; apply Zshiftin_ind; auto; intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - replace x with 0. omega. apply equal_same_bits; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    rewrite Ztestbit_0. destruct (Z.testbit x i) as [] eqn:E; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    exploit H; eauto. rewrite Ztestbit_0. auto.
  - assert (Z.div2 x0 <= x).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
    { apply H0. intros. exploit (H1 (Z.succ i)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
        omega. rewrite Ztestbit_succ; auto. rewrite Ztestbit_shiftin_succ; auto.
    }
(* Goal: @Logic.eq Z (Zshiftin (Z.odd x0) x1) (Z.add (Z.mul (Z.div x1 (two_p x)) (Z.mul (Zpos (xO xH)) (two_p x))) (Zshiftin (Z.odd x0) (Z.modulo x1 (two_p x)))) *)
(* Goal: Logic.and (Z.le Z0 (Zshiftin (Z.odd x0) (Z.modulo x1 (two_p x)))) (Z.lt (Zshiftin (Z.odd x0) (Z.modulo x1 (two_p x))) (Z.mul (Zpos (xO xH)) (two_p x))) *)
    rewrite (Zdecomp x0). rewrite !Zshiftin_spec.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    destruct (Z.odd x0) as [] eqn:E1; destruct b as [] eqn:E2; try omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    exploit (H1 0). omega. rewrite Ztestbit_base; auto.
(* Goal: @Logic.eq BinNums.Z (Z.add (Int.unsigned y) (Int.unsigned z)) (Z.add (unsigned y') (unsigned z')) *)
    rewrite Ztestbit_shiftin_base. congruence.
Qed.

(** ** Bit-level reasoning over type [int] *)

Definition testbit (x: int) (i: Z) : bool := Z.testbit (unsigned x) i.

Lemma testbit_repr:
  forall x i,
  0 <= i < zwordsize ->
  testbit (repr x) i = Z.testbit x i.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold testbit. apply same_bits_eqm; auto with ints.
Qed.

Lemma same_bits_eq:
  forall x y,
  (forall i, 0 <= i < zwordsize -> testbit x i = testbit y i) ->
  x = y.
Proof.
  intros. rewrite <- (repr_unsigned x). rewrite <- (repr_unsigned y).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply eqm_samerepr. apply eqm_same_bits. auto.
Qed.

Lemma bits_above:
  forall x i, i >= zwordsize -> testbit x i = false.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply Ztestbit_above with wordsize; auto. apply unsigned_range.
Qed.

Lemma bits_zero:
  forall i, testbit zero i = false.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold testbit. rewrite unsigned_zero. apply Ztestbit_0.
Qed.

Remark bits_one: forall n, testbit one n = zeq n 0.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold testbit; intros. rewrite unsigned_one. apply Ztestbit_1.
Qed.

Lemma bits_mone:
  forall i, 0 <= i < zwordsize -> testbit mone i = true.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. unfold mone. rewrite testbit_repr; auto. apply Ztestbit_m1. omega.
Qed.

Hint Rewrite bits_zero bits_mone : ints.

Ltac bit_solve :=
  intros; apply same_bits_eq; intros; autorewrite with ints; auto with bool.

Lemma sign_bit_of_unsigned:
  forall x, testbit x (zwordsize - 1) = if zlt (unsigned x) half_modulus then false else true.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold testbit.
(* Goal: @Logic.eq bool (Z.testbit (unsigned x) (Z.sub zwordsize (Zpos xH))) (if zlt (unsigned x) half_modulus then false else true) *)
  set (ws1 := Init.Nat.pred wordsize).
  assert (zwordsize - 1 = Z.of_nat ws1).
(* Goal: @Logic.eq Z (Z.sub zwordsize (Zpos xH)) (Z.of_nat ws1) *)
(* Goal: @Logic.eq bool (Z.testbit (unsigned x) (Z.sub zwordsize (Zpos xH))) (if zlt (unsigned x) half_modulus then false else true) *)
    unfold zwordsize, ws1, wordsize.
(* Goal: None *)
(* Goal: @Logic.eq bool (Z.testbit (unsigned x) (Z.sub zwordsize (Zpos xH))) (if zlt (unsigned x) half_modulus then false else true) *)
    destruct WS.wordsize as [] eqn:E.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    elim WS.wordsize_not_zero; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite Nat2Z.inj_succ. simpl. omega.
(* Goal: @Logic.eq bool (Z.testbit (unsigned x) (Z.sub zwordsize (Zpos xH))) (if zlt (unsigned x) half_modulus then false else true) *)
  assert (half_modulus = two_power_nat ws1).
    rewrite two_power_nat_two_p. rewrite <- H. apply half_modulus_power.
(* Goal: @Logic.eq bool (Z.testbit (unsigned x) (Z.sub zwordsize (Zpos xH))) (if zlt (unsigned x) half_modulus then false else true) *)
  rewrite H; rewrite H0.
  apply Zsign_bit. rewrite two_power_nat_S. rewrite <- H0.
  rewrite <- half_modulus_modulus. apply unsigned_range.
Qed.

Lemma bits_signed:
  forall x i, 0 <= i ->
  Z.testbit (signed x) i = testbit x (if zlt i zwordsize then i else zwordsize - 1).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq bool (testbit (zero_ext n x) i) (if zlt i n then Z.testbit (unsigned x) i else false) *)
(* Goal: Z.le Z0 n *)
  destruct (zlt i zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - apply same_bits_eqm. apply eqm_signed_unsigned. omega.
  - unfold signed. rewrite sign_bit_of_unsigned. destruct (zlt (unsigned x) half_modulus).
    + apply Ztestbit_above with wordsize. apply unsigned_range. auto.
    + apply Ztestbit_above_neg with wordsize.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      fold modulus. generalize (unsigned_range x). omega. auto.
Qed.

Lemma bits_le:
  forall x y,
  (forall i, 0 <= i < zwordsize -> testbit x i = true -> testbit y i = true) ->
  unsigned x <= unsigned y.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. apply Ztestbit_le. generalize (unsigned_range y); omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. fold (testbit y i). destruct (zlt i zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply H. omega. auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  fold (testbit x i) in H1. rewrite bits_above in H1; auto. congruence.
Qed.

(** ** Properties of bitwise and, or, xor *)

Lemma bits_and:
  forall x y i, 0 <= i < zwordsize ->
  testbit (and x y) i = testbit x i && testbit y i.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold and. rewrite testbit_repr; auto. rewrite Z.land_spec; intuition.
Qed.

Lemma bits_or:
  forall x y i, 0 <= i < zwordsize ->
  testbit (or x y) i = testbit x i || testbit y i.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold or. rewrite testbit_repr; auto. rewrite Z.lor_spec; intuition.
Qed.

Lemma bits_xor:
  forall x y i, 0 <= i < zwordsize ->
  testbit (xor x y) i = xorb (testbit x i) (testbit y i).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold xor. rewrite testbit_repr; auto. rewrite Z.lxor_spec; intuition.
Qed.

Lemma bits_not:
  forall x i, 0 <= i < zwordsize ->
  testbit (not x) i = negb (testbit x i).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold not. rewrite bits_xor; auto. rewrite bits_mone; auto.
Qed.

Hint Rewrite bits_and bits_or bits_xor bits_not: ints.

Theorem and_commut: forall x y, and x y = and y x.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
Qed.

Theorem and_assoc: forall x y z, and (and x y) z = and x (and y z).
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
Qed.

Theorem and_zero: forall x, and x zero = zero.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. apply andb_b_false.
Qed.

Corollary and_zero_l: forall x, and zero x = zero.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite and_commut. apply and_zero.
Qed.

Theorem and_mone: forall x, and x mone = x.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. apply andb_b_true.
Qed.

Corollary and_mone_l: forall x, and mone x = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite and_commut. apply and_mone.
Qed.

Theorem and_idem: forall x, and x x = x.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  bit_solve. destruct (testbit x i); auto.
Qed.

Theorem or_commut: forall x y, or x y = or y x.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
Qed.

Theorem or_assoc: forall x y z, or (or x y) z = or x (or y z).
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
Qed.

Theorem or_zero: forall x, or x zero = x.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
Qed.

Corollary or_zero_l: forall x, or zero x = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite or_commut. apply or_zero.
Qed.

Theorem or_mone: forall x, or x mone = mone.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
Qed.

Theorem or_idem: forall x, or x x = x.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  bit_solve. destruct (testbit x i); auto.
Qed.

Theorem and_or_distrib:
  forall x y z,
  and x (or y z) = or (and x y) (and x z).
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. apply demorgan1.
Qed.

Corollary and_or_distrib_l:
  forall x y z,
  and (or x y) z = or (and x z) (and y z).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite (and_commut (or x y)). rewrite and_or_distrib. f_equal; apply and_commut.
Qed.

Theorem or_and_distrib:
  forall x y z,
  or x (and y z) = and (or x y) (or x z).
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. apply orb_andb_distrib_r.
Qed.

Corollary or_and_distrib_l:
  forall x y z,
  or (and x y) z = and (or x z) (or y z).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite (or_commut (and x y)). rewrite or_and_distrib. f_equal; apply or_commut.
Qed.

Theorem and_or_absorb: forall x y, and x (or x y) = x.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
(* Goal: @Logic.eq bool (andb (testbit x i) (orb (testbit x i) (testbit y i))) (testbit x i) *)
  assert (forall a b, a && (a || b) = a) by destr_bool.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
Qed.

Theorem or_and_absorb: forall x y, or x (and x y) = x.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
(* Goal: @Logic.eq bool (orb (testbit x i) (andb (testbit x i) (testbit y i))) (testbit x i) *)
  assert (forall a b, a || (a && b) = a) by destr_bool.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
Qed.

Theorem xor_commut: forall x y, xor x y = xor y x.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. apply xorb_comm.
Qed.

Theorem xor_assoc: forall x y z, xor (xor x y) z = xor x (xor y z).
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. apply xorb_assoc.
Qed.

Theorem xor_zero: forall x, xor x zero = x.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. apply xorb_false.
Qed.

Corollary xor_zero_l: forall x, xor zero x = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite xor_commut. apply xor_zero.
Qed.

Theorem xor_idem: forall x, xor x x = zero.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. apply xorb_nilpotent.
Qed.

Theorem xor_zero_one: xor zero one = one.
Proof. rewrite xor_commut. apply xor_zero. Qed.

Theorem xor_one_one: xor one one = zero.
Proof. apply xor_idem. Qed.

Theorem xor_zero_equal: forall x y, xor x y = zero -> x = y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros.
(* Goal: @Logic.eq bool (testbit x i) (testbit y i) *)
  assert (xorb (testbit x i) (testbit y i) = false).
    rewrite <- bits_xor; auto. rewrite H. apply bits_zero.
(* Goal: @Logic.eq bool (testbit x i) (testbit y i) *)
  destruct (testbit x i); destruct (testbit y i); reflexivity || discriminate.
Qed.

Theorem xor_is_zero: forall x y, eq (xor x y) zero = eq x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. predSpec eq eq_spec (xor x y) zero.
- apply xor_zero_equal in H. subst y. rewrite eq_true; auto. 
- predSpec eq eq_spec x y.
+ elim H; subst y; apply xor_idem. 
+ auto.
Qed. 

Theorem and_xor_distrib:
  forall x y z,
  and x (xor y z) = xor (and x y) (and x z).
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
(* Goal: @Logic.eq bool (andb (testbit x i) (xorb (testbit y i) (testbit z i))) (xorb (andb (testbit x i) (testbit y i)) (andb (testbit x i) (testbit z i))) *)
  assert (forall a b c, a && (xorb b c) = xorb (a && b) (a && c)) by destr_bool.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
Qed.

Theorem and_le:
  forall x y, unsigned (and x y) <= unsigned x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bits_le; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_and in H0; auto. rewrite andb_true_iff in H0. tauto.
Qed.

Theorem or_le:
  forall x y, unsigned x <= unsigned (or x y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bits_le; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_or; auto. rewrite H0; auto.
Qed.

(** Properties of bitwise complement.*)

Theorem not_involutive:
  forall (x: int), not (not x) = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold not. rewrite xor_assoc. rewrite xor_idem. apply xor_zero.
Qed.

Theorem not_zero:
  not zero = mone.
Proof.
(* Goal: @Logic.eq int (not zero) mone *)
  unfold not. rewrite xor_commut. apply xor_zero.
Qed.

Theorem not_mone:
  not mone = zero.
Proof.
  rewrite <- (not_involutive zero). symmetry. decEq. apply not_zero.
Qed.

Theorem not_or_and_not:
  forall x y, not (or x y) = and (not x) (not y).
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. apply negb_orb.
Qed.

Theorem not_and_or_not:
  forall x y, not (and x y) = or (not x) (not y).
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. apply negb_andb.
Qed.

Theorem and_not_self:
  forall x, and x (not x) = zero.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
Qed.

Theorem or_not_self:
  forall x, or x (not x) = mone.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
Qed.

Theorem xor_not_self:
  forall x, xor x (not x) = mone.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  bit_solve. destruct (testbit x i); auto.
Qed.

Lemma unsigned_not:
  forall x, unsigned (not x) = max_unsigned - unsigned x.
Proof.
  intros. transitivity (unsigned (repr(-unsigned x - 1))).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  f_equal. bit_solve. rewrite testbit_repr; auto. symmetry. apply Z_one_complement. omega.
  rewrite unsigned_repr_eq. apply Zmod_unique with (-1).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold max_unsigned. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (unsigned_range x). unfold max_unsigned. omega.
Qed.

Theorem not_neg:
  forall x, not x = add (neg x) mone.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
  rewrite <- (repr_unsigned x) at 1. unfold add.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite !testbit_repr; auto.
  transitivity (Z.testbit (-unsigned x - 1) i).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  symmetry. apply Z_one_complement. omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply same_bits_eqm; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  replace (-unsigned x - 1) with (-unsigned x + (-1)) by omega.
(* Goal: eqm (Z.add (Z.mul ph Int.modulus) pl) (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p))) *)
  apply eqm_add.
(* Goal: eqm (two_p (Int.unsigned y)) (unsigned (repr (two_p (Int.unsigned y)))) *)
(* Goal: Z.le Z0 (Int.unsigned y) *)
  unfold neg. apply eqm_unsigned_repr.
  rewrite unsigned_mone. exists (-1). ring.
Qed.

Theorem neg_not:
  forall x, neg x = add (not x) one.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite not_neg. rewrite add_assoc.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  replace (add mone one) with zero. rewrite add_zero. auto.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr. rewrite unsigned_mone. rewrite unsigned_one.
  exists (-1). ring.
Qed.

Theorem sub_add_not:
  forall x y, sub x y = add (add x (not y)) one.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite sub_add_opp. rewrite neg_not.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite ! add_assoc. auto.
Qed.

Theorem sub_add_not_3:
  forall x y b,
  b = zero \/ b = one ->
  sub (sub x y) b = add (add x (not y)) (xor b one).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite ! sub_add_not. rewrite ! add_assoc. f_equal. f_equal.
  rewrite <- neg_not. rewrite <- sub_add_opp. destruct H; subst b.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite xor_zero_l. rewrite sub_zero_l. auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite xor_idem. rewrite sub_idem. auto.
Qed.

Theorem sub_borrow_add_carry:
  forall x y b,
  b = zero \/ b = one ->
  sub_borrow x y b = xor (add_carry x (not y) (xor b one)) one.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold sub_borrow, add_carry. rewrite unsigned_not.
  replace (unsigned (xor b one)) with (1 - unsigned b).
  destruct (zlt (unsigned x - unsigned y - unsigned b)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite zlt_true. rewrite xor_zero_l; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold max_unsigned; omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite zlt_false. rewrite xor_idem; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold max_unsigned; omega.
(* Goal: @Logic.eq Z (Z.sub (Zpos xH) (unsigned b)) (unsigned (xor b one)) *)
  destruct H; subst b.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite xor_zero_l. rewrite unsigned_one, unsigned_zero; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite xor_idem. rewrite unsigned_one, unsigned_zero; auto.
Qed.

(** Connections between [add] and bitwise logical operations. *)

Lemma Z_add_is_or:
  forall i, 0 <= i ->
  forall x y,
  (forall j, 0 <= j <= i -> Z.testbit x j && Z.testbit y j = false) ->
  Z.testbit (x + y) i = Z.testbit x i || Z.testbit y i.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  intros i0 POS0. pattern i0. apply Zlt_0_ind; auto.
  intros i IND POS x y EXCL.
  rewrite (Zdecomp x) in *. rewrite (Zdecomp y) in *.
  transitivity (Z.testbit (Zshiftin (Z.odd x || Z.odd y) (Z.div2 x + Z.div2 y)) i).
  - f_equal. rewrite !Zshiftin_spec.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    exploit (EXCL 0). omega. rewrite !Ztestbit_shiftin_base. intros.
Opaque Z.mul.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
    destruct (Z.odd x); destruct (Z.odd y); simpl in *; discriminate || ring.
  - rewrite !Ztestbit_shiftin; auto.
(* Goal: @Logic.eq bool (if zeq i Z0 then Z.odd x0 else Z.testbit (Z.iter (Z.pred x1) (forall _ : Z, Z) (fun (rec : forall _ : Z, Z) (x : Z) => Zshiftin (Z.odd x) (rec (Z.div2 x))) (fun x : Z => if Z.odd x then Zneg xH else Z0) (Z.div2 x0)) (Z.pred i)) (Z.testbit x0 (if zlt i x then i else Z.sub x (Zpos xH))) *)
(* Goal: Z.le Z0 i *)
(* Goal: Z.le Z0 (Z.pred x1) *)
(* Goal: @Logic.eq Z (Z.succ (Z.pred x1)) x1 *)
    destruct (zeq i 0).
    + auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + apply IND. omega. intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      exploit (EXCL (Z.succ j)). omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
      rewrite !Ztestbit_shiftin_succ. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      omega. omega.
Qed.

Theorem add_is_or:
  forall x y,
  and x y = zero ->
  add x y = or x y.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  bit_solve. unfold add. rewrite testbit_repr; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply Z_add_is_or. omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq BinNums.Z (Z.add (Int.unsigned y) (Int.unsigned z)) (Z.add (unsigned y') (unsigned z')) *)
  assert (testbit (and x y) j = testbit zero j) by congruence.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  autorewrite with ints in H2. assumption. omega.
Qed.

Theorem xor_is_or:
  forall x y, and x y = zero -> xor x y = or x y.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
(* Goal: @Logic.eq BinNums.Z (Z.add (Int.unsigned y) (Int.unsigned z)) (Z.add (unsigned y') (unsigned z')) *)
  assert (testbit (and x y) i = testbit zero i) by congruence.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  autorewrite with ints in H1; auto.
(* Goal: @Logic.eq BinNums.Z (Z.add (Int.unsigned y) (Int.unsigned z)) (Z.add (unsigned y') (unsigned z')) *)
  destruct (testbit x i); destruct (testbit y i); simpl in *; congruence.
Qed.

Theorem add_is_xor:
  forall x y,
  and x y = zero ->
  add x y = xor x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite xor_is_or; auto. apply add_is_or; auto.
Qed.

Theorem add_and:
  forall x y z,
  and y z = zero ->
  add (and x y) (and x z) = and x (or y z).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite add_is_or.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite and_or_distrib; auto.
(* Goal: @Logic.eq int (and (and x y) (and x z)) zero *)
  rewrite (and_commut x y).
(* Goal: @Logic.eq int (and (and (rol (rol x n1) n2) (rol m1 n2)) m2) (and (rol x (modu (add n1 n2) iwordsize)) (and (rol m1 n2) m2)) *)
  rewrite and_assoc.
  repeat rewrite <- (and_assoc x).
(* Goal: @Logic.eq int (and y (and (and x x) z)) zero *)
  rewrite (and_commut (and x x)).
  rewrite <- and_assoc.
(* Goal: @Logic.eq int (and zero (and x x)) zero *)
  rewrite H. rewrite and_commut. apply and_zero.
Qed.

(** ** Properties of shifts *)

Lemma bits_shl:
  forall x y i,
  0 <= i < zwordsize ->
  testbit (shl x y) i =
  if zlt i (unsigned y) then false else testbit x (i - unsigned y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shl. rewrite testbit_repr; auto.
(* Goal: @Logic.eq bool (Z.testbit (Z.shiftl (unsigned x) (unsigned y)) i) (if zlt i (unsigned y) then false else testbit x (Z.sub i (unsigned y))) *)
  destruct (zlt i (unsigned y)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply Z.shiftl_spec_low. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply Z.shiftl_spec_high. omega. omega.
Qed.

Lemma bits_shru:
  forall x y i,
  0 <= i < zwordsize ->
  testbit (shru x y) i =
  if zlt (i + unsigned y) zwordsize then testbit x (i + unsigned y) else false.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shru. rewrite testbit_repr; auto.
  rewrite Z.shiftr_spec. fold (testbit x (i + unsigned y)).
  destruct (zlt (i + unsigned y) zwordsize).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply bits_above; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Lemma bits_shr:
  forall x y i,
  0 <= i < zwordsize ->
  testbit (shr x y) i =
  testbit x (if zlt (i + unsigned y) zwordsize then i + unsigned y else zwordsize - 1).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shr. rewrite testbit_repr; auto.
(* Goal: @Logic.eq bool (Z.testbit (Z.shiftr (signed x) (Int.unsigned y)) i) (testbit x (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
  rewrite Z.shiftr_spec. apply bits_signed.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (unsigned_range y); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Hint Rewrite bits_shl bits_shru bits_shr: ints.

Theorem shl_zero: forall x, shl x zero = x.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  bit_solve. rewrite unsigned_zero. rewrite zlt_false. f_equal; omega. omega.
Qed.

Lemma bitwise_binop_shl:
  forall f f' x y n,
  (forall x y i, 0 <= i < zwordsize -> testbit (f x y) i = f' (testbit x i) (testbit y i)) ->
  f' false false = false ->
  f (shl x n) (shl y n) = shl (f x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite H; auto. rewrite !bits_shl; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct (zlt i (unsigned n)); auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite H; auto. generalize (unsigned_range n); omega.
Qed.

Theorem and_shl:
  forall x y n,
  and (shl x n) (shl y n) = shl (and x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_shl with andb. exact bits_and. auto.
Qed.

Theorem or_shl:
  forall x y n,
  or (shl x n) (shl y n) = shl (or x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_shl with orb. exact bits_or. auto.
Qed.

Theorem xor_shl:
  forall x y n,
  xor (shl x n) (shl y n) = shl (xor x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_shl with xorb. exact bits_xor. auto.
Qed.

Lemma ltu_inv:
  forall x y, ltu x y = true -> 0 <= unsigned x < unsigned y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold ltu; intros. destruct (zlt (unsigned x) (unsigned y)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  split; auto. generalize (unsigned_range x); omega.
(* Goal: Logic.and (Z.le Z0 (unsigned x)) (Z.lt (unsigned x) (unsigned y)) *)
  discriminate.
Qed.

Lemma ltu_iwordsize_inv:
  forall x, ltu x iwordsize = true -> 0 <= unsigned x < zwordsize.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (ltu_inv _ _ H). rewrite unsigned_repr_wordsize. auto.
Qed.

Theorem shl_shl:
  forall x y z,
  ltu y iwordsize = true ->
  ltu z iwordsize = true ->
  ltu (add y z) iwordsize = true ->
  shl (shl x y) z = shl x (add y z).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (ltu_iwordsize_inv _ H) (ltu_iwordsize_inv _ H0); intros.
  assert (unsigned (add y z) = unsigned y + unsigned z).
(* Goal: @Logic.eq Z (unsigned (repr (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)))) (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)) *)
    unfold add. apply unsigned_repr.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize two_wordsize_max_unsigned; omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_shl; auto.
(* Goal: @Logic.eq bool (if zlt i (unsigned z) then false else testbit (shl x y) (Z.sub i (unsigned z))) (testbit (shl x (add y z)) i) *)
  destruct (zlt i (unsigned z)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - rewrite bits_shl; auto. rewrite zlt_true. auto. omega.
  - rewrite bits_shl. destruct (zlt (i - unsigned z) (unsigned y)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + rewrite bits_shl; auto. rewrite zlt_true. auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + rewrite bits_shl; auto. rewrite zlt_false. f_equal. omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + omega.
Qed.

Theorem sub_ltu:
  forall x y,
    ltu x y = true ->
    0 <= unsigned y - unsigned x <= unsigned y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (unsigned y) (unsigned x))) (Z.le (Z.sub (unsigned y) (unsigned x)) (unsigned y)) *)
  generalize (ltu_inv x y H). intros .
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  split. omega. omega.
Qed.

Theorem shru_zero: forall x, shru x zero = x.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  bit_solve. rewrite unsigned_zero. rewrite zlt_true. f_equal; omega. omega.
Qed.

Lemma bitwise_binop_shru:
  forall f f' x y n,
  (forall x y i, 0 <= i < zwordsize -> testbit (f x y) i = f' (testbit x i) (testbit y i)) ->
  f' false false = false ->
  f (shru x n) (shru y n) = shru (f x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite H; auto. rewrite !bits_shru; auto.
  destruct (zlt (i + unsigned n) zwordsize); auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite H; auto. generalize (unsigned_range n); omega.
Qed.

Theorem and_shru:
  forall x y n,
  and (shru x n) (shru y n) = shru (and x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_shru with andb; auto. exact bits_and.
Qed.

Theorem or_shru:
  forall x y n,
  or (shru x n) (shru y n) = shru (or x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_shru with orb; auto. exact bits_or.
Qed.

Theorem xor_shru:
  forall x y n,
  xor (shru x n) (shru y n) = shru (xor x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_shru with xorb; auto. exact bits_xor.
Qed.

Theorem shru_shru:
  forall x y z,
  ltu y iwordsize = true ->
  ltu z iwordsize = true ->
  ltu (add y z) iwordsize = true ->
  shru (shru x y) z = shru x (add y z).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (ltu_iwordsize_inv _ H) (ltu_iwordsize_inv _ H0); intros.
  assert (unsigned (add y z) = unsigned y + unsigned z).
(* Goal: @Logic.eq Z (unsigned (repr (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)))) (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)) *)
    unfold add. apply unsigned_repr.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize two_wordsize_max_unsigned; omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_shru; auto.
  destruct (zlt (i + unsigned z) zwordsize).
  - rewrite bits_shru. destruct (zlt (i + unsigned z + unsigned y) zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + rewrite bits_shru; auto. rewrite zlt_true. f_equal. omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + rewrite bits_shru; auto. rewrite zlt_false. auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - rewrite bits_shru; auto. rewrite zlt_false. auto. omega.
Qed.

Theorem shr_zero: forall x, shr x zero = x.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  bit_solve. rewrite unsigned_zero. rewrite zlt_true. f_equal; omega. omega.
Qed.

Lemma bitwise_binop_shr:
  forall f f' x y n,
  (forall x y i, 0 <= i < zwordsize -> testbit (f x y) i = f' (testbit x i) (testbit y i)) ->
  f (shr x n) (shr y n) = shr (f x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite H; auto. rewrite !bits_shr; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite H; auto.
  destruct (zlt (i + unsigned n) zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (unsigned_range n); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Theorem and_shr:
  forall x y n,
  and (shr x n) (shr y n) = shr (and x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_shr with andb. exact bits_and.
Qed.

Theorem or_shr:
  forall x y n,
  or (shr x n) (shr y n) = shr (or x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_shr with orb. exact bits_or.
Qed.

Theorem xor_shr:
  forall x y n,
  xor (shr x n) (shr y n) = shr (xor x y) n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_shr with xorb. exact bits_xor.
Qed.

Theorem shr_shr:
  forall x y z,
  ltu y iwordsize = true ->
  ltu z iwordsize = true ->
  ltu (add y z) iwordsize = true ->
  shr (shr x y) z = shr x (add y z).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (ltu_iwordsize_inv _ H) (ltu_iwordsize_inv _ H0); intros.
  assert (unsigned (add y z) = unsigned y + unsigned z).
(* Goal: @Logic.eq Z (unsigned (repr (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)))) (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)) *)
    unfold add. apply unsigned_repr.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize two_wordsize_max_unsigned; omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite !bits_shr; auto. f_equal.
  destruct (zlt (i + unsigned z) zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite H4. replace (i + (unsigned y + unsigned z)) with (i + unsigned z + unsigned y) by omega. auto.
  rewrite (zlt_false _ (i + unsigned (add y z))).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt (zwordsize - 1 + unsigned y) zwordsize); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt (i + unsigned z) zwordsize); omega.
Qed.

Theorem and_shr_shru:
  forall x y z,
  and (shr x z) (shru y z) = shru (and x y) z.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_and; auto. rewrite bits_shr; auto. rewrite !bits_shru; auto.
  destruct (zlt (i + unsigned z) zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - rewrite bits_and; auto. generalize (unsigned_range z); omega.
  - apply andb_false_r.
Qed.

Theorem shr_and_shru_and:
  forall x y z,
  shru (shl z y) y = z ->
  and (shr x y) z = and (shru x y) z.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
  rewrite <- H.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite and_shru. rewrite and_shr_shru. auto.
Qed.

Theorem shru_lt_zero:
  forall x,
  shru x (repr (zwordsize - 1)) = if lt x zero then one else zero.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_shru; auto.
(* Goal: @Logic.eq Int64.int (Int64.repr (unsigned (repr (Int64.unsigned n)))) n *)
  rewrite unsigned_repr.
(* Goal: @Logic.eq bool (if zeq i Z0 then Z.odd x0 else Z.testbit (Z.iter (Z.pred x1) (forall _ : Z, Z) (fun (rec : forall _ : Z, Z) (x : Z) => Zshiftin (Z.odd x) (rec (Z.div2 x))) (fun x : Z => if Z.odd x then Zneg xH else Z0) (Z.div2 x0)) (Z.pred i)) (Z.testbit x0 (if zlt i x then i else Z.sub x (Zpos xH))) *)
(* Goal: Z.le Z0 i *)
(* Goal: Z.le Z0 (Z.pred x1) *)
(* Goal: @Logic.eq Z (Z.succ (Z.pred x1)) x1 *)
  destruct (zeq i 0).
(* Goal: @Logic.eq bool (negb false) (orb (if zlt (unsigned x) (unsigned y) then true else false) false) *)
  subst i. rewrite Z.add_0_l. rewrite zlt_true.
(* Goal: @Logic.eq bool (testbit x (Z.sub zwordsize (Zpos xH))) (testbit (if lt x zero then mone else zero) i) *)
(* Goal: Logic.and (Z.le Z0 (Z.sub zwordsize (Zpos xH))) (Z.le (Z.sub zwordsize (Zpos xH)) max_unsigned) *)
  rewrite sign_bit_of_unsigned.
(* Goal: forall _ : @Logic.eq bool false (if zlt (unsigned (and x y)) half_modulus then false else true), Z.ge (signed (and x y)) Z0 *)
(* Goal: Logic.and (Z.le Z0 (Z.sub zwordsize (Zpos xH))) (Z.lt (Z.sub zwordsize (Zpos xH)) zwordsize) *)
  unfold lt. rewrite signed_zero. unfold signed.
(* Goal: @Logic.eq bool (if zlt (unsigned x) half_modulus then false else true) (testbit (if if zlt (if zlt (unsigned x) half_modulus then unsigned x else Z.sub (unsigned x) modulus) Z0 then true else false then mone else zero) i) *)
(* Goal: Logic.and (Z.le Z0 (Z.sub zwordsize (Zpos xH))) (Z.le (Z.sub zwordsize (Zpos xH)) max_unsigned) *)
  destruct (zlt (unsigned x) half_modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false. auto. generalize (unsigned_range x); omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite zlt_true. unfold one; rewrite testbit_repr; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (unsigned_range x); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
(* Goal: @Logic.eq bool (if zlt (Z.add i Int.zwordsize) Int.zwordsize then Int.testbit lo (Z.add i Int.zwordsize) else Int.testbit hi (Z.sub (Z.add i Int.zwordsize) Int.zwordsize)) (Int.testbit hi i) *)
(* Goal: Logic.and (Z.le Z0 (Z.add i Int.zwordsize)) (Z.lt (Z.add i Int.zwordsize) zwordsize) *)
  rewrite zlt_false.
(* Goal: @Logic.eq bool (if zeq i Z0 then b else Z.testbit x (Z.pred i)) false *)
(* Goal: Z.le Z0 i *)
  unfold testbit. rewrite Ztestbit_eq. rewrite zeq_false.
(* Goal: @Logic.eq int (if lt x zero then add x (sub (shl one y) one) else x) (add x (shru (if lt x zero then mone else zero) (sub iwordsize y))) *)
  destruct (lt x zero).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite unsigned_one. simpl Z.div2. rewrite Z.testbit_0_l; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite unsigned_zero. simpl Z.div2. rewrite Z.testbit_0_l; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  auto. omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize wordsize_max_unsigned; omega.
Qed.

Theorem shr_lt_zero:
  forall x,
  shr x (repr (zwordsize - 1)) = if lt x zero then mone else zero.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_shr; auto.
(* Goal: @Logic.eq Int64.int (Int64.repr (unsigned (repr (Int64.unsigned n)))) n *)
  rewrite unsigned_repr.
  transitivity (testbit x (zwordsize - 1)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  f_equal. destruct (zlt (i + (zwordsize - 1)) zwordsize); omega.
(* Goal: @Logic.eq bool (testbit x (Z.sub zwordsize (Zpos xH))) (testbit (if lt x zero then mone else zero) i) *)
(* Goal: Logic.and (Z.le Z0 (Z.sub zwordsize (Zpos xH))) (Z.le (Z.sub zwordsize (Zpos xH)) max_unsigned) *)
  rewrite sign_bit_of_unsigned.
(* Goal: forall _ : @Logic.eq bool false (if zlt (unsigned (and x y)) half_modulus then false else true), Z.ge (signed (and x y)) Z0 *)
(* Goal: Logic.and (Z.le Z0 (Z.sub zwordsize (Zpos xH))) (Z.lt (Z.sub zwordsize (Zpos xH)) zwordsize) *)
  unfold lt. rewrite signed_zero. unfold signed.
(* Goal: @Logic.eq bool (if zlt (unsigned x) half_modulus then false else true) (testbit (if if zlt (if zlt (unsigned x) half_modulus then unsigned x else Z.sub (unsigned x) modulus) Z0 then true else false then mone else zero) i) *)
(* Goal: Logic.and (Z.le Z0 (Z.sub zwordsize (Zpos xH))) (Z.le (Z.sub zwordsize (Zpos xH)) max_unsigned) *)
  destruct (zlt (unsigned x) half_modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false. rewrite bits_zero; auto. generalize (unsigned_range x); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true. rewrite bits_mone; auto. generalize (unsigned_range x); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize wordsize_max_unsigned; omega.
Qed.

(** ** Properties of rotations *)

Lemma bits_rol:
  forall x y i,
  0 <= i < zwordsize ->
  testbit (rol x y) i = testbit x ((i - unsigned y) mod zwordsize).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold rol.
  exploit (Z_div_mod_eq (unsigned y) zwordsize). apply wordsize_pos.
  set (j := unsigned y mod zwordsize). set (k := unsigned y / zwordsize).
  intros EQ.
(* Goal: Z.gt zwordsize Z0 *)
(* Goal: eqmod zwordsize (Z.add i (unsigned y)) (Z.sub i (Z.sub zwordsize (unsigned y))) *)
(* Goal: Logic.and (Z.le Z0 (Z.sub (unsigned iwordsize) (unsigned y))) (Z.le (Z.sub (unsigned iwordsize) (unsigned y)) max_unsigned) *)
  exploit (Z_mod_lt (unsigned y) zwordsize). apply wordsize_pos.
  fold j. intros RANGE.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite testbit_repr; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Z.lor_spec. rewrite Z.shiftr_spec. 2: omega.
  destruct (zlt i j).
  - rewrite Z.shiftl_spec_low; auto. simpl.
(* Goal: @Logic.eq bool (testbit y i) false *)
    unfold testbit. f_equal.
    symmetry. apply Zmod_unique with (-k - 1).
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
    rewrite EQ. ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    omega.
  - rewrite Z.shiftl_spec_high.
    fold (testbit x (i + (zwordsize - j))).
(* Goal: @Logic.eq bool (testbit (zero_ext n x) i) (if zlt i n then Z.testbit (unsigned x) i else false) *)
(* Goal: Z.le Z0 n *)
    rewrite bits_above. rewrite orb_false_r.
    fold (testbit x (i - j)).
    f_equal. symmetry. apply Zmod_unique with (-k).
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
    rewrite EQ. ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    omega. omega. omega. omega.
Qed.

Lemma bits_ror:
  forall x y i,
  0 <= i < zwordsize ->
  testbit (ror x y) i = testbit x ((i + unsigned y) mod zwordsize).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold ror.
  exploit (Z_div_mod_eq (unsigned y) zwordsize). apply wordsize_pos.
  set (j := unsigned y mod zwordsize). set (k := unsigned y / zwordsize).
  intros EQ.
(* Goal: Z.gt zwordsize Z0 *)
(* Goal: eqmod zwordsize (Z.add i (unsigned y)) (Z.sub i (Z.sub zwordsize (unsigned y))) *)
(* Goal: Logic.and (Z.le Z0 (Z.sub (unsigned iwordsize) (unsigned y))) (Z.le (Z.sub (unsigned iwordsize) (unsigned y)) max_unsigned) *)
  exploit (Z_mod_lt (unsigned y) zwordsize). apply wordsize_pos.
  fold j. intros RANGE.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite testbit_repr; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Z.lor_spec. rewrite Z.shiftr_spec. 2: omega.
  destruct (zlt (i + j) zwordsize).
  - rewrite Z.shiftl_spec_low; auto. rewrite orb_false_r.
(* Goal: @Logic.eq bool (testbit y i) false *)
    unfold testbit. f_equal.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
    symmetry. apply Zmod_unique with k.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
    rewrite EQ. ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    omega. omega.
  - rewrite Z.shiftl_spec_high.
    fold (testbit x (i + j)).
(* Goal: forall _ : Logic.and (Z.le Z0 (Int.unsigned x)) (Z.lt (Int.unsigned x) (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))) xH))), Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) xH)) (Zpos xH))) *)
    rewrite bits_above. simpl.
(* Goal: @Logic.eq bool (testbit y i) false *)
    unfold testbit. f_equal.
    symmetry. apply Zmod_unique with (k + 1).
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
    rewrite EQ. ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    omega. omega. omega. omega.
Qed.

Hint Rewrite bits_rol bits_ror: ints.

Theorem shl_rolm:
  forall x n,
  ltu n iwordsize = true ->
  shl x n = rolm x n (shl mone n).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (ltu_inv _ _ H). rewrite unsigned_repr_wordsize; intros.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold rolm. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_and; auto. rewrite !bits_shl; auto. rewrite bits_rol; auto.
(* Goal: @Logic.eq bool (if zlt i (unsigned n) then false else testbit x (Z.sub i (unsigned n))) (andb (testbit x (Z.modulo (Z.sub i (unsigned n)) zwordsize)) (if zlt i (unsigned n) then false else testbit mone (Z.sub i (unsigned n)))) *)
  destruct (zlt i (unsigned n)).
  - rewrite andb_false_r; auto.
  - generalize (unsigned_range n); intros.
(* Goal: @Logic.eq int (repr p) (repr (Z.add (Z.mul ph Int.modulus) pl)) *)
    rewrite bits_mone. rewrite andb_true_r. f_equal.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    symmetry. apply Zmod_small. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    omega.
Qed.

Theorem shru_rolm:
  forall x n,
  ltu n iwordsize = true ->
  shru x n = rolm x (sub iwordsize n) (shru mone n).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (ltu_inv _ _ H). rewrite unsigned_repr_wordsize; intros.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold rolm. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_and; auto. rewrite !bits_shru; auto. rewrite bits_rol; auto.
  destruct (zlt (i + unsigned n) zwordsize).
  - generalize (unsigned_range n); intros.
(* Goal: @Logic.eq int (repr p) (repr (Z.add (Z.mul ph Int.modulus) pl)) *)
    rewrite bits_mone. rewrite andb_true_r. f_equal.
(* Goal: @Logic.eq Z (Int.unsigned (Int.repr (Z.sub (Int.unsigned y) (Int.unsigned x)))) (unsigned (sub (repr (Int.unsigned y)) (repr (Int.unsigned x)))) *)
    unfold sub. rewrite unsigned_repr. rewrite unsigned_repr_wordsize.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    symmetry. apply Zmod_unique with (-1). ring. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite unsigned_repr_wordsize. generalize wordsize_max_unsigned. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    omega.
  - rewrite andb_false_r; auto.
Qed.

Theorem rol_zero:
  forall x,
  rol x zero = x.
Proof.
(* Goal: @Logic.eq Z (Z.modulo (Z.sub i (unsigned zero)) zwordsize) i *)
  bit_solve. f_equal. rewrite unsigned_zero. rewrite Z.sub_0_r.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply Zmod_small; auto.
Qed.

Lemma bitwise_binop_rol:
  forall f f' x y n,
  (forall x y i, 0 <= i < zwordsize -> testbit (f x y) i = f' (testbit x i) (testbit y i)) ->
  rol (f x y) n = f (rol x n) (rol y n).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite H; auto. rewrite !bits_rol; auto. rewrite H; auto.
(* Goal: Z.gt zwordsize Z0 *)
(* Goal: eqmod zwordsize (Z.add i (unsigned y)) (Z.sub i (Z.sub zwordsize (unsigned y))) *)
(* Goal: Logic.and (Z.le Z0 (Z.sub (unsigned iwordsize) (unsigned y))) (Z.le (Z.sub (unsigned iwordsize) (unsigned y)) max_unsigned) *)
  apply Z_mod_lt. apply wordsize_pos.
Qed.

Theorem rol_and:
  forall x y n,
  rol (and x y) n = and (rol x n) (rol y n).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_rol with andb. exact bits_and.
Qed.

Theorem rol_or:
  forall x y n,
  rol (or x y) n = or (rol x n) (rol y n).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_rol with orb. exact bits_or.
Qed.

Theorem rol_xor:
  forall x y n,
  rol (xor x y) n = xor (rol x n) (rol y n).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply bitwise_binop_rol with xorb. exact bits_xor.
Qed.

Theorem rol_rol:
  forall x n m,
  Z.divide zwordsize modulus ->
  rol (rol x n) m = rol x (modu (add n m) iwordsize).
Proof.
(* Goal: @Logic.eq Z (Z.modulo (Z.add i (unsigned y)) zwordsize) (Z.modulo (Z.sub i (unsigned (neg y))) zwordsize) *)
  bit_solve. f_equal. apply eqmod_mod_eq. apply wordsize_pos.
  set (M := unsigned m); set (N := unsigned n).
  apply eqmod_trans with (i - M - N).
(* Goal: eqmod zwordsize (Z.sub i (Z.opp (unsigned y))) (Z.sub i (unsigned (neg y))) *)
  apply eqmod_sub.
(* Goal: eqmod (two_p n) (unsigned x) (Z.modulo (unsigned x) (two_p n)) *)
  apply eqmod_sym. apply eqmod_mod. apply wordsize_pos.
(* Goal: eqmod zwordsize i i *)
(* Goal: eqmod zwordsize (Z.opp (unsigned y)) (unsigned (neg y)) *)
  apply eqmod_refl.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  replace (i - M - N) with (i - (M + N)) by omega.
(* Goal: eqmod zwordsize (Z.sub i (Z.opp (unsigned y))) (Z.sub i (unsigned (neg y))) *)
  apply eqmod_sub.
(* Goal: eqmod zwordsize i i *)
(* Goal: eqmod zwordsize (Z.opp (unsigned y)) (unsigned (neg y)) *)
  apply eqmod_refl.
  apply eqmod_trans with (Z.modulo (unsigned n + unsigned m) zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  replace (M + N) with (N + M) by omega. apply eqmod_mod. apply wordsize_pos.
(* Goal: @Logic.eq int (repr (Z.sub (two_p uy) (Zpos xH))) (shru mone (repr (Z.sub (unsigned iwordsize) (unsigned y)))) *)
(* Goal: Logic.and (Z.le Z0 (two_p uy)) (Z.le (two_p uy) max_unsigned) *)
  unfold modu, add. fold M; fold N. rewrite unsigned_repr_wordsize.
  assert (forall a, eqmod zwordsize a (unsigned (repr a))).
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
    intros. eapply eqmod_divides. apply eqm_unsigned_repr. assumption.
  eapply eqmod_trans. 2: apply H1.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply eqmod_refl2. apply eqmod_mod_eq. apply wordsize_pos. auto.
(* Goal: Z.gt zwordsize Z0 *)
(* Goal: eqmod zwordsize (Z.add i (unsigned y)) (Z.sub i (Z.sub zwordsize (unsigned y))) *)
(* Goal: Logic.and (Z.le Z0 (Z.sub (unsigned iwordsize) (unsigned y))) (Z.le (Z.sub (unsigned iwordsize) (unsigned y)) max_unsigned) *)
  apply Z_mod_lt. apply wordsize_pos.
Qed.

Theorem rolm_zero:
  forall x m,
  rolm x zero m = and x m.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold rolm. rewrite rol_zero. auto.
Qed.

Theorem rolm_rolm:
  forall x n1 m1 n2 m2,
  Z.divide zwordsize modulus ->
  rolm (rolm x n1 m1) n2 m2 =
    rolm x (modu (add n1 n2) iwordsize)
           (and (rol m1 n2) m2).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq int (and (and (rol (rol x n1) n2) (rol m1 n2)) m2) (and (rol x (modu (add n1 n2) iwordsize)) (and (rol m1 n2) m2)) *)
  unfold rolm. rewrite rol_and. rewrite and_assoc.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite rol_rol. reflexivity. auto.
Qed.

Theorem or_rolm:
  forall x n m1 m2,
  or (rolm x n m1) (rolm x n m2) = rolm x n (or m1 m2).
Proof.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  intros; unfold rolm. symmetry. apply and_or_distrib.
Qed.

Theorem ror_rol:
  forall x y,
  ltu y iwordsize = true ->
  ror x y = rol x (sub iwordsize y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (ltu_iwordsize_inv _ H); intros.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_ror; auto. rewrite bits_rol; auto. f_equal.
(* Goal: @Logic.eq Z (Int.unsigned (Int.repr (Z.sub (Int.unsigned y) (Int.unsigned x)))) (unsigned (sub (repr (Int.unsigned y)) (repr (Int.unsigned x)))) *)
  unfold sub. rewrite unsigned_repr. rewrite unsigned_repr_wordsize.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  apply eqmod_mod_eq. apply wordsize_pos. exists 1. ring.
(* Goal: @Logic.eq int (repr (Z.sub (two_p uy) (Zpos xH))) (shru mone (repr (Z.sub (unsigned iwordsize) (unsigned y)))) *)
(* Goal: Logic.and (Z.le Z0 (two_p uy)) (Z.le (two_p uy) max_unsigned) *)
  rewrite unsigned_repr_wordsize.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize wordsize_pos; generalize wordsize_max_unsigned; omega.
Qed.

Theorem ror_rol_neg:
  forall x y, (zwordsize | modulus) -> ror x y = rol x (neg y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_ror by auto. rewrite bits_rol by auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  f_equal. apply eqmod_mod_eq. omega.
  apply eqmod_trans with (i - (- unsigned y)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply eqmod_refl2; omega.
(* Goal: eqmod zwordsize i i *)
(* Goal: eqmod zwordsize (Z.opp (unsigned y)) (unsigned (neg y)) *)
  apply eqmod_sub. apply eqmod_refl.
(* Goal: eqmod (two_p n) (signed (sign_ext n x)) (unsigned (sign_ext n x)) *)
(* Goal: eqmod (two_p n) (unsigned (sign_ext n x)) (unsigned x) *)
  apply eqmod_divides with modulus.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply eqm_unsigned_repr. auto.
Qed.

Theorem or_ror:
  forall x y z,
  ltu y iwordsize = true ->
  ltu z iwordsize = true ->
  add y z = iwordsize ->
  ror x z = or (shl x y) (shru x z).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (ltu_iwordsize_inv _ H) (ltu_iwordsize_inv _ H0); intros.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold ror, or, shl, shru. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite !testbit_repr; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite !Z.lor_spec. rewrite orb_comm. f_equal; apply same_bits_eqm; auto.
  - apply eqm_unsigned_repr_r. apply eqm_refl2. f_equal.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    rewrite Zmod_small; auto.
(* Goal: @Logic.eq Z (Z.sub zwordsize (unsigned z)) (unsigned y) *)
    assert (unsigned (add y z) = zwordsize).
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add i (Int.unsigned (Int.sub y Int.iwordsize))) Int.zwordsize then Z.add i (Int.unsigned (Int.sub y Int.iwordsize)) else Z.sub Int.zwordsize (Zpos xH))) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
(* Goal: @Logic.eq bool (Int.testbit (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Z.sub i Int.zwordsize)) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
      rewrite H1. apply unsigned_repr_wordsize.
(* Goal: @Logic.eq Z (Z.sub zwordsize (unsigned z)) (unsigned y) *)
    unfold add in H5. rewrite unsigned_repr in H5.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize two_wordsize_max_unsigned; omega.
  - apply eqm_unsigned_repr_r. apply eqm_refl2. f_equal.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    apply Zmod_small; auto.
Qed.

(** ** Properties of [Z_one_bits] and [is_power2]. *)

Fixpoint powerserie (l: list Z): Z :=
  match l with
  | nil => 0
  | x :: xs => two_p x + powerserie xs
  end.

Lemma Z_one_bits_powerserie:
  forall x, 0 <= x < modulus -> x = powerserie (Z_one_bits wordsize x 0).
Proof.
  assert (forall n x i,
    0 <= i ->
    0 <= x < two_power_nat n ->
    x * two_p i = powerserie (Z_one_bits n x i)).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  {
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  induction n; intros.
(* Goal: forall _ : Logic.and (Z.le Z0 (Int.unsigned x)) (Z.lt (Int.unsigned x) (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))) xH))), Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) xH)) (Zpos xH))) *)
  simpl. rewrite two_power_nat_O in H0.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (x = 0) by omega. subst x. omega.
(* Goal: @Logic.eq Z (Z.mul x (two_p i)) (powerserie (Z_one_bits (S n) x i)) *)
  rewrite two_power_nat_S in H0. simpl Z_one_bits.
(* Goal: @Logic.eq Z (Z.mul x (two_p i)) (powerserie (if Z.odd x then @cons Z i (Z_one_bits n (Z.div2 x) (Z.add i (Zpos xH))) else Z_one_bits n (Z.div2 x) (Z.add i (Zpos xH)))) *)
  rewrite (Zdecomp x) in H0. rewrite Zshiftin_spec in H0.
  assert (EQ: Z.div2 x * two_p (i + 1) = powerserie (Z_one_bits n (Z.div2 x) (i + 1))).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    apply IHn. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    destruct (Z.odd x); omega.
(* Goal: @Logic.eq Z (Z.mul x (two_p i)) (powerserie (if Z.odd x then @cons Z i (Z_one_bits n (Z.div2 x) (Z.add i (Zpos xH))) else Z_one_bits n (Z.div2 x) (Z.add i (Zpos xH)))) *)
  rewrite two_p_is_exp in EQ. change (two_p 1) with 2 in EQ.
(* Goal: Logic.and (Z.le Z0 (Zshiftin (Z.odd x0) (Z.modulo x1 (two_p x)))) (Z.lt (Zshiftin (Z.odd x0) (Z.modulo x1 (two_p x))) (Z.mul (Zpos (xO xH)) (two_p x))) *)
  rewrite (Zdecomp x) at 1. rewrite Zshiftin_spec.
  destruct (Z.odd x); simpl powerserie; rewrite <- EQ; ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega.
  }
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. rewrite <- H. change (two_p 0) with 1. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. exact H0.
Qed.

Lemma Z_one_bits_range:
  forall x i, In i (Z_one_bits wordsize x 0) -> 0 <= i < zwordsize.
Proof.
  assert (forall n x i j,
    In j (Z_one_bits n x i) -> i <= j < i + Z.of_nat n).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  {
(* Goal: forall (n : nat) (x i j : Z) (_ : @In Z j (Z_one_bits n x i)), Logic.and (Z.le i j) (Z.lt j (Z.add i (Z.of_nat n))) *)
  induction n; simpl In.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  tauto.
(* Goal: forall _ : @In Z j (if Z.odd x then @cons Z i (Z_one_bits n (Z.div2 x) (Z.add i (Zpos xH))) else Z_one_bits n (Z.div2 x) (Z.add i (Zpos xH))), Logic.and (Z.le i j) (Z.lt j (Z.add i (Z.of_nat (S n)))) *)
  intros x i j. rewrite Nat2Z.inj_succ.
  assert (In j (Z_one_bits n (Z.div2 x) (i + 1)) -> i <= j < i + Z.succ (Z.of_nat n)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    intros. exploit IHn; eauto. omega.
(* Goal: forall _ : Logic.and (Z.le Z0 (Int.unsigned x)) (Z.lt (Int.unsigned x) (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))) xH))), Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) xH)) (Zpos xH))) *)
  destruct (Z.odd x); simpl.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros [A|B]. subst j. omega. auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
  }
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. generalize (H wordsize x 0 i H0). fold zwordsize; omega.
Qed.

Lemma is_power2_rng:
  forall n logn,
  is_power2 n = Some logn ->
  0 <= unsigned logn < zwordsize.
Proof.
(* Goal: forall (n logn : int) (_ : @Logic.eq (option int) (is_power2 n) (@Some int logn)), @Logic.eq Z (unsigned n) (two_p (unsigned logn)) *)
  intros n logn. unfold is_power2.
(* Goal: forall (_ : @Logic.eq Z (unsigned n) (powerserie (Z_one_bits wordsize (unsigned n) Z0))) (_ : @Logic.eq (option int) match Z_one_bits wordsize (unsigned n) Z0 with | nil => @None int | cons i (nil as l) => @Some int (repr i) | cons i (cons z l0 as l) => @None int end (@Some int logn)), @Logic.eq Z (unsigned n) (two_p (unsigned logn)) *)
  generalize (Z_one_bits_range (unsigned n)).
(* Goal: forall (_ : forall (i : Z) (_ : @In Z i (Z_one_bits wordsize (unsigned n) Z0)), Logic.and (Z.le Z0 i) (Z.lt i zwordsize)) (_ : @Logic.eq Z (unsigned n) (powerserie (Z_one_bits wordsize (unsigned n) Z0))) (_ : @Logic.eq (option int) match Z_one_bits wordsize (unsigned n) Z0 with | nil => @None int | cons i (nil as l) => @Some int (repr i) | cons i (cons z l0 as l) => @None int end (@Some int logn)), @Logic.eq Z (unsigned n) (two_p (unsigned logn)) *)
  destruct (Z_one_bits wordsize (unsigned n) 0).
(* Goal: Logic.and (Z.le Z0 (unsigned x)) (Z.lt (unsigned x) (unsigned y)) *)
  intros; discriminate.
(* Goal: forall (_ : forall (i : Z) (_ : @In Z i (@cons Z z l)), Logic.and (Z.le Z0 i) (Z.lt i zwordsize)) (_ : @Logic.eq Z (unsigned n) (powerserie (@cons Z z l))) (_ : @Logic.eq (option int) match l with | nil => @Some int (repr z) | cons z l => @None int end (@Some int logn)), @Logic.eq Z (unsigned n) (two_p (unsigned logn)) *)
  destruct l.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. injection H0; intro; subst logn; clear H0.
(* Goal: Logic.and (Z.le Z0 (unsigned (repr z))) (Z.lt (unsigned (repr z)) zwordsize) *)
(* Goal: forall (_ : forall (i : Z) (_ : @In Z i (@cons Z z (@cons Z z0 l))), Logic.and (Z.le Z0 i) (Z.lt i zwordsize)) (_ : @Logic.eq (option int) (@None int) (@Some int logn)), Logic.and (Z.le Z0 (unsigned logn)) (Z.lt (unsigned logn) zwordsize) *)
  assert (0 <= z < zwordsize).
(* Goal: P n *)
  apply H. auto with coqlib.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite unsigned_repr. auto. generalize wordsize_max_unsigned; omega.
(* Goal: Logic.and (Z.le Z0 (unsigned x)) (Z.lt (unsigned x) (unsigned y)) *)
  intros; discriminate.
Qed.

Theorem is_power2_range:
  forall n logn,
  is_power2 n = Some logn -> ltu logn iwordsize = true.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold ltu. rewrite unsigned_repr_wordsize.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply zlt_true. generalize (is_power2_rng _ _ H). tauto.
Qed.

Lemma is_power2_correct:
  forall n logn,
  is_power2 n = Some logn ->
  unsigned n = two_p (unsigned logn).
Proof.
(* Goal: forall (n logn : int) (_ : @Logic.eq (option int) (is_power2 n) (@Some int logn)), @Logic.eq Z (unsigned n) (two_p (unsigned logn)) *)
  intros n logn. unfold is_power2.
(* Goal: forall _ : @Logic.eq (option int) match Z_one_bits wordsize (unsigned n) Z0 with | nil => @None int | cons i (nil as l) => @Some int (repr i) | cons i (cons z l0 as l) => @None int end (@Some int logn), @Logic.eq Z (unsigned n) (two_p (unsigned logn)) *)
  generalize (Z_one_bits_powerserie (unsigned n) (unsigned_range n)).
(* Goal: forall (_ : @Logic.eq Z (unsigned n) (powerserie (Z_one_bits wordsize (unsigned n) Z0))) (_ : @Logic.eq (option int) match Z_one_bits wordsize (unsigned n) Z0 with | nil => @None int | cons i (nil as l) => @Some int (repr i) | cons i (cons z l0 as l) => @None int end (@Some int logn)), @Logic.eq Z (unsigned n) (two_p (unsigned logn)) *)
  generalize (Z_one_bits_range (unsigned n)).
(* Goal: forall (_ : forall (i : Z) (_ : @In Z i (Z_one_bits wordsize (unsigned n) Z0)), Logic.and (Z.le Z0 i) (Z.lt i zwordsize)) (_ : @Logic.eq Z (unsigned n) (powerserie (Z_one_bits wordsize (unsigned n) Z0))) (_ : @Logic.eq (option int) match Z_one_bits wordsize (unsigned n) Z0 with | nil => @None int | cons i (nil as l) => @Some int (repr i) | cons i (cons z l0 as l) => @None int end (@Some int logn)), @Logic.eq Z (unsigned n) (two_p (unsigned logn)) *)
  destruct (Z_one_bits wordsize (unsigned n) 0).
(* Goal: Logic.and (Z.le Z0 (unsigned x)) (Z.lt (unsigned x) (unsigned y)) *)
  intros; discriminate.
(* Goal: forall (_ : forall (i : Z) (_ : @In Z i (@cons Z z l)), Logic.and (Z.le Z0 i) (Z.lt i zwordsize)) (_ : @Logic.eq Z (unsigned n) (powerserie (@cons Z z l))) (_ : @Logic.eq (option int) match l with | nil => @Some int (repr z) | cons z l => @None int end (@Some int logn)), @Logic.eq Z (unsigned n) (two_p (unsigned logn)) *)
  destruct l.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. simpl in H0. injection H1; intros; subst logn; clear H1.
  rewrite unsigned_repr. replace (two_p z) with (two_p z + 0).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  auto. omega. elim (H z); intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize wordsize_max_unsigned; omega.
(* Goal: @In Z z (@cons Z z (@nil Z)) *)
(* Goal: forall (_ : forall (i : Z) (_ : @In Z i (@cons Z z (@cons Z z0 l))), Logic.and (Z.le Z0 i) (Z.lt i zwordsize)) (_ : @Logic.eq Z (unsigned n) (powerserie (@cons Z z (@cons Z z0 l)))) (_ : @Logic.eq (option int) (@None int) (@Some int logn)), @Logic.eq Z (unsigned n) (two_p (unsigned logn)) *)
  auto with coqlib.
(* Goal: Logic.and (Z.le Z0 (unsigned x)) (Z.lt (unsigned x) (unsigned y)) *)
  intros; discriminate.
Qed.

Remark two_p_range:
  forall n,
  0 <= n < zwordsize ->
  0 <= two_p n <= max_unsigned.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. split.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (two_p n > 0). apply two_p_gt_ZERO. omega. omega.
(* Goal: Z.le (two_p n) max_unsigned *)
  generalize (two_p_monotone_strict _ _ H).
  unfold zwordsize; rewrite <- two_power_nat_two_p.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold max_unsigned, modulus. omega.
Qed.

Remark Z_one_bits_zero:
  forall n i, Z_one_bits n 0 i = nil.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  induction n; intros; simpl; auto.
Qed.

Remark Z_one_bits_two_p:
  forall n x i,
  0 <= x < Z.of_nat n ->
  Z_one_bits n (two_p x) i = (i + x) :: nil.
Proof.
(* Goal: forall _ : Logic.and (Z.le Z0 (Int.unsigned x)) (Z.lt (Int.unsigned x) (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))) xH))), Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) xH)) (Zpos xH))) *)
  induction n; intros; simpl. simpl in H. omegaContradiction.
(* Goal: @Logic.eq (list Z) (if Z.odd (two_p x) then @cons Z i (Z_one_bits n (Z.div2 (two_p x)) (Z.add i (Zpos xH))) else Z_one_bits n (Z.div2 (two_p x)) (Z.add i (Zpos xH))) (@cons Z (Z.add i x) (@nil Z)) *)
  rewrite Nat2Z.inj_succ in H.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (x = 0 \/ 0 < x) by omega. destruct H0.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  subst x; simpl. decEq. omega. apply Z_one_bits_zero.
  assert (Z.odd (two_p x) = false /\ Z.div2 (two_p x) = two_p (x-1)).
    apply Zshiftin_inj. rewrite <- Zdecomp. rewrite !Zshiftin_spec.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite <- two_p_S. rewrite Z.add_0_r. f_equal; omega. omega.
(* Goal: @Logic.eq (list Z) (if Z.odd (two_p x) then @cons Z i (Z_one_bits n (Z.div2 (two_p x)) (Z.add i (Zpos xH))) else Z_one_bits n (Z.div2 (two_p x)) (Z.add i (Zpos xH))) (@cons Z (Z.add i x) (@nil Z)) *)
  destruct H1 as [A B]; rewrite A; rewrite B.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite IHn. f_equal; omega. omega.
Qed.

Lemma is_power2_two_p:
  forall n, 0 <= n < zwordsize ->
  is_power2 (repr (two_p n)) = Some (repr n).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold is_power2. rewrite unsigned_repr.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Z_one_bits_two_p. auto. auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply two_p_range. auto.
Qed.

(** ** Relation between bitwise operations and multiplications / divisions by powers of 2 *)

(** Left shifts and multiplications by powers of 2. *)

Lemma Zshiftl_mul_two_p:
  forall x n, 0 <= n -> Z.shiftl x n = x * two_p n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct n; simpl.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - omega.
  - pattern p. apply Pos.peano_ind.
    + change (two_power_pos 1) with 2. simpl. ring.
    + intros. rewrite Pos.iter_succ. rewrite H0.
(* Goal: @Logic.eq Z (Z.div2 (Z.div x (two_power_pos p0))) (Z.div x (two_power_pos (Pos.succ p0))) *)
      rewrite Pplus_one_succ_l. rewrite two_power_pos_is_exp.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
      change (two_power_pos 1) with 2. ring.
  - compute in H. congruence.
Qed.

Lemma shl_mul_two_p:
  forall x y,
  shl x y = mul x (repr (two_p (unsigned y))).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shl, mul. apply eqm_samerepr.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  rewrite Zshiftl_mul_two_p. auto with ints.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (unsigned_range y); omega.
Qed.

Theorem shl_mul:
  forall x y,
  shl x y = mul x (shl one y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq int (shl x y) (mul x (shl one y)) *)
  assert (shl one y = repr (two_p (unsigned y))).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  {
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    rewrite shl_mul_two_p. rewrite mul_commut. rewrite mul_one. auto.
  }
(* Goal: @Logic.eq Z (unsigned (repr (Z.opp (unsigned a1)))) (Int64.unsigned (Int64.repr (Z.opp (Int64.unsigned b1)))) *)
  rewrite H. apply shl_mul_two_p.
Qed.

Theorem mul_pow2:
  forall x n logn,
  is_power2 n = Some logn ->
  mul x n = shl x logn.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (is_power2_correct n logn H); intro.
  rewrite shl_mul_two_p. rewrite <- H0. rewrite repr_unsigned.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
Qed.

Theorem shifted_or_is_add:
  forall x y n,
  0 <= n < zwordsize ->
  unsigned y < two_p n ->
  or (shl x (repr n)) y = repr(unsigned x * two_p n + unsigned y).
Proof.
  intros. rewrite <- add_is_or.
  - unfold add. apply eqm_samerepr. apply eqm_add; auto with ints.
(* Goal: eqm (unsigned (repr (two_p (unsigned (repr n))))) (two_p n) *)
    rewrite shl_mul_two_p. unfold mul. apply eqm_unsigned_repr_l.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
    apply eqm_mult; auto with ints. apply eqm_unsigned_repr_l.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    apply eqm_refl2. rewrite unsigned_repr. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize wordsize_max_unsigned; omega.
  - bit_solve.
(* Goal: @Logic.eq Int64.int (Int64.repr (unsigned (repr (Int64.unsigned n)))) n *)
    rewrite unsigned_repr.
(* Goal: @Logic.eq bool (testbit x (if zlt i n then i else Z.sub n (Zpos xH))) (testbit (shl x y) (if zlt (Z.add i (unsigned y)) zwordsize then Z.add i (unsigned y) else Z.sub zwordsize (Zpos xH))) *)
(* Goal: Logic.and (Z.le Z0 i) (Z.lt i zwordsize) *)
(* Goal: Z.lt Z0 n *)
    destruct (zlt i n).
    + auto.
    + replace (testbit y i) with false. apply andb_false_r.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
      symmetry. unfold testbit.
(* Goal: @Logic.eq bool (Z.testbit (unsigned y) i) false *)
      assert (EQ: Z.of_nat (Z.to_nat n) = n) by (apply Z2Nat.id; omega).
(* Goal: @Logic.eq bool (Z.testbit (unsigned y) i) false *)
      apply Ztestbit_above with (Z.to_nat n).
      rewrite <- EQ in H0. rewrite <- two_power_nat_two_p in H0.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      generalize (unsigned_range y); omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
      rewrite EQ; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + generalize wordsize_max_unsigned; omega.
Qed.

(** Unsigned right shifts and unsigned divisions by powers of 2. *)

Lemma Zshiftr_div_two_p:
  forall x n, 0 <= n -> Z.shiftr x n = x / two_p n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct n; unfold Z.shiftr; simpl.
  - rewrite Zdiv_1_r. auto.
  - pattern p. apply Pos.peano_ind.
    + change (two_power_pos 1) with 2. simpl. apply Zdiv2_div.
    + intros. rewrite Pos.iter_succ. rewrite H0.
(* Goal: @Logic.eq Z (Z.div2 (Z.div x (two_power_pos p0))) (Z.div x (two_power_pos (Pos.succ p0))) *)
      rewrite Pplus_one_succ_l. rewrite two_power_pos_is_exp.
(* Goal: @Logic.eq Z (Z.div2 (Z.div x (two_power_pos p0))) (Z.div x (Z.mul (two_power_pos xH) (two_power_pos p0))) *)
      change (two_power_pos 1) with 2.
(* Goal: @Logic.eq Z p (Z.add (Z.mul ph Int.modulus) pl) *)
      rewrite Zdiv2_div. rewrite Z.mul_comm. apply Zdiv_Zdiv.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      rewrite two_power_pos_nat. apply two_power_nat_pos. omega.
  - compute in H. congruence.
Qed.

Lemma shru_div_two_p:
  forall x y,
  shru x y = repr (unsigned x / two_p (unsigned y)).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shru.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Zshiftr_div_two_p. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (unsigned_range y); omega.
Qed.

Theorem divu_pow2:
  forall x n logn,
  is_power2 n = Some logn ->
  divu x n = shru x logn.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (is_power2_correct n logn H). intro.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  symmetry. unfold divu. rewrite H0. apply shru_div_two_p.
Qed.

(** Signed right shifts and signed divisions by powers of 2. *)

Lemma shr_div_two_p:
  forall x y,
  shr x y = repr (signed x / two_p (unsigned y)).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shr.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Zshiftr_div_two_p. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (unsigned_range y); omega.
Qed.

Theorem divs_pow2:
  forall x n logn,
  is_power2 n = Some logn ->
  divs x n = shrx x logn.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (is_power2_correct _ _ H); intro.
(* Goal: eqm (two_p a) (unsigned (shl one (repr a))) *)
(* Goal: eqm (powerserie l) (unsigned (repr (powerserie l))) *)
(* Goal: forall (i : Z) (_ : @In Z i l), Logic.and (Z.le Z0 i) (Z.lt i zwordsize) *)
  unfold shrx. rewrite shl_mul_two_p.
(* Goal: @Logic.eq int (mul one (repr (two_p (Int.unsigned y)))) (repr (two_p (Int.unsigned y))) *)
  rewrite mul_commut. rewrite mul_one.
  rewrite <- H0. rewrite repr_unsigned. auto.
Qed.

(** Unsigned modulus over [2^n] is masking with [2^n-1]. *)

Lemma Ztestbit_mod_two_p:
  forall n x i,
  0 <= n -> 0 <= i ->
  Z.testbit (x mod (two_p n)) i = if zlt i n then Z.testbit x i else false.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  intros n0 x i N0POS. revert x i; pattern n0; apply natlike_ind; auto.
  - intros. change (two_p 0) with 1. rewrite Zmod_1_r. rewrite Z.testbit_0_l.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite zlt_false; auto. omega.
  - intros. rewrite two_p_S; auto.
    replace (x0 mod (2 * two_p x))
       with (Zshiftin (Z.odd x0) (Z.div2 x0 mod two_p x)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    rewrite Ztestbit_shiftin; auto. rewrite (Ztestbit_eq i x0); auto. destruct (zeq i 0).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + rewrite zlt_true; auto. omega.
    + rewrite H0. destruct (zlt (Z.pred i) x).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      * rewrite zlt_true; auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      * rewrite zlt_false; auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      * omega.
    + rewrite (Zdecomp x0) at 3. set (x1 := Z.div2 x0). symmetry.
(* Goal: @Logic.eq Z (Z.modulo (Zshiftin (Z.odd x0) x1) (Z.mul (Zpos (xO xH)) (two_p x))) (Zshiftin (Z.odd x0) (Z.modulo x1 (two_p x))) *)
      apply Zmod_unique with (x1 / two_p x).
(* Goal: @Logic.eq Z (Zshiftin (Z.odd x0) x1) (Z.add (Z.mul (Z.div x1 (two_p x)) (Z.mul (Zpos (xO xH)) (two_p x))) (Zshiftin (Z.odd x0) (Z.modulo x1 (two_p x)))) *)
(* Goal: Logic.and (Z.le Z0 (Zshiftin (Z.odd x0) (Z.modulo x1 (two_p x)))) (Z.lt (Zshiftin (Z.odd x0) (Z.modulo x1 (two_p x))) (Z.mul (Zpos (xO xH)) (two_p x))) *)
      rewrite !Zshiftin_spec. rewrite Z.add_assoc. f_equal.
      transitivity (2 * (two_p x * (x1 / two_p x) + x1 mod two_p x)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
      f_equal. apply Z_div_mod_eq. apply two_p_gt_ZERO; auto.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
      ring.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
      rewrite Zshiftin_spec. exploit (Z_mod_lt x1 (two_p x)). apply two_p_gt_ZERO; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      destruct (Z.odd x0); omega.
Qed.

Corollary Ztestbit_two_p_m1:
  forall n i, 0 <= n -> 0 <= i ->
  Z.testbit (two_p n - 1) i = if zlt i n then true else false.
Proof.
  intros. replace (two_p n - 1) with ((-1) mod (two_p n)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Ztestbit_mod_two_p; auto. destruct (zlt i n); auto. apply Ztestbit_m1; auto.
  apply Zmod_unique with (-1). ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  exploit (two_p_gt_ZERO n). auto. omega.
Qed.

Theorem modu_and:
  forall x n logn,
  is_power2 n = Some logn ->
  modu x n = and x (sub n one).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (is_power2_correct _ _ H); intro.
(* Goal: forall _ : @Logic.eq Z (unsigned n) (two_p (Int.unsigned logn)), @Logic.eq int (divu x n) (shru' x logn) *)
  generalize (is_power2_rng _ _ H); intro.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_and; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold sub. rewrite testbit_repr; auto.
(* Goal: @Logic.eq int (repr (Z.sub (unsigned (repr (two_p uy))) (unsigned one))) (shru mone (repr (Z.sub (unsigned iwordsize) (unsigned y)))) *)
  rewrite H0. rewrite unsigned_one.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold modu. rewrite testbit_repr; auto. rewrite H0.
(* Goal: @Logic.eq bool (Z.testbit (Z.modulo (unsigned x) (two_p (unsigned logn))) i) (andb (testbit x i) (Z.testbit (Z.sub (two_p (unsigned logn)) (Zpos xH)) i)) *)
  rewrite Ztestbit_mod_two_p. rewrite Ztestbit_two_p_m1.
(* Goal: @Logic.eq bool (if zlt i (unsigned logn) then Z.testbit (unsigned x) i else false) (andb (testbit x i) (if zlt i (unsigned logn) then true else false)) *)
(* Goal: Z.le Z0 (unsigned logn) *)
(* Goal: Z.le Z0 i *)
(* Goal: Z.le Z0 (unsigned logn) *)
(* Goal: Z.le Z0 i *)
  destruct (zlt i (unsigned logn)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite andb_true_r; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite andb_false_r; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  tauto. tauto. tauto. tauto.
Qed.

(** ** Properties of [shrx] (signed division by a power of 2) *)

Lemma Zquot_Zdiv:
  forall x y,
  y > 0 ->
  Z.quot x y = if zlt x 0 then (x + y - 1) / y else x / y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct (zlt x 0).
  - symmetry. apply Zquot_unique_full with ((x + y - 1) mod y - (y - 1)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
     + red. right; split. omega.
       exploit (Z_mod_lt (x + y - 1) y); auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
       rewrite Z.abs_eq. omega. omega.
     + transitivity ((y * ((x + y - 1) / y) + (x + y - 1) mod y) - (y-1)).
       rewrite <- Z_div_mod_eq. ring. auto. ring.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - apply Zquot_Zdiv_pos; omega.
Qed.

Theorem shrx_zero:
  forall x, zwordsize > 1 -> shrx x zero = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shrx. rewrite shl_zero. unfold divs. rewrite signed_one by auto.
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (Zpos xH))) x *)
  rewrite Z.quot_1_r. apply repr_signed.
Qed. 

Theorem shrx_shr:
  forall x y,
  ltu y (repr (zwordsize - 1)) = true ->
  shrx x y = shr (if lt x zero then add x (sub (shl one y) one) else x) y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq int (add x (sub (shl one y) one)) (add x (shru mone (sub iwordsize y))) *)
  set (uy := unsigned y).
  assert (0 <= uy < zwordsize - 1).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    generalize (ltu_inv _ _ H). rewrite unsigned_repr. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize wordsize_pos wordsize_max_unsigned; omega.
(* Goal: @Logic.eq int (shrx x y) (repr (Z.div (signed (if lt x zero then add x (sub (shl one y) one) else x)) (two_p (unsigned y)))) *)
  rewrite shr_div_two_p. unfold shrx. unfold divs.
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (signed (shl one y)))) (repr (Z.div (signed (if lt x zero then add x (sub (shl one y) one) else x)) (two_p (unsigned y)))) *)
  assert (shl one y = repr (two_p uy)).
(* Goal: @Logic.eq int (shl one y) (repr (two_p uy)) *)
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (signed (shl one y)))) (repr (Z.div (signed (if lt x zero then add x (sub (shl one y) one) else x)) (two_p (unsigned y)))) *)
    transitivity (mul one (repr (two_p uy))).
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
    symmetry. apply mul_pow2. replace y with (repr uy).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    apply is_power2_two_p. omega. apply repr_unsigned.
(* Goal: @Logic.eq int (mul one (repr (two_p (Int.unsigned y)))) (repr (two_p (Int.unsigned y))) *)
    rewrite mul_commut. apply mul_one.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (two_p uy > 0). apply two_p_gt_ZERO. omega.
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (signed (shl one y)))) (repr (Z.div (signed (if lt x zero then add x (sub (shl one y) one) else x)) (two_p (unsigned y)))) *)
  assert (two_p uy < half_modulus).
(* Goal: Z.lt (two_p uy) half_modulus *)
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (signed (shl one y)))) (repr (Z.div (signed (if lt x zero then add x (sub (shl one y) one) else x)) (two_p (unsigned y)))) *)
    rewrite half_modulus_power.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    apply two_p_monotone_strict. auto.
(* Goal: @Logic.eq int (add x (sub (shl one y) one)) (add x (shru mone (sub iwordsize y))) *)
  assert (two_p uy < modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite modulus_power. apply two_p_monotone_strict. omega.
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (signed (shl one y)))) (repr (Z.div (signed (if lt x zero then add x (sub (shl one y) one) else x)) (two_p (unsigned y)))) *)
  assert (unsigned (shl one y) = two_p uy).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite H1. apply unsigned_repr. unfold max_unsigned. omega.
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (signed (shl one y)))) (repr (Z.div (signed (if lt x zero then add x (sub (shl one y) one) else x)) (two_p (unsigned y)))) *)
  assert (signed (shl one y) = two_p uy).
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add i (Int.unsigned (Int.sub y Int.iwordsize))) Int.zwordsize then Z.add i (Int.unsigned (Int.sub y Int.iwordsize)) else Z.sub Int.zwordsize (Zpos xH))) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
(* Goal: @Logic.eq bool (Int.testbit (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Z.sub i Int.zwordsize)) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
    rewrite H1. apply signed_repr.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    unfold max_signed. generalize min_signed_neg. omega.
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (signed (shl one y)))) (repr (Z.div (signed (if lt x zero then add x (sub (shl one y) one) else x)) (two_p (unsigned y)))) *)
  rewrite H6.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Zquot_Zdiv; auto.
(* Goal: @Logic.eq bool (lt (ofwords xh xl) (ofwords yh yl)) (if Int.eq xh yh then Int.ltu xl yl else Int.lt xh yh) *)
  unfold lt. rewrite signed_zero.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct (zlt (signed x) 0); auto.
(* Goal: @Logic.eq int (repr (Z.div (Z.sub (Z.add (signed x) (two_p uy)) (Zpos xH)) (two_p uy))) (repr (Z.div (signed (add x (sub (shl one y) one))) (two_p (unsigned y)))) *)
  rewrite add_signed.
  assert (signed (sub (shl one y) one) = two_p uy - 1).
(* Goal: @Logic.eq int (repr (Z.sub (unsigned (repr (two_p uy))) (unsigned one))) (shru mone (repr (Z.sub (unsigned iwordsize) (unsigned y)))) *)
    unfold sub. rewrite H5. rewrite unsigned_one.
(* Goal: @Logic.eq Z (signed (repr (Z.add (Z.mul (Int.signed hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)))) (Z.add (Z.mul (Int.signed hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)) *)
(* Goal: @Logic.eq int (repr (Z.add (Z.mul (Int.signed hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo))) (repr (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo))) *)
    apply signed_repr.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize min_signed_neg. unfold max_signed. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite H7. rewrite signed_repr. f_equal. f_equal. omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (signed_range x). intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (two_p uy - 1 <= max_signed). unfold max_signed. omega. omega.
Qed.

Theorem shrx_shr_2:
  forall x y,
  ltu y (repr (zwordsize - 1)) = true ->
  shrx x y = shr (add x (shru (shr x (repr (zwordsize - 1))) (sub iwordsize y))) y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite shrx_shr by auto. f_equal.
(* Goal: @Logic.eq int (if lt x zero then add x (sub (shl one y) one) else x) (add x (shru (if lt x zero then mone else zero) (sub iwordsize y))) *)
  rewrite shr_lt_zero. destruct (lt x zero).
- set (uy := unsigned y).
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (unsigned_range y); fold uy; intros.
  assert (0 <= uy < zwordsize - 1).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    generalize (ltu_inv _ _ H). rewrite unsigned_repr. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize wordsize_pos wordsize_max_unsigned; omega.
(* Goal: @Logic.eq int (add x (sub (shl one y) one)) (add x (shru mone (sub iwordsize y))) *)
  assert (two_p uy < modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite modulus_power. apply two_p_monotone_strict. omega.
(* Goal: @Logic.eq int (mul one (repr (two_p (Int.unsigned y)))) (repr (two_p (Int.unsigned y))) *)
  f_equal. rewrite shl_mul_two_p. fold uy. rewrite mul_commut. rewrite mul_one.
(* Goal: @Logic.eq int (repr (Z.sub (unsigned (repr (two_p uy))) (unsigned one))) (shru mone (repr (Z.sub (unsigned iwordsize) (unsigned y)))) *)
  unfold sub. rewrite unsigned_one. rewrite unsigned_repr.
(* Goal: @Logic.eq int (repr (Z.sub (two_p uy) (Zpos xH))) (shru mone (repr (Z.sub (unsigned iwordsize) (unsigned y)))) *)
(* Goal: Logic.and (Z.le Z0 (two_p uy)) (Z.le (two_p uy) max_unsigned) *)
  rewrite unsigned_repr_wordsize. fold uy.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply same_bits_eq; intros. rewrite bits_shru by auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite testbit_repr by auto. rewrite Ztestbit_two_p_m1 by omega.
(* Goal: @Logic.eq bool (if zlt i uy then true else false) (if zlt (Z.add i (unsigned (repr (Z.sub zwordsize uy)))) zwordsize then testbit mone (Z.add i (unsigned (repr (Z.sub zwordsize uy)))) else false) *)
(* Goal: Logic.and (Z.le Z0 (two_p uy)) (Z.le (two_p uy) max_unsigned) *)
  rewrite unsigned_repr by (generalize wordsize_max_unsigned; omega).
(* Goal: @Logic.eq bool (if zlt i uy then true else false) (if zlt (Z.add i (Z.sub zwordsize uy)) zwordsize then testbit mone (Z.add i (Z.sub zwordsize uy)) else false) *)
(* Goal: Logic.and (Z.le Z0 (two_p uy)) (Z.le (two_p uy) max_unsigned) *)
  destruct (zlt i uy).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true by omega. rewrite bits_mone by omega. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (two_p uy > 0) by (apply two_p_gt_ZERO; omega). unfold max_unsigned; omega.
- replace (shru zero (sub iwordsize y)) with zero.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite add_zero; auto.
  bit_solve. destruct (zlt (i + unsigned (sub iwordsize y)) zwordsize); auto.
Qed.

Lemma Zdiv_shift:
  forall x y, y > 0 ->
  (x + (y - 1)) / y = x / y + if zeq (Z.modulo x y) 0 then 0 else 1.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (Z_div_mod_eq x y H). generalize (Z_mod_lt x y H).
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  set (q := x / y). set (r := x mod y). intros.
(* Goal: @Logic.eq Z (Z.div (Z.add x (Z.sub y (Zpos xH))) y) (Z.add q (if zeq r Z0 then Z0 else Zpos xH)) *)
  destruct (zeq r 0).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply Zdiv_unique with (y - 1). rewrite H1. rewrite e. ring. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply Zdiv_unique with (r - 1). rewrite H1. ring. omega.
Qed.

Theorem shrx_carry:
  forall x y,
  ltu y (repr (zwordsize - 1)) = true ->
  shrx x y = add (shr x y) (shr_carry x y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite shrx_shr; auto. unfold shr_carry.
(* Goal: @Logic.eq bool (lt (ofwords xh xl) (ofwords yh yl)) (if Int.eq xh yh then Int.ltu xl yl else Int.lt xh yh) *)
  unfold lt. set (sx := signed x). rewrite signed_zero.
(* Goal: forall _ : Logic.and (Z.le Z0 (Int.unsigned x)) (Z.lt (Int.unsigned x) (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))) xH))), Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) xH)) (Zpos xH))) *)
  destruct (zlt sx 0); simpl.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  2: rewrite add_zero; auto.
(* Goal: @Logic.eq int (add x (sub (shl one y) one)) (add x (shru mone (sub iwordsize y))) *)
  set (uy := unsigned y).
  assert (0 <= uy < zwordsize - 1).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    generalize (ltu_inv _ _ H). rewrite unsigned_repr. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize wordsize_pos wordsize_max_unsigned; omega.
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (signed (shl one y)))) (repr (Z.div (signed (if lt x zero then add x (sub (shl one y) one) else x)) (two_p (unsigned y)))) *)
  assert (shl one y = repr (two_p uy)).
(* Goal: @Logic.eq int (mul one (repr (two_p (Int.unsigned y)))) (repr (two_p (Int.unsigned y))) *)
    rewrite shl_mul_two_p. rewrite mul_commut. apply mul_one.
  assert (and x (sub (shl one y) one) = modu x (repr (two_p uy))).
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
    symmetry. rewrite H1. apply modu_and with (logn := y).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    rewrite is_power2_two_p. unfold uy. rewrite repr_unsigned. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    omega.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add i (Int.unsigned (Int.sub y Int.iwordsize))) Int.zwordsize then Z.add i (Int.unsigned (Int.sub y Int.iwordsize)) else Z.sub Int.zwordsize (Zpos xH))) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
(* Goal: @Logic.eq bool (Int.testbit (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Z.sub i Int.zwordsize)) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
  rewrite H2. rewrite H1.
(* Goal: Logic.and (Z.le (Z.opp (two_p (Z.sub n (Zpos xH)))) (signed (shr X (repr (Z.sub zwordsize n))))) (Z.lt (signed (shr X (repr (Z.sub zwordsize n)))) (two_p (Z.sub n (Zpos xH)))) *)
  repeat rewrite shr_div_two_p. fold sx. fold uy.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (two_p uy > 0). apply two_p_gt_ZERO. omega.
(* Goal: @Logic.eq int (add x (sub (shl one y) one)) (add x (shru mone (sub iwordsize y))) *)
  assert (two_p uy < modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite modulus_power. apply two_p_monotone_strict. omega.
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (signed (shl one y)))) (repr (Z.div (signed (if lt x zero then add x (sub (shl one y) one) else x)) (two_p (unsigned y)))) *)
  assert (two_p uy < half_modulus).
(* Goal: Z.lt (two_p uy) half_modulus *)
(* Goal: @Logic.eq int (repr (Z.quot (signed x) (signed (shl one y)))) (repr (Z.div (signed (if lt x zero then add x (sub (shl one y) one) else x)) (two_p (unsigned y)))) *)
    rewrite half_modulus_power.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    apply two_p_monotone_strict. auto.
(* Goal: @Logic.eq int (add x (sub (shl one y) one)) (add x (shru mone (sub iwordsize y))) *)
  assert (two_p uy < modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite modulus_power. apply two_p_monotone_strict. omega.
  assert (sub (repr (two_p uy)) one = repr (two_p uy - 1)).
(* Goal: eqm (two_p (Int.unsigned y)) (unsigned (repr (two_p (Int.unsigned y)))) *)
(* Goal: Z.le Z0 (Int.unsigned y) *)
    unfold sub. apply eqm_samerepr. apply eqm_sub. apply eqm_sym; apply eqm_unsigned_repr.
(* Goal: @Logic.eq int (repr (Z.sub (unsigned (repr (two_p uy))) (unsigned one))) (shru mone (repr (Z.sub (unsigned iwordsize) (unsigned y)))) *)
    rewrite unsigned_one. apply eqm_refl.
(* Goal: @Logic.eq int (repr (Z.div (Z.sub (Z.add (signed x) (two_p uy)) (Zpos xH)) (two_p uy))) (repr (Z.div (signed (add x (sub (shl one y) one))) (two_p (unsigned y)))) *)
  rewrite H7. rewrite add_signed. fold sx.
  rewrite (signed_repr (two_p uy - 1)). rewrite signed_repr.
(* Goal: @Logic.eq Int64.int (Int64.repr (unsigned (repr (Int64.unsigned n)))) n *)
  unfold modu. rewrite unsigned_repr.
(* Goal: @Logic.eq Z (Z.modulo (Z.sub i (unsigned zero)) zwordsize) i *)
  unfold eq. rewrite unsigned_zero. rewrite unsigned_repr.
  assert (unsigned x mod two_p uy = sx mod two_p uy).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    apply eqmod_mod_eq; auto. apply eqmod_divides with modulus.
(* Goal: eqm (unsigned (repr a)) a *)
(* Goal: eqm a b *)
    fold eqm. unfold sx. apply eqm_sym. apply eqm_signed_unsigned.
(* Goal: Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub modulus (Zpos xH))) *)
    unfold modulus. rewrite two_power_nat_two_p.
    exists (two_p (zwordsize - uy)). rewrite <- two_p_is_exp.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    f_equal. fold zwordsize; omega. omega. omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite H8. rewrite Zdiv_shift; auto.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  unfold add. apply eqm_samerepr. apply eqm_add.
(* Goal: eqm (two_p (Int.unsigned y)) (unsigned (repr (two_p (Int.unsigned y)))) *)
(* Goal: Z.le Z0 (Int.unsigned y) *)
  apply eqm_unsigned_repr.
(* Goal: forall _ : Logic.and (Z.le Z0 (Int.unsigned x)) (Z.lt (Int.unsigned x) (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))) xH))), Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) xH)) (Zpos xH))) *)
  destruct (zeq (sx mod two_p uy) 0); simpl.
(* Goal: @Logic.eq Z (Z.modulo (Z.sub i (unsigned zero)) zwordsize) i *)
  rewrite unsigned_zero. apply eqm_refl.
(* Goal: @Logic.eq int (repr (Z.sub (unsigned (repr (two_p uy))) (unsigned one))) (shru mone (repr (Z.sub (unsigned iwordsize) (unsigned y)))) *)
  rewrite unsigned_one. apply eqm_refl.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (Z_mod_lt (unsigned x) (two_p uy) H3). unfold max_unsigned. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold max_unsigned; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (signed_range x). fold sx. intros. split. omega. unfold max_signed. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize min_signed_neg. unfold max_signed. omega.
Qed.

(** Connections between [shr] and [shru]. *)

Lemma shr_shru_positive:
  forall x y,
  signed x >= 0 ->
  shr x y = shru x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: Logic.and (Z.le (Z.opp (two_p (Z.sub n (Zpos xH)))) (signed (shr X (repr (Z.sub zwordsize n))))) (Z.lt (signed (shr X (repr (Z.sub zwordsize n)))) (two_p (Z.sub n (Zpos xH)))) *)
  rewrite shr_div_two_p. rewrite shru_div_two_p.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite signed_eq_unsigned. auto. apply signed_positive. auto.
Qed.

Lemma and_positive:
  forall x y, signed y >= 0 -> signed (and x y) >= 0.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (unsigned y < half_modulus). rewrite signed_positive in H. unfold max_signed in H; omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  generalize (sign_bit_of_unsigned y). rewrite zlt_true; auto. intros A.
(* Goal: Z.ge (signed (and x y)) Z0 *)
  generalize (sign_bit_of_unsigned (and x y)). rewrite bits_and. rewrite A.
(* Goal: forall _ : @Logic.eq bool false (if zlt (unsigned (and x y)) half_modulus then false else true), Z.ge (signed (and x y)) Z0 *)
(* Goal: Logic.and (Z.le Z0 (Z.sub zwordsize (Zpos xH))) (Z.lt (Z.sub zwordsize (Zpos xH)) zwordsize) *)
  rewrite andb_false_r. unfold signed.
(* Goal: forall _ : @Logic.eq bool false (if zlt (unsigned (and x y)) half_modulus then false else true), Z.ge (if zlt (unsigned (and x y)) half_modulus then unsigned (and x y) else Z.sub (unsigned (and x y)) modulus) Z0 *)
(* Goal: Logic.and (Z.le Z0 (Z.sub zwordsize (Zpos xH))) (Z.lt (Z.sub zwordsize (Zpos xH)) zwordsize) *)
  destruct (zlt (unsigned (and x y)) half_modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. generalize (unsigned_range (and x y)); omega.
(* Goal: @Logic.eq BinNums.Z (Z.add (Int.unsigned y) (Int.unsigned z)) (Z.add (unsigned y') (unsigned z')) *)
  congruence.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize wordsize_pos; omega.
Qed.

Theorem shr_and_is_shru_and:
  forall x y z,
  lt y zero = false -> shr (and x y) z = shru (and x y) z.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply shr_shru_positive. apply and_positive.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold lt in H. rewrite signed_zero in H. destruct (zlt (signed y) 0). congruence. auto.
Qed.

(** ** Properties of integer zero extension and sign extension. *)

Lemma Ziter_base:
  forall (A: Type) n (f: A -> A) x, n <= 0 -> Z.iter n f x = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold Z.iter. destruct n; auto. compute in H. elim H; auto.
Qed.

Lemma Ziter_succ:
  forall (A: Type) n (f: A -> A) x,
  0 <= n -> Z.iter (Z.succ n) f x = f (Z.iter n f x).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct n; simpl.
  - auto.
  - rewrite Pos.add_1_r. apply Pos.iter_succ.
  - compute in H. elim H; auto.
Qed.

Lemma Znatlike_ind:
  forall (P: Z -> Prop),
  (forall n, n <= 0 -> P n) ->
  (forall n, 0 <= n -> P n -> P (Z.succ n)) ->
  forall n, P n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct (zle 0 n).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply natlike_ind; auto. apply H; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply H. omega.
Qed.

Lemma Zzero_ext_spec:
  forall n x i, 0 <= i ->
  Z.testbit (Zzero_ext n x) i = if zlt i n then Z.testbit x i else false.
Proof.
(* Goal: forall (n x i : Z) (_ : Z.le Z0 i), @Logic.eq bool (Z.testbit (Zzero_ext n x) i) (if zlt i n then Z.testbit x i else false) *)
  unfold Zzero_ext. induction n using Znatlike_ind.
  - intros. rewrite Ziter_base; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite zlt_false. rewrite Ztestbit_0; auto. omega.
  - intros. rewrite Ziter_succ; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    rewrite Ztestbit_shiftin; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    rewrite (Ztestbit_eq i x); auto.
(* Goal: @Logic.eq bool (if zeq i Z0 then Z.odd x0 else Z.testbit (Z.iter (Z.pred x1) (forall _ : Z, Z) (fun (rec : forall _ : Z, Z) (x : Z) => Zshiftin (Z.odd x) (rec (Z.div2 x))) (fun x : Z => if Z.odd x then Zneg xH else Z0) (Z.div2 x0)) (Z.pred i)) (Z.testbit x0 (if zlt i x then i else Z.sub x (Zpos xH))) *)
(* Goal: Z.le Z0 i *)
(* Goal: Z.le Z0 (Z.pred x1) *)
(* Goal: @Logic.eq Z (Z.succ (Z.pred x1)) x1 *)
    destruct (zeq i 0).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + subst i. rewrite zlt_true; auto. omega.
    + rewrite IHn. destruct (zlt (Z.pred i) n).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      rewrite zlt_true; auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      rewrite zlt_false; auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      omega.
Qed.

Lemma bits_zero_ext:
  forall n x i, 0 <= i ->
  testbit (zero_ext n x) i = if zlt i n then testbit x i else false.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold zero_ext. destruct (zlt i zwordsize).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite testbit_repr; auto. rewrite Zzero_ext_spec. auto. auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite !bits_above; auto. destruct (zlt i n); auto.
Qed.

Lemma Zsign_ext_spec:
  forall n x i, 0 <= i -> 0 < n ->
  Z.testbit (Zsign_ext n x) i = Z.testbit x (if zlt i n then i else n - 1).
Proof.
(* Goal: forall (n x i : Z) (_ : Z.le Z0 i) (_ : Z.lt Z0 n), @Logic.eq bool (Z.testbit (Zsign_ext n x) i) (Z.testbit x (if zlt i n then i else Z.sub n (Zpos xH))) *)
  intros n0 x i I0 N0.
(* Goal: @Logic.eq bool (Z.testbit (Zsign_ext n0 x) i) (Z.testbit x (if zlt i n0 then i else Z.sub n0 (Zpos xH))) *)
  revert x i I0. pattern n0. apply Zlt_lower_bound_ind with (z := 1).
  - unfold Zsign_ext. intros.
(* Goal: @Logic.eq bool (Z.testbit (Z.iter (Z.pred x) (forall _ : Z, Z) (fun (rec : forall _ : Z, Z) (x : Z) => Zshiftin (Z.odd x) (rec (Z.div2 x))) (fun x : Z => if Z.odd x then Zneg xH else Z0) x0) i) (Z.testbit x0 (if zlt i x then i else Z.sub x (Zpos xH))) *)
    destruct (zeq x 1).
    + subst x; simpl.
(* Goal: @Logic.eq bool (Z.testbit (if Z.odd x0 then Zneg xH else Z0) i) (Z.testbit x0 (if zlt i (Zpos xH) then i else Z0)) *)
      replace (if zlt i 1 then i else 0) with 0.
(* Goal: @Logic.eq bool (Z.testbit (if Z.odd x0 then Zneg xH else Z0) i) (Z.testbit x0 Z0) *)
(* Goal: @Logic.eq Z Z0 (if zlt i (Zpos xH) then i else Z0) *)
      rewrite Ztestbit_base.
(* Goal: @Logic.eq bool (Z.testbit (if Z.odd x0 then Zneg xH else Z0) i) (Z.odd x0) *)
(* Goal: @Logic.eq Z Z0 (if zlt i (Zpos xH) then i else Z0) *)
      destruct (Z.odd x0).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
      apply Ztestbit_m1; auto.
(* Goal: @Logic.eq bool (Z.testbit Z0 (Z.pred i)) false *)
(* Goal: Logic.not (@Logic.eq Z i Z0) *)
(* Goal: Z.le Z0 i *)
      apply Ztestbit_0.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      destruct (zlt i 1); omega.
    + set (x1 := Z.pred x). replace x1 with (Z.succ (Z.pred x1)).
(* Goal: @Logic.eq bool (Z.testbit (Zshiftin b x) i) false *)
      rewrite Ziter_succ. rewrite Ztestbit_shiftin.
(* Goal: @Logic.eq bool (if zeq i Z0 then Z.odd x0 else Z.testbit (Z.iter (Z.pred x1) (forall _ : Z, Z) (fun (rec : forall _ : Z, Z) (x : Z) => Zshiftin (Z.odd x) (rec (Z.div2 x))) (fun x : Z => if Z.odd x then Zneg xH else Z0) (Z.div2 x0)) (Z.pred i)) (Z.testbit x0 (if zlt i x then i else Z.sub x (Zpos xH))) *)
(* Goal: Z.le Z0 i *)
(* Goal: Z.le Z0 (Z.pred x1) *)
(* Goal: @Logic.eq Z (Z.succ (Z.pred x1)) x1 *)
      destruct (zeq i 0).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      * subst i. rewrite zlt_true. rewrite Ztestbit_base; auto. omega.
(* Goal: @Logic.eq Z (unsigned (repr (Z.opp (unsigned a1)))) (Int64.unsigned (Int64.repr (Z.opp (Int64.unsigned b1)))) *)
      * rewrite H. unfold x1. destruct (zlt (Z.pred i) (Z.pred x)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
        rewrite zlt_true. rewrite (Ztestbit_eq i x0); auto. rewrite zeq_false; auto. omega.
        rewrite zlt_false. rewrite (Ztestbit_eq (x - 1) x0). rewrite zeq_false; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
        omega. omega. omega. unfold x1; omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      * omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      * unfold x1; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      * omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  - omega.
Qed.

Lemma bits_sign_ext:
  forall n x i, 0 <= i < zwordsize -> 0 < n ->
  testbit (sign_ext n x) i = testbit x (if zlt i n then i else n - 1).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold sign_ext.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite testbit_repr; auto. rewrite Zsign_ext_spec. destruct (zlt i n); auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. auto.
Qed.

Hint Rewrite bits_zero_ext bits_sign_ext: ints.

Theorem zero_ext_above:
  forall n x, n >= zwordsize -> zero_ext n x = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_zero_ext. apply zlt_true. omega. omega.
Qed.

Theorem sign_ext_above:
  forall n x, n >= zwordsize -> sign_ext n x = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold sign_ext; rewrite testbit_repr; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Zsign_ext_spec. rewrite zlt_true. auto. omega. omega. omega.
Qed.

Theorem zero_ext_and:
  forall n x, 0 <= n -> zero_ext n x = and x (repr (two_p n - 1)).
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  bit_solve. rewrite testbit_repr; auto. rewrite Ztestbit_two_p_m1; intuition.
(* Goal: @Logic.eq bool (testbit x (if zlt i n then i else Z.sub n (Zpos xH))) (testbit (shl x y) (if zlt (Z.add i (unsigned y)) zwordsize then Z.add i (unsigned y) else Z.sub zwordsize (Zpos xH))) *)
(* Goal: Logic.and (Z.le Z0 i) (Z.lt i zwordsize) *)
(* Goal: Z.lt Z0 n *)
  destruct (zlt i n).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite andb_true_r; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite andb_false_r; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  tauto.
Qed.

Theorem zero_ext_mod:
  forall n x, 0 <= n < zwordsize ->
  unsigned (zero_ext n x) = Z.modulo (unsigned x) (two_p n).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply equal_same_bits. intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Ztestbit_mod_two_p; auto.
(* Goal: @Logic.eq bool (Z.testbit (unsigned (zero_ext n x)) i) (if zlt i n then Z.testbit (unsigned x) i else false) *)
(* Goal: Z.le Z0 n *)
  fold (testbit (zero_ext n x) i).
(* Goal: @Logic.eq bool (testbit (zero_ext n x) i) (if zlt i n then Z.testbit (unsigned x) i else false) *)
(* Goal: Z.le Z0 n *)
  destruct (zlt i zwordsize).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_zero_ext; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_above. rewrite zlt_false; auto. omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Theorem zero_ext_widen:
  forall x n n', 0 <= n <= n' ->
  zero_ext n' (zero_ext n x) = zero_ext n x.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. destruct (zlt i n).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_true. omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct (zlt i n'); auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  tauto. tauto.
Qed.

Theorem sign_ext_widen:
  forall x n n', 0 < n  <= n' ->
  sign_ext n' (sign_ext n x) = sign_ext n x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct (zlt n' zwordsize).
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. destruct (zlt i n').
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
(* Goal: @Logic.eq bool (testbit x (if zlt (Z.sub n' (Zpos xH)) n then Z.sub n' (Zpos xH) else Z.sub n (Zpos xH))) (testbit x (if zlt i n then i else Z.sub n (Zpos xH))) *)
(* Goal: Z.lt Z0 n *)
(* Goal: Logic.and (Z.le Z0 (if zlt i n' then i else Z.sub n' (Zpos xH))) (Z.lt (if zlt i n' then i else Z.sub n' (Zpos xH)) zwordsize) *)
(* Goal: Z.lt Z0 n *)
(* Goal: Z.lt Z0 n' *)
(* Goal: @Logic.eq int (sign_ext n' (sign_ext n x)) (sign_ext n x) *)
  rewrite (zlt_false _ i n).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt (n' - 1) n); f_equal; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt i n'); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply sign_ext_above; auto.
Qed.

Theorem sign_zero_ext_widen:
  forall x n n', 0 <= n < n' ->
  sign_ext n' (zero_ext n x) = zero_ext n x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct (zlt n' zwordsize).
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
(* Goal: @Logic.eq bool (if zlt (if zlt i n' then i else Z.sub n' (Zpos xH)) n then testbit x (if zlt i n' then i else Z.sub n' (Zpos xH)) else false) (if zlt i n then testbit x i else false) *)
(* Goal: Z.le Z0 i *)
(* Goal: Z.le Z0 (if zlt i n' then i else Z.sub n' (Zpos xH)) *)
(* Goal: Z.lt Z0 n' *)
(* Goal: @Logic.eq int (sign_ext n' (zero_ext n x)) (zero_ext n x) *)
  destruct (zlt i n').
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite !zlt_false. auto. omega. omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt i n'); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply sign_ext_above; auto.
Qed.

Theorem zero_ext_narrow:
  forall x n n', 0 <= n <= n' ->
  zero_ext n (zero_ext n' x) = zero_ext n x.
Proof.
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve. destruct (zlt i n).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_true. omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega. omega.
Qed.

Theorem sign_ext_narrow:
  forall x n n', 0 < n <= n' ->
  sign_ext n (sign_ext n' x) = sign_ext n x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct (zlt n zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  bit_solve. destruct (zlt i n); f_equal; apply zlt_true; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt i n); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite (sign_ext_above n'). auto. omega.
Qed.

Theorem zero_sign_ext_narrow:
  forall x n n', 0 < n <= n' ->
  zero_ext n (sign_ext n' x) = zero_ext n x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct (zlt n' zwordsize).
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct (zlt i n); auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true; auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega. omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite sign_ext_above; auto.
Qed.

Theorem zero_ext_idem:
  forall n x, 0 <= n -> zero_ext n (zero_ext n x) = zero_ext n x.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. apply zero_ext_widen. omega.
Qed.

Theorem sign_ext_idem:
  forall n x, 0 < n -> sign_ext n (sign_ext n x) = sign_ext n x.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. apply sign_ext_widen. omega.
Qed.

Theorem sign_ext_zero_ext:
  forall n x, 0 < n -> sign_ext n (zero_ext n x) = sign_ext n x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct (zlt n zwordsize).
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
(* Goal: @Logic.eq int (sign_ext n (zero_ext n x)) (sign_ext n x) *)
  bit_solve.
(* Goal: @Logic.eq bool (testbit x (if zlt i n then i else Z.sub n (Zpos xH))) (testbit (shl x y) (if zlt (Z.add i (unsigned y)) zwordsize then Z.add i (unsigned y) else Z.sub zwordsize (Zpos xH))) *)
(* Goal: Logic.and (Z.le Z0 i) (Z.lt i zwordsize) *)
(* Goal: Z.lt Z0 n *)
  destruct (zlt i n).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite zlt_true; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true; auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt i n); omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite zero_ext_above; auto.
Qed.

Theorem zero_ext_sign_ext:
  forall n x, 0 < n -> zero_ext n (sign_ext n x) = zero_ext n x.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. apply zero_sign_ext_narrow. omega.
Qed.

Theorem sign_ext_equal_if_zero_equal:
  forall n x y, 0 < n ->
  zero_ext n x = zero_ext n y ->
  sign_ext n x = sign_ext n y.
Proof.
  intros. rewrite <- (sign_ext_zero_ext n x H).
  rewrite <- (sign_ext_zero_ext n y H). congruence.
Qed.

Theorem zero_ext_shru_shl:
  forall n x,
  0 < n < zwordsize ->
  let y := repr (zwordsize - n) in
  zero_ext n x = shru (shl x y) y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
  assert (unsigned y = zwordsize - n).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply same_bits_eq; intros.
(* Goal: @Logic.eq bool (testbit (zero_ext n x) i) (testbit (shru (shl x y) y) i) *)
  rewrite bits_zero_ext.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_shru; auto.
(* Goal: @Logic.eq bool (testbit x (if zlt i n then i else Z.sub n (Zpos xH))) (testbit (shl x y) (if zlt (Z.add i (unsigned y)) zwordsize then Z.add i (unsigned y) else Z.sub zwordsize (Zpos xH))) *)
(* Goal: Logic.and (Z.le Z0 i) (Z.lt i zwordsize) *)
(* Goal: Z.lt Z0 n *)
  destruct (zlt i n).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true. rewrite bits_shl. rewrite zlt_false. f_equal. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false. auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Theorem sign_ext_shr_shl:
  forall n x,
  0 < n < zwordsize ->
  let y := repr (zwordsize - n) in
  sign_ext n x = shr (shl x y) y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
  assert (unsigned y = zwordsize - n).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply same_bits_eq; intros.
(* Goal: @Logic.eq bool (testbit (sign_ext n x) i) (Z.testbit (unsigned x) i) *)
  rewrite bits_sign_ext.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_shr; auto.
(* Goal: @Logic.eq bool (testbit x (if zlt i n then i else Z.sub n (Zpos xH))) (testbit (shl x y) (if zlt (Z.add i (unsigned y)) zwordsize then Z.add i (unsigned y) else Z.sub zwordsize (Zpos xH))) *)
(* Goal: Logic.and (Z.le Z0 i) (Z.lt i zwordsize) *)
(* Goal: Z.lt Z0 n *)
  destruct (zlt i n).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true. rewrite bits_shl. rewrite zlt_false. f_equal. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false. rewrite bits_shl. rewrite zlt_false. f_equal. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega. omega. omega. omega.
Qed.

(** [zero_ext n x] is the unique integer congruent to [x] modulo [2^n]
    in the range [0...2^n-1]. *)

Lemma zero_ext_range:
  forall n x, 0 <= n < zwordsize -> 0 <= unsigned (zero_ext n x) < two_p n.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. rewrite zero_ext_mod; auto. apply Z_mod_lt. apply two_p_gt_ZERO. omega.
Qed.

Lemma eqmod_zero_ext:
  forall n x, 0 <= n < zwordsize -> eqmod (two_p n) (unsigned (zero_ext n x)) (unsigned x).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite zero_ext_mod; auto. apply eqmod_sym. apply eqmod_mod.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply two_p_gt_ZERO. omega.
Qed.

(** [sign_ext n x] is the unique integer congruent to [x] modulo [2^n]
    in the range [-2^(n-1)...2^(n-1) - 1]. *)

Lemma sign_ext_range:
  forall n x, 0 < n < zwordsize -> -two_p (n-1) <= signed (sign_ext n x) < two_p (n-1).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite sign_ext_shr_shl; auto.
  set (X := shl x (repr (zwordsize - n))).
  assert (two_p (n - 1) > 0) by (apply two_p_gt_ZERO; omega).
  assert (unsigned (repr (zwordsize - n)) = zwordsize - n).
(* Goal: @Logic.eq Z (unsigned (repr (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)))) (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)) *)
    apply unsigned_repr.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    split. omega. generalize wordsize_max_unsigned; omega.
(* Goal: Logic.and (Z.le (Z.opp (two_p (Z.sub n (Zpos xH)))) (signed (shr X (repr (Z.sub zwordsize n))))) (Z.lt (signed (shr X (repr (Z.sub zwordsize n)))) (two_p (Z.sub n (Zpos xH)))) *)
  rewrite shr_div_two_p.
(* Goal: @Logic.eq int (xor zero (if if zlt (signed (repr (Z.sub X Y))) Z0 then true else false then one else zero)) one *)
  rewrite signed_repr.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add i (Int.unsigned (Int.sub y Int.iwordsize))) Int.zwordsize then Z.add i (Int.unsigned (Int.sub y Int.iwordsize)) else Z.sub Int.zwordsize (Zpos xH))) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
(* Goal: @Logic.eq bool (Int.testbit (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Z.sub i Int.zwordsize)) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
  rewrite H1.
(* Goal: Logic.and (Z.le (Z.opp (two_p (Z.sub n (Zpos xH)))) (Z.div (signed X) (two_p (Z.sub zwordsize n)))) (Z.lt (Z.div (signed X) (two_p (Z.sub zwordsize n))) (two_p (Z.sub n (Zpos xH)))) *)
(* Goal: Logic.and (Z.le min_signed (Z.div (signed X) (two_p (unsigned (repr (Z.sub zwordsize n)))))) (Z.le (Z.div (signed X) (two_p (unsigned (repr (Z.sub zwordsize n))))) max_signed) *)
  apply Zdiv_interval_1.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega. apply two_p_gt_ZERO; omega.
  replace (- two_p (n - 1) * two_p (zwordsize - n))
     with (- (two_p (n - 1) * two_p (zwordsize - n))) by ring.
  rewrite <- two_p_is_exp.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  replace (n - 1 + (zwordsize - n)) with (zwordsize - 1) by omega.
  rewrite <- half_modulus_power.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (signed_range X). unfold min_signed, max_signed. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega.
(* Goal: Logic.and (Z.le min_signed (Z.div (signed X) (two_p (unsigned (repr (Z.sub zwordsize n)))))) (Z.le (Z.div (signed X) (two_p (unsigned (repr (Z.sub zwordsize n))))) max_signed) *)
  apply Zdiv_interval_2. apply signed_range.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize min_signed_neg; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize max_signed_pos; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite H1. apply two_p_gt_ZERO. omega.
Qed.

Lemma eqmod_sign_ext':
  forall n x, 0 < n < zwordsize ->
  eqmod (two_p n) (unsigned (sign_ext n x)) (unsigned x).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: Z.ge n (Zsize x) *)
  set (N := Z.to_nat n).
(* Goal: eqmod (two_p n) (unsigned (sign_ext n x)) (unsigned x) *)
  assert (Z.of_nat N = n) by (apply Z2Nat.id; omega).
  rewrite <- H0. rewrite <- two_power_nat_two_p.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply eqmod_same_bits; intros.
(* Goal: @Logic.eq bool (orb (if zlt (Z.add i (Int.unsigned y)) Int.zwordsize then Int.testbit xl (Z.add i (Int.unsigned y)) else false) (if zlt i (Int.unsigned (Int.sub Int.iwordsize y)) then false else Int.testbit xh (Z.sub i (Int.unsigned (Int.sub Int.iwordsize y))))) (if zlt (Z.add i (Int.unsigned y)) Int.zwordsize then Int.testbit xl (Z.add i (Int.unsigned y)) else Int.testbit xh (Z.sub (Z.add i (Int.unsigned y)) Int.zwordsize)) *)
(* Goal: @Logic.eq bool (Int.testbit (Int.shr xh y) (Z.sub i Int.zwordsize)) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
  rewrite H0 in H1. rewrite H0.
(* Goal: @Logic.eq bool (testbit (sign_ext n x) i) (Z.testbit (unsigned x) i) *)
  fold (testbit (sign_ext n x) i). rewrite bits_sign_ext.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true. auto. omega. omega. omega.
Qed.

Lemma eqmod_sign_ext:
  forall n x, 0 < n < zwordsize ->
  eqmod (two_p n) (signed (sign_ext n x)) (unsigned x).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply eqmod_trans with (unsigned (sign_ext n x)).
(* Goal: eqmod modulus (signed (sign_ext n x)) (unsigned (sign_ext n x)) *)
(* Goal: Z.divide (two_p n) modulus *)
(* Goal: eqmod (two_p n) (unsigned (sign_ext n x)) (unsigned x) *)
  apply eqmod_divides with modulus. apply eqm_signed_unsigned.
  exists (two_p (zwordsize - n)).
(* Goal: Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub modulus (Zpos xH))) *)
  unfold modulus. rewrite two_power_nat_two_p. fold zwordsize.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite <- two_p_is_exp. f_equal. omega. omega. omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply eqmod_sign_ext'; auto.
Qed.

(** ** Properties of [one_bits] (decomposition in sum of powers of two) *)

Theorem one_bits_range:
  forall x i, In i (one_bits x) -> ltu i iwordsize = true.
Proof.
  assert (A: forall p, 0 <= p < zwordsize -> ltu (repr p) iwordsize = true).
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
    intros. unfold ltu, iwordsize. apply zlt_true.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    repeat rewrite unsigned_repr. tauto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize wordsize_max_unsigned; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize wordsize_max_unsigned; omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold one_bits. intros.
(* Goal: @Logic.eq bool (Int.ltu i iwordsize') true *)
  destruct (list_in_map_inv _ _ _ H) as [i0 [EQ IN]].
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  subst i. apply A. apply Z_one_bits_range with (unsigned x); auto.
Qed.

Fixpoint int_of_one_bits (l: list int) : int :=
  match l with
  | nil => zero
  | a :: b => add (shl one a) (int_of_one_bits b)
  end.

Theorem one_bits_decomp:
  forall x, x = int_of_one_bits (one_bits x).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq int x (int_of_one_bits (one_bits x)) *)
  transitivity (repr (powerserie (Z_one_bits wordsize (unsigned x) 0))).
(* Goal: @Logic.eq int x (repr (powerserie (Z_one_bits wordsize (unsigned x) Z0))) *)
(* Goal: @Logic.eq int (repr (powerserie (Z_one_bits wordsize (unsigned x) Z0))) (int_of_one_bits (one_bits x)) *)
  transitivity (repr (unsigned x)).
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  auto with ints. decEq. apply Z_one_bits_powerserie.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  auto with ints.
(* Goal: @Logic.eq int (repr (powerserie (Z_one_bits wordsize (unsigned x) Z0))) (int_of_one_bits (one_bits x)) *)
  unfold one_bits.
(* Goal: @Logic.eq int (repr (powerserie (Z_one_bits wordsize (unsigned x) Z0))) (int_of_one_bits (@map Z int repr (Z_one_bits wordsize (unsigned x) Z0))) *)
  generalize (Z_one_bits_range (unsigned x)).
(* Goal: forall _ : forall (i : Z) (_ : @In Z i (Z_one_bits wordsize (unsigned x) Z0)), Logic.and (Z.le Z0 i) (Z.lt i zwordsize), @Logic.eq int (repr (powerserie (Z_one_bits wordsize (unsigned x) Z0))) (int_of_one_bits (@map Z int repr (Z_one_bits wordsize (unsigned x) Z0))) *)
  generalize (Z_one_bits wordsize (unsigned x) 0).
(* Goal: forall (l : list Z) (_ : forall (i : Z) (_ : @In Z i l), Logic.and (Z.le Z0 i) (Z.lt i zwordsize)), @Logic.eq int (repr (powerserie l)) (int_of_one_bits (@map Z int repr l)) *)
  induction l.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  intros; reflexivity.
  intros; simpl. rewrite <- IHl. unfold add. apply eqm_samerepr.
(* Goal: @Logic.eq int (mul one (repr (two_p (Int.unsigned y)))) (repr (two_p (Int.unsigned y))) *)
  apply eqm_add. rewrite shl_mul_two_p. rewrite mul_commut.
(* Goal: eqm (two_p a) (unsigned (repr (two_p (unsigned (repr a))))) *)
(* Goal: eqm (powerserie l) (unsigned (repr (powerserie l))) *)
(* Goal: forall (i : Z) (_ : @In Z i l), Logic.and (Z.le Z0 i) (Z.lt i zwordsize) *)
  rewrite mul_one. apply eqm_unsigned_repr_r.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  rewrite unsigned_repr. auto with ints.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (H a (in_eq _ _)). generalize wordsize_max_unsigned. omega.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  auto with ints.
(* Goal: @In Z z (@cons Z z (@nil Z)) *)
(* Goal: forall (_ : forall (i : Z) (_ : @In Z i (@cons Z z (@cons Z z0 l))), Logic.and (Z.le Z0 i) (Z.lt i zwordsize)) (_ : @Logic.eq Z (unsigned n) (powerserie (@cons Z z (@cons Z z0 l)))) (_ : @Logic.eq (option int) (@None int) (@Some int logn)), @Logic.eq Z (unsigned n) (two_p (unsigned logn)) *)
  intros; apply H; auto with coqlib.
Qed.

(** ** Properties of comparisons *)

Theorem negate_cmp:
  forall c x y, cmp (negate_comparison c) x y = negb (cmp c x y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct c; simpl; try rewrite negb_elim; auto.
Qed.

Theorem negate_cmpu:
  forall c x y, cmpu (negate_comparison c) x y = negb (cmpu c x y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct c; simpl; try rewrite negb_elim; auto.
Qed.

Theorem swap_cmp:
  forall c x y, cmp (swap_comparison c) x y = cmp c y x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct c; simpl; auto. apply eq_sym. decEq. apply eq_sym.
Qed.

Theorem swap_cmpu:
  forall c x y, cmpu (swap_comparison c) x y = cmpu c y x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct c; simpl; auto. apply eq_sym. decEq. apply eq_sym.
Qed.

Lemma translate_eq:
  forall x y d,
  eq (add x d) (add y d) = eq x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold eq. case (zeq (unsigned x) (unsigned y)); intro.
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.ltu xl yl) *)
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  unfold add. rewrite e. apply zeq_true.
(* Goal: Logic.not (@Logic.eq Z (unsigned (repr (Z.add (unsigned x) (unsigned d)))) (unsigned (repr (Z.add (unsigned y) (unsigned d))))) *)
  apply zeq_false. unfold add. red; intro. apply n.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  apply eqm_small_eq; auto with ints.
  replace (unsigned x) with ((unsigned x + unsigned d) - unsigned d).
  replace (unsigned y) with ((unsigned y + unsigned d) - unsigned d).
  apply eqm_sub. apply eqm_trans with (unsigned (repr (unsigned x + unsigned d))).
  eauto with ints. apply eqm_trans with (unsigned (repr (unsigned y + unsigned d))).
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  eauto with ints. eauto with ints. eauto with ints.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega. omega.
Qed.

Lemma translate_ltu:
  forall x y d,
  0 <= unsigned x + unsigned d <= max_unsigned ->
  0 <= unsigned y + unsigned d <= max_unsigned ->
  ltu (add x d) (add y d) = ltu x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold add. unfold ltu.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  repeat rewrite unsigned_repr; auto. case (zlt (unsigned x) (unsigned y)); intro.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_true. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_false. omega.
Qed.

Theorem translate_cmpu:
  forall c x y d,
  0 <= unsigned x + unsigned d <= max_unsigned ->
  0 <= unsigned y + unsigned d <= max_unsigned ->
  cmpu c (add x d) (add y d) = cmpu c x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold cmpu.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite translate_eq. repeat rewrite translate_ltu; auto.
Qed.

Lemma translate_lt:
  forall x y d,
  min_signed <= signed x + signed d <= max_signed ->
  min_signed <= signed y + signed d <= max_signed ->
  lt (add x d) (add y d) = lt x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. repeat rewrite add_signed. unfold lt.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  repeat rewrite signed_repr; auto. case (zlt (signed x) (signed y)); intro.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_true. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_false. omega.
Qed.

Theorem translate_cmp:
  forall c x y d,
  min_signed <= signed x + signed d <= max_signed ->
  min_signed <= signed y + signed d <= max_signed ->
  cmp c (add x d) (add y d) = cmp c x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold cmp.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite translate_eq. repeat rewrite translate_lt; auto.
Qed.

Theorem notbool_isfalse_istrue:
  forall x, is_false x -> is_true (notbool x).
Proof.
(* Goal: Z.le (size x) n *)
(* Goal: Z.le (size x) n *)
  unfold is_false, is_true, notbool; intros; subst x.
(* Goal: Logic.not (@Logic.eq int one zero) *)
  rewrite eq_true. apply one_not_zero.
Qed.

Theorem notbool_istrue_isfalse:
  forall x, is_true x -> is_false (notbool x).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold is_false, is_true, notbool; intros.
(* Goal: forall _ : @Logic.eq Z (unsigned n) (two_p (Int.unsigned logn)), @Logic.eq int (divu x n) (shru' x logn) *)
  generalize (eq_spec x zero). case (eq x zero); intro.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  contradiction. auto.
Qed.

Theorem ltu_range_test:
  forall x y,
  ltu x y = true -> unsigned y <= max_signed ->
  0 <= signed x < unsigned y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: Logic.and (Z.le Z0 (unsigned x)) (Z.lt (unsigned x) (unsigned y)) *)
  unfold ltu in H. destruct (zlt (unsigned x) (unsigned y)); try discriminate.
(* Goal: Logic.and (Z.le Z0 (signed x)) (Z.lt (signed x) (unsigned y)) *)
  rewrite signed_eq_unsigned.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (unsigned_range x). omega. omega.
Qed.

Theorem lt_sub_overflow:
  forall x y,
  xor (sub_overflow x y zero) (negative (sub x y)) = if lt x y then one else zero.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold negative, sub_overflow, lt. rewrite sub_signed.
(* Goal: @Logic.eq int (xor (if andb (@proj_sumbool (Z.le min_signed (Z.sub (Z.sub (signed x) (signed y)) Z0)) (Z.gt min_signed (Z.sub (Z.sub (signed x) (signed y)) Z0)) (zle min_signed (Z.sub (Z.sub (signed x) (signed y)) Z0))) (@proj_sumbool (Z.le (Z.sub (Z.sub (signed x) (signed y)) Z0) max_signed) (Z.gt (Z.sub (Z.sub (signed x) (signed y)) Z0) max_signed) (zle (Z.sub (Z.sub (signed x) (signed y)) Z0) max_signed)) then zero else one) (if if zlt (signed (repr (Z.sub (signed x) (signed y)))) Z0 then true else false then one else zero)) (if if zlt (signed x) (signed y) then true else false then one else zero) *)
  rewrite signed_zero. rewrite Z.sub_0_r.
(* Goal: @Logic.eq int (xor (if andb (@proj_sumbool (Z.le min_signed (Z.sub (signed x) (signed y))) (Z.gt min_signed (Z.sub (signed x) (signed y))) (zle min_signed (Z.sub (signed x) (signed y)))) (@proj_sumbool (Z.le (Z.sub (signed x) (signed y)) max_signed) (Z.gt (Z.sub (signed x) (signed y)) max_signed) (zle (Z.sub (signed x) (signed y)) max_signed)) then zero else one) (if if zlt (signed (repr (Z.sub (signed x) (signed y)))) Z0 then true else false then one else zero)) (if if zlt (signed x) (signed y) then true else false then one else zero) *)
  generalize (signed_range x) (signed_range y).
(* Goal: forall (_ : Logic.and (Z.le min_signed (signed x)) (Z.le (signed x) max_signed)) (_ : Logic.and (Z.le min_signed (signed y)) (Z.le (signed y) max_signed)), @Logic.eq int (xor (if andb (@proj_sumbool (Z.le min_signed (Z.sub (signed x) (signed y))) (Z.gt min_signed (Z.sub (signed x) (signed y))) (zle min_signed (Z.sub (signed x) (signed y)))) (@proj_sumbool (Z.le (Z.sub (signed x) (signed y)) max_signed) (Z.gt (Z.sub (signed x) (signed y)) max_signed) (zle (Z.sub (signed x) (signed y)) max_signed)) then zero else one) (if if zlt (signed (repr (Z.sub (signed x) (signed y)))) Z0 then true else false then one else zero)) (if if zlt (signed x) (signed y) then true else false then one else zero) *)
  set (X := signed x); set (Y := signed y). intros RX RY.
(* Goal: @Logic.eq int (xor (if andb (@proj_sumbool (Z.le min_signed (Z.sub X Y)) (Z.gt min_signed (Z.sub X Y)) (zle min_signed (Z.sub X Y))) (@proj_sumbool (Z.le (Z.sub X Y) max_signed) (Z.gt (Z.sub X Y) max_signed) (zle (Z.sub X Y) max_signed)) then zero else one) (if if zlt (signed (repr (Z.sub X Y))) Z0 then true else false then one else zero)) (if if zlt X Y then true else false then one else zero) *)
  unfold min_signed, max_signed in *.
(* Goal: @Logic.eq int (xor (if andb (@proj_sumbool (Z.le (Z.opp half_modulus) (Z.sub X Y)) (Z.gt (Z.opp half_modulus) (Z.sub X Y)) (zle (Z.opp half_modulus) (Z.sub X Y))) (@proj_sumbool (Z.le (Z.sub X Y) (Z.sub half_modulus (Zpos xH))) (Z.gt (Z.sub X Y) (Z.sub half_modulus (Zpos xH))) (zle (Z.sub X Y) (Z.sub half_modulus (Zpos xH)))) then zero else one) (if if zlt (signed (repr (Z.sub X Y))) Z0 then true else false then one else zero)) (if if zlt X Y then true else false then one else zero) *)
  generalize half_modulus_pos half_modulus_modulus; intros HM MM.
  destruct (zle 0 (X - Y)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
- unfold proj_sumbool at 1; rewrite zle_true at 1 by omega. simpl.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite (zlt_false _ X) by omega.
  destruct (zlt (X - Y) half_modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  + unfold proj_sumbool; rewrite zle_true by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite signed_repr. rewrite zlt_false by omega. apply xor_idem.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    unfold min_signed, max_signed; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  + unfold proj_sumbool; rewrite zle_false by omega.
    replace (signed (repr (X - Y))) with (X - Y - modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite zlt_true by omega. apply xor_idem.
    rewrite signed_repr_eq. replace ((X - Y) mod modulus) with (X - Y).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    rewrite zlt_false; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    symmetry. apply Zmod_unique with 0; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
- unfold proj_sumbool at 2. rewrite zle_true at 1 by omega. rewrite andb_true_r.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite (zlt_true _ X) by omega.
  destruct (zlt (X - Y) (-half_modulus)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  + unfold proj_sumbool; rewrite zle_false by omega.
    replace (signed (repr (X - Y))) with (X - Y + modulus).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite zlt_false by omega. apply xor_zero.
    rewrite signed_repr_eq. replace ((X - Y) mod modulus) with (X - Y + modulus).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    rewrite zlt_true by omega; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    symmetry. apply Zmod_unique with (-1); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  + unfold proj_sumbool; rewrite zle_true by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite signed_repr. rewrite zlt_true by omega. apply xor_zero_l.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    unfold min_signed, max_signed; omega.
Qed.

Lemma signed_eq:
  forall x y, eq x y = zeq (signed x) (signed y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold eq. unfold proj_sumbool.
  destruct (zeq (unsigned x) (unsigned y));
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct (zeq (signed x) (signed y)); auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  elim n. unfold signed. rewrite e; auto.
(* Goal: Int.eqm ph (Int.unsigned (Int.repr ph)) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  elim n. apply eqm_small_eq; auto with ints.
(* Goal: eqm (unsigned (repr a)) a *)
(* Goal: eqm a b *)
  eapply eqm_trans. apply eqm_sym. apply eqm_signed_unsigned.
(* Goal: eqmod modulus (signed (sign_ext n x)) (unsigned (sign_ext n x)) *)
(* Goal: Z.divide (two_p n) modulus *)
(* Goal: eqmod (two_p n) (unsigned (sign_ext n x)) (unsigned x) *)
  rewrite e. apply eqm_signed_unsigned.
Qed.

Lemma not_lt:
  forall x y, negb (lt y x) = (lt x y || eq x y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold lt. rewrite signed_eq. unfold proj_sumbool.
(* Goal: @Logic.eq bool (negb (if zlt (signed y) (signed x) then true else false)) (orb (if zlt (signed x) (signed y) then true else false) (if zeq (signed x) (signed y) then true else false)) *)
  destruct (zlt (signed y) (signed x)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false. rewrite zeq_false. auto. omega. omega.
(* Goal: @Logic.eq bool (negb false) (orb (if zlt (signed x) (signed y) then true else false) (if zeq (signed x) (signed y) then true else false)) *)
  destruct (zeq (signed x) (signed y)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false. auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true. auto. omega.
Qed.

Lemma lt_not:
  forall x y, lt y x = negb (lt x y) && negb (eq x y).
Proof.
  intros. rewrite <- negb_orb. rewrite <- not_lt. rewrite negb_involutive. auto.
Qed.

Lemma not_ltu:
  forall x y, negb (ltu y x) = (ltu x y || eq x y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold ltu, eq.
(* Goal: @Logic.eq bool (negb (if zlt (unsigned y) (unsigned x) then true else false)) (orb (if zlt (unsigned x) (unsigned y) then true else false) (if zeq (unsigned x) (unsigned y) then true else false)) *)
  destruct (zlt (unsigned y) (unsigned x)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false. rewrite zeq_false. auto. omega. omega.
(* Goal: @Logic.eq bool (negb false) (orb (if zlt (unsigned x) (unsigned y) then true else false) (if zeq (unsigned x) (unsigned y) then true else false)) *)
  destruct (zeq (unsigned x) (unsigned y)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false. auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true. auto. omega.
Qed.

Lemma ltu_not:
  forall x y, ltu y x = negb (ltu x y) && negb (eq x y).
Proof.
  intros. rewrite <- negb_orb. rewrite <- not_ltu. rewrite negb_involutive. auto.
Qed.


(** Non-overlapping test *)

Definition no_overlap (ofs1: int) (sz1: Z) (ofs2: int) (sz2: Z) : bool :=
  let x1 := unsigned ofs1 in let x2 := unsigned ofs2 in
     zlt (x1 + sz1) modulus && zlt (x2 + sz2) modulus
  && (zle (x1 + sz1) x2 || zle (x2 + sz2) x1).

Lemma no_overlap_sound:
  forall ofs1 sz1 ofs2 sz2 base,
  sz1 > 0 -> sz2 > 0 -> no_overlap ofs1 sz1 ofs2 sz2 = true ->
  unsigned (add base ofs1) + sz1 <= unsigned (add base ofs2)
  \/ unsigned (add base ofs2) + sz2 <= unsigned (add base ofs1).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: Logic.or (Z.le (Z.add (unsigned (add base ofs1)) sz1) (unsigned (add base ofs2))) (Z.le (Z.add (unsigned (add base ofs2)) sz2) (unsigned (add base ofs1))) *)
  destruct (andb_prop _ _ H1). clear H1.
(* Goal: Logic.or (Z.le (Z.add (unsigned (add base ofs1)) sz1) (unsigned (add base ofs2))) (Z.le (Z.add (unsigned (add base ofs2)) sz2) (unsigned (add base ofs1))) *)
  destruct (andb_prop _ _ H2). clear H2.
(* Goal: Logic.or (Z.le (Z.add (unsigned (add base ofs1)) sz1) (unsigned (add base ofs2))) (Z.le (Z.add (unsigned (add base ofs2)) sz2) (unsigned (add base ofs1))) *)
  apply proj_sumbool_true in H1.
(* Goal: Logic.or (Z.le (Z.add (unsigned (add base ofs1)) sz1) (unsigned (add base ofs2))) (Z.le (Z.add (unsigned (add base ofs2)) sz2) (unsigned (add base ofs1))) *)
  apply proj_sumbool_true in H4.
  assert (unsigned ofs1 + sz1 <= unsigned ofs2 \/ unsigned ofs2 + sz2 <= unsigned ofs1).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct (orb_prop _ _ H3). left. eapply proj_sumbool_true; eauto. right. eapply proj_sumbool_true; eauto.
(* Goal: Logic.or (Z.le (Z.add (unsigned (add base ofs1)) sz1) (unsigned (add base ofs2))) (Z.le (Z.add (unsigned (add base ofs2)) sz2) (unsigned (add base ofs1))) *)
  clear H3.
(* Goal: Logic.or (Z.le (Z.add (unsigned (add base ofs1)) sz1) (unsigned (add base ofs2))) (Z.le (Z.add (unsigned (add base ofs2)) sz2) (unsigned (add base ofs1))) *)
  generalize (unsigned_range ofs1) (unsigned_range ofs2). intros P Q.
(* Goal: Logic.or (Z.le (Z.add (unsigned (add base ofs1)) sz1) (unsigned (add base ofs2))) (Z.le (Z.add (unsigned (add base ofs2)) sz2) (unsigned (add base ofs1))) *)
  generalize (unsigned_add_either base ofs1) (unsigned_add_either base ofs2).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros [C|C] [D|D]; omega.
Qed.

(** Size of integers, in bits. *)

Definition Zsize (x: Z) : Z :=
  match x with
  | Zpos p => Zpos (Pos.size p)
  | _ => 0
  end.

Definition size (x: int) : Z := Zsize (unsigned x).

Remark Zsize_pos: forall x, 0 <= Zsize x.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct x; simpl. omega. compute; intuition congruence. omega.
Qed.

Remark Zsize_pos': forall x, 0 < x -> 0 < Zsize x.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct x; simpl; intros; try discriminate. compute; auto.
Qed.

Lemma Zsize_shiftin:
  forall b x, 0 < x -> Zsize (Zshiftin b x) = Z.succ (Zsize x).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct x; compute in H; try discriminate.
(* Goal: @Logic.eq Z (Zsize (Zshiftin b (Zpos p))) (Z.succ (Zsize (Zpos p))) *)
  destruct b.
(* Goal: @Logic.eq Z (Zsize (Zshiftin true (Zpos p))) (Z.succ (Zsize (Zpos p))) *)
(* Goal: @Logic.eq Z (Zsize (Zshiftin false (Zpos p))) (Z.succ (Zsize (Zpos p))) *)
  change (Zshiftin true (Zpos p)) with (Zpos (p~1)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  simpl. f_equal. rewrite Pos.add_1_r; auto.
(* Goal: @Logic.eq Z (Zsize (Zshiftin false (Zpos p))) (Z.succ (Zsize (Zpos p))) *)
  change (Zshiftin false (Zpos p)) with (Zpos (p~0)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  simpl. f_equal. rewrite Pos.add_1_r; auto.
Qed.

Lemma Ztestbit_size_1:
  forall x, 0 < x -> Z.testbit x (Z.pred (Zsize x)) = true.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  intros x0 POS0; pattern x0; apply Zshiftin_pos_ind; auto.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite Zsize_shiftin; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  replace (Z.pred (Z.succ (Zsize x))) with (Z.succ (Z.pred (Zsize x))) by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Ztestbit_shiftin_succ. auto. generalize (Zsize_pos' x H); omega.
Qed.

Lemma Ztestbit_size_2:
  forall x, 0 <= x -> forall i, i >= Zsize x -> Z.testbit x i = false.
Proof.
(* Goal: forall (x : Z) (_ : Z.le Z0 x) (i : Z) (_ : Z.ge i (Zsize x)), @Logic.eq bool (Z.testbit x i) false *)
  intros x0 POS0. destruct (zeq x0 0).
  - subst x0; intros. apply Ztestbit_0.
  - pattern x0; apply Zshiftin_pos_ind.
    + simpl. intros. change 1 with (Zshiftin true 0). rewrite Ztestbit_shiftin.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      rewrite zeq_false. apply Ztestbit_0. omega. omega.
    + intros. rewrite Zsize_shiftin in H1; auto.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
      generalize (Zsize_pos' _ H); intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      rewrite Ztestbit_shiftin. rewrite zeq_false. apply H0. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
      omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    + omega.
Qed.

Lemma Zsize_interval_1:
  forall x, 0 <= x -> 0 <= x < two_p (Zsize x).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: Logic.and (Z.le Z0 x) (Z.lt x (two_p (Zsize x))) *)
  assert (x = x mod (two_p (Zsize x))).
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
    apply equal_same_bits; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    rewrite Ztestbit_mod_two_p; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    destruct (zlt i (Zsize x)). auto. apply Ztestbit_size_2; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    apply Zsize_pos; auto.
(* Goal: Z.gt (two_p (Zsize x)) Z0 *)
  rewrite H0 at 1. rewrite H0 at 3. apply Z_mod_lt. apply two_p_gt_ZERO. apply Zsize_pos; auto.
Qed.

Lemma Zsize_interval_2:
  forall x n, 0 <= n -> 0 <= x < two_p n -> n >= Zsize x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. set (N := Z.to_nat n).
(* Goal: Z.ge n (Zsize x) *)
  assert (Z.of_nat N = n) by (apply Z2Nat.id; auto).
  rewrite <- H1 in H0. rewrite <- two_power_nat_two_p in H0.
(* Goal: Z.ge n (Zsize x) *)
  destruct (zeq x 0).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  subst x; simpl; omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct (zlt n (Zsize x)); auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  exploit (Ztestbit_above N x (Z.pred (Zsize x))). auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Ztestbit_size_1. congruence. omega.
Qed.

Lemma Zsize_monotone:
  forall x y, 0 <= x <= y -> Zsize x <= Zsize y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply Z.ge_le. apply Zsize_interval_2. apply Zsize_pos.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  exploit (Zsize_interval_1 y). omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Theorem size_zero: size zero = 0.
Proof.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold size; rewrite unsigned_zero; auto.
Qed.

Theorem bits_size_1:
  forall x, x = zero \/ testbit x (Z.pred (size x)) = true.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct (zeq (unsigned x) 0).
  left. rewrite <- (repr_unsigned x). rewrite e; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  right. apply Ztestbit_size_1. generalize (unsigned_range x); omega.
Qed.

Theorem bits_size_2:
  forall x i, size x <= i -> testbit x i = false.
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. apply Ztestbit_size_2. generalize (unsigned_range x); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  fold (size x); omega.
Qed.

Theorem size_range:
  forall x, 0 <= size x <= zwordsize.
Proof.
(* Goal: Logic.and (Z.le Z0 (size (xor a b))) (Z.le (size (xor a b)) (Z.max (size a) (size b))) *)
(* Goal: Logic.and (Z.le Z0 (unsigned (xor a b))) (Z.lt (unsigned (xor a b)) (two_p (Z.max (size a) (size b)))) *)
  intros; split. apply Zsize_pos.
(* Goal: Z.le (size x) n *)
  destruct (bits_size_1 x).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  subst x; unfold size; rewrite unsigned_zero; simpl. generalize wordsize_pos; omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct (zle (size x) zwordsize); auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_above in H. congruence. omega.
Qed.

Theorem bits_size_3:
  forall x n,
  0 <= n ->
  (forall i, n <= i < zwordsize -> testbit x i = false) ->
  size x <= n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. destruct (zle (size x) n). auto.
(* Goal: Z.le (size x) n *)
  destruct (bits_size_1 x).
(* Goal: Z.le (size x) n *)
(* Goal: Z.le (size x) n *)
  subst x. unfold size; rewrite unsigned_zero; assumption.
(* Goal: @Logic.eq BinNums.Z (Z.add (Int.unsigned y) (Int.unsigned z)) (Z.add (unsigned y') (unsigned z')) *)
  rewrite (H0 (Z.pred (size x))) in H1. congruence.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (size_range x); omega.
Qed.

Theorem bits_size_4:
  forall x n,
  0 <= n ->
  testbit x (Z.pred n) = true ->
  (forall i, n <= i < zwordsize -> testbit x i = false) ->
  size x = n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq Z (size x) n *)
  assert (size x <= n).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
    apply bits_size_3; auto.
(* Goal: @Logic.eq Z (size x) n *)
  destruct (zlt (size x) n).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_size_2 in H0. congruence. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Theorem size_interval_1:
  forall x, 0 <= unsigned x < two_p (size x).
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros; apply Zsize_interval_1. generalize (unsigned_range x); omega.
Qed.

Theorem size_interval_2:
  forall x n, 0 <= n -> 0 <= unsigned x < two_p n -> n >= size x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply Zsize_interval_2; auto.
Qed.

Theorem size_and:
  forall a b, size (and a b) <= Z.min (size a) (size b).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: Z.le (size (and a b)) (Z.min (size a) (size b)) *)
  assert (0 <= Z.min (size a) (size b)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize (size_range a) (size_range b). zify; omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply bits_size_3. auto. intros.
(* Goal: @Logic.eq bool (testbit (and a b) i) false *)
  rewrite bits_and. zify. subst z z0. destruct H1.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite (bits_size_2 a). auto. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite (bits_size_2 b). apply andb_false_r. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Corollary and_interval:
  forall a b, 0 <= unsigned (and a b) < two_p (Z.min (size a) (size b)).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (size_interval_1 (and a b)); intros.
(* Goal: Logic.and (Z.le Z0 (unsigned (and a b))) (Z.lt (unsigned (and a b)) (two_p (Z.min (size a) (size b)))) *)
  assert (two_p (size (and a b)) <= two_p (Z.min (size a) (size b))).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply two_p_monotone. split. generalize (size_range (and a b)); omega.
(* Goal: Z.le (size (and a b)) (Z.min (size a) (size b)) *)
(* Goal: Logic.and (Z.le Z0 (unsigned (and a b))) (Z.lt (unsigned (and a b)) (two_p (Z.min (size a) (size b)))) *)
  apply size_and.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Theorem size_or:
  forall a b, size (or a b) = Z.max (size a) (size b).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (size_range a) (size_range b); intros.
(* Goal: @Logic.eq Z (size (or a b)) (Z.max (size a) (size b)) *)
  destruct (bits_size_1 a).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  subst a. rewrite size_zero. rewrite or_zero_l. zify; omega.
(* Goal: @Logic.eq Z (size (or a b)) (Z.max (size a) (size b)) *)
  destruct (bits_size_1 b).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  subst b. rewrite size_zero. rewrite or_zero. zify; omega.
(* Goal: @Logic.eq Z (size (or a b)) (Z.max (size a) (size b)) *)
  zify. destruct H3 as [[P Q] | [P Q]]; subst.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply bits_size_4. tauto. rewrite bits_or. rewrite H2. apply orb_true_r.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. rewrite bits_or. rewrite !bits_size_2. auto. omega. omega. omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply bits_size_4. tauto. rewrite bits_or. rewrite H1. apply orb_true_l.
(* Goal: Logic.and (Z.le Z0 (Z.pred (size a))) (Z.lt (Z.pred (size a)) zwordsize) *)
(* Goal: forall (i : Z) (_ : Logic.and (Z.le (size a) i) (Z.lt i zwordsize)), @Logic.eq bool (testbit (or a b) i) false *)
  destruct (zeq (size a) 0). unfold testbit in H1. rewrite Z.testbit_neg_r in H1.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  congruence. omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. rewrite bits_or. rewrite !bits_size_2. auto. omega. omega. omega.
Qed.

Corollary or_interval:
  forall a b, 0 <= unsigned (or a b) < two_p (Z.max (size a) (size b)).
Proof.
  intros. rewrite <- size_or. apply size_interval_1.
Qed.

Theorem size_xor:
  forall a b, size (xor a b) <= Z.max (size a) (size b).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: Z.le (size (xor a b)) (Z.max (size a) (size b)) *)
  assert (0 <= Z.max (size a) (size b)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    generalize (size_range a) (size_range b). zify; omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply bits_size_3. auto. intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_xor. rewrite !bits_size_2. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  zify; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  zify; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Corollary xor_interval:
  forall a b, 0 <= unsigned (xor a b) < two_p (Z.max (size a) (size b)).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (size_interval_1 (xor a b)); intros.
(* Goal: Logic.and (Z.le Z0 (unsigned (xor a b))) (Z.lt (unsigned (xor a b)) (two_p (Z.max (size a) (size b)))) *)
  assert (two_p (size (xor a b)) <= two_p (Z.max (size a) (size b))).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply two_p_monotone. split. generalize (size_range (xor a b)); omega.
(* Goal: Z.le (size (xor a b)) (Z.max (size a) (size b)) *)
(* Goal: Logic.and (Z.le Z0 (unsigned (xor a b))) (Z.lt (unsigned (xor a b)) (two_p (Z.max (size a) (size b)))) *)
  apply size_xor.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

End Make.

(** * Specialization to integers of size 8, 32, and 64 bits *)

Module Wordsize_32.
  Definition wordsize := 32%nat.
  Remark wordsize_not_zero: wordsize <> 0%nat.
  Proof. unfold wordsize; congruence. Qed.
End Wordsize_32.

Strategy opaque [Wordsize_32.wordsize].

Module Int := Make(Wordsize_32).

Strategy 0 [Wordsize_32.wordsize].

Notation int := Int.int.

Remark int_wordsize_divides_modulus:
  Z.divide (Z.of_nat Int.wordsize) Int.modulus.
Proof.
  exists (two_p (32-5)); reflexivity.
Qed.

Module Wordsize_8.
  Definition wordsize := 8%nat.
  Remark wordsize_not_zero: wordsize <> 0%nat.
  Proof. unfold wordsize; congruence. Qed.
End Wordsize_8.

Strategy opaque [Wordsize_8.wordsize].

Module Byte := Make(Wordsize_8).

Strategy 0 [Wordsize_8.wordsize].

Notation byte := Byte.int.

Module Wordsize_64.
  Definition wordsize := 64%nat.
  Remark wordsize_not_zero: wordsize <> 0%nat.
  Proof. unfold wordsize; congruence. Qed.
End Wordsize_64.

Strategy opaque [Wordsize_64.wordsize].

Module Int64.

Include Make(Wordsize_64).

(** Shifts with amount given as a 32-bit integer *)

Definition iwordsize': Int.int := Int.repr zwordsize.

Definition shl' (x: int) (y: Int.int): int :=
  repr (Z.shiftl (unsigned x) (Int.unsigned y)).
Definition shru' (x: int) (y: Int.int): int :=
  repr (Z.shiftr (unsigned x) (Int.unsigned y)).
Definition shr' (x: int) (y: Int.int): int :=
  repr (Z.shiftr (signed x) (Int.unsigned y)).
Definition rol' (x: int) (y: Int.int): int :=
  rol x (repr (Int.unsigned y)).
Definition shrx' (x: int) (y: Int.int): int :=
  divs x (shl' one y).
Definition shr_carry' (x: int) (y: Int.int): int :=
  if lt x zero && negb (eq (and x (sub (shl' one y) one)) zero)
  then one else zero.

Lemma bits_shl':
  forall x y i,
  0 <= i < zwordsize ->
  testbit (shl' x y) i =
  if zlt i (Int.unsigned y) then false else testbit x (i - Int.unsigned y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shl'. rewrite testbit_repr; auto.
(* Goal: @Logic.eq bool (if zlt (Z.sub i Int.zwordsize) (Int.unsigned (Int.sub y Int.iwordsize)) then false else Int.testbit xl (Z.sub (Z.sub i Int.zwordsize) (Int.unsigned (Int.sub y Int.iwordsize)))) (if zlt i (Int.unsigned y) then false else testbit (ofwords xh xl) (Z.sub i (Int.unsigned y))) *)
  destruct (zlt i (Int.unsigned y)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply Z.shiftl_spec_low. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply Z.shiftl_spec_high. omega. omega.
Qed.

Lemma bits_shru':
  forall x y i,
  0 <= i < zwordsize ->
  testbit (shru' x y) i =
  if zlt (i + Int.unsigned y) zwordsize then testbit x (i + Int.unsigned y) else false.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shru'. rewrite testbit_repr; auto.
  rewrite Z.shiftr_spec. fold (testbit x (i + Int.unsigned y)).
  destruct (zlt (i + Int.unsigned y) zwordsize).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply bits_above; auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Lemma bits_shr':
  forall x y i,
  0 <= i < zwordsize ->
  testbit (shr' x y) i =
  testbit x (if zlt (i + Int.unsigned y) zwordsize then i + Int.unsigned y else zwordsize - 1).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shr'. rewrite testbit_repr; auto.
(* Goal: @Logic.eq bool (Z.testbit (Z.shiftr (signed x) (Int.unsigned y)) i) (testbit x (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
  rewrite Z.shiftr_spec. apply bits_signed.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (Int.unsigned_range y); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Lemma shl'_mul_two_p:
  forall x y,
  shl' x y = mul x (repr (two_p (Int.unsigned y))).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shl', mul. apply eqm_samerepr.
(* Goal: eqm (two_p (Int.unsigned y)) (unsigned (repr (two_p (Int.unsigned y)))) *)
(* Goal: Z.le Z0 (Int.unsigned y) *)
  rewrite Zshiftl_mul_two_p. apply eqm_mult. apply eqm_refl. apply eqm_unsigned_repr.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (Int.unsigned_range y); omega.
Qed.

Lemma shl'_one_two_p:
  forall y, shl' one y = repr (two_p (Int.unsigned y)).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite shl'_mul_two_p. rewrite mul_commut. rewrite mul_one. auto.
Qed.

Theorem shl'_mul:
  forall x y,
  shl' x y = mul x (shl' one y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite shl'_one_two_p. apply shl'_mul_two_p.
Qed.

Theorem shl'_zero:
  forall x, shl' x Int.zero = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shl'. rewrite Int.unsigned_zero. unfold Z.shiftl.
(* Goal: @Logic.eq int (repr (unsigned a)) a *)
  apply repr_unsigned.
Qed.

Theorem shru'_zero :
  forall x, shru' x Int.zero = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shru'. rewrite Int.unsigned_zero. unfold Z.shiftr.
(* Goal: @Logic.eq int (repr (unsigned a)) a *)
  apply repr_unsigned.
Qed.

Theorem shr'_zero :
  forall x, shr' x Int.zero = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold shr'. rewrite Int.unsigned_zero. unfold Z.shiftr.
(* Goal: @Logic.eq int (repr (signed a)) a *)
  apply repr_signed.
Qed.

Theorem shrx'_zero:
  forall x, shrx' x Int.zero = x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. change (shrx' x Int.zero) with (shrx x zero). apply shrx_zero. compute; auto.
Qed.

Theorem shrx'_carry:
  forall x y,
  Int.ltu y (Int.repr 63) = true ->
  shrx' x y = add (shr' x y) (shr_carry' x y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply Int.ltu_inv in H. change (Int.unsigned (Int.repr 63)) with 63 in H.
(* Goal: @Logic.eq int (shrx' x y) (add (shr' x y) (shr_carry' x y)) *)
  set (y1 := Int64.repr (Int.unsigned y)).
(* Goal: @Logic.eq int (shrx' x y) (add (shr' x y) (shr_carry' x y)) *)
  assert (U: unsigned y1 = Int.unsigned y).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  { apply unsigned_repr. assert (63 < max_unsigned) by reflexivity. omega. }
(* Goal: @Logic.eq int (shrx' x y) (add (shr' x y) (shr_carry' x y)) *)
  transitivity (shrx x y1).
- unfold shrx', shrx, shl', shl. rewrite U; auto.
- rewrite shrx_carry. 
+ f_equal. 
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold shr, shr'. rewrite U; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold shr_carry, shr_carry', shl, shl'. rewrite U; auto.
+ unfold ltu. apply zlt_true. rewrite U; tauto. 
Qed.

Theorem shrx'_shr_2:
  forall x y,
  Int.ltu y (Int.repr 63) = true ->
  shrx' x y = shr' (add x (shru' (shr' x (Int.repr 63)) (Int.sub (Int.repr 64) y))) y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq int (shrx' x y) (shr' (add x (shru' (shr' x (Int.repr (Zpos (xI (xI (xI (xI (xI xH)))))))) (Int.sub (Int.repr (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) y))) y) *)
  set (z := repr (Int.unsigned y)).
(* Goal: Logic.and (@Logic.eq Z (Int.unsigned y) (unsigned y')) (Logic.and (@Logic.eq Z (Int.unsigned z) (unsigned z')) (Logic.and (@Logic.eq bool (ltu y' iwordsize) true) (Logic.and (@Logic.eq bool (ltu z' iwordsize) true) (Logic.and (@Logic.eq Z (Int.unsigned (Int.add y z)) (unsigned (add y' z'))) (@Logic.eq int (add y' z') (repr (Int.unsigned (Int.add y z)))))))) *)
  apply Int.ltu_inv in H. change (Int.unsigned (Int.repr 63)) with 63 in H.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (N1: 63 < max_unsigned) by reflexivity.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (N2: 63 < Int.max_unsigned) by reflexivity.
(* Goal: @Logic.eq int (shrx' x y) (shr' (add x (shru' (shr' x (Int.repr (Zpos (xI (xI (xI (xI (xI xH)))))))) (Int.sub (Int.repr (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) y))) y) *)
  assert (A: unsigned z = Int.unsigned y).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  { unfold z; apply unsigned_repr; omega. }
(* Goal: @Logic.eq int (shrx' x y) (shr' (add x (shru' (shr' x (Int.repr (Zpos (xI (xI (xI (xI (xI xH)))))))) (Int.sub (Int.repr (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) y))) y) *)
  assert (B: unsigned (sub (repr 64) z) = Int.unsigned (Int.sub (Int.repr 64) y)).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { unfold z. unfold sub, Int.sub.
(* Goal: @Logic.eq Z (unsigned (repr (Z.sub (unsigned (repr (Zpos (xO (xO (xO (xO (xO (xO xH))))))))) (unsigned (repr (Int.unsigned y)))))) (Int.unsigned (Int.repr (Z.sub (Int.unsigned (Int.repr (Zpos (xO (xO (xO (xO (xO (xO xH))))))))) (Int.unsigned y)))) *)
    change (unsigned (repr 64)) with 64.
(* Goal: @Logic.eq Z (unsigned (repr (Z.sub (Zpos (xO (xO (xO (xO (xO (xO xH))))))) (unsigned (repr (Int.unsigned y)))))) (Int.unsigned (Int.repr (Z.sub (Int.unsigned (Int.repr (Zpos (xO (xO (xO (xO (xO (xO xH))))))))) (Int.unsigned y)))) *)
    change (Int.unsigned (Int.repr 64)) with 64.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite (unsigned_repr (Int.unsigned y)) by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite unsigned_repr, Int.unsigned_repr by omega.
    auto. }
(* Goal: @Logic.eq int (shrx' x y) (shr' (add x (shru' (shr' x (Int.repr (Zpos (xI (xI (xI (xI (xI xH)))))))) (Int.sub (Int.repr (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) y))) y) *)
  unfold shrx', shr', shru', shl'.
  rewrite <- A.
(* Goal: @Logic.eq int (divs x (repr (Z.shiftl (unsigned one) (unsigned z)))) (repr (Z.shiftr (signed (add x (repr (Z.shiftr (unsigned (repr (Z.shiftr (signed x) (Int.unsigned (Int.repr (Zpos (xI (xI (xI (xI (xI xH))))))))))) (Int.unsigned (Int.sub (Int.repr (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) y)))))) (unsigned z))) *)
  change (Int.unsigned (Int.repr 63)) with (unsigned (repr 63)).
  rewrite <- B.
(* Goal: @Logic.eq int (divs x (repr (Z.shiftl (unsigned one) (unsigned z)))) (repr (Z.shiftr (signed (add x (repr (Z.shiftr (unsigned (repr (Z.shiftr (signed x) (unsigned (repr (Zpos (xI (xI (xI (xI (xI xH))))))))))) (unsigned (sub (repr (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) z)))))) (unsigned z))) *)
  apply shrx_shr_2.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold ltu. apply zlt_true. change (unsigned z < 63). rewrite A; omega.
Qed.

Remark int_ltu_2_inv:
  forall y z,
  Int.ltu y iwordsize' = true ->
  Int.ltu z iwordsize' = true ->
  Int.unsigned (Int.add y z) <= Int.unsigned iwordsize' ->
  let y' := repr (Int.unsigned y) in
  let z' := repr (Int.unsigned z) in
     Int.unsigned y = unsigned y'
  /\ Int.unsigned z = unsigned z'
  /\ ltu y' iwordsize = true
  /\ ltu z' iwordsize = true
  /\ Int.unsigned (Int.add y z) = unsigned (add y' z')
  /\ add y' z' = repr (Int.unsigned (Int.add y z)).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply Int.ltu_inv in H. apply Int.ltu_inv in H0.
  change (Int.unsigned iwordsize') with 64 in *.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (128 < max_unsigned) by reflexivity.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (128 < Int.max_unsigned) by reflexivity.
(* Goal: Logic.and (@Logic.eq Z (Int.unsigned y) (unsigned y')) (Logic.and (@Logic.eq Z (Int.unsigned z) (unsigned z')) (Logic.and (@Logic.eq bool (ltu y' iwordsize) true) (Logic.and (@Logic.eq bool (ltu z' iwordsize) true) (Logic.and (@Logic.eq Z (Int.unsigned (Int.add y z)) (unsigned (add y' z'))) (@Logic.eq int (add y' z') (repr (Int.unsigned (Int.add y z)))))))) *)
  assert (Y: unsigned y' = Int.unsigned y) by (apply unsigned_repr; omega).
(* Goal: Logic.and (@Logic.eq Z (Int.unsigned y) (unsigned y')) (Logic.and (@Logic.eq Z (Int.unsigned z) (unsigned z')) (Logic.and (@Logic.eq bool (ltu y' iwordsize) true) (Logic.and (@Logic.eq bool (ltu z' iwordsize) true) (Logic.and (@Logic.eq Z (Int.unsigned (Int.add y z)) (unsigned (add y' z'))) (@Logic.eq int (add y' z') (repr (Int.unsigned (Int.add y z)))))))) *)
  assert (Z: unsigned z' = Int.unsigned z) by (apply unsigned_repr; omega).
(* Goal: Logic.and (@Logic.eq Z (Int.unsigned y) (unsigned y')) (Logic.and (@Logic.eq Z (Int.unsigned z) (unsigned z')) (Logic.and (@Logic.eq bool (ltu y' iwordsize) true) (Logic.and (@Logic.eq bool (ltu z' iwordsize) true) (Logic.and (@Logic.eq Z (Int.unsigned (Int.add y z)) (unsigned (add y' z'))) (@Logic.eq int (add y' z') (repr (Int.unsigned (Int.add y z)))))))) *)
  assert (P: Int.unsigned (Int.add y z) = unsigned (add y' z')).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  { unfold Int.add. rewrite Int.unsigned_repr by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    unfold add. rewrite unsigned_repr by omega. congruence. }
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  intuition auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply zlt_true. rewrite Y; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply zlt_true. rewrite Z; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite P. rewrite repr_unsigned. auto.
Qed.

Theorem or_ror':
  forall x y z,
  Int.ltu y iwordsize' = true ->
  Int.ltu z iwordsize' = true ->
  Int.add y z = iwordsize' ->
  ror x (repr (Int.unsigned z)) = or (shl' x y) (shru' x z).
Proof.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  intros. destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. rewrite H1; omega.
(* Goal: @Logic.eq int (ror x (repr (Int.unsigned z))) (or (shl' x y) (shru' x z)) *)
  replace (shl' x y) with (shl x (repr (Int.unsigned y))).
(* Goal: @Logic.eq int (ror x (repr (Int.unsigned z))) (or (shl x (repr (Int.unsigned y))) (shru' x z)) *)
(* Goal: @Logic.eq int (shl x (repr (Int.unsigned y))) (shl' x y) *)
  replace (shru' x z) with (shru x (repr (Int.unsigned z))).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply or_ror; auto. rewrite F, H1. reflexivity.
  unfold shru, shru'; rewrite <- B; auto.
  unfold shl, shl'; rewrite <- A; auto.
Qed.

Theorem shl'_shl':
  forall x y z,
  Int.ltu y iwordsize' = true ->
  Int.ltu z iwordsize' = true ->
  Int.ltu (Int.add y z) iwordsize' = true ->
  shl' (shl' x y) z = shl' x (Int.add y z).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply Int.ltu_inv in H1.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. omega.
  set (y' := repr (Int.unsigned y)) in *.
  set (z' := repr (Int.unsigned z)) in *.
(* Goal: @Logic.eq int (shl' (shl' x y) z) (shl' x (Int.add y z)) *)
  replace (shl' x y) with (shl x y').
(* Goal: @Logic.eq int (shl' (shl x y') z) (shl' x (Int.add y z)) *)
(* Goal: @Logic.eq int (shl x y') (shl' x y) *)
  replace (shl' (shl x y') z) with (shl (shl x y') z').
(* Goal: @Logic.eq int (shl (shl x y') z') (shl' x (Int.add y z)) *)
(* Goal: @Logic.eq int (shl (shl x y') z') (shl' (shl x y') z) *)
(* Goal: @Logic.eq int (shl x y') (shl' x y) *)
  replace (shl' x (Int.add y z)) with (shl x (add y' z')).
  apply shl_shl; auto. apply zlt_true. rewrite <- E.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  change (unsigned iwordsize) with zwordsize. tauto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold shl, shl'. rewrite E; auto.
  unfold shl at 1, shl'. rewrite <- B; auto.
  unfold shl, shl'; rewrite <- A; auto.
Qed.

Theorem shru'_shru':
  forall x y z,
  Int.ltu y iwordsize' = true ->
  Int.ltu z iwordsize' = true ->
  Int.ltu (Int.add y z) iwordsize' = true ->
  shru' (shru' x y) z = shru' x (Int.add y z).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply Int.ltu_inv in H1.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. omega.
  set (y' := repr (Int.unsigned y)) in *.
  set (z' := repr (Int.unsigned z)) in *.
(* Goal: @Logic.eq int (shru' (shru' x y) z) (shru' x (Int.add y z)) *)
  replace (shru' x y) with (shru x y').
(* Goal: @Logic.eq int (shru' (shru x y') z) (shru' x (Int.add y z)) *)
(* Goal: @Logic.eq int (shru x y') (shru' x y) *)
  replace (shru' (shru x y') z) with (shru (shru x y') z').
(* Goal: @Logic.eq int (shru (shru x y') z') (shru' x (Int.add y z)) *)
(* Goal: @Logic.eq int (shru (shru x y') z') (shru' (shru x y') z) *)
(* Goal: @Logic.eq int (shru x y') (shru' x y) *)
  replace (shru' x (Int.add y z)) with (shru x (add y' z')).
  apply shru_shru; auto. apply zlt_true. rewrite <- E.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  change (unsigned iwordsize) with zwordsize. tauto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold shru, shru'. rewrite E; auto.
  unfold shru at 1, shru'. rewrite <- B; auto.
  unfold shru, shru'; rewrite <- A; auto.
Qed.

Theorem shr'_shr':
  forall x y z,
  Int.ltu y iwordsize' = true ->
  Int.ltu z iwordsize' = true ->
  Int.ltu (Int.add y z) iwordsize' = true ->
  shr' (shr' x y) z = shr' x (Int.add y z).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply Int.ltu_inv in H1.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. omega.
  set (y' := repr (Int.unsigned y)) in *.
  set (z' := repr (Int.unsigned z)) in *.
(* Goal: @Logic.eq int (shr' (shr' x y) z) (shr' x (Int.add y z)) *)
  replace (shr' x y) with (shr x y').
(* Goal: @Logic.eq int (shr' (shr x y') z) (shr' x (Int.add y z)) *)
(* Goal: @Logic.eq int (shr x y') (shr' x y) *)
  replace (shr' (shr x y') z) with (shr (shr x y') z').
(* Goal: @Logic.eq int (shr (shr x y') z') (shr' x (Int.add y z)) *)
(* Goal: @Logic.eq int (shr (shr x y') z') (shr' (shr x y') z) *)
(* Goal: @Logic.eq int (shr x y') (shr' x y) *)
  replace (shr' x (Int.add y z)) with (shr x (add y' z')).
  apply shr_shr; auto. apply zlt_true. rewrite <- E.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  change (unsigned iwordsize) with zwordsize. tauto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  unfold shr, shr'. rewrite E; auto.
  unfold shr at 1, shr'. rewrite <- B; auto.
  unfold shr, shr'; rewrite <- A; auto.
Qed.

(** Powers of two with exponents given as 32-bit ints *)

Definition one_bits' (x: int) : list Int.int :=
  List.map Int.repr (Z_one_bits wordsize (unsigned x) 0).

Definition is_power2' (x: int) : option Int.int :=
  match Z_one_bits wordsize (unsigned x) 0 with
  | i :: nil => Some (Int.repr i)
  | _ => None
  end.

Theorem one_bits'_range:
  forall x i, In i (one_bits' x) -> Int.ltu i iwordsize' = true.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq bool (Int.ltu i iwordsize') true *)
  destruct (list_in_map_inv _ _ _ H) as [i0 [EQ IN]].
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  exploit Z_one_bits_range; eauto. intros R.
(* Goal: @Logic.eq Z (Z.mul x (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k modulus) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  unfold Int.ltu. rewrite EQ. rewrite Int.unsigned_repr.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  change (Int.unsigned iwordsize') with zwordsize. apply zlt_true. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (zwordsize < Int.max_unsigned) by reflexivity. omega.
Qed.

Fixpoint int_of_one_bits' (l: list Int.int) : int :=
  match l with
  | nil => zero
  | a :: b => add (shl' one a) (int_of_one_bits' b)
  end.

Theorem one_bits'_decomp:
  forall x, x = int_of_one_bits' (one_bits' x).
Proof.
  assert (REC: forall l,
           (forall i, In i l -> 0 <= i < zwordsize) ->
           int_of_one_bits' (List.map Int.repr l) = repr (powerserie l)).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { induction l; simpl; intros.
  - auto.
  - rewrite IHl by eauto. apply eqm_samerepr; apply eqm_add.
  + rewrite shl'_one_two_p. rewrite Int.unsigned_repr. apply eqm_sym; apply eqm_unsigned_repr.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    exploit (H a). auto. assert (zwordsize < Int.max_unsigned) by reflexivity. omega.
  + apply eqm_sym; apply eqm_unsigned_repr.
  }
  intros. rewrite <- (repr_unsigned x) at 1. unfold one_bits'. rewrite REC.
  rewrite <- Z_one_bits_powerserie. auto. apply unsigned_range.
(* Goal: forall (i : Z) (_ : @In Z i (Z_one_bits wordsize (unsigned x) Z0)), Logic.and (Z.le Z0 i) (Z.lt i zwordsize) *)
  apply Z_one_bits_range.
Qed.

Lemma is_power2'_rng:
  forall n logn,
  is_power2' n = Some logn ->
  0 <= Int.unsigned logn < zwordsize.
Proof.
(* Goal: forall (n : int) (logn : Int.int) (_ : @Logic.eq (option Int.int) (is_power2' n) (@Some Int.int logn)), Logic.and (Z.le Z0 (Int.unsigned logn)) (Z.lt (Int.unsigned logn) zwordsize) *)
  unfold is_power2'; intros n logn P2.
(* Goal: Logic.and (Z.le Z0 (Int.unsigned logn)) (Z.lt (Int.unsigned logn) zwordsize) *)
  destruct (Z_one_bits wordsize (unsigned n) 0) as [ | i [ | ? ?]] eqn:B; inv P2.
(* Goal: Logic.and (Z.le Z0 i) (Z.le i Int.max_unsigned) *)
  assert (0 <= i < zwordsize).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { apply Z_one_bits_range with (unsigned n). rewrite B; auto with coqlib. }
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Int.unsigned_repr. auto.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (zwordsize < Int.max_unsigned) by reflexivity.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Theorem is_power2'_range:
  forall n logn,
  is_power2' n = Some logn -> Int.ltu logn iwordsize' = true.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold Int.ltu. change (Int.unsigned iwordsize') with zwordsize.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply zlt_true. generalize (is_power2'_rng _ _ H). tauto.
Qed.

Lemma is_power2'_correct:
  forall n logn,
  is_power2' n = Some logn ->
  unsigned n = two_p (Int.unsigned logn).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold is_power2'; intros.
(* Goal: @Logic.eq Z (unsigned n) (two_p (Int.unsigned logn)) *)
  destruct (Z_one_bits wordsize (unsigned n) 0) as [ | i [ | ? ?]] eqn:B; inv H.
(* Goal: @Logic.eq Z (unsigned n) (two_p (Int.unsigned (Int.repr i))) *)
  rewrite (Z_one_bits_powerserie (unsigned n)) by (apply unsigned_range).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.unsigned_repr. rewrite B; simpl. omega.
(* Goal: Logic.and (Z.le Z0 i) (Z.le i Int.max_unsigned) *)
  assert (0 <= i < zwordsize).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { apply Z_one_bits_range with (unsigned n). rewrite B; auto with coqlib. }
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (zwordsize < Int.max_unsigned) by reflexivity.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Theorem mul_pow2':
  forall x n logn,
  is_power2' n = Some logn ->
  mul x n = shl' x logn.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite shl'_mul. f_equal. rewrite shl'_one_two_p.
  rewrite <- (repr_unsigned n). f_equal. apply is_power2'_correct; auto.
Qed.

Theorem divu_pow2':
  forall x n logn,
  is_power2' n = Some logn ->
  divu x n = shru' x logn.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (is_power2'_correct n logn H). intro.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  symmetry. unfold divu. rewrite H0. unfold shru'. rewrite Zshiftr_div_two_p. auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  eapply is_power2'_rng; eauto.
Qed.

(** Decomposing 64-bit ints as pairs of 32-bit ints *)

Definition loword (n: int) : Int.int := Int.repr (unsigned n).

Definition hiword (n: int) : Int.int := Int.repr (unsigned (shru n (repr Int.zwordsize))).

Definition ofwords (hi lo: Int.int) : int :=
  or (shl (repr (Int.unsigned hi)) (repr Int.zwordsize)) (repr (Int.unsigned lo)).

Lemma bits_loword:
  forall n i, 0 <= i < Int.zwordsize -> Int.testbit (loword n) i = testbit n i.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold loword. rewrite Int.testbit_repr; auto.
Qed.

Lemma bits_hiword:
  forall n i, 0 <= i < Int.zwordsize -> Int.testbit (hiword n) i = testbit n (i + Int.zwordsize).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold hiword. rewrite Int.testbit_repr; auto.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity.
(* Goal: @Logic.eq bool (testbit (shru n (repr Int.zwordsize)) i) (testbit n (Z.add i Int.zwordsize)) *)
  fold (testbit (shru n (repr Int.zwordsize)) i). rewrite bits_shru.
(* Goal: @Logic.eq bool (orb (if zlt i (unsigned (repr Int.zwordsize)) then false else testbit (repr (Int.unsigned hi)) (Z.sub i (unsigned (repr Int.zwordsize)))) (testbit (repr (Int.unsigned lo)) i)) (if zlt i Int.zwordsize then Int.testbit lo i else Int.testbit hi (Z.sub i Int.zwordsize)) *)
  change (unsigned (repr Int.zwordsize)) with Int.zwordsize.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_true. omega. omega.
Qed.

Lemma bits_ofwords:
  forall hi lo i, 0 <= i < zwordsize ->
  testbit (ofwords hi lo) i =
  if zlt i Int.zwordsize then Int.testbit lo i else Int.testbit hi (i - Int.zwordsize).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold ofwords. rewrite bits_or; auto. rewrite bits_shl; auto.
(* Goal: @Logic.eq bool (orb (if zlt i (unsigned (repr Int.zwordsize)) then false else testbit (repr (Int.unsigned hi)) (Z.sub i (unsigned (repr Int.zwordsize)))) (testbit (repr (Int.unsigned lo)) i)) (if zlt i Int.zwordsize then Int.testbit lo i else Int.testbit hi (Z.sub i Int.zwordsize)) *)
  change (unsigned (repr Int.zwordsize)) with Int.zwordsize.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity.
(* Goal: @Logic.eq bool (if zlt i Int.zwordsize then Int.testbit (Int.shr xh (Int.sub y Int.iwordsize)) i else Int.testbit (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Z.sub i Int.zwordsize)) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
  destruct (zlt i Int.zwordsize).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite testbit_repr; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite !testbit_repr; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  fold (Int.testbit lo i). rewrite Int.bits_above. apply orb_false_r. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Lemma lo_ofwords:
  forall hi lo, loword (ofwords hi lo) = lo.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply Int.same_bits_eq; intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_loword; auto. rewrite bits_ofwords. apply zlt_true. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity. omega.
Qed.

Lemma hi_ofwords:
  forall hi lo, hiword (ofwords hi lo) = hi.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply Int.same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite bits_hiword; auto. rewrite bits_ofwords.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false. f_equal. omega. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity. omega.
Qed.

Lemma ofwords_recompose:
  forall n, ofwords (hiword n) (loword n) = n.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply same_bits_eq; intros. rewrite bits_ofwords; auto.
(* Goal: @Logic.eq bool (if zlt i Int.zwordsize then Int.testbit (Int.shr xh (Int.sub y Int.iwordsize)) i else Int.testbit (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Z.sub i Int.zwordsize)) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
  destruct (zlt i Int.zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply bits_loword. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_hiword. f_equal. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity. omega.
Qed.

Lemma ofwords_add:
  forall lo hi, ofwords hi lo = repr (Int.unsigned hi * two_p 32 + Int.unsigned lo).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold ofwords. rewrite shifted_or_is_add.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr. apply eqm_add. apply eqm_mult.
(* Goal: eqm (two_p (Int.unsigned y)) (unsigned (repr (two_p (Int.unsigned y)))) *)
(* Goal: Z.le Z0 (Int.unsigned y) *)
  apply eqm_sym; apply eqm_unsigned_repr.
(* Goal: eqm pl (Z.modulo p Int.modulus) *)
  apply eqm_refl.
(* Goal: eqm (two_p (Int.unsigned y)) (unsigned (repr (two_p (Int.unsigned y)))) *)
(* Goal: Z.le Z0 (Int.unsigned y) *)
  apply eqm_sym; apply eqm_unsigned_repr.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  change Int.zwordsize with 32; change zwordsize with 64; omega.
(* Goal: forall _ : Logic.and (Z.le Z0 (Int.unsigned lo)) (Z.lt (Int.unsigned lo) Int.modulus), Z.lt (Int.unsigned lo) (two_p Int.zwordsize) *)
(* Goal: Logic.and (Z.le Z0 (Int.unsigned lo)) (Z.le (Int.unsigned lo) max_unsigned) *)
  rewrite unsigned_repr. generalize (Int.unsigned_range lo). intros [A B]. exact B.
(* Goal: Logic.and (Z.le Z0 (Int.unsigned lo)) (Z.le (Int.unsigned lo) max_unsigned) *)
  assert (Int.max_unsigned < max_unsigned) by (compute; auto).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (Int.unsigned_range_2 lo); omega.
Qed.

Lemma ofwords_add':
  forall lo hi, unsigned (ofwords hi lo) = Int.unsigned hi * two_p 32 + Int.unsigned lo.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite ofwords_add. apply unsigned_repr.
(* Goal: Logic.and (Z.le Z0 (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo))) (Z.le (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)) max_unsigned) *)
  generalize (Int.unsigned_range hi) (Int.unsigned_range lo).
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  change (two_p 32) with Int.modulus.
(* Goal: forall (_ : Logic.and (Z.le Z0 (Int.unsigned xl)) (Z.lt (Int.unsigned xl) Int.modulus)) (_ : Logic.and (Z.le Z0 (Int.unsigned yl)) (Z.lt (Int.unsigned yl) Int.modulus)), @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) Int.modulus) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) Int.modulus) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  change Int.modulus with 4294967296.
(* Goal: forall (_ : Logic.and (Z.le Z0 (Int.unsigned hi)) (Z.lt (Int.unsigned hi) (Zpos (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO xH))))))))))))))))))))))))))))))))))) (_ : Logic.and (Z.le Z0 (Int.unsigned lo)) (Z.lt (Int.unsigned lo) (Zpos (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO xH))))))))))))))))))))))))))))))))))), Logic.and (Z.le Z0 (Z.add (Z.mul (Int.unsigned hi) (Zpos (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO xH)))))))))))))))))))))))))))))))))) (Int.unsigned lo))) (Z.le (Z.add (Z.mul (Int.unsigned hi) (Zpos (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO (xO xH)))))))))))))))))))))))))))))))))) (Int.unsigned lo)) max_unsigned) *)
  change max_unsigned with 18446744073709551615.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Remark eqm_mul_2p32:
  forall x y, Int.eqm x y -> eqm (x * two_p 32) (y * two_p 32).
Proof.
(* Goal: @Logic.eq Z (Z.mul x (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k modulus) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  intros. destruct H as [k EQ]. exists k. rewrite EQ.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k Int.modulus) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k modulus) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  change Int.modulus with (two_p 32).
  change modulus with (two_p 32 * two_p 32).
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  ring.
Qed.

Lemma ofwords_add'':
  forall lo hi, signed (ofwords hi lo) = Int.signed hi * two_p 32 + Int.unsigned lo.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite ofwords_add.
  replace (repr (Int.unsigned hi * two_p 32 + Int.unsigned lo))
     with (repr (Int.signed hi * two_p 32 + Int.unsigned lo)).
(* Goal: @Logic.eq Z (signed (repr (Z.add (Z.mul (Int.signed hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)))) (Z.add (Z.mul (Int.signed hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)) *)
(* Goal: @Logic.eq int (repr (Z.add (Z.mul (Int.signed hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo))) (repr (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo))) *)
  apply signed_repr.
(* Goal: Logic.and (Z.le min_signed (Z.add (Z.mul (Int.signed hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo))) (Z.le (Z.add (Z.mul (Int.signed hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo)) max_signed) *)
(* Goal: @Logic.eq int (repr (Z.add (Z.mul (Int.signed hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo))) (repr (Z.add (Z.mul (Int.unsigned hi) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned lo))) *)
  generalize (Int.signed_range hi) (Int.unsigned_range lo).
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  change (two_p 32) with Int.modulus.
  change min_signed with (Int.min_signed * Int.modulus).
  change max_signed with (Int.max_signed * Int.modulus + Int.modulus - 1).
(* Goal: forall (_ : Logic.and (Z.le Z0 (Int.unsigned xl)) (Z.lt (Int.unsigned xl) Int.modulus)) (_ : Logic.and (Z.le Z0 (Int.unsigned yl)) (Z.lt (Int.unsigned yl) Int.modulus)), @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) Int.modulus) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) Int.modulus) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  change Int.modulus with 4294967296.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr. apply eqm_add. apply eqm_mul_2p32. apply Int.eqm_signed_unsigned. apply eqm_refl.
Qed.

(** Expressing 64-bit operations in terms of 32-bit operations *)

Lemma decompose_bitwise_binop:
  forall f f64 f32 xh xl yh yl,
  (forall x y i, 0 <= i < zwordsize -> testbit (f64 x y) i = f (testbit x i) (testbit y i)) ->
  (forall x y i, 0 <= i < Int.zwordsize -> Int.testbit (f32 x y) i = f (Int.testbit x i) (Int.testbit y i)) ->
  f64 (ofwords xh xl) (ofwords yh yl) = ofwords (f32 xh yh) (f32 xl yl).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply Int64.same_bits_eq; intros.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite H by auto. rewrite ! bits_ofwords by auto.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct (zlt i Int.zwordsize); rewrite H0 by omega; auto.
Qed.

Lemma decompose_and:
  forall xh xl yh yl,
  and (ofwords xh xl) (ofwords yh yl) = ofwords (Int.and xh yh) (Int.and xl yl).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply decompose_bitwise_binop with andb.
(* Goal: forall (x y : int) (i : Z) (_ : Logic.and (Z.le Z0 i) (Z.lt i zwordsize)), @Logic.eq bool (testbit (and x y) i) (andb (testbit x i) (testbit y i)) *)
(* Goal: forall (x y : Int.int) (i : Z) (_ : Logic.and (Z.le Z0 i) (Z.lt i Int.zwordsize)), @Logic.eq bool (Int.testbit (Int.and x y) i) (andb (Int.testbit x i) (Int.testbit y i)) *)
  apply bits_and. apply Int.bits_and.
Qed.

Lemma decompose_or:
  forall xh xl yh yl,
  or (ofwords xh xl) (ofwords yh yl) = ofwords (Int.or xh yh) (Int.or xl yl).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply decompose_bitwise_binop with orb.
(* Goal: forall (x y : int) (i : Z) (_ : Logic.and (Z.le Z0 i) (Z.lt i zwordsize)), @Logic.eq bool (testbit (or x y) i) (orb (testbit x i) (testbit y i)) *)
(* Goal: forall (x y : Int.int) (i : Z) (_ : Logic.and (Z.le Z0 i) (Z.lt i Int.zwordsize)), @Logic.eq bool (Int.testbit (Int.or x y) i) (orb (Int.testbit x i) (Int.testbit y i)) *)
  apply bits_or. apply Int.bits_or.
Qed.

Lemma decompose_xor:
  forall xh xl yh yl,
  xor (ofwords xh xl) (ofwords yh yl) = ofwords (Int.xor xh yh) (Int.xor xl yl).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. apply decompose_bitwise_binop with xorb.
(* Goal: forall (x y : int) (i : Z) (_ : Logic.and (Z.le Z0 i) (Z.lt i zwordsize)), @Logic.eq bool (testbit (xor x y) i) (xorb (testbit x i) (testbit y i)) *)
(* Goal: forall (x y : Int.int) (i : Z) (_ : Logic.and (Z.le Z0 i) (Z.lt i Int.zwordsize)), @Logic.eq bool (Int.testbit (Int.xor x y) i) (xorb (Int.testbit x i) (Int.testbit y i)) *)
  apply bits_xor. apply Int.bits_xor.
Qed.

Lemma decompose_not:
  forall xh xl,
  not (ofwords xh xl) = ofwords (Int.not xh) (Int.not xl).
Proof.
  intros. unfold not, Int.not. rewrite <- decompose_xor. f_equal.
(* Goal: @Logic.eq int mone (ofwords Int.mone Int.mone) *)
  apply (Int64.eq_spec mone (ofwords Int.mone Int.mone)).
Qed.

Lemma decompose_shl_1:
  forall xh xl y,
  0 <= Int.unsigned y < Int.zwordsize ->
  shl' (ofwords xh xl) y =
  ofwords (Int.or (Int.shl xh y) (Int.shru xl (Int.sub Int.iwordsize y)))
          (Int.shl xl y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
  assert (Int.unsigned (Int.sub Int.iwordsize y) = Int.zwordsize - Int.unsigned y).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { unfold Int.sub. rewrite Int.unsigned_repr. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; omega. }
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply Int64.same_bits_eq; intros.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  rewrite bits_shl' by auto. symmetry. rewrite bits_ofwords by auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt i Int.zwordsize). rewrite Int.bits_shl by omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  destruct (zlt i (Int.unsigned y)). auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_ofwords by omega. rewrite zlt_true by omega. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. rewrite bits_ofwords by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_shru by omega. rewrite H0.
  destruct (zlt (i - Int.unsigned y) (Int.zwordsize)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true by omega. rewrite zlt_true by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite orb_false_l. f_equal. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. rewrite zlt_false by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite orb_false_r. f_equal. omega.
Qed.

Lemma decompose_shl_2:
  forall xh xl y,
  Int.zwordsize <= Int.unsigned y < zwordsize ->
  shl' (ofwords xh xl) y =
  ofwords (Int.shl xl (Int.sub y Int.iwordsize)) Int.zero.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity.
  assert (Int.unsigned (Int.sub y Int.iwordsize) = Int.unsigned y - Int.zwordsize).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { unfold Int.sub. rewrite Int.unsigned_repr. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). omega. }
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply Int64.same_bits_eq; intros.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  rewrite bits_shl' by auto. symmetry. rewrite bits_ofwords by auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt i Int.zwordsize). rewrite zlt_true by omega. apply Int.bits_zero.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_shl by omega.
(* Goal: @Logic.eq bool (if zlt (Z.sub i Int.zwordsize) (Int.unsigned (Int.sub y Int.iwordsize)) then false else Int.testbit xl (Z.sub (Z.sub i Int.zwordsize) (Int.unsigned (Int.sub y Int.iwordsize)))) (if zlt i (Int.unsigned y) then false else testbit (ofwords xh xl) (Z.sub i (Int.unsigned y))) *)
  destruct (zlt i (Int.unsigned y)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true by omega. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_ofwords by omega. rewrite zlt_true by omega. f_equal. omega.
Qed.

Lemma decompose_shru_1:
  forall xh xl y,
  0 <= Int.unsigned y < Int.zwordsize ->
  shru' (ofwords xh xl) y =
  ofwords (Int.shru xh y)
          (Int.or (Int.shru xl y) (Int.shl xh (Int.sub Int.iwordsize y))).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
  assert (Int.unsigned (Int.sub Int.iwordsize y) = Int.zwordsize - Int.unsigned y).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { unfold Int.sub. rewrite Int.unsigned_repr. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; omega. }
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply Int64.same_bits_eq; intros.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  rewrite bits_shru' by auto. symmetry. rewrite bits_ofwords by auto.
(* Goal: @Logic.eq bool (if zlt i Int.zwordsize then Int.testbit (Int.shr xh (Int.sub y Int.iwordsize)) i else Int.testbit (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Z.sub i Int.zwordsize)) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
  destruct (zlt i Int.zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_ofwords by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_shru by omega. rewrite H0.
  destruct (zlt (i + Int.unsigned y) (Int.zwordsize)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true by omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite orb_false_r. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite orb_false_l. f_equal. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_shru by omega.
  destruct (zlt (i + Int.unsigned y) zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_ofwords by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true by omega. rewrite zlt_false by omega. f_equal. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. auto.
Qed.

Lemma decompose_shru_2:
  forall xh xl y,
  Int.zwordsize <= Int.unsigned y < zwordsize ->
  shru' (ofwords xh xl) y =
  ofwords Int.zero (Int.shru xh (Int.sub y Int.iwordsize)).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity.
  assert (Int.unsigned (Int.sub y Int.iwordsize) = Int.unsigned y - Int.zwordsize).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { unfold Int.sub. rewrite Int.unsigned_repr. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). omega. }
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply Int64.same_bits_eq; intros.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  rewrite bits_shru' by auto. symmetry. rewrite bits_ofwords by auto.
(* Goal: @Logic.eq bool (if zlt i Int.zwordsize then Int.testbit (Int.shr xh (Int.sub y Int.iwordsize)) i else Int.testbit (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Z.sub i Int.zwordsize)) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
  destruct (zlt i Int.zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_shru by omega. rewrite H1.
  destruct (zlt (i + Int.unsigned y) zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true by omega. rewrite bits_ofwords by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. f_equal; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. apply Int.bits_zero.
Qed.

Lemma decompose_shr_1:
  forall xh xl y,
  0 <= Int.unsigned y < Int.zwordsize ->
  shr' (ofwords xh xl) y =
  ofwords (Int.shr xh y)
          (Int.or (Int.shru xl y) (Int.shl xh (Int.sub Int.iwordsize y))).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
  assert (Int.unsigned (Int.sub Int.iwordsize y) = Int.zwordsize - Int.unsigned y).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { unfold Int.sub. rewrite Int.unsigned_repr. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; omega. }
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply Int64.same_bits_eq; intros.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  rewrite bits_shr' by auto. symmetry. rewrite bits_ofwords by auto.
(* Goal: @Logic.eq bool (if zlt i Int.zwordsize then Int.testbit (Int.shr xh (Int.sub y Int.iwordsize)) i else Int.testbit (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Z.sub i Int.zwordsize)) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
  destruct (zlt i Int.zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_ofwords by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_shru by omega. rewrite H0.
  destruct (zlt (i + Int.unsigned y) (Int.zwordsize)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true by omega.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite orb_false_r. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite orb_false_l. f_equal. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_shr by omega.
  destruct (zlt (i + Int.unsigned y) zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_ofwords by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true by omega. rewrite zlt_false by omega. f_equal. omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. rewrite bits_ofwords by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. f_equal.
Qed.

Lemma decompose_shr_2:
  forall xh xl y,
  Int.zwordsize <= Int.unsigned y < zwordsize ->
  shr' (ofwords xh xl) y =
  ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one))
          (Int.shr xh (Int.sub y Int.iwordsize)).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  assert (zwordsize = 2 * Int.zwordsize) by reflexivity.
  assert (Int.unsigned (Int.sub y Int.iwordsize) = Int.unsigned y - Int.zwordsize).
(* Goal: @Logic.eq Z (Int.unsigned (Int.sub y Int.iwordsize)) (Z.sub (Int.unsigned y) Int.zwordsize) *)
(* Goal: @Logic.eq int (shr' (ofwords xh xl) y) (ofwords (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Int.shr xh (Int.sub y Int.iwordsize))) *)
  { unfold Int.sub. rewrite Int.unsigned_repr. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
    rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). omega. }
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  apply Int64.same_bits_eq; intros.
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  rewrite bits_shr' by auto. symmetry. rewrite bits_ofwords by auto.
(* Goal: @Logic.eq bool (if zlt i Int.zwordsize then Int.testbit (Int.shr xh (Int.sub y Int.iwordsize)) i else Int.testbit (Int.shr xh (Int.sub Int.iwordsize Int.one)) (Z.sub i Int.zwordsize)) (testbit (ofwords xh xl) (if zlt (Z.add i (Int.unsigned y)) zwordsize then Z.add i (Int.unsigned y) else Z.sub zwordsize (Zpos xH))) *)
  destruct (zlt i Int.zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_shr by omega. rewrite H1.
  destruct (zlt (i + Int.unsigned y) zwordsize).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_true by omega. rewrite bits_ofwords by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. f_equal; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. rewrite bits_ofwords by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite zlt_false by omega. auto.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite Int.bits_shr by omega.
  change (Int.unsigned (Int.sub Int.iwordsize Int.one)) with (Int.zwordsize - 1).
  destruct (zlt (i + Int.unsigned y) zwordsize);
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite bits_ofwords by omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  symmetry. rewrite zlt_false by omega. f_equal.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt (i - Int.zwordsize + (Int.zwordsize - 1)) Int.zwordsize); omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  symmetry. rewrite zlt_false by omega. f_equal.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  destruct (zlt (i - Int.zwordsize + (Int.zwordsize - 1)) Int.zwordsize); omega.
Qed.

Lemma decompose_add:
  forall xh xl yh yl,
  add (ofwords xh xl) (ofwords yh yl) =
  ofwords (Int.add (Int.add xh yh) (Int.add_carry xl yl Int.zero))
          (Int.add xl yl).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. symmetry. rewrite ofwords_add. rewrite add_unsigned.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr.
(* Goal: @Logic.eq bool (if zlt (unsigned (ofwords xh xl)) (unsigned (ofwords yh yl)) then true else false) (if Int.eq xh yh then Int.ltu xl yl else Int.ltu xh yh) *)
  rewrite ! ofwords_add'. rewrite (Int.unsigned_add_carry xl yl).
  set (cc := Int.add_carry xl yl Int.zero).
  set (Xl := Int.unsigned xl); set (Xh := Int.unsigned xh);
  set (Yl := Int.unsigned yl); set (Yh := Int.unsigned yh).
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k Int.modulus) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k modulus) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  change Int.modulus with (two_p 32).
  replace (Xh * two_p 32 + Xl + (Yh * two_p 32 + Yl))
     with ((Xh + Yh) * two_p 32 + (Xl + Yl)) by ring.
  replace (Int.unsigned (Int.add (Int.add xh yh) cc) * two_p 32 +
              (Xl + Yl - Int.unsigned cc * two_p 32))
     with ((Int.unsigned (Int.add (Int.add xh yh) cc) - Int.unsigned cc) * two_p 32
           + (Xl + Yl)) by ring.
(* Goal: eqm pl (Z.modulo p Int.modulus) *)
  apply eqm_add. 2: apply eqm_refl. apply eqm_mul_2p32.
  replace (Xh + Yh) with ((Xh + Yh + Int.unsigned cc) - Int.unsigned cc) by ring.
  apply Int.eqm_sub. 2: apply Int.eqm_refl.
  apply Int.eqm_unsigned_repr_l. apply Int.eqm_add. 2: apply Int.eqm_refl.
  apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl.
Qed.

Lemma decompose_sub:
  forall xh xl yh yl,
  sub (ofwords xh xl) (ofwords yh yl) =
  ofwords (Int.sub (Int.sub xh yh) (Int.sub_borrow xl yl Int.zero))
          (Int.sub xl yl).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. symmetry. rewrite ofwords_add.
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr.
(* Goal: @Logic.eq bool (if zlt (unsigned (ofwords xh xl)) (unsigned (ofwords yh yl)) then true else false) (if Int.eq xh yh then Int.ltu xl yl else Int.ltu xh yh) *)
  rewrite ! ofwords_add'. rewrite (Int.unsigned_sub_borrow xl yl).
  set (bb := Int.sub_borrow xl yl Int.zero).
  set (Xl := Int.unsigned xl); set (Xh := Int.unsigned xh);
  set (Yl := Int.unsigned yl); set (Yh := Int.unsigned yh).
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k Int.modulus) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k modulus) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  change Int.modulus with (two_p 32).
  replace (Xh * two_p 32 + Xl - (Yh * two_p 32 + Yl))
     with ((Xh - Yh) * two_p 32 + (Xl - Yl)) by ring.
  replace (Int.unsigned (Int.sub (Int.sub xh yh) bb) * two_p 32 +
              (Xl - Yl + Int.unsigned bb * two_p 32))
     with ((Int.unsigned (Int.sub (Int.sub xh yh) bb) + Int.unsigned bb) * two_p 32
           + (Xl - Yl)) by ring.
(* Goal: eqm pl (Z.modulo p Int.modulus) *)
  apply eqm_add. 2: apply eqm_refl. apply eqm_mul_2p32.
  replace (Xh - Yh) with ((Xh - Yh - Int.unsigned bb) + Int.unsigned bb) by ring.
  apply Int.eqm_add. 2: apply Int.eqm_refl.
  apply Int.eqm_unsigned_repr_l. apply Int.eqm_add. 2: apply Int.eqm_refl.
  apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl.
Qed.

Lemma decompose_sub':
  forall xh xl yh yl,
  sub (ofwords xh xl) (ofwords yh yl) =
  ofwords (Int.add (Int.add xh (Int.not yh)) (Int.add_carry xl (Int.not yl) Int.one))
          (Int.sub xl yl).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite decompose_sub. f_equal.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Int.sub_borrow_add_carry by auto.
(* Goal: @Logic.eq Int.int (Int.sub (Int.sub xh yh) (Int.xor (Int.add_carry xl (Int.not yl) (Int.xor Int.zero Int.one)) Int.one)) (Int.add (Int.add xh (Int.not yh)) (Int.add_carry xl (Int.not yl) Int.one)) *)
  rewrite Int.sub_add_not_3. rewrite Int.xor_assoc. rewrite Int.xor_idem.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Int.xor_zero. auto.
(* Goal: Logic.or (@Logic.eq Int.int (Int.xor (Int.add_carry xl (Int.not yl) (Int.xor Int.zero Int.one)) Int.one) Int.zero) (@Logic.eq Int.int (Int.xor (Int.add_carry xl (Int.not yl) (Int.xor Int.zero Int.one)) Int.one) Int.one) *)
  rewrite Int.xor_zero_l. unfold Int.add_carry.
  destruct (zlt (Int.unsigned xl + Int.unsigned (Int.not yl) + Int.unsigned Int.one) Int.modulus);
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  compute; [right|left]; apply Int.mkint_eq; auto.
Qed.

Definition mul' (x y: Int.int) : int := repr (Int.unsigned x * Int.unsigned y).

Lemma mul'_mulhu:
  forall x y, mul' x y = ofwords (Int.mulhu x y) (Int.mul x y).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: @Logic.eq int (mul' x y) (ofwords (Int.mulhu x y) (Int.mul x y)) *)
  rewrite ofwords_add. unfold mul', Int.mulhu, Int.mul.
  set (p := Int.unsigned x * Int.unsigned y).
(* Goal: @Logic.eq int (repr p) (repr (Z.add (Z.mul (Int.unsigned (Int.repr (Z.div p Int.modulus))) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  set (ph := p / Int.modulus). set (pl := p mod Int.modulus).
  transitivity (repr (ph * Int.modulus + pl)).
- f_equal. rewrite Z.mul_comm. apply Z_div_mod_eq. apply Int.modulus_pos.
- apply eqm_samerepr. apply eqm_add. apply eqm_mul_2p32. auto with ints.
(* Goal: eqm pl (Z.modulo p Int.modulus) *)
  rewrite Int.unsigned_repr_eq. apply eqm_refl.
Qed.

Lemma decompose_mul:
  forall xh xl yh yl,
  mul (ofwords xh xl) (ofwords yh yl) =
  ofwords (Int.add (Int.add (hiword (mul' xl yl)) (Int.mul xl yh)) (Int.mul xh yl))
          (loword (mul' xl yl)).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
  set (pl := loword (mul' xl yl)); set (ph := hiword (mul' xl yl)).
  assert (EQ0: unsigned (mul' xl yl) = Int.unsigned ph * two_p 32 + Int.unsigned pl).
  { rewrite <- (ofwords_recompose (mul' xl yl)). apply ofwords_add'. }
(* Goal: @Logic.eq bool (Int.testbit xh (if zlt (Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH))) Int.zwordsize then Z.add (Z.sub i Int.zwordsize) (Z.sub Int.zwordsize (Zpos xH)) else Z.sub Int.zwordsize (Zpos xH))) (if zlt (Z.sub zwordsize (Zpos xH)) Int.zwordsize then Int.testbit xl (Z.sub zwordsize (Zpos xH)) else Int.testbit xh (Z.sub (Z.sub zwordsize (Zpos xH)) Int.zwordsize)) *)
  symmetry. rewrite ofwords_add. unfold mul. rewrite !ofwords_add'.
  set (XL := Int.unsigned xl); set (XH := Int.unsigned xh);
  set (YL := Int.unsigned yl); set (YH := Int.unsigned yh).
  set (PH := Int.unsigned ph) in *. set (PL := Int.unsigned pl) in *.
  transitivity (repr (((PH + XL * YH) + XH * YL) * two_p 32 + PL)).
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr. apply eqm_add. 2: apply eqm_refl.
(* Goal: eqm (Z.mul ph Int.modulus) (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) *)
(* Goal: eqm pl (Int.unsigned (Int.repr p)) *)
  apply eqm_mul_2p32.
  rewrite Int.add_unsigned. apply Int.eqm_unsigned_repr_l. apply Int.eqm_add.
  rewrite Int.add_unsigned. apply Int.eqm_unsigned_repr_l. apply Int.eqm_add.
  apply Int.eqm_refl.
  unfold Int.mul. apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl.
  unfold Int.mul. apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl.
  transitivity (repr (unsigned (mul' xl yl) + (XL * YH + XH * YL) * two_p 32)).
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  rewrite EQ0. f_equal. ring.
  transitivity (repr ((XL * YL + (XL * YH + XH * YL) * two_p 32))).
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr. apply eqm_add. 2: apply eqm_refl.
(* Goal: eqm (unsigned (repr (two_p (unsigned (repr n))))) (two_p n) *)
  unfold mul'. apply eqm_unsigned_repr_l. apply eqm_refl.
  transitivity (repr (0 + (XL * YL + (XL * YH + XH * YL) * two_p 32))).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite Z.add_0_l; auto.
  transitivity (repr (XH * YH * (two_p 32 * two_p 32) + (XL * YL + (XL * YH + XH * YL) * two_p 32))).
(* Goal: @Logic.eq int (repr (Z.add (Z.mul ph Int.modulus) pl)) (repr (Z.add (Z.mul (Int.unsigned (Int.repr ph)) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned (Int.repr p)))) *)
  apply eqm_samerepr. apply eqm_add. 2: apply eqm_refl.
  change (two_p 32 * two_p 32) with modulus. exists (- XH * YH). ring.
(* Goal: @Logic.eq Z (Z.mul (Z.add (Z.mul k (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) y) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Z.add (Z.mul k (Z.mul (two_p (Zpos (xO (xO (xO (xO (xO xH))))))) (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) (Z.mul y (two_p (Zpos (xO (xO (xO (xO (xO xH))))))))) *)
  f_equal. ring.
Qed.

Lemma decompose_mul_2:
  forall xh xl yh yl,
  mul (ofwords xh xl) (ofwords yh yl) =
  ofwords (Int.add (Int.add (Int.mulhu xl yl) (Int.mul xl yh)) (Int.mul xh yl))
          (Int.mul xl yl).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite decompose_mul. rewrite mul'_mulhu.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite hi_ofwords, lo_ofwords. auto.
Qed.

Lemma decompose_ltu:
  forall xh xl yh yl,
  ltu (ofwords xh xl) (ofwords yh yl) = if Int.eq xh yh then Int.ltu xl yl else Int.ltu xh yh.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold ltu. rewrite ! ofwords_add'. unfold Int.ltu, Int.eq.
(* Goal: @Logic.eq bool (negb (if if zeq (Int.unsigned xh) (Int.unsigned yh) then true else false then Int.ltu yl xl else Int.ltu yh xh)) (if if zeq (Int.unsigned xh) (Int.unsigned yh) then true else false then negb (Int.ltu yl xl) else Int.ltu xh yh) *)
  destruct (zeq (Int.unsigned xh) (Int.unsigned yh)).
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.ltu xl yl) *)
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  rewrite e. destruct (zlt (Int.unsigned xl) (Int.unsigned yl)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_true; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_false; omega.
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  change (two_p 32) with Int.modulus.
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) Int.modulus) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) Int.modulus) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  generalize (Int.unsigned_range xl) (Int.unsigned_range yl).
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  change Int.modulus with 4294967296. intros.
(* Goal: @Logic.eq bool (negb (if zlt (Int.unsigned yh) (Int.unsigned xh) then true else false)) (if zlt (Int.unsigned xh) (Int.unsigned yh) then true else false) *)
  destruct (zlt (Int.unsigned xh) (Int.unsigned yh)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_true; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_false; omega.
Qed.

Lemma decompose_leu:
  forall xh xl yh yl,
  negb (ltu (ofwords yh yl) (ofwords xh xl)) =
  if Int.eq xh yh then negb (Int.ltu yl xl) else Int.ltu xh yh.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite decompose_ltu. rewrite Int.eq_sym.
(* Goal: @Logic.eq bool (negb (if if zeq (Int.unsigned xh) (Int.unsigned yh) then true else false then Int.ltu yl xl else Int.ltu yh xh)) (if if zeq (Int.unsigned xh) (Int.unsigned yh) then true else false then negb (Int.ltu yl xl) else Int.ltu xh yh) *)
  unfold Int.eq. destruct (zeq (Int.unsigned xh) (Int.unsigned yh)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.ltu xl yl) *)
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  unfold Int.ltu. destruct (zlt (Int.unsigned xh) (Int.unsigned yh)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite zlt_false by omega; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite zlt_true by omega; auto.
Qed.

Lemma decompose_lt:
  forall xh xl yh yl,
  lt (ofwords xh xl) (ofwords yh yl) = if Int.eq xh yh then Int.ltu xl yl else Int.lt xh yh.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold lt. rewrite ! ofwords_add''. rewrite Int.eq_signed.
(* Goal: @Logic.eq bool (negb (if if zeq (Int.signed xh) (Int.signed yh) then true else false then Int.ltu yl xl else Int.lt yh xh)) (if if zeq (Int.signed xh) (Int.signed yh) then true else false then negb (Int.ltu yl xl) else Int.lt xh yh) *)
  destruct (zeq (Int.signed xh) (Int.signed yh)).
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.ltu xl yl) *)
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  rewrite e. unfold Int.ltu. destruct (zlt (Int.unsigned xl) (Int.unsigned yl)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_true; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_false; omega.
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) (two_p (Zpos (xO (xO (xO (xO (xO xH)))))))) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  change (two_p 32) with Int.modulus.
(* Goal: @Logic.eq bool (if zlt (Z.add (Z.mul (Int.signed xh) Int.modulus) (Int.unsigned xl)) (Z.add (Z.mul (Int.signed yh) Int.modulus) (Int.unsigned yl)) then true else false) (Int.lt xh yh) *)
  generalize (Int.unsigned_range xl) (Int.unsigned_range yl).
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  change Int.modulus with 4294967296. intros.
(* Goal: @Logic.eq bool (negb (Int.lt yh xh)) (Int.lt xh yh) *)
  unfold Int.lt. destruct (zlt (Int.signed xh) (Int.signed yh)).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_true; omega.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  apply zlt_false; omega.
Qed.

Lemma decompose_le:
  forall xh xl yh yl,
  negb (lt (ofwords yh yl) (ofwords xh xl)) =
  if Int.eq xh yh then negb (Int.ltu yl xl) else Int.lt xh yh.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite decompose_lt. rewrite Int.eq_sym.
(* Goal: @Logic.eq bool (negb (if Int.eq xh yh then Int.ltu yl xl else Int.lt yh xh)) (if Int.eq xh yh then negb (Int.ltu yl xl) else Int.lt xh yh) *)
  rewrite Int.eq_signed. destruct (zeq (Int.signed xh) (Int.signed yh)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  auto.
(* Goal: @Logic.eq bool (negb (Int.lt yh xh)) (Int.lt xh yh) *)
  unfold Int.lt. destruct (zlt (Int.signed xh) (Int.signed yh)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite zlt_false by omega; auto.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite zlt_true by omega; auto.
Qed.

(** Utility proofs for mixed 32bit and 64bit arithmetic *)

Remark int_unsigned_range:
  forall x, 0 <= Int.unsigned x <= max_unsigned.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros.
(* Goal: Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub modulus (Zpos xH))) *)
  unfold max_unsigned. unfold modulus.
(* Goal: Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub (two_power_nat wordsize) (Zpos xH))) *)
  generalize (Int.unsigned_range x).
  unfold Int.modulus in *.
  change (wordsize) with  64%nat in *.
  change (Int.wordsize) with 32%nat in *.
(* Goal: forall _ : Logic.and (Z.le Z0 (Int.unsigned x)) (Z.lt (Int.unsigned x) (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))) xH))), Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) (Z.sub (Zpos (shift_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) xH)) (Zpos xH))) *)
  unfold two_power_nat. simpl.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
Qed.

Remark int_unsigned_repr:
  forall x, unsigned (repr (Int.unsigned x)) = Int.unsigned x.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. rewrite unsigned_repr. auto.
(* Goal: Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) max_unsigned) *)
  apply int_unsigned_range.
Qed.

Lemma int_sub_ltu:
  forall x y,
    Int.ltu x y= true ->
    Int.unsigned (Int.sub y x) = unsigned (sub (repr (Int.unsigned y)) (repr (Int.unsigned x))).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. generalize (Int.sub_ltu x y H). intros. unfold Int.sub. unfold sub.
(* Goal: @Logic.eq Int64.int (Int64.repr (unsigned (repr (Int64.unsigned n)))) n *)
  rewrite Int.unsigned_repr. rewrite unsigned_repr.
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  rewrite unsigned_repr by apply int_unsigned_range. rewrite int_unsigned_repr. reflexivity.
(* Goal: Logic.and (Z.le Z0 (Int.unsigned x)) (Z.le (Int.unsigned x) max_unsigned) *)
  rewrite unsigned_repr by apply int_unsigned_range.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (unsigned (repr (Int.unsigned x))))) (Z.le (Z.sub (Int.unsigned y) (unsigned (repr (Int.unsigned x)))) max_unsigned) *)
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  rewrite int_unsigned_repr. generalize (int_unsigned_range y).
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  omega.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  generalize (Int.sub_ltu x y H). intros.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  generalize (Int.unsigned_range_2 y). intros. omega.
Qed.

End Int64.

Strategy 0 [Wordsize_64.wordsize].

Notation int64 := Int64.int.

Global Opaque Int.repr Int64.repr Byte.repr.

(** * Specialization to offsets in pointer values *)

Module Wordsize_Ptrofs.
  Definition wordsize := if Archi.ptr64 then 64%nat else 32%nat.
  Remark wordsize_not_zero: wordsize <> 0%nat.
  Proof. unfold wordsize; destruct Archi.ptr64; congruence. Qed.
End Wordsize_Ptrofs.

Strategy opaque [Wordsize_Ptrofs.wordsize].

Module Ptrofs.

Include Make(Wordsize_Ptrofs).

Definition to_int (x: int): Int.int := Int.repr (unsigned x).

Definition to_int64 (x: int): Int64.int := Int64.repr (unsigned x).

Definition of_int (x: Int.int) : int := repr (Int.unsigned x).

Definition of_intu := of_int.

Definition of_ints (x: Int.int) : int := repr (Int.signed x).

Definition of_int64 (x: Int64.int) : int := repr (Int64.unsigned x).

Definition of_int64u := of_int64.

Definition of_int64s (x: Int64.int) : int := repr (Int64.signed x).

Section AGREE32.

Hypothesis _32: Archi.ptr64 = false.

Lemma modulus_eq32: modulus = Int.modulus.
Proof.
(* Goal: @Logic.eq Z modulus Int64.modulus *)
  unfold modulus, wordsize.
(* Goal: @Logic.eq Z (two_power_nat Wordsize_Ptrofs.wordsize) Int64.modulus *)
  change Wordsize_Ptrofs.wordsize with (if Archi.ptr64 then 64%nat else 32%nat).
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  rewrite _32. reflexivity.
Qed.

Lemma eqm32:
  forall x y, Int.eqm x y <-> eqm x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold Int.eqm, eqm. rewrite modulus_eq32; tauto.
Qed.

Definition agree32 (a: Ptrofs.int) (b: Int.int) : Prop :=
  Ptrofs.unsigned a = Int.unsigned b.

Lemma agree32_repr:
  forall i, agree32 (Ptrofs.repr i) (Int.repr i).
Proof.
(* Goal: forall i : Z, agree64 (repr i) (Int64.repr i) *)
  intros; red. rewrite Ptrofs.unsigned_repr_eq, Int.unsigned_repr_eq.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply f_equal2. auto. apply modulus_eq32.
Qed.

Lemma agree32_signed:
  forall a b, agree32 a b -> Ptrofs.signed a = Int.signed b.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree32; intros. unfold signed, Int.signed, half_modulus, Int.half_modulus.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite modulus_eq32. rewrite H. auto.
Qed.

Lemma agree32_of_int:
  forall b, agree32 (of_int b) b.
Proof.
  unfold of_int; intros. rewrite <- (Int.repr_unsigned b) at 2. apply agree32_repr.
Qed.

Lemma agree32_of_ints:
  forall b, agree32 (of_ints b) b.
Proof.
  unfold of_int; intros. rewrite <- (Int.repr_signed b) at 2. apply agree32_repr.
Qed.

Lemma agree32_of_int_eq:
  forall a b, agree32 a b -> of_int b = a.
Proof.
  unfold agree32, of_int; intros. rewrite <- H. apply repr_unsigned.
Qed.

Lemma agree32_of_ints_eq:
  forall a b, agree32 a b -> of_ints b = a.
Proof.
  unfold of_ints; intros. erewrite <- agree32_signed by eauto. apply repr_signed.
Qed.

Lemma agree32_to_int:
  forall a, agree32 a (to_int a).
Proof.
  unfold agree32, to_int; intros. rewrite <- (agree32_repr (unsigned a)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite repr_unsigned; auto.
Qed.

Lemma agree32_to_int_eq:
  forall a b, agree32 a b -> to_int a = b.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree32, to_int; intros. rewrite H. apply Int.repr_unsigned.
Qed.

Lemma agree32_neg:
  forall a1 b1, agree32 a1 b1 -> agree32 (Ptrofs.neg a1) (Int.neg b1).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree32, Ptrofs.neg, Int.neg; intros. rewrite H. apply agree32_repr.
Qed.

Lemma agree32_add:
  forall a1 b1 a2 b2,
  agree32 a1 b1 -> agree32 a2 b2 -> agree32 (Ptrofs.add a1 a2) (Int.add b1 b2).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree32, Ptrofs.add, Int.add; intros. rewrite H, H0. apply agree32_repr.
Qed.

Lemma agree32_sub:
  forall a1 b1 a2 b2,
  agree32 a1 b1 -> agree32 a2 b2 -> agree32 (Ptrofs.sub a1 a2) (Int.sub b1 b2).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree32, Ptrofs.sub, Int.sub; intros. rewrite H, H0. apply agree32_repr.
Qed.

Lemma agree32_mul:
  forall a1 b1 a2 b2,
  agree32 a1 b1 -> agree32 a2 b2 -> agree32 (Ptrofs.mul a1 a2) (Int.mul b1 b2).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree32, Ptrofs.mul, Int.mul; intros. rewrite H, H0. apply agree32_repr.
Qed.

Lemma agree32_divs:
  forall a1 b1 a2 b2,
  agree32 a1 b1 -> agree32 a2 b2 -> agree32 (Ptrofs.divs a1 a2) (Int.divs b1 b2).
Proof.
(* Goal: forall (a1 : int) (b1 : Int.int) (a2 : int) (b2 : Int.int) (_ : agree32 a1 b1) (_ : agree32 a2 b2), agree32 (divs a1 a2) (Int.divs b1 b2) *)
  intros; unfold agree32, Ptrofs.divs, Int.divs.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  erewrite ! agree32_signed by eauto. apply agree32_repr.
Qed.

Lemma of_int_to_int:
  forall n, of_int (to_int n) = n.
Proof.
  intros; unfold of_int, to_int. apply eqm_repr_eq. rewrite <- eqm32.
(* Goal: Int.eqm (Int.unsigned (Int.repr (unsigned n))) (unsigned n) *)
  apply Int.eqm_sym; apply Int.eqm_unsigned_repr.
Qed.

Lemma to_int_of_int:
  forall n, to_int (of_int n) = n.
Proof.
(* Goal: @Logic.eq Int64.int (Int64.repr (unsigned (repr (Int64.unsigned n)))) n *)
  intros; unfold of_int, to_int. rewrite unsigned_repr. apply Int.repr_unsigned.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold max_unsigned. rewrite modulus_eq32. destruct (Int.unsigned_range n); omega.
Qed.

End AGREE32.

Section AGREE64.

Hypothesis _64: Archi.ptr64 = true.

Lemma modulus_eq64: modulus = Int64.modulus.
Proof.
(* Goal: @Logic.eq Z modulus Int64.modulus *)
  unfold modulus, wordsize.
(* Goal: @Logic.eq Z (two_power_nat Wordsize_Ptrofs.wordsize) Int64.modulus *)
  change Wordsize_Ptrofs.wordsize with (if Archi.ptr64 then 64%nat else 32%nat).
(* Goal: @Logic.eq Z (two_power_nat (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) Int64.modulus *)
  rewrite _64. reflexivity.
Qed.

Lemma eqm64:
  forall x y, Int64.eqm x y <-> eqm x y.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  intros. unfold Int64.eqm, eqm. rewrite modulus_eq64; tauto.
Qed.

Definition agree64 (a: Ptrofs.int) (b: Int64.int) : Prop :=
  Ptrofs.unsigned a = Int64.unsigned b.

Lemma agree64_repr:
  forall i, agree64 (Ptrofs.repr i) (Int64.repr i).
Proof.
(* Goal: forall i : Z, agree64 (repr i) (Int64.repr i) *)
  intros; red. rewrite Ptrofs.unsigned_repr_eq, Int64.unsigned_repr_eq.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  apply f_equal2. auto. apply modulus_eq64.
Qed.

Lemma agree64_signed:
  forall a b, agree64 a b -> Ptrofs.signed a = Int64.signed b.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree64; intros. unfold signed, Int64.signed, half_modulus, Int64.half_modulus.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite modulus_eq64. rewrite H. auto.
Qed.

Lemma agree64_of_int:
  forall b, agree64 (of_int64 b) b.
Proof.
  unfold of_int64; intros. rewrite <- (Int64.repr_unsigned b) at 2. apply agree64_repr.
Qed.

Lemma agree64_of_int_eq:
  forall a b, agree64 a b -> of_int64 b = a.
Proof.
  unfold agree64, of_int64; intros. rewrite <- H. apply repr_unsigned.
Qed.

Lemma agree64_to_int:
  forall a, agree64 a (to_int64 a).
Proof.
  unfold agree64, to_int64; intros. rewrite <- (agree64_repr (unsigned a)).
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  rewrite repr_unsigned; auto.
Qed.

Lemma agree64_to_int_eq:
  forall a b, agree64 a b -> to_int64 a = b.
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree64, to_int64; intros. rewrite H. apply Int64.repr_unsigned.
Qed.

Lemma agree64_neg:
  forall a1 b1, agree64 a1 b1 -> agree64 (Ptrofs.neg a1) (Int64.neg b1).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree64, Ptrofs.neg, Int64.neg; intros. rewrite H. apply agree64_repr.
Qed.

Lemma agree64_add:
  forall a1 b1 a2 b2,
  agree64 a1 b1 -> agree64 a2 b2 -> agree64 (Ptrofs.add a1 a2) (Int64.add b1 b2).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree64, Ptrofs.add, Int.add; intros. rewrite H, H0. apply agree64_repr.
Qed.

Lemma agree64_sub:
  forall a1 b1 a2 b2,
  agree64 a1 b1 -> agree64 a2 b2 -> agree64 (Ptrofs.sub a1 a2) (Int64.sub b1 b2).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree64, Ptrofs.sub, Int.sub; intros. rewrite H, H0. apply agree64_repr.
Qed.

Lemma agree64_mul:
  forall a1 b1 a2 b2,
  agree64 a1 b1 -> agree64 a2 b2 -> agree64 (Ptrofs.mul a1 a2) (Int64.mul b1 b2).
Proof.
(* Goal: forall x y : Z, iff (Int64.eqm x y) (eqm x y) *)
  unfold agree64, Ptrofs.mul, Int.mul; intros. rewrite H, H0. apply agree64_repr.
Qed.

Lemma agree64_divs:
  forall a1 b1 a2 b2,
  agree64 a1 b1 -> agree64 a2 b2 -> agree64 (Ptrofs.divs a1 a2) (Int64.divs b1 b2).
Proof.
(* Goal: forall (a1 : int) (b1 : Int64.int) (a2 : int) (b2 : Int64.int) (_ : agree64 a1 b1) (_ : agree64 a2 b2), agree64 (divs a1 a2) (Int64.divs b1 b2) *)
  intros; unfold agree64, Ptrofs.divs, Int64.divs.
(* Goal: @Logic.eq Z (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) (if zlt (Int64.unsigned b) (Z.div Int64.modulus (Zpos (xO xH))) then Int64.unsigned b else Z.sub (Int64.unsigned b) Int64.modulus) *)
  erewrite ! agree64_signed by eauto. apply agree64_repr.
Qed.

Lemma of_int64_to_int64:
  forall n, of_int64 (to_int64 n) = n.
Proof.
  intros; unfold of_int64, to_int64. apply eqm_repr_eq. rewrite <- eqm64.
(* Goal: Int64.eqm (Int64.unsigned (Int64.repr (unsigned n))) (unsigned n) *)
  apply Int64.eqm_sym; apply Int64.eqm_unsigned_repr.
Qed.

Lemma to_int64_of_int64:
  forall n, to_int64 (of_int64 n) = n.
Proof.
(* Goal: @Logic.eq Int64.int (Int64.repr (unsigned (repr (Int64.unsigned n)))) n *)
  intros; unfold of_int64, to_int64. rewrite unsigned_repr. apply Int64.repr_unsigned.
(* Goal: Logic.and (Z.le Z0 (Z.sub (Int.unsigned y) (Int.unsigned x))) (Z.le (Z.sub (Int.unsigned y) (Int.unsigned x)) Int.max_unsigned) *)
  unfold max_unsigned. rewrite  modulus_eq64. destruct (Int64.unsigned_range n); omega.
Qed.

End AGREE64.

Hint Resolve
  agree32_repr agree32_of_int agree32_of_ints agree32_of_int_eq agree32_of_ints_eq
  agree32_to_int agree32_to_int_eq agree32_neg agree32_add agree32_sub agree32_mul agree32_divs
  agree64_repr agree64_of_int agree64_of_int_eq
  agree64_to_int agree64_to_int_eq agree64_neg agree64_add agree64_sub agree64_mul agree64_divs : ptrofs.

End Ptrofs.

Strategy 0 [Wordsize_Ptrofs.wordsize].

Notation ptrofs := Ptrofs.int.

Global Opaque Ptrofs.repr.

Hint Resolve Int.modulus_pos Int.eqm_refl Int.eqm_refl2 Int.eqm_sym Int.eqm_trans
  Int.eqm_small_eq Int.eqm_add Int.eqm_neg Int.eqm_sub Int.eqm_mult
  Int.eqm_unsigned_repr Int.eqm_unsigned_repr_l Int.eqm_unsigned_repr_r
  Int.unsigned_range Int.unsigned_range_2
  Int.repr_unsigned Int.repr_signed Int.unsigned_repr : ints.

Hint Resolve Int64.modulus_pos Int64.eqm_refl Int64.eqm_refl2 Int64.eqm_sym Int64.eqm_trans
  Int64.eqm_small_eq Int64.eqm_add Int64.eqm_neg Int64.eqm_sub Int64.eqm_mult
  Int64.eqm_unsigned_repr Int64.eqm_unsigned_repr_l Int64.eqm_unsigned_repr_r
  Int64.unsigned_range Int64.unsigned_range_2
  Int64.repr_unsigned Int64.repr_signed Int64.unsigned_repr : ints.

Hint Resolve Ptrofs.modulus_pos Ptrofs.eqm_refl Ptrofs.eqm_refl2 Ptrofs.eqm_sym Ptrofs.eqm_trans
  Ptrofs.eqm_small_eq Ptrofs.eqm_add Ptrofs.eqm_neg Ptrofs.eqm_sub Ptrofs.eqm_mult
  Ptrofs.eqm_unsigned_repr Ptrofs.eqm_unsigned_repr_l Ptrofs.eqm_unsigned_repr_r
  Ptrofs.unsigned_range Ptrofs.unsigned_range_2
  Ptrofs.repr_unsigned Ptrofs.repr_signed Ptrofs.unsigned_repr : ints.

