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

   Before handing in this file with your homework solutions, please
   fill in the names of all members of your group:
     

   Also, please tell us roughly how many person-hours you spent on
   this assignment (i.e., if you worked in a group, give us the SUM of
   the number of hours spent by each person individually).
     

*)

Require Export lec11. 

(* ====================================================================== *)
(* LECTURE 12 *)

(* Where we've been...

       - Functional programming
         -- inductive definitions of datatypes
         -- Fixpoints over inductive datatypes
         -- higher-order functions (map, fold, filter, etc.)
         -- polymorphism 
         -- dependent types

       - Logic
         -- inductive definitions of propositions and relations
         -- logical connectives as inductive propositions
         -- inductive proof techniques (induction principles, generalizing
            induction hypotheses, etc.
         -- the Curry-Howard isomorphism between proofs and programs

       - Coq
         -- fundamental tactics
         -- basic automation

       - Operational semantics
         -- programming language syntax as an inductive datatype
         -- single- and multi-step evaluation relations
         -- determinism, progress, normalization


  Where we're going...
  
       - Types
           -- typing relations
           -- type safety (progress and preservation theorems)

       - The lambda-calculus
           -- untyped lambda-calculus: the ur-functional programming language
           -- formalizing bound variables and substitution
           -- function types

       - Object-oriented features
           -- Record types
           -- Subtyping

       - Major case study: Featherweight Java


  Fundamental themes of the course (i.e., What's it all good for?)...

       - Logic: The mathematical basis for ALL of computer science

                     logic                        calculus
              --------------------   =   ----------------------------
              software engineering       mechanical/civil engineering

           -- In particular, inductively defined sets and relations
              and inductive proofs about them are ubiquitous in
              computer science

       - Coq: An industrial-strength proof assistant

           -- Proof assistants are becoming more and more popular in
              both software and (especially) hardware industries.  Coq
              is not the only one in widespread use, but learning one
              thoroughly will give you a big advantage in coming to
              grips with another.

       - Functional programming: An increasingly important part of
         the software developer's bag of tricks

           -- Advanced programming idioms in mainstream software
              development methodologies are increasingly incorporating
              ideas from functional programming.

           -- In particular, using persistent data structures and
              avoiding mutable state enormously simplifies many
              concurrent programming tasks.

       - Foundations of programming languages (the second part of the
         course):

            -- Notations and techniques for rigorously describing and
               stress-testing new programming languages and language
               features.  (This is a surprisingly common activity!
               Most large software systems include subsystems that are
               basically programming languages -- think regular
               expressions, command-line formats, preference and
               configuration files, SQL, Flash, PDF, etc., etc.)

            -- A more sophisticated understanding of the everyday
               tools used to build software... what's going on under
               the hood of <your favorite programming language>.
*)


(* --------------------------------------------------------------------- *)
(* A single-step evaluation FUNCTION *)

(* One last thing to look at in our small language of booleans and
   numbers... *)

Module FullArithContd.
Export FullArith.

(* We saw in lecture 5 how to define a function that behaves as a
   single-step evaluator for the trivial programming language we were
   using in that lecture.  Here is the analogous function for our
   current language... *)

Fixpoint is_nvalue (t:tm) {struct t} : yesno :=
  match t with
  | tm_zero => yes
  | tm_succ t1 => is_nvalue t1
  | _ => no
  end.

Fixpoint simplify_step (t:tm) {struct t} : option tm :=
  match t with
  | tm_if t1 t2 t3 =>
    match simplify_step t1 with
    | None => match t1 with
              | tm_true => Some _ t2
              | tm_false => Some _ t3
              | _ => None _
              end
    | Some t1' => Some _ (tm_if t1' t2 t3)
    end
  | tm_succ t1 =>
      match simplify_step t1 with
      | None => None _
      | Some t1' => Some _ (tm_succ t1')
      end
  | tm_pred t1 =>
      match simplify_step t1 with
      | None => match t1 with
                | tm_zero => Some _ tm_zero
                | tm_succ t2 => if (is_nvalue t2) then Some _ t2 else None _
                | _ => None _
                end
      | Some t1' => Some _ (tm_pred t1')
      end
  | tm_iszero t1 =>
      match simplify_step t1 with
      | None => match t1 with
                | tm_zero => Some _ tm_true
                | tm_succ t2 => if (is_nvalue t2) then Some _ tm_false else None _
                | _ => None _
                end
      | Some t1' => Some _ (tm_iszero t1')
      end
  | _ => None _
  end.

(* This function is a little complicated, but its logic closely
   mirrors the rules of the evaluation relation -- things are just a
   little reorganized because, in the evaluation relation, the
   preconditions for each rule are listed all at once, while the
   evaluation function performs several nested tests (by pattern
   matching) one after another.

   We can make this correspondence precise by PROVING that we've
   defined the single-step function correctly, i.e., that it computes
   exactly the same partial function as the evaluation relation --
   Theorem [two_variants_of_single_step_evaluation_coincide]
   below.  (Thanks to Luke Zarko for help with this proof.) *)

Lemma is_nvalue__nvalue : forall t,
  is_nvalue t = yes -> nvalue t.
Proof.
  induction t; try solve [intros H; solve by inversion | reflexivity].
  intros H. apply nv_zero.
  intros H. apply nv_succ. apply IHt. inversion H. reflexivity.
Qed.

Lemma nvalue__is_nvalue : forall t,
  nvalue t -> is_nvalue t = yes.
Proof.
  intros t H. induction H.
  reflexivity. simpl. assumption.
Qed.

Lemma nvalues_do_not_step : forall t,
  nvalue t -> simplify_step t = None _.
  intros t H. induction H; try solve [intros H; solve by inversion | reflexivity].
  simpl. rewrite -> IHnvalue. reflexivity.
Qed.

Theorem two_variants_of_single_step_evaluation_coincide : forall t t',
  eval t t' <-> simplify_step t = Some _ t'.
