(** * Software Foundations, Formally
      Benjamin C. Pierce
      Version of 10/3/2007
*)

Require Export lec08_sol.
(* ====================================================================== *)
(* LECTURE 8 *)

(* Wei: note the structure of this lecture allows for using le_transitive to prove this lemma *)
(* The transitivity of [le], in turn, can be used to prove a
   fact ([Sn_not_le_n]) that is needed for the proof of symmetry
   below... *)
Lemma le_S_le : forall n m, S n <= m -> n <= m.
Proof.
  intros n m H. apply le_transitive with (b := S n).
    apply le_S. apply le_n.
    apply H.
Qed.

Lemma Sn_le_Sm__n_le_m : forall n m,
  (S n <= S m) -> (n <= m).
Proof.
  intros n m H. inversion H.
    apply le_n.
    apply le_S_le. apply H1.
Qed.

Lemma Sn_not_le_n : forall n,
  ~ (S n <= n).
Proof.
  induction n.
    Case "O". intros H. inversion H.
    Case "S". intros H. unfold not in IHn. apply IHn.
      apply Sn_le_Sm__n_le_m. apply H.
Qed.

Lemma le_antisymmetric :
  antisymmetric _ le.
Proof.
  (* Proof sketch: Suppose that n <= m and m <= n, and consider the
     constructors used to prove these facts.  If either constructor is
     le_n, the result follows easily.  If both are le_S, then for some
     n0 and m0 we have n = S n0 and m = S m0, with n <= m0 and m <=
     n0.  By transitivity of le, it follows that S m0 <= m0.  But this
     contradicts Sn_not_le_n.

     (Coq hint: If you find yourself stuck at the point where you want
     to use [Sn_not_le_n] to obtain a contradiction because the
     [apply] tactic doesn't work when you think it should, try using
     an [assert] to introduce the specific case of [Sn_not_le_n] that
     you need.) *)
red; inversion 1; intuition.
assert (S m <= m).
  apply le_transitive with (b:= a); trivial.
assert False. apply Sn_not_le_n with (n:=m); trivial.
destruct H4.
Qed.


(* ====================================================================== *)
(* LECTURE 9 *)

(* ---------------------------------------------------------------------- *)
(* Operational semantics *)

(* We've defined a lot of relations on numbers.  Let's now turn our
   attention to something closer to the heart of this course:
   relations on PROGRAMS. *)

Export SimpleArith.
Module SimpleArithEval.

(* We then went on to define several program transformations and show
   that they preserved the meaning of programs as defined by [interp].
   The last of these transformations was a "single-step evaluator" [simplify_step]
   that finds the leftmost [tm_plus] whose immediate children are both
   constants and replaces it by a [tm_const].  

   The same notion of single-step evaluation can be expressed as an
   EVALUATION RELATION on terms: *)

