(********************************************************************)
(*                                                                  *)
(*  The Why3 Verification Platform   /   The Why3 Development Team  *)
(*  Copyright 2010-2019   --   Inria - CNRS - Paris-Sud University  *)
(*                                                                  *)
(*  This software is distributed under the terms of the GNU Lesser  *)
(*  General Public License version 2.1, with the special exception  *)
(*  on linking described in file LICENSE.                           *)
(*                                                                  *)
(********************************************************************)

(* This file is generated by Why3's Coq-realize driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require bool.Bool.
Require int.Int.
Require int.Abs.
Require int.EuclideanDivision.
Require bv.Pow2int.

Local Parameter last_bit : nat.
(* Important notice: do not remove 'Local' above, otherwise 'why3 realize' will
   assume it comes from Why3 and will remove it. We use 'Parameter' instead of
  'Variable' to avoid a Coq warning *)

Definition size_nat: nat := S last_bit.

(* Why3 goal *)
Definition size : Numbers.BinNums.Z.
  exact (Z.of_nat size_nat).
Defined.

Lemma size_int_S : size = Z.succ (Z.of_nat last_bit).
  unfold size, size_nat.
  rewrite Nat2Z.inj_succ; trivial.
Qed.

(* Why3 goal *)
Lemma size_pos : (0%Z < size)%Z.
  rewrite size_int_S; omega.
Qed.

Require Import Bool.Bvector.

(* Why3 goal *)
Definition t : Type.
  exact (Bvector size_nat).
Defined.

Fixpoint nth_aux {l} (v : Vector.t bool l) (m : Z) : bool :=
  match v with
    | Vector.nil _ => false
    | Vector.cons _ b _ tl => if Z_eq_dec m 0 then b else nth_aux tl (Z.pred m)
  end.

(* nth helper lemmas *)

Lemma nth_cons {l} (v : Vector.t bool l) (m : Z) b : (m <> -1)%Z ->
  nth_aux (Vector.cons bool b l v) (Z.succ m) = nth_aux v m.
  intro; simpl.
  case Z.eq_dec; intro.
  assert False by omega; easy.
  rewrite <- Zpred_succ; easy.
Qed.

Lemma nth_cons_pred {l} (v : Vector.t bool l) (m : Z) b : (m <> 0)%Z ->
  nth_aux (Vector.cons bool b l v) m = nth_aux v (Z.pred m).
  intro.
  rewrite Zsucc_pred with (n := m), <- Zpred_succ; apply nth_cons; omega.
Qed.

Lemma nth_high : forall {l} (v : Vector.t bool l) m, (m >= (Z.of_nat l))%Z -> nth_aux v m = false.
  induction v.
  easy.
  rewrite Nat2Z.inj_succ.
  intros; rewrite nth_cons_pred by omega.
  apply IHv; omega.
Qed.

Lemma nth_low : forall {l} (v : Vector.t bool l) m, (m < 0)%Z -> nth_aux v m = false.
  induction v.
  easy.
  intros; rewrite nth_cons_pred by omega.
  apply IHv; omega.
Qed.

Lemma nth_zeros_is_hd : forall {l} (b : Vector.t bool (S l)), nth_aux b 0 = Vector.hd b.
  apply Vector.rectS; easy.
Qed.

Lemma nth_predl_is_last : forall {l} (b : Vector.t bool (S l)), nth_aux b (Z.of_nat l) = Vector.last b.
  apply Vector.rectS.
  easy.
  intros.
  rewrite Nat2Z.inj_succ, nth_cons by omega.
  easy.
Qed.

Lemma nth_const {l} (m : Z) b: (0 <= m < Z.of_nat l)%Z -> nth_aux (Vector.const b l) m = b.
  revert b m.
  induction l.
  simpl.
  intros; assert False by omega; easy.
  rewrite Nat2Z.inj_succ; intros; simpl.
  case (Z.eq_dec m 0); intro.
  easy.
  apply IHl; omega.
Qed.

Lemma nth_aux_map : forall {l} (f : bool -> bool) (v : Vector.t bool l) m,
                       (0 <= m < Z.of_nat l)%Z ->
                       f (nth_aux v m) = nth_aux (Vector.map f v) m.
  induction v.
  simpl; intros; assert False by omega; easy.
  rewrite Nat2Z.inj_succ; intros; simpl.
  case (Z.eq_dec m 0); intro.
  easy.
  apply IHv; omega.
Qed.

Lemma nth_aux_map2 : forall {l} (f : bool -> bool -> bool) (v1 v2 : Vector.t bool l) m,
                       (0 <= m < Z.of_nat l)%Z ->
                       f (nth_aux v1 m) (nth_aux v2 m) = nth_aux (Vector.map2 f v1 v2) m.
  intros l f v1 v2; pattern l, v1, v2.
  apply Vector.rect2.
  simpl; intros; assert False by omega; easy.
  intros.
  rewrite Nat2Z.inj_succ in H0; simpl.
  case (Z.eq_dec m 0); intro.
  easy.
  apply H; omega.
Qed.

Lemma nth_aux_tl : forall {l} (v : Vector.t bool (S l)) m, (m <> -1)%Z -> nth_aux (Vector.tl v) m = nth_aux v (Z.succ m).
  intros l v; pattern l, v.
  apply Vector.rectS.
  simpl.
  intros; case Z.eq_dec.
  intro; assert False by omega; easy.
  trivial.
  intros.
  simpl (Vector.tl (a :: v0)).
  symmetry; apply nth_cons; omega.
Qed.

Lemma nth_aux_shiftout_last : forall {l} (v : Vector.t bool (S l)), nth_aux (Vector.shiftout v) (Z.of_nat l) = false.
  intros l v; pattern l, v.
  apply Vector.rectS; intros.
  easy.
  rewrite Nat2Z.inj_succ.
  assert (Vector.shiftout (a :: v0) = a :: (Vector.shiftout v0)) by easy.
  rewrite H0, nth_cons by omega.
  apply H.
Qed.

Lemma nth_aux_shiftout_not_last : forall {l} (v : Vector.t bool (S l)) m, (m <> Z.of_nat l)%Z -> nth_aux (Vector.shiftout v) m = nth_aux v m.
  intros l v; pattern l, v.
  apply Vector.rectS; intros.
  simpl; case Z.eq_dec; easy.
  simpl; case Z.eq_dec; trivial.
  intro; apply H.
  rewrite Nat2Z.inj_succ in H0; omega.
Qed.

Lemma nth_aux_shiftin_false : forall {l} (v : Vector.t bool l) m, nth_aux (Vector.shiftin false v) m = nth_aux v m.
  induction v; intro; simpl; case (Z.eq_dec m 0); trivial.
Qed.

Lemma nth_aux_shiftin_low : forall {l} (v : Vector.t bool l) m b, 0 < l -> (0 <= m < Z.of_nat l)%Z -> nth_aux (Vector.shiftin b v) m = nth_aux v m.
  induction v; intros.
  easy.
  simpl; case Z.eq_dec.
  easy.
  rewrite Nat2Z.inj_succ in H0.
  intro; apply IHv; omega.
Qed.

Lemma nth_aux_shiftin_high : forall {l} (v : Vector.t bool l) b, nth_aux (Vector.shiftin b v) (Z.of_nat l) = b.
  induction v.
  easy.
  unfold Vector.shiftin.
  fold (@Vector.shiftin bool).
  rewrite Nat2Z.inj_succ.
  intro; rewrite nth_cons by omega.
  apply IHv.
Qed.

(* end of nth helpers *)

(* Why3 goal *)
Definition nth : t -> Numbers.BinNums.Z -> Init.Datatypes.bool.
  exact nth_aux.
Defined.

Lemma nth_aux_out_of_bound : forall {l} (v : Vector.t bool l) (n : Z), ((n < 0%Z)%Z \/
  (Z.of_nat l <= n)%Z) -> ((nth_aux v n) = false).
induction v.
simpl; auto.
simpl.
intros.
case Z.eq_dec.
intros; elimtype False; destruct H.
omega.
subst n0.
auto with zarith.
intro; rewrite IHv;auto.
intuition; auto with zarith.
right.
rewrite Zpos_P_of_succ_nat in H0.
omega.
Qed.

(* Why3 goal *)
Lemma nth_out_of_bound :
  forall (x:t) (n:Numbers.BinNums.Z), (n < 0%Z)%Z \/ (size <= n)%Z ->
  ((nth x n) = Init.Datatypes.false).
intros.
unfold nth.
rewrite nth_aux_out_of_bound; auto with zarith.
Qed.

Definition zeros_aux {l} : Vector.t bool l.
  exact (Vector.const false l).
Defined.

(* Why3 goal *)
Definition zeros : t.
  exact zeros_aux.
Defined.

Lemma Nth_zeros_aux : forall {l} (n:Z), ((@nth_aux l zeros_aux n) = false).
  induction l.
  easy.
  simpl.
  intro n; case (Z.eq_dec n 0); easy.
Qed.

(* Why3 goal *)
Lemma Nth_zeros :
  forall (n:Numbers.BinNums.Z), ((nth zeros n) = Init.Datatypes.false).
intros n; apply Nth_zeros_aux.
Qed.

Definition one_aux l : Vector.t bool (S l).
  exact (Vector.cons bool true l (Vector.const false l)).
Defined.

(* Why3 goal *)
Definition one : t.
  exact (one_aux last_bit).
Defined.

Definition ones_aux l : Vector.t bool l.
  exact (Vector.const true l).
Defined.

(* Why3 goal *)
Definition ones : t.
  exact (ones_aux size_nat).
Defined.

(* Why3 goal *)
Lemma Nth_ones :
  forall (n:Numbers.BinNums.Z), (0%Z <= n)%Z /\ (n < size)%Z ->
  ((nth ones n) = Init.Datatypes.true).
  intros; apply nth_const; easy.
Qed.

(* Why3 goal *)
Definition bw_and : t -> t -> t.
  exact (Vector.map2 (fun x y => x && y)).
Defined.

(* Why3 goal *)
Lemma Nth_bw_and :
  forall (v1:t) (v2:t) (n:Numbers.BinNums.Z), (0%Z <= n)%Z /\ (n < size)%Z ->
  ((nth (bw_and v1 v2) n) = (Init.Datatypes.andb (nth v1 n) (nth v2 n))).
  symmetry.
  apply nth_aux_map2 with (f := fun x y => x && y); easy.
Qed.

(* Why3 goal *)
Definition bw_or : t -> t -> t.
  exact (Vector.map2 (fun x y => x || y)).
Defined.

(* Why3 goal *)
Lemma Nth_bw_or :
  forall (v1:t) (v2:t) (n:Numbers.BinNums.Z), (0%Z <= n)%Z /\ (n < size)%Z ->
  ((nth (bw_or v1 v2) n) = (Init.Datatypes.orb (nth v1 n) (nth v2 n))).
  symmetry.
  apply nth_aux_map2; easy.
Qed.

(* Why3 goal *)
Definition bw_xor : t -> t -> t.
  exact (Vector.map2 (fun x y => xorb x y)).
Defined.

(* Why3 goal *)
Lemma Nth_bw_xor :
  forall (v1:t) (v2:t) (n:Numbers.BinNums.Z), (0%Z <= n)%Z /\ (n < size)%Z ->
  ((nth (bw_xor v1 v2) n) = (Init.Datatypes.xorb (nth v1 n) (nth v2 n))).
  symmetry.
  apply nth_aux_map2; easy.
Qed.

(* Why3 goal *)
Definition bw_not : t -> t.
  exact (Vector.map (fun x => negb x)).
Defined.

(* Why3 goal *)
Lemma Nth_bw_not :
  forall (v:t) (n:Numbers.BinNums.Z), (0%Z <= n)%Z /\ (n < size)%Z ->
  ((nth (bw_not v) n) = (Init.Datatypes.negb (nth v n))).
  symmetry.
  apply nth_aux_map; easy.
Qed.

(* Why3 goal *)
Definition lsr : t -> Numbers.BinNums.Z -> t.
  exact (fun v m => BshiftRl_iter last_bit v (Z.to_nat m)).
Defined.

Lemma bshiftRl_iter_nth : forall b s m,
                                (0 <= Z.of_nat s)%Z ->
                                (0 <= m)%Z ->
   nth_aux (BshiftRl_iter last_bit b s) m = nth_aux b (m + Z.of_nat s).
  induction s.
  simpl.
  intros; rewrite <- Zplus_0_r_reverse; easy.
  rewrite Nat2Z.inj_succ; intros.
  simpl BshiftRl_iter.
  unfold BshiftRl, Bhigh.
  rewrite nth_aux_tl by omega.
  rewrite nth_aux_shiftin_false.
  rewrite <- Zplus_succ_r_reverse, <- Z.add_succ_l.
  apply IHs; omega.
Qed.

(* Why3 goal *)
Lemma Lsr_nth_low :
  forall (b:t) (n:Numbers.BinNums.Z) (s:Numbers.BinNums.Z), (0%Z <= s)%Z ->
  (0%Z <= n)%Z -> ((n + s)%Z < size)%Z ->
  ((nth (lsr b s) n) = (nth b (n + s)%Z)).
intros b n s h1 h2 h3.
rewrite <-Z2Nat.id with (n := s) at 2; auto.
apply bshiftRl_iter_nth; omega.
Qed.

(* Why3 goal *)
Lemma Lsr_nth_high :
  forall (b:t) (n:Numbers.BinNums.Z) (s:Numbers.BinNums.Z), (0%Z <= s)%Z ->
  (0%Z <= n)%Z -> (size <= (n + s)%Z)%Z ->
  ((nth (lsr b s) n) = Init.Datatypes.false).
  intros b n s h1 h2 h3.
  unfold nth,lsr.
  cut (nth_aux b (n + Z.of_nat (Z.to_nat s)) = false).
  intro.
  rewrite <-H.
  apply bshiftRl_iter_nth; omega.
  rewrite Z2Nat.id by omega.
  apply nth_out_of_bound; omega.
Qed.

(* Why3 goal *)
Lemma lsr_zeros : forall (x:t), ((lsr x 0%Z) = x).
auto.
Qed.

(* Why3 goal *)
Definition asr : t -> Numbers.BinNums.Z -> t.
  exact (fun v m => BshiftRa_iter last_bit v (Z.to_nat m)).
Defined.

Definition eq_aux {l} (v1 v2 : Vector.t bool l): Prop := forall (n:Z), ((0%Z <= n)%Z /\
  (n < (Z.of_nat l))%Z) -> ((nth_aux v1 n) = (nth_aux v2 n)).

Lemma eq_aux_cons : forall {l} v1 v2 b b',  b = b' /\ @eq_aux l v1 v2 <-> eq_aux (b :: v1) (b' :: v2).
  intros; unfold eq_aux.
  rewrite Nat2Z.inj_succ.
  split; intros.
  simpl; case Z.eq_dec; intro.
  easy.
  apply H; omega.
  split.
  apply (H 0%Z); omega.
  intros.
  rewrite <- (nth_cons v1 n b) by omega.
  rewrite <- (nth_cons v2 n b') by omega.
  apply H; omega.
Qed.

Lemma Extensionality_aux : forall {l} (x y : Vector.t bool l), eq_aux x y -> x = y.
  intros l x y; pattern l, x, y.
  apply Vector.rect2.
  easy.
  intros.
  apply (eq_aux_cons v1 v2 a b) in H0; destruct H0.
  apply H in H1.
  rewrite H0, H1; trivial.
Qed.

(* Vector helper lemmas *)

Lemma singleton_is_singl : forall b : Vector.t bool 1, b = [ Vector.hd b ].
  intro; apply Extensionality_aux; unfold eq_aux; intros.
  change (Z.of_nat 1) with 1%Z in H; assert (n = 0%Z) as e by omega; rewrite e; simpl.
  apply nth_zeros_is_hd.
Qed.

Lemma shiftrepeat_is_shiftin : forall {l} (v : Vector.t bool (S l)), Vector.shiftrepeat v = Vector.shiftin (Vector.last v) v.
  apply Vector.rectS.
  easy.
  intros; simpl.
  rewrite H; trivial.
Qed.

Lemma last_tail_shiftreapeat : forall {l} (v : Vector.t bool (S l)), Vector.last (Vector.tl (Vector.shiftrepeat v)) = Vector.last v.
  apply Vector.caseS; intros.
  induction n.
  apply Vector.case0 with (v := t0); easy.
  simpl.
  apply Vector.shiftrepeat_last.
Qed.

(* end of Vector helpers *)

Lemma BshiftRa_iter_nth_low : forall (b:t) (s:nat) (n:Z),
  (0%Z <= n < (size - (Z.of_nat s)))%Z ->
  (nth_aux (BshiftRa_iter last_bit b s) n) = (nth_aux b (n + Z.of_nat s)%Z).
  induction s.
  simpl.
  intros; rewrite <- Zplus_0_r_reverse; easy.
  rewrite Nat2Z.inj_succ; intros.
  simpl BshiftRa_iter.
  unfold BshiftRa, Bhigh.
  rewrite nth_aux_tl by omega.
  rewrite shiftrepeat_is_shiftin.
  rewrite nth_aux_shiftin_low.
  rewrite <- Zplus_succ_r_reverse, <- Z.add_succ_l.
  apply IHs; omega.
  omega.
  fold size_nat; fold size; omega.
Qed.

(* Why3 goal *)
Lemma Asr_nth_low :
  forall (b:t) (n:Numbers.BinNums.Z) (s:Numbers.BinNums.Z), (0%Z <= s)%Z ->
  (0%Z <= n)%Z /\ (n < size)%Z -> ((n + s)%Z < size)%Z ->
  ((nth (asr b s) n) = (nth b (n + s)%Z)).
  unfold nth, lsr.
  intros.
  assert ((n + s)%Z = (n + Z.of_nat (Z.to_nat s))%Z).
  rewrite Z2Nat.id with (n := s); omega.
  rewrite H2.
  apply BshiftRa_iter_nth_low; omega.
Qed.

Lemma bshiftra_iter_last : forall {l} (v : Bvector (S l)) s, Vector.last (BshiftRa_iter l v s) = Vector.last v.
  induction s.
  easy.
  simpl; unfold BshiftRa, Bhigh.
  rewrite last_tail_shiftreapeat.
  apply IHs.
Qed.

Lemma BhiftRa_iter_nth_high : forall (b:t) (s:nat) (n:Z),
  (0%Z <= n < size)%Z ->
  (size <= n + Z.of_nat s)%Z -> ((nth_aux (BshiftRa_iter last_bit b s) n) = nth_aux b
  (size - 1%Z))%Z.
  induction s.
  simpl BshiftRa_iter.
  simpl (Z.of_nat 0).
  intros.
  assert (n = size - 1)%Z by omega; rewrite H1; trivial.
  rewrite Nat2Z.inj_succ; intros.
  simpl BshiftRa_iter.
  unfold BshiftRa, Bhigh.
  rewrite nth_aux_tl by omega.
  rewrite shiftrepeat_is_shiftin.
  case (Z.eq_dec (Z.succ n) size).
  intro; unfold size in e.
  rewrite e, nth_aux_shiftin_high.
  rewrite bshiftra_iter_last.
  rewrite size_int_S, Z.sub_1_r, <- Zpred_succ.
  symmetry; apply nth_predl_is_last.
  intro; rewrite nth_aux_shiftin_low.
  apply IHs; omega.
  omega.
  fold size_nat; fold size; omega.
Qed.

(* Why3 goal *)
Lemma Asr_nth_high :
  forall (b:t) (n:Numbers.BinNums.Z) (s:Numbers.BinNums.Z), (0%Z <= s)%Z ->
  (0%Z <= n)%Z /\ (n < size)%Z -> (size <= (n + s)%Z)%Z ->
  ((nth (asr b s) n) = (nth b (size - 1%Z)%Z)).
  unfold nth, asr.
  intros.
  apply BhiftRa_iter_nth_high.
  omega.
  rewrite Z2Nat.id; omega.
Qed.

(* Why3 goal *)
Lemma asr_zeros : forall (x:t), ((asr x 0%Z) = x).
auto.
Qed.

(* Why3 goal *)
Definition lsl : t -> Numbers.BinNums.Z -> t.
  exact (fun v m => BshiftL_iter last_bit v (Z.to_nat m)).
Defined.

Lemma bshiftL_iter_nth_high : forall {l} v s m, (0 <= Z.of_nat s)%Z -> (Z.of_nat s <= m)%Z -> (m < Z.succ (Z.of_nat l))%Z -> nth_aux (BshiftL_iter l v s) m = nth_aux v (m - Z.of_nat s).
  induction s; intros.
  simpl.
  rewrite <-Zminus_0_l_reverse; reflexivity.
  simpl.
  case Z.eq_dec; intro.
  symmetry; apply nth_low.
  rewrite e; simpl; apply Pos2Z.neg_is_neg.
  rewrite Nat2Z.inj_succ in H, H0.
  case (Z.eq_dec (Z.pred m) (Z.of_nat l));intro.
  assert False by omega; easy.
  rewrite nth_aux_shiftout_not_last by omega.
  rewrite Zpos_P_of_succ_nat, Z.sub_succ_r, <- Z.sub_pred_l.
  apply IHs; omega.
Qed.

(* Why3 goal *)
Lemma Lsl_nth_high :
  forall (b:t) (n:Numbers.BinNums.Z) (s:Numbers.BinNums.Z),
  (0%Z <= s)%Z /\ (s <= n)%Z /\ (n < size)%Z ->
  ((nth (lsl b s) n) = (nth b (n - s)%Z)).
  intros.
  unfold lsl, nth.
  rewrite <-Z2Nat.id with (n := s) at 2 by omega.
  destruct H.
  destruct H0.
  apply (bshiftL_iter_nth_high b (Z.to_nat s) n).
  auto with zarith.
  rewrite Z2Nat.id; omega.
  rewrite size_int_S in H1.
  omega.
Qed.

Lemma Lsl_nth_low_aux : forall {l} x b (n : int),
                          (0 <= n < Z.of_nat x)%Z -> nth_aux (BshiftL_iter l b x) n = false.
  induction x.
  simpl; intros; assert False by omega; easy.
  rewrite Nat2Z.inj_succ; intros.
  simpl.
  case Z.eq_dec;intro.
  trivial.
  case (Z.eq_dec (Z.pred n) (Z.of_nat l));intro.
  apply nth_high; omega.
  rewrite nth_aux_shiftout_not_last by auto.
  apply IHx; omega.
Qed.

(* Why3 goal *)
Lemma Lsl_nth_low :
  forall (b:t) (n:Numbers.BinNums.Z) (s:Numbers.BinNums.Z),
  (0%Z <= n)%Z /\ (n < s)%Z -> ((nth (lsl b s) n) = Init.Datatypes.false).
  intros.
  apply Lsl_nth_low_aux.
  rewrite Z2Nat.id; omega.
Qed.

(* Why3 goal *)
Lemma lsl_zeros : forall (x:t), ((lsl x 0%Z) = x).
auto.
Qed.

Lemma max_int_nat : forall l, (0 <= Pow2int.pow2 (Z.of_nat l) - 1)%Z.
  intro.
  rewrite Z.sub_1_r.
  apply Zlt_0_le_0_pred.
  apply Pow2int.pow2pos.
  omega.
Qed.

Fixpoint bvec_to_nat n (v : Bvector n) {struct v} : nat :=
  match v with
    | Vector.nil _ => O
    | Vector.cons _ false n v => 2 * bvec_to_nat n v
    | Vector.cons _ true n v => 1 + 2 * bvec_to_nat n v
  end.

Lemma bvec_to_nat_zeros : forall {l}, bvec_to_nat l (Vector.const false l) = 0.
  induction l; [easy|simpl; omega].
Qed.

Definition twos_complement n (v : Bvector n) : Z.
destruct n.
exact 0%Z.
exact (match Bsign _ v with
        | false => Z.of_nat (bvec_to_nat _ v)
        | true  => (Z.of_nat (bvec_to_nat _ v) - Pow2int.pow2 (Z.of_nat (S n)))%Z
       end).
Defined.

Require Arith.Div2.

Fixpoint nat_to_bvec (length val : nat) {struct length} : Bvector length :=
  match length as x return Bvector x with
    | O => Bnil
    | S length =>
      Bcons (Z.odd (Z.of_nat val)) length (nat_to_bvec length (Div2.div2 val))
  end.

Lemma Nat_to_bvec_zeros : forall {n}, Vector.const false n = nat_to_bvec n 0.
  induction n.
  easy.
  simpl.
  unfold Bcons.
  rewrite IHn; trivial.
Qed.

Lemma bvec_to_nat_extensionality : forall {m} (v v' : Bvector m),
 (bvec_to_nat m v) = (bvec_to_nat m v') -> v = v'.
  unfold Bvector.
  intros m v v'.
  pattern m,v,v'.
  apply Vector.rect2.
  trivial.
  case a, b; intros.
  rewrite H; auto; inversion H0; omega.
  inversion H0; assert False; omega.
  inversion H0; assert False; omega.
  rewrite H; auto; inversion H0; omega.
Qed.

(* pow2 helper lemmas *)

Lemma id_lt_pow2: forall n, (Z.of_nat (S n) < Pow2int.pow2 (Z.of_nat (S n)))%Z.
  intro.
  induction n.
  easy.
  rewrite Nat2Z.inj_succ.
  apply Z.le_lt_trans with (m := (2 * Z.of_nat (S n))%Z).
  rewrite Nat2Z.inj_succ; omega.
  apply Z.lt_le_trans with (m := (2 * Pow2int.pow2 (Z.of_nat (S n)))%Z).
  omega.
  rewrite two_p_S by omega.
  unfold Pow2int.pow2; omega.
Qed.

Lemma pow2_lt_mono_nat : forall i j : nat, (i < j) -> (Pow2int.pow2 (Z.of_nat i) < Pow2int.pow2 (Z.of_nat j))%Z.
  intros.
  unfold Pow2int.pow2; rewrite two_p_equiv, two_p_equiv.
  apply Z.pow_lt_mono_r; omega.
Qed.

Lemma pow2_le_mono_nat : forall i j : nat, (i <= j) -> (Pow2int.pow2 (Z.of_nat i) <= Pow2int.pow2 (Z.of_nat j))%Z.
  intros.
  unfold Pow2int.pow2; rewrite two_p_equiv, two_p_equiv.
  apply Z.pow_le_mono_r; omega.
Qed.

Lemma pow2_le_mono_pos : forall i j : positive, (Pos.le i j) -> (Pow2int.pow2 (Zpos i) <= Pow2int.pow2 (Zpos j))%Z.
  intros.
  rewrite <- positive_nat_Z, <- positive_nat_Z.
  apply pow2_le_mono_nat.
  apply Pos2Nat.inj_le; trivial.
Qed.

Lemma pow2_pos : forall i : positive, (2 <= Pow2int.pow2 (Z.pos i))%Z.
  intros.
  rewrite <- Pow2int.Power_1.
  apply pow2_le_mono_pos.
  apply Pos.le_1_l.
Qed.

(* end of pow2 helpers *)

(* arithmetic helper lemmas *)

Lemma lem_time2 : forall a b, a < b -> 1 + 2 * a < 2 * b.
  intros; omega.
Qed.

Lemma le_le_le: forall x y z t, (t <= z)%Z -> (x <= y <= t)%Z -> (x <= y <= z)%Z.
  split; [easy|apply Int.Trans with (y := t0); easy].
Qed.

Lemma le_lt_le: forall x y z t, (t <= z)%Z -> (x <= y < t)%Z -> (x <= y <= z)%Z.
  split; [easy|apply Int.Trans with (y := t0); [apply Z.lt_le_incl, H0|easy]].
Qed.

Lemma factor_sub : forall n m p, (n * m - n * p = n * (m - p))%Z.
  intros.
  rewrite Int.infix_mn_def, Int.infix_mn_def, Zopp_mult_distr_r.
  apply Zred_factor4.
Qed.

Lemma lt_sym: forall x y, (x < y)%Z <-> (y > x)%Z.
  intro; split; omega.
Qed.

(* end of arithmetic helpers *)

Lemma bvec_to_nat_range : forall {n} v, bvec_to_nat n v < Z.to_nat (Pow2int.pow2 (Z.of_nat n)).
  induction v.
  simpl bvec_to_nat; auto.
  apply Nat.le_lt_trans with (m := 1 + (bvec_to_nat n v * 2)).
  simpl; case h; omega.
  rewrite Nat2Z.inj_succ, <- Z.add_1_r, Pow2int.Power_s by omega.
  rewrite Z2Nat.inj_mul.
  assert (Z.to_nat 2 = 2) by easy; rewrite H.
  rewrite mult_comm.
  apply lem_time2.
  easy.
  easy.
  apply Zlt_le_weak, Pow2int.pow2pos; omega.
Qed.

Lemma twos_complement_neg : forall {n} v, Bsign n v = true -> (twos_complement (S n) v < 0)%Z.
  intros.
  unfold twos_complement.
  rewrite H.
  apply Z.lt_sub_0.
  apply Zlt_le_trans with (m := Pow2int.pow2 (Z.of_nat (S n))).
  rewrite Z2Nat.inj_lt.
  rewrite Nat2Z.id.
  apply bvec_to_nat_range.
  omega.
  apply Zlt_le_weak, Pow2int.pow2pos; omega.
  omega.
Qed.

Lemma twos_complement_pos : forall {n} v, Bsign n v = false -> (twos_complement (S n) v >= 0)%Z.
  intros.
  unfold twos_complement; rewrite H; omega.
Qed.

Lemma twos_complement_extensionality : forall {m} (v v' : Bvector m),
  (twos_complement m v = twos_complement m v' -> v = v').

  destruct m.
  (* v = v' = nil *)
  - simpl. intros. apply Vector.case0; eauto.
    symmetry. apply Vector.case0; eauto.
  (* Non empty vector *)
  - intros.
    assert (Bsign m v = Bsign m v').
    { unfold twos_complement in H. destruct Bsign.
      destruct Bsign. reflexivity.
      assert (Z.of_nat (bvec_to_nat (S m) v') >= 0 /\
              Z.of_nat (bvec_to_nat (S m) v') < 0)%Z.
      {
        split.
        + omega.
        + rewrite <- H. generalize (bvec_to_nat_range v). intros.
          eapply Z.lt_sub_0. rewrite <- Z2Nat.id.
          apply inj_lt. assumption.
          eapply Zle_trans. apply (max_int_nat (S m)).
          omega.
      }
      omega.
      destruct Bsign.
      (* TODO improve this (copy/paste) *)
      assert (Z.of_nat (bvec_to_nat (S m) v) >= 0 /\
              Z.of_nat (bvec_to_nat (S m) v) < 0)%Z.
      {
        split.
        + omega.
        + rewrite H. generalize (bvec_to_nat_range v'). intros.
          eapply Z.lt_sub_0. rewrite <- Z2Nat.id.
          apply inj_lt. assumption.
          eapply Zle_trans. apply (max_int_nat (S m)).
          omega.
      }
      omega.
      reflexivity.
    }
    unfold twos_complement in H. rewrite <- H0 in H.
    destruct Bsign.
    apply bvec_to_nat_extensionality. apply Z.sub_cancel_r in H.
    apply Nat2Z.inj in H. assumption.

    apply bvec_to_nat_extensionality.
    apply Nat2Z.inj in H. assumption.
Qed.

(* even / odd helper lemmas *)

Lemma odd_is_odd : forall n : nat, Even.odd n <-> Z.odd (Z.of_nat n) = true.
  intro.
  rewrite Zodd_bool_iff, Zodd_ex_iff, Even.odd_equiv.
  unfold Nat.Odd.
  split; intro; destruct H.
  exists (Z.of_nat x); omega.
  rewrite <-Z2Nat.id with (n := x) in H by omega.
  exists (Z.to_nat x); omega.
Qed.

Lemma even_not_odd : forall n : nat, Even.even n <-> not (Even.odd n).
  intro; split; intro.
  intro; apply Even.not_even_and_odd with (n := n); easy.
  case (Even.even_or_odd n); easy.
Qed.

Lemma even_is_even : forall n : nat, Even.even n <-> Z.even (Z.of_nat n) = true.
  intro.
  rewrite even_not_odd, odd_is_odd, Zeven.Zeven_odd_bool, negb_true_iff, not_true_iff_false; easy.
Qed.

Lemma case_odd : forall (i : nat), (Z.odd (Z.of_nat i) = true) + (Z.odd (Z.of_nat i) = false).
  induction i.
  right; simpl; easy.
  rewrite Nat2Z.inj_succ.
  destruct IHi.
  right; rewrite Z.odd_succ, <- Z.negb_odd; rewrite e; trivial.
  left; rewrite Z.odd_succ, <- Z.negb_odd; rewrite e; trivial.
Qed.

Lemma odd_even_le : forall n m, Z.even n = true -> Z.odd m = true -> (n <= m)%Z -> (n < m)%Z.
  intros.
  case (Z_le_lt_eq_dec n m); trivial.
  intro; assert False.
  rewrite e, <- Z.negb_odd, negb_true_iff, H0 in H; easy.
  easy.
Qed.

Lemma pow2_is_even : forall n, (n > 0)%Z -> Z.even (Pow2int.pow2 n) = true.
  intros.
  unfold Pow2int.pow2.
  rewrite two_p_equiv, Z.even_pow by omega; easy.
Qed.

Lemma max_int_is_odd : forall n, (n > 0)%Z -> Z.odd (Pow2int.pow2 n - 1) = true.
  intros.
  rewrite Z.sub_1_r, Z.odd_pred.
  apply pow2_is_even; trivial.
Qed.

(* end of even / odd helpers *)

Lemma bvec_to_nat_nat_to_bvec : forall {n} i, (Z.of_nat i <= Pow2int.pow2 (Z.of_nat n) - 1)%Z ->
  bvec_to_nat n (nat_to_bvec n i) = i.
  induction n.
  simpl; intro; omega.
  destruct i; intros.
  simpl.
  rewrite <- Nat_to_bvec_zeros, bvec_to_nat_zeros; trivial.
  unfold nat_to_bvec, Bcons, bvec_to_nat.
  case (case_odd (S i)); intro.
  assert (Even.even i).
  rewrite even_not_odd, odd_is_odd.
  rewrite Nat2Z.inj_succ, Z.odd_succ, <- Z.negb_odd, negb_true_iff in e.
  rewrite e; easy.
  rewrite e.
  apply Nat.succ_inj_wd.
  change (2 * bvec_to_nat n (nat_to_bvec n (Div2.div2 (S i))) = i).
  rewrite IHn.
  rewrite <- Div2.even_div2, <- Nat.double_twice, <- Div2.even_double by easy; trivial.
  rewrite Z.mul_le_mono_pos_l with (p := 2%Z) by easy.
  rewrite Z.add_le_mono_l with (p := 1%Z) by easy.
  apply Z.le_trans with (m := Z.of_nat (S i)).
  rewrite <- Div2.even_div2, <- Nat2Z.inj_mul with (n:= 2), <- Nat.double_twice, <- Div2.even_double, Nat2Z.inj_succ by trivial; omega.
  apply Z.le_trans with (m := (Pow2int.pow2 (Z.of_nat (S n)) - 1)%Z); trivial.
  rewrite Nat2Z.inj_succ, <- Z.add_1_r, Pow2int.Power_s; omega.
  rewrite e.
  change (2 * bvec_to_nat n (nat_to_bvec n (Div2.div2 (S i))) = S i).
  rewrite IHn.
  rewrite  <- Nat.double_twice, <- Div2.even_double; trivial.
  rewrite even_not_odd, odd_is_odd, e; auto.
  rewrite Z.mul_le_mono_pos_l with (p := 2%Z) by easy.
  apply Z.le_trans with (m := Z.of_nat (S i)).
  rewrite <- Nat2Z.inj_mul with (n := 2), <- Nat.double_twice, <- Div2.even_double.
  omega.
  rewrite even_not_odd, odd_is_odd, not_true_iff_false; trivial.
  apply odd_even_le, Z.lt_le_pred in H.
  apply Z.le_trans with (m := (Pow2int.pow2 (Z.of_nat (S n)) - 2)%Z).
  omega.
  rewrite Nat2Z.inj_succ, <- Z.add_1_r, Pow2int.Power_s; omega.
  rewrite Zeven.Zeven_odd_bool, e; easy.
  unfold Pow2int.pow2.
  rewrite Z.sub_1_r, Z.odd_pred, Nat2Z.inj_succ.
  rewrite pow2_is_even by omega; easy.
Qed.

Lemma Nat_to_bvec_ones : forall {n}, Vector.const true n = nat_to_bvec n (Z.to_nat (Pow2int.pow2 (Z.of_nat n) - 1)).
  induction n.
  easy.
  unfold nat_to_bvec.
  rewrite Z2Nat.id by (apply max_int_nat).
  rewrite max_int_is_odd by easy.
  fold nat_to_bvec.
  assert ((Div2.div2 (Z.to_nat (Pow2int.pow2 (Z.of_nat (S n)) - 1))) = (Z.to_nat (Pow2int.pow2 (Z.of_nat n) - 1))).
  apply eq_add_S.
  rewrite Div2.odd_div2.
  rewrite <- Z2Nat.inj_succ by (apply max_int_nat).
  rewrite Z.sub_1_r, <- Zsucc_pred, Nat2Z.inj_succ, <- Z.add_1_r.
  rewrite Pow2int.Power_s by omega.
  rewrite Z2Nat.inj_mul, Div2.div2_double.
  rewrite <- Z2Nat.inj_succ by (apply max_int_nat).
  rewrite Z.sub_1_r, <- Zsucc_pred; trivial.
  easy.
  apply Z.lt_le_incl, Pow2int.pow2pos; omega.
  rewrite odd_is_odd.
  rewrite Z2Nat.id by (apply max_int_nat).
  apply max_int_is_odd; easy.
  rewrite H, <- IHn; auto.
Qed.

Import EuclideanDivision.

(* mod helper lemmas *)

Lemma mod1_nat : forall x y, 0 < y -> 0 <= mod1 x y.
  intros.
  unfold mod1, div.
  case Z_le_dec; intro.
  apply Zle_minus_le_0, Z_mult_div_ge; omega.
  destruct n; apply Z.mod_pos_bound; trivial.
Qed.

Lemma mod1_nat_high_bound_lt: forall u v, 0 < v -> mod1 u v < v.
  intros.
  rewrite <- Z.abs_eq by omega.
  apply Mod_bound; omega.
Qed.

Lemma mod1_nat_high_bound_le: forall u v, 0 <= v ->
                                       mod1 u (v + 1) <= v.
  intros.
  rewrite Zpred_succ, <- Z.lt_le_pred.
  apply mod1_nat_high_bound_lt; omega.
Qed.

Lemma mod1_out : forall x y, 0 <= x < y -> mod1 x y = x.
  intros; unfold mod1.
  rewrite Div_inf; omega.
Qed.

Lemma mod_mod_mult: forall a b c, b > 0 -> c > 0 -> ((a mod (c * b)) mod b) = a mod b.
  intros.
  rewrite Z.mul_comm.
  rewrite Z.rem_mul_r by omega.
  rewrite <-Zplus_mod_idemp_r.
  rewrite Z.mul_comm, Z_mod_mult, Zplus_0_r.
  apply Zmod_mod.
Qed.

(* end of mod helpers *)

Fixpoint rotate_right_aux {l} (b : Vector.t bool (S l)) (p : nat) : Vector.t bool (S l) :=
match p with
  | O => b
  | S q => let prev := rotate_right_aux b q in
            (Vector.shiftin (Vector.hd prev) (Vector.tl prev))
end.

Fixpoint rotate_left_aux {l} (b : Vector.t bool (S l)) (p : nat) : Vector.t bool (S l) :=
match p with
  | O => b
  | S q => let prev := rotate_left_aux b q in
            ((Vector.last prev) :: (Vector.shiftout prev))
end.

Lemma mod1_is_mod : forall x y, y > 0 -> mod1 x y = Zmod x y.
  intros; unfold mod1, div.
  case Z_le_dec; intro.
  rewrite Z.mod_eq by omega; trivial.
  destruct n; apply Z_mod_lt; omega.
Qed.

Lemma mod1_succ_low : forall x y, y > 0 -> mod1 x y < (Z.pred y) -> mod1 (Z.succ x) y = Z.succ (mod1 x y).
  intros x y H.
  rewrite mod1_is_mod, mod1_is_mod by trivial.
  rewrite Z.mod_eq, Z.mod_eq by omega.
  intro; cut (Zsucc x / y = x / y).
  intro e; rewrite e; omega.
  rewrite Z.div_unique_pos with (a := Z.succ x) (b := y) (r := (x mod y) + 1) (q := x / y).
  trivial.
  rewrite <- Z.mod_eq in H0 by omega.
  split; [apply Z.le_le_succ_r, Z_mod_lt; trivial|omega].
  rewrite <- Zplus_assoc_reverse, <- Z_div_mod_eq by omega; omega.
Qed.

Lemma mod1_succ_high : forall x y, y > 0 -> mod1 x y = (Z.pred y) -> mod1 (Z.succ x) y = 0.
  intros x y H.
  rewrite mod1_is_mod, mod1_is_mod by omega; intro.
  rewrite <- Z.add_1_r, Zplus_mod, H0.
  case (Z.eq_dec y 1); intro e.
  rewrite e; easy.
  rewrite Zmod_1_l by omega.
  rewrite Z.add_1_r, <- Zsucc_pred.
  apply Z_mod_same_full.
Qed.

Lemma mod1_add : forall x y, y > 0 -> mod1 (x + y) y = mod1 x y.
  intros.
  rewrite mod1_is_mod, mod1_is_mod by omega.
  rewrite <- Z.mul_1_l with (n := x + y), <- Zred_factor4, Z.mul_1_l.
  apply Z.mod_add; omega.
Qed.

Lemma Nth_rotate_aux_left :
  forall {l} (v : Vector.t bool (S l)) (n : nat) (i : nat),
    (Z.of_nat i < Z.succ (Z.of_nat l))%Z ->
    ((nth_aux (rotate_left_aux v n) (Z.of_nat i))
     = (nth_aux v (mod1 (Z.of_nat i - Z.of_nat n)%Z (Z.succ (Z.of_nat l))))).
  induction n; intros.
  simpl.
  rewrite <- Zminus_0_l_reverse, mod1_out; auto with zarith.
  case (Z.eq_dec (Z.of_nat i) 0); intros.
  rewrite e.
  rewrite <-mod1_add by auto with zarith.
  rewrite Z.sub_0_l, Int.Comm, Z.add_opp_r.
  rewrite Nat2Z.inj_succ, Z.sub_succ_r, <-Z.sub_pred_l, <-Zpred_succ.
  rewrite <-IHn by omega.
  simpl.
  symmetry; apply nth_predl_is_last.

  rewrite Nat2Z.inj_succ, Z.sub_succ_r, <-Z.sub_pred_l.
  rewrite <-Nat2Z.inj_pred by auto with zarith.
  rewrite <-IHn by (rewrite Nat2Z.inj_pred; omega).
  rewrite Nat2Z.inj_pred by auto with zarith.
  simpl.
  destruct Z.eq_dec; try easy.
  apply nth_aux_shiftout_not_last; auto with zarith.
Qed.

Lemma Nth_rotate_aux_right : forall {l} (v : Vector.t bool (S l)) (n:nat) (i:nat),
  (Z.of_nat i < (Z.succ (Z.of_nat l))) ->
  (nth_aux (rotate_right_aux v n) (Z.of_nat i)) = (nth_aux v (mod1 ((Z.of_nat i) + (Z.of_nat n)) (Z.succ (Z.of_nat l)))).
  induction n.
  simpl; intros; rewrite <- Zplus_0_r_reverse, mod1_out; [trivial|omega].
  intros; rewrite Nat2Z.inj_succ, <-Z.add_succ_comm, <-Nat2Z.inj_succ.
  case (Z.eq_dec (Z.of_nat i) (Z.of_nat l)); intro e.
  rewrite Nat2Z.inj_succ, e.
  simpl (rotate_right_aux v (S n)).
  rewrite nth_aux_shiftin_high.
  rewrite Z.add_comm, mod1_add by omega.
  rewrite <-nth_zeros_is_hd.
  apply (IHn 0%nat); simpl; omega.
  rewrite <-IHn by (rewrite Nat2Z.inj_succ; omega).
  simpl (rotate_right_aux v (S n)).
  rewrite nth_aux_shiftin_low by omega.
  rewrite Nat2Z.inj_succ.
  apply nth_aux_tl; omega.
Qed.

Lemma bvec_to_nat_tl: forall {l} v, Z.of_nat (bvec_to_nat l (Vector.tl v)) = Z.of_nat (bvec_to_nat (S l) v) / 2.
  apply Vector.rectS; intros.
  simpl.
  symmetry; case a.
  apply Zdiv_1_l; omega.
  apply Zdiv_0_l.
  simpl (Vector.tl (a :: v)).
  case a.
  change (Z.of_nat (bvec_to_nat (S n) v) =
   Z.of_nat (S (2 * bvec_to_nat (S n) v)) / 2).
  rewrite Nat2Z.inj_succ, Nat2Z.inj_mul, Z.mul_comm, <-Z.add_1_l.
  rewrite Z.div_add, Zdiv_1_l by omega; omega.
  change (Z.of_nat (bvec_to_nat (S n) v) =
   Z.of_nat (2 * bvec_to_nat (S n) v) / 2).
  rewrite Nat2Z.inj_mul, Z.mul_comm, Z_div_mult_full; omega.
Qed.

Lemma bvec_to_nat_shiftin: forall {l} v, bvec_to_nat (S l) (Vector.shiftin false v) = bvec_to_nat l v.
  induction v.
  easy.
  case h; simpl; rewrite IHv; easy.
Qed.

Lemma bvec_to_nat_shiftout_mod1 : forall {l} v, Z.of_nat (bvec_to_nat l (Vector.shiftout v)) = (Z.of_nat (bvec_to_nat (S l) v)) mod (Pow2int.pow2 (Z.of_nat l)).
  intros.
  revert l v.
  apply Vector.rectS; intros.
  simpl.
  symmetry; apply Zmod_1_r.
  case a.
  change (Z.of_nat (S (2 * bvec_to_nat n (Vector.shiftout v))) = (Z.of_nat (S (2 * bvec_to_nat (S n) v))) mod (Pow2int.pow2 (Z.of_nat (S n)))).
  rewrite Nat2Z.inj_succ with (n := n), <-Z.add_1_r with (n := Z.of_nat n), Pow2int.Power_s by omega.
  rewrite Nat2Z.inj_succ, Nat2Z.inj_succ, <-Z.add_1_l, <-Z.add_1_l, Nat2Z.inj_mul, Nat2Z.inj_mul.
  rewrite Z.rem_mul_r.
  rewrite Zmod_odd.
  assert (Z.odd (1 + Z.of_nat 2 * Z.of_nat (bvec_to_nat (S n) v)) = true) by (rewrite Z.odd_add_mul_2; easy).
  rewrite H0.
  rewrite Int.Comm1 with (y := Z.of_nat (bvec_to_nat (S n) v)), Z_div_plus_full, Zdiv_1_l by easy.
  rewrite H; easy.
  omega.
  apply Pow2int.pow2pos; omega.
  change (Z.of_nat (2 * bvec_to_nat n (Vector.shiftout v)) = (Z.of_nat (2 * bvec_to_nat (S n) v)) mod (Pow2int.pow2 (Z.of_nat (S n)))).
  rewrite Nat2Z.inj_succ with (n := n), <-Z.add_1_r with (n := Z.of_nat n), Pow2int.Power_s by omega.
  rewrite Nat2Z.inj_mul, Nat2Z.inj_mul.
  rewrite Zmult_mod_distr_l.
  rewrite H; trivial.
Qed.

(* Why3 goal *)
Definition rotate_right : t -> Numbers.BinNums.Z -> t.
  exact (fun b p => rotate_right_aux b (Z.to_nat p)).
Defined.

(* Why3 goal *)
Lemma Nth_rotate_right :
  forall (v:t) (n:Numbers.BinNums.Z) (i:Numbers.BinNums.Z),
  (0%Z <= i)%Z /\ (i < size)%Z -> (0%Z <= n)%Z ->
  ((nth (rotate_right v n) i) =
   (nth v (int.EuclideanDivision.mod1 (i + n)%Z size))).
  intros v n i h1 h2.
  revert h2; revert n.
  apply Z_of_nat_prop.
  destruct h1.
  revert H0.
  pattern i.
  apply Z_of_nat_prop; auto.
  unfold nth, rotate_right, size, size_nat.
  intro n.
  rewrite Nat2Z.inj_succ.
  intros. rewrite Nat2Z.id.
  apply Nth_rotate_aux_right; auto.
Qed.

(* Why3 goal *)
Definition rotate_left : t -> Numbers.BinNums.Z -> t.
  exact (fun b p => rotate_left_aux b (Z.to_nat p)).
Defined.

(* Why3 goal *)
Lemma Nth_rotate_left :
  forall (v:t) (n:Numbers.BinNums.Z) (i:Numbers.BinNums.Z),
  (0%Z <= i)%Z /\ (i < size)%Z -> (0%Z <= n)%Z ->
  ((nth (rotate_left v n) i) =
   (nth v (int.EuclideanDivision.mod1 (i - n)%Z size))).
  intros v n i h1 h2.
  revert h2; revert n.
  apply Z_of_nat_prop.
  destruct h1.
  revert H0.
  pattern i.
  apply Z_of_nat_prop; auto.
  unfold nth, rotate_left, size, size_nat.
  intro n.
  rewrite Nat2Z.inj_succ.
  intros. rewrite Nat2Z.id.
  apply Nth_rotate_aux_left; auto.
Qed.

(* Why3 goal *)
Definition two_power_size : Numbers.BinNums.Z.
  exact (Pow2int.pow2 size)%Z.
Defined.

(* Why3 goal *)
Definition max_int : Numbers.BinNums.Z.
  exact (Pow2int.pow2 size - 1)%Z.
Defined.

(* Why3 goal *)
Lemma two_power_size_val : (two_power_size = (bv.Pow2int.pow2 size)).
  trivial.
Qed.

(* Why3 goal *)
Lemma max_int_val : (max_int = (two_power_size - 1%Z)%Z).
  trivial.
Qed.

(* Why3 goal *)
Definition is_signed_positive : t -> Prop.
  exact (fun v => if Bsign _ v then False else True).
Defined.

(* Why3 goal *)
Definition to_uint : t -> Numbers.BinNums.Z.
  exact (fun x => Z.of_nat (bvec_to_nat size_nat x)).
Defined.

Lemma max_int_S : (two_power_size = max_int + 1)%Z.
  rewrite max_int_val; auto with zarith.
Qed.

(* Why3 goal *)
Definition of_int : Numbers.BinNums.Z -> t.
  exact (fun x => nat_to_bvec size_nat (Z.to_nat x)).
Defined.

(* Why3 goal *)
Definition to_int : t -> Numbers.BinNums.Z.
  exact (twos_complement size_nat).
Defined.

(* Why3 goal *)
Lemma to_int_def :
  forall (x:t),
  (is_signed_positive x -> ((to_int x) = (to_uint x))) /\
  (~ is_signed_positive x ->
   ((to_int x) = (-(two_power_size - (to_uint x))%Z)%Z)).
  intros. split.
  - unfold to_int, to_uint,is_signed_positive, twos_complement, size_nat.
    intros.
    assert (Bsign last_bit x = false).
    {
      destruct Bsign; try (now destruct H); auto.
    }
    rewrite H0. reflexivity.

  - unfold two_power_size, to_int, to_uint,is_signed_positive,
           twos_complement, size, size_nat.
    intros.
    assert (Bsign last_bit x = true).
    {
      destruct Bsign; try (now destruct H); auto.
    }
    rewrite H0. ring.
Qed.

(* Why3 goal *)
Lemma to_uint_extensionality :
  forall (v:t) (v':t), ((to_uint v) = (to_uint v')) -> (v = v').
  unfold to_uint.
  intros v v'.
  rewrite Nat2Z.inj_iff.
  apply bvec_to_nat_extensionality.
Qed.

(* Why3 goal *)
Lemma to_int_extensionality :
  forall (v:t) (v':t), ((to_int v) = (to_int v')) -> (v = v').
  apply twos_complement_extensionality.
Qed.

(* Why3 assumption *)
Definition uint_in_range (i:Numbers.BinNums.Z) : Prop :=
  (0%Z <= i)%Z /\ (i <= max_int)%Z.

(* Why3 goal *)
Lemma to_uint_bounds :
  forall (v:t), (0%Z <= (to_uint v))%Z /\ ((to_uint v) < two_power_size)%Z.
  intros v.
  unfold to_uint, uint_in_range.
  split.
  omega.
  assert (two_power_size = Z.of_nat (Z.to_nat two_power_size)).
  rewrite Z2Nat.id.
  easy.
  unfold two_power_size, size.
  transitivity (Pow2int.pow2 (Z.of_nat size_nat) - 1);[apply max_int_nat|omega].
  rewrite H.
  apply inj_lt.
  apply bvec_to_nat_range.
Qed.

Lemma uint_in_range_power : forall (v:Z), uint_in_range v <-> (0 <= v < two_power_size).
  unfold uint_in_range, max_int, two_power_size.
  split; intros; auto with zarith.
Qed.

(* to_uint helper lemmas *)

Lemma to_uint_lsr_aux : forall (v:t) (n:nat), ((to_uint (lsr v
  (Z.of_nat n))) = (div (to_uint v) (Pow2int.pow2 (Z.of_nat n)))).
  unfold div.
  intros; case Z_le_dec; [|intro e; destruct e; apply Z_mod_lt, lt_sym, Pow2int.pow2pos; omega].
  revert v n.
  induction n; intro.
  simpl.
  assert (lsr v 0 = v) as H by easy; rewrite H; symmetry; apply Zdiv_1_r.
  unfold lsr.
  rewrite Nat2Z.id.
  simpl BshiftRl_iter.
  unfold BshiftRl, Bhigh, to_uint, div.
  rewrite bvec_to_nat_tl.
  rewrite bvec_to_nat_shiftin.
  rewrite Nat2Z.inj_succ, <-Z.add_1_r, Pow2int.Power_s by omega.
  rewrite Z.mul_comm, <-Zdiv_Zdiv.
  rewrite <- Nat2Z.id with (n := n).
  change (to_uint (lsr v (Z.of_nat n)) / 2 =
          to_uint v / Pow2int.pow2 (Z.of_nat (Z.to_nat (Z.of_nat n))) / 2).
  rewrite Nat2Z.id.
  rewrite IHn.
  omega.
  apply Z_mod_lt, lt_sym, Pow2int.pow2pos; omega.
  apply Z.lt_le_incl, Pow2int.pow2pos; omega.
  omega.
Qed.

Lemma size_in_range: uint_in_range size.
  unfold uint_in_range, max_int, size, size.
  split; [omega|apply Z.lt_le_pred, id_lt_pow2].
Qed.

Lemma mod1_in_range : forall x, uint_in_range (mod1 x two_power_size).
  split;[|apply Zlt_succ_le;rewrite <-Z.add_1_r, <-max_int_S];
  apply Mod_bound; easy.
Qed.

Lemma mod1_in_range2 : forall x, 0 <= mod1 x two_power_size < two_power_size.
  intro; apply Mod_bound; easy.
Qed.

Lemma to_uint_nat : forall v, (0 <= to_uint v)%Z.
  apply to_uint_bounds.
Qed.

Lemma to_uint_lsl_aux : forall (v:t) (n:nat), ((to_uint (lsl v
  (Z.of_nat n))) = (mod1 ((to_uint v) * (Pow2int.pow2 (Z.of_nat n)))%Z
  two_power_size)).
  intros v n.
  rewrite mod1_is_mod.
  Focus 2.
  easy.
  induction n.
  simpl.
  apply Zmod_unique with (q := 0).
  apply to_uint_bounds.
  assert (lsl v 0 = v) as H by easy; rewrite H; omega.
  unfold lsl.
  rewrite Nat2Z.id.
  unfold BshiftL, Bcons, to_uint.
  simpl BshiftL_iter.
  rewrite <- Nat2Z.id with (n := n).
  change (Z.of_nat (2 * bvec_to_nat last_bit (Vector.shiftout (lsl v (Z.of_nat n)))) = (Z.of_nat (bvec_to_nat size_nat v) * Pow2int.pow2 (Z.of_nat (S (Z.to_nat (Z.of_nat n)))))  mod two_power_size)%Z.
  rewrite Nat2Z.id.
  rewrite Nat2Z.inj_mul.
  rewrite bvec_to_nat_shiftout_mod1.
  change (2 * ((to_uint (lsl v (Z.of_nat n))) mod (Pow2int.pow2 (Z.of_nat last_bit))) = (to_uint v * Pow2int.pow2 (Z.of_nat (S n))) mod two_power_size).
  unfold two_power_size.
  rewrite size_int_S, Nat2Z.inj_succ, <-Z.add_1_r, Pow2int.Power_s by omega.
  rewrite Zmult_assoc, Int.Comm1 with (y := 2), <-Z.add_1_r, Pow2int.Power_s by omega.
  rewrite Zmult_assoc_reverse, Zmult_mod_distr_l.
  rewrite Z.mul_cancel_l by omega.
  rewrite IHn.
  unfold two_power_size.
  rewrite size_int_S, <-Z.add_1_r, Pow2int.Power_s by omega.
  apply mod_mod_mult.
  apply lt_sym, Pow2int.pow2pos; omega.
  omega.
Qed.
(* end of to_uint helpers *)

(* Why3 goal *)
Lemma to_uint_of_int :
  forall (i:Numbers.BinNums.Z), (0%Z <= i)%Z /\ (i < two_power_size)%Z ->
  ((to_uint (of_int i)) = i).
  intros i h1; destruct h1.
  unfold to_uint, of_int.
  rewrite bvec_to_nat_nat_to_bvec.
  apply Z2Nat.id; easy.
  rewrite Z2Nat.id; [fold size; fold two_power_size; omega|easy].
Qed.

(* Why3 goal *)
Definition size_bv : t.
  exact (of_int size).
Defined.

(* Why3 goal *)
Lemma to_uint_size_bv : ((to_uint size_bv) = size).
  apply to_uint_of_int.
  rewrite max_int_S.
  destruct size_in_range; auto with zarith.
Qed.

Lemma Of_int_zeros: zeros = of_int 0.
apply Nat_to_bvec_zeros.
Qed.

(* Why3 goal *)
Lemma to_uint_zeros : ((to_uint zeros) = 0%Z).
  rewrite Of_int_zeros.
  apply to_uint_of_int; easy.
Qed.

Lemma to_uint_one_aux : forall {l}, bvec_to_nat (S l) (one_aux l) = 1%nat.
  intro l.
  simpl.
  rewrite bvec_to_nat_zeros.
  auto with zarith.
Qed.

Lemma Of_int_one_aux : forall {l}, one_aux l = nat_to_bvec (S l) 1%nat.
  intro l.
  apply bvec_to_nat_extensionality.
  rewrite bvec_to_nat_nat_to_bvec.
  apply to_uint_one_aux.
  pose proof (id_lt_pow2 l).
  zify.
  auto with zarith.
Qed.

(* Why3 goal *)
Lemma to_uint_one : ((to_uint one) = 1%Z).
  unfold to_uint, one.
  simpl.
  rewrite bvec_to_nat_zeros.
  auto with zarith.
Qed.

Lemma Of_int_one : one = of_int 1.
  apply Of_int_one_aux.
Qed.

Lemma Of_int_ones: ones = of_int max_int.
  apply Nat_to_bvec_ones.
Qed.

(* Why3 goal *)
Lemma to_uint_ones : ((to_uint ones) = max_int).
  rewrite Of_int_ones.
  apply to_uint_of_int.
  rewrite max_int_S.
  destruct size_in_range; auto with zarith.
Qed.

(* Why3 assumption *)
Definition ult (x:t) (y:t) : Prop := ((to_uint x) < (to_uint y))%Z.

(* Why3 assumption *)
Definition ule (x:t) (y:t) : Prop := ((to_uint x) <= (to_uint y))%Z.

(* Why3 assumption *)
Definition ugt (x:t) (y:t) : Prop := ((to_uint y) < (to_uint x))%Z.

(* Why3 assumption *)
Definition uge (x:t) (y:t) : Prop := ((to_uint y) <= (to_uint x))%Z.

(* Why3 assumption *)
Definition slt (v1:t) (v2:t) : Prop := ((to_int v1) < (to_int v2))%Z.

(* Why3 assumption *)
Definition sle (v1:t) (v2:t) : Prop := ((to_int v1) <= (to_int v2))%Z.

(* Why3 assumption *)
Definition sgt (v1:t) (v2:t) : Prop := ((to_int v2) < (to_int v1))%Z.

(* Why3 assumption *)
Definition sge (v1:t) (v2:t) : Prop := ((to_int v2) <= (to_int v1))%Z.

Lemma zeros_sign_aux: forall A n (h: A), Vector.last (Vector.const h (S n)) = h.
  induction n; eauto.
Qed.

Lemma zeros_sign_false: Bsign last_bit zeros = false.
  apply zeros_sign_aux.
Qed.

(* Why3 goal *)
Lemma positive_is_ge_zeros :
  forall (x:t), is_signed_positive x <-> sge x zeros.
  intros.
  unfold is_signed_positive, sge, to_int, twos_complement, size_nat.
  rewrite zeros_sign_false. destruct Bsign.
  intuition.
  unfold zeros, zeros_aux, size_nat in *. rewrite bvec_to_nat_zeros in H.
  generalize (bvec_to_nat_range x). intros.
  simpl (Z.of_nat 0) in H.
  assert (Pow2int.pow2 (Z.of_nat (S last_bit)) <= Z.of_nat (bvec_to_nat (S last_bit) x)).
  omega. unfold size_nat in *.
  apply Z2Nat.inj_le in H1; try omega.
  rewrite Nat2Z.id in H1; try omega.
  eapply Zle_trans. apply (max_int_nat (S last_bit)). omega.

  intuition.
  unfold zeros, zeros_aux.
  rewrite bvec_to_nat_zeros. simpl. omega.
Qed.

(* Why3 goal *)
Definition add : t -> t -> t.
  exact (fun v v' => of_int (mod1 (to_uint v + to_uint v') two_power_size)).
Defined.

(* Why3 goal *)
Lemma to_uint_add :
  forall (v1:t) (v2:t),
  ((to_uint (add v1 v2)) =
   (int.EuclideanDivision.mod1 ((to_uint v1) + (to_uint v2))%Z
    two_power_size)).
  intros v1 v2.
  apply to_uint_of_int.
  apply mod1_in_range2.
Qed.

(* Why3 goal *)
Lemma to_uint_add_bounded :
  forall (v1:t) (v2:t),
  (((to_uint v1) + (to_uint v2))%Z < two_power_size)%Z ->
  ((to_uint (add v1 v2)) = ((to_uint v1) + (to_uint v2))%Z).
  intros v1 v2 h1.
  rewrite <-(mod1_out (to_uint v1 + to_uint v2) two_power_size).
  apply to_uint_add.
  split; [apply OMEGA2; apply to_uint_nat|auto].
Qed.

(* Why3 goal *)
Definition sub : t -> t -> t.
  exact (fun v v' => of_int (mod1 (to_uint v - to_uint v') two_power_size)).
Defined.

(* Why3 goal *)
Lemma to_uint_sub :
  forall (v1:t) (v2:t),
  ((to_uint (sub v1 v2)) =
   (int.EuclideanDivision.mod1 ((to_uint v1) - (to_uint v2))%Z
    two_power_size)).
  intros v1 v2.
  apply to_uint_of_int, mod1_in_range2.
Qed.

(* Why3 goal *)
Lemma to_uint_sub_bounded :
  forall (v1:t) (v2:t),
  (0%Z <= ((to_uint v1) - (to_uint v2))%Z)%Z /\
  (((to_uint v1) - (to_uint v2))%Z < two_power_size)%Z ->
  ((to_uint (sub v1 v2)) = ((to_uint v1) - (to_uint v2))%Z).
  intros v1 v2 (h1,h2).
  rewrite <-(mod1_out (to_uint v1 - to_uint v2) two_power_size) by auto.
  apply to_uint_sub.
Qed.

(* Why3 goal *)
Definition neg : t -> t.
  exact (fun v => of_int (mod1 (- to_uint v) two_power_size)).
Defined.

(* Why3 goal *)
Lemma to_uint_neg :
  forall (v:t),
  ((to_uint (neg v)) =
   (int.EuclideanDivision.mod1 (-(to_uint v))%Z two_power_size)).
  intros v.
  apply to_uint_of_int, mod1_in_range2.
Qed.

(* Why3 goal *)
Definition mul : t -> t -> t.
  exact (fun v v' => of_int (mod1 (to_uint v * to_uint v') two_power_size)).
Defined.

(* Why3 goal *)
Lemma to_uint_mul :
  forall (v1:t) (v2:t),
  ((to_uint (mul v1 v2)) =
   (int.EuclideanDivision.mod1 ((to_uint v1) * (to_uint v2))%Z
    two_power_size)).
  intros v1 v2.
  apply to_uint_of_int, mod1_in_range2.
Qed.

(* Why3 goal *)
Lemma to_uint_mul_bounded :
  forall (v1:t) (v2:t),
  (((to_uint v1) * (to_uint v2))%Z < two_power_size)%Z ->
  ((to_uint (mul v1 v2)) = ((to_uint v1) * (to_uint v2))%Z).
  intros v1 v2 h1.
  rewrite <-(mod1_out (to_uint v1 * to_uint v2) two_power_size).
  apply to_uint_mul.
  split.
  apply Z.mul_nonneg_nonneg; apply to_uint_nat.
  easy.
Qed.

(* Why3 goal *)
Definition udiv : t -> t -> t.
  exact (fun v v' => of_int (div (to_uint v) (to_uint v'))).
Defined.

(* Why3 goal *)
Lemma to_uint_udiv :
  forall (v1:t) (v2:t),
  ((to_uint (udiv v1 v2)) =
   (int.EuclideanDivision.div (to_uint v1) (to_uint v2))).
  intros v1 v2.
  apply to_uint_of_int.
  case (Z.eq_dec (to_uint v2) 0); intro.
  rewrite e; unfold uint_in_range, div.
  rewrite Zmod_0_r; simpl.
  rewrite Zdiv_0_r.
  split; [easy|apply Pow2int.pow2pos;easy].
  split.
  apply Div_bound; split;[|apply Z.le_neq;split;[|auto]];apply to_uint_nat.
  apply (Z.le_lt_trans _ (to_uint v1)).
  apply Div_bound; split;[|apply Z.le_neq;split;[|auto]];apply to_uint_nat.
  apply to_uint_bounds.
Qed.

(* Why3 goal *)
Definition urem : t -> t -> t.
  exact (fun v v' => of_int (mod1 (to_uint v) (to_uint v'))).
