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

(* ---------------------------------------------------------------------- *)
Require Export lec18. 

(* Topics for today:
      - from formal to informal proofs
      - sums  (TAPL section 11.9)
      - variants  (TAPL 11.10) *)

(* ====================================================================== *)
(* From formal to informal proofs *)

(* Giving someone a formal Coq proof of some proposition [P] is a
   good way to convey *belief* that [P] is true.  They only have to
      - read and understand the formal statement of [P]
      - trust that Coq's internal logic (the Calculus of Inductive
        Constructions, CiC) is consistent
      - trust that Coq's implementation of its CiC verifier is correct
      - run Coq on your proof and see that it says "yes." 
   They do not have to check all the steps of your proof (Coq itself
   can do that), nor do they have to check Coq's implementation of all
   the hairy tactics you might have used (internally, every tactic must
   actually construct a CiC "proof object" that demonstrates the
   correctness of what it has done).

   However, handing someone a bare Coq proof is not an especially good
   way of conveying the *understanding* of why [P] is true.  Even if
   the proof is nicely structured, major subsidiary steps are broken
   out into separate lemmas, etc., it still takes considerable work to
   reconstruct the reasons for each low-level step and figure out
   where the critical choices are being made.  So we really need both
   formal and informal proofs.

   Of course, the two forms of proofs are deeply connected:

      - Given a well-structured formal proof, we can obtain a useful
        informal proof by (a) suppressing all the "mechanical"
        low-level steps that any competent mathematician would easily
        be able to fill in, and (b) indicating each point where an
        important choice is made (e.g., where we choose exactly how to
        state an induction hypothesis, how to perform a case analysis,
        what auxiliary fact to assert, etc.) and explaining our
        intuition for why we did this.

      - Conversely, the test of whether an informal proof of [P] has
        successfully communicated a deep understanding of why [P] is
        true is that the reader of the proof should be able to sit
        down and *easily* construct a formal proof of [P], just by
        filling in mechanical details.
*)

Module STLCWithRecordsContd.
Export STLCWithRecords.

(* Here is the progress theorem from Lecture 18 again... *)
Theorem progress' : forall t T,
     empty |- t ~ T    
  -> value t \/ exists t', eval t t'.
Proof.
  intros t T Hty.
  remember empty as Gamma.
  (typing_cases (induction Hty) (CASE)); subst.
  CASE "T_Var".
    solve by inversion.
  CASE "T_Abs".
    apply or_introl. apply v_abs.
  CASE "T_App".
    assert (value t1 \/ (exists t' : tm, eval t1 t')) as IH1.
      apply IHHty1. reflexivity.
    assert (value t2 \/ (exists t' : tm, eval t2 t')) as IH2.
      apply IHHty2. reflexivity.
    apply or_intror.
    inversion IH1.
      SCASE "t1 value". inversion IH2; subst.
        SSCASE "t1 value / t2 value".
          inversion H; subst. 
            SSSCASE "t1 is an abstraction". 
              apply ex_intro with (witness := {x |-> t2} t).
              apply E_AppAbs. assumption. 
            SSSCASE "t1 is record nil". 
              solve by inversion.
            SSSCASE "t1 is record cons". 
              solve by inversion.
        SSCASE "t1 value / t2 steps".
          inversion H0.
          apply ex_intro with (witness := tm_app t1 witness).
          apply E_App2. assumption. assumption.
      SCASE "t1 steps".
        inversion H.
        apply ex_intro with (witness := tm_app witness t2).
        apply E_App1. assumption.
  (* ... remainder omitted ... *)
Admitted.
(* Here is the same formal proof, annotated with informal explanations
   of the most important steps.  We can now obtain a pure informal
   proof (such as would be published in a mathematical journal) by
   just deleting everything but the comments.  Or, if we expect our
   readers to have a Coq interpreter available, we can keep the formal
   and informal versions mixed together just as they appear here.
   This gives readers some useful additional possibilities,
   including (a) using Coq to explore points where our informal
   explanation may not be clear enough, or (b) modifying the proof
   themselves, either to check whether some different proof strategy
   would also work or to adapt it to changes in earlier
   definitions. *)
Theorem progress'' : forall t T,
     empty |- t ~ T    
  -> value t \/ exists t', eval t t'.
