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

Definition last_bit : nat.
Admitted.

Definition size_bv: nat := S last_bit.

(* Why3 goal *)
Definition size: Z.
  exact (Z.of_nat size_bv).
Defined.

Lemma size_int_S : size = Z.succ (Z.of_nat last_bit).
  unfold size, size_bv.
  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_bv).
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 -> Z -> 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:Z), ((n < 0%Z)%Z \/
  (size <= n)%Z) -> ((nth x n) = 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:Z), ((nth zeros n) = false).
intros n; apply Nth_zeros_aux.
Qed.

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

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

(* Why3 goal *)
Lemma Nth_ones : forall (n:Z), ((0%Z <= n)%Z /\ (n < size)%Z) -> ((nth ones
  n) = 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: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: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: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: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 -> 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:Z) (s: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:Z) (s:Z), (0%Z <= s)%Z ->
  ((0%Z <= n)%Z -> ((size <= (n + s)%Z)%Z -> ((nth (lsr b s) n) = 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 -> 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_bv; fold size; omega.
Qed.

(* Why3 goal *)
Lemma Asr_nth_low : forall (b:t) (n:Z) (s: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_bv; fold size; omega.
Qed.

(* Why3 goal *)
Lemma Asr_nth_high : forall (b:t) (n:Z) (s: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 -> 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:Z) (s: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:Z) (s:Z), ((0%Z <= n)%Z /\ (n < s)%Z) ->
  ((nth (lsl b s) n) = 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 :=
  match v with
    | Vector.nil => 0%Z
    | Vector.cons false n v => Z.of_nat (bvec_to_nat n v)
    | Vector.cons true n v => (Z.of_nat (bvec_to_nat n v) - Pow2int.pow2 (Z.of_nat (S n)))%Z
  end.

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 NPeano.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, (twos_complement (S n) (true :: v) < 0)%Z.
  intros.
  unfold twos_complement.
  apply Z.lt_sub_0.
  apply Zlt_trans with (m := Pow2int.pow2 (Z.of_nat n)).
  rewrite Z2Nat.inj_lt.
  rewrite Nat2Z.id.
  apply bvec_to_nat_range.
  omega.
  apply Zlt_le_weak, Pow2int.pow2pos; omega.
  apply pow2_lt_mono_nat; omega.
Qed.

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

Lemma twos_complement_extensionality : forall {m} (v v' : Bvector m),
  (twos_complement m v = twos_complement m v' -> v = v').
  destruct v; intros.
  apply Vector.case0 with (v := v'); trivial.
  revert v h H.
  apply Vector.caseS with (v := v'); intros.
  case h, h0; intros.
  inversion H.
  apply bvec_to_nat_extensionality; simpl; omega.
  Lemma tmp : forall {n} v v', twos_complement (S n) (false :: v) <> twos_complement (S n) (true :: v').
    intros.
    intro.
    assert ((twos_complement (S n) (true :: v') >= 0)%Z).
    rewrite <- H; apply twos_complement_pos.
    assert ((twos_complement (S n) (true :: v') < 0)%Z).
    apply twos_complement_neg.
    easy.
  Qed.
  assert (twos_complement (S n0) (false :: v) <>
          twos_complement (S n0) (true :: t0)).
  apply tmp.
  assert False by omega; easy.
  assert (twos_complement (S n0) (false :: t0) <>
          twos_complement (S n0) (true :: v)).
  apply tmp.
  assert False by omega; easy.
  inversion H.
  apply bvec_to_nat_extensionality; simpl; omega.
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, <- NPeano.Odd_equiv.
  unfold NPeano.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 NPeano.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, <- NPeano.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), <- NPeano.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  <- NPeano.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), <- NPeano.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 -> 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:Z) (i: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_bv.
  intro n.
  rewrite Nat2Z.inj_succ.
  intros. rewrite Nat2Z.id.
  apply Nth_rotate_aux_right; auto.
Qed.

(* Why3 goal *)
Definition rotate_left: t -> 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:Z) (i: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_bv.
  intro n.
  rewrite Nat2Z.inj_succ.
  intros. rewrite Nat2Z.id.
  apply Nth_rotate_aux_left; auto.
Qed.

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

(* Why3 goal *)
Definition max_int: 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 to_int: t -> Z.
  exact (twos_complement size_bv).
Defined.

(* Why3 goal *)
Definition to_uint: t -> Z.
  exact (fun x => Z.of_nat (bvec_to_nat size_bv 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: Z -> t.
  exact (fun x => nat_to_bvec size_bv (Z.to_nat x)).
Defined.

(* 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: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_bv) - 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_bv 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: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 *)
Lemma Of_int_zeros : (zeros = (of_int 0%Z)).
apply Nat_to_bvec_zeros.
Qed.

(* Why3 goal *)
Lemma Of_int_ones : (ones = (of_int max_int)).
  apply Nat_to_bvec_ones.
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.

(* 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 -> 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 (nat_to_bvec (S l) 1)) <> zeros_aux.
  intros.
  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) = true) <->
  ~ ((bw_and (lsr_bv x i) (of_int 1%Z)) = 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.
  Lemma 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.
  Qed.
  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: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 (of_int 1%Z) n) (of_int 1%Z)) i) in ((eq_sub_bv a b i
  n) <-> ((bw_and b mask) = (bw_and a mask))).
  easy.
Qed.

(* Why3 assumption *)
Definition eq_sub (a:t) (b:t) (i:Z) (n:Z): Prop := forall (j: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.

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.

  Lemma add_and_or :
    forall v, nth v 0 = false ->
              add v (of_int 1) = bw_or v (of_int 1).
    Definition add_aux {l} (v w : Vector.t bool l) : Vector.t bool l.
      exact (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))))).
    Defined.
    Lemma add_is_add_aux : forall v w, add v w = add_aux v w.
      auto.
    Qed.
    Lemma 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 n)
                      (Z.to_nat
                         (mod1
                            (Z.of_nat (2 * (bvec_to_nat n v)) +
                             Z.of_nat (1 + 2 * (bvec_to_nat n (nat_to_bvec n 0))))
                            (Pow2int.pow2 (Z.of_nat (S n))))) =
          true :: Vector.map2 (fun x y : bool => x || y) v (nat_to_bvec n 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 n v) + 1)
           (Pow2int.pow2 (Z.of_nat (S n)))).
      simpl nat_to_bvec.
      rewrite Z2Nat.id by (apply mod1_nat, Z.lt_le_pred, max_int_nat).
      assert (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 n (Div2.div2 (Z.to_nat z))
           = Vector.map2 (fun x y : bool => x || y) v (Vector.const false n)).
      intro t; rewrite t; trivial.
      case (Z_lt_le_dec (Z.of_nat (2 * bvec_to_nat n v) + 1) (Pow2int.pow2 (Z.of_nat (S n)))); 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.
      Lemma 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 l) - 1); [apply max_int_nat|auto with zarith]).
        apply inj_lt, bvec_to_nat_range.
      Qed.
      rewrite nat_to_bvec_bvec_to_nat.
      Lemma tmp2:
        forall {l} v,
          Vector.map2 (fun x y : bool => x || y) v (Vector.const false l) = v.
        induction v; auto.
        simpl.
        rewrite orb_false_r.
        rewrite IHv; trivial.
      Qed.
      symmetry; apply tmp2.
      absurd (Z.of_nat (bvec_to_nat n v) < Pow2int.pow2 (Z.of_nat n)).
      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 n) - 1).
      apply max_int_nat.
      auto with zarith.
    Qed.
    intros.
    rewrite add_is_add_aux.
    apply add_and_or_aux.
    trivial.
  Qed.
  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.
  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).
  pose (to_uint_bounds i).
  auto with zarith.
  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 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.
  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.
  unfold of_int, size, size_bv.
  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).
  split;intros.
  rewrite lsl_bv_is_lsl.
  pose (to_uint_bounds i).
  pose (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.
  pose (to_uint_bounds i) as u.
  pose (to_uint_bounds n) as v.
  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).
  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.

  pose (to_uint_bounds i) as u; unfold uint_in_range in u.
  assert (0 <= j < Z.of_nat size_bv) 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 Crypto.Util.FixCoqMistakes.