Defined.

(* Why3 goal *)
Lemma to_uint_urem :
  forall (v1:t) (v2:t),
  ((to_uint (urem v1 v2)) =
   (int.EuclideanDivision.mod1 (to_uint v1) (to_uint v2))).
  intros v1 v2.
  apply to_uint_of_int.
  case (Z.eq_dec (to_uint v2) 0); intro.
  rewrite e.
  unfold uint_in_range, mod1; simpl.
  rewrite <- Zminus_0_l_reverse; apply to_uint_bounds.
  split.
  apply Mod_bound; trivial.
  apply (Z.lt_trans _ (Z.abs (to_uint v2))).
  apply Mod_bound; trivial.
  rewrite Z.abs_eq; apply to_uint_bounds.
Qed.

(* Why3 goal *)
Definition lsr_bv : t -> t -> t.
  exact (fun v w => lsr v (to_uint w)).
Defined.

(* Why3 goal *)
Lemma lsr_bv_is_lsr :
  forall (x:t) (n:t), ((lsr_bv x n) = (lsr x (to_uint n))).
  easy.
Qed.

(* Why3 goal *)
Lemma to_uint_lsr :
  forall (v:t) (n:t),
  ((to_uint (lsr_bv v n)) =
   (int.EuclideanDivision.div (to_uint v) (bv.Pow2int.pow2 (to_uint n)))).
  intros v n.
  apply to_uint_lsr_aux.
