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

Theorem evalDet_steps_bind_done_inv : forall (A B : Set)(c1 : Comp B)(c2 : B -> Comp A) s s' a,
evalDet_steps (cs_more (Bind c1 c2) s) (cs_done a s') ->
exists b s'', evalDet_steps (cs_more c1 s) (cs_done b s'') /\
evalDet_steps (cs_more (c2 b) s'') (cs_done a s').