(* Use of this source code is governed by the license described	* * in the LICENSE file at the root of the source tree.		*)
(* Lists of booleans and related theory. *)
Set Implicit Arguments.
Require Export List.
Require Export Bvector.
Local Open Scope list_scope.
Definition Blist := list bool.
Definition Blist_eq_dec := (list_eq_dec bool_dec).
Definition Bvector_eq_dec(n : nat)(v1 v2 : Bvector n) : {v1 = v2} + {v1 <> v2}.
apply (EqDec_dec (Bvector_EqDec n)).
Defined.
(* shiftOut gets bits from the head of the list. *)
(* return None when we run out *)
Fixpoint shiftOut(s : Blist)(n : nat) : option (Bvector n * Blist) :=
match n with
| 0 => Some ((@Vector.nil bool), s)
| S n' =>
match s with
| nil => None
| b :: s' =>
match (shiftOut s' n') with
| Some (v', s'') => Some (Vector.cons _ b _ v', s'')
| None => None
end
end
end.
induction n; simpl in *; intuition.
destruct s1; simpl in *.
inversion H; clear H; subst.
destruct s2; simpl.
trivial.
trivial.
inversion H; clear H; subst.
rewrite app_comm_cons.
trivial.
destruct s1; simpl in *.
discriminate.
case_eq (shiftOut s1 n); intuition.
rewrite H0 in H.
destruct p.
inversion H; clear H; subst.
erewrite IHn; eauto.
rewrite H0 in H.
discriminate.
Qed.
induction ls; intuition; simpl in *.
destruct n.
omega.
trivial.
destruct n.
omega.
rewrite IHls.
trivial.
omega.
Qed.
induction ls; intuition; simpl in *.
assert (n = O).
omega.
subst.
exists ([], nil).
trivial.
destruct n.
exists ([], a :: ls).
trivial.
assert (length ls >= n).
omega.
destruct (IHls n).
trivial.
destruct x.
econstructor.
rewrite H1.
eauto.
Qed.
induction n; destruct ls; intuition; simpl in *; try discriminate.
apply gt_n_S.
eapply IHn.
case_eq (shiftOut ls n); intuition; trivial.
rewrite H0 in H.
destruct p.
discriminate.
Qed.
induction n; destruct ls; intuition; simpl in *; try discriminate.
apply le_n_S.
case_eq (shiftOut ls n); intuition.
destruct p.
eauto.
rewrite H0 in H.
discriminate.
Qed.
induction n; destruct ls; intuition; simpl in *.
inversion H; clear H; subst.
simpl.
trivial.
inversion H; clear H; subst.
simpl.
trivial.
discriminate.
case_eq (shiftOut ls n); intuition.
rewrite H0 in H.
destruct p.
inversion H; clear H; subst.
simpl.
f_equal.
apply IHn in H0.
subst.
trivial.
rewrite H0 in H.
discriminate.
Qed.
induction m; intuition.
rewrite (vector_0 v).
simpl.
trivial.
destruct (vector_S v).
destruct H.
subst.
simpl.
f_equal.
eapply IHm.
Qed.
Definition of_list_length (A : Set)(m : nat)(ls : list A)(pf : length ls = m) : Vector.t A m :=
match pf with
| eq_refl => Vector.of_list ls
end.
Definition of_sig_list (A : Set)(m : nat)(l : {ls : list A | length ls = m}) : Vector.t A m :=
match l with
| exist _ ls pf => (of_list_length ls pf)
end.
intuition.
destruct (vector_S v).
destruct H.
subst.
destruct (vector_0 x0).
simpl.
trivial.
Qed.
intuition.
destruct s; simpl in *; trivial.
Qed.
Abort.
Abort.
(* Todo : we need a general theorem that covers these sorts of facts.  Something like: shiftOut s n1 = Some(_, s1) -> shiftOut s1 n2 = x -> shiftOut s (n1 + n2) = x *)
destruct n; intuition; simpl in *.
eapply eq_trans.
eapply H.
specialize (shiftOut_0 s1); intuition.
rewrite H0 in H1.
inversion H1; clear H1; subst.
f_equal.
f_equal.
eapply vector_hd_cons_eq.
destruct s; intuition; simpl in *.
discriminate.
rewrite shiftOut_0 in H.
inversion H; clear H; subst.
rewrite H0.
f_equal.
Qed.
Fixpoint oneList(n : nat) : Blist :=
match n with
| 0 => nil
| S n' => true :: (oneList n')
end.
induction n; intuition; simpl in *.
auto.
Qed.
(* TODO: remove oneVector and replace it with Bvect_true *)
Fixpoint oneVector(n : nat) : Bvector n :=
match n with
| 0 => Vector.nil bool
| S n' => Vector.cons _ true _ (oneVector n')
end.
induction n; intuition; simpl in *.
rewrite IHn.
trivial.
Qed.
Fixpoint getAllBlists(n : nat) : (list Blist) :=
match n with
| 0 => nil :: nil
| S n' => (map (cons true) (getAllBlists n')) ++
(map (cons false) (getAllBlists n'))
end.
Fixpoint getAllBlists_app(n : nat) : list Blist :=
match n with
| 0 => nil :: nil
| S n' => (map (fun ls => ls ++ (true :: nil)) (getAllBlists_app n')) ++
(map (fun ls => ls ++ (false :: nil)) (getAllBlists_app n'))
end.
Fixpoint getAllBvectors(n : nat) : (list (Bvector n)) :=
match n with
| 0 => (Vector.nil bool) :: nil
| S n' => (map (Vector.cons _ true _) (getAllBvectors n')) ++
(map (Vector.cons _ false _) (getAllBvectors n'))
end.
induction n; intuition; simpl in *.
rewrite app_length.
repeat rewrite map_length.
rewrite plus_0_r.
f_equal; eauto.
Qed.
induction n; intuition; simpl in *.
rewrite app_length.
repeat rewrite map_length.
rewrite <- plus_0_r.
eapply gt_trans.
eapply plus_gt_compat_l.
apply IHn.
repeat rewrite plus_0_r.
apply IHn.
Qed.
induction v; intuition; simpl.
auto.
eapply in_or_app; intuition.
destruct h.
left.
eapply in_map; eauto.
right.
eapply in_map; eauto.
Qed.
intuition.
specialize (vector_S v1).
specialize (vector_S v2).
intuition.
destruct H0. destruct H0.
destruct H1. destruct H1.
subst.
simpl.
trivial.
Qed.
intuition.
apply vector_tl_eq in H.
simpl in *.
trivial.
Qed.
intuition.
eapply H.
eapply vector_cons_eq.
eauto.
Qed.
induction ls; intuition; simpl in *.
econstructor.
inversion H; subst; clear H.
econstructor.
intuition.
apply in_map_iff in H.
destruct H.
intuition.
eapply H0; eauto.
intuition.
subst.
intuition.
eapply IHls; eauto.
Qed.
induction n; intuition; simpl in *.
econstructor.
eapply in_nil.
econstructor.
eapply app_NoDup.
eapply map_NoDup; eauto.
intros.
eapply vector_cons_ne; eauto.
eapply map_NoDup; eauto.
intros.
eapply vector_cons_ne; eauto.
intuition.
apply in_map_iff in H.
apply in_map_iff in H0.
destruct H.
destruct H0.
intuition.
subst.
inversion H.
intuition.
apply in_map_iff in H.
apply in_map_iff in H0.
destruct H.
destruct H0.
intuition.
subst.
inversion H.
Qed.
induction n; intuition; simpl in *.
econstructor.
simpl.
intuition.
econstructor.
eapply app_NoDup; intuition.
eapply map_NoDup; intuition.
eapply H.
inversion H0; subst; intuition.
eapply map_NoDup; intuition.
eapply H.
inversion H0; subst; intuition.
apply in_map_iff in H.
apply in_map_iff in H0.
destruct H.
destruct H0.
intuition.
subst.
discriminate.
apply in_map_iff in H.
apply in_map_iff in H0.
destruct H.
destruct H0.
intuition.
subst.
discriminate.
Qed.
induction n; intuition; simpl in *.
econstructor.
simpl.
intuition.
econstructor.
eapply app_NoDup; intuition.
eapply map_NoDup; intuition.
eapply H.
apply app_inj_tail in H0.
intuition.
eapply map_NoDup; intuition.
eapply H.
eapply app_inj_tail in H0.
intuition.
apply in_map_iff in H.
apply in_map_iff in H0.
destruct H.
destruct H0.
intuition.
subst.
apply app_inj_tail in H; intuition.
apply in_map_iff in H.
apply in_map_iff in H0.
destruct H.
destruct H0.
intuition.
subst.
apply app_inj_tail in H; intuition.
Qed.
induction ls; intuition; simpl in *.
omega.
destruct n.
destruct ls; simpl in *; try omega.
exists a. exists nil.
simpl.
intuition.
inversion H; clear H.
edestruct IHls; intuition.
eauto.
destruct H.
intuition.
exists x.
exists (a :: x0).
subst.
simpl.
intuition.
Qed.
induction n; intuition; simpl in *.
econstructor.
econstructor.
simpl.
trivial.
eapply rel_map_app.
eapply rel_map_map2.
eapply rel_map_impl; eauto; intuition.
subst.
simpl.
trivial.
eapply rel_map_map2.
eapply rel_map_impl; eauto; intuition.
subst.
simpl.
trivial.
Qed.
induction n; intuition; simpl in *.
econstructor.
econstructor.
trivial.
eapply rel_map_app.
eapply rel_map_map2.
eapply rel_map_impl; eauto; intuition.
subst.
rewrite rev_unit.
trivial.
eapply rel_map_map2.
eapply rel_map_impl; eauto; intuition.
subst.
rewrite rev_unit.
trivial.
Qed.
induction n; intuition; simpl in *.
destruct H; subst; intuition.
apply in_app_or in H;
destruct H;
apply in_map_iff in H;
destruct H;
intuition;
subst;
rewrite app_length; simpl;
rewrite plus_comm; simpl;
f_equal;
eapply IHn; eauto.
Qed.
induction n; intuition; simpl in *;
destruct ls; simpl in *; intuition; try omega.
edestruct (ls_last_exists (b :: ls)).
simpl.
eauto.
destruct H0.
intuition.
rewrite H2.
eapply in_or_app.
destruct x; [left | right];
eapply in_map_iff;
econstructor; intuition.
Qed.
induction n; intuition; simpl in *.
destruct H; subst; intuition.
apply in_app_or in H;
destruct H;
apply in_map_iff in H;
destruct H;
intuition;
subst;
simpl;
f_equal;
eapply IHn; eauto.
Qed.
induction n; intuition; simpl in *;
destruct ls; simpl in *; intuition; try omega.
apply in_or_app.
destruct b; [left | right];
eapply in_map_iff; eauto.
Qed.
intuition.
eapply NoDup_Permutation.
apply getAllBlists_NoDup.
apply getAllBlists_app_NoDup.
intuition.
specialize (getAllBlists_rel_map n); intuition.
specialize (rel_map_in_inv H0 x); intuition.
destruct H2.
intuition.
subst.
eapply getAllBlists_app_length_In.
rewrite rev_length.
eapply getAllBlists_app_In_length.
eauto.
specialize (getAllBlists_app_rel_map n); intuition.
specialize (rel_map_in_inv H0 x); intuition.
destruct H2.
intuition.
subst.
eapply getAllBlists_length_In.
rewrite rev_length.
eapply getAllBlists_In_length.
eauto.
Qed.
induction n; intuition; simpl in *.
rewrite app_length.
repeat rewrite map_length.
rewrite plus_0_r.
rewrite <- IHn.
trivial.
Qed.
Fixpoint tailOpt(A : Set)(n : nat)(v : Vector.t A n) : option (Vector.t A (pred n)):=
match v with
| [] => None
| Vector.cons _ _ _ v => Some v
end.
intuition.
subst.
trivial.
Qed.
intuition.
inversion H; trivial.
assert (tailOpt (Vector.cons A a1 n v1) = tailOpt (Vector.cons A a2 n v2)).
eapply tailOpt_eq.
trivial.
simpl in *.
inversion H0; clear H0; subst.
trivial.
Qed.
intros.
inversion H; clear H; subst.
intuition.
Qed.
intuition.
inversion H; clear H; subst.
trivial.
Qed.
induction n; intuition; simpl in *.
destruct ls1; simpl in *; try discriminate.
destruct ls2; simpl in *; try discriminate.
case_eq (shiftOut ls1 n); intuition.
rewrite H1 in H.
case_eq (shiftOut ls2 n); intuition.
rewrite H2 in H0.
destruct p.
destruct p0.
inversion H; clear H; subst.
apply opt_eq_inv in H0.
apply pair_eq_inv in H0; intuition.
apply vector_cons_eq_inv in H; intuition; subst.
f_equal.
eapply IHn.
eapply H1.
eapply H2.
rewrite H2 in H0.
discriminate.
rewrite H1 in H.
discriminate.
Qed.
intuition.
Qed.
intros; subst.
assert (ls3 = nil).
rewrite app_length in H0.
assert (length ls3 = O).
omega.
destruct ls3; simpl in *; try omega; trivial.
subst.
rewrite app_nil_r.
intuition.
Qed.
induction n; intuition.
rewrite (vector_0 v2).
rewrite (vector_0 v1).
trivial.
destruct (vector_S v1).
destruct (vector_S v2).
destruct H0.
destruct H1.
subst.
unfold VectorDef.to_list in *.
inversion H; clear H; subst.
f_equal.
eauto.
Qed.
intuition.
edestruct (shiftOut_Some (VectorDef.to_list v)).
eapply le_refl_gen.
symmetry.
eapply (to_list_length v).
destruct x.
rewrite H.
apply shiftOut_correct_inv in H.
apply app_first_eq in H.
intuition; subst.
apply to_list_eq_inv in H0; subst.
trivial.
repeat rewrite to_list_length.
trivial.
Qed.
induction ls1; intuition; simpl in *.
destruct n; destruct ls2; try discriminate; trivial.
destruct n.
discriminate.
case_eq (shiftOut (ls1 ++ ls2) n); intuition.
rewrite H0 in H.
destruct p.
discriminate.
rewrite H0 in H.
erewrite IHls1.
trivial.
eauto.
Qed.
induction n; intuition.
rewrite (vector_0 v).
simpl.
unfold Bvect_false.
simpl.
trivial.
destruct (vector_S v).
destruct H.
rewrite H.
unfold Bvect_false.
simpl.
rewrite IHn.
rewrite xorb_nilpotent.
trivial.
Qed.
induction n; intuition.
rewrite (vector_0 v1).
rewrite (vector_0 v2).
trivial.
destruct (vector_S v1).
destruct H.
destruct (vector_S v2).
destruct H0.
subst.
simpl.
rewrite IHn.
rewrite xorb_comm.
trivial.
Qed.
induction n; intuition.
rewrite (vector_0 v).
unfold Bvect_false.
simpl.
trivial.
destruct (vector_S v).
destruct H.
unfold Bvect_false.
subst.
simpl.
rewrite IHn.
rewrite xorb_false_r.
trivial.
Qed.
intuition.
rewrite BVxor_comm.
apply BVxor_id_r.
Qed.
induction n; intuition.
rewrite (vector_0 v1).
rewrite (vector_0 v2).
rewrite BVxor_same_id.
rewrite BVxor_id_l.
rewrite (vector_0).
rewrite (vector_0 v3).
trivial.
destruct (vector_S v1).
destruct H.
destruct (vector_S v2).
destruct H0.
destruct (vector_S v3).
destruct H1.
subst.
simpl.
rewrite IHn.
rewrite xorb_assoc.
trivial.
Qed.
intuition.
rewrite <- BVxor_id_l at 1.
rewrite <- (BVxor_same_id v1).
rewrite BVxor_assoc.
f_equal; intuition.
Qed.
intuition.
rewrite <- BVxor_id_l at 1.
rewrite <- (BVxor_id_l v2).
rewrite <- (BVxor_same_id v2) at 1.
rewrite BVxor_assoc.
rewrite BVxor_comm.
f_equal; intuition.
rewrite BVxor_comm.
trivial.
Qed.
Definition lognat(n : nat) : nat :=
N.size_nat (N.of_nat n).
Definition bvToNat(k : nat)(v : Bvector k) :=
N.to_nat (Bv2N k v).
induction n; intuition; simpl in *.
unfold N.double in *.
unfold Bvect_false in *.
rewrite IHn.
trivial.
Qed.
intuition.
unfold bvToNat.
assert (N.to_nat N0 = O).
simpl.
trivial.
rewrite <- H.
f_equal.
eapply Bv2N_zero.
Qed.
Definition natToBv(k : nat)(v : nat) : Bvector k :=
N2Bv_gen k (N.of_nat v).
induction n1; intuition.
rewrite (vector_0 v1).
simpl.
apply Bv2N_zero.
destruct (vector_S v1).
destruct H.
rewrite H.
simpl.
destruct x.
rewrite IHn1.
trivial.
rewrite IHn1.
trivial.
Qed.
intuition.
assert (exists x, n0 = N.size_nat k + x)%nat.
exists (minus n0 (N.size_nat k)).
omega.
destruct H0.
rewrite H0.
rewrite N2Bv_N2Bv_gen_above.
rewrite Bv2N_app_false.
apply Bv2N_N2Bv.
Qed.
intuition.
unfold bvToNat, natToBv.
rewrite Bv2N_N2Bv_gen.
apply Nnat.Nat2N.id.
trivial.
Qed.
intuition.
destruct n1; simpl.
omega.
destruct n2; simpl.
inversion H.
eapply Pos.size_nat_monotone.
intuition.
Qed.
intuition.
unfold lognat.
eapply Nat_size_nat_monotonic.
specialize (Nnat.Nat2N.inj_compare n1 n2); intuition.
apply nat_compare_lt in H.
rewrite H in H0.
case_eq (N.of_nat n1 ?= N.of_nat n2)%N; intuition;
congruence.
Qed.
intuition.
unfold natToBv, bvToNat.
rewrite Nnat.N2Nat.id.
apply N2Bv_Bv2N.
Qed.

Lemma bvToNat_natToBv_eq : forall n (v : Bvector n) k,
bvToNat v = k ->
v = natToBv n k.