Proof.
  unfold iff. intros t t'. apply conj.
  CASE "->".
    intros H.
    (eval_cases (induction H) (SUBCASE)); try solve [simpl; reflexivity].
    SUBCASE "E_If".
      simpl. rewrite -> IHeval.
      destruct t1; try solve [solve by inversion | reflexivity].
    SUBCASE "E_Succ".
      simpl. rewrite -> IHeval. reflexivity.
    SUBCASE "E_PredSucc".
      apply nvalue__is_nvalue in H.
      simpl. rewrite -> H. apply is_nvalue__nvalue in H.
      apply nvalues_do_not_step in H. rewrite -> H. reflexivity.
      simpl. rewrite -> IHeval. reflexivity.
    SUBCASE "E_IszeroSucc".
      apply nvalue__is_nvalue in H.
      simpl. rewrite -> H. apply is_nvalue__nvalue in H.
      apply nvalues_do_not_step in H. rewrite -> H. reflexivity.
      simpl. rewrite -> IHeval. reflexivity.
  CASE "<-".
    generalize dependent t'.
    induction t; intros t' H; try solve [solve by inversion].
    SUBCASE "tm_if".
      inversion H.
      destruct (simplify_step t1).
        inversion H1. apply E_If. apply IHt1. reflexivity.
        destruct t1; try solve [solve by inversion].
          inversion H. apply E_IfTrue.
          inversion H. apply E_IfFalse.
    SUBCASE "tm_succ".
      inversion H.
      destruct (simplify_step t).
        inversion H1. apply E_Succ. apply IHt. reflexivity.
        inversion H1.
    SUBCASE "tm_pred".
      inversion H.
      destruct (simplify_step t).
        inversion H1. apply E_Pred. apply IHt. reflexivity.
        destruct t; try solve [solve by inversion].
          inversion H1. apply E_PredZero.
          assert (is_nvalue t = yes).
            destruct (is_nvalue t).
            reflexivity. solve by inversion.
          rewrite -> H0 in H1.
          inversion H1. subst.
          apply E_PredSucc. apply is_nvalue__nvalue in H0.
          apply H0.
    SUBCASE "tm_iszero".
      inversion H.
      destruct (simplify_step t).
        inversion H1. apply E_Iszero. apply IHt. reflexivity.
        destruct t; try solve [solve by inversion].
          inversion H1. apply E_IszeroZero.
          assert (is_nvalue t = yes).
            destruct (is_nvalue t).
            reflexivity. solve by inversion.
          rewrite -> H0 in H1.
          inversion H1. subst.
          apply E_IszeroSucc. apply is_nvalue__nvalue in H0.
          apply H0.
Qed.

End FullArithContd.

(* --------------------------------------------------------------------- *)
(* Types *)

Module FullArithTypes.
Export FullArith.

Inductive ty : Set := 
  | ty_bool : ty
  | ty_nat : ty.

Inductive has_type : tm -> ty -> Prop :=
  | T_True : 
         has_type tm_true ty_bool
  | T_False : 
         has_type tm_false ty_bool
  | T_If : forall t1 t2 t3 T,
         has_type t1 ty_bool
      -> has_type t2 T
      -> has_type t3 T
      -> has_type (tm_if t1 t2 t3) T
  | T_Zero : 
         has_type tm_zero ty_nat
  | T_Succ : forall t1,
         has_type t1 ty_nat
      -> has_type (tm_succ t1) ty_nat
  | T_Pred : forall t1,
         has_type t1 ty_nat
      -> has_type (tm_pred t1) ty_nat
  | T_Iszero : forall t1,
         has_type t1 ty_nat
      -> has_type (tm_iszero t1) ty_bool.

Tactic Notation "has_type_cases" tactic(first) tactic(c) :=
  first;
  [ c "T_True" | c "T_False" | c "T_If" | c "T_Zero" | c "T_Succ" 
  | c "T_Pred" | c "T_Iszero" ].

Theorem progress : forall t T,
     has_type t T
  -> value t \/ exists t', eval t t'.
Proof.
  intros t T HT.
  has_type_cases (induction HT) (CASE).
    CASE "T_True". 
      apply or_introl. unfold value. apply or_introl. apply bv_true.
    CASE "T_False". 
      apply or_introl. unfold value. apply or_introl. apply bv_false.
    CASE "T_If". 
      apply or_intror. 
      destruct IHHT1. 
        SUBCASE "t1 is a value". destruct H. 
          SSUBCASE "t1 is a bvalue". destruct H.
            SSSUBCASE "t1 is tm_true". 
              apply ex_intro with (witness := t2). apply E_IfTrue.
            SSSUBCASE "t1 is tm_false". 
              apply ex_intro with (witness := t3). apply E_IfFalse.
          SSUBCASE "t1 is an nvalue". solve by inversion 2.
        SUBCASE "t1 can take a step". 
          destruct H. 
          apply ex_intro with (witness := tm_if witness t2 t3).
          apply E_If. assumption.
    (* SOLUTION *)
    CASE "T_Zero". 
      apply or_introl. unfold value. apply or_intror. apply nv_zero.
    CASE "T_Succ". 
      destruct IHHT. 
        SUBCASE "t1 is a value". destruct H. 
          SSUBCASE "t1 is a bvalue". solve by inversion 2.
          SSUBCASE "t1 is an nvalue". apply or_introl. 
            unfold value. apply or_intror. apply nv_succ. assumption.
        SUBCASE "t1 can take a step". 
          apply or_intror. destruct H. 
          apply ex_intro with (witness := tm_succ witness).
          apply E_Succ. assumption.
    CASE "T_Pred". 
      destruct IHHT. 
        SUBCASE "t1 is a value". destruct H. 
          SSUBCASE "t1 is a bvalue". solve by inversion 2.
          SSUBCASE "t1 is an nvalue". apply or_intror.
            inversion H. 
              SSSUBCASE "t1 is zero".
                subst. apply ex_intro with (witness := tm_zero). 
                apply E_PredZero.
              SSSUBCASE "t1 is nonzero".
                subst. apply ex_intro with (witness := t). 
                apply E_PredSucc. assumption.
        SUBCASE "t1 can take a step". 
          apply or_intror. destruct H. 
          apply ex_intro with (witness := tm_pred witness).
          apply E_Pred. assumption.
    CASE "T_Iszero". 
      destruct IHHT. 
        SUBCASE "t1 is a value". destruct H. 
          SSUBCASE "t1 is a bvalue". solve by inversion 2.
          SSUBCASE "t1 is an nvalue". apply or_intror.
            inversion H. 
              SSSUBCASE "t1 is zero".
                subst. apply ex_intro with (witness := tm_true). 
                apply E_IszeroZero.
              SSSUBCASE "t1 is nonzero".
                subst. apply ex_intro with (witness := tm_false). 
                apply E_IszeroSucc. assumption.
        SUBCASE "t1 can take a step". 
          apply or_intror. destruct H. 
          apply ex_intro with (witness := tm_iszero witness).
          apply E_Iszero. assumption.