Inductive eval : tm -> tm -> Prop :=
  | E_PlusConstConst : forall n1 n2,
        eval (tm_plus (tm_const n1) (tm_const n2))
             (tm_const (plus n1 n2))
  | E_Plus1 : forall t1 t1' t2,
        (eval t1 t1')
     -> eval (tm_plus t1 t2)
             (tm_plus t1' t2)
  | E_Plus2 : forall n1 t2 t2',
        (eval t2 t2')
     -> eval (tm_plus (tm_const n1) t2)
             (tm_plus (tm_const n1) t2').

(* THOUGHT EXERCISE: What induction principle is generated for
   [eval]? *)

(* Let's verify that this relation matches the behavior of the old
   [simplify_step] function in a few test cases. *)

(* If [t1] can take a step to [t1'], then [tm_plus t1 t2] steps to 
   [plus t1' t2]: *)
Lemma check_eval_2: 
    eval
      (tm_plus 
        (tm_plus (tm_const zero) (tm_const three))
        (tm_plus (tm_const two) (tm_const four)))
      (tm_plus 
        (tm_const (plus zero three))
        (tm_plus (tm_const two) (tm_const four))).
Proof.
  apply E_Plus1. apply E_PlusConstConst.
Qed.

(* Right-hand sides of sums can take a step only when the left-hand
   side is finished: if [t2] can take a step to [t2'], then
   [tm_plus (tm_const n) t2] steps to [tm_plus (tm_const n) t2']: *)
Lemma check_simplify_step_3: 
    eval
      (tm_plus 
        (tm_const zero)
        (tm_plus 
          (tm_const two) 
          (tm_plus (tm_const zero) (tm_const three))))
      (tm_plus 
        (tm_const zero)
          (tm_plus 
            (tm_const two) 
            (tm_const (plus zero three)))).
Proof.
  apply E_Plus2; simpl. apply E_Plus2; simpl. apply E_PlusConstConst with (n1:=zero) (n2:=three).
Qed.  

(* Proofs of simple facts like this -- term [t] takes a step to become
   [t'] -- consist of sequences of applications of the three
   constructors of [eval] that, essentially, construct a data
   structure -- a tree whose single leaf is labeled E_PlusConstConst
   and whose internal nodes are labeled either [E_Plus1] or
   [E_Plus2] -- to serve as evidence for the assertion [eval t t'].

   We use the term "tree" here even though each internal node has
   exactly one child (because the constructors [E_Plus1] and [E_Plus2]
   each take only one argument) so that the same terminology will
   apply to other inductive definitions where constructors take
   multiple arguments.

   These "evidence trees" are commonly called DERIVATIONS. *)

(* One interesting property of the [eval] relation is that it is
   DETERMINISTIC: for each [t], there is at most one [t'] such that
   [eval t t'] is provable.  Formally, this is the same as saying that
   [eval] is a partial function. *)

Theorem eval_deterministic :
  partial_function _ eval.
Proof.
  (* Proof sketch: We must show that if [x] evaluates to both [y1] and
     [y2] then [y1] and [y2] are equal.  Consider the last
     constructors used in the derivations of [eval x y1] and [eval x
     y2].
      - If both are [E_PlusConstConst], the result is immediate.
      - It cannot happen that one is [E_PlusConstConst] and the other
        is [E_Plus1] or [E_Plus2], since this would imply that [x] has
        the form [tm_plus t1 t2] where both [t1] and [t2] are
        constants (by [E_PlusConstConst]) AND one of [t1] or [t2] has
        the form [tm_plus ...].
      - Similarly, it cannot happen that one is [E_Plus1] and the
        other is [E_Plus2], since this would imply that [x] has the
        form [tm_plus t1 t2] where [t1] has both the form [tm_plus t1
        t2] and the form [tm_const n].
      - The cases when both derivations end with [E_Plus1] or [E_Plus2]
        follow by the induction hypothesis. *)
  unfold partial_function. intros x y1 y2 Hy1 Hy2.
  generalize dependent y2.
  induction Hy1.
    Case "E_PlusConstConst". intros y2 Hy2. inversion Hy2.
      Case "E_PlusConstConst". reflexivity.
      Case "E_Plus1". inversion H2.
      Case "E_Plus2". inversion H2.
    Case "E_Plus1". intros y2 Hy2. inversion Hy2.
      Case "E_PlusConstConst".
        rewrite <- H0 in Hy1. inversion Hy1.
      Case "E_Plus1".
        assert (t1' = t1'0) as eq.
          Case "Proof of assertion". apply IHHy1. apply H2.
        rewrite <- eq. reflexivity.
      Case "E_Plus2". rewrite <- H in Hy1. inversion Hy1.
    Case "E_Plus2". intros y2 Hy2. inversion Hy2.
      Case "E_PlusConstConst". rewrite <- H1 in Hy1. inversion Hy1.
      Case "E_Plus1". inversion H2.
      Case "E_Plus2".
        assert (t2' = t2'0) as eq.
          Case "Proof of assertion". apply IHHy1. apply H2.
        rewrite <- eq. reflexivity.
Qed.

End SimpleArithEval.

Module SimpleArithEvalAgain.

(* Before we move on, let's take a moment to slightly generalize the
   way we state the definition of single-step evaluation.  

   It is useful to think of the [eval] relation as defining a sort of
   ABSTRACT MACHINE for evaluating programs:
      - At any moment, the STATE of the machine is a term.
      - A STEP of the machine is an atomic unit of computation -- a
        single "add" operation, in the case of the present tiny
        programming language.  
      - The FINAL STATES of the machine are ones where there is no
        more computation to be done.  

   We can then think about "executing" a term [t] as follows:
      - Take [t] as the starting state of the machine.
      - Repeatedly use the [eval] relation to find a sequence of
        machine states such that each evaluates to the next.
      - When no more evaluation is possible, "read out" the final
        state of the machine as the result of execution.

   Intuitively, it is clear that the final states of the machine are
   always terms of the form [tm_const n] for some [n].  We call such
   terms VALUES. *)

Inductive value : tm -> Prop :=
  v_const : forall n, value (tm_const n).

(* Having introduced the idea of VALUES, we can use it in the
   definition of the [eval] relation to write [E_Plus2] rule in a
   slightly more intuitive way: *)

Inductive eval : tm -> tm -> Prop :=
  | E_PlusConstConst : forall n1 n2,
        eval (tm_plus (tm_const n1) (tm_const n2))
             (tm_const (plus n1 n2))
  | E_Plus1 : forall t1 t1' t2,
        (eval t1 t1')
     -> eval (tm_plus t1 t2)
             (tm_plus t1' t2)
  | E_Plus2 : forall v1 t2 t2',
        (value v1)                        (* <----- *)
     -> (eval t2 t2')
     -> eval (tm_plus v1 t2)
             (tm_plus v1 t2').

(* As a sanity check on this change, let's re-verify the properties we
   proved a few minutes ago... *)

Theorem eval_preserves_interp : forall t t',
     eval t t'
  -> interp t = interp t'.
Proof.
  (* Like the one for the earlier definition of [eval], this proof is
     easy.  Try to do it without peeking. *)
  (* FILL IN HERE (and delete "Admitted") *) Admitted.

Theorem eval_deterministic :
  partial_function _ eval.
Proof.
  (* Most of this proof is the same as the one above.  But to get
     maximum benefit from the exercise you should try to write it from
     scratch and just use the earlier one if you get stuck. *)
  unfold partial_function. intros x y1 y2 Hy1 Hy2.
  generalize dependent y2.
  induction Hy1.
    Case "E_PlusConstConst". intros y2 Hy2. inversion Hy2.
      Case "E_PlusConstConst". reflexivity.
      Case "E_Plus1". inversion H2.
      Case "E_Plus2". (* Wei: find a contradiction by showing const can be reduced *)
      inversion H3.
    Case "E_Plus1". intros y2 Hy2. inversion Hy2.
      Case "E_PlusConstConst".
        rewrite <- H0 in Hy1. inversion Hy1.
      Case "E_Plus1".
        assert (t1' = t1'0) as eq.
          Case "Proof of assertion". apply IHHy1. apply H2.
        rewrite <- eq. reflexivity.
      Case "E_Plus2". (* Wei: we need to manually extract the fact that t1 is const *)
      destruct H1. inversion Hy1.
    Case "E_Plus2". intros y2 Hy2. inversion Hy2. (* Wei *)
      Case "E_PlusConstConst".
      rewrite <- H2 in Hy1. inversion Hy1.
      Case "E_Plus1". destruct H. inversion H3.
      Case "E_Plus2".
        assert (t2' = t2'0) as eq.
          Case "Proof of assertion". apply IHHy1. apply H4.
        rewrite <- eq. reflexivity.
Qed.

End SimpleArithEvalAgain.


(* ---------------------------------------------------------------------- *)
(* Existential quantification *)

(* We saw a couple of lectures ago how a variety of logical
   connectives ([and], [or], etc.) can be encoded in Coq as
   inductively defined propositions.  Here is an inductive definition
   of one more important connective: existential quantification. *)

Inductive ex (X : Type) (P : X -> Prop) : Prop :=
  ex_intro : forall witness:X, P witness -> ex X P.

(* The intuition is that, in order to give evidence for the assertion
   "there is some x for which P holds" we must actually name a WITNESS
   -- a specific value x for which we can give evidence that P
   holds. *)

(* Next we add some convenient notation for the [ex] type.  The
   details of how this works are not important: the critical point is
   that it allows us to write [exists x, P] or [exists x:t, P], just
   as we do with the [forall] quantifier.  *)
Notation "'exists' x , p" := (ex _ (fun x => p))
  (at level 200, x ident, right associativity) : type_scope.
Notation "'exists' x : t , p" := (ex _ (fun x:t => p))
  (at level 200, x ident, right associativity) : type_scope.

(* We can use the same set of tactics to manipulate existentials as we
   have been using all along.  For example, if to prove an
   existential, we [apply] the constructor [ex_intro].  Since the
   premise of [ex_intro] involves a variable ([witness]) that does not
   appear in its conclusion, we need to explicitly give its value when
   we use [apply]. *)
Lemma exists_example_1 : 
  exists n, plus n (times n n) = six.
Proof.
  apply ex_intro with (witness := two).
  reflexivity.
Qed.

(* On the other hand, if we have an existential hypothesis in the
   context, we can eliminate it with [inversion]. *)
Lemma exists_example_2 : forall m,
     (exists n, m = plus four n)
  -> (exists o, m = plus two o).
Proof.
  intros m H.
  inversion H. 
  apply ex_intro with (witness := plus two witness).
  apply H0.
Qed.

(* Wei: The initial question was wrong:
Lemma dist_exists_or : forall (X:Set) (P Q : X -> Prop),
  (exists x, P x /\ Q x) <-> (exists x, P x) \/ (exists x, Q x).

The correct version: *)
Lemma dist_exists_or : forall (X:Set) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
red; intuition.
(* -> *)
destruct H; intuition.
left. apply ex_intro with (witness := witness). trivial.
right. apply ex_intro with (witness := witness). trivial.
(* <- *)
destruct H0; exists witness; intuition.
destruct H0; exists witness; intuition.
Qed.

Lemma dist_not_exists : forall (X:Set) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
red. intros.
inversion H0. apply H1. trivial.
Qed.


(* ---------------------------------------------------------------------- *)
(* Normal forms *)

Module SimpleArithEvalContd.
Export SimpleArithEvalAgain.

Theorem eval_progress : forall t,
  value t \/ (exists t', eval t t').
Proof.
  intros t. induction t.
    Case "tm_const". apply or_introl. apply v_const.
    Case "tm_plus". apply or_intror. destruct t1.
      Case "tm_const". inversion IHt1.
        Case "left". inversion IHt2.
          Case "left". inversion H0.
            exists (tm_const (plus n n0)). apply E_PlusConstConst.
          Case "right".
            inversion H0.
            exists (tm_plus (tm_const n) witness). apply E_Plus2.
            apply H. apply H1.
        Case "right". inversion H. inversion H0.
      Case "tm_plus". inversion IHt1.
        Case "left". inversion H.
        Case "right". inversion H.
          exists (tm_plus witness t2).
          apply E_Plus1. apply H0.
Qed.

(* Wei: exactly the same lemma? *)
Lemma value_or_eval : forall t,
  value t \/ exists t', eval t t'.
Proof.
  induction t.
    Case "tm_const". apply or_introl. apply v_const.
    Case "tm_plus". apply or_intror. inversion IHt1.
      Case "l". inversion IHt2.
        Case "l". inversion H. inversion H0.
          apply ex_intro with (witness := tm_const (plus n n0)).
          apply E_PlusConstConst.
        Case "r". inversion H0.
          apply ex_intro with (witness := tm_plus t1 witness).
          apply E_Plus2. apply H. apply H1.
      Case "r". inversion H.
          apply ex_intro with (witness := tm_plus witness t2).
          apply E_Plus1. apply H0.
Qed.

(* Normal forms *)
Definition normal_form (X:Set) (R:relation X) (t:X) : Prop :=
  ~ exists t', R t t'.

(* We can use this terminology to concisely re-package the observation
   we made in Lemma [value_or_eval]: normal forms and values are the
   same thing. *)
Lemma value_iff_nf : forall t,
  value t <-> normal_form _ eval t.
Proof.
  intros t. unfold iff. apply conj.
    Case "->".
      intros H. unfold normal_form. intros contra. inversion H.
        rewrite <- H0 in contra. inversion contra. inversion H1.
    Case "<-".
      intros H.
      unfold normal_form in H.
      assert (value t \/ exists t', eval t t') as G.
        Case "Proof of assertion". apply value_or_eval.
      inversion G.
        Case "l". apply H0.
        Case "r". unfold not in H. apply H in H0. inversion H0.
Qed.

(* Why is this an interesting fact?  For two reasons:

     - 1. Because [value] is a syntactic concept -- it is a defined by
          looking at the form of a term -- while [normal_form] is a
          semantic one -- it is defined by looking at how the term
          evaluates.  Is it not obvious that these concepts should
          coincide.

     - 2. Indeed, there are lots of languages in which the concepts of
          normal form and value do NOT coincide.

   Let's examine how this can happen. *)

(* We might, for example, accidentally define [value] so that it
   includes some terms that are not finished evaluating. *)

Module Temp1. (* Open an inner module so we can redefine [value] and [eval]. *)

Inductive value : tm -> Prop :=
| v_const : forall n, value (tm_const n)
| v_funny : forall t1 n2, value (tm_plus t1 (tm_const n2)).  (* <---- *)

Inductive eval : tm -> tm -> Prop :=
  | E_PlusConstConst : forall n1 n2,
        eval (tm_plus (tm_const n1) (tm_const n2))
             (tm_const (plus n1 n2))
  | E_Plus1 : forall t1 t1' t2,
        (eval t1 t1')
     -> eval (tm_plus t1 t2)
             (tm_plus t1' t2)
  | E_Plus2 : forall v1 t2 t2',
        (value v1)
     -> (eval t2 t2')
     -> eval (tm_plus v1 t2)
             (tm_plus v1 t2').

Lemma value_not_same_as_normal_form :
  exists t, value t /\ ~ normal_form _ eval t.
Proof.
exists (tm_plus (tm_const zero) (tm_const zero)).
split. constructor.
unfold normal_form. unfold not. intros.
apply H.
exists (tm_const zero). apply E_PlusConstConst with (n1:=zero) (n2:=zero).
Qed.


End Temp1.

(* Alternatively, we might accidentally define [eval] so that it
   permits something designated as a value to evaluate further. *)

Module Temp2.

Inductive value : tm -> Prop :=
| v_const : forall n, value (tm_const n).

Inductive eval : tm -> tm -> Prop :=
  | E_Funny : forall n,                                 (* <---- *)
        eval (tm_const n)
             (tm_plus (tm_const n) (tm_const zero))
  | E_PlusConstConst : forall n1 n2,
        eval (tm_plus (tm_const n1) (tm_const n2))
             (tm_const (plus n1 n2))
  | E_Plus1 : forall t1 t1' t2,
        (eval t1 t1')
     -> eval (tm_plus t1 t2)
             (tm_plus t1' t2)
  | E_Plus2 : forall v1 t2 t2',
        (value v1)
     -> (eval t2 t2')
     -> eval (tm_plus v1 t2)
             (tm_plus v1 t2').

Lemma value_not_same_as_normal_form :
  exists t, value t /\ ~ normal_form _ eval t.
Proof.
exists (tm_const zero).
split. constructor.
unfold normal_form. unfold not. intros.
apply H. exists  (tm_plus (tm_const zero) (tm_const zero)).
apply E_Funny.
Qed.

End Temp2.

(* Finally, we might accidentally define [value] and [eval] so that
   there is some term that is not a value but that cannot take a step
   in the [eval] relation.  Such terms are said to be STUCK. *)

Module Temp3.

Inductive value : tm -> Prop :=
| v_const : forall n, value (tm_const n).

Inductive eval : tm -> tm -> Prop :=
  | E_PlusConstConst : forall n1 n2,
        eval (tm_plus (tm_const n1) (tm_const n2))
             (tm_const (plus n1 n2))
  | E_Plus1 : forall t1 t1' t2,
        (eval t1 t1')
     -> eval (tm_plus t1 t2)
             (tm_plus t1' t2).
                                  (* <---- note that E_Plus2 is missing  *)

Lemma value_not_same_as_normal_form :
  exists t, ~ value t /\ normal_form _ eval t.
Proof.
exists (tm_plus (tm_const zero) (tm_plus (tm_const zero) (tm_const zero))).
split.
red. intros. inversion H.
unfold normal_form. red. intros. destruct H.
inversion H. inversion H3.
Qed.

End Temp3.

End SimpleArithEvalContd.

(* Copy definition of [normal_form] into the top-level environment *)
Notation normal_form := SimpleArithEvalContd.normal_form.