Proof.
  intros t T Hty.
  remember empty as Gamma.
  (* By induction on a derivation of [empty |- t ~ T]. *)
  (typing_cases (induction Hty) (CASE)); subst.
  CASE "T_Var".
    (* The T_Var case is impossible, since then t would be a variable
       but we are assuming t is typable in the empty environment. *)
    solve by inversion.
  CASE "T_Abs".
    (* The T_Abs case is immediate, since then t must be an
       abstraction, hence a value. *)
    apply or_introl. apply v_abs.
  CASE "T_App".
    (* In the T_App case, we know by the form of the rule that [t = t1
       @ t2], with [empty |- t1 ~ S-->T] and [empty |- t2 ~ S], for
       some [S].  Moreover, the IH tells us that either [t1] is a
       value or else it can take a step, and similarly for [t2].  *)
    assert (value t1 \/ (exists t' : tm, eval t1 t')) as IH1.
      apply IHHty1. reflexivity.
    assert (value t2 \/ (exists t' : tm, eval t2 t')) as IH2.
      apply IHHty2. reflexivity.
    apply or_intror.
    (* Let us consider each of these cases separately. *)
    inversion IH1.
      SCASE "t1 value". inversion IH2; subst.
        SSCASE "t1 value / t2 value".
          (* First, suppose both [t1] and [t2] are values.  In
             particular, [t1] must be either an abstraction, an empty
             record, or a record-cons. *)
          inversion H; subst. 
            SSSCASE "t1 is an abstraction". 
              (* But we also know that [empty |- t1 ~ S-->T], and the
                 form of the typing rules tells us that only the
                 abstraction case is possible: [t1 = \x~S,t] for some
                 [t].  But then the original term [t1 @ t2] can take a
                 step, by E_AppAbs, to [{x |-> t2} t]. *)
              apply ex_intro with (witness := {x |-> t2} t).
              apply E_AppAbs. assumption. 
            SSSCASE "t1 is record nil". 
              solve by inversion.
            SSSCASE "t1 is record cons". 
              solve by inversion.
        SSCASE "t1 value / t2 steps".
          (* If [t1] is a value and [t2] can take a step, then, by
             E_App2, [t1 @ t2] can take the same step. *)
          inversion H0.
          apply ex_intro with (witness := tm_app t1 witness).
          apply E_App2. assumption. assumption.
      SCASE "t1 steps".
        (* Finally, if [t1] can take a step, then, by E_App1, [t1 @
           t2] can take the same step. *)
        inversion H.
        apply ex_intro with (witness := tm_app witness t2).
        apply E_App1. assumption.
  (* ... remainder omitted ... *)
Admitted.
End STLCWithRecordsContd.

(* ====================================================================== *)
(* STLC with sums *)

(* We saw in the last lecture how to formalize the simplest kind of
   "structured data" (pairs) and how to extend the same ideas to a
   more flexible form of structured data (records).

   Another crucial element in most programs of any size is
   HETEROGENEOUS data.  For example, a core data structure in a
   graphics editor might be a list containing all the graphical
   elements currently displayed on the screen, and each of these
   elements might be a box or a text string.  In order to write down
   the type of this list, we need a type that describes "either a box
   or a text string."  Indeed, even the type of lists itself involves
   this kind of heterogeneity: A list is either an empty list or else
   a pair of something and another list.

   Just as the simplest structured data type was a binary product
   type (describing two-element pairs), the simplest type for
   heterogeneous data is a binary SUM type, describing a choice
   between two alternatives.
*)

Module STLCWithSums.

Inductive ty : Set :=
  | ty_base : nat -> ty 
  | ty_arrow : ty -> ty -> ty 
  | ty_sum : ty -> ty -> ty.

Notation A := (ty_base one).
Notation B := (ty_base two).
Notation C := (ty_base three).
Notation "S --> T" := (ty_arrow S T) (at level 20, right associativity).
Notation "<< S , T >>" := (ty_sum S T) (at level 21, right associativity).

Inductive tm : Set :=
  | tm_var : nat -> tm
  | tm_app : tm -> tm -> tm
  | tm_abs : nat -> ty -> tm -> tm
  | tm_inl : tm -> tm
  | tm_inr : tm -> tm
  | tm_case : tm -> nat -> tm -> nat -> tm -> tm.

Notation "! n" := (tm_var n) (at level 39).
Notation "\ x ~ T , t" := (tm_abs x T t) (at level 42).
Notation "r @ s" := (tm_app r s) (at level 40, left associativity).
Notation "'inl' t" := (tm_inl t) (at level 43).
Notation "'inr' t" := (tm_inr t) (at level 43).
Notation "'case' t 'of' 'inl' x1 ==> t1 || 'inr' x2 ==> t2" := 
  (tm_case t x1 t1 x2 t2) (at level 45).

Module Examples.
Notation x := (S (S (S (S (S O))))).
Notation y := (S (S (S (S (S (S O)))))).
Notation z := (S (S (S (S (S (S (S O))))))).
Notation s := (S (S (S (S (S (S (S (S O)))))))).
Notation a := (S (S (S (S (S (S (S (S (S O))))))))).
Notation f := (S (S (S (S (S (S (S (S (S (S O)))))))))).
Notation b := (S (S (S (S (S (S (S (S (S (S (S O))))))))))).
Definition nat_in_tm : nat -> tm := tm_var.
Coercion nat_in_tm : nat >-> tm.