Require Import Crypto.Util.Logic.
Require Import Coq.Classes.Morphisms Coq.Setoids.Setoid.

Lemma symmetry_iff {T} {R} {Rsym:@Symmetric T R} x y: R x y <-> R y x.
  intuition eauto using symmetry.
Qed.

Lemma and_rewrite_l {A B} {RA RB} {Equivalence_RA:Equivalence RA} {Equivalence_RB:Equivalence RB}
      (f:A->B) ref P {Proper_P: Proper (RA==>RB==>iff) P} a
  : (RB (f a) ref /\ P a (f a)) <-> (RB (f a) ref /\ P a ref).
Proof.
  logic; match goal with [H:_|-_] => (rewrite H || rewrite <-H); assumption end.
Qed.

Lemma and_rewriteleft_l {A B} {RA RB} {Equivalence_RA:Equivalence RA} {Equivalence_RB:Equivalence RB}
      (f:A->B) ref P {Proper_P: Proper (RA==>RB==>iff) P} a
  : (RB ref (f a) /\ P a (f a)) <-> (RB ref (f a) /\ P a ref).
Proof.
  logic; match goal with [H:_|-_] => (rewrite H || rewrite <-H); assumption end.
Qed.

Lemma exists_and_equiv_r {A} {RA} {Equivalence_RA:Equivalence RA}
      P {Proper_P: Proper (RA==>iff) P} (ref:A)
  : (exists a, P a /\ RA a ref) <-> P ref.
Proof.
  logic; try match goal with [H:_|-_] => (rewrite H || rewrite <-H); assumption end.
  repeat (assumption||reflexivity||econstructor); assumption. (* WHY the last [assumption]?*)
Qed.

Lemma iff_R_R_same_r {T R} {Req:@Equivalence T R} x y ref : R x y -> (R x ref <-> R y ref).
Proof.
  intro Hx; rewrite Hx; clear Hx. reflexivity.
Qed.

Global Instance Equivalence_and {A B RA RB}
       {Equivalence_RA:@Equivalence A RA}
       {Equivalence_RB:@Equivalence B RB}
       : Equivalence (fun ab AB => RA (fst ab) (fst AB) /\ RB (snd ab) (snd AB)).
Proof.
  destruct Equivalence_RA as [], Equivalence_RB as []; cbv in *|-.
  repeat match goal with
           | _ => intro
           | _ => split
           | [p:prod _ _ |- _ ] => destruct p
           | [p:and _ _ |- _ ] => destruct p
           | _ => progress (cbv [fst snd] in * )
           | _ => solve[eauto]
         end.
