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

Theorem compFold_repeat_spec :
forall (C D: Set)(ls1 : list C)(ls2 : list D)(pre : C -> D -> Prop),
list_pred pre ls1 ls2 ->
forall (A B : Set)(eqda : EqDec A)(eqdb : EqDec B)(post : A -> B -> Prop)(c1 : C -> Comp A)(P1 : A -> bool)(c2 : D -> Comp B)(P2 : B -> bool) a b,
post a b ->
(forall a b, pre a b -> comp_spec post (c1 a) (c2 b)) ->
(forall a b, post a b -> (P1 a = true <-> P2 b = true)) ->
comp_spec
post
(compFold _ (fun acc v => if (P1 acc) then (ret acc) else (c1 v)) a ls1)
(compFold _ (fun acc v => if (P2 acc) then (ret acc) else (c2 v)) b ls2).