Notation sum_example_tm :=
  (\s ~ << A, B-->A >>, 
     \b ~ B,
       case s of
          inl a ==> a
       || inr f ==> f @ b).

End Examples.

Reserved Notation "{ x |-> s } t" (at level 17). 

Fixpoint subst (x:nat) (s:tm) (t:tm) {struct t} : tm :=
  match t with
  | !y => if eqnat x y then s else t
  | \y~T, t1 => if eqnat x y then t else \y~T, {x |-> s}t1
  | t1 @ t2 => ({x |-> s}t1) @ ({x |-> s}t2)
  | inl t => inl {x |-> s}t
  | inr t => inr {x |-> s}t
  | (case t of inl x1 ==> t1 || inr x2 ==> t2) =>
      (case {x |-> s}t of 
        inl x1 ==> (if eqnat x x1 then t1 else {x |-> s}t1)
     || inr x2 ==> (if eqnat x x2 then t2 else {x |-> s}t2))
  end

where "{ x |-> s } t" := (subst x s t). 

Inductive value : tm -> Prop :=
  | v_abs : forall x T t,
         value (\x~T, t)
  | v_inl : forall t,
         value t
      -> value (inl t)
  | v_inr : forall t,
         value t
      -> value (inr t).

Inductive eval : tm -> tm -> Prop :=
  | E_AppAbs : forall x T t12 v2,
         value v2
      -> eval ((\x~T, 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')
  | E_CaseInl : forall v0 x1 t1 x2 t2,
         value v0
      -> eval (case (inl v0) of inl x1 ==> t1 || inr x2 ==> t2) 
              ({x2|->v0}t2)
  | E_CaseInr : forall v0 x1 t1 x2 t2,
         value v0
      -> eval (case (inr v0) of inl x1 ==> t1 || inr x2 ==> t2) 
              ({x1|->v0}t2)
  | E_Case : forall t0 t0' x1 t1 x2 t2,
         eval t0 t0'
      -> eval (case t0  of inl x1 ==> t1 || inr x2 ==> t2) 
              (case t0' of inl x1 ==> t1 || inr x2 ==> t2) .

Notation context := (alist ty).
Definition empty : context := nil _.

Reserved Notation "Gamma |- t ~ T" (at level 69).

Inductive typing : context -> tm -> ty -> Prop :=
  | T_Var : forall Gamma x T,
         binds _ x T Gamma 
      -> Gamma |- (!x) ~ T
  | T_Abs : forall Gamma x T1 T2 t,
         [(x,T1)] ++ Gamma |- t ~ T2
      -> Gamma |- (\x~T1, t) ~ T1-->T2
  | T_App : forall S T Gamma t1 t2,
         Gamma |- t1 ~ (S-->T)
      -> Gamma |- t2 ~ S
      -> Gamma |- (t1 @ t2) ~ T
  | T_Inl : forall Gamma t T1 T2,
         Gamma |- t ~ T1
      -> Gamma |- inl t ~ <<T1,T2>>
  | T_Inr : forall Gamma t T1 T2,
         Gamma |- t ~ T2
      -> Gamma |- inr t ~ <<T1,T2>>
  | T_Case : forall Gamma t0 x1 t1 x2 t2 T1 T2 T,
         Gamma |- t0 ~ <<T1,T2>>
      -> [(x1,T1)] ++ Gamma |- t1 ~ T
      -> [(x2,T2)] ++ Gamma |- t2 ~ T
      -> Gamma |- (case t0 of inl x1 ==> t1 || inr x2 ==> t2) ~ T

where "Gamma |- t ~ T" := (typing Gamma t T).

Module Examples'.
Export Examples.

Lemma sum_example : 
  empty |- sum_example_tm ~ <<A,B-->A>> --> B --> A.
Proof.
  apply T_Abs. apply T_Abs. apply T_Case with (T1:=A) (T2:=B-->A).
    apply T_Var. auto.
    apply T_Var. auto.
    apply T_App with (S:=B).
      apply T_Var. auto.
      apply T_Var. auto.
Qed.

(* Note: It's hard to give *realistic* examples of programming with
   sums in the very minimal language we're dealing with here --
   convincing examples tend to involve other constructs such as
   records, in addition to sums.  Sections 11.9 and 11.10 of TAPL
   contain several such examples.

   A good (optional!) exercise is to extend the definition of the
   current language with the syntax, operational semantics, and typing
   rules for records and formalize some of these examples. *)

End Examples'.

End STLCWithSums.