Qed.

Theorem preservation : forall t t' T,
     has_type t T
  -> eval t t'
  -> has_type t' T.
Proof.
  intros t t' T HT HE.
  generalize dependent t'.
  (has_type_cases (induction HT) (CASE)); 
         (* every case needs to introduce a couple of things *)
         intros t' HE; 
         (* and we can deal with several contradictory cases all at once *)
         try solve [solve by inversion].
    CASE "T_If". inversion HE; subst. 
      SUBCASE "E_IfTrue". assumption.
      SUBCASE "E_IfFalse". assumption.
      SUBCASE "E_If". apply T_If. apply IHHT1. 
        assumption. assumption. assumption.
    (* SOLUTION *)
    CASE "T_Succ". inversion HE; subst. 
      SUBCASE "E_Succ". apply T_Succ. apply IHHT. assumption. 
    CASE "T_Pred". inversion HE; subst. 
      SUBCASE "E_PredZero". apply T_Zero. 
      SUBCASE "E_PredSucc". inversion HT. assumption.
      SUBCASE "E_Pred". apply T_Pred. apply IHHT. assumption. 
    CASE "T_Iszero". inversion HE; subst. 
      SUBCASE "E_IszeroZero". apply T_True. 
      SUBCASE "E_IszeroSucc". apply T_False. 
      SUBCASE "E_Iszero". apply T_Iszero. apply IHHT. assumption. 
Qed.

Theorem preservation' : forall t t' T,
     has_type t T
  -> eval t t'
  -> has_type t' T.
Proof.
  (* Now prove the same property again by induction on the EVALUATION
     derivation instead of on the typing derivation.  Begin by
     carefully reading and thinking about the first few lines of the
     above proof to make sure you understand what each one is doing.
     The set-up for this proof is similar, but not exactly the
     same. *)
  (* SOLUTION *)
  intros t t' T HT HE.
  generalize dependent T.
  (eval_cases (induction HE) (CASE));
         (* in each case, invert the given typing derivation *)
         intros T HT; inversion HT; subst; 
         (* deal with several easy or contradictory cases all at once *)
         try solve [assumption; solve by inversion].
    CASE "E_If". 
      apply T_If. apply IHHE. assumption. assumption. assumption.
    CASE "E_Succ". 
      apply T_Succ. inversion HT. subst. apply IHHE. assumption.
    CASE "E_PredSucc". 
      inversion HT. subst. inversion H2. subst. assumption.
    CASE "E_Pred". 
      inversion HT. subst. apply T_Pred. apply IHHE. assumption.
    CASE "E_IszeroZero". 
      apply T_True.
    CASE "E_IszeroSucc". 
      apply T_False.
    CASE "E_Iszero". 
      apply T_Iszero. apply IHHE. inversion HT. subst. assumption.
Qed.

End FullArithTypes.

(* ====================================================================== *)

(* A little cleanup: These tactics were accidentally defined inside of
   a module instead of at the top level.  Repeating the definitions
   here will make them available globally for the rest of the
   course. *)

Tactic Notation "assert_eq" ident(x) constr(v) :=
  let H := fresh in
  assert (x = v) as H by reflexivity;
  clear H.

Tactic Notation "Case_aux" ident(x) constr(name) :=
  first [
    set (x := name); move_to_top x
  | assert_eq x name; move_to_top x
  | fail 1 "because we are working on a different case." ].

Ltac CASE name := Case_aux CASE name.
Ltac SUBCASE name := Case_aux SUBCASE name.
Ltac SSUBCASE name := Case_aux SSUBCASE name.
Ltac SSSUBCASE name := Case_aux SSSUBCASE name.
Ltac SSSSUBCASE name := Case_aux SSSSUBCASE name.
Ltac SSSSSUBCASE name := Case_aux SSSSSUBCASE name.
Ltac SSSSSSUBCASE name := Case_aux SSSSSSUBCASE name.
Ltac SSSSSSSUBCASE name := Case_aux SSSSSSSUBCASE name.
Ltac SCASE name := Case_aux SCASE name.
Ltac SSCASE name := Case_aux SSCASE name.
Ltac SSSCASE name := Case_aux SSSCASE name.
Ltac SSSSCASE name := Case_aux SSSSCASE name.
Ltac SSSSSCASE name := Case_aux SSSSSCASE name.
Ltac SSSSSSCASE name := Case_aux SSSSSSCASE name.
Ltac SSSSSSSCASE name := Case_aux SSSSSSSCASE name.

Tactic Notation "solve_by_inversion_step" tactic(t) :=
  match goal with
  | H : _ |- _ => solve [ inversion H; subst; t ]
  end
  || fail "because the goal is not solvable by inversion.".

Tactic Notation "solve" "by" "inversion" "1" :=
  solve_by_inversion_step idtac.
Tactic Notation "solve" "by" "inversion" "2" :=
  solve_by_inversion_step (solve by inversion 1).
Tactic Notation "solve" "by" "inversion" "3" :=
  solve_by_inversion_step (solve by inversion 2).
