(* 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.		*)
(* An oracle machine semantics for computations. *)
Set Implicit Arguments.
Require Export FCF.Comp.
Local Open Scope list_scope.
Local Open Scope comp_scope.
(* A type for keeping track of the state of the evaluation. *)
Inductive comp_state(A : Set) :=
| cs_done : A -> Blist -> comp_state A
| cs_eof : comp_state A
| cs_more : Comp A -> Blist -> comp_state A.
(* a type for returning answers *)
Inductive comp_answer(A : Set) :=
| ca_done : A -> comp_answer A
| ca_eof : comp_answer A.
intuition.
unfold eq_dec in *.
intuition.
destruct a1; destruct a2.
destruct (H a a0); subst.
left.
trivial.
right.
intuition.
inversion H0; clear H0; subst.
intuition.
right; intuition; discriminate.
right; intuition; discriminate.
left.
trivial.
Qed.
(* a functional form of the small-step semantics*)
Fixpoint evalDet_step(A : Set)(c : Comp A)(s : Blist) : comp_state A :=
match c in Comp A return comp_state A with
| Ret pf a => cs_done a s
| Rnd n  =>
match (shiftOut s n) with
| Some (v, s') => cs_more (Ret (@Bvector_eq_dec n) v) s'
| None => (@cs_eof (Bvector n))
end
| Bind c1 c2 =>
match (evalDet_step c1 s) with
| cs_eof _ => (@cs_eof _)
| cs_done b s' => cs_more (c2 b) s'
| cs_more c1' s' => cs_more (Bind c1' c2) s'
end
| Repeat c P =>
cs_more (Bind c (fun a => if (P a) then (Ret (comp_eq_dec c) a) else (Repeat c P))) s
end.
Inductive evalDet_steps(A : Set) : comp_state A -> comp_state A -> Prop :=
| evalDet_steps_refl : forall ans,
evalDet_steps ans ans
| evalDet_steps_step :
forall c s ans ans',
(evalDet_step c s) = ans ->
evalDet_steps ans ans' ->
evalDet_steps (cs_more c s) ans'.
Hint Constructors evalDet_steps : evalDet.
Inductive evalDet(A : Set)(c : Comp A)(s : Blist) : comp_answer A -> Prop :=
| evalDet_done : forall a s',
evalDet_steps (cs_more c s) (cs_done a s') ->
evalDet c s (ca_done a)
| evalDet_eof :
evalDet_steps (cs_more c s) (@cs_eof A) ->
evalDet c s (@ca_eof A).
induction 1; intuition; subst.
econstructor.
trivial.
eapply IHevalDet_steps.
trivial.
Qed.
induction 1; intuition; subst.
Ltac evalDet_tac1 :=
match goal with
| [H : cs_more _ _ = cs_more _ _ |- _ ] => inversion H; clear H; subst
| [|- evalDet_steps ?c ?c ] => econstructor
| [H : evalDet_steps (evalDet_step ?c ?s) _ |- evalDet_steps (cs_more (Bind ?c _) ?s) _ ] => inversion H; clear H; subst
| [H : (evalDet_step ?c ?s) = _ |- evalDet_steps (cs_more (Bind ?c _) ?s) _ ] => econstructor; simpl
| [|- context[match ?x with | cs_done _ _ => _ | cs_eof _ => _ | cs_more _ _ => _ end] ] => case_eq x; intuition
end.
repeat evalDet_tac1.
inversion H0; clear H0; subst.
inversion H1; clear H1; subst.
econstructor.
eauto.
simpl.
rewrite H3.
econstructor.
inversion H1; clear H1; subst.
econstructor.
eauto.
simpl.
rewrite <- H.
eapply IHevalDet_steps.
auto.
trivial.
Qed.
intuition.
eapply evalDet_steps_bind_more_h; eauto.
Qed.
induction 1; intuition; subst.
discriminate.
inversion H1; clear H1; subst.
inversion H0; clear H0; subst.
econstructor. econstructor.
intuition.
destruct (IHevalDet_steps c a s s'); eauto.
destruct H0; intuition.
exists x.
exists x0.
intuition.
symmetry in H.
econstructor.
eapply H.
trivial.
Qed.
intuition.
eapply evalDet_steps_done_inv_h; eauto.
Qed.
induction 1; intuition; subst.
discriminate.
inversion H1; clear H1; subst.
inversion H0; clear H0; subst.
econstructor. econstructor.
intuition.
destruct (IHevalDet_steps c s); eauto.
destruct H0; intuition.
exists x.
exists x0.
intuition.
econstructor.
rewrite <- H.
eauto.
rewrite <- H.
trivial.
Qed.
intuition.
eapply evalDet_steps_eof_inv_h; eauto.
Qed.
intuition.
apply evalDet_steps_done_inv in H.
destruct H.
destruct H.
intuition.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_more.
eauto.
econstructor.
simpl.
rewrite H1.
eauto.
econstructor.
Qed.
intuition.
apply evalDet_steps_eof_inv in H.
destruct H.
destruct H.
intuition.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_more.
eauto.
econstructor.
simpl.
rewrite H1.
eauto.
econstructor.
Qed.
Inductive comp_state_eq(A : Set) : comp_state A -> comp_state A -> Prop :=
| cse_done :
forall a s,
comp_state_eq (cs_done a s) (cs_done a s)
| cse_eof :
comp_state_eq (@cs_eof A) (@cs_eof A)
| cse_more :
forall c1 c2 s,
Comp_eq c1 c2 ->
comp_state_eq (cs_more c1 s) (cs_more c2 s).
destruct c; intuition;
econstructor.
eapply Comp_eq_refl.
Qed.
induction 1; intros; subst.
inversion H0; clear H0; subst.
intuition.
inversion H2; clear H2; subst.
eapply IHevalDet_steps;
trivial.
Qed.
intros.
eapply evalDet_steps_done_func_h.
eapply H.
eauto.
eauto.
Qed.
induction 1; intros; subst.
inversion H0.
inversion H2; clear H2; subst.
eapply IHevalDet_steps;
trivial.
Qed.
intros.
eapply evalDet_steps_done_eof_func_h.
eapply H.
eauto.
eauto.
Qed.
intuition.
inversion H; subst; clear H.
inversion H0; subst; clear H0.
f_equal.
eapply evalDet_steps_done_func; eauto.
exfalso.
eapply evalDet_steps_done_eof_func; eauto.
inversion H0; clear H0; subst.
exfalso.
eapply evalDet_steps_done_eof_func; eauto.
trivial.
Qed.
Definition evalDet_equiv(A : Set)(c1 c2 : Comp A) :=
(forall s y, evalDet c1 s y <-> evalDet c2 s y).
unfold evalDet_equiv. intuition.
eapply H; trivial.
eapply H; trivial.
Qed.
induction 1; intuition; subst.
discriminate.
inversion H1; clear H1; subst.
inversion H0; clear H0; subst.
case_eq (evalDet_step c1 s0); intuition;
rewrite H in H2; discriminate.
case_eq (evalDet_step c1 s0); intuition;
rewrite H0 in H.
inversion H; clear H; subst.
econstructor. econstructor. intuition.
econstructor.
eapply H0.
econstructor.
econstructor; eauto.
discriminate.
inversion H; clear H; subst.
edestruct IHevalDet_steps.
simpl.
rewrite H0.
eauto.
eauto.
destruct H.
intuition.
econstructor. econstructor. intuition.
econstructor.
eapply H0.
eauto.
trivial.
Qed.
intuition.
eapply evalDet_steps_bind_done_inv_h; eauto.
Qed.
induction 1; intuition; subst.
discriminate.
inversion H1; clear H1; subst.
inversion H0; clear H0; subst.
case_eq (evalDet_step c1 s0); intuition;
rewrite H in H2.
discriminate.
left.
econstructor.
rewrite H.
eauto.
econstructor.
discriminate.
case_eq (evalDet_step c1 s0); intuition;
rewrite H0 in H.
inversion H; clear H; subst.
right.
econstructor. econstructor. intuition.
econstructor.
eauto.
econstructor.
econstructor.
eauto.
trivial.
discriminate.
inversion H; clear H; subst.
edestruct (IHevalDet_steps).
simpl.
rewrite H0.
eauto.
trivial.
left.
econstructor; eauto.
destruct H. destruct H. intuition.
right.
econstructor. econstructor. intuition.
econstructor; eauto.
trivial.
Qed.
intuition.
eapply evalDet_steps_bind_eof_inv_h; eauto.
Qed.
intuition.
unfold evalDet_equiv.
intuition.
inversion H; clear H; subst.
Ltac evalDet_tac :=
match goal with
| [H1 : evalDet_steps ?x (cs_done ?a1 ?s1), H2 : evalDet_steps ?x (@cs_eof _) |- _ ] => exfalso; eauto using evalDet_steps_done_eof_func; intuition
| [H : evalDet_steps (cs_more (Bind _ _) _) (cs_done _ _) |- _ ] => apply evalDet_steps_bind_done_inv in H
| [H : evalDet_steps (cs_more (Bind _ _) _) (@cs_eof _) |- _ ] => apply evalDet_steps_bind_eof_inv in H; intuition
| [H : exists _ : _, _ |- _ ] => destruct H; intuition
| [H1 : evalDet_steps ?x (cs_done ?a1 ?s1), H2 : evalDet_steps ?x (cs_done ?a2 ?s2) |- _ ] => assert (a1 = a2 /\ s1 = s2); eauto using evalDet_steps_done_func; intuition; subst; clear H1; eauto
end.
repeat evalDet_tac.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done; eauto.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done; eauto.
eauto.
repeat evalDet_tac.
econstructor.
eapply evalDet_bind_eof; eauto.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done; eauto.
eapply evalDet_bind_eof; eauto.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done; eauto.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done; eauto.
eauto.
inversion H; clear H; subst.
repeat evalDet_tac.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done; eauto.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done; eauto.
eauto.
eauto.
repeat evalDet_tac.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_bind_eof; eauto.
eapply evalDet_bind_eof; eauto.
econstructor.
econstructor.
eapply evalDet_bind_eof.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done; eauto.
eauto.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done; eauto.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done; eauto.
eauto.
eauto.
Qed.
intuition.
inversion H; clear H; subst.
inversion H0; clear H0; subst.
eapply evalDet_steps_done_eof_func; eauto.
Qed.
induction c; intuition; simpl in *.
inversion H; clear H; subst.
intuition.
destruct (evalDet_step c s); try discriminate.
eapply in_getAllBvectors.
discriminate.
Qed.
induction c; intuition; simpl in *.
discriminate.
case_eq (evalDet_step c s); intuition;
rewrite H2 in H0.
inversion H0; clear H0; subst.
eapply in_getUnique.
eapply in_flatten.
exists (getSupport (c0 b)).
intuition.
eapply in_map_iff.
exists b.
intuition.
eapply getSupport_In_evalDet_step_done; eauto.
discriminate.
inversion H0; clear H0; subst.
simpl in *.
apply in_getUnique_if in H1.
apply in_flatten in H1.
destruct H1; intuition.
eapply in_getUnique.
eapply in_flatten.
exists x.
intuition.
apply in_map_iff in H1.
destruct H1; intuition.
subst.
eapply in_map_iff.
exists x0.
intuition.
eapply IHc; eauto.
eapply in_getAllBvectors.
inversion H; clear H; subst.
simpl in *.
eapply in_getUnique_if in H0.
eapply in_flatten in H0.
destruct H0.
intuition.
eapply in_map_iff in H0.
destruct H0.
intuition.
subst.
case_eq (b x0); intuition;
rewrite H in H1; simpl in *.
intuition; subst.
eapply filter_In; eauto.
trivial.
Qed.
induction 1; intuition; subst.
discriminate.
inversion H1; clear H1; subst.
inversion H0; clear H0; subst.
eapply getSupport_In_evalDet_step_done; eauto.
eapply getSupport_In_evalDet_step_more.
eauto.
eapply IHevalDet_steps.
eauto.
eauto.
Qed.
intuition.
eapply getSupport_In_evalDet_steps_h; eauto.
Qed.
intuition.
inversion H; clear H; subst.
eapply getSupport_In_evalDet_steps; eauto.
Qed.
(* The following predicate makes it easier for us to do induction on the number of loop iterations. *)
Inductive evalDet_repeat_steps (A : Set)(P : A -> bool) : comp_state A -> comp_state A -> Prop :=
| evalDet_repeat_steps_done :
forall c s a s',
evalDet_steps (cs_more c s) (cs_done a s') ->
P a = true ->
evalDet_repeat_steps P (cs_more c s) (cs_done a s')
| evalDet_repeat_steps_eof :
forall c s,
evalDet_steps (cs_more c s) (@cs_eof A) ->
evalDet_repeat_steps P (cs_more c s) (@cs_eof A)
| evalDet_repeat_steps_step :
forall c s a s' y,
evalDet_steps (cs_more c s) (cs_done a s') ->
P a = false ->
evalDet_repeat_steps P (cs_more c s') y ->
evalDet_repeat_steps P (cs_more c s) y.
Inductive evalDet_repeat(A : Set)(P : A -> bool)(c : Comp A)(s : Blist) : comp_answer A -> Prop :=
| evalDet_repeat_done : forall a s',
evalDet_repeat_steps P (cs_more c s) (cs_done a s') ->
evalDet_repeat P c s (ca_done a)
| evalDet_repeat_eof :
evalDet_repeat_steps P (cs_more c s) (@cs_eof A) ->
evalDet_repeat P c s (@ca_eof A).
induction l;
intuition; simpl in *.
destruct n; simpl in *; trivial.
destruct n; simpl in *.
eapply H0.
intuition.
destruct n; try omega; simpl in *.
eapply IHl; intuition.
eapply IHl; intuition.
Qed.
intuition.
assert (l = skipn 0 l).
simpl.
trivial.
rewrite H1.
eapply list_skipn_strong_ind_h; trivial.
Qed.
induction c; intuition; simpl in *; intuition; subst.
inversion H; clear H; subst.
trivial.
destruct (evalDet_step c nil); discriminate.
destruct n; try discriminate.
discriminate.
Qed.
induction c; intuition; simpl in *.
inversion H; clear H; subst.
trivial.
case_eq (evalDet_step c nil); intuition;
rewrite H1 in H0;
discriminate.
destruct n;
discriminate.
discriminate.
Qed.
induction c; intuition; simpl in *.
discriminate.
case_eq (evalDet_step c nil); intuition;
rewrite H1 in H0.
inversion H0; clear H0; subst.
eapply evalDet_step_done_nil_inv; eauto.
discriminate.
inversion H0; clear H0; subst.
eauto.
destruct n.
inversion H; clear H; subst.
trivial.
discriminate.
inversion H; clear H; subst.
trivial.
Qed.
induction c; intuition; simpl in *.
inversion H; clear H; subst.
trivial.
destruct (evalDet_step c s); discriminate.
destruct (shiftOut s n).
destruct p.
discriminate.
discriminate.
discriminate.
Qed.
induction ls; intuition; simpl in *.
inversion H; clear H; subst.
destruct (in_dec eqd a (getUnique ls eqd)).
exfalso.
apply H2.
eapply in_getUnique_if.
eauto.
f_equal.
eauto.
Qed.
induction 1; intuition; simpl in *.
destruct (in_dec eqd1 x (getUnique l eqd1)).
destruct (in_dec eqd2 x (getUnique l' eqd2)).
eauto.
exfalso.
eapply n.
eapply Permutation_in; eauto.
destruct (in_dec eqd2 x (getUnique l' eqd2)).
exfalso.
eapply n.
eapply Permutation_in.
eapply Permutation_sym.
eauto.
eauto.
eapply perm_skip.
trivial.
destruct (in_dec eqd1 x (getUnique l eqd1)).
destruct (in_dec eqd1 y (getUnique l eqd1)).
destruct (in_dec eqd2 y (getUnique l eqd2)).
destruct (in_dec eqd2 x (getUnique l eqd2)).
eapply NoDup_Permutation; eauto using getUnique_NoDup; intuition;
eauto using in_getUnique, in_getUnique_if.
exfalso.
eauto using in_getUnique, in_getUnique_if.
exfalso.
eauto using in_getUnique, in_getUnique_if.
destruct (in_dec eqd2 y (getUnique l eqd2)).
exfalso.
eauto using in_getUnique, in_getUnique_if.
destruct (in_dec eqd2 x (y :: getUnique l eqd2)).
eapply perm_skip.
eapply NoDup_Permutation; eauto using getUnique_NoDup; intuition;
eauto using in_getUnique, in_getUnique_if.
simpl in *. intuition.
exfalso.
eauto using in_getUnique, in_getUnique_if.
destruct (in_dec eqd1 y (x :: getUnique l eqd1)).
destruct (in_dec eqd2 y (getUnique l eqd2)).
destruct (in_dec eqd2 x (getUnique l eqd2)).
exfalso.
eauto using in_getUnique, in_getUnique_if.
eapply perm_skip.
eapply NoDup_Permutation; eauto using getUnique_NoDup; intuition;
eauto using in_getUnique, in_getUnique_if.
destruct (in_dec eqd2 x (y :: getUnique l eqd2)).
simpl in *; intuition.
clear H.
subst.
eapply perm_skip.
eapply NoDup_Permutation; eauto using getUnique_NoDup; intuition;
eauto using in_getUnique, in_getUnique_if.
subst.
exfalso.
eauto using in_getUnique, in_getUnique_if.
subst.
exfalso.
eauto using in_getUnique, in_getUnique_if.
exfalso.
eauto using in_getUnique, in_getUnique_if.
simpl in *; intuition; subst.
intuition.
exfalso.
eauto using in_getUnique, in_getUnique_if.
destruct (in_dec eqd2 y (getUnique l eqd2)).
destruct (in_dec eqd2 x (getUnique l eqd2)).
exfalso.
eauto using in_getUnique, in_getUnique_if.
simpl in n0; intuition.
exfalso.
eauto using in_getUnique, in_getUnique_if.
destruct (in_dec eqd2 x (y :: getUnique l eqd2)).
simpl in *; intuition; subst.
intuition.
exfalso.
eauto using in_getUnique, in_getUnique_if.
eapply perm_trans.
eapply perm_swap.
eapply perm_skip.
eapply perm_skip.
eapply NoDup_Permutation; eauto using getUnique_NoDup; intuition;
eauto using in_getUnique, in_getUnique_if.
eapply perm_trans.
eapply IHPermutation1.
eapply (@perm_trans _ _ (getUnique l' eqd1)).
eapply NoDup_Permutation; eauto using getUnique_NoDup; intuition;
eauto using in_getUnique, in_getUnique_if.
trivial.
Qed.
induction 1; intuition; simpl in *.
eapply Permutation_app.
eapply Permutation_refl.
trivial.
repeat rewrite app_assoc.
eapply Permutation_app.
eapply Permutation_app_comm.
eapply Permutation_refl.
eapply perm_trans.
eapply IHPermutation1.
trivial.
Qed.
intuition.
destruct v; simpl in *.
trivial.
unfold Vector.to_list in *.
discriminate.
Qed.
induction ls2; simpl in *; intuition;
subst;
simpl in *;
rewrite app_length in H0;
omega.
Qed.
intuition.
eapply to_list_nil_inv.
eapply app_second_eq.
eapply shiftOut_correct_inv.
eauto.
trivial.
Qed.
induction 1; intuition; simpl in *.
destruct (P x).
eapply perm_skip.
trivial.
trivial.
destruct (P x).
destruct (P y).
eapply perm_swap.
eapply Permutation_refl.
destruct (P y).
eapply Permutation_refl.
eapply Permutation_refl.
eapply perm_trans;
eauto.
Qed.
induction c; intuition; simpl in *; try discriminate.
subst.
case_eq (evalDet_step c s); intuition;
rewrite H1 in H0.
inversion H0; clear H0; subst.
erewrite evalDet_step_done_support_singleton; eauto.
simpl.
rewrite app_nil_r.
rewrite getUnique_NoDup_eq.
eapply Permutation_refl.
eapply getSupport_NoDup.
discriminate.
inversion H0; clear H0; subst.
simpl.
eapply getUnique_Permutation.
eapply flatten_Permutation.
eapply Permutation_map.
eauto.
case_eq (shiftOut s n); intuition;
rewrite H0 in H.
destruct p.
inversion H; clear H; subst.
assert (n = O).
eapply shiftOut_same_inv; eauto.
subst.
simpl.
rewrite shiftOut_0 in H0.
inversion H0; clear H0; subst.
eapply Permutation_refl.
discriminate.
inversion H; clear H; subst.
simpl.
eapply NoDup_Permutation.
eapply filter_NoDup.
eapply getSupport_NoDup.
eapply getUnique_NoDup.
intuition.
eapply in_getUnique.
eapply in_flatten.
econstructor.
split.
eapply in_map_iff.
econstructor.
split.
2:{
eapply filter_In; eauto.
}
assert (b x = true).
eapply filter_In; eauto.
rewrite H0.
eauto.
simpl.
intuition.
apply in_getUnique_if in H.
eapply in_flatten in H.
destruct H.
intuition.
eapply in_map_iff in H0.
destruct H0.
intuition.
subst.
case_eq (b x1); intuition;
rewrite H in H1.
simpl in *.
intuition; subst.
eapply filter_In; eauto.
simpl in *.
trivial.
Qed.
induction 1; intuition; simpl in *; subst.
discriminate.
inversion H1; clear H1; subst.
inversion H0; clear H0; subst.
eapply evalDet_step_nil_inv; eauto.
symmetry in H.
specialize (evalDet_step_more_nil_inv _ H); intuition.
subst.
eapply IHevalDet_steps.
eauto.
eauto.
eapply Permutation_in.
eapply evalDet_step_more_support_preserved.
eauto.
trivial.
Qed.
intuition.
eapply evalDet_steps_nil_eq_h; eauto.
Qed.
induction c; intuition; simpl in *.
intuition; subst.
inversion H; clear H; subst.
trivial.
destruct (evalDet_step c s1); discriminate.
destruct (shiftOut s1 n); [ destruct p ; discriminate | discriminate ].
discriminate.
Qed.
induction c; intuition; simpl in *.
inversion H; clear H; subst.
trivial.
destruct (evalDet_step c s1); discriminate.
destruct (shiftOut s1 n); [ destruct p ; discriminate | discriminate ].
discriminate.
Qed.

Lemma shiftOut_skipn : forall n (v : Bvector n) s s',
shiftOut s n = Some (v, s') ->
s' = skipn n s.