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