Tactic Notation "solve" "by" "inversion" :=
  solve by inversion 1.


(* ====================================================================== *)
(** * The [remember] tactic *)

(* A brief digression to introduce a useful tactic. 

   This material was not covered yet in lecture -- I'll do that next
   week -- but I'm including it here (a) in case anyone wants to get
   started with it now and (b) because it is needed to understand the
   details of the proofs in Lecture 13.
*)


(* We have seen how the [destruct] tactic can be used to perform case
   analysis of the results of arbitrary computations.  If [e] is an
   expression whose type is some inductively defined set [T], then,
   for each constructor [c] of [T], [destruct e] generates a subgoal
   in which all occurrences of [e] (in the goal and in the context)
   are replaced by [c].

   Sometimes, however, this substitution process loses information
   that we need in order to complete the proof.  For example, suppose
   we define a function [sillyfun1] like this... *)
Definition sillyfun1 (n : nat) : yesno :=
  if eqnat n three then yes
  else if eqnat n five then yes
  else no.

(* ... and suppose that we want to convince Coq of the rather obvious
   observation that [sillyfun1 n] yields [yes] only when [n] is odd.
   By analogy with the proofs we did with [sillyfun] above, it is
   natural to start the proof like this: *)
Lemma sillyfun1_odd_FAILED : forall (n : nat),
     sillyfun1 n = yes
  -> odd n = yes.
Proof.
  intros n eq. unfold sillyfun1 in eq.
  destruct (eqnat n three).
  (* At this point, we are stuck: the context does not contain enough
     information to prove the goal!  The problem is that the
     substitution peformed by [destruct] is too brutal -- it threw
     away every occurrence of [eqnat n three], but we need to keep at
     least one of these because we need to be able to reason that
     since, in this branch of the case analysis, [eqnat n three =
     yes], it must be that [n = three], from which it follows that [n]
     is odd. *)
Admitted.

(* What we would really like is not to use [destruct] directly on
   [eqnat n three] and substitute away all occurrences of this
   expression, but rather to use [destruct] on something else that is
   EQUAL to [eqnat n three] -- e.g., if we had a variable that we knew
   was equal to [eqnat n three], we could [destruct] this variable
   instead.

   The [remember] tactic allows us to introduce such a variable. *)

Lemma sillyfun1_odd : forall (n : nat),
     sillyfun1 n = yes
  -> odd n = yes.
Proof.
  intros n eq. unfold sillyfun1 in eq.
  remember (eqnat n three) as e3.
  (* At this point, the context has been enriched with a new variable
     [e3] and an assumption that [e3 = eqnat n three].  Now if we do
     [destruct e3]... *)
  destruct e3.
  (* ... the variable [e3] gets substituted away (it disappears
     completely) and we are left with the same state as at the point
     where we got stuck above, except that the context still contains
     the extra equality assumption -- now with [yes] substituted for
     [e3] -- which is exactly what we need to make progress. *)
    Case "yes". apply eq_symm in Heqe3. apply eqnat_yes in Heqe3.
      rewrite -> Heqe3. reflexivity.
    Case "no".
      (* When we come to the second equality test in the body of the
         function we are reasoning about, we can use [remember] again
         in the same way, allowing us to finish the proof. *)
      remember (eqnat n five) as e5. destruct e5.
        Case "yes". apply eq_symm in Heqe5. apply eqnat_yes in Heqe5.
          rewrite -> Heqe5. reflexivity.
        Case "no". inversion eq.
Qed.

