(* 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.		*)
(* A denotational semantics for computations that relates every computation to a denotation. *)
Set Implicit Arguments.
Require Export FCF.Comp.
Require Export FCF.Rat.
Local Open Scope list_scope.
Local Open Scope rat_scope.
Ltac simp_in_support :=
unfold setLet in *;
match goal with
| [H : In _ (getSupport (Bind _ _)) |- _ ] =>
apply getSupport_Bind_In in H; destruct_exists; intuition
| [H : In _ (getSupport (if ?t then _ else _)) |- _ ] => let x := fresh "x" in remember t as x; destruct x
| [H : In _ (getSupport (ret _)) |- _ ] => apply getSupport_In_Ret in H; try pairInv; subst
(*     | [H : false = inRange _ _ |- _] => symmetry in H *)
| [H : true = negb ?t |- _ ] => let x := fresh "x" in remember t as x; destruct x; simpl in H; try discriminate
end.
(* evalDist is a denotational semantics that produces a distribution instead of a value. *)
Definition Distribution(A : Set) := A -> Rat.
Definition indicator(A : Set)(P : A -> bool) :=
fun a => if (P a) then rat1 else rat0.
Fixpoint evalDist(A : Set)(c : Comp A) : Distribution A :=
match c with
| Ret eqd a => fun a' => if (eqd a a') then 1 else 0
| Bind c1 c2 => fun a =>
sumList (getSupport c1) (fun b => (evalDist c1 b) * (evalDist (c2 b) a))
| Rnd n => fun v => 1 / (expnat 2 n)
| Repeat c P => fun a => (indicator P a) * (ratInverse (sumList (filter P (getSupport c)) (evalDist c))) * (evalDist c a)
end.
Definition dist_sem_eq(A : Set)(c1 c2 : Comp A) :=
forall a, (evalDist c1 a) == (evalDist c2 a).
Definition Support(A : Set)(ls : list A)(d : Distribution A) :=
NoDup ls /\
(forall a, In a ls <-> ~((d a) == 0)).
destruct c; intuition; simpl in *.
econstructor.
apply in_nil.
econstructor.
eapply getUnique_NoDup.
eapply getAllBvectors_NoDup.
eapply filter_NoDup.
eapply getSupport_NoDup.
Qed.
intuition.
eapply H1.
eapply filter_In; eauto.
assert (P a = true -> False).
intuition.
congruence.
eapply H.
eapply filter_In; eauto.
case_eq (P a); intuition.
left.
intuition.
eapply H.
eapply filter_In; eauto.
Qed.
induction c; simpl in *; intuition.
subst.
destruct (e a0 a0).
eapply rat1_ne_rat0.
trivial.
congruence.
destruct (e a a0); subst.
intuition.
right.
intuition.
apply in_getUnique_if in H0.
apply in_flatten in H0.
destruct H0.
intuition.
apply in_map_iff in H2.
destruct H2.
intuition.
eapply sumList_0 in H1; eauto.
apply ratMult_0 in H1; intuition.
eapply IHc; eauto.
subst.
eapply H; eauto.
apply (in_getUnique (flatten (map (fun b : B => getSupport (c0 b)) (getSupport c)))).
apply in_flatten.
apply sumList_nz in H0.
destruct H0.
intuition.
apply ratMult_nz in H2.
intuition.
econstructor.
split.
eapply in_map_iff.
econstructor.
split.
eapply eq_refl.
eapply H1.
eapply H.
eauto.
eapply in_getAllBvectors.
apply ratMult_0 in H0.
intuition.
apply ratMult_0 in H1.
intuition.
unfold indicator in *.
case_eq (b a); intuition.
rewrite H1 in H0.
eapply rat1_ne_rat0.
trivial.
eapply filter_not_In.
eauto.
eauto.
eapply ratInverse_nz; eauto.
eapply IHc.
eapply filter_In.
eauto.
trivial.
apply ratMult_nz in H.
intuition.
apply ratMult_nz in H0.
intuition.
unfold indicator in *.
case_eq (b a); intuition;
rewrite H0 in H.
eapply filter_In.
intuition.
eapply IHc.
trivial.
exfalso.
intuition.
Qed.
induction c; intuition; simpl in *.
intuition.
destruct (e a a0); subst;
intuition.
eapply sumList_0.
intuition.
eapply ratMult_0.
right.
eapply H.
intuition.
eapply H0.
eapply (in_getUnique (flatten (map (fun b : B => getSupport (c0 b)) (getSupport c)))).
eapply in_flatten.
exists (getSupport (c0 a0)).
intuition.
eapply in_map_iff.
exists a0.
intuition.
exfalso.
eapply H.
eapply in_getAllBvectors.
apply filter_not_In in H.
intuition.
eapply ratMult_0.
right.
eauto.
eapply ratMult_0.
left.
unfold indicator.
rewrite H0.
rewrite ratMult_0_l.
intuition.
Qed.
intuition.
eapply getSupport_not_In_evalDist_h.
intuition.
eapply getSupport_In_evalDist; eauto.
Qed.

Theorem getSupport_correct : forall (A : Set)(c : Comp A),
Support (getSupport c)(evalDist c).