(* Use of this source code is governed by the license described	* * in the LICENSE file at the root of the source tree.		*)
(* Operations that fold and map a computation over a list, and related theory. *)
Set Implicit Arguments.
Local Open Scope list_scope.
(* Definitions for fold, map etc.   These should probably go somewhere else. *)
(* Fold a computation over a list *)
Fixpoint compFold(A B : Set)(eqd : EqDec B)(f : B -> A -> Comp B)(init : B)(ls : list A) :=
match ls with
| nil => ret init
| a :: ls' =>
init' <-$ f init a;
compFold  _ f init' ls'
end.
(* foldBody_option is an adapter that allows you to fold a computation with signature B -> A -> Comp (option B) over a list of A, accumulating an option B. *)
Definition foldBody_option(A B : Set)(eqd : EqDec B)(f : B -> A -> Comp (option B))(b_opt : option B)(a : A) :=
match b_opt with
| None => ret None
| Some b =>
f b a
end.
Definition opt_pred(A B : Set)(P : A -> B -> Prop)(opt_a : option A)(opt_b : option B) :=
match opt_a with
| Some a =>
match opt_b with
| Some b => P a b
| None => False
end
| None =>
match opt_b with
| Some _ => False
| None => True
end
end.
intuition.
unfold foldBody_option.
unfold opt_pred in *.
destruct opt_a; destruct opt_b; intuition.
eapply comp_spec_ret; intuition.
Qed.
induction 1; intuition; simpl.
eapply comp_spec_ret; intuition.
eapply comp_spec_seq; eauto.
eapply foldBody_option_spec; eauto.
Qed.
(* Map a computation over a list. *)
Fixpoint compMap (A B : Set)(eqdb : EqDec B)(c : A -> Comp B)(ls : list A) : Comp (list B) :=
match ls with
| nil => ret nil
| a :: lsa' =>
b <-$ c a;
lsb' <-$ compMap _ c lsa';
ret (b :: lsb')
end.
intuition.
simpl.
intuition.
Qed.
intuition.
Qed.
intuition.
apply nil.
Qed.
induction ls; intuition.
unfold compMap.
prog_simp.
intuition.
simpl.
prog_inline_first.
Hint Resolve list_inhabited : inhabited.
eapply comp_spec_seq; intuition;
eauto with inhabited.
eapply comp_spec_eq_trans.
2:{
eapply comp_spec_seq_eq; eauto with inhabited.
eapply comp_spec_eq_refl.
intuition.
eapply comp_spec_seq_eq; eauto with inhabited.
intuition.
eapply comp_spec_eq_refl.
}
prog_swap_r.
prog_inline_first.
prog_skip.
Qed.
intuition.
eapply compMap_fission_eq; intuition.
simpl.
eapply comp_spec_eq_refl.
simpl.
prog_simp.
eapply comp_spec_ret.
congruence.
Qed.
induction ls; intuition.
unfold compMap.
prog_simp.
eapply comp_spec_eq_refl.
simpl.
prog_inline_first.
prog_at prog_inline rightc 1%nat.
simpl.
prog_at prog_ret rightc 2.
simpl.
prog_at prog_swap rightc 1%nat.
eapply comp_spec_eq_trans.
eapply comp_spec_seq_eq; intuition.
eapply comp_spec_eq_refl.
prog_inline_first.
do 2 prog_skip.
Qed.
induction ls_b; intuition.
simpl.
prog_simp.
simpl.
eapply comp_spec_ret.
trivial.
simpl.
prog_inline_first.
prog_at prog_inline rightc 1%nat.
simpl.
prog_at prog_ret rightc 2.
simpl.
prog_at prog_swap rightc 1%nat.
Ltac prog_assoc_r :=
eapply comp_spec_eq_trans_r; [ idtac | eapply comp_spec_assoc].
prog_assoc_r.
eapply comp_spec_seq; intuition.
Qed.
(* A bounded repeat based on fold. *)
Definition repeatMax(A : Set)(eqd : EqDec A)(c : Comp A)(P : A -> bool) def (n : nat):=
compFold _ (fun a' i => if (P a') then (ret a') else c) def (allNatsLt n).
induction ls; intuition; simpl.
eapply comp_spec_eq_refl.
rewrite H.
prog_simp.
intuition.
Qed.
induction ls; intuition.
simpl.
intuition.
unfold compFold.
fold compFold.
eapply getSupport_In_Seq.
rewrite H0.
eapply H.
simpl.
intuition.
eapply IHls; intuition.
Qed.
induction 1; intuition.
simpl.
eapply comp_spec_ret.
trivial.
simpl.
case_eq (P1 a); intuition.
assert (P2 b = true).
eapply H3; eauto.
rewrite H5.
prog_simp.
eauto.
case_eq (P2 b); intuition.
assert (P1 a = true).
eapply H3; intuition; eauto.
congruence.
eapply comp_spec_seq; intuition.
Qed.
induction 1; intuition; simpl.
eapply comp_spec_eq_refl.
eapply comp_spec_seq; intuition.
subst.
intuition.
Qed.
induction 1; intuition.
inversion H.
subst.
econstructor.
inversion H1; clear H1; subst.
inversion H2; clear H2; subst.
simpl.
econstructor; intuition.
Qed.
induction lsa; intuition; simpl in *; econstructor; intuition.
Qed.
induction lsa; destruct lsb; intuition; simpl in *; try omega.
econstructor.
econstructor;
intuition.
Qed.
induction 1; intuition; simpl in *.
f_equal.
intuition.
Qed.
intuition.
eapply list_pred_impl.
eapply list_pred_zip_l.
eauto.
eapply list_pred_eq.
eapply list_pred_I.
symmetry.
eapply list_pred_length_eq; eauto.
intuition.
Qed.
induction ls; intuition; simpl in *.
econstructor.
econstructor; intuition.
Qed.
induction 1; intuition; simpl in *.
econstructor.
econstructor; intuition.
econstructor; intuition.
trivial.
Qed.
induction 1; intuition.
inversion H.
subst.
econstructor.
inversion H1; clear H1; subst.
inversion H2; clear H2; subst.
simpl.
econstructor; intuition.
Qed.
induction ls; intuition; simpl in *.
econstructor.
econstructor; intuition.
Qed.
(* map constructed out of fold -- more complicated but allows us to apply any fold theory to map operations.*)
Definition compMap_fold (A B : Set)(eqd : EqDec B)(c : A -> Comp B)(ls : list A) :=
compFold _ (fun (acc : list B)(a : A) => b <-$ c a; ret (acc ++ (b :: nil))) nil ls.
induction lsa; intuition; simpl.
eapply comp_spec_ret; intuition.
eapply comp_spec_seq; intuition.
eapply H0; eauto.
intuition.
Qed.
induction ls; intuition; simpl.
unfold compMap_fold.
simpl.
eapply comp_spec_eq_refl.
unfold compMap_fold.
simpl.
prog_inline_first.
prog_skip.
prog_simp.
eapply comp_spec_eq_trans.
eapply comp_spec_seq_eq; eauto with inhabited.
intuition.
eapply comp_spec_eq_refl.
unfold compMap_fold.
eapply comp_spec_eq_trans_r.
2:{
eapply comp_spec_right_ident.
}
eapply comp_spec_seq; eauto with inhabited.
eapply (@compFold_spec _ _ _ (fun ls p1 p2 => b :: p1 = p2)); intuition.
subst.
simpl.
comp_skip.
eapply comp_spec_ret.
trivial.
intuition.
subst.
eapply comp_spec_eq_refl.
Qed.
induction ls; intuition.
unfold compFold.
wftac.
unfold compFold.
fold compFold.
wftac.
Qed.
induction ls; intuition.
simpl.
eapply comp_spec_eq_refl.
simpl.
prog_simp.
eapply comp_spec_eq_trans.
eapply comp_spec_seq_eq; intuition.
eapply IHls.
eapply comp_spec_eq_refl.
prog_simp.
eapply comp_spec_eq_refl.
Qed.
induction ls; intuition.
simpl in *.
intuition.
unfold compFold in H.
fold compFold in H.
simp_in_support.
assert (x0 = init).
eapply H0; eauto.
simpl.
intuition.
subst.
eapply IHls.
trivial.
intuition.
eapply H0; eauto.
simpl.
intuition.
Qed.
induction ls1; intuition.
rewrite app_nil_l.
unfold compFold.
fold compFold.
comp_simp.
intuition.
rewrite <- app_comm_cons.
unfold compFold.
fold compFold.
inline_first.
comp_skip.
Qed.
intuition.
eapply compFold_eq.
eapply list_pred_eq.
intuition.
subst.
eauto.
Qed.
induction lsa1; intuition; simpl in *.
econstructor.
inversion H; clear H; subst.
econstructor; intuition.
eapply IHlsa1; eauto.
inversion H; clear H; subst.
eapply IHlsa1; eauto.
Qed.
induction lsa; intuition; simpl in *.
inversion H; clear H; subst.
econstructor.
inversion H; clear H; subst.
econstructor.
trivial.
eauto.
Qed.
Definition flatten_prep
(A B : Set)(ls : list (A * (list B))) : list (list (nat * nat * A * B)) :=
map (fun p => [a, lsb] <-2 p; map (fun p' => [i, b] <-2 p'; (i, length lsb, a, b)) (zip (allNatsLt (length lsb)) lsb)) ls.
induction ls1; intuition.
simpl in H.
inversion H; clear H; subst.
unfold compFold.
eapply evalDist_ret_eq.
trivial.
simpl in H.
unfold compFold.
fold compFold.
eapply list_pred_app in H.
intuition.
erewrite <- (@firstn_skipn _ _ ls2).
rewrite compFold_app.
comp_skip.
Qed.
induction 1; intuition.
unfold compMap.
intuition.
unfold compMap. fold compMap.
comp_skip.
comp_skip.
Qed.
induction 1;
intuition.
unfold compFold.
fold compFold.
comp_skip.
eapply IHPermutation; intuition.
eapply H1.
simpl.
right.
eapply H4.
eapply H5.
trivial.
eapply H1.
simpl.
left.
eauto.
eauto.
trivial.
unfold compFold.
fold compFold.
eapply (trans _  (evalDist (init'0 <-$ (init' <-$ c init y; c init' x); compFold eqd c init'0 l) x0)).
inline_first.
intuition.
eapply trans.
comp_skip.
eapply eqRat_refl.
inline_first.
intuition.
eapply trans.
eapply IHPermutation1; intuition.
eapply H1; intuition.
eapply Permutation_in; eauto.
eapply IHPermutation2; intuition.
eapply H1; intuition.
eapply Permutation_in.
eapply Permutation_sym.
eauto.
trivial.
eapply H2; eauto.
eapply Permutation_in.
eapply Permutation_sym.
eauto.
trivial.
Qed.
induction lsa1; destruct lsb1; intuition.
inversion H.
inversion H.
inversion H; clear H; subst.
repeat rewrite <- app_comm_cons.
econstructor.
trivial.
eauto.
Qed.
induction lsa; destruct lsb; intuition; simpl in *.
econstructor.
inversion H.
inversion H.
inversion H; clear H; subst.
econstructor; intuition.
eauto.
Qed.
induction 1; intuition.
unfold compMap.
eapply comp_spec_ret.
econstructor.
simpl.
eapply comp_spec_seq.
apply nil.
apply nil.
eapply H1;
simpl; intuition.
intuition.
eapply comp_spec_seq.
eapply nil.
eapply nil.
eapply IHlist_pred.
intuition.
intuition.
eapply comp_spec_ret.
econstructor; eauto.
Qed.
induction ls; intuition; simpl in *.
comp_simp; simpl; reflexivity.
inline_first; comp_skip; inline_first.
comp_swap_l.
(* comp_skip *)
(* *)
eapply comp_spec_eq_trans.
eapply (@comp_spec_seq (list C) (list C));
eauto with inhabited.
(* *)
intuition; subst.
eapply comp_spec_eq_refl.
inline_first; comp_skip; comp_simp; simpl.
comp_swap_r; comp_skip.
Qed.
intuition.
subst.
eapply list_pred_eq.
Qed.
induction lsa; intuition.
simpl in *.
intuition; subst.
econstructor.
unfold compMap in *.
fold compMap in *.
repeat simp_in_support.
econstructor.
eapply H0.
simpl.
intuition.
trivial.
eapply IHlsa.
trivial.
intuition.
Qed.
induction lsa; intuition; simpl in *.
intuition.
destruct lsb.
inversion H.
simpl in H.
intuition.
pairInv.
intuition.
right.
eapply IHlsa.
eauto.
destruct lsb.
inversion H.
simpl in *.
intuition.
pairInv.
intuition.
right.
eapply IHlsa.
eauto.
Qed.
induction 1; intuition; simpl in *.
econstructor.
econstructor.
econstructor; eauto.
eauto.
Qed.
induction lsa; inversion 1; intuition; subst; simpl in *;
econstructor.
inversion H; clear H; subst.
trivial.
inversion H; clear H; subst.
eauto.
Qed.
induction lsb; inversion 1; intuition; subst; simpl in *;
econstructor.
inversion H; clear H; subst.
trivial.
inversion H; clear H; subst.
eauto.
Qed.
induction lsa; inversion 1; intuition; subst; simpl in *;
econstructor.
inversion H; clear H; subst.
trivial.
eauto.
Qed.
induction lsa; inversion 1; intuition; subst; simpl in *;
econstructor.
inversion H; clear H; subst.
trivial.
eauto.
Qed.
induction 1; intuition.
repeat rewrite app_nil_l.
econstructor.
intuition.
econstructor.
repeat rewrite <- app_comm_cons.
econstructor; intuition.
Qed.
induction 1; intuition.
econstructor.
econstructor; intuition.
Qed.
induction ls using rev_ind; intuition; simpl in *.
econstructor.
rewrite app_length.
rewrite plus_comm.
simpl.
eapply list_pred_rev.
eapply list_pred_impl'.
eapply IHls.
intuition.
rewrite app_nth1.
eauto.
apply allNatsLt_lt.
trivial.
intuition.
rewrite app_nth2.
rewrite minus_diag.
simpl.
trivial.
intuition.
Qed.
induction ls ; intuition.
simpl in *.
intuition; subst.
simpl.
trivial.
unfold compMap in *.
fold compMap in *.
repeat simp_in_support.
simpl.
f_equal.
eauto.
Qed.
induction lsa; inversion 1; intuition; simpl in *; subst.
f_equal; eauto.
Qed.
induction lsa; intuition; simpl in *.
destruct lsb;
simpl in *.
discriminate.
f_equal.
eapply IHlsa.
omega.
Qed.
Definition numberedMap(A B : Set)(f : nat -> nat -> A -> B)(ls : list A) :=
map (fun p => [i, a] <-2 p; f i (length ls) a) (zip (allNatsLt (length ls)) ls).
intuition.
unfold numberedMap.
rewrite map_length.
repeat rewrite zip_length.
apply allNatsLt_length.
apply allNatsLt_length.
Qed.
induction lsa; destruct lsb; destruct n; intuition; simpl in *; try omega; try pairInv; intuition.
inversion H; clear H; subst.
eapply IHlsa.
eauto.
eauto.
eapply IHlsa.
eauto.
eauto.
Qed.
induction lsa; destruct lsb; intuition.
simpl.
eapply comp_spec_ret; intuition.
simpl in *.
discriminate.
simpl in *.
discriminate.
simpl.
eapply comp_spec_seq; intuition.
eapply H1; eauto.
eapply IHlsa; eauto.
Qed.
induction lsa1; intuition.
simpl in H.
intuition; subst.
repeat rewrite app_nil_l.
trivial.
unfold compMap in H.
fold compMap in H.
repeat simp_in_support.
repeat rewrite <- app_comm_cons.
unfold compMap.
fold compMap.
eapply getSupport_In_Seq; eauto.
eapply getSupport_In_Seq; eauto.
simpl; intuition.
Qed.
induction lsa; intuition; simpl in *;
econstructor.
eapply H.
intuition.
eauto.
Qed.
induction ls; intuition; simpl in *.
rewrite map_app.
f_equal; eauto.
Qed.
induction lsa1; destruct lsb1; destruct lsa2; destruct lsb2; intuition; simpl in *; try omega.
repeat rewrite app_nil_r.
trivial.
f_equal.
rewrite <-  IHlsa1.
simpl.
trivial.
omega.
simpl.
omega.
Qed.
induction 1; intuition; simpl in *.
repeat rewrite app_length.
f_equal.
trivial.
trivial.
Qed.
induction ls; intuition; simpl in *.
rewrite IHls.
rewrite <- zip_app.
rewrite map_app.
trivial.
eapply H.
intuition.
eapply length_flatten_eq.
eapply list_pred_map_r'.
eapply list_pred_map_l'.
eapply list_pred_single.
intuition.
destruct a. simpl.
eapply H.
intuition.
intuition.
Qed.
induction ls1; intuition.
rewrite app_nil_l.
unfold compMap.
fold compMap.
comp_simp.
rewrite <- evalDist_right_ident.
comp_skip.
simpl.
reflexivity.
rewrite <- app_comm_cons.
unfold compMap.
fold compMap.
inline_first.
comp_skip.
eapply eqRat_trans.
comp_skip.
eapply eqRat_refl.
inline_first.
comp_skip.
inline_first.
comp_simp.
comp_skip.
simpl.
intuition.
Qed.
induction ls; intuition; simpl in *.
eapply comp_spec_ret; simpl; intuition.
eapply comp_spec_eq_trans_r.
2:{
eapply comp_spec_eq_symm.
eapply eq_impl_comp_spec_eq.
intros.
eapply compMap_app.
}
comp_skip.
eapply comp_spec_seq.
apply nil.
apply nil.
eapply IHls.
intuition.
subst.
eapply comp_spec_ret.
simpl.
intuition.
Qed.
intuition.
subst.
eapply map_ext.
trivial.
Qed.
induction lsa; destruct lsb; intuition; simpl in *; try omega;
econstructor.
intuition.
eauto.
Qed.
induction 1; intuition; simpl in *.
intuition.
intuition.
pairInv.
trivial.
Qed.
induction lsa; destruct lsb; intuition; simpl in *; try omega.
intuition.
pairInv.
intuition.
Qed.
induction lsa; destruct lsb; intuition; simpl in *; try omega.
unfold unzip in *.
simpl.
assert ((map (fst (B:=B)) (zip lsa lsb), map (snd (B:=B)) (zip lsa lsb)) =
(lsa, lsb)).
eapply IHlsa.
omega.
repeat f_equal.
congruence.
congruence.
Qed.
Notation "'foreach' '(' x 'in' ls ')' c " := (compMap _ (fun x => c) ls) (right associativity, at level 85, only parsing) : comp_scope.
Notation "'foreach' '(' x 'in' ls ')' c " := (map (fun x => c) ls) (right associativity, at level 85, only parsing).
Notation "'for' '(' x ''<' n ')' c " := (map (fun x => c) (allNatsLt n)) (right associativity, at level 86, only parsing).
Fixpoint removePresent (A : Set)(eqd : eq_dec A)(u ls : list A) :=
match ls with
| nil => nil
| a' :: ls' =>
ls'' <- removePresent eqd u ls';
if (in_dec eqd a' u) then ls'' else (a' :: ls'')
end.
induction ls2; intuition; simpl in *.
unfold setLet in *.
destruct (in_dec eqd a0 ls1).
eauto.
simpl in *.
intuition; subst.
intuition.
Qed.
Ltac hypInv :=
try (match goal with
| [H: Some _ = Some _ |-_ ] => inversion H; clear H; subst
end); try pairInv.
Fixpoint lookupIndex (A : Set)(eqd : eq_dec A)(ls : list A)(a : A) def :=
match ls with
| nil => def
| a' :: ls' =>
if (eqd a a') then O else S (lookupIndex eqd ls' a def)
end.
induction ls; intuition; simpl in *.
intuition.
intuition; subst.
destruct (eqd a0 a0); try congruence.
destruct (eqd a0 a); subst.
trivial.
eauto.
Qed.
induction ls; intuition; simpl in *.
f_equal.
eapply H.
intuition.
eauto.
Qed.
induction ls; intuition; simpl in *.
destruct i.
omega.
omega.
destruct i.
trivial.
eapply IHls.
omega.
Qed.
induction ls2; intuition; simpl in *.
intuition; subst.
unfold setLet.
destruct (in_dec eqd a0 ls1); intuition.
unfold setLet.
destruct (in_dec eqd a ls1); subst.
eauto.
simpl.
destruct (eqd a a0); subst.
intuition.
right.
eauto.
Qed.
induction ls; intuition; simpl in *;
intuition; subst.
destruct (eqd a0 a0); subst; intuition.
destruct (eqd a0 a); subst.
omega.
eapply lt_n_S.
eapply IHls.
trivial.
Qed.
induction ls1; intuition; simpl in *; intuition.
Qed.
induction ls; intuition; simpl in *.
rewrite <- plus_assoc.
eapply IHls.
Qed.
intuition.
rewrite <- (plus_0_r init) at 1.
rewrite fold_add_init_nat_h.
trivial.
Qed.
induction ls; intuition; simpl in *.
rewrite app_length.
rewrite fold_add_init_nat.
f_equal.
eauto.
Qed.
induction ls; intuition; simpl in *.
eauto.
Qed.
induction 1; intuition; simpl in *.
rewrite fold_add_init_nat.
symmetry.
rewrite fold_add_init_nat.
symmetry.
f_equal.
eauto.
rewrite plus_comm.
trivial.
Qed.
intuition.
eapply filter_NoDup.
trivial.
Qed.
intuition.
eapply NoDup_Permutation; intuition.
eapply intersect_NoDup.
trivial.
eapply intersect_NoDup.
trivial.
unfold intersect in *.
apply filter_In in H1.
intuition.
eapply filter_In; intuition.
destruct (in_dec eqd x ls1); try congruence.
destruct (in_dec eqd x ls2); intuition.
unfold intersect in *.
apply filter_In in H1.
intuition.
eapply filter_In; intuition.
destruct (in_dec eqd x ls2); try congruence.
destruct (in_dec eqd x ls1); intuition.
Qed.

Lemma fold_add_nat_filter_partition :
forall (A : Set)(P : A -> bool)(f : A -> nat)(ls : list A),
fold_left (fun acc a => acc + (f a))%nat ls O =
(plus
(fold_left (fun acc a => acc + (f a))%nat (filter P ls) O)
(fold_left (fun acc a => acc + (f a))%nat (filter (fun a => negb (P a)) ls) O)
).