(* Now you try it... *)
Lemma filter_exercise : forall (X : Set) (test : X -> yesno)
                               (x : X) (l l' : list X),
     filter _ test l = x :: l'
  -> test x = yes.
Proof.
  (* SOLUTION *)
  intros X test x l. induction l.
    Case "nil". intros l' eq. inversion eq.
    Case "cons". intros l' eq.
      simpl in eq.
      remember (test x0) as t. destruct t.
        Case "yes". inversion eq. rewrite <- H0. rewrite <- Heqt. reflexivity.
        Case "no". apply IHl with (l':=l').
          apply eq.
Qed.

(* ====================================================================== *)
(* LECTURE 13 *)

(* Now we come to the first really interesting programming language:
   the lambda-calculus.  

   Chapter 5 of TAPL is good background reading for the material in
   the next couple of lectures. *)

(* ====================================================================== *)
(* Untyped lambda-calculus *)

Module Lambda.

(* When we were doing functional programming back at the beginning of
   the semester, we saw three fundamental syntactic constructs for
   creating and using functions:

      fun x => t        abstraction  (anonymous function creation)
      t1 t2             application  (apply function t1 to argument t2)
      x                 variable     (placeholder for the argument to
                                      a function, in its body)

   The PURE LAMBDA-CALCULUS focuses on just these three constructs --
   indeed, it offers nothing else.  We will see that a surprising
   range of computational behaviors can be expressed using just these
   basic building blocks.

   (Actually, for the sake of convenience when experimenting with the
   evaluation behavior of terms in the lambda-calculus, we'll include
   one additional syntactic construct: a collection of uninterpreted
   constants.  These constants have no interesting behavior -- they
   are computationally "inert" -- and including them does not change
   the fundamental properties of the language.)
*)

(* ---------------------------------------------------------------------- *)
(* Syntax *)

(* To define the lambda-calculus, we begin with names of variables.
   It doesn't much matter how these are represented -- all we need is
   to be able to tell whether two names are the same or different.
   Strings would be a natural choice, but there's an even simpler one:
   natural numbers. *)

Definition name := nat.
Definition eqname := eqnat.
Definition aa : name := one.
Definition bb : name := two.
Definition cc : name := three.

(* Now the syntax of terms: *)
Inductive tm : Set :=
  | tm_const : name -> tm
  | tm_var : name -> tm
  | tm_app : tm -> tm -> tm
  | tm_abs : name -> tm -> tm.

Tactic Notation "tm_cases" tactic(first) tactic(c) :=
  first;
  [ c "tm_const" | c "tm_var" | c "tm_app" | c "tm_abs" ].

(* Since we are going to be writing some longish examples, it will
   help to introduce some shorthand notations for terms.
   Unfortunately, Coq's [Notation] mechanism starts to show its
   limitations at this point: We can't make a notation for
   lambda-terms that is as simple and compact as the standard notation
   used in TAPL.  In particular:
      - The application of one term to another needs to be indicated
        by some symbol (we use @) rather than by simple juxtaposition
        as in the standard notation.
      - In many situations, the [tm_var] constructor needs to be
        indicated by some symbol (we use !).  (In examples, we are
        often able to get away with writing a bare name and omitting
        the !, by using Coq's "implicit coercion" mechanism.)

   Here is a summary of the notations we'll use and their
   correspondence with the standard notation used in TAPL:

       Concrete         Shorthand notation   TAPL           Coq       
       --------------------------------------------------------
       tm_const c       `c                   c              c
       tm_var x         !x or x              x              x  
       tm_abs x t       \x,t                 lambda x. t    fun x => t 
       tm_app t1 t2     t1 @ t2              t1 t2          t1 t2
*)

Notation "` n" := (tm_const n) (at level 19).
Notation "! n" := (tm_var n) (at level 19).
Notation "\ x , t" := (tm_abs x t) (at level 21).
Notation "r @ s" := (tm_app r s) (at level 20).

(* These declarations tell Coq that it should accept an expression of
   type [name] in a situation where it wants an expression of type
   [tm], implicitly inserting the constructor [tm_var] as needed to
   make such expressions well typed. *)
Definition name_in_tm : name -> tm := tm_var.
Coercion name_in_tm : name >-> tm.
Definition nat_in_tm : nat -> tm := tm_var.
Coercion nat_in_tm : nat >-> tm.

(* For example, the term written
   
       lambda aa. lambda bb. aa bb (aa bb) aa

   in standard notation would be written here either as... *)
Check (\aa, \bb, aa @ bb @ (aa @ bb) @ aa).

(* ... or, being more explicit about the [tm_var] constructors, as: *)
Check (\aa, \bb, !aa @ !bb @ (!aa @ !bb) @ !aa).

(* To make examples easier to read, we can define some abbreviations
   for constants, as we did above for names. *)
Notation AA := (tm_const one).
Notation BB := (tm_const two).
Notation CC := (tm_const three).
Notation DD := (tm_const four).
Notation EE := (tm_const five).
Notation FF := (tm_const six).
Check (\aa, aa @ BB @ (aa @ BB) @ aa).

(* ---------------------------------------------------------------------- *)
(* Evaluation *)

Fixpoint only_constants (t:tm) {struct t} : yesno :=
  match t with
  | tm_const _ => yes
  | tm_app t1 t2 => both_yes (only_constants t1) (only_constants t2)
  | _ => no
  end.
(* ADD: Explain! *)
(* LATER: A possibly better definition (that will lead to nicer
   inductive proofs)... a generalized constant is either a constant or
   a generalized constant applied to a value (but that introduces
   mutual recursion! maybe not so much better) *)

Inductive value : tm -> Prop :=
  | v_const : forall t, 
      only_constants t = yes -> value t
  | v_abs : forall x t,
      value (\x, t).

(* The fundamental "evaluation step" in the lambda-calculus is the
   application of a function to a value.  For example:

       (\aa, aa) BB             --->   BB
       (\aa, \bb, aa cc) BB     --->   \bb, BB cc
       (\aa, aa) (\bb, bb CC)   --->   \bb, bb CC
       (\aa, aa CC) (\bb, bb)   --->   (\bb, bb) CC

   That is, the fundamental step replaces a term of the form

       (\x, t) v

   (where [v] is a value -- a term of this form is often called a BETA
   REDEX) by the result of substituting [v] for the bound variable [x]
   in the body [t].

   The operation of substituting a value for a variable thus lies at
   the heart of evaluation in the lambda-calculus.  To formalize
   evaluation, we begin by formalizing substitution... *)

Fixpoint subst (x:name) (s:tm) (t:tm) {struct t} : tm :=
  match t with
  | `c => `c
  | !y => if eqname x y then s else t
  | \y, t1 => if eqname x y then t else (\y, subst x s t1)
  | t1 @ t2 => (subst x s t1) @ (subst x s t2)
  end.

(* In TAPL, the substitution of [v] for [x] in the term [t] is written

      [x |-> v] t

   but we've already used square brackets for lists.  So we'll use
   curly braces instead. *)
Notation "{ x |-> s } t" := (subst x s t) (at level 17).

Lemma check_subst1 : 
    {aa |-> CC} (aa @ BB) 
  = CC @ BB.
Proof. reflexivity. Qed.

(* Here are some examples for you to try... *)
Lemma check_subst2 : 
    {aa |-> (\cc, DD)} BB
  =  BB.
Proof. reflexivity. Qed.

Lemma check_subst3 : 
    {aa |-> (\cc, DD)} (\cc, aa @ (\bb, aa @ DD))
  =  \cc, (\cc, DD) @ (\bb, (\cc, DD) @ DD).
Proof. reflexivity. Qed.

Lemma check_subst4 : 
    { aa |-> (\cc, DD)} (\bb, aa @ bb @ (CC @ aa))
  = \bb, (\cc, DD) @ bb @ (CC @ (\cc, DD)).
Proof. reflexivity. Qed.

Lemma check_subst5 : 
    {aa |-> (\cc, DD)} (\cc, aa @ (\aa, DD @ aa))
  =  \cc, (\cc, DD) @ (\aa, DD @ aa).
Proof. reflexivity. Qed.


Inductive eval : tm -> tm -> Prop :=
  | E_AppAbs : forall x t12 v2,
         value v2
      -> eval ((\x, t12) @ v2) ({x |-> v2} t12)
  | E_App1 : forall t1 t1' t2,
         eval t1 t1'
      -> eval (t1 @ t2) (t1' @ t2)
  | E_App2 : forall v1 t2 t2',
         value v1
      -> eval t2 t2'
      -> eval (v1 @ t2) (v1 @ t2').

Lemma check_eval1 : 
  eval ((\aa, aa @ BB) @ CC)
       (CC @ BB).
Proof.
  rewrite <- check_subst1.
  apply E_AppAbs.
  apply v_const. 
  reflexivity.
Qed.

Lemma check_eval2 : 
  eval ((\aa, \bb, aa @ bb @ (`three @ aa) ) @ (\cc, DD) @ EE)
       ((\bb, (\cc, DD) @ bb @ (`three @ (\cc, DD))) @ EE).
Proof.
  (* SOLUTION *)
  rewrite <- check_subst4.
  apply E_App1.
  apply E_AppAbs.
  apply v_abs.
Qed.

Lemma check_eval3 : 
  eval ((\aa, aa @ aa @ aa) @ (\aa, aa @ aa))
       ((\aa, aa @ aa) @ (\aa, aa @ aa) @ (\aa, aa @ aa)).
Proof.
  (* SOLUTION *)
  assert ({ aa |-> (\aa, aa @ aa)} (aa @ aa @ aa)
          = (\aa, aa @ aa) @ (\aa, aa @ aa) @ (\aa, aa @ aa)).
    reflexivity.
  rewrite <- H.
  apply E_AppAbs.
  apply v_abs.
Qed.

(* In passing, let's define an [eval_cases] tactic, for use in
   inductive proofs about evaluation. *)
Tactic Notation "eval_cases" tactic(first) tactic(c) :=
  first;
  [ c "E_AppAbs" | c "E_App1" | c "E_App2" ].

(* ====================================================================== *)
(* An evaluation function for the lambda-calculus *)

(* For experimenting with the lamba-calculus, it is convenient to have
   an evaluation FUNCTION that we can call to normalize terms
   automatically rather than doing it manually by applying the
   constructors of the evaluation relation (as in the examples just
   above).  The structure of this function is similar to the one we
   wrote in the last lecture for the simpler language of booleans and
   numbers. *)

Fixpoint is_value (t:tm) {struct t} : yesno :=
  match t with
  | \ _, _ => yes
  | _ => only_constants t
  end.

Fixpoint simplify_step (t:tm) {struct t} : option tm :=
  match t with
  | t1 @ t2 =>
      if is_value t1 then
        match simplify_step t2 with
        | None => 
            match t1 with
            | \x,t12 => 
                if is_value t2 then Some _ (({x |-> t2} t12))
                else None _
            | _ => None _
            end
        | Some t2' => Some _ (t1 @ t2')
        end
      else
        match simplify_step t1 with
        | None => None _
        | Some t1' => Some _ (t1' @ t2)
        end
  | _ => None _
  end.

(* As before, we should check our work by proving that [simplify_step]
   is correctly defined... 

   (I'm not completely satisfied with this proof -- I'll bet it can be
   done more smoothly, perhaps by slightly tweaking the definition of
   the evaluation function...  However, it does demonstrate that the
   definition as it stands is correct.)
*)

Lemma is_value__value : forall t,
  is_value t = yes -> value t.
Proof.
  intros t0. destruct t0; intros H.
    simpl. apply v_const. reflexivity.
    solve by inversion.
    apply v_const. simpl. simpl in H. assumption.
    simpl. apply v_abs.
Qed.

Lemma value__is_value : forall t,
  value t -> is_value t = yes.
Proof.
  intros t Hv. inversion Hv. 
    destruct t; try solve [reflexivity | solve by inversion].
    simpl. simpl in H. assumption.
    reflexivity.
Qed.

Lemma both_yes_1 : forall b c,
  both_yes b c = yes -> b = yes.
Proof.
  intros b c H. destruct b; destruct c; 
    try solve [reflexivity | simpl in H; assumption].
Qed.    
Lemma both_yes_2 : forall b c,
  both_yes b c = yes -> c = yes.
Proof.
  intros b c H. destruct b; destruct c; 
    try solve [reflexivity | simpl in H; assumption].
Qed.    

Lemma only_constants_don't_simplify : forall v,
     only_constants v = yes
  -> simplify_step v = None _.
Proof.
  intros v H.
  (tm_cases (induction v) (CASE)); try solve [reflexivity].
     CASE "tm_app". 
       simpl. destruct (is_value v1). 
         SUBCASE "v1 is a value".
           simpl in H. 
           assert (only_constants v1 = yes).
             SSUBCASE "Pf of assumption". 
               apply both_yes_1 with (c := only_constants v2). 
               assumption.
           assert (only_constants v2 = yes).
             SSUBCASE "Pf of assumption". 
               apply both_yes_2 with (b := only_constants v1). 
               assumption.
           apply IHv2 in H1. rewrite H1. 
           (tm_cases (destruct v1) (SSUBCASE)).
             reflexivity. reflexivity. reflexivity.
             destruct v2; inversion H0. 
         SUBCASE "v1 is not a value".
           simpl in H. 
           assert (only_constants v1 = yes).
             SSUBCASE "Pf of assumption". 
               apply both_yes_1 with (c := only_constants v2). 
               assumption.
           apply IHv1 in H0. rewrite H0. reflexivity.
Qed.

Lemma simplify_step__eval : forall t t',
     simplify_step t = Some _ t'
  -> eval t t'.
Proof.
  intros t t'.
  generalize dependent t'.  
  (tm_cases (induction t) (CASE)); intros t' H; try solve [solve by inversion].
    CASE "tm_app". simpl in H. remember (is_value t1) as r1. 
      destruct r1.
        SUBCASE "t1 is a value".
          destruct (simplify_step t2). 
            SSUBCASE "t2 steps".
              inversion H. apply E_App2. apply is_value__value. 
              apply eq_symm. assumption. apply IHt2. reflexivity.
            SSUBCASE "t2 nf". destruct t1.
              SSSUBCASE "tm_const". solve by inversion.
              SSSUBCASE "tm_var". solve by inversion.
              SSSUBCASE "tm_app". solve by inversion.
              SSSUBCASE "tm_abs". 
                remember (is_value t2) as r2. destruct r2.
                 SSSSUBCASE "t2 is a value".
                   inversion H. subst. apply E_AppAbs.
                   apply is_value__value. apply eq_symm. assumption.
                 SSSSUBCASE "t2 is not a value". solve by inversion. 
        SUBCASE "t1 is not a value". 
          remember (simplify_step t1) as r1. destruct r1.
            SSUBCASE "t1 steps". inversion H. subst.
              apply E_App1. apply IHt1. reflexivity.
            SSUBCASE "t1 nf". solve by inversion. 
Qed.

Lemma values_don't_simplify : forall v,
     value v
  -> simplify_step v = None _.
Proof.
  intros v Hv.
  (tm_cases (induction v) (CASE)); try solve [reflexivity]. 
    inversion Hv. 
      apply only_constants_don't_simplify. assumption.
Qed.

Lemma things_that_simplify_aren't_only_constants : forall t t',
     simplify_step t = Some _ t'
  -> only_constants t = no.
Proof.
  intros t t' H. 
  apply simplify_step__eval in H. 
  eval_cases (induction H) (CASE).
    reflexivity.
    simpl. rewrite IHeval. reflexivity.
    simpl. rewrite IHeval. destruct (only_constants v1); reflexivity.
Qed.

Lemma things_that_simplify_aren't_values : forall t t',
     simplify_step t = Some _ t'
  -> is_value t = no.
Proof.
  intros t t' H. 
  assert (only_constants t = no).
    apply things_that_simplify_aren't_only_constants with (t':=t'). 
    assumption.
  (tm_cases (destruct t) (CASE)); try solve [solve by inversion]. 
     simpl. simpl in H0. assumption.
Qed.

Theorem two_variants_of_single_step_evaluation_coincide : forall t t',
  eval t t' <-> simplify_step t = Some _ t'.
Proof.
  unfold iff. intros t t'. apply conj.
  CASE "->". intros H. 
    (eval_cases (induction H) (SUBCASE)).
      SUBCASE "E_AppAbs". 
        inversion H. 
          simpl. rewrite -> values_don't_simplify. simpl. 
          destruct v2; try solve [solve by inversion].
          reflexivity.
          simpl. simpl in H0. rewrite H0. reflexivity.
          assumption. simpl. reflexivity.
      SUBCASE "E_App1". simpl. 
        assert (is_value t1 = no).
          SSUBCASE "Pf of assertion". 
            apply things_that_simplify_aren't_values with (t' := t1'). 
            assumption.
        rewrite H0. rewrite IHeval. reflexivity.
      SUBCASE "E_App2". simpl. destruct v1.
        SSUBCASE "tm_const". simpl. rewrite IHeval. reflexivity.
        SSUBCASE "tm_var". simpl. solve by inversion 2.
        SSUBCASE "tm_app". assert (is_value (v1_1 @ v1_2) = yes).
          apply value__is_value. assumption. 
          rewrite -> H1. rewrite -> IHeval. reflexivity.
        SSUBCASE "tm_abs". simpl. rewrite IHeval. reflexivity. 
  CASE "<-".
    apply simplify_step__eval.
Qed.

(* THOUGHT EXERCISE (not to be handed in).  When I first sat down to
   write the evaluation function, I did not get it quite right.  See
   if you can spot the error in the following definition without
   looking at the correct version of [simplify_step] above.  (You'll
   need to look at the definition of [eval], of course.)  Test your
   answer by constructing a term that demonstrates the difference
   between the definitions. *)

Fixpoint simplify_step_WRONG (t:tm) {struct t} : option tm :=
  match t with
  | t1 @ t2 =>
      match simplify_step t1 with
      | None => 
          match simplify_step t2 with
          | None => 
              match t1 with
              | \ x, t12 => Some _ (({x |-> t2} t12))
              | _ => None _
              end
          | Some t2' => Some _ (t1 @ t2')
          end
      | Some t1' => Some _ (t1' @ t2)
      end
  | _ => None _
  end.


(* ---------------------------------------------------------------------- *)
(* Multi-step evaluation *)

(* As we did for previous languages, we can now define an [evalmany]
   relation that allows multiple steps of evaluation.  But for
   purposes of experimenting with examples, it's more convenient to
   define a functional version first.  

   The function [normalize] takes a term [t] and a number [steps] and
   performs up to [steps] single-step evaluations of [t] (using
   [simplify_step]) to try to reduce it to a normal form.  If it
   succeeds in finding a normal form [t'] within [steps] steps, it
   returns [Some _ t']; otherwise it returns [None _]. *)

Fixpoint normalize (t:tm) (steps:nat) {struct steps} : option tm :=
  match steps with
  | O => None _
  | S steps' => 
      match simplify_step t with
      | None => Some _ t
      | Some t' => normalize t' steps'
      end
  end.

(* For testing examples below, here is a convenient shorthand for the
   proposition "[t] normalizes to [t'] within 100 steps of
   evaluation." *)
Notation " t -->* t' " :=
  (normalize t (times ten ten) = Some _ t')
  (at level 80).

(* ====================================================================== *)
(* Programming in the untyped lambda-calculus *)


Module LambdaExamples.

(* To make the notation in the examples as close as possible to TAPL,
   let's introduce some more names for variables.  Coq will do a
   better job with printing if we choose numbers that do not already
   have names (like [zero], [one], [two]), so let's choose larger
   numbers to represent variables in lambda-terms.  (This looks
   hideous, but all we're doing is choosing 26 different numbers to
   act as names in the examples.) *)
Notation a := (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))).
Notation b := (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))).
Notation c := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))).
Notation d := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))).
Notation e := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))).
Notation f := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))).
Notation g := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))).
Notation h := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))).
Notation i := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))).
Notation j := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))).
Notation k := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))).
Notation l := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))).
Notation m := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))).
Notation n := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))).
Notation o := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))).
Notation p := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))).
Notation q := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))).
Notation r := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))).
Notation s := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))).
Notation t := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))).
Notation u := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))).
Notation v := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))))).
Notation w := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))).
Notation x := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))))))).
Notation y := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))).
Notation z := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))))))))))))))))))))))))).

