Section PRP_PRF.
Variable n : nat. (* bit vector length *)
Hint Resolve getUnusedR_wf : wftac.
Hint Resolve well_formed_perm_1 : wftac.
Definition getUnusedBvector := @getUnusedR (Bvector n) _ _ (Rnd n).
Definition well_formed_Bvector_perm := @well_formed_perm (Bvector n) _ _ _ (Rnd n).
Definition randomPerm_Bvector := @randomPerm (Bvector n) _ _ _ (Rnd n).
intuition.
eapply getUnusedR_wf; wftac.
simpl.
eapply in_getAllBvectors.
Qed.
intuition.
eapply well_formed_perm_1 in H.
destruct H.
intuition.
unfold getUnusedBvector.
eapply getUnusedR_wf; wftac.
eauto.
Qed.
Hint Resolve getUnusedBvector_wf : wftac.
(* A random permutation in which the loop that gets an unused value from the range is unrolled one step.  This is useful when comparing to a random function. *)
Definition randomPerm_unroll(p : (list (Bvector n * Bvector n)) * Bvector n) : Comp (list (Bvector n * Bvector n) * Bvector n) :=
let (f, d) := p in
match f#d with
| None => (r <-$ (r0 <-$ {0, 1}^n; if (negb (inRange _ f r0)) then ret r0 else getUnusedBvector f) ; ret ((d, r) :: f, r))
| Some r => ret (f, r)
end.
intuition.
unfold randomPerm_unroll.
case_eq (ls#b0); intuition; wftac.
edestruct H; eauto.
eapply getUnusedBvector_wf_h.
eauto.
Qed.
(* A random permutation in which the loop that gets an unused value form the range is unrolled one step and the permutation keeps track of whether the first attempt located a value that is already in the range.  This is useful when comparing to a random function. *)
Definition randomPerm_bad(p : (list (Bvector n * Bvector n)) *  Bvector n) : Comp (list (Bvector n * Bvector n) * Bvector n) :=
let (f, d) := p in
match f#d with
| None =>
r0 <-$ {0,1} ^ n;
r <-$ if (negb (inRange _ f r0)) then ret r0 else getUnusedBvector f;
ret (if (inRange _ f r0) then ((d, r) :: (d, r0) :: f) else ((d, r) :: f), r)
| Some r => ret (f, r)
end.
Fixpoint checkBad(f : list (Bvector n * Bvector n)) : bool :=
match f with
| nil => false
| (d, r) :: f' =>
orb (inRange _ f' r) (checkBad f')
end.
intuition.
unfold randomPerm_bad.
case_eq (ls#d); intuition.
wftac.
wftac.
Qed.
Hint Resolve randomPerm_bad_wf : wftac.
intuition.
unfold randomPerm_Bvector, randomPerm, randomPerm_unroll.
case_eq (s#d); intuition.
unfold getUnusedR.
comp_skip.
eapply repeat_unroll_eq; wftac.
eapply well_formed_perm_1 in H; eauto.
destruct H.
exists x0.
eapply filter_In; intuition.
destruct (inRange _ s x0); intuition.
Qed.
intuition.
unfold randomPerm_unroll in *.
case_eq (ls#d); intuition.
rewrite H1 in H0.
simpl in *.
intuition.
inversion H2; clear H2; subst.
trivial.
rewrite H1 in H0.
apply getSupport_Bind_In in H0.
destruct H0.
intuition.
apply getSupport_Bind_In in H2.
destruct H2.
intuition.
simpl in H3.
intuition.
inversion H0; clear H0; subst.
case_eq (inRange _ ls x0); intuition;
rewrite H0 in H4.
simpl in *.
apply filter_In in H4.
intuition.
eapply well_formed_perm_cons; eauto.
destruct (inRange _ ls r); intuition.
simpl in *.
intuition. subst.
eapply well_formed_perm_cons; eauto.
Qed.
intuition.
destruct p.
eapply randomPerm_unroll_preserves_wf; eauto.
Qed.
intuition.
unfold randomPerm_bad in *.
case_eq (ls#d); intuition;
rewrite H1 in H0.
simp_in_support.
trivial.
simp_in_support.
case_eq (inRange _ ls x); intuition;
rewrite H0 in H3.
simp_in_support.
simpl in *.
intuition.
inversion H3; clear H3; subst.
apply filter_In in H4.
intuition.
unfold well_formed_Bvector_perm, well_formed_perm in *.
intuition.
destruct (in_dec (EqDec_dec _) d lsd).
specialize (H6 d).
intuition.
simpl in *.
rewrite eqbBvector_complete in H7.
discriminate.
edestruct (H (d :: lsd)).
econstructor; trivial.
intuition.
simpl in H7.
intuition. subst.
trivial.
specialize (H6 d0).
intuition.
simpl in H7.
destruct (eqbBvector d0 d).
discriminate.
trivial.
intuition.
destruct (in_dec (EqDec_dec _) r x0).
exists (removeFirst (EqDec_dec _) x0 r).
intuition.
simpl.
case_eq (eqbBvector r0 r); intuition.
apply eqbBvector_sound in H11.
subst.
exfalso.
eapply removeFirst_NoDup_not_in; eauto.
case_eq (eqbBvector r0 x); intuition.
apply eqbBvector_sound in H12.
subst.
assert (inRange  _ ls x = false).
eapply H8.
eapply removeFirst_in_iff.
eauto.
congruence.
eapply H8.
eapply removeFirst_in_iff.
eauto.
simpl.
eapply in_getAllBvectors.
eapply removeFirst_NoDup.
trivial.
eapply eq_add_S.
simpl in H10.
rewrite H10.
symmetry.
eapply removeFirst_length.
trivial.
destruct x0.
simpl in *.
omega.
exists x0.
intuition.
simpl.
simpl in n1.
intuition.
case_eq (eqbBvector r0 r); intuition.
apply eqbBvector_sound in H13.
subst.
intuition.
case_eq (eqbBvector r0 x); intuition.
apply eqbBvector_sound in H14.
subst.
assert (inRange _ ls x = false).
eapply H8.
simpl.
right.
trivial.
congruence.
eapply H8.
simpl.
intuition.
simpl.
eapply in_getAllBvectors.
inversion H7; clear H7; subst.
trivial.
repeat simp_in_support.
eapply well_formed_perm_cons; trivial.
simpl in *.
discriminate.
Qed.
intuition.
destruct p.
eapply randomPerm_bad_preserves_wf; eauto.
Qed.
Definition Bvector_perms_eq := @perms_eq (Bvector n) _ _ _ (Rnd n).
(* Lemma randomPerm_unroll_bad_inv : comp_spec (fun p1 p2 => (snd p1) = (snd p2) /\ Bvector_perms_eq (fst p1) (fst p2)) (fun p1 p2 => (snd p1) = (snd p2) /\ Bvector_perms_eq (fst p1) (fst p2)) randomPerm_unroll randomPerm_bad.  unfold comp_spec.  intuition. simpl in H1. subst. unfold randomPerm_unroll, randomPerm_bad. unfold Bvector_perms_eq, perms_eq, funcs_eq in *. intuition. destruct d2. unfold snd. simpl in H3.  rewrite H3. case_eq (l # b); intuition.  comp_simp. eapply H0; intuition.  unfold randomPerm_unroll. simpl. rewrite H3. rewrite H4. simpl. intuition.  unfold randomPerm_bad. rewrite H4. simpl. intuition.  inline_first. comp_skip. inline_first.  unfold fst, snd in H5. rewrite H5. case_eq (inRange _ l r2); intuition; unfold negb. comp_skip. eapply getUnusedR_eq; intuition.  comp_simp. eapply H0; intuition; unfold fst. eapply well_formed_perm_cons; trivial. rewrite H3. trivial. eapply getUnusedR_not_inRange. rewrite H3. eauto. eauto.  eapply well_formed_perm_cons_2; intuition. simpl. destruct (eqbBvector d b); intuition. simpl. case_eq (eqbBvector r r0); intuition. case_eq (eqbBvector r r2); intuition. apply eqbBvector_sound in H12. subst. rewrite H5. trivial.  unfold snd.  eapply getSupport_In_evalDist. intuition. eapply getSupport_In_evalDist. eapply (@inSupportRandomPerm (Bvector n) (Bvector n)). eauto. rewrite H3. eauto. rewrite randomPerm_eq_unroll. trivial. simpl in H1. trivial.  Theorem inSupportRandomPerm_bad : forall a b r1 r2, In r1 (getSupport (getUnusedBvector a)) -> inRange _ a r2  = true -> a # b = None -> In ((b, r1) :: (b, r2) :: a, r1) (getSupport (randomPerm_bad (a, b))).  intuition. unfold randomPerm_bad. rewrite H1. eapply getSupport_In_Seq. simpl. eapply (in_getAllBvectors r2). eapply getSupport_In_Seq. rewrite H0. unfold negb. eauto. rewrite H0. simpl. intuition. Qed.  eapply inSupportRandomPerm_bad; eauto.  comp_simp.  eapply H0; intuition; unfold fst. eapply well_formed_perm_cons; intuition. rewrite H3. trivial. rewrite H5. trivial. eapply well_formed_perm_cons; eauto. simpl. rewrite H3. trivial. simpl. rewrite H5. trivial.  unfold snd. eapply getSupport_In_evalDist. intuition. eapply getSupport_In_evalDist. eapply (@inSupportRandomPerm (Bvector n) (Bvector n)).  simpl. eapply filter_In. split. eapply H8.  instantiate (1:=a). rewrite H5. rewrite H6. trivial. rewrite H3. eauto.  rewrite randomPerm_eq_unroll. trivial. simpl in H1. trivial.  Theorem inSupportRandomPerm_bad_1 : forall a b r1, In r1 (getSupport (getUnusedBvector a)) -> a # b = None -> In ((b, r1) :: a, r1) (getSupport (randomPerm_bad (a, b))).  intuition. unfold randomPerm_bad. rewrite H0. eapply getSupport_In_Seq. simpl. eapply (in_getAllBvectors r1). eapply getSupport_In_Seq. erewrite getUnusedR_not_inRange. simpl. intuition. eauto. eauto. erewrite getUnusedR_not_inRange. simpl. intuition. eauto. eauto. Qed.  eapply inSupportRandomPerm_bad_1; eauto. simpl. eapply filter_In. split. eapply in_getAllBvectors. rewrite H6. trivial.  Qed. *)
induction ls; intuition; simpl in *.
rewrite (H a); intuition.
destruct (P2 a).
f_equal.
eapply IHls; intuition.
eapply IHls; intuition.
Qed.
intuition.
unfold randomPerm_bad in *.
case_eq (ls # v); intuition;
rewrite H1 in H0.
simp_in_support.
trivial.
repeat simp_in_support.
simpl.
rewrite H.
eapply orb_true_r.
case_eq (inRange _ ls x); intuition.
simpl.
rewrite H.
rewrite orb_true_r.
eapply orb_true_r.
simpl.
rewrite H.
eapply orb_true_r.
Qed.
Definition randomFunc_Bvector := @randomFunc (Bvector n) _ _ _ (Rnd n).
intuition.
unfold randomFunc_Bvector, randomFunc in *.
case_eq (ls # v); intuition;
rewrite H1 in H0.
simp_in_support.
trivial.
repeat simp_in_support.
simpl.
rewrite H.
eapply orb_true_r.
Qed.
(* Lemma perm_func_bad_spec : comp_spec (fun p1 p2 => checkBad (fst p1) = true /\ checkBad (fst p2) = true /\ well_formed_Bvector_perm (fst p2)) (fun p1 p2 => checkBad (fst p1) = true /\ checkBad (fst p2) = true /\ well_formed_Bvector_perm (fst p2)) (randomFunc_Bvector) randomPerm_bad.  intuition. unfold comp_spec. intuition.  unfold randomFunc_Bvector, randomFunc, randomPerm_bad. destruct d2. case_eq (a # b); intuition; case_eq (l # b0); intuition.  comp_simp. eapply H2; intuition. unfold randomFunc_Bvector, randomFunc. rewrite H4. simpl. intuition. unfold randomPerm_bad. rewrite H5. simpl. intuition.  inline_first. comp_irr_r; wftac. inline_first. case_eq (inRange _ l x); intuition; unfold negb. comp_irr_r; wftac. comp_simp. eapply H2; intuition.  simpl. destruct (eqbBvector x0 x); intuition. unfold fst. eapply well_formed_perm_cons_2; intuition.  unfold randomFunc_Bvector, randomFunc. rewrite H4. simpl. intuition.  eapply inSupportRandomPerm_bad; eauto.  comp_simp. eapply H2; intuition. unfold fst. simpl. simpl in H0. rewrite H0. eapply orb_true_r. unfold fst in *. eapply well_formed_perm_cons; intuition.  unfold randomFunc_Bvector, randomFunc. rewrite H4. simpl. intuition. eapply inSupportRandomPerm_bad_1; eauto. simpl. eapply filter_In. intuition. rewrite H7. trivial.  comp_simp. inline_first. comp_irr_l. wftac. eapply H2; intuition. simpl in *. rewrite H1. eapply orb_true_r.  eapply inSupportRandomFunc; trivial.  unfold randomPerm_bad. rewrite H5. simpl. intuition.  inline_first. comp_skip. inline_first. case_eq (inRange _ l r2); intuition; unfold negb. comp_irr_r; wftac. comp_simp. eapply H2; intuition. simpl in *. rewrite H1. eapply orb_true_r.  simpl. destruct (eqbBvector x r2); intuition. simpl. eapply well_formed_perm_cons_2; intuition.  eapply inSupportRandomFunc; trivial. eapply inSupportRandomPerm_bad; trivial.  comp_simp. eapply H2; intuition. simpl in *. rewrite H1. eapply orb_true_r. simpl in *. rewrite H0. eapply orb_true_r. eapply well_formed_perm_cons; intuition.  eapply inSupportRandomFunc; trivial. eapply inSupportRandomPerm_bad_1; trivial. simpl. eapply filter_In; intuition. rewrite H6. trivial.  Qed.  Lemma perm_func_not_bad_spec : let s1 := (fun p1 p2 => checkBad (fst p1) = false /\ checkBad (fst p2) = false /\ snd p1 = snd p2 /\ (forall v, (fst p1) # v = ((fst p2) # v)) /\ (forall r, inRange  _ (fst p1) r = inRange _ (fst p2) r) /\ well_formed_Bvector_perm (fst p2)) in comp_spec s1 (fun p1 p2 => s1 p1 p2 \/ (checkBad (fst p1) = true /\ checkBad (fst p2) = true /\ well_formed_Bvector_perm (fst p2))) (randomFunc_Bvector) randomPerm_bad.  unfold comp_spec; intuition.  unfold randomFunc_Bvector, randomFunc, randomPerm_bad. simpl in H2. subst. destruct d2. unfold snd. simpl in H3. rewrite H3. case_eq (l # b); intuition. comp_simp. eapply H5; intuition.  simpl. rewrite H3. rewrite H2. simpl. intuition.  simpl. rewrite H2. simpl. intuition.  inline_first. comp_skip. inline_first. case_eq (inRange _ l r2); intuition; unfold negb. comp_irr_r; wftac. comp_simp. eapply H5; intuition. right. intuition. simpl. simpl in H4. rewrite H4. rewrite H7. eapply orb_true_l. simpl. case_eq (eqbBvector x r2); intuition. eapply well_formed_perm_cons_2; intuition.  eapply inSupportRandomFunc; trivial. simpl. rewrite H3. trivial.  eapply inSupportRandomPerm_bad; trivial.  comp_simp. eapply H5; intuition. left; intuition.  simpl in *. rewrite H4. rewrite H7. rewrite H1. trivial. simpl in *.  rewrite H7. rewrite H0. trivial.  simpl. rewrite H3. trivial.  simpl. rewrite H4. trivial.  unfold fst. eapply well_formed_perm_cons; intuition.  eapply inSupportRandomFunc; trivial. simpl. rewrite H3. trivial.  eapply inSupportRandomPerm_bad_1; trivial. simpl. eapply filter_In. intuition. rewrite H7. trivial. Qed. *)
Definition randomFunc_eager(p: (list (Bvector n * Bvector n)) * Bvector n) : Comp (list (Bvector n * Bvector n) * Bvector n) :=
let (f, d) := p in
r <-$ {0, 1}^n;
f' <- f ++ (d, r) :: nil;
match f # d with
| None => ret (f', r)
| Some r => ret (f', r)
end.
induction 1; intuition; simpl in *.
rewrite IHPermutation.
erewrite inRange_permutation.
eauto.
trivial.
case_eq (eqbBvector b0 b); intuition.
apply eqbBvector_sound in H. subst.
rewrite eqbBvector_complete.
simpl.
trivial.
case_eq (eqbBvector b b0); intuition.
apply eqbBvector_sound in H0.
subst.
rewrite eqbBvector_complete in H.
discriminate.
destruct (inRange _ l b0).
destruct (inRange _ l b).
simpl.
trivial.
simpl.
trivial.
simpl.
trivial.
eauto.
Qed.
intuition.
symmetry.
eapply checkBad_permutation.
eapply Permutation_cons_append.
Qed.
induction ls; intuition; simpl in *.
apply orb_true_iff in H.
intuition.
rewrite inRange_app.
simpl.
trivial.
trivial.
Qed.
(* Lemma randomFunc_eager_spec : stateful_comp_spec (fun s1 s2 => (checkBad s1 = true -> checkBad s2 = true) /\ (forall d, s1 # d = (s2 # d)) /\ forall r, inRange _ s1 r = true -> inRange _ s2 r = true) (fun p1 p2 => snd p1 = snd p2) (fun p1 p2  => snd p1 = snd p2) (randomFunc_Bvector) randomFunc_eager.  intuition. unfold stateful_comp_spec, comp_spec. intuition.  unfold randomFunc_Bvector, randomFunc, randomFunc_eager. simpl in H1. subst. destruct d2. simpl in H2. unfold snd. rewrite H2.  inline_first.  case_eq (l # b); intuition. comp_simp. inline_first. comp_irr_r; wftac. comp_simp. eapply H3; intuition.  simpl in *. eapply checkBad_app; trivial. simpl. erewrite arrayLookup_app_some; eauto. simpl in *. rewrite inRange_app_cons. simpl. case_eq (eqbBvector r x); intuition.  simpl. rewrite H2. rewrite H1. simpl. intuition.  Theorem inSupportRandomFunc_eager_Some : forall l a r b, l # a = Some b -> In (l ++ (a, r) :: nil, b) (getSupport (randomFunc_eager (l, a))).  intuition. unfold randomFunc_eager. eapply getSupport_In_Seq. simpl. eapply in_getAllBvectors. rewrite H. unfold setLet. simpl. intuition. Qed.  Theorem inSupportRandomFunc_eager_None : forall l a r, l # a = None -> In (l ++ (a, r) :: nil, r) (getSupport (randomFunc_eager (l, a))).  intuition. unfold randomFunc_eager. eapply getSupport_In_Seq. simpl. eapply in_getAllBvectors. rewrite H. unfold setLet. simpl. intuition. Qed.   eapply inSupportRandomFunc_eager_Some. trivial.  inline_first. comp_skip.  comp_simp. eapply H3; intuition. simpl in *. rewrite checkBad_app_cons. simpl. apply orb_true_iff in H5. intuition.  simpl. case_eq (eqbBvector d b); intuition. apply eqbBvector_sound in H5. subst. rewrite arrayLookup_app_some_eq; trivial.  rewrite arrayLookup_app_none; trivial. simpl. rewrite H5. intuition.  simpl in *. case_eq (eqbBvector r r2); intuition. rewrite H8 in H5. apply eqbBvector_sound in H8. subst. rewrite inRange_app_cons. simpl. rewrite eqbBvector_complete. trivial. eapply inRange_app. rewrite H8 in H5. intuition.  eapply inSupportRandomFunc; trivial. simpl. rewrite H2. trivial.  eapply inSupportRandomFunc_eager_None; trivial.   Qed.  Lemma randomFunc_eager_bad_eq : stateful_comp_spec (fun s1 s2 => (checkBad s1 = checkBad s2) /\ (forall r, inRange _ s1 r = inRange _ s2 r)) (fun p1 p2 => True) (fun p1 p2 => True) randomFunc_eager randomFunc_eager.  intuition. unfold stateful_comp_spec, comp_spec. intuition.  unfold randomFunc_eager. comp_simp. inline_first. comp_skip. case_eq (a # b); intuition; case_eq (l # b0); intuition; comp_simp; eapply H2; intuition;  try match goal with | [|- _ = _ ] => simpl in *; repeat rewrite checkBad_app_cons; repeat rewrite inRange_app_cons; simpl; repeat rewrite H3; repeat rewrite H0; intuition | [|- In (?a ++ (?b, ?r) :: nil, ?r) (getSupport (randomFunc_eager (?a, ?b))) ] => eapply inSupportRandomFunc_eager_None; trivial | [|- In (?a ++ (?b, ?r) :: nil, _) (getSupport (randomFunc_eager (?a, ?b))) ] => eapply inSupportRandomFunc_eager_Some; trivial end.  Qed. *)
induction u; intuition; simpl in *.
destruct ls.
econstructor.
specialize (H1 a); simpl in *.
intuition.
inversion H0; clear H0; subst.
destruct (in_dec eqd a ls).
symmetry.
eapply perm_trans.
eapply (removeFirst_permutation eqd).
eauto.
eapply perm_skip.
eapply Permutation_sym.
erewrite filter_eq.
eapply IHu; intuition.
eapply removeFirst_NoDup.
trivial.
specialize (H1 a0).
intuition.
edestruct H1.
eapply removeFirst_in_iff.
eauto.
subst.
exfalso.
eapply removeFirst_NoDup_not_in.
eapply H.
eauto.
trivial.
intuition.
destruct (in_dec eqd a0 ls).
destruct (in_dec eqd a0 (removeFirst eqd ls a)).
trivial.
exfalso.
destruct (eqd a a0); subst.
intuition.
eapply n0.
eapply removeFirst_in; eauto.
destruct (in_dec eqd a0 (removeFirst eqd ls a)).
exfalso.
eapply removeFirst_not_in; eauto.
trivial.
eapply IHu; intuition.
specialize (H1 a0); intuition.
subst.
intuition.
Qed.
intuition.
unfold randomFunc_eager.
wftac.
intuition.
destruct (ls # d); wftac.
Qed.

Lemma randomFunc_eager_preserves_bad : forall ls d ls' r,
In (ls', r) (getSupport (randomFunc_eager (ls, d))) ->
checkBad ls = true ->
checkBad ls' = true.