(* Copyright 2012-2015 by Adam Petcher.				* * Use of this source code is governed by the license described	* * in the LICENSE file at the root of the source tree.		*)
(* The syntax of computations.  *)
Set Implicit Arguments.
Require Export Bvector.
Require Export List.
Require Export FCF.Blist.
Require Export FCF.EqDec.
Inductive Comp : Set -> Type :=
| Ret : forall (A : Set), eq_dec A -> A -> Comp A
| Bind : forall (A B : Set), Comp B -> (B -> Comp A) -> Comp A
| Rnd : forall n, Comp (Bvector n)
| Repeat : forall (A : Set), Comp A -> (A -> bool) -> Comp A.
(* syntactic equality for Comp *)
Inductive Comp_eq : forall (A : Set), Comp A -> Comp A -> Prop :=
| Comp_eq_Ret : forall (A : Set)(pf1 pf2 : eq_dec A)(a : A),
Comp_eq (Ret pf1 a) (Ret pf2 a)
| Comp_eq_Bind : forall (A B : Set)(c1x c1y : Comp B)(c2x c2y : B -> Comp A),
Comp_eq c1x c1y ->
(forall b, (Comp_eq (c2x b) (c2y b))) ->
Comp_eq (Bind c1x c2x) (Bind c1y c2y)
| Comp_eq_Rnd : forall n,
Comp_eq (Rnd n) (Rnd n)
| Comp_eq_Repeat : forall (A : Set)(c1 c2 : Comp A)(P1 P2 : A -> bool),
Comp_eq c1 c2 ->
(forall a, P1 a = P2 a) ->
Comp_eq (Repeat c1 P1) (Repeat c2 P2).
Hint Constructors Comp_eq : comp.
induction c; intuition; eauto with comp.
Qed.
induction n; intuition.
econstructor.
econstructor.
econstructor.
eapply IHn.
Qed.
induction 1; intuition;
eauto using Bvector_exists.
Qed.
induction 1; intuition.
exists (fun a1 a2 => if e a1 a2 then true else false).
intuition.
destruct (e x y); simpl in *; trivial. discriminate.
subst.
destruct (e y y); trivial; congruence.
eapply H.
eapply comp_base_exists; eauto.
Qed.
induction 1; intuition.
eapply H.
eapply comp_base_exists; eauto.
specialize (@Bvector_eq_dec n); intuition.
Qed.
intuition.
eapply comp_EqDec.
eapply X0.
eapply comp_base_exists.
eauto.
Qed.
intuition.
eapply comp_eq_dec.
eapply X0.
eapply comp_base_exists.
eauto.
Qed.
(* Instance comp_eq_dec : forall (A : Set), Comp A -> EqDec A.  eapply comp_base_EqDec. Qed.  Instance bind_EqDec : forall (B A : Set), Comp B -> (B -> Comp A) -> EqDec A.  intuition. eapply comp_EqDec. eapply X0. eapply comp_base_exists. eauto. Qed.  *)
Fixpoint getSupport(A : Set)(c : Comp A) : list A :=
match c with
| Ret _ a => a :: nil
| Bind c1 c2 => getUnique (flatten (map (fun b => (getSupport (c2 b))) (getSupport c1))) (bind_eq_dec c1 c2)
| Rnd n => getAllBvectors n
| Repeat c1 P => (filter P (getSupport c1))
end.
(* Only well-formed computations are guaranteed to terminate. *)
Inductive well_formed_comp : forall (A : Set), Comp A -> Prop :=
| well_formed_Ret :
forall (A : Set)(pf : eq_dec A)(a : A),
well_formed_comp (Ret pf a)
| well_formed_Bind :
forall (A B : Set)(c1 : Comp B)(c2 : B -> Comp A),
well_formed_comp c1 ->
(forall b, In b (getSupport c1) -> well_formed_comp (c2 b)) ->
well_formed_comp (Bind c1 c2)
| well_formed_Rnd : forall n,
well_formed_comp (Rnd n)
| well_formed_Repeat :
forall (A : Set)(eqd : eq_dec A)(c : Comp A) P b,
well_formed_comp c ->
In b (filter P (getSupport c)) ->
well_formed_comp (Repeat c P).
Delimit Scope comp_scope with comp.
destruct n; intuition.
Qed.
destruct ls; intuition; simpl in *.
exfalso.
eapply lt_eq_false; eauto.
econstructor; eauto.
Qed.
induction 1; intuition; simpl in *.
apply length_getUnique_nz.
apply length_nz_exists in IHwell_formed_comp.
destruct IHwell_formed_comp.
eapply length_flatten_nz.
eapply in_map_iff.
econstructor; intuition; eauto.
eapply H1.
trivial.
apply getAllBvectors_length_nz.
destruct (filter P (getSupport c)); simpl in *; intuition.
Qed.
induction ls; intuition; simpl in *.
inversion H; clear H; subst.
case_eq (P a); intuition.
econstructor; intuition.
eapply H2.
eapply filter_In; eauto.
Qed.
induction c; intuition; simpl in *.
econstructor.
apply in_nil.
econstructor.
eapply getUnique_NoDup.
eapply getAllBvectors_NoDup.
eapply filter_NoDup.
trivial.
Qed.

Lemma getSupport_Bind_In : forall (A B : Set) (c : Comp B)(f : B -> Comp A) a,
In a (getSupport (Bind c f)) ->
exists b,
In b (getSupport c) /\
In a (getSupport (f b)).