Qed.

(* Why3 goal *)
Definition asr_bv : t -> t -> t.
  exact (fun v w => asr v (to_uint w)).
Defined.

(* Why3 goal *)
Lemma asr_bv_is_asr :
  forall (x:t) (n:t), ((asr_bv x n) = (asr x (to_uint n))).
  easy.
Qed.

(* Why3 goal *)
Definition lsl_bv : t -> t -> t.
  exact (fun v w => lsl v (to_uint w)).
Defined.

(* Why3 goal *)
Lemma lsl_bv_is_lsl :
  forall (x:t) (n:t), ((lsl_bv x n) = (lsl x (to_uint n))).
  easy.
Qed.

(* Why3 goal *)
Lemma to_uint_lsl :
  forall (v:t) (n:t),
  ((to_uint (lsl_bv v n)) =
   (int.EuclideanDivision.mod1
    ((to_uint v) * (bv.Pow2int.pow2 (to_uint n)))%Z two_power_size)).
  intros v n.
  apply to_uint_lsl_aux.
Qed.

(* Why3 goal *)
Definition rotate_right_bv : t -> t -> t.
  exact (fun b p => rotate_right b (to_uint p)).
Defined.

(* Why3 goal *)
Definition rotate_left_bv : t -> t -> t.
  exact (fun b p => rotate_left b (to_uint p)).