(* ---------------------------------------------------------------------- *)
(* Church booleans *)

Notation tru := (\t, \f, t).
Notation fls := (\t, \f, f).

Lemma check_tru : 
       tru @ AA @ BB
  -->* AA.
Proof. reflexivity. Qed.
Lemma check_fls : 
       fls @ AA @ BB
  -->* BB.
Proof. reflexivity. Qed.

(* The lambda-term [bnot] takes a lambda-term [b] representing a
   boolean and yields another term representing the negation of this
   boolean. *)
Notation bnot := (\b, b @ fls @ tru).

Lemma check_bnot : 
       ((bnot @ tru) @ AA @ BB)
  -->* BB.
Proof. reflexivity. Qed.

(* Similarly, [and] takes two arguments representing booleans and
   yields a lambda-term representing their logical conjunction. *)
Notation and := (\b, \c, b @ c @ fls).

Lemma check_and1 : 
       ((and @ tru @ tru) @ AA @ BB)
  -->* AA.
Proof. reflexivity. Qed.
Lemma check_and2 : 
       ((and @ tru @ fls) @ AA @ BB)
  -->* BB.
Proof. reflexivity. Qed.
Lemma check_and3 : 
       ((and @ fls @ tru) @ AA @ BB)
  -->* BB.
Proof. reflexivity. Qed.
Lemma check_and4 : 
       ((and @ fls @ fls) @ AA @ BB)
  -->* BB.
