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

Lemma evalDet_steps_eof_inv : forall (A : Set)(c : Comp A) s,
evalDet_steps (cs_more c s) (@cs_eof A) ->
exists c'' s'', evalDet_steps (cs_more c s) (cs_more c'' s'') /\ evalDet_step c'' s'' = (@cs_eof A).