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

(* ====================================================================== *)
(* LECTURE 8 *)

Require Export lec07_sol.


(* ---------------------------------------------------------------------- *)
(* A little more on induction principles *)

(* The relation between [Inductive] definitions and the corresponding
   induction principles generated for them by Coq is somewhat complex
   to describe in full generality.  It is not necessary to understand
   every detail, but let's discuss a few important points...

   The most typical example of an inductive definition is, of course,
   natural numbers:

     Inductive nat : Set :=
       | O : nat
       | S : nat -> nat.

   The corresponding induction principle that is generated by Coq...

     nat_ind : 
       forall P : nat -> Prop,
            P O
         -> (forall n : nat, P n -> P (S n)) 
         -> forall n : nat, P n

   ... can be read as follows:
      - The induction principle can be used to prove assertions about
        numbers; the type [nat->Prop] of its first argument [P]
        captures this.
      - When the induction principle is applied, the result will be a
        proof that [P] holds of all numbers; the last line says this.
      - When the induction principle is applied to some [P], two
        subgoals are generated (one for each of the constructors of
        [nat]); these are the second and third lines.

   The inductive definition of polymorphic lists

     Inductive list (X:Set) : Set :=
       | nil : list X
       | cons : X -> list X -> list X.

   is very similar.  The main difference is that, here, the whole
   definition is PARAMTERIZED on a set [X] -- i.e., we are defining a
   FAMILY of inductive types [list X], one for each [X].  Note that,
   wherever [list] appears in the body of the declaration, it is
   always applied to the parameter [X].  The induction principle is
   likewise parameterized on [X]:

     list_ind : 
       forall (X : Set) (P : list X -> Prop),
            P (nil X) 
         -> (forall (x : X) (l : list X), P l -> P (x :: l)) 
         -> forall l : list X, P l

   Note the wording here (and, accordingly, the form of [list_ind]):
   The WHOLE induction principle is parameterized on [X].  That is,
   [list_ind] can be thought of as a polymorphic function that, when
   applied to a set [X], gives us back an induction principle
   specialized to [list X]. *)

(* THOUGHT EXERCISE (not to be handed in): Write out the induction
   principles that Coq will generate for the following definitions of
   inductive sets.  Compare your answers with what Coq prints. *)
Inductive rgb : Set :=
  | red : rgb
  | green : rgb
  | blue : rgb.
Check rgb_ind.

Inductive tree (X:Set) : Set :=
  | leaf : nat -> tree X
  | node : tree X -> tree X -> tree X.
Check tree_ind.

(* THOUGHT EXERCISE (not to be handed in): Find an inductive definition
   that gives rise to the following induction principle: 
      mytype_ind :
        forall (X : Set) (P : mytype X -> Prop),
            (forall x : X, P (constr1 X x)) 
         -> (forall n : nat, P (constr2 X n)) 
         -> (forall m : mytype X, P m -> forall n : nat, P (constr3 X m n)) 
         -> forall m : mytype X, P m                                        *)
Inductive mytype (X:Set) : Set :=
  | constr1: X -> mytype X
  | constr2: nat -> mytype X
  | constr3: mytype X -> nat -> mytype X.
Check mytype_ind.

(* THOUGHT EXERCISE (not to be handed in): Find an inductive definition
   that gives rise to the following induction principle: 
      foo_ind : 
        forall (X Y : Set) (P : foo X Y -> Prop),
             (forall x : X, P (bar X Y x)) 
          -> (forall y : Y, P (baz X Y y)) 
          -> (forall f1 : nat -> foo X Y,
               (forall n : nat, P (f1 n)) -> P (quux X Y f1)) 
          -> forall f2 : foo X Y, P f2                              *)
Inductive foo (X Y:Set) : Set :=
  | bar: X -> foo X Y
  | baz: Y -> foo X Y
  | quux: (nat -> foo X Y) -> foo X Y.
Print foo_ind.

