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

Lemma vector_tl_eq : forall (A : Set)(n : nat)(v1 v2 : Vector.t A (S n)),
v1 = v2 ->
Vector.tl v1 = Vector.tl v2.