Defined.

(* Why3 goal *)
Lemma rotate_left_bv_is_rotate_left :
  forall (v:t) (n:t), ((rotate_left_bv v n) = (rotate_left v (to_uint n))).
trivial.
Qed.

(* Why3 goal *)
Lemma rotate_right_bv_is_rotate_right :
  forall (v:t) (n:t), ((rotate_right_bv v n) = (rotate_right v (to_uint n))).
trivial.
Qed.

(* Why3 goal *)
Definition nth_bv : t -> t -> Init.Datatypes.bool.
  exact (fun v w => nth v (to_uint w)).
Defined.

Lemma and_zeros : forall {l} (x:Vector.t bool l),
                   Vector.map2 (fun a b => a && b) x zeros_aux = zeros_aux.
  induction x; auto.
  simpl.
  rewrite andb_false_r.
  fold (@zeros_aux n).
  rewrite IHx; reflexivity.
Qed.

Lemma nth_bv_def_aux : forall {l} (x:Vector.t bool (S l)) (i:Z),
                         nth_aux x 0 = true <-> (Vector.map2 (fun a b => a && b) x (one_aux l)) <> zeros_aux.
  intros.
  rewrite Of_int_one_aux.
  destruct x.
  simpl.
  split; [easy|auto].
  rewrite nth_zeros_is_hd; unfold Vector.hd.
  simpl.
  rewrite <-Nat_to_bvec_zeros, and_zeros.
  rewrite andb_true_r.
  split; intro.
  rewrite H; easy.
  revert H; case h; auto.