Qed.

Global Instance eq_eta_Reflexive {T} : Reflexive (fun x y : T => x = y) | 1
  := eq_Reflexive.

Global Instance Symmetric_not {T:Type} (R:T->T->Prop)
       {SymmetricR:Symmetric R} : Symmetric (fun a b => not (R a b)).
Proof. cbv [Symmetric] in *; repeat intro; eauto. Qed.

Lemma not_exfalso (P:Prop) (H:P->False) : not P. auto with nocore. Qed.


Require Export Coq.Sets.Ensembles.

Require Import
  ByteString.LibExt
  ByteString.Relations
  ByteString.Same_set.

Generalizable All Variables.

Section TupleEnsemble.

Variables A : Type.
Variables B : A -> Type.

Definition DMap := Ensemble { a : A & B a }.

Definition Empty : DMap := Empty_set _.

Definition Single (a : A) (b : B a) : DMap := Singleton _ (existT _ a b).

Definition Lookup (a : A) (b : B a) (r : DMap) := In _ r (existT _ a b).

Definition Functional (r : DMap) :=
  forall addr blk1, Lookup (a:=addr) blk1 r ->
  forall blk2, Lookup (a:=addr) blk2 r -> blk1 = blk2.

Definition Same (x y : DMap) : Prop :=
  forall a b, Lookup (a:=a) b x <-> Lookup (a:=a) b y.

Global Program Instance Same_Equivalence : Equivalence Same.
Obligation 1.
  constructor; auto.
Qed.
Obligation 2.
  constructor; apply H; auto.
Qed.
Obligation 3.
  constructor; intros.
    apply H0, H; auto.
  apply H, H0; auto.
Qed.

Lemma Same_Same_set : forall x y, Same x y <-> Same_set _ x y.
Proof.
  unfold Same, Lookup.
  split; intros.
    split; intros;
    intros ? H0;
    destruct x0;
    apply H; assumption.
  split; intros;
  apply H; assumption.
Qed.

Require Import
  Coq.Program.Equality
  Coq.Logic.EqdepFacts.

Global Program Instance Lookup_Proper :
  Proper (forall_relation
            (fun x : A =>
               (fun p p' => eq_dep A B x p x p')
                 ==> Same ==> Basics.impl)%signature) Lookup.
Obligation 1.
  intros ?.
  relational; unfold Basics.impl; intros.
  apply H0.
  destruct H.
  assumption.
Qed.

Global Program Instance Lookup_Proper_flip :
  Proper (forall_relation
            (fun x : A =>
               (fun p p' => eq_dep A B x p x p')
                 ==> Same --> Basics.impl)%signature) Lookup.
Obligation 1.
  intros ?.
  relational; unfold Basics.impl; intros.
  apply H0.
  destruct H.
  assumption.
Qed.

Definition Member (a : A) (r : DMap) := exists b, Lookup (a:=a) b r.

Definition Insert (a : A) (b : B a) (r : DMap)
           (H : forall b' : B a, ~ Lookup (a:=a) b' r) : DMap :=
  Add _ r (existT _ a b).

Definition Remove (a : A) (r : DMap) : DMap :=
  Setminus _ r (fun p => projT1 p = a).

Program Definition Update (a : A) (b : B a) (r : DMap) :
  DMap := Insert (a:=a) b (Remove a r) _.
Obligation 1. firstorder. Qed.

Definition Map {C} (f : forall a : A, B a -> C a) (r : DMap) :
  Ensemble { a : A & C a } :=
  fun p => exists b : B (projT1 p),
    Lookup (a:=projT1 p) b r /\ projT2 p = f (projT1 p) b.