Proof. reflexivity. Qed.

(* EXERCISE: Write a lambda-term representing logical "or". *)
Notation or :=  (\b, \c, b @ tru @ c).

Lemma check_or1 : 
       ((or @ tru @ tru) @ AA @ BB)
  -->* AA.
Proof. reflexivity. Qed.
Lemma check_or2 : 
       ((or @ tru @ fls) @ AA @ BB)
  -->* AA.
Proof. reflexivity. Qed.
Lemma check_or3 : 
       ((or @ fls @ tru) @ AA @ BB)
  -->* AA.
Proof. reflexivity. Qed.
Lemma check_or4 : 
       ((or @ fls @ fls) @ AA @ BB)
  -->* BB.
Proof. reflexivity. Qed.


(* ---------------------------------------------------------------------- *)
(* Pairs *)

(* Using booleans, we can encode pairs of values as lambda-terms. *)  

Notation pair := (\f, \s, (\b, b @ f @ s)).
Notation fst  := (\p, p @ tru).
Notation snd  := (\p, p @ fls).

Lemma check_pair1 : 
       (fst @ (pair @ AA @ BB))
  -->* AA.
Proof. reflexivity. Qed.
Lemma check_pair2 : 
       (snd @ (pair @ AA @ BB))
  -->* BB.