Qed.

(* Why3 goal *)
Lemma nth_bv_def :
  forall (x:t) (i:t),
  ((nth_bv x i) = Init.Datatypes.true) <->
  ~ ((bw_and (lsr_bv x i) one) = zeros).
  intros; unfold nth_bv.
  case (Z_lt_ge_dec (to_uint i) size); intro.
  rewrite <-(Zplus_0_l (to_uint i)).
  rewrite <-Lsr_nth_low; auto with zarith.
  fold (lsr_bv x i).
  set (lsr_bv x i).
  apply (nth_bv_def_aux t0 0).
  apply to_uint_bounds.
  unfold nth.
  rewrite (nth_high x (to_uint i)); auto.
  assert (tmmp: forall x i, to_uint i >= size -> lsr_bv x i = zeros_aux).
    intros.
    apply Extensionality_aux; unfold eq_aux; intros.
    unfold lsr_bv, zeros_aux.
    rewrite nth_const by auto.
    apply Lsr_nth_high.
    unfold size in H; auto with zarith.
    easy.
    auto with zarith.
  rewrite tmmp by auto.
  split; intro.
  assert False by easy; auto.
  destruct H.
  apply Extensionality_aux; unfold eq_aux; intros.
  rewrite Nth_bw_and by auto.
  unfold nth, zeros, zeros_aux.
  rewrite nth_const by auto.
  easy.