(* Here is a more interesting inductively defined family of sets:

     Inductive vector (X:Set) : nat->Set :=
       | Vnil  : vector X zero
       | Vcons : forall n:nat, X -> vector X n -> vector X (S n).

   Given a set [X] and a natural number [n], the set [vector X n]
   describes lists of length [n] whose elements are drawn from the set
   [X].  

   Note that the numeric argument to [vector] is NOT a general
   parameter: it plays different roles in the two clauses (it is
   [zero] in the type of the constructor [Vnil] and [S n] in the type
   of [Vcons]).  We call such an argument an INDEX of the inductive
   definition.  Since it is not used uniformly, it cannot be written
   as a parameter to the whole inductive definition (as [X] is).
   Instead, it becomes part of the declared "result type" of the
   inductive definition (i.e., the result type is [nat->Set], not just
   [Set]).  Thus, the first line of the declaration, [Inductive
   vector (X:Set) : nat->Set], can be read as, "For every set [X],
   declare a family of inductively defined sets (indexed by a [nat])
   as follows..."

   Terminological note: Like [list], the type [vector] is
   parameterized -- it can be thought of as a function that, when
   applied to appropriate arguments, yields a set.  Unlike [list],
   however, one of [vector]'s parameters is a VALUE, not just another
   set.  Types like this -- i.e., families of types indexed by
   values -- are generally called DEPENDENT TYPES.

   Here is the induction principle that is generated for [vector]:

     vector_ind :
       forall (X : Set) (P : forall n : nat, vector X n -> Prop),
            P zero (Vnil X) 
         -> (forall (n : nat) (x : X) (v : vector X n),
               P n v -> P (S n) (Vcons X n x v)) 
         -> forall (n : nat) (v : vector X n), P n v.

   Note that the parameter [X] and the index [n] are treated
   differently: [X] becomes a parameter to the whole induction
   principle, while [n] becomes an argument to the proposition [P]. *)

(* THOUGHT EXERCISE (not to be handed in): Here is a variant of the
   set [tree] defined above.  For each natural number [n], the type
   [htree n] describes balanced trees of height exactly [n].  Write
   out the induction principle for [htree] and compare it with what
   Coq generates. *)
Inductive htree (X:Set) : nat->Set :=
  | hleaf : nat -> htree X zero
  | hnode : forall n:nat, htree X n -> htree X n -> htree X (S n).
Check htree_ind.

(* So far, the whole discussion applies to inductively defined SETS.
   Inductively defined PROPOSITIONS are handled a little differently.
   For example, from what we've said so far, you might expect the
   inductive definition of [evenI]

     Inductive evenI : nat -> Prop :=
       | even_zero : evenI O
       | even_SS : forall n:nat, evenI n -> evenI (S (S n)).

   to give rise to an induction principle that looks like this...

     evenI_ind_max : 
       forall P : (forall n : nat, evenI n -> Prop),
            P O even_zero 
         -> (forall (n : nat) (e : evenI n), P n e -> P (S (S n)) (even_SS n e)) 
         -> forall (n : nat) (e : evenI n), P n e

   ... because:
     - Since [evenI] is indexed by a number [n] (every [evenI] object
       [e] is a piece of evidence that some particular number [n] is
       even), the proposition [P] is parameterized by both [n] and
       [e] -- that is, the induction principle can be used to prove
       assertions involving both an even number and the evidence that
       it is even.
     - Since there are two ways of giving evidence of
       evenness ([evenI] has two constructors), applying the induction
       principle generates two subgoals:
         - We must prove that [P] holds for [O] and [even_zero].
         - We must prove that, whenever [n] is an even number and [e]
           is evidence of its evenness, if [P] holds of [n] and [e],
           then it also holds of [S (S n)] and [even_SS n e].
     - If these subgoals can be proved, then the induction principle
       tells us that [P] is true for ALL even numbers [n] and evidence
       [e] of their evenness.

   But this is a little more flexibility than we actually need or
   want: it is giving us a way to prove logical assertions about
   EVIDENCE of evenness, while all we really care about is proving
   properties of numbers that are even -- we interested in assertions
   about numbers, not about evidence.  It would therefore be more
   convenient to have an induction principle for proving propositions
   [P] that are parameterized just by [n] and whose conclusion
   establishes [P] for all even numbers [n]:

       forall P : nat -> Prop,
          ...
          -> forall n : nat, evenI n -> P n

   For this reason, Coq actually generates the following simplified
   induction principle for [evenI]:

     evenI_ind : 
       forall P : nat -> Prop,
            P O
         -> (forall n : nat, evenI n -> P n -> P (S (S n))) 
         -> forall n : nat, evenI n -> P n

   Similarly, from the inductive definition of the proposition [and A B] 

     Inductive and (A B : Prop) : Prop :=
       conj : A -> B -> (and A B). 

   we might expect Coq to generate this induction principle

     and_ind_max : 
       forall (A B : Prop) (P : A /\ B -> Prop),
            (forall (a : A) (b : B), P (conj A B a b)) 
         -> forall a : A /\ B, P a
       
   but actually it generates this simpler and more useful one:

     and_ind : 
       forall A B P : Prop, 
            (A -> B -> P) 
         -> A /\ B -> P

   In the same way, when given the inductive definition of [or A B]

     Inductive or (A B : Prop) : Prop :=
       | or_introl : A -> or A B
       | or_intror : B -> or A B. 

   instead of the "maximal induction principle"

     or_ind_max : 
       forall (A B : Prop) (P : A \/ B -> Prop),
            (forall a : A, P (or_introl A B a)) 
         -> (forall b : B, P (or_intror A B b)) 
         -> forall o : A \/ B, P o

   what Coq actually generates is this:

     or_ind : 
       forall A B P : Prop, 
            (A -> P) 
         -> (B -> P) 
         -> A \/ B -> P
*)