Proof. reflexivity. Qed.

(* EXERCISE: Define a similar set of functions for representing
   triples of values. *)
Notation choose1of3  := (\f, \s, \t, f).
Notation choose2of3  := (\f, \s, \t, s).
Notation choose3of3  := (\f, \s, \t, t).
Notation triple := (\f, \s, \t,  (\b, b @ f @ s @ t)).
Notation fst3  :=  (\p, p @ choose1of3).
Notation snd3  :=  (\p, p @ choose2of3).
Notation thd3  :=  (\p, p @ choose3of3).
Lemma check_fst3 : 
       (fst3 @ (triple @ AA @ BB @ CC))
  -->* AA.
Proof. reflexivity. Qed.
Lemma check_snd3 : 
       (snd3 @ (triple @ AA @ BB @ CC))
  -->* BB.
Proof. reflexivity. Qed.
Lemma check_thd3 : 
       (thd3 @ (triple @ AA @ BB @ CC))
  -->* CC.
Proof. reflexivity. Qed.

(* ---------------------------------------------------------------------- *)
(* Church numerals *)

(* Representing numbers as lambda-terms is also not too hard... *)

Notation c_zero  := (\s, \z, z).
Notation c_one   := (\s, \z, s @ z).
Notation c_two   := (\s, \z, s @ (s @ z)).
Notation c_three := (\s, \z, s @ (s @ (s @ z))).

Lemma check_three : 
       (c_three @ AA @ BB)
  -->* AA @ (AA @ (AA @ BB)).
Proof. reflexivity. Qed.

Notation scc := (\n, \s, \z, s @ (n @ s @ z)).

Lemma check_scc : 
       ((scc @ (scc @ c_one)) @ AA @ BB)
  -->* AA @ (AA @ (AA @ BB)).
Proof. reflexivity. Qed.

Notation pls := (\m, \n, \s, \z, m @ s @ (n @ s @ z)).

Lemma check_pls : 
       ((pls @ c_one @ c_two) @ AA @ BB)
  -->* AA @ (AA @ (AA @ BB)).
Proof. vm_compute. reflexivity. Qed.
(* Note: [vm_compute] is a more efficient variant of [simpl]. *)

Notation tms := (\m, \n, m @ (pls @ n) @ c_zero).

Lemma check_tms : 
       ((tms @ c_two @ c_two) @ AA @ BB)
  -->* AA @ (AA @ (AA @ (AA @ BB))).
Proof. vm_compute. reflexivity. Qed.

(* EXERCISE: Is it possible to define [tms] without using [pls]? *)
Notation tms' := (\m, \n, \s, \z,  m @ (n @ s) @ z).
Lemma check_tms' : 
       ((tms' @ c_two @ c_two) @ AA @ BB)
  -->* AA @ (AA @ (AA @ (AA @ BB))).
Proof. vm_compute. reflexivity. Qed.

End LambdaExamples.

End Lambda.