Definition Relate {C D}
           (f : forall a : A,  B a -> forall c : C, D c -> Prop) (r : DMap) :
  Ensemble (sigT D) :=
  fun p => exists k' e', Lookup (a:=k') e' r /\ f k' e' (projT1 p) (projT2 p).

Lemma Map_left_identity : forall r, Same r (Map (fun _ x => x) r).
Proof.
  unfold Map; split; intros.
    eexists b.
    intuition.
  do 2 destruct H.
  simpl in *.
  rewrite H0.
  assumption.
Qed.

Lemma Map_right_identity : forall r, Same (Map (fun _ x => x) r) r.
Proof.
  unfold Map; split; intros.
    do 2 destruct H.
    simpl in *.
    rewrite H0.
    assumption.
  eexists b.
  intuition.
Qed.

Lemma Map_composition : forall f g r,
  Same (Map (fun k e => f k (g k e)) r) (Map f (Map g r)).
Proof.
  unfold Map; split; intros.
    destruct H.
    destruct H; simpl in *.
    subst.
    exists (g a x); simpl in *.
    split; trivial.
    exists x; simpl.
    intuition.
  destruct H.
  destruct H; simpl in *.
  subst.
  destruct H; simpl in *.
  exists x0; simpl in *.
  destruct H.
  intuition.
  rewrite <- H0.
  reflexivity.
Qed.

(* Definition Move (a a' : A) (r : DMap) : DMap := *)
(*   Relate (fun k e k' e' => *)
(*             eq_dep _ _ k e k' e' *)
(*               /\ ((k' = a' /\ k = a) \/ (k' <> a /\ k = k'))) r. *)

Definition Filter (P : forall a : A, B a -> Prop) (r : DMap) :
  DMap :=
  fun p => Lookup (a:=projT1 p) (projT2 p) r /\ P (projT1 p) (projT2 p).

Definition Define (P : A -> Prop) (b : forall a : A, B a) (r : DMap) :
  DMap :=
  Ensembles.Union
    _ (fun p => P (projT1 p) /\ In _ (Singleton _ (b (projT1 p))) (projT2 p))
      (Filter (fun k _ => ~ P k) r).

Definition Modify (a : A) (f : forall a : A, B a -> B a) (r : DMap) :
  DMap :=
  Relate (fun k e k' e' =>
            k = k' /\ IF k' = a
                      then eq_dep _ _ k' e' k (f k e)
                      else eq_dep _ _ k' e' k e) r.

Definition All (P : forall a : A, B a -> Prop) (r : DMap) : Prop :=
  forall a b, Lookup (a:=a) b r -> P a b.

Definition Any (P : forall a : A, B a -> Prop) (r : DMap) : Prop :=
  exists a b, Lookup (a:=a) b r /\ P a b.

Lemma Lookup_Empty : forall a b, ~ Lookup (a:=a) b Empty.
Proof. firstorder. Qed.

Lemma Lookup_Single : forall a a' b b',
  eq_dep _ _ a b a' b' -> Lookup (a:=a) b (Single (a:=a') b').
Proof.
  intros.
  destruct H.
  firstorder.
Qed.

Lemma Lookup_Single_inv : forall a b c d,
  Lookup (a:=a) b (Single (a:=c) d) -> eq_dep _ _ a b c d.
Proof.
  intros.
  inversion H.
  constructor.
Qed.

Lemma Lookup_Insert : forall a b c d r H,
  eq_dep _ _ a b c d \/ (~ eq_dep _ _ a b c d /\ Lookup (a:=a) b r)
    -> Lookup (a:=a) b (Insert (a:=c) d r H).
Proof.
  intros.
  intuition.
    destruct H1.
    right; constructor.
  left.
  exact H2.
Qed.

Lemma Lookup_Insert_inv : forall a b c d r H,
  Lookup (a:=a) b (Insert (a:=c) d r H)
    -> eq_dep _ _ a b c d \/ (~ eq_dep _ _ a b c d /\ Lookup (a:=a) b r).
Proof.
  intros.
  inversion H0; clear H0.
    subst.
    right.
    firstorder.
    unfold not; intros; subst.
    destruct H0.
    contradiction (H b).
  inversion H1; clear H1.
  firstorder.
Qed.

Lemma Lookup_Remove : forall a b a' r,
  Lookup (a:=a) b r -> a <> a' -> Lookup (a:=a) b (Remove a' r).
Proof. firstorder. Qed.

Lemma Lookup_Remove_ex_r : forall a b r,
  Lookup (a:=a) b r
    -> exists a' b', a <> a' -> Lookup (a:=a') b' (Remove a r).
Proof. firstorder. Qed.

Lemma Lookup_Remove_inv : forall a b a' r,
  Lookup (a:=a) b (Remove a' r) -> a <> a' /\ Lookup (a:=a) b r.
Proof. firstorder. Qed.

Lemma Lookup_Update : forall a b a' b' r,
  eq_dep _ _ a b a' b' \/ (a <> a' /\ Lookup (a:=a) b r)
    -> Lookup (a:=a) b (Update (a:=a') b' r).
Proof. intros; destruct H, H; [right|left]; constructor; firstorder. Qed.

Lemma Lookup_Update_inv : forall a b a' b' r,
  Lookup (a:=a) b (Update (a:=a') b' r)
    -> eq_dep _ _ a b a' b' \/ (a <> a' /\ Lookup (a:=a) b r).
Proof.
  intros.
  inversion H; clear H.
    firstorder.
  subst.
  inversion H0; subst; clear H0.
  firstorder.
Qed.

Lemma Lookup_Relate :
  forall a b c d (f : forall a : A, B a -> forall a' : A, B a' -> Prop) r,
    Lookup (a:=a) b r -> f a b c d -> Lookup (a:=c) d (Relate f r).
Proof. firstorder. Qed.

Lemma Lookup_Relate_inv :
  forall a b (f : forall a : A, B a -> forall a' : A, B a' -> Prop) r,
    Lookup (a:=a) b (Relate f r)
      -> exists a' b', f a' b' a b /\ Lookup (a:=a') b' r.
Proof. firstorder. Qed.

(* Lemma Lookup_Move : forall k a a' e r, *)
(*   (IF k = a' *)
(*    then Lookup (a:=a) e r *)
(*    else k <> a /\ Lookup (a:=k) e r) *)
(*     -> Lookup (a:=k) e (Move a a' r). *)
(* Proof. firstorder. Qed. *)

(* Lemma Lookup_Move_inv : forall k a a' e r, *)
(*   Lookup (a:=k) e (Move a a' r) *)
(*     -> (k = a' /\ Lookup (a:=a) e r) \/ (k <> a /\ Lookup k e r). *)
(* Proof. *)
(*   firstorder; *)
(*   simpl in *; subst; *)
(*   firstorder. *)
(* Qed. *)

Lemma Lookup_Map : forall a b f r,
  (exists b', f a b' = b /\ Lookup (a:=a) b' r) -> Lookup (a:=a) b (Map f r).
Proof. firstorder. Qed.

Lemma Lookup_Map_inv : forall a b f r,
  Lookup (a:=a) b (Map f r) -> exists b', f a b' = b /\ Lookup (a:=a) b' r.
Proof.
  intros.
  inversion H; clear H.
  firstorder.
Qed.

Lemma dep_surjective_pairing : forall A (B : A -> Type) (x : sigT B),
  x = existT (fun a : A => B a) (projT1 x) (projT2 x).
Proof.
  intros.
  destruct x; simpl.
  apply eq_dep_eq_sigT.
  constructor.
Qed.

Lemma Lookup_Map_set : forall a b f r,
  (exists p', f p' = (existT _ a b) /\ Lookup (a:=projT1 p') (projT2 p') r)
    -> Lookup (a:=a) b (Map_set f r).
Proof.
  unfold Map_set, Lookup, Ensembles.In; simpl.
  intuition.
  do 2 destruct H.
  exists x.
  rewrite <- dep_surjective_pairing in H0.
  intuition.
Qed.

Lemma Lookup_Map_set_inv : forall a b f r,
  Lookup (a:=a) b (Map_set f r)
    -> exists p', f p' = (existT _ a b) /\ Lookup (a:=projT1 p') (projT2 p') r.
Proof.
  intros.
  inversion H; clear H.
  exists x.
  unfold Lookup.
  rewrite <- dep_surjective_pairing.
  firstorder.
Qed.

Lemma Lookup_Filter : forall a b P r,
  Lookup (a:=a) b r /\ P a b -> Lookup (a:=a) b (Filter P r).
Proof. firstorder. Qed.

Lemma Lookup_Filter_inv : forall a b P r,
  Lookup (a:=a) b (Filter P r) -> P a b /\ Lookup (a:=a) b r.
Proof. firstorder. Qed.

Lemma Lookup_Union : forall a b r r',
  Lookup (a:=a) b r \/ Lookup (a:=a) b r'
    -> Lookup (a:=a) b (Union (sigT B) r r').
Proof.
  firstorder.
    left; exact H.
  right; exact H.
Qed.

Lemma Lookup_Union_inv : forall a b r r',
  Lookup (a:=a) b (Union (sigT B) r r')
    -> Lookup (a:=a) b r \/ Lookup (a:=a) b r'.
Proof.
  firstorder.
  unfold Lookup, Ensembles.In in *.
  apply Constructive_sets.Union_inv in H.
  intuition.
Qed.

Lemma Lookup_Define : forall a b c P r,
  (IF P a then In _ (Singleton _ (c _)) b else Lookup (a:=a) b r)
    -> Lookup (a:=a) b (Define P c r).
Proof.
  unfold Define; intros.
  apply Lookup_Union.
  do 2 destruct H.
    left.
    unfold Lookup, Ensembles.In; simpl.
    intuition.
  right.
  apply Lookup_Filter.
  intuition.
Qed.

Lemma Lookup_Define_inv : forall a b c P r,
  Lookup (a:=a) b (Define P c r)
    -> IF P a
       then In _ (Singleton _ (c _)) b
       else Lookup (a:=a) b r.
Proof.
  unfold Define; intros.
  apply Lookup_Union_inv in H.
  destruct H.
    firstorder.
  apply Lookup_Filter_inv in H.
  firstorder.
Qed.

Lemma Lookup_Modify :
  forall (a : A) (b : B a) a' (f : forall a : A, B a -> B a) r,
    (a = a' /\ exists b', eq_dep A B a b a' (f a' b') /\ Lookup (a:=a') b' r)
      \/ (a <> a' /\ Lookup (a:=a) b r)
      -> Lookup (a:=a) b (Modify a' f r).
Proof. firstorder. Qed.

Lemma Lookup_Modify_inv :
  forall (a : A) (b : B a) a' (f : forall a : A, B a -> B a) r,
    Lookup (a:=a) b (Modify a' f r)
      -> (a = a' /\ exists b', eq_dep A B a b a' (f a' b')
                                 /\ Lookup (a:=a') b' r)
           \/ (a <> a' /\ Lookup (a:=a) b r).
Proof.
  firstorder;
  simpl in *; subst.
    left; intuition.
    exists x0.
    intuition.
  right; intuition.
  destruct H2.
  exact H.
Qed.

Lemma Lookup_Member : forall a b r,
  Lookup (a:=a) b r -> Member a r.
Proof. firstorder. Qed.

Lemma Member_Lookup_not : forall a r,
  ~ Member a r -> forall b, ~ Lookup (a:=a) b r.
Proof. firstorder. Qed.

Lemma All_Remove_inv : forall a P r,
  All P (Remove a r) -> ~ Member a r -> All P r.
Proof.
  intros.
  intros ???.
  apply H.
  apply Lookup_Remove.
    assumption.
  unfold not; intros.
  subst.
  unfold Member in H0.
  Require Import Classical_Pred_Type.
  apply not_ex_all_not with (n:=b) in H0.
  contradiction.
Qed.

Lemma All_Remove_Lookup_inv : forall a P r,
  All P (Remove a r) -> forall a' b', a' <> a -> Lookup (a:=a') b' r -> P a' b'.
Proof. intros; apply H, Lookup_Remove; trivial. Qed.

End TupleEnsemble.

Arguments Functional : default implicits.
Arguments Empty {_ _} _.
Arguments Single : default implicits.
Arguments Insert : default implicits.
Arguments Remove : default implicits.
Arguments Update : default implicits.
Arguments Modify : default implicits.
(* Arguments Move : default implicits. *)
Arguments Filter : default implicits.
Arguments Map : default implicits.
Arguments Relate : default implicits.
Arguments All : default implicits.
Arguments Any : default implicits.
Arguments Define : default implicits.
Arguments Lookup : default implicits.
Arguments Same : default implicits.
Arguments Member : default implicits.

Arguments Lookup_Empty : default implicits.

Ltac t H :=
  unfold Relate;
  split; intros;
  repeat destruct H;
  simpl in *; subst;
  firstorder;
  simpl in *; subst;
  firstorder;
  try match goal with
    [ H0 : eq_dep _ _ _ _ _ _ |- _ ] => destruct H0; assumption
  end.

Lemma Relate_left_identity : forall A (B : A -> Type) (r : DMap B),
  Same r (Relate (eq_dep A B) r).
Proof. t H. Qed.

Lemma Relate_right_identity : forall A (B : A -> Type) (r : DMap B),
  Same (Relate (eq_dep A B) r) r.
Proof. t H. Qed.

Lemma Relate_composition :
  forall A B C D E F
         (f : forall c : C, D c -> forall e : E, F e -> Prop)
         (g : forall a : A, B a -> forall c : C, D c -> Prop) r,
    Same (Relate (fun k e k' e' =>
                  exists k'' e'', g k e k'' e'' /\ f k'' e'' k' e') r)
         (Relate f (Relate g r)).
Proof. t H; exists x1; exists x2; t H. Qed.

Ltac teardown :=
  match goal with
  | [ H : Lookup _ _ Empty            |- _ ] => contradiction (Lookup_Empty H)
  | [ H : Lookup _ _ (Single _ _)     |- _ ] => apply Lookup_Single_inv in H
  | [ H : Lookup _ _ (Insert _ _ _ _) |- _ ] => apply Lookup_Insert_inv in H
  | [ H : Lookup _ _ (Remove _ _)     |- _ ] => apply Lookup_Remove_inv in H
  | [ H : Lookup _ _ (Update _ _ _)   |- _ ] => apply Lookup_Update_inv in H
  (* | [ H : Lookup _ _ (Move _ _ _)     |- _ ] => apply Lookup_Move_inv in H *)
  | [ H : Lookup _ _ (Map _ _)        |- _ ] => apply Lookup_Map_inv in H
  | [ H : Lookup _ _ (Map_set _ _)    |- _ ] => apply Lookup_Map_set_inv in H
  | [ H : Lookup _ _ (Relate _ _)     |- _ ] => apply Lookup_Relate_inv in H
  | [ H : Lookup _ _ (Filter _ _)     |- _ ] => apply Lookup_Filter_inv in H
  | [ H : Lookup _ _ (Define _ _ _)   |- _ ] => apply Lookup_Define_inv in H
  | [ H : Lookup _ _ (Modify _ _ _)   |- _ ] => apply Lookup_Modify_inv in H
  | [ H : Lookup _ _ (Union _ _ _)    |- _ ] => apply Lookup_Union_inv in H

  | [ H : Member _ Empty            |- _ ] => unfold Member in H
  | [ H : Member _ (Single _ _)     |- _ ] => unfold Member in H
  | [ H : Member _ (Insert _ _ _ _) |- _ ] => unfold Member in H
  | [ H : Member _ (Remove _ _)     |- _ ] => unfold Member in H
  | [ H : Member _ (Update _ _ _)   |- _ ] => unfold Member in H
  (* | [ H : Member _ (Move _ _ _)     |- _ ] => unfold Member in H *)
  | [ H : Member _ (Map _ _)        |- _ ] => unfold Member in H
  | [ H : Member _ (Map_set _ _)    |- _ ] => unfold Member in H
  | [ H : Member _ (Relate _ _)     |- _ ] => unfold Member in H
  | [ H : Member _ (Filter _ _)     |- _ ] => unfold Member in H
  | [ H : Member _ (Define _ _ _)   |- _ ] => unfold Member in H
  | [ H : Member _ (Modify _ _ _)   |- _ ] => unfold Member in H
  | [ H : Member _ (Union _ _ _)    |- _ ] => unfold Member in H

  | [ |- Lookup _ _ Empty            ] => apply Lookup_Empty
  | [ |- Lookup _ _ (Single _ _)     ] => apply Lookup_Single
  | [ |- Lookup _ _ (Insert _ _ _ _) ] => apply Lookup_Insert
  | [ |- Lookup _ _ (Remove _ _)     ] => apply Lookup_Remove
  | [ |- Lookup _ _ (Update _ _ _)   ] => apply Lookup_Update
  (* | [ |- Lookup _ _ (Move _ _ _)     ] => apply Lookup_Move *)
  | [ |- Lookup _ _ (Map _ _)        ] => apply Lookup_Map
  | [ |- Lookup _ _ (Map_set _ _)    ] => apply Lookup_Map_set
  | [ |- Lookup _ _ (Relate _ _)     ] => apply Lookup_Relate
  | [ |- Lookup _ _ (Filter _ _)     ] => apply Lookup_Filter
  | [ |- Lookup _ _ (Define _ _ _)   ] => apply Lookup_Define
  | [ |- Lookup _ _ (Modify _ _ _)   ] => apply Lookup_Modify
  | [ |- Lookup _ _ (Union _ _ _)    ] => apply Lookup_Union

  | [ H : Lookup ?X ?Y ?R |- Member ?X ?R ] => exists Y; exact H

  | [ H1 : All ?P ?R, H2 : Lookup ?X ?Y ?R |- _ ] =>
    specialize (H1 _ _ H2); simpl in H1

  | [ H : IF _ then _ else _ |- _ ] => destruct H
  | [ H : _ /\ _             |- _ ] => destruct H
  | [ H : _ \/ _             |- _ ] => destruct H
  | [ H : _ * _              |- _ ] => destruct H
  | [ H : exists _, _        |- _ ] => destruct H
  | [ H : @sig _ _           |- _ ] => destruct H
  | [ H : @sig2 _ _ _        |- _ ] => destruct H
  | [ H : @sigT _ _          |- _ ] => destruct H
  | [ H : @sigT2 _ _ _       |- _ ] => destruct H
  | [ H : bool               |- _ ] => destruct H
  | [ H : option _           |- _ ] => destruct H
  | [ H : sum _ _            |- _ ] => destruct H
  | [ H : sumor _ _          |- _ ] => destruct H
  | [ H : sumbool _ _        |- _ ] => destruct H

  | [ H : forall x, Some ?X = Some x -> _  |- _ ] => specialize (H X eq_refl)
  | [ H : forall x y, Some (?X, ?Y) = Some (x, y) -> _  |- _ ] =>
    specialize (H X Y eq_refl)

  | [ H1 : ?X = true, H2 : ?X = false |- _ ] => rewrite H1 in H2; discriminate

  end; simpl in *; try tauto.


(** * 6.822 Formal Reasoning About Programs, Spring 2020 - Pset 12 *)

(* Author:
 * Samuel Gruetter (gruetter@mit.edu)
 *)

(* SETUP: Starting in the spring20 folder, do these commands:
   git pull
   git submodule update
   cd ./frap
   make lib
   make -f Makefile.coq MessagesAndRefinement.vo
   cd ../pset12_MessagePassing/
   make
*)

Require Import Frap.Frap.
Require Import Frap.MessagesAndRefinement.

(* We suggest that you start by reading Chapter 19 in the FRAP book.
   For this pset, you will need to understand everything in that chapter up to and
   including Theorem 19.2 ("If p1 <| p2, then every trace generated by p1 is
   also generated by p2").
   Also study the code in MessagesAndRefinement.v, because this
   pset depends on that code. *)

(* Delete this line if you don't like bullet points and errors like
   "Expected a single focused goal but 2 goals are focused." *)
Set Default Goal Selector "!".
Arguments Nat.modulo: simpl never.

(* In this pset, we will define a small key-value store server.
   To simplify, it only accepts GET requests: *)
Inductive request :=
| GET (client_id key : nat).

Definition get_key (req : request) : nat :=
  match req with
  | GET _ key => key
  end.

(* There are two possible responses for a GET request: *)
Inductive response :=
| FOUND (client_id key value : nat)
| NOT_FOUND (client_id key : nat).

(* Given a key-value store (modeled as an fmap), a source channel, and an output channel,
   here's how we handle one request: *)
Definition request_handler (store : fmap nat nat) (source output : channel) : proc :=
  ??source(req: request);
  match req with
  | GET client_id key =>
    match store $? key with
    | Some v => !!output(FOUND client_id key v); Done
    | None => !!output(NOT_FOUND client_id key); Done
    end
  end.

(* Key-value stores might become very large, so that they don't fit on one single
   server's disk. Therefore, we split the store into two shards:
   One for all even keys, and one for all odd keys.
   Here's a predicate asserting that a full_store is split correctly into an
   even_store and an odd_store: *)
Definition split_store (full_store even_store odd_store : fmap nat nat) : Prop :=
  (forall k, k mod 2 = 0  -> even_store $? k = full_store $? k) /\
  (forall k, k mod 2 = 0  -> odd_store  $? k = None) /\
  (forall k, k mod 2 <> 0 -> even_store $? k = None) /\
  (forall k, k mod 2 <> 0 -> odd_store  $? k = full_store $? k).

(* The goal of this pset is to define a distributed key-value-store system
   implementation that does not need to save the full store anywhere, and only
   needs full_store to specify its correctness. *)

(* We use two intermediate channels forward_even and forward_odd, and add a
   request_dispatcher to forward requests to these channels: *)
Definition request_dispatcher (input forward_even forward_odd : channel) : proc :=
  ??input(req: request);
  if get_key req mod 2 ==n 0 then
    !!forward_even(req); Done
  else
    !!forward_odd(req); Done.

(* Our balanced request handler creates two intermediate channels and then combines the
   request dispatcher with two request handlers, one for even keys and one for odd keys: *)
Definition balanced_handler (even_store odd_store : fmap nat nat) (input output : channel) : proc :=
  New[input; output](forward_even);
  New[input; output; forward_even](forward_odd);
  request_dispatcher input forward_even forward_odd
  || request_handler even_store forward_even output
  || request_handler odd_store forward_odd output.

(* Here's the correctness property that we want to hold for our balanced_handler:
   Each I/O trace generated by balanced_handler should also be a trace generated
   by one single request_handler which uses the full_store. *)
Definition correctness: Prop := forall full_store even_store odd_store input output,
    split_store full_store even_store odd_store ->
    input <> output ->
    forall trace,
      couldGenerate (balanced_handler even_store odd_store input output) trace ->
      couldGenerate (request_handler full_store input output) trace.

(* We suggest that you start by testing your understanding by answering the
   following questions.
   They are graded as follows: If you complete all the Coq proofs, you will
   get full score, no matter what you write in the answers to these questions.
   On the other hand, if you can't finish the Coq proofs, you can get up to
   40 points for answering these questions, plus points for partial Coq proofs.

Question 1) For each of the following processes, briefly describe what they do:

a)  !!ch(v); k

b)  ??ch(x: T); k

c)  pr1 || pr2

d)  Dup pr

e)  Done

f)  New[ch1; ch2; ch3](ch4); k

g)  Block ch; k

Question 2) Is the "refines" relation symmetric?
That is, if "pr1 <| pr2", does that imply "pr2 <| pr1"?

Question 3) Which of "||" and ";" binds stronger?
In other words, does "pr1 || pr2 ; pr3" equal "pr1 || (pr2 ; pr3)" or
"(pr1 || pr2) ; pr3"?

Hint: Here's how you could solve this question for nats and "+" vs "*":
Goal forall (a b c: nat), a + b * c = 0.
Proof.
  simplify.
  Set Printing All.
  prints "(Init.Nat.add a (Init.Nat.mul b c))", so it's clear that
  "*" binds stronger.

Question 4) Draw a diagram of the balanced request handler and the channels it uses

Question 5) In order to prove refinements, we need to provide a simulation relation
R of type "proc -> proc -> Prop", and prove the three conditions defined by "simulates".
If we just pick "fun pr1 pr2 => True" for R, which of these three conditions can/cannot
be proven? And what if we pick "fun pr1 pr2 => False"?

Question 6) The specification (addN 2 input output) in MessagesAndRefinement.v performs
the following steps:

1) It starts as

         (??input(n : nat); !!output(n + 2); Done)

   where it reads an input n

2) and then becomes

         (!!output(n + 2); Done)

   where it outputs (n + 2)

3) and then becomes

         Done

Write down the same kind of explanation of steps for the implementation (add2_once input output):
You should get steps numbered from 1) to 5).

Question 7) In order to prove that the specification (addN 2 input output) can
simulate the implementation (add2_once input output), we have to show that each
implementation state has a corresponding specification state. Do so by filling
out the following table:

Impl  | Spec
state | state
------+------
  1   |
  2   |
  3   |
  4   |
  5   |

Question 8) If you completed the above table, you've actually just created a paper
proof of add2_once_refines_addN. Now study the Coq proof add2_once_refines_addN,
and look at the three subgoals opened after the call to first_order.
Where do they come from, and what does each of them ask you to prove?

*)

(* Now you should be ready to start proving correctness!
   NOTE: You MUST use refinement ("_ <| _") and "simulates" to earn full credit on this pset.
   Hint: You should follow the same approach as add2_once_refines_addN and define a relation
   similar to R_add2, with the following signature, where we use "fs", "es", and "os" as
   abbreviations for full_store, even_store, and odd_store: *)
Inductive R (fs es os : fmap nat nat) (input output : channel) : proc -> proc -> Prop :=
(* FILL IN HERE *)
.

(* One more hint: You can use the "lists" tactic to prove any "NoDup" goals/contradictions. *)

(* And another hint: Here's some tactic which you might find handy in your proofs.
   Feel free to use and/or adapt it! *)

Ltac head e :=
  match e with
  | ?e _ => head e
  | _ => e
  end.

Ltac head_constructor e :=
  let e := eval cbv beta delta in e in (* this is quite agressive... *)
  let h := head e in
  is_constructor h.

Ltac t_step :=
  match goal with
  | |- _ => solve [propositional]
  | H : ?a = ?b |- _ => head_constructor a; head_constructor b; progress invert H
        (* the previous case can loop because repeat invert can loop,
           propositional earlier prunes the cases where this occurs in our proof *)
  | H : R _ _ _  _ _  _ _ |- _ => invert H
  | H:lstep ?c _ _ |- _ => head_constructor c; (apply invert_Recv in H; try subst) || invert H
  | H:lstepSilent ?c _ |- _ => head_constructor c; invert H
  | r : request |- _ => cases r
  | H : True |- _ => clear H
  | _ => progress (cbn [notUse Channel get_key] in *; simplify)
  | |- _ /\ _ => split
  | _ => solve [equality]
  end.

Ltac t := repeat t_step.

Theorem balanced_handler_correct : correctness.
Proof.
Admitted.

(* OPTIONAL exercise (ungraded, very short):
   Another important property of refinment is that any subpart of a larger
   program can be replaced with a refined version of it, yielding a refined
   version of the larger program. You can try it out by wrapping our one-shot
   server in Dup and using the "impl <| spec" fact you proved as a part of
   the last theorem to show "Dup impl <| Dup spec". This should be trivial
   once you have found the appropariate lemma from frap and factored out the
   appropriate refinement claim from the last proof. *)
Lemma multicorrectness : forall full_store even_store odd_store input output,
  split_store full_store even_store odd_store ->
  input <> output ->
  forall trace,
    couldGenerate (Dup (balanced_handler even_store odd_store input output)) trace ->
    couldGenerate (Dup (request_handler full_store input output)) trace.
Proof.
Admitted.