(* ---------------------------------------------------------------------- *)
(* Relations as propositions *)

(* A proposition parameterized over a number (like [evenI]) can be
   thought of as a PREDICATE -- i.e., the subset of [nat] for which
   the proposition is provable.

   A two-argument proposition can be thought of as a RELATION -- i.e.,
   the set of pairs for which the proposition is provable. *)

(* For example, here is the "less than or equal" relation on numbers. *)
Inductive le (n:nat) : nat -> Prop :=
  | le_n : le n n
  | le_S : forall m:nat, (le n m) -> (le n (S m)).

Notation "m <= n" := (le m n).

(* Note that the left-hand argument [n] to [le] is the same everywhere
   in the definition, so we've made it a general parameter.  This
   leads to a simpler induction principle. *)

(* THOUGHT EXERCISE: Print out the induction principle for [le] and
   check that you understand it.  Then try redefining [le] with [n] as
   an index rather than a general parameter (i.e., write the first
   line as [Inductive le : nat -> nat -> Prop]) and check how the
   generated induction principle changes. *)
Inductive le': nat -> nat -> Prop :=
  | le_n' : forall n:nat, le' n n
  | le_S' : forall n m:nat, (le' n m) -> (le' n (S m)).
Check le'_ind.

(* Some sanity checks on the definition.  (Notice that, although these
   are the same kind of simple "unit tests" as we gave for the testing
   functions we wrote in the first few lectures, we must construct
   their proofs explicitly -- [simpl] doesn't do the job for us. *)
Lemma check_le1 : 
  three <= three.
Proof.
  apply le_n.
Qed.
Lemma check_le2 : 
  three <= six.
Proof.
  apply le_S. apply le_S. apply le_S. apply le_n.
Qed.
Lemma check_le3 : 
  ~ (two <= one).
Proof.
  intros H. inversion H. inversion H1.
Qed.

(* The "strictly less than" relation [n < m] can now be defined on top
   of [le]. *)
Definition lt (n m:nat) := le (S n) m.

Notation "m < n" := (lt m n).

(* Here are a few more simple relations on numbers *)

Inductive square_of : nat -> nat -> Prop :=
  sq : forall n:nat, square_of n (times n n).

Inductive next_nat (n:nat) : nat -> Prop :=
  | nn : next_nat n (S n).

Inductive next_even (n:nat) : nat -> Prop :=
  | ne_1 : evenI (S n) -> next_even n (S n)
(*  | ne_2 : evenI (S (S n)) -> next_even n (S (S n)). *)
  | ne_2 : evenI n -> next_even n (S (S n)).    

(* EXERCISE: define an inductive relation [total_relation] that holds
   between every pair of natural numbers. *)
Inductive total_relation (m n:nat): Prop :=
  | tr : total_relation m n.
Check tr.

(* EXERCISE: define an inductive relation [empty_relation] (on
   numbers) that never holds. *)
Inductive empty_relation (m n:nat): Prop :=.

(* ---------------------------------------------------------------------- *)
(* Relations, in general *)

(* We've now defined a few particular relations.  As you may remember
   from an undergraduate discrete math course, there are a lot of ways
   of discussing and describing relations *in general* -- ways of
   classifying relations (are they reflexive, transitive, etc.),
   theorems that can be proved generically about classes of relations,
   constructions that build one relation from another, etc.  Let us
   pause here to review a few of these that will be useful in what
   follows. *)

(* A RELATION on a set [X] is a proposition parameterized by two
   [X]s -- i.e., it is a logical assertion involving two values from
   the set [X]. *)
Definition relation (X: Set) := X->X->Prop.

(* A relation [R] on a set [X] is a PARTIAL FUNCTION if, for every [x
   : X], there is at most one [y] such that [R x y] -- or, to put it
   differently, if [R x y1] and [R x y2] together imply [y1 = y2]. *)
Definition partial_function (X: Set) (R: relation X) := 
  forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2.

Lemma le_not_a_partial_function : 
  ~ (partial_function _ le).
Proof.
  unfold not. unfold partial_function. intros H.
  assert (zero <= one) as A01.
    Case "Proof of assertion". apply le_S. apply le_n.
  assert (zero <= two) as A02.
    Case "Proof of assertion". apply le_S. apply le_S. apply le_n.
  assert (one = two) as Nonsense.
    Case "Proof of assertion". apply H with (x:=zero) (y1:=one) (y2:=two).
      apply A01. apply A02.
  inversion Nonsense.
Qed.

(* EXERCISE: Show that the [total_relation] you defined above is not a
   partial function, but that [empty_relation] is. *)
Lemma tr_not_a_partial_function : 
  ~ (partial_function _ total_relation).
Proof.
  unfold not. unfold partial_function. intros H.
  assert (total_relation zero one) as A01.
    Case "Proof of assertion". apply tr.
  assert (total_relation zero two) as A02.
    Case "Proof of assertion". apply tr.
  assert (one = two) as Nonsense.
    Case "Proof of assertion". apply H with (x:=zero) (y1:=one) (y2:=two).
      apply A01. apply A02.
  inversion Nonsense.
Qed.

Lemma er_a_partial_function : 
  (partial_function _ empty_relation).
Proof.
  unfold partial_function. intros.
  inversion H.
Qed.  

Definition reflexive (X: Set) (R: relation X) := 
  forall a : X, R a a.

Lemma le_reflexive : 
  reflexive _ le.
Proof.
  unfold reflexive. intros n. apply le_n.
Qed.

Definition symmetric (X: Set) (R: relation X) := 
  forall a b : X, (R a b) -> (R b a).

Lemma le_not_symmetric : 
  ~ (symmetric _ le).
Proof.
unfold symmetric. red. intros.
assert (one <= zero). apply H. constructor. constructor.
inversion H0.
Qed.

Definition antisymmetric (X: Set) (R: relation X) := 
  forall a b : X, (R a b) -> (R b a) -> a = b.

(* Wei: A helper lemma
   I was right! It turns out that in lec09 the antisymmetric property and the transitivity property
   are swapped because the transitivy property makes [le_antisymmetric] easier to prove!
*) 
Lemma le_s : forall m n, (S m <= S n) -> m <= n.
  intros. generalize dependent m.
  (* Wei: because the le relation only reduces the RHS, we do induction on n *)
  induction n; inversion 1; try clear H0 m0.
  (* the easy case in the base step *)
  constructor.
  (* the absurd case in the base step *)
  inversion H1.
  
  (* the induction step, has already been divided into two cases by the previous inversion *)
  (* the easy case *)
  constructor.
  (* the hard case, further case analysis! *) inversion H1.
    constructor. constructor. clear H0 H m0.
    constructor. exact (IHn m H1).
Qed.  
  
Lemma le_antisymmetric : 
  antisymmetric _ le.
Proof.
red.
induction a; intros.
inversion H0. trivial.
destruct b. inversion H.
assert (a = b -> S a = S b) as S_inj''. intros. rewrite H1. trivial. apply S_inj''.
apply IHa; clear IHa S_inj'';
apply le_s; trivial.
Qed.

Definition transitive (X: Set) (R: relation X) := 
  forall a b c : X, (R a b) -> (R b c) -> (R a c).

Lemma le_transitive : 
  transitive _ le.
Proof.
  intros m n o Hmn Hno.
  induction Hno.
    apply Hmn.
    apply le_S. apply IHHno. 
Qed.

Lemma lt_transitive : 
  transitive _ lt.
Proof.
  (* Prove this by induction on evidence that [n] is less than [o] *)
  unfold lt. unfold transitive.
  intros m n o Hmn Hno.
  induction Hno; constructor; trivial.
Qed.

Lemma lt_transitive' : 
  transitive _ lt.
Proof.
  (* Prove the same thing again by induction on [o] *)
  unfold lt. unfold transitive.
  intros m n o Hmn Hno.
  induction o; inversion Hno.
  rewrite H0 in Hmn. constructor. trivial.
  apply IHo in H0. constructor. trivial.
Qed.  

Definition equivalence (X:Set) (R: relation X) :=
  (reflexive _ R) /\ (symmetric _ R) /\ (transitive _ R). 

Definition partial_order (X:Set) (R: relation X) :=
  (reflexive _ R) /\ (antisymmetric _ R) /\ (transitive _ R). 

Definition preorder (X:Set) (R: relation X) :=
  (reflexive _ R) /\ (transitive _ R). 

Lemma le_preorder : 
  preorder _ le.
Proof.
  unfold preorder. apply conj.
    Case "refl". apply le_reflexive. 
    Case "trans". apply le_transitive. 
Qed.

Inductive refl_trans_closure (X:Set) (R: relation X) : X -> X -> Prop :=
  | rtc_R     : forall (x y : X), R x y -> refl_trans_closure X R x y
  | rtc_refl  : forall (x : X), 
                 refl_trans_closure X R x x
  | rtc_trans : forall (x y z : X), 
                    refl_trans_closure X R x y
                 -> refl_trans_closure X R y z
                 -> refl_trans_closure X R x z.


Definition preserves (X: Set) (R: relation X) (P: X->Prop) :=
  forall (x y : X), P x -> R x y -> P y.

Lemma rtc_preserves : forall (X: Set) (R: relation X) (P: X->Prop),
  preserves _ R P -> preserves _ (refl_trans_closure _ R) P.  
Proof.
unfold preserves.
intros.
induction H1;
try apply H with (x:=x) (y:=y); intuition.
Qed.

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

Module SimpleArithEval.
(* Import SimpleArith. *) Export SimpleArith. (* from lec05 *)

(* Wei: The definition here is a small-step opsem.
   Here is a big-step opsem:
Inductive eval' : tm -> tm -> Prop :=
  | E_Const: forall n, eval (tm_const n) (tm_const n)
  | E_Plus: forall t1 t2 n1 n2,
    eval t1 (tm_const n1) -> eval t2 (tm_const n2)
    -> eval (tm_plus t1 t2) (tm_const (plus n1 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 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]? *)
Check eval_ind.

(* Formally, [Theorem] means the same as [Lemma].  Calling something a
   [Theorem] is a signal to the reader that the assertion being proved
   is a particularly important or interesting one. *)
Theorem eval_preserves_interp : forall t t',
     eval t t' 
  -> interp t = interp t'.
Proof.
  intros t t' E. induction E.
    Case "E_PlusConstConst". reflexivity.
    Case "EPlus1". simpl. rewrite -> IHE. reflexivity.
    Case "E_Plus2". simpl. rewrite -> IHE. reflexivity.
Qed.

(* OPTIONAL EXERCISE: Is the word "preserves" in the name of this
   lemma being used in precisely the same sense as we did earlier?
   That is, can the statement of the lemma be written using the formal
   term [preserves] that we defined above?  If yes, do so and provide
   a proof.  If no, explain why not. *)
Theorem eval_preserves_interp_take2 : forall n,
     preserves _ eval (fun t => interp t = n).
Proof.
  intros n. unfold preserves. intros t t' H1 H2. rewrite <- H1.
  apply eq_symm. apply eval_preserves_interp. apply H2.
Qed.

Definition deterministic (X: Set) (R: relation X) :=
  partial_function X R.

Theorem eval_deterministic : 
  deterministic _ eval.
Proof.
  unfold deterministic. 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.