Qed.

(* Why3 goal *)
Lemma Nth_bv_is_nth :
  forall (x:t) (i:t), ((nth x (to_uint i)) = (nth_bv x i)).
  trivial.
Qed.

(* Why3 goal *)
Lemma Nth_bv_is_nth2 :
  forall (x:t) (i:Numbers.BinNums.Z),
  (0%Z <= i)%Z /\ (i < two_power_size)%Z ->
  ((nth_bv x (of_int i)) = (nth x i)).
  intros x i h1.
  rewrite <-Nth_bv_is_nth.
  rewrite to_uint_of_int by auto.
  reflexivity.
Qed.

(* Why3 goal *)
Definition eq_sub_bv : t -> t -> t -> t -> Prop.
  exact (fun a b i n =>
           let mask := (lsl_bv (sub (lsl_bv (of_int 1%Z) n) (of_int 1%Z)) i)
           in ((bw_and b mask) = (bw_and a mask))).
Defined.

(* Why3 goal *)
Lemma eq_sub_bv_def :
  forall (a:t) (b:t) (i:t) (n:t),
  let mask := lsl_bv (sub (lsl_bv one n) one) i in
  eq_sub_bv a b i n <-> ((bw_and b mask) = (bw_and a mask)).
  rewrite Of_int_one.
  easy.
Qed.

(* Why3 assumption *)
Definition eq_sub (a:t) (b:t) (i:Numbers.BinNums.Z) (n:Numbers.BinNums.Z) :
    Prop :=
  forall (j:Numbers.BinNums.Z), (i <= j)%Z /\ (j < (i + n)%Z)%Z ->
  ((nth a j) = (nth b j)).

Lemma in_range_1 : uint_in_range 1.
  split; auto with zarith.
  change (Z.succ 0 <= max_int)%Z; apply Zlt_le_succ.
  unfold max_int, size, size.
  apply Zlt_succ_pred.
  apply Z.le_lt_trans with (m := Z.of_nat (S last_bit)).
  rewrite Nat2Z.inj_succ; auto with zarith.
  apply id_lt_pow2.
Qed.

Lemma in_range_1' : 0 <= 1 < two_power_size.
  split; auto with zarith.
  rewrite max_int_S, Z.add_1_r.
  apply Zle_lt_succ, in_range_1.
Qed.

Lemma max_int_neq_1 : max_int + 1 <> 0.
  intro; symmetry in H; revert H.
  apply Z.lt_neq, Zle_lt_succ, max_int_nat.
Qed.

(* mask (S n) = lsl (mask n) 1 + 1 *)
Lemma mask_succ :
  forall n,
    sub (lsl (of_int 1) (Z.of_nat (S n))) (of_int 1%Z)
    = add (lsl (sub (lsl (of_int 1%Z) (Z.of_nat n)) (of_int 1%Z)) (Z.of_nat 1)) (of_int 1%Z).
  intro; apply to_uint_extensionality.
  rewrite to_uint_add.
  rewrite to_uint_lsl_aux.
  assert (Pow2int.pow2 (Z.of_nat 1) = 2) as tmp by auto with zarith; rewrite tmp.
  symmetry; rewrite to_uint_sub; symmetry.
  rewrite to_uint_of_int by (apply in_range_1').
  rewrite mod1_is_mod,mod1_is_mod,mod1_is_mod by easy.
  rewrite Z.mul_mod_idemp_l by easy.
  rewrite Z.mul_sub_distr_r.
  rewrite <- Zminus_mod_idemp_l.
  rewrite to_uint_lsl_aux.
  rewrite mod1_is_mod by easy.
  rewrite Z.mul_mod_idemp_l by easy.
  rewrite Zmult_assoc_reverse, (Int.Comm1 (Pow2int.pow2 (Z.of_nat n)) 2).
  rewrite <-Pow2int.Power_s by omega.
  rewrite <-mod1_is_mod with (x := to_uint (of_int 1) * Pow2int.pow2 (Z.of_nat n + 1)) by easy.
  rewrite Z.add_1_r with (n := Z.of_nat n).
  rewrite <- Nat2Z.inj_succ.
  rewrite <-to_uint_lsl_aux.
  rewrite Zplus_mod_idemp_l.
  rewrite <-Z.sub_sub_distr.
  assert (1 * 2 - 1 = to_uint (of_int 1)).
  simpl; symmetry; apply to_uint_of_int; apply in_range_1'.
  rewrite H.
  rewrite <-mod1_is_mod by easy.
  apply to_uint_sub.
Qed.

Definition add_aux {l} (v w : Vector.t bool l) : Vector.t bool l :=
     nat_to_bvec l (Z.to_nat (mod1
        (Z.of_nat (bvec_to_nat l v) + Z.of_nat (bvec_to_nat l w))
        (Pow2int.pow2 (Z.of_nat l)))).

Lemma mask_succ_tmp :
  forall n,
    add (lsl (sub (lsl (of_int 1%Z) (Z.of_nat n)) (of_int 1%Z)) (Z.of_nat 1)) (of_int 1%Z)
    = bw_or (lsl (sub (lsl (of_int 1%Z) (Z.of_nat n)) (of_int 1%Z)) (Z.of_nat 1)) (of_int 1%Z).
  intro.

  assert (add_and_or :
    forall v, nth v 0 = false ->
              add v (of_int 1) = bw_or v (of_int 1)).
  assert (add_is_add_aux : forall v w, add v w = add_aux v w) by auto.
  assert (add_and_or_aux :
      forall {l} v, @nth_aux l v 0 = false ->
                    add_aux v (nat_to_bvec l 1)
                    = Vector.map2 (fun x y => x || y) v (nat_to_bvec l 1)).
      destruct v; auto.
      intro.
      assert (h = false) as hf by auto; rewrite hf.
      simpl.
      unfold add_aux.
      change (
          nat_to_bvec (S n0)
                      (Z.to_nat
                         (mod1
                            (Z.of_nat (2 * (bvec_to_nat n0 v)) +
                             Z.of_nat (1 + 2 * (bvec_to_nat n0 (nat_to_bvec n0 0))))
                            (Pow2int.pow2 (Z.of_nat (S n0))))) =
          true :: Vector.map2 (fun x y : bool => x || y) v (nat_to_bvec n0 0)).
      rewrite <-Nat_to_bvec_zeros, bvec_to_nat_zeros.
      change (Z.of_nat (1 + 2 * 0)) with 1.
      set (mod1 (Z.of_nat (2 * bvec_to_nat n0 v) + 1)
           (Pow2int.pow2 (Z.of_nat (S n0)))).
      simpl nat_to_bvec.
      rewrite Z2Nat.id by (apply mod1_nat, Z.lt_le_pred, max_int_nat).
      assert (H0: Z.odd z = true).
        subst z.
        rewrite Zodd_mod, mod1_is_mod by auto with zarith.
        rewrite Nat2Z.inj_succ, <- Z.add_1_r, Pow2int.Power_s by auto with zarith.
        rewrite Int.Comm1, (mod_mod_mult _ 2 _)by auto with zarith.
        rewrite <-Zodd_mod, Int.Comm, Nat2Z.inj_mul, Z.odd_add_mul_2; trivial.
      rewrite H0.
      cut (nat_to_bvec n0 (Div2.div2 (Z.to_nat z))
           = Vector.map2 (fun x y : bool => x || y) v (Vector.const false n0)).
      intro t; rewrite t; trivial.
      case (Z_lt_le_dec (Z.of_nat (2 * bvec_to_nat n0 v) + 1) (Pow2int.pow2 (Z.of_nat (S n0)))); intro.
      subst z.
      revert H0.
      rewrite mod1_out by auto with zarith.
      rewrite Z.add_1_r.
      intro.
      rewrite <-Nat2Z.inj_succ, Nat2Z.id.
      rewrite Z.odd_succ, <-even_is_even in H0.
      rewrite <-(Div2.even_div2 _ H0), Div2.div2_double.
      assert (nat_to_bvec_bvec_to_nat:
        forall {l} v, nat_to_bvec l (bvec_to_nat l v) = v).
        intros; apply bvec_to_nat_extensionality.
        apply bvec_to_nat_nat_to_bvec.
        apply Z.lt_le_pred.
        rewrite <-Z2Nat.id by (transitivity (Pow2int.pow2 (Z.of_nat l0) - 1);
             [apply max_int_nat|auto with zarith]).
        apply inj_lt, bvec_to_nat_range.
      rewrite nat_to_bvec_bvec_to_nat.
      assert (tmp2:
        forall {l} v,
          Vector.map2 (fun x y : bool => x || y) v (Vector.const false l) = v).
        induction v0; auto.
        simpl.
        rewrite orb_false_r.
        rewrite IHv0; trivial.
      symmetry; apply tmp2.
      absurd (Z.of_nat (bvec_to_nat n0 v) < Pow2int.pow2 (Z.of_nat n0)).
      apply Zle_not_lt.
      rewrite Nat2Z.inj_succ in l.
      rewrite <- Z.add_1_r, Pow2int.Power_s in l by auto with zarith.
      apply Zle_lt_succ in l.
      rewrite <-Z.add_1_r, Zplus_assoc_reverse, Nat2Z.inj_mul in l.
      simpl (1 + 1) in l.
      rewrite Zred_factor3 in l.
      rewrite <-(Z.mul_lt_mono_pos_l 2) in l by omega.
      rewrite Z.add_1_l in l.
      apply Zlt_succ_le in l; trivial.
      rewrite Z2Nat.inj_lt, Nat2Z.id.
      apply (bvec_to_nat_range v).
      auto with zarith.
      transitivity (Pow2int.pow2 (Z.of_nat n0) - 1).
      apply max_int_nat.
      auto with zarith.
    intros.
    rewrite add_is_add_aux.
    apply add_and_or_aux.
    trivial.
  simpl.
  apply add_and_or.
  intros; apply Lsl_nth_low; auto with zarith.
Qed.

Lemma mask_succ_2 :
  forall n,
    sub (lsl (of_int 1) (Z.of_nat (S n))) (of_int 1%Z)
  = bw_or (lsl (sub (lsl (of_int 1%Z) (Z.of_nat n)) (of_int 1%Z)) (Z.of_nat 1)) (of_int 1%Z).
  intro; rewrite mask_succ.
  apply mask_succ_tmp.
Qed.

Lemma nth_bit_pred_high :
  forall n i,
    to_uint i < size ->
    to_uint i < Z.of_nat n ->
    nth_bv (sub (lsl (of_int 1%Z) (Z.of_nat n)) (of_int 1%Z)) i = true.
Proof.
  induction n;intros.
  assert (Z.of_nat 0 <= to_uint i) by apply to_uint_bounds.
  omega.
  rewrite <-Nth_bv_is_nth.
  rewrite mask_succ_2; simpl.
  unfold bw_or, nth.
  rewrite <-nth_aux_map2.
  Focus 2.
  split; auto with zarith.
  apply to_uint_bounds.

  apply orb_true_iff.
  case (Z_lt_le_dec (to_uint i) 1); intro.
  right.
  assert (to_uint i = 0).
    assert (H' := to_uint_bounds i).
    omega.
  rewrite H1; apply nth_zeros_is_hd.

  left.
  rewrite Lsl_nth_high; auto with zarith.

  assert (to_uint i - 1 = to_uint (sub i (of_int 1))).
  rewrite to_uint_sub by auto with zarith.
  rewrite to_uint_of_int by (apply in_range_1').
  rewrite mod1_out; trivial.
  split; auto with zarith.
  apply (Z.lt_trans _ (to_uint i)).
  omega.
  apply to_uint_bounds.

  rewrite H1, Nth_bv_is_nth.
  apply IHn; rewrite <-H1; rewrite Nat2Z.inj_succ in H0; omega.
Qed.

  Lemma one_nth: forall {l},
    nat_to_bvec (S l) 1
    = Vector.cons bool true l (Vector.const false _).
    intro.
    change (Bcons (Z.odd (Z.of_nat 1)) l (nat_to_bvec l (Div2.div2 1)) = true :: Vector.const false l).
    assert (Z.odd (Z.of_nat 1) = true) by auto with zarith.
    rewrite H.
    assert (Div2.div2 1 = 0%nat) by auto with zarith.
    rewrite H0.
    assert (nat_to_bvec l 0 = Vector.const false l).
    induction l.
    auto.
    change (Bcons (Z.odd (Z.of_nat 0)) l (nat_to_bvec l (Div2.div2 0)) = false :: Vector.const false l).
    rewrite <-IHl; auto.
    rewrite H1; trivial.
  Qed.

Lemma nth_bit_pred_low :
  forall n i,
    to_uint i >= Z.of_nat n ->
    nth_bv (sub (lsl (of_int 1%Z) (Z.of_nat n)) (of_int 1%Z)) i = false.
  induction n;intros.
  assert (lsl (of_int 1) (Z.of_nat 0) = of_int 1) as h by auto with zarith; rewrite h.
  assert (sub (of_int 1) (of_int 1) = of_int 0).
  apply to_uint_extensionality.
  rewrite to_uint_sub, to_uint_of_int, to_uint_of_int.
  apply mod1_out.
  split; [omega|apply Pow2int.pow2pos, Z.lt_le_incl, size_pos].
  split; [omega|apply Pow2int.pow2pos, Z.lt_le_incl, size_pos].
  apply in_range_1'.
  rewrite H0, <-Of_int_zeros.
  apply Nth_zeros.

  rewrite Nat2Z.inj_succ in H.
  rewrite <-Nth_bv_is_nth, mask_succ_2; simpl.

  unfold bw_or, nth.
  case (Z_lt_ge_dec (to_uint i) size); intro.
  rewrite <-nth_aux_map2 by (split; auto with zarith).

  apply orb_false_iff.
  split.
  rewrite Lsl_nth_high; auto with zarith.
  assert (to_uint i - 1 = to_uint (sub i (of_int 1))).
  rewrite to_uint_sub by auto with zarith.
  rewrite to_uint_of_int by (apply in_range_1').
  rewrite mod1_out; trivial.
  split; auto with zarith.
  apply (Z.lt_trans _ (to_uint i)).
  omega.
  apply to_uint_bounds.
  rewrite H0,Nth_bv_is_nth.
  apply IHn.
  rewrite <-H0; omega.
  assert (to_uint i > 0) by omega.
  unfold of_int, size, size_nat.
  rewrite one_nth.
  rewrite nth_cons_pred by auto with zarith.
  apply Nth_zeros_aux.
  apply nth_aux_out_of_bound.
  fold size; omega.
Qed.

Lemma mask_correctness :
  forall (i:t) (n:t),
    let mask := lsl_bv (sub (lsl_bv (of_int 1%Z) n) (of_int 1%Z)) i in
    forall (j:Z),
      (j < size -> (to_uint i) <= j -> j < (to_uint i + to_uint n)%Z -> nth mask j = true)
   /\ (j < to_uint i \/ j >= to_uint i + to_uint n -> nth mask j = false).
Proof.
  split;intros.
  rewrite lsl_bv_is_lsl.
  assert (a := to_uint_bounds i).
  assert (u := size_in_range).
  rewrite uint_in_range_power in u.
  rewrite Lsl_nth_high; auto with zarith.
  assert (j - to_uint i = to_uint (sub (of_int j) i)).
  rewrite to_uint_sub by omega.
  rewrite to_uint_of_int by (split; auto with zarith).
  rewrite mod1_out by auto with zarith; trivial.
  rewrite H2.
  rewrite Nth_bv_is_nth by omega.
  apply nth_bit_pred_high; auto with zarith.
  rewrite <-H2.
  fold (to_uint n); auto with zarith.
  destruct H.
  case (Z_lt_le_dec j 0); intro.
  apply nth_low; easy.
  rewrite lsl_bv_is_lsl.
  apply Lsl_nth_low; auto with zarith.

  rewrite lsl_bv_is_lsl.
  assert (u := to_uint_bounds i).
  assert (v := to_uint_bounds n).
  pose size_in_range as w; rewrite uint_in_range_power in w.
  assert (0 <= j) by auto with zarith.

  case (Z_lt_ge_dec j size); intro.
  case (Z_lt_ge_dec j (to_uint i)); intro.

  apply Lsl_nth_low; auto.

  rewrite Lsl_nth_high; auto with zarith.
  rewrite lsl_bv_is_lsl.
  assert (j - to_uint i = to_uint (sub (of_int j) i)).
  rewrite to_uint_sub.
  rewrite to_uint_of_int by (unfold uint_in_range; auto with zarith).
  rewrite mod1_out; auto with zarith.
  rewrite H1.
  rewrite Nth_bv_is_nth.
  apply nth_bit_pred_low.
  fold (to_uint n).
  rewrite <-H1; auto with zarith.

  apply nth_high; auto.
Qed.

(* Why3 goal *)
Lemma eq_sub_equiv :
  forall (a:t) (b:t) (i:t) (n:t),
  eq_sub a b (to_uint i) (to_uint n) <-> eq_sub_bv a b i n.
Proof.
  intros a b i n.
  unfold eq_sub, eq_sub_bv.
  transitivity (eq_aux (bw_and b (lsl_bv (sub (lsl_bv (of_int 1) n) (of_int 1)) i))
                       (bw_and a (lsl_bv (sub (lsl_bv (of_int 1) n) (of_int 1)) i))); unfold eq_aux.
  Focus 2.
  split.
  apply Extensionality_aux.
  intro e; rewrite e; reflexivity.
  split; intros.

  fold nth; rewrite Nth_bw_and, Nth_bw_and by auto.
  case (Z_lt_ge_dec n0 (to_uint i + to_uint n)); intro.
  case (Z_le_gt_dec (to_uint i) n0); intro.

  rewrite H; auto.

  rewrite (match (mask_correctness i n n0) with conj a b => b (or_introl (Z.gt_lt _ _ g)) end).
  rewrite andb_false_r, andb_false_r; reflexivity.

  rewrite (match (mask_correctness i n n0) with conj a b => b (or_intror g) end).
  rewrite andb_false_r, andb_false_r; reflexivity.

  case (Z_lt_ge_dec j size); intro.

  assert (u := to_uint_bounds i); unfold uint_in_range in u.
  assert (0 <= j < Z.of_nat size_nat) by auto with zarith.
  pose (H j H1).
  fold nth in e; rewrite Nth_bw_and, Nth_bw_and in e by auto.
  destruct H0.
  rewrite (match (mask_correctness i n j) with conj a b => a l H0 H2 end) in e.
  rewrite andb_true_r, andb_true_r in e.
  auto.

  unfold nth, nth; rewrite nth_high, nth_high by auto with zarith; reflexivity.
Qed.

(* Why3 goal *)
Lemma Extensionality : forall (x:t) (y:t), eq_sub x y 0%Z size -> (x = y).
  intros x y.
  apply Extensionality_aux.
Qed.


Require Import Coq.ZArith.ZArith.
Require Import Coq.Strings.String.
Require Import Crypto.Bedrock.Field.Synthesis.Generic.WordByWordMontgomery.
Require Import Crypto.Bedrock.Field.Synthesis.Specialized.WordByWordMontgomery.
Local Open Scope Z_scope.

Local Definition m := 2^224 - 2^96 + 1.
Local Definition machine_wordsize := 64.
Local Definition prefix := "p224_"%string. (* placed before function names *)

Instance names : names_of_operations.
  make_names_of_operations prefix. Defined.

Definition ops : wbwmontgomery_reified_ops m machine_wordsize.
  make_reified_ops. Time Defined.

Instance p224_bedrock2_funcs : bedrock2_wbwmontgomery_funcs.
funcs_from_ops ops. Defined.

Instance p224_bedrock2_specs : bedrock2_wbwmontgomery_specs.
specs_from_ops ops m. Defined.

Instance p224_bedrock2_correctness : bedrock2_wbwmontgomery_correctness.
prove_correctness ops m machine_wordsize. Defined.

(*
Require Import bedrock2.NotationsCustomEntry.
Require Import bedrock2.NotationsInConstr.
Require Import bedrock2.Syntax.
Coercion expr.var : string >-> Syntax.expr.
Local Open Scope bedrock_expr.
Eval cbv [add p224_bedrock2_funcs] in add.
Eval cbv [spec_of_add p224_bedrock2_specs] in spec_of_add.
*)


Require Import FP.Data.Sum.
Require Import FP.Data.Type.
Require Import FP.Structures.FUnit.
Require Import FP.Structures.Functor.
Require Import FP.Structures.EqvRel.
Require Import FP.Structures.Monoid.
Require Import FP.Structures.FZero.
Require Import FP.Structures.Injection.
Require Import FP.Structures.Additive.
Require Import FP.Structures.Proxy.
Require Import FP.Relations.Setoid.

Import FunctionNotation.
Import AdditiveNotation.

Class FPlus (t:Type->Type) :=
  { fplus : forall {A B}, t A -> t B -> t (A+B) }.

Class FAdditive (t:Type -> Type) : Type :=
  { FAdditive_FZero : FZero t
  ; FAdditive_FPlus : FPlus t
  }.
Hint Resolve Build_FAdditive : typeclass_instances.
Hint Immediate FAdditive_FZero : typeclass_instances.
Hint Immediate FAdditive_FPlus : typeclass_instances.

Module FAdditiveNotation.
  Infix "<+>" := fplus (at level 48, left associativity).
End FAdditiveNotation.

Section FAdditiveWF.
  Context {t:Type->Type}.
  Context {FMap_:FMap t} {FPlus_:FPlus t}.
  Context {EqvEnv_:EqvEnv}.
  Context {RPromote:forall {A} {aER:EqvRel A}, EqvRel (t A)}.
  Context {RPromote_sum:forall {A} {aER:EqvRel A} {B} {bER:EqvRel B}, EqvRel (A+B)}.

  Class FAdditiveWF :=
    { fplus_left_zero :
        forall
          {A} {aER:EqvRel A}
          {B} {bER:EqvRel B}
          (bT:t B) (bT':t B) {bTP:env_R bT bT'},
            env_R
            (fplus fzero bT)
            (fmap inr bT')
    ; fplus_right_zero :
        forall
          {A} {aER:EqvRel A}
          {B} {bER:EqvRel B}
          (aT:t A) (aT':t A) {aTP:env_R aT aT'},
            env_R
            (fplus aT fzero)
            (fmap inl aT)
    ; fplus_associativity :
        forall
          {A} {aER:EqvRel A}
          {B} {bER:EqvRel B}
          {C} {cER:EqvRel C}
          (aT:t A) (bT:t B) (cT:t C),
            env_R
            (fplus (fplus aT bT) cT)
            (fmap sum_associate (fplus aT (fplus bT cT)))
    }.

End FAdditiveWF.

Section Deriving_FAdditive
  Variable (n:Type -> Type).
  Context {m} {B:HasFunctorBijection m n} {nMP:MonadPlus n}.

  Definition iso_MonadPlus_mzero {A} : m A := ffrom mzero.
  Definition iso_MonadPlus_mplus {A B} (aM:m A) (bM:m B) : m (A+B) :=
    ffrom $ mplus (fto aM) (fto bM).
  Definition iso_MonadPlus : MonadPlus m :=
    {| mzero := @iso_MonadPlus_mzero
     ; mplus := @iso_MonadPlus_mplus
    |}.
End Deriving_FAdditive.


Require Import propInv1.
Require Import verif_cond_7.
Require Import extra7.
Local Open Scope Z.

Theorem t1_7: (startnewloop hands0 hands1 dryer0 dryer1 ctrlState0 ctrlState1 ctrlTimer0 ctrlTimer1 timer0 timer1) /\ cond7 ->
 (inv hands1 dryer1 ctrlState1 ctrlTimer1 timer1).

Proof.
intros.
split.
unfold propInv1.
inversion_clear H.
inversion_clear H1.
inversion_clear H2.
inversion_clear H3.
intros.
(*analysis of cases i<timer1 and i=timer1*)
elim Zle_lt_or_eq with i timer1.
intros.
apply startnewloop_to_propInv.
assumption.
split.
apply H3.
split.
inversion_clear H0.
auto with zarith.
apply H3.
(*analysis of case i=timer1*)
intros.
rewrite H5 in H3.
inversion_clear H3.
inversion_clear H7.
inversion_clear H8.
inversion_clear H9.
elimtype False.
auto.
inversion_clear H3.
inversion_clear H6.
assumption.
apply extra7.
split.
inversion_clear H.
inversion_clear H0.
split.
apply H.
assumption.
apply H.
Qed.