(** * Software Foundations, Formally   
      Benjamin C. Pierce
      Version of 11/5/2007
*)

Require Export lec15_sol.
(* Wei: This lecture overlaps a great deal with lec15 *)

(* ---------------------------------------------------------------------- *)
(* Determinism of single-step evaluation *)

(* Like most of the other evaluation relations we have defined,
   single-step call-by-value evaluation of lambda terms is
   deterministic.  The proof is very similar to ones we have seen
   previously -- so not too interesting in itself -- but we'll need
   the property in several places below so let's record it here. *)

Export LambdaContd'.
Module LambdaContd'.
Export LambdaContd.

Lemma value_subterms_are_values : forall t1 t2, 
     value (t1 @ t2) 
  -> (value t1) /\ (value t2).
Proof.
  intros t1 t2 Hv. 
  apply conj.
    CASE "t1". tm_cases (induction t1) SCASE.
      apply v_const. reflexivity.
      inversion Hv. solve by inversion.
      inversion Hv. inversion H. apply v_const. simpl. 
      destruct (both_yes (only_constants t1_1) (only_constants t1_2)).
        reflexivity.
        solve by inversion.
      apply v_abs.
    CASE "t2". tm_cases (induction t2) SCASE.
      apply v_const. reflexivity.
      inversion Hv. inversion H. 
      destruct (only_constants t1). solve by inversion. solve by inversion.
      inversion Hv. inversion H. apply v_const. simpl. 
      destruct (both_yes (only_constants t2_1) (only_constants t2_2)).
        reflexivity.
        destruct (only_constants t1). solve by inversion. solve by inversion.
      apply v_abs.
Qed.

Lemma values_don't_step : forall t t', 
  value t -> ~ eval t t'.
Proof.
  intros u v Hv1. unfold not.
  generalize dependent v.
  (tm_cases (induction u) CASE); intros v He1.
    CASE "tm_const". inversion He1.
    CASE "tm_var". inversion Hv1; subst. solve by inversion.
    CASE "tm_app". inversion He1; subst.
      inversion Hv1. solve by inversion.
      apply IHu1 in H2. inversion H2. apply value_subterms_are_values in Hv1. 
        destruct Hv1. assumption.
      apply IHu2 in H3. inversion H3. apply value_subterms_are_values in Hv1. 
        destruct Hv1. assumption.
    CASE "tm_abs". solve by inversion.
Qed.

(* Wei: This is the canonical proof approach, compared to my trick in lec15_sol *)
Lemma eval_deterministic : 
  partial_function _ eval.
Proof.
  (* A little trick: Put this in the context so that we can do 
     [unfold] in it. *)
  assert (forall t t', value t -> ~ eval t t') as values_don't_step. 
    apply values_don't_step.
  unfold partial_function.
  intros x y1 y2 Hy1 Hy2.
  generalize dependent y2.
  (eval_cases (induction Hy1) CASE); 
         intros y2 Hy2; 
         (eval_cases (inversion Hy2) SCASE); 
         subst;
         try solve [reflexivity | solve by inversion].
  CASE "E_AppAbs".
    SCASE "E_App2".
      unfold not in values_don't_step. apply values_don't_step in H4. 
        inversion H4. assumption.
  CASE "E_App1".
    SCASE "E_App1".
      apply IHHy1 in H2. subst. reflexivity.
    SCASE "E_App2".
      unfold not in values_don't_step. apply values_don't_step in Hy1. 
      inversion Hy1. assumption.
  CASE "E_App2".            
    SCASE "E_AppAbs".
      unfold not in values_don't_step. apply values_don't_step in Hy1. 
      inversion Hy1. assumption.                
    SCASE "E_App1".
      unfold not in values_don't_step. apply values_don't_step in H3. 
      inversion H3. assumption.                
    SCASE "E_App2".
      apply IHHy1 in H4. subst. reflexivity.
Qed.

(* ---------------------------------------------------------------------- *)
(* Many-step evaluation *)

(* As always, we define multi-step evaluation on top of single-step,
   and then define the concept of "normalizable term" on top of this. *)

Notation evalmany := (refl_trans_closure' _ eval). 
Notation eval_normal_form := (normal_form _ eval).  

Definition normalizable (t : tm) :=
  exists t', evalmany t t' /\  eval_normal_form t'.

(* For working with examples, it is nice to be able to perform complex
   evaluation sequences using the [simplify_steps] (or [-->*])
   relation and its associated [steps] tactic.  The following lemmas
   connect these to multi-step evaluation and normalization. *)

Lemma simplify_steps__evalmany : forall t t',
     simplify_steps t t' 
  -> evalmany t t'.
Proof.
  intros t t' SS. induction SS.
    CASE "ss_refl". apply rtc'_refl.
    CASE "ss_step". 
      assert (eval t t' <-> simplify_step t = Some _ t').
        apply two_variants_of_single_step_evaluation_coincide.
      destruct H0. apply H1 in H.
      apply rtc'_step with (y:=t').
        assumption. assumption.
Qed.

Lemma simplify_steps__normalizable : forall t t',
     simplify_steps t t' 
  -> is_value t' = yes
  -> normalizable t.
Proof.
  intros t t' SS IV.
  unfold normalizable. apply ex_intro with (witness := t'). 
  apply conj.
    CASE "evalmany". apply simplify_steps__evalmany. assumption.
    CASE "nf". unfold normal_form. intros C. 
       apply is_value__value in IV. 
       destruct C.
       assert (value t' -> ~ eval t' witness).
         apply values_don't_step.
       apply H0 in IV. unfold not in IV. apply IV in H. assumption.
Qed.

(* Some examples... *)

Export LambdaExamplesContd'.
Module LambdaExamplesContd'.
(* LATER: I don't think this internal LambdaExamples module is helping
   anything very much!  Try just dropping it, everywhere. *)

Lemma one_pls_zero_normalizable : 
  normalizable (pls @ c_one @ c_zero).
Proof.
  apply simplify_steps__normalizable
    with (t' := \s, \z, c_one @ s @ (c_zero @ s @ z)). 
  steps. reflexivity.
Qed.

Lemma normalizable_example_6 :
  normalizable (c_zero @ poisonpill @ tru).
Proof.
  apply simplify_steps__normalizable with (t' := tru). 
  steps. reflexivity.
Qed.

(* To show that a particular example *is* normalizable, it is enough
   just to give its normal form.  But showing that particular terms
   are *not* normalizable often requires more work.  We can sometimes
   avoid this work by observing that, if a term [t] evaluates to a
   non-normalizable term, then [t] itself is not normalizable. *)

Lemma evalmany_diverge__diverge : forall t t',
     evalmany t t'
  -> ~ normalizable t'
  -> ~ normalizable t.
Proof.
  intros t t' E. induction E.
    CASE "rtc'_refl". 
      intros H. assumption.
    CASE "rtc'_trans". 
      intros Nz C. apply IHE in Nz. unfold normalizable in C. inversion C.
      destruct H0. inversion H0; subst. 
      unfold normal_form in H1. 
      assert (exists t' : tm, eval witness t').
        apply ex_intro with (witness := y). assumption.
      unfold not in H1. apply H1 in H2. assumption.
      assert (partial_function _ eval) as ED.
        apply eval_deterministic.
      assert (y = y0).
        unfold partial_function in ED. apply ED with (x:=x). 
        assumption. assumption.
      subst. 
      assert (normalizable y0).
        unfold normalizable. apply ex_intro with (witness:=witness).
        apply conj. assumption. assumption. 
      unfold not in Nz. apply Nz in H4.        assumption.
Qed.

Lemma normalizable_example_5 :
  ~ normalizable (pls @ c_one @ c_zero @ poisonpill @ tru).
Proof.
  assert (evalmany (pls @ c_one @ c_zero @ poisonpill @ tru) 
                   omega).
    apply simplify_steps__evalmany. steps.
  apply evalmany_diverge__diverge with (t' := omega).
  assumption. apply omega_not_normalizable.
Qed.

(* ---------------------------------------------------------------------- *)
(* Hypothetical evaluation *)

(* Another situation where a little more work is required is when we
   want to reason about the evaluation behavior of a term in which
   some subterm is not a concrete lambda-expression but a meta-level
   variable that stands for some arbitrary lambda-expression.  For
   example, any term of the form [c_one @ t], where [t] is an
   arbitrary value, reduces in one step to [\z, t @ z].  (Note that we
   need the assumption that [t] is a value, since otherwise we would
   not be justified in applying the [E_AppAbs] rule.)  

   This section shows a few typical examples of this sort of
   "hypothetical" reasoning about evaluation. *)

(* To begin, we need a couple of facts about substitution. *)

Lemma not_free__subst_invariant : forall x s t,
     ~ (appears_free_in x t) 
  -> {x|->s}t = t.
Proof.
  intros x s t H. 
  (tm_cases (induction t) CASE); simpl.
    CASE "tm_const". reflexivity.
    CASE "tm_var". unfold not in H. 
      remember (eqname x n) as r. destruct r.
        SCASE "yes". 
          assert (appears_free_in x (!n)).
            assert (x = n).
              apply eqnat_yes. apply eq_symm. assumption.
            subst. apply afi_var.
          apply H in H0. solve by inversion.
        SCASE "no". reflexivity. 
    CASE "tm_app". 
      assert ({x |-> s}t1 = t1). 
        apply IHt1. unfold not. intros C. apply afi_app1 with (t2:=t2) in C.
        unfold not in H. apply H in C. solve by inversion.
      assert ({x |-> s}t2 = t2). 
        apply IHt2. unfold not. intros C. apply afi_app2 with (t1:=t1) in C.
        unfold not in H. apply H in C. solve by inversion.
        rewrite H0. rewrite H1. reflexivity.
    CASE "tm_abs".
      remember (eqname x n) as r. destruct r.
        SCASE "x = n". reflexivity.
        SCASE "x<>n". 
          assert ({x |-> s}t = t). 
            SSCASE "Pf of assertion". apply IHt. unfold not. intros C. 
              apply afi_abs with (y:=n) in C.
              unfold not in H. apply H in C. solve by inversion. 
              apply eq_symm. assumption.
          rewrite H0. reflexivity.
Qed.

Lemma subst_doesn't_change_closed_terms : forall x s t,
     closed t 
  -> {x|->s}t = t.
Proof.
  intros x s t Closed.
  apply not_free__subst_invariant. apply Closed.
Qed.

(* Now here are the examples... *)

Lemma evalmany_example_0 : forall t,
     value t 
  -> evalmany
       (pls @ c_one @ c_zero @ t)
       (\z, c_one @ t @ (c_zero @ t @ z)).
Proof.
  intros t Vt.
  (* We can first do a couple of steps the easy way... *)
  apply rtc'_step with 
    (y := (\n, \s, \z, c_one @ s @ (n @ s @ z)) @ c_zero @ t).
  apply simplify_step__eval. reflexivity.
  apply rtc'_step with 
    (y := (\s, \z, c_one @ s @ (c_zero @ s @ z)) @ t).
  apply simplify_step__eval. reflexivity.
  (* But we have to do this step the hard way *)
  apply rtc'_step 
    with (y := (\z, c_one @ t @ (c_zero @ t @ z))).
  assert ({s|->t} (\z, c_one @ s @ (c_zero @ s @ z))
           = \z, c_one @ t @ (c_zero @ t @ z)) as R.
    reflexivity.
  rewrite <- R.
  apply E_AppAbs. assumption.
  apply rtc'_refl.
Qed.

Lemma evalmany_example_1 : forall t t0,
     value t 
  -> closed t
  -> value t0
  -> evalmany 
       (pls @ c_one @ c_zero @ t @ t0) 
       (t @ t0).
Proof.
  intros t t0 Ct Vt Vt0.

  (* Begin by recording a couple of facts about substitution 
     that are needed multiple times *)
  assert ({z|->t0}t = t) as E.
    apply subst_doesn't_change_closed_terms. assumption.
  assert ({s|->t} (\z, s @ z) = \z, t @ z) as E1.
    reflexivity.
  assert ({z|->t0} z = t0) as E2.
    reflexivity.

  (* Now, we can first do a couple of steps the easy way... *)
  apply rtc'_step with 
    (y := (\n, \s, \z, c_one @ s @ (n @ s @ z)) @ c_zero @ t @ t0).
  apply simplify_step__eval. reflexivity.
  apply rtc'_step with 
    (y := (\s, \z, c_one @ s @ (c_zero @ s @ z)) @ t @ t0).
  apply simplify_step__eval. reflexivity.

  (* But we have to do this step the hard way *)
  apply rtc'_step 
    with (y := (\z, c_one @ t @ (c_zero @ t @ z)) @ t0).
  SCASE "show first step".
  apply E_App1.
  assert ({s|->t} (\z, c_one @ s @ (c_zero @ s @ z))
           = \z, c_one @ t @ (c_zero @ t @ z)) as R.
    reflexivity.
  rewrite <- R.
  apply E_AppAbs. assumption.

  (* This one too *)
  apply rtc'_step with 
    (y := c_one @ t @ (c_zero @ t @ t0)).
  SCASE "show first step".
  assert ({z|->t0} (c_one @ t @ (c_zero @ t @ z))
           = c_one @ t @ (c_zero @ t @ t0)) as R.
    simpl. rewrite E. reflexivity.
  rewrite <- R.
  apply E_AppAbs. assumption.
  
  (* This one too *)
  apply rtc'_step with 
    (y := (\z, t @ z) @ (c_zero @ t @ t0)).
  SCASE "show first step".
  rewrite <- E1.
  apply E_App1. apply E_AppAbs. assumption.
  
  (* This one too *)
  apply rtc'_step with 
    (y := (\z, t @ z) @ ((\z, z) @ t0)).
  SCASE "show first step".
  apply E_App2. apply v_abs.
  apply E_App1.
  assert ({s|->t} (\z, z)
          = (\z, z)) as E3.
    reflexivity.
  rewrite <- E3.
  apply E_AppAbs. assumption.

  (* This one too *)
  apply rtc'_step with 
    (y := (\z, t @ z) @ t0).
  SCASE "show first step".
  apply E_App2. apply v_abs.
  assert ({z|->t0}(z) = t0) as R.
    reflexivity.
  rewrite <- R. apply E_AppAbs. assumption.

  (* This one too *)
  apply rtc'_step with 
    (y := t @ t0).
  SCASE "show first step".
  assert ({z|->t0}(t @ z) = t @ t0) as R.
    simpl. rewrite E. reflexivity.
  rewrite <- R. apply E_AppAbs. 
  assumption.

  (* ... and now we're done! *)
  apply rtc'_refl.
Qed.

(* Here's a simpler one for you to try. *)
Lemma evalmany_example_2 : forall t t0,
     value t 
  -> closed t
  -> value t0
  -> evalmany 
       (c_one @ t @ t0) 
       (t @ t0).
Proof.
  intros.
  apply rtc'_step with (y := (\z, t @ z) @ t0).
    apply E_App1 with (t1' := (\z, t @ z)).
    assert ({s|->t} (\z, s @ z) = \z, t @ z). trivial.
    rewrite <- H2. apply E_AppAbs. trivial.
  apply rtc'_step with (y := (t @ t0)).
    assert ({z|->t0} (t @ z) = t @ t0). simpl. rewrite (subst_doesn't_change_closed_terms z t0 t). trivial. trivial.
    rewrite <- H2. apply E_AppAbs. trivial.
  apply rtc'_refl.
Qed.  

(* And here's an even simpler one that we'll need later. *)
Lemma evalmany_example_3 : forall t,
     value t 
  -> evalmany 
       (c_one @ t) 
       (\z, t @ z).
Proof.
  intros t Vt.
  assert ({s|->t}(\z, s @ z) = \z, t @ z) as E3.
    simpl. reflexivity.
  apply rtc'_step with (y := (\z, t @ z)).
    rewrite <- E3. apply E_AppAbs. assumption.
  apply rtc'_refl.
Qed.

(* ====================================================================== *)
(* Introduction to behavioral equivalence *)

(* We have observed that the evaluation behavior of lambda-terms does
   not always quite reflect our informal intuitions.  For example,

     pls @ c_one @ c_zero 

   does not reduce to

     c_one,

   although they "obviously behave the same".  How can we make this
   precise?

   One way of articulating the intuition in more detail is to say that
   [pls @ c_one @ c_zero] and [c_one] are cannot be distinguished by
   any observing context -- i.e., all the experiments we can perform
   on them yield the same results.  To make this formal, we need to
   say precisely what we mean by "performing an experiment" and
   "observing the result."

   Let's start with the latter...  
*)

(* ---------------------------------------------------------------------- *)
(* Observational equivalence *)

(* How can we "observe" a lambda-term?  

      - We can watch its evaluation step by step and notice the
        sequence of terms in the evaluation sequence.  

        But this is a very "intensional" way of observing a term: it
        allows us to make distinctions that are not possible from
        within the language.  For example, [omega @ tru] and [omega]
        do not "look" the same, but their external behavior is
        identical: no matter what we do with them, they both just
        diverge.  

      - We can wait until the term finishes evaluating and then record
        what final value it reaches (if any).  Again, though, this
        will make distinctions between terms that are not possible
        from within the language -- it is too intensional.  For
        example, [(\x,x) (\y, omega)] and [(\x,x) (\y, omega @ tru)]
        would be distinguished -- and, more to the point, so would
        [pls @ c_one @ c_zero] and [c_one].  We want a notion of
        equivalence that identifies these.

      - The "coarsest" way of observing a lambda-term is simply to
        record whether it reaches a normal form or not -- i.e., to
        collapse all distinctions between normal forms.  From this
        point of view, [(\x,x) (\y, omega)] and [(\x,x) (\y, omega @
        tru)] would be identified with each other and with
        [(\x,x) (\y, omega)] and [(\x,x) (\y, omega @ tru)], since
        they are all normalizable.  On the other hand, these terms
        would all be distinguished from [omega @ tru] and [omega],
        which both diverge.

        This equivalence -- the simplest and least intensional --
        turns out to be the one we want: it represents the simplest
        imaginable notion of "observation" that we can make of a
        term.  

        (Note that it lumps together terms like [\x, tru] and [\x,
        omega], which both normalize but which do not seem
        "behaviorally equivalent."  We will deal with this in a second
        step, defining "behavioral equivalence" as "observational
        equivalence in any context.")
*)

Definition observationally_equivalent (t t' : tm) :=
  normalizable t <-> normalizable t'.

Lemma observational_equivalence_symmetric : forall t1 t2,
     observationally_equivalent t1 t2
  -> observationally_equivalent t2 t1.
Proof.
  unfold observationally_equivalent. unfold iff.
  intros t1 t2 H. apply conj.
    CASE "->". intro N. destruct H. apply H0. assumption.
    CASE "<-". intro N. destruct H. apply H. assumption.
Qed.

(* It can easily be shown that observational equivalence is also
   reflexive and transitive -- i.e., that it is really an
   equivalence. *)

(* Some examples... *)

Lemma observationally_equivalent_example_3 :
  ~ observationally_equivalent
      (pls @ c_one @ c_zero)
      omega.
Proof.
  apply normalizable_and_divergent_not_observationally_equivalent.
  apply one_pls_zero_normalizable.
  apply omega_not_normalizable.
Qed.

Lemma observationally_equivalent_example_4 :
  observationally_equivalent
    (pls @ c_one @ c_zero)
    c_one.
Proof.
  (* Hint: This proof can be pretty short.  You may find one or more
     of the examples and lemmas from earlier in the file useful... *)
  apply normalizable_terms_observationally_equivalent.
  apply one_pls_zero_normalizable.
  exists c_one. split.
  apply rtc'_refl.
  red. intro H. inversion H. inversion H0.
Qed.  

Lemma observationally_equivalent_example_5 :
  observationally_equivalent
    (pls @ c_one @ c_zero)
    c_zero.
Proof.
  (* Hint: This proof should also be short. *)
  apply normalizable_terms_observationally_equivalent.
  apply one_pls_zero_normalizable.
  exists c_zero. split.
  apply rtc'_refl.
  red. intro H. inversion H. inversion H0.
Qed.  
  
(* If we apply them to just a single argument, we still get
   observationally equivalent terms.  (Note the use of hypothetical
   reasoning about evaluation here.) *)
Lemma observationally_equivalent_example_7 : forall t,
     value t 
  -> observationally_equivalent
       (pls @ c_one @ c_zero @ t)
       (c_one @ t).
Proof.
  intros t Vt.
  apply normalizable_terms_observationally_equivalent.
    CASE "(pls @ c_one @ c_zero @ t) normalizable".
      unfold normalizable. red.
      apply ex_intro with (witness := \z, c_one @ t @ (c_zero @ t @ z)).
      apply conj. apply evalmany_example_0. assumption. unfold normal_form.
      intros C. solve by inversion 2.
    CASE "(c_one @ t) normalizable".
      unfold normalizable. red.
      apply ex_intro with (witness := \z, t @ z).
      apply conj. apply evalmany_example_3. assumption. unfold normal_form.
      intros C. solve by inversion 2.
Qed.

(* However, if we apply them to *two* (carefully chosen) arguments, we
   obtain terms that are not observationally equivalent. *)
Lemma observationally_equivalent_example_6 : 
  ~ observationally_equivalent
      (pls @ c_one @ c_zero @ poisonpill @ tru)
      (c_zero @ poisonpill @ tru).
Proof.
  intros C.
  apply observational_equivalence_symmetric in C.
  generalize dependent C.
  apply normalizable_and_divergent_not_observationally_equivalent.
  apply normalizable_example_6.
  apply normalizable_example_5.
Qed.

(* ---------------------------------------------------------------------- *)
(* Behavioral equivalence *)

(* Finally, we can define behavioral equivalence.  The intuition is
   that two terms are behaviorally equivalent if the results of any
   experiment we can make on them (by applying them to arbitrary
   numbers of arguments) are observationally equivalent. *)

Fixpoint apply_list (base : tm) (ts : list tm) {struct ts} : tm :=
  match ts with
  | nil => base
  | t1 :: ts' => apply_list (base@t1) ts'
  end.

Inductive all_closed_values : list tm -> Prop :=
  | acv_nil : 
         all_closed_values (nil _)
(* Wei: t1 is required to be closed, one more constraint than the definition in lec15
   I've proved the properties below without this constraint in lec15 *)
  | acv_cons : forall t1 ts, 
         closed t1 
      -> value t1 
      -> all_closed_values ts 
      -> all_closed_values (t1::ts).

Definition behaviorally_equivalent (t1 t2 : tm) := forall ts,
     all_closed_values ts
  -> observationally_equivalent
       (apply_list t1 ts)
       (apply_list t2 ts).

Lemma behavior_equivalence_reflexive : forall t,
     behaviorally_equivalent t t.
Proof.
  unfold behaviorally_equivalent. unfold observationally_equivalent. unfold iff.
  intros t ts H. apply conj.
    CASE "->". intro N. assumption.
    CASE "<-". intro N. assumption.
Qed.

Lemma behavior_equivalence_transitive : forall t1 t2 t3,
     behaviorally_equivalent t1 t2
  -> behaviorally_equivalent t2 t3
  -> behaviorally_equivalent t1 t3.
Proof.
  unfold behaviorally_equivalent. unfold observationally_equivalent. unfold iff.
  intros t1 t2 t3 H1 H2 ts H0. apply conj.
    CASE "->". intro N. assert (all_closed_values ts) as H0'.  assumption.
      apply H2 in H0. destruct H0. apply H. apply H1 in H0'. destruct H0'. 
      apply H3. assumption.
    CASE "<-". intro N. assert (all_closed_values ts) as H0'.  assumption.
      apply H1 in H0. destruct H0. apply H0. apply H2 in H0'. destruct H0'. 
      apply H4. assumption.
Qed.

Lemma behavior_equivalence_symmetric : forall t1 t2,
     behaviorally_equivalent t1 t2
  -> behaviorally_equivalent t2 t1.
Proof.
  unfold behaviorally_equivalent. unfold observationally_equivalent. unfold iff.
  intros t1 t2 H ts H0. apply conj.
    CASE "->". intro N. apply H in H0. destruct H0. apply H1. assumption.
    CASE "<-". intro N. apply H in H0. destruct H0. apply H0. assumption.
Qed.

Lemma eval_preserves_observational_equivalence : forall t t',
     eval t t'
  -> observationally_equivalent t t'.
Proof.
  (* FILL IN HERE (and delete "Admitted") *) Admitted.

Lemma eval_preserves_behavioral_equivalence : forall t t',
     eval t t'
  -> behaviorally_equivalent t t'.
Proof.
  unfold behaviorally_equivalent. intros t t' He ts Hv.
  apply eval_preserves_observational_equivalence.
  generalize dependent t'. generalize dependent t.
  induction ts; intros t t' He.
  CASE "nil". simpl. assumption.
  CASE "cons". simpl. apply IHts.
    SCASE "all_closed_values". simpl. inversion Hv. assumption.
    SCASE "eval". apply E_App1. assumption.
Qed.

Lemma evalmany_preserves_behavioral_equivalence : forall t1 t', 
  evalmany t1 t' -> behaviorally_equivalent t1 t'.
Proof.
  intros t1 t' He. induction He.
  SCASE "rtc'_refl". 
    apply behavior_equivalence_reflexive.
  SCASE "rtc'_step". 
    apply behavior_equivalence_transitive with (t2:=y).
    apply eval_preserves_behavioral_equivalence. 
      assumption. assumption.
Qed.

Lemma terms_reaching_same_term_are_behaviorally_equivalent : forall t1 t2 t',
     evalmany t1 t'
  -> evalmany t2 t'
  -> behaviorally_equivalent t1 t2.
Proof.
  (* Proof 1 -- using transitivity *)
  intros t1 t2 t' He1 He2.
  apply behavior_equivalence_transitive with (t2:=t').
    CASE "t1 t'". 
      apply evalmany_preserves_behavioral_equivalence. assumption.
    CASE "t' t2". 
      apply behavior_equivalence_symmetric. 
      apply evalmany_preserves_behavioral_equivalence. assumption.
Qed.

(* An alternate proof of the same thing *)
Theorem terms_reaching_same_term_are_behaviorally_equivalent' : forall t1 t2 t',
     evalmany t1 t'
  -> evalmany t2 t'
  -> behaviorally_equivalent t1 t2.
Proof.
  (* Proof 2 -- by induction*)
  intros t1 t2 t' He1 He2.
  induction He1.
    CASE "rtc'_refl". 
      apply behavior_equivalence_symmetric. 
      apply evalmany_preserves_behavioral_equivalence. assumption.
    CASE "rtc'_step". 
      apply behavior_equivalence_transitive with (t2:=y).
      apply eval_preserves_behavioral_equivalence. assumption.
      apply IHHe1. assumption. 
Qed.

(* Now some examples! *)

Lemma tru_closed :
  closed tru.
Proof.
  unfold closed. intros x. intros A. inversion A; subst. 
  inversion H3; subst. 
  inversion H5. 
  apply eqnat_no in H2. unfold not in H2. apply H2 in H1. solve by inversion.
Qed.
Lemma c_zero_closed :
  closed c_zero.
Proof.
  unfold closed. intros x. intros A. inversion A; subst. 
  inversion H3; subst. 
  inversion H5.
  apply eqnat_no in H4. unfold not in H4. apply H4 in H1. solve by inversion.
Qed.

Lemma poisonpill_closed :
  closed poisonpill.
Proof.
  unfold closed. intros x. intros A. inversion A; subst. 
  inversion H3; subst. inversion H1; subst.  
  inversion H6; subst. inversion H4; subst. 
  apply eqnat_no in H5. apply H5. reflexivity.
  inversion H4; subst. 
  apply eqnat_no in H5. apply H5. reflexivity.
  inversion H1; subst.  
  inversion H6; subst. inversion H4; subst. 
  apply eqnat_no in H5. apply H5. reflexivity.
  inversion H4; subst. 
  apply eqnat_no in H5. apply H5. reflexivity.  
Qed.

(* A sanity check *)
Lemma behaviorally_equivalent_example_0 : 
  ~ behaviorally_equivalent 
     (pls @ c_one @ c_zero)
     c_zero.
Proof.
  unfold behaviorally_equivalent. intros C.
  assert (exists ts, 
                all_closed_values ts
            /\ ~ observationally_equivalent
                   (apply_list (pls @ c_one @ c_zero) ts)
                   (apply_list c_zero ts)).
    apply ex_intro with (witness := [poisonpill, tru]).
      CASE "Pf of assertion". apply conj.
        SCASE "all_closed_values".
          apply acv_cons. apply poisonpill_closed. apply v_abs.
          apply acv_cons. apply tru_closed. apply v_abs.
          apply acv_nil.
        SCASE "not obs equiv".
          apply observationally_equivalent_example_6.
    destruct H. destruct H. apply H0. apply C. assumption.
Qed.

Lemma behaviorally_equivalent_example_1 : forall t t0,
     value t 
  -> closed t
  -> value t0
  -> behaviorally_equivalent 
      (pls @ c_one @ c_zero @ t @ t0)
      (c_one @ t @ t0).
Proof.
  intros t t0 Ct Vt Vt0.
  apply terms_reaching_same_term_are_behaviorally_equivalent
    with (t' := t @ t0).
  apply evalmany_example_1; assumption.
  apply evalmany_example_2; assumption.
Qed.

(* Now extend this to the un-applied bare terms that we care about... *)

Lemma behaviorally_equivalent_example_2 : 
  behaviorally_equivalent 
   (pls @ c_one @ c_zero)
   c_one.
Proof.
  unfold behaviorally_equivalent. intros ts A.
  destruct ts.
  apply observationally_equivalent_example_4.
  destruct ts. simpl.
  apply observationally_equivalent_example_7. inversion A. assumption.
  simpl. inversion A; subst. inversion H3; subst. 
  assert (behaviorally_equivalent 
            (pls @ c_one @ c_zero @ t @ t0) 
            (c_one @ t @ t0)) as B.
     apply behaviorally_equivalent_example_1. 
     assumption. assumption. assumption.
  unfold behaviorally_equivalent in B.
  apply B. assumption. 
Qed.

(* ARGH: Is this even provable???  The issue is that, in order to get
   the two things to evaluate the same term, we need to know the nf of
   [t@t0].  Now, this may or may not exist.  If it doesn't, then both
   terms diverge (at different times).  If it does, then both reach
   the same term.  So all seems OK.  BUT! To formalize this argument
   we seem to need a case split on whether [t@t0] has a normal form --
   something that is certainly not decidable! *)
Lemma behaviorally_equivalent_example_1' : forall t t0,
     value t 
  -> closed t
  -> value t0
  -> behaviorally_equivalent 
      (pls @ c_one @ c_one @ t @ t0)
      (c_two @ t @ t0).
Proof.
  intros t t0 Ct Vt Vt0.
  apply terms_reaching_same_term_are_behaviorally_equivalent
    with (t' := t @ (t @ t0)).
  CASE "(pls @ c_one @ c_one @ t @ t0) steps to t'".
    (* Begin by recording a couple of facts about substitution 
       that are needed multiple times *)
    assert ({z|->t0}t = t) as E.
      apply subst_doesn't_change_closed_terms. assumption.
    assert ({s|->t} (\z, s @ z)
             = \z, t @ z) as E1.
      reflexivity.
    (* Now, we can first do a couple of steps the easy way... *)
    apply rtc'_step with 
      (y := (\n, \s, \z, c_one @ s @ (n @ s @ z)) @ c_one @ t @ t0).
    apply simplify_step__eval. reflexivity.
    apply rtc'_step with 
      (y := (\s, \z, c_one @ s @ (c_one @ s @ z)) @ t @ t0).
    apply simplify_step__eval. reflexivity.
    (* But we have to do this step the hard way *)
    apply rtc'_step 
      with (y := (\z, c_one @ t @ (c_one @ t @ z)) @ t0).
    SCASE "show first step".
    apply E_App1.
    assert ({s|->t} (\z, c_one @ s @ (c_one @ s @ z))
             = \z, c_one @ t @ (c_one @ t @ z)) as R.
      reflexivity.
    rewrite <- R.
    apply E_AppAbs. assumption.
    (* This one too *)
    apply rtc'_step with 
      (y := c_one @ t @ (c_one @ t @ t0)).
    SCASE "show first step".
    assert ({z|->t0} (c_one @ t @ (c_one @ t @ z))
             = c_one @ t @ (c_one @ t @ t0)) as R.
      simpl. rewrite E. reflexivity.
    rewrite <- R.
    apply E_AppAbs. assumption.
    (* This one too *)
    apply rtc'_step with 
      (y := (\z, t @ z) @ (c_one @ t @ t0)).
    SCASE "show first step".
    rewrite <- E1.
    apply E_App1. apply E_AppAbs. assumption.
    (* This one too *)
    apply rtc'_step with 
      (y := (\z, t @ z) @ ((\z, t @ z) @ t0)).
    SCASE "show first step".
    apply E_App2. apply v_abs.
    rewrite <- E1.
    apply E_App1. apply E_AppAbs. assumption.
    (* This one too *)
    apply rtc'_step with 
      (y := (\z, t @ z) @ (t @ t0)).
    SCASE "show first step".
    apply E_App2. apply v_abs.
    assert ({z|->t0}(t @ z) = t @ t0) as R.
      simpl. rewrite E. reflexivity.
    rewrite <- R. apply E_AppAbs. assumption.
    (* This one too *)
    apply rtc'_step with 
      (y := t @ (t @ t0)).
    SCASE "show first step".
    assert ({z|->t@t0}(t @ z) = t @ (t @ t0)) as R.
      assert ({z|->t@t0}t = t) as E2.
        apply subst_doesn't_change_closed_terms. assumption.
      simpl. rewrite E2. reflexivity.
    rewrite <- R. apply E_AppAbs. 
Admitted.

End LambdaExamplesContd'.
End LambdaContd'.