(** * ProofObjects: The Curry-Howard Correspondence *)

Set Warnings "-notation-overridden,-parsing".
From LF Require Export IndProp.

(** "_Algorithms are the computational content of proofs_."  --Robert Harper *)

(** We have seen that Coq has mechanisms both for _programming_,
    using inductive data types like [nat] or [list] and functions over
    these types, and for _proving_ properties of these programs, using
    inductive propositions (like [even]), implication, universal
    quantification, and the like.  So far, we have mostly treated
    these mechanisms as if they were quite separate, and for many
    purposes this is a good way to think.  But we have also seen hints
    that Coq's programming and proving facilities are closely related.
    For example, the keyword [Inductive] is used to declare both data
    types and propositions, and [->] is used both to describe the type
    of functions on data and logical implication.  This is not just a
    syntactic accident!  In fact, programs and proofs in Coq are
    almost the same thing.  In this chapter we will study how this
    works.

    We have already seen the fundamental idea: provability in Coq is
    represented by concrete _evidence_.  When we construct the proof
    of a basic proposition, we are actually building a tree of
    evidence, which can be thought of as a data structure.

    If the proposition is an implication like [A -> B], then its proof
    will be an evidence _transformer_: a recipe for converting
    evidence for A into evidence for B.  So at a fundamental level,
    proofs are simply programs that manipulate evidence. *)

(** Question: If evidence is data, what are propositions themselves?

    Answer: They are types! *)

(** Look again at the formal definition of the [even] property.  *)

Print even.
(* ==>
  Inductive even : nat -> Prop :=
    | ev_0 : even 0
    | ev_SS : forall n, even n -> even (S (S n)).
*)

(** Suppose we introduce an alternative pronunciation of "[:]".
    Instead of "has type," we can say "is a proof of."  For example,
    the second line in the definition of [even] declares that [ev_0 : even
    0].  Instead of "[ev_0] has type [even 0]," we can say that "[ev_0]
    is a proof of [even 0]." *)

(** This pun between types and propositions -- between [:] as "has type"
    and [:] as "is a proof of" or "is evidence for" -- is called the
    _Curry-Howard correspondence_.  It proposes a deep connection
    between the world of logic and the world of computation:

                 propositions  ~  types
                 proofs        ~  data values

    See [Wadler 2015] (in Bib.v) for a brief history and up-to-date exposition. *)

(** Many useful insights follow from this connection.  To begin with,
    it gives us a natural interpretation of the type of the [ev_SS]
    constructor: *)

Check ev_SS.
(* ===> ev_SS : forall n,
                  even n ->
                  even (S (S n)) *)

(** This can be read "[ev_SS] is a constructor that takes two
    arguments -- a number [n] and evidence for the proposition [even
    n] -- and yields evidence for the proposition [even (S (S n))]." *)

(** Now let's look again at a previous proof involving [even]. *)

Theorem ev_4 : even 4.
Proof.
  apply ev_SS. apply ev_SS. apply ev_0. Qed.

(** As with ordinary data values and functions, we can use the [Print]
    command to see the _proof object_ that results from this proof
    script. *)

Print ev_4.
(* ===> ev_4 = ev_SS 2 (ev_SS 0 ev_0)
     : even 4  *)

(** Indeed, we can also write down this proof object _directly_,
    without the need for a separate proof script: *)

Check (ev_SS 2 (ev_SS 0 ev_0)).
(* ===> even 4 *)

(** The expression [ev_SS 2 (ev_SS 0 ev_0)] can be thought of as
    instantiating the parameterized constructor [ev_SS] with the
    specific arguments [2] and [0] plus the corresponding proof
    objects for its premises [even 2] and [even 0].  Alternatively, we can
    think of [ev_SS] as a primitive "evidence constructor" that, when
    applied to a particular number, wants to be further applied to
    evidence that that number is even; its type,

      forall n, even n -> even (S (S n)),

    expresses this functionality, in the same way that the polymorphic
    type [forall X, list X] expresses the fact that the constructor
    [nil] can be thought of as a function from types to empty lists
    with elements of that type. *)

(** We saw in the [Logic] chapter that we can use function
    application syntax to instantiate universally quantified variables
    in lemmas, as well as to supply evidence for assumptions that
    these lemmas impose.  For instance: *)

Theorem ev_4': even 4.
Proof.
  apply (ev_SS 2 (ev_SS 0 ev_0)).
Qed.

(* ################################################################# *)
(** * Proof Scripts *)

(** The _proof objects_ we've been discussing lie at the core of how
    Coq operates.  When Coq is following a proof script, what is
    happening internally is that it is gradually constructing a proof
    object -- a term whose type is the proposition being proved.  The
    tactics between [Proof] and [Qed] tell it how to build up a term
    of the required type.  To see this process in action, let's use
    the [Show Proof] command to display the current state of the proof
    tree at various points in the following tactic proof. *)

Theorem ev_4'' : even 4.
Proof.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_0.
  Show Proof.
Qed.

(** At any given moment, Coq has constructed a term with a
    "hole" (indicated by [?Goal] here, and so on), and it knows what
    type of evidence is needed to fill this hole.

    Each hole corresponds to a subgoal, and the proof is
    finished when there are no more subgoals.  At this point, the
    evidence we've built stored in the global context under the name
    given in the [Theorem] command. *)

(** Tactic proofs are useful and convenient, but they are not
    essential: in principle, we can always construct the required
    evidence by hand, as shown above. Then we can use [Definition]
    (rather than [Theorem]) to give a global name directly to this
    evidence. *)

Definition ev_4''' : even 4 :=
  ev_SS 2 (ev_SS 0 ev_0).

(** All these different ways of building the proof lead to exactly the
    same evidence being saved in the global environment. *)

Print ev_4.
(* ===> ev_4    =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
Print ev_4'.
(* ===> ev_4'   =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
Print ev_4''.
(* ===> ev_4''  =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
Print ev_4'''.
(* ===> ev_4''' =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)

(** **** Exercise: 2 stars, standard (eight_is_even)

    Give a tactic proof and a proof object showing that [even 8]. *)

Theorem ev_8 : even 8.
Proof.
  (* FILL IN HERE *) Admitted.

Definition ev_8' : even 8
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
(** [] *)

(* ################################################################# *)
(** * Quantifiers, Implications, Functions *)

(** In Coq's computational universe (where data structures and
    programs live), there are two sorts of values with arrows in their
    types: _constructors_ introduced by [Inductive]ly defined data
    types, and _functions_.

    Similarly, in Coq's logical universe (where we carry out proofs),
    there are two ways of giving evidence for an implication:
    constructors introduced by [Inductive]ly defined propositions,
    and... functions! *)

(** For example, consider this statement: *)

Theorem ev_plus4 : forall n, even n -> even (4 + n).
Proof.
  intros n H. simpl.
  apply ev_SS.
  apply ev_SS.
  apply H.
Qed.

(** What is the proof object corresponding to [ev_plus4]?

    We're looking for an expression whose _type_ is [forall n, even n ->
    even (4 + n)] -- that is, a _function_ that takes two arguments (one
    number and a piece of evidence) and returns a piece of evidence!

    Here it is: *)

Definition ev_plus4' : forall n, even n -> even (4 + n) :=
  fun (n : nat) => fun (H : even n) =>
    ev_SS (S (S n)) (ev_SS n H).

(** Recall that [fun n => blah] means "the function that, given [n],
    yields [blah]," and that Coq treats [4 + n] and [S (S (S (S n)))]
    as synonyms. Another equivalent way to write this definition is: *)

Definition ev_plus4'' (n : nat) (H : even n)
                    : even (4 + n) :=
  ev_SS (S (S n)) (ev_SS n H).

Check ev_plus4''.
(* ===>
     : forall n : nat, even n -> even (4 + n) *)

(** When we view the proposition being proved by [ev_plus4] as a
    function type, one interesting point becomes apparent: The second
    argument's type, [even n], mentions the _value_ of the first
    argument, [n].

    While such _dependent types_ are not found in conventional
    programming languages, they can be useful in programming too, as
    the recent flurry of activity in the functional programming
    community demonstrates. *)

(** Notice that both implication ([->]) and quantification ([forall])
    correspond to functions on evidence.  In fact, they are really the
    same thing: [->] is just a shorthand for a degenerate use of
    [forall] where there is no dependency, i.e., no need to give a
    name to the type on the left-hand side of the arrow:

           forall (x:nat), nat
        =  forall (_:nat), nat
        =  nat -> nat
*)

(** For example, consider this proposition: *)

Definition ev_plus2 : Prop :=
  forall n, forall (E : even n), even (n + 2).

(** A proof term inhabiting this proposition would be a function
    with two arguments: a number [n] and some evidence [E] that [n] is
    even.  But the name [E] for this evidence is not used in the rest
    of the statement of [ev_plus2], so it's a bit silly to bother
    making up a name for it.  We could write it like this instead,
    using the dummy identifier [_] in place of a real name: *)

Definition ev_plus2' : Prop :=
  forall n, forall (_ : even n), even (n + 2).

(** Or, equivalently, we can write it in more familiar notation: *)

Definition ev_plus2'' : Prop :=
  forall n, even n -> even (n + 2).

(** In general, "[P -> Q]" is just syntactic sugar for
    "[forall (_:P), Q]". *)

(* ################################################################# *)
(** * Programming with Tactics *)

(** If we can build proofs by giving explicit terms rather than
    executing tactic scripts, you may be wondering whether we can
    build _programs_ using _tactics_ rather than explicit terms.
    Naturally, the answer is yes! *)

Definition add1 : nat -> nat.
intro n.
Show Proof.
apply S.
Show Proof.
apply n. Defined.

Print add1.
(* ==>
    add1 = fun n : nat => S n
         : nat -> nat
*)

Compute add1 2.
(* ==> 3 : nat *)

(** Notice that we terminate the [Definition] with a [.] rather than
    with [:=] followed by a term.  This tells Coq to enter _proof
    scripting mode_ to build an object of type [nat -> nat].  Also, we
    terminate the proof with [Defined] rather than [Qed]; this makes
    the definition _transparent_ so that it can be used in computation
    like a normally-defined function.  ([Qed]-defined objects are
    opaque during computation.)

    This feature is mainly useful for writing functions with dependent
    types, which we won't explore much further in this book.  But it
    does illustrate the uniformity and orthogonality of the basic
    ideas in Coq. *)

(* ################################################################# *)
(** * Logical Connectives as Inductive Types *)

(** Inductive definitions are powerful enough to express most of the
    connectives we have seen so far.  Indeed, only universal
    quantification (with implication as a special case) is built into
    Coq; all the others are defined inductively.  We'll see these
    definitions in this section. *)

Module Props.

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

(** To prove that [P /\ Q] holds, we must present evidence for both
    [P] and [Q].  Thus, it makes sense to define a proof object for [P
    /\ Q] as consisting of a pair of two proofs: one for [P] and
    another one for [Q]. This leads to the following definition. *)

Module And.

Inductive and (P Q : Prop) : Prop :=
| conj : P -> Q -> and P Q.

End And.

(** Notice the similarity with the definition of the [prod] type,
    given in chapter [Poly]; the only difference is that [prod] takes
    [Type] arguments, whereas [and] takes [Prop] arguments. *)

Print prod.
(* ===>
   Inductive prod (X Y : Type) : Type :=
   | pair : X -> Y -> X * Y. *)

(** This similarity should clarify why [destruct] and [intros]
    patterns can be used on a conjunctive hypothesis.  Case analysis
    allows us to consider all possible ways in which [P /\ Q] was
    proved -- here just one (the [conj] constructor).

    Similarly, the [split] tactic actually works for any inductively
    defined proposition with exactly one constructor.  In particular,
    it works for [and]: *)

Lemma and_comm : forall P Q : Prop, P /\ Q <-> Q /\ P.
Proof.
  intros P Q. split.
  - intros [HP HQ]. split.
    + apply HQ.
    + apply HP.
  - intros [HP HQ]. split.
    + apply HQ.
    + apply HP.
Qed.

(** This shows why the inductive definition of [and] can be
    manipulated by tactics as we've been doing.  We can also use it to
    build proofs directly, using pattern-matching.  For instance: *)

Definition and_comm'_aux P Q (H : P /\ Q) : Q /\ P :=
  match H with
  | conj HP HQ => conj HQ HP
  end.

Definition and_comm' P Q : P /\ Q <-> Q /\ P :=
  conj (and_comm'_aux P Q) (and_comm'_aux Q P).

(** **** Exercise: 2 stars, standard, optional (conj_fact)

    Construct a proof object demonstrating the following proposition. *)

Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
(** [] *)

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

(** The inductive definition of disjunction uses two constructors, one
    for each side of the disjunct: *)

Module Or.

Inductive or (P Q : Prop) : Prop :=
| or_introl : P -> or P Q
| or_intror : Q -> or P Q.

End Or.

(** This declaration explains the behavior of the [destruct] tactic on
    a disjunctive hypothesis, since the generated subgoals match the
    shape of the [or_introl] and [or_intror] constructors.

    Once again, we can also directly write proof objects for theorems
    involving [or], without resorting to tactics. *)

(** **** Exercise: 2 stars, standard, optional (or_commut'')

    Try to write down an explicit proof object for [or_commut] (without
    using [Print] to peek at the ones we already defined!). *)

Definition or_comm : forall P Q, P \/ Q -> Q \/ P
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
(** [] *)

(* ================================================================= *)
(** ** Existential Quantification *)

(** To give evidence for an existential quantifier, we package a
    witness [x] together with a proof that [x] satisfies the property
    [P]: *)

Module Ex.

Inductive ex {A : Type} (P : A -> Prop) : Prop :=
| ex_intro : forall x : A, P x -> ex P.

End Ex.

(** This may benefit from a little unpacking.  The core definition is
    for a type former [ex] that can be used to build propositions of
    the form [ex P], where [P] itself is a _function_ from witness
    values in the type [A] to propositions.  The [ex_intro]
    constructor then offers a way of constructing evidence for [ex P],
    given a witness [x] and a proof of [P x]. *)

(** The more familiar form [exists x, P x] desugars to an expression
    involving [ex]: *)

Check ex (fun n => even n).
(* ===> exists n : nat, even n
        : Prop *)

(** Here's how to define an explicit proof object involving [ex]: *)

Definition some_nat_is_even : exists n, even n :=
  ex_intro even 4 (ev_SS 2 (ev_SS 0 ev_0)).

(** **** Exercise: 2 stars, standard, optional (ex_ev_Sn)

    Complete the definition of the following proof object: *)

Definition ex_ev_Sn : ex (fun n => even (S n))
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
(** [] *)

(* ================================================================= *)
(** ** [True] and [False] *)

(** The inductive definition of the [True] proposition is simple: *)

Inductive True : Prop :=
  | I : True.

(** It has one constructor (so every proof of [True] is the same, so
    being given a proof of [True] is not informative.) *)

(** [False] is equally simple -- indeed, so simple it may look
    syntactically wrong at first glance! *)

Inductive False : Prop := .

(** That is, [False] is an inductive type with _no_ constructors --
    i.e., no way to build evidence for it. *)

End Props.

(* ################################################################# *)
(** * Equality *)

(** Even Coq's equality relation is not built in.  It has the
    following inductive definition.  (Actually, the definition in the
    standard library is a slight variant of this, which gives an
    induction principle that is slightly easier to use.) *)

Module MyEquality.

Inductive eq {X:Type} : X -> X -> Prop :=
| eq_refl : forall x, eq x x.

Notation "x == y" := (eq x y)
                    (at level 70, no associativity)
                    : type_scope.

(** The way to think about this definition is that, given a set [X],
    it defines a _family_ of propositions "[x] is equal to [y],"
    indexed by pairs of values ([x] and [y]) from [X].  There is just
    one way of constructing evidence for members of this family:
    applying the constructor [eq_refl] to a type [X] and a single
    value [x : X], which yields evidence that [x] is equal to [x].

    Other types of the form [eq x y] where [x] and [y] are not the
    same are thus uninhabited. *)

(** We can use [eq_refl] to construct evidence that, for example, [2 =
    2].  Can we also use it to construct evidence that [1 + 1 = 2]?
    Yes, we can.  Indeed, it is the very same piece of evidence!

    The reason is that Coq treats as "the same" any two terms that are
    _convertible_ according to a simple set of computation rules.

    These rules, which are similar to those used by [Compute], include
    evaluation of function application, inlining of definitions, and
    simplification of [match]es.  *)

Lemma four: 2 + 2 == 1 + 3.
Proof.
  apply eq_refl.
Qed.

(** The [reflexivity] tactic that we have used to prove equalities up
    to now is essentially just shorthand for [apply eq_refl].

    In tactic-based proofs of equality, the conversion rules are
    normally hidden in uses of [simpl] (either explicit or implicit in
    other tactics such as [reflexivity]).

    But you can see them directly at work in the following explicit
    proof objects: *)

Definition four' : 2 + 2 == 1 + 3 :=
  eq_refl 4.

Definition singleton : forall (X:Type) (x:X), []++[x] == x::[]  :=
  fun (X:Type) (x:X) => eq_refl [x].

(** **** Exercise: 2 stars, standard (equality__leibniz_equality)

    The inductive definition of equality implies _Leibniz equality_:
    what we mean when we say "[x] and [y] are equal" is that every
    property on [P] that is true of [x] is also true of [y].  *)

Lemma equality__leibniz_equality : forall (X : Type) (x y: X),
  x == y -> forall P:X->Prop, P x -> P y.
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 5 stars, standard, optional (leibniz_equality__equality)

    Show that, in fact, the inductive definition of equality is
    _equivalent_ to Leibniz equality: *)

Lemma leibniz_equality__equality : forall (X : Type) (x y: X),
  (forall P:X->Prop, P x -> P y) -> x == y.
Proof.
(* FILL IN HERE *) Admitted.

(** [] *)

End MyEquality.

(* ================================================================= *)
(** ** Inversion, Again *)

(** We've seen [inversion] used with both equality hypotheses and
    hypotheses about inductively defined propositions.  Now that we've
    seen that these are actually the same thing, we're in a position
    to take a closer look at how [inversion] behaves.

    In general, the [inversion] tactic...

    - takes a hypothesis [H] whose type [P] is inductively defined,
      and

    - for each constructor [C] in [P]'s definition,

      - generates a new subgoal in which we assume [H] was
        built with [C],

      - adds the arguments (premises) of [C] to the context of
        the subgoal as extra hypotheses,

      - matches the conclusion (result type) of [C] against the
        current goal and calculates a set of equalities that must
        hold in order for [C] to be applicable,

      - adds these equalities to the context (and, for convenience,
        rewrites them in the goal), and

      - if the equalities are not satisfiable (e.g., they involve
        things like [S n = O]), immediately solves the subgoal. *)

(** _Example_: If we invert a hypothesis built with [or], there are
    two constructors, so two subgoals get generated.  The
    conclusion (result type) of the constructor ([P \/ Q]) doesn't
    place any restrictions on the form of [P] or [Q], so we don't get
    any extra equalities in the context of the subgoal. *)

(** _Example_: If we invert a hypothesis built with [and], there is
    only one constructor, so only one subgoal gets generated.  Again,
    the conclusion (result type) of the constructor ([P /\ Q]) doesn't
    place any restrictions on the form of [P] or [Q], so we don't get
    any extra equalities in the context of the subgoal.  The
    constructor does have two arguments, though, and these can be seen
    in the context in the subgoal. *)

(** _Example_: If we invert a hypothesis built with [eq], there is
    again only one constructor, so only one subgoal gets generated.
    Now, though, the form of the [eq_refl] constructor does give us
    some extra information: it tells us that the two arguments to [eq]
    must be the same!  The [inversion] tactic adds this fact to the
    context. *)

(* Wed Jan 9 12:02:45 EST 2019 *)


(** * MoreCoq: More About Coq *)

Require Export Poly.

(** This chapter introduces several more Coq tactics that,
    together, allow us to prove many more theorems about the
    functional programs we are writing. *)

(* ###################################################### *)
(** * The [apply] Tactic *)

(** We often encounter situations where the goal to be proved is
    exactly the same as some hypothesis in the context or some
    previously proved lemma. *)

Theorem silly1 : forall (n m o p : nat),
     n = m  ->
     [n;o] = [n;p] ->
     [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  rewrite <- eq1.
  (* At this point, we could finish with
     "[rewrite -> eq2. reflexivity.]" as we have
     done several times above. But we can achieve the
     same effect in a single step by using the
     [apply] tactic instead: *)
  apply eq2.  Qed.

(** The [apply] tactic also works with _conditional_ hypotheses
    and lemmas: if the statement being applied is an implication, then
    the premises of this implication will be added to the list of
    subgoals needing to be proved. *)

Theorem silly2 : forall (n m o p : nat),
     n = m  ->
     (forall (q r : nat), q = r -> [q;o] = [r;p]) ->
     [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  apply eq2. apply eq1.  Abort.

(** You may find it instructive to experiment with this proof
    and see if there is a way to complete it using just [rewrite]
    instead of [apply]. *)

Theorem silly2 : forall (n m o p : nat),
     n = m  ->
     (forall (q r : nat), q = r -> [q;o] = [r;p]) ->
     [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  assert (n = m -> [n;o] = [m;p]).
    rewrite (eq2 n m). reflexivity.
    rewrite eq1. reflexivity.
  rewrite (H eq1). reflexivity.
Qed.

(** Typically, when we use [apply H], the statement [H] will
    begin with a [forall] binding some _universal variables_.  When
    Coq matches the current goal against the conclusion of [H], it
    will try to find appropriate values for these variables.  For
    example, when we do [apply eq2] in the following proof, the
    universal variable [q] in [eq2] gets instantiated with [n] and [r]
    gets instantiated with [m]. *)

Theorem silly2a : forall (n m : nat),
     (n,n) = (m,m)  ->
     (forall (q r : nat), (q,q) = (r,r) -> [q] = [r]) ->
     [n] = [m].
Proof.
  intros n m eq1 eq2.
  apply eq2. apply eq1.  Qed.

(** **** Exercise: 2 stars, optional (silly_ex) *)
(** Complete the following proof without using [simpl]. *)

Theorem silly_ex :
     (forall n, evenb n = true -> oddb (S n) = true) ->
     evenb 3 = true ->
     oddb 4 = true.
Proof.
  intros H. apply H.
Qed.
(** [] *)

(** To use the [apply] tactic, the (conclusion of the) fact
    being applied must match the goal _exactly_ -- for example, [apply]
    will not work if the left and right sides of the equality are
    swapped. *)

Theorem silly3_firsttry : forall (n : nat),
     true = beq_nat n 5  ->
     beq_nat (S (S n)) 7 = true.
Proof.
  intros n H.
  simpl.
  (* Here we cannot use [apply] directly *)
Abort.

(** In this case we can use the [symmetry] tactic, which switches the
    left and right sides of an equality in the goal. *)

Theorem silly3 : forall (n : nat),
     true = beq_nat n 5  ->
     beq_nat (S (S n)) 7 = true.
Proof.
  intros n H.
  symmetry.
  simpl. (* Actually, this [simpl] is unnecessary, since
            [apply] will do a [simpl] step first. *)
  apply H.  Qed.

(** **** Exercise: 3 stars (apply_exercise1) *)
(** Hint: you can use [apply] with previously defined lemmas, not
    just hypotheses in the context.  Remember that [SearchAbout] is
    your friend. *)

Theorem rev_exercise1 : forall (l l' : list nat),
     l = rev l' ->
     l' = rev l.
Proof.
  intros l l' H. rewrite H.
  symmetry. apply rev_involutive.
Qed.
(** [] *)

(** **** Exercise: 1 star, optional (apply_rewrite) *)
(** Briefly explain the difference between the tactics [apply] and
    [rewrite].  Are there situations where both can usefully be
    applied?

 - apply: trys to simplify first, and applies hypothesis / lemma to the goal.
     requires exact match. might need to prove preconditions afterwards.
 - rewrite: can rewrite using a hypothesis / lemma both from left to right
     and from right to left. it can be use to rewrite only a portion of the conclusion
     does less thing than "apply".

*)
(** [] *)

(* ###################################################### *)
(** * The [apply ... with ...] Tactic *)

(** The following silly example uses two rewrites in a row to
    get from [[a,b]] to [[e,f]]. *)

Example trans_eq_example : forall (a b c d e f : nat),
     [a;b] = [c;d] ->
     [c;d] = [e;f] ->
     [a;b] = [e;f].
Proof.
  intros a b c d e f eq1 eq2.
  rewrite -> eq1. rewrite -> eq2. reflexivity.  Qed.

(** Since this is a common pattern, we might
    abstract it out as a lemma recording once and for all
    the fact that equality is transitive. *)

Theorem trans_eq : forall (X:Type) (n m o : X),
  n = m -> m = o -> n = o.
Proof.
  intros X n m o eq1 eq2. rewrite -> eq1. rewrite -> eq2.
  reflexivity.  Qed.

(** Now, we should be able to use [trans_eq] to
    prove the above example.  However, to do this we need
    a slight refinement of the [apply] tactic. *)

Example trans_eq_example' : forall (a b c d e f : nat),
     [a;b] = [c;d] ->
     [c;d] = [e;f] ->
     [a;b] = [e;f].
Proof.
  intros a b c d e f eq1 eq2.
  (* If we simply tell Coq [apply trans_eq] at this point,
     it can tell (by matching the goal against the
     conclusion of the lemma) that it should instantiate [X]
     with [[nat]], [n] with [[a,b]], and [o] with [[e,f]].
     However, the matching process doesn't determine an
     instantiation for [m]: we have to supply one explicitly
     by adding [with (m:=[c,d])] to the invocation of
     [apply]. *)
  apply trans_eq with (m:=[c;d]). apply eq1. apply eq2.   Qed.

(**  Actually, we usually don't have to include the name [m]
    in the [with] clause; Coq is often smart enough to
    figure out which instantiation we're giving. We could
    instead write: [apply trans_eq with [c,d]]. *)

(** **** Exercise: 3 stars, optional (apply_with_exercise) *)
Example trans_eq_exercise : forall (n m o p : nat),
     m = (minustwo o) ->
     (n + p) = m ->
     (n + p) = (minustwo o).
Proof.
  intros n m o p eq1 eq2.
  apply trans_eq with m. apply eq2. apply eq1.
Qed.
(** [] *)

(* ###################################################### *)
(** * The [inversion] tactic *)

(** Recall the definition of natural numbers:
     Inductive nat : Type :=
       | O : nat
       | S : nat -> nat.
    It is clear from this definition that every number has one of two
    forms: either it is the constructor [O] or it is built by applying
    the constructor [S] to another number.  But there is more here than
    meets the eye: implicit in the definition (and in our informal
    understanding of how datatype declarations work in other
    programming languages) are two other facts:

    - The constructor [S] is _injective_.  That is, the only way we can
      have [S n = S m] is if [n = m].

    - The constructors [O] and [S] are _disjoint_.  That is, [O] is not
      equal to [S n] for any [n]. *)

(** Similar principles apply to all inductively defined types: all
    constructors are injective, and the values built from distinct
    constructors are never equal.  For lists, the [cons] constructor is
    injective and [nil] is different from every non-empty list.  For
    booleans, [true] and [false] are unequal.  (Since neither [true]
    nor [false] take any arguments, their injectivity is not an issue.) *)

(** Coq provides a tactic called [inversion] that allows us to exploit
    these principles in proofs.

    The [inversion] tactic is used like this.  Suppose [H] is a
    hypothesis in the context (or a previously proven lemma) of the
    form
      c a1 a2 ... an = d b1 b2 ... bm
    for some constructors [c] and [d] and arguments [a1 ... an] and
    [b1 ... bm].  Then [inversion H] instructs Coq to "invert" this
    equality to extract the information it contains about these terms:

    - If [c] and [d] are the same constructor, then we know, by the
      injectivity of this constructor, that [a1 = b1], [a2 = b2],
      etc.; [inversion H] adds these facts to the context, and tries
      to use them to rewrite the goal.

    - If [c] and [d] are different constructors, then the hypothesis
      [H] is contradictory.  That is, a false assumption has crept
      into the context, and this means that any goal whatsoever is
      provable!  In this case, [inversion H] marks the current goal as
      completed and pops it off the goal stack. *)

(** The [inversion] tactic is probably easier to understand by
    seeing it in action than from general descriptions like the above.
    Below you will find example theorems that demonstrate the use of
    [inversion] and exercises to test your understanding. *)

Theorem eq_add_S : forall (n m : nat),
     S n = S m ->
     n = m.
Proof.
  intros n m eq. inversion eq. reflexivity.  Qed.

Theorem silly4 : forall (n m : nat),
     [n] = [m] ->
     n = m.
Proof.
  intros n o eq. inversion eq. reflexivity.  Qed.

(** As a convenience, the [inversion] tactic can also
    destruct equalities between complex values, binding
    multiple variables as it goes. *)

Theorem silly5 : forall (n m o : nat),
     [n;m] = [o;o] ->
     [n] = [m].
Proof.
  intros n m o eq. inversion eq. reflexivity. Qed.

(** **** Exercise: 1 star (sillyex1) *)
Example sillyex1 : forall (X : Type) (x y z : X) (l j : list X),
     x :: y :: l = z :: j ->
     y :: l = x :: j ->
     x = y.
Proof.
  intros X x y z i j eq1 eq2. inversion eq2. reflexivity.
Qed.
(** [] *)

Theorem silly6 : forall (n : nat),
     S n = O ->
     2 + 2 = 5.
Proof.
  intros n contra. inversion contra. Qed.

Theorem silly7 : forall (n m : nat),
     false = true ->
     [n] = [m].
Proof.
  intros n m contra. inversion contra.  Qed.

(** **** Exercise: 1 star (sillyex2) *)
Example sillyex2 : forall (X : Type) (x y z : X) (l j : list X),
     x :: y :: l = [] ->
     y :: l = z :: j ->
     x = z.
Proof.
  intros X x y z i j eq1 eq2. inversion eq1. Qed.
(** [] *)

(** While the injectivity of constructors allows us to reason
    [forall (n m : nat), S n = S m -> n = m], the reverse direction of
    the implication is an instance of a more general fact about
    constructors and functions, which we will often find useful: *)

Theorem f_equal : forall (A B : Type) (f: A -> B) (x y: A),
    x = y -> f x = f y.
Proof. intros A B f x y eq. rewrite eq.  reflexivity.  Qed.

(** Here's another illustration of [inversion].  This is a slightly
    roundabout way of stating a fact that we have already proved
    above.  The extra equalities force us to do a little more
    equational reasoning and exercise some of the tactics we've seen
    recently. *)

Theorem length_snoc' : forall (X : Type) (v : X)
                              (l : list X) (n : nat),
     length l = n ->
     length (snoc l v) = S n.
Proof.
  intros X v l. induction l as [| v' l'].
  Case "l = []". intros n eq. rewrite <- eq. reflexivity.
  Case "l = v' :: l'". intros n eq. simpl. destruct n as [| n'].
    SCase "n = 0". inversion eq.
    SCase "n = S n'".
      apply f_equal. apply IHl'. inversion eq. reflexivity. Qed.

(** **** Exercise: 2 stars, optional (practice) *)
(** A couple more nontrivial but not-too-complicated proofs to work
    together in class, or for you to work as exercises.  They may
    involve applying lemmas from earlier lectures or homeworks. *)

Theorem beq_nat_0_l : forall n,
   beq_nat 0 n = true -> n = 0.
Proof.
  intros n eq1. destruct n as [|n'].
  Case "n = 0". reflexivity.
  Case "n = S n'". inversion eq1.
Qed.

Theorem beq_nat_0_r : forall n,
   beq_nat n 0 = true -> n = 0.
Proof.
  intros n eq1. destruct n as [|n'].
  Case "n = 0". reflexivity.
  Case "n = S n'". inversion eq1.
Qed.
(** [] *)

(* ###################################################### *)
(** * Using Tactics on Hypotheses *)

(** By default, most tactics work on the goal formula and leave
    the context unchanged.  However, most tactics also have a variant
    that performs a similar operation on a statement in the context.

    For example, the tactic [simpl in H] performs simplification in
    the hypothesis named [H] in the context. *)

Theorem S_inj : forall (n m : nat) (b : bool),
     beq_nat (S n) (S m) = b  ->
     beq_nat n m = b.
Proof.
  intros n m b H. simpl in H. apply H.  Qed.

(** Similarly, the tactic [apply L in H] matches some
    conditional statement [L] (of the form [L1 -> L2], say) against a
    hypothesis [H] in the context.  However, unlike ordinary
    [apply] (which rewrites a goal matching [L2] into a subgoal [L1]),
    [apply L in H] matches [H] against [L1] and, if successful,
    replaces it with [L2].

    In other words, [apply L in H] gives us a form of "forward
    reasoning" -- from [L1 -> L2] and a hypothesis matching [L1], it
    gives us a hypothesis matching [L2].  By contrast, [apply L] is
    "backward reasoning" -- it says that if we know [L1->L2] and we
    are trying to prove [L2], it suffices to prove [L1].

    Here is a variant of a proof from above, using forward reasoning
    throughout instead of backward reasoning. *)

Theorem silly3' : forall (n : nat),
  (beq_nat n 5 = true -> beq_nat (S (S n)) 7 = true) ->
     true = beq_nat n 5  ->
     true = beq_nat (S (S n)) 7.
Proof.
  intros n eq H.
  symmetry in H. apply eq in H. symmetry in H.
  apply H.  Qed.

(** Forward reasoning starts from what is _given_ (premises,
    previously proven theorems) and iteratively draws conclusions from
    them until the goal is reached.  Backward reasoning starts from
    the _goal_, and iteratively reasons about what would imply the
    goal, until premises or previously proven theorems are reached.
    If you've seen informal proofs before (for example, in a math or
    computer science class), they probably used forward reasoning.  In
    general, Coq tends to favor backward reasoning, but in some
    situations the forward style can be easier to use or to think
    about.  *)

(** **** Exercise: 3 stars (plus_n_n_injective) *)
(** Practice using "in" variants in this exercise. *)

Theorem plus_n_n_injective : forall n m,
     n + n = m + m ->
     n = m.
Proof.
  intros n. induction n as [| n'].
  Case "n = 0". intros m eq1. simpl in eq1. rewrite eq1.
    induction m as [| m'].
    SCase "m = 0". reflexivity.
    SCase "m = S m'". rewrite <- plus_n_Sm in eq1. inversion eq1.
  Case "n = S n'". intros m eq2.
  rewrite <- plus_n_Sm in eq2.
    destruct m as [| m'].
    SCase "m = 0". simpl in eq2. inversion eq2.
    SCase "m = S m'". simpl in eq2.
      assert (S (m' + S m') = S (S (m' + m'))).
        rewrite <- plus_n_Sm. reflexivity.
      rewrite H in eq2. inversion eq2.
      apply f_equal. apply IHn'.  apply H1.
Qed.
(** [] *)

(* ###################################################### *)
(** * Varying the Induction Hypothesis *)

(** Sometimes it is important to control the exact form of the
    induction hypothesis when carrying out inductive proofs in Coq.
    In particular, we need to be careful about which of the
    assumptions we move (using [intros]) from the goal to the context
    before invoking the [induction] tactic.  For example, suppose
    we want to show that the [double] function is injective -- i.e.,
    that it always maps different arguments to different results:
    Theorem double_injective: forall n m, double n = double m -> n = m.
    The way we _start_ this proof is a little bit delicate: if we
    begin it with
      intros n. induction n.
]]
    all is well.  But if we begin it with
      intros n m. induction n.
    we get stuck in the middle of the inductive case... *)

Theorem double_injective_FAILED : forall n m,
     double n = double m ->
     n = m.
Proof.
  intros n m. induction n as [| n'].
  Case "n = O". simpl. intros eq. destruct m as [| m'].
    SCase "m = O". reflexivity.
    SCase "m = S m'". inversion eq.
  Case "n = S n'". intros eq. destruct m as [| m'].
    SCase "m = O". inversion eq.
    SCase "m = S m'".  apply f_equal.
      (* Here we are stuck.  The induction hypothesis, [IHn'], does
         not give us [n' = m'] -- there is an extra [S] in the
         way -- so the goal is not provable. *)
      Abort.

(** What went wrong? *)

(** The problem is that, at the point we invoke the induction
    hypothesis, we have already introduced [m] into the context --
    intuitively, we have told Coq, "Let's consider some particular
    [n] and [m]..." and we now have to prove that, if [double n =
    double m] for _this particular_ [n] and [m], then [n = m].

    The next tactic, [induction n] says to Coq: We are going to show
    the goal by induction on [n].  That is, we are going to prove that
    the proposition

      - [P n]  =  "if [double n = double m], then [n = m]"

    holds for all [n] by showing

      - [P O]

         (i.e., "if [double O = double m] then [O = m]")

      - [P n -> P (S n)]

        (i.e., "if [double n = double m] then [n = m]" implies "if
        [double (S n) = double m] then [S n = m]").

    If we look closely at the second statement, it is saying something
    rather strange: it says that, for a _particular_ [m], if we know

      - "if [double n = double m] then [n = m]"

    then we can prove

       - "if [double (S n) = double m] then [S n = m]".

    To see why this is strange, let's think of a particular [m] --
    say, [5].  The statement is then saying that, if we know

      - [Q] = "if [double n = 10] then [n = 5]"

    then we can prove

      - [R] = "if [double (S n) = 10] then [S n = 5]".

    But knowing [Q] doesn't give us any help with proving [R]!  (If we
    tried to prove [R] from [Q], we would say something like "Suppose
    [double (S n) = 10]..." but then we'd be stuck: knowing that
    [double (S n)] is [10] tells us nothing about whether [double n]
    is [10], so [Q] is useless at this point.) *)

(** To summarize: Trying to carry out this proof by induction on [n]
    when [m] is already in the context doesn't work because we are
    trying to prove a relation involving _every_ [n] but just a
    _single_ [m]. *)

(** The good proof of [double_injective] leaves [m] in the goal
    statement at the point where the [induction] tactic is invoked on
    [n]: *)

Theorem double_injective : forall n m,
     double n = double m ->
     n = m.
Proof.
  intros n. induction n as [| n'].
  Case "n = O". simpl. intros m eq. destruct m as [| m'].
    SCase "m = O". reflexivity.
    SCase "m = S m'". inversion eq.
  Case "n = S n'".
    (* Notice that both the goal and the induction
       hypothesis have changed: the goal asks us to prove
       something more general (i.e., to prove the
       statement for _every_ [m]), but the IH is
       correspondingly more flexible, allowing us to
       choose any [m] we like when we apply the IH.  *)
    intros m eq.
    (* Now we choose a particular [m] and introduce the
       assumption that [double n = double m].  Since we
       are doing a case analysis on [n], we need a case
       analysis on [m] to keep the two "in sync." *)
    destruct m as [| m'].
    SCase "m = O".
      (* The 0 case is trivial *)
      inversion eq.
    SCase "m = S m'".
      apply f_equal.
      (* At this point, since we are in the second
         branch of the [destruct m], the [m'] mentioned
         in the context at this point is actually the
         predecessor of the one we started out talking
         about.  Since we are also in the [S] branch of
         the induction, this is perfect: if we
         instantiate the generic [m] in the IH with the
         [m'] that we are talking about right now (this
         instantiation is performed automatically by
         [apply]), then [IHn'] gives us exactly what we
         need to finish the proof. *)
      apply IHn'. inversion eq. reflexivity. Qed.

(** What this teaches us is that we need to be careful about using
    induction to try to prove something too specific: If we're proving
    a property of [n] and [m] by induction on [n], we may need to
    leave [m] generic. *)

(** The proof of this theorem has to be treated similarly: *)

(** **** Exercise: 2 stars (beq_nat_true) *)
Theorem beq_nat_true : forall n m,
    beq_nat n m = true -> n = m.
Proof.
  intros n. induction n as [|n'].
  Case "n = 0". symmetry. apply beq_nat_0_l. apply H.
  Case "n = S n'". intros m eq1. destruct m as [|m'].
    SCase "m = 0". inversion eq1.
    SCase "m = S m'". apply f_equal. apply IHn'.
      simpl in eq1. apply eq1.
Qed.
(** [] *)

(** **** Exercise: 2 stars, advanced (beq_nat_true_informal) *)
(** Give a careful informal proof of [beq_nat_true], being as explicit
    as possible about quantifiers. *)
(*
  We want to prove: suppose m n are two natural numbers, if [beq_nat n m]
  returns [true], then [m = n].

  We will prove it by induction on n.

  - Base case: n = 0.
    Since we know that for any given natural number l, if [beq_nat 0 l = true],
    then [l = 0]. The conclusion follows by letting [m = l], and we have [m = 0 = n].
  - Inductive step: n = S n'
    Assume for any given n' < n, the conclusion holds. We need to prove
    if [beq_nat (S n') m = true] then [m = S n' = n] for any natural number m.

    This can be proved by considering two cases:

    - Case #1: m = 0

    We know that if [beq_nat (S n') 0 = true], we must have [S n' = 0],
    which is impossible.

    - Case #2: m = S m' > 0

    Since [beq_nat n m = beq_nat (S n') (S m') = true], by definition, we also have:
    [beq_nat n' m' = true]. And the conclusion holds by applying the hypothesis,
    which is: since [beq_nat n' m' = true], we have [n' = m'], thus [S n' = S m']
    therefore [n = m].

*)
(** [] *)

(** The strategy of doing fewer [intros] before an [induction] doesn't
    always work directly; sometimes a little _rearrangement_ of
    quantified variables is needed.  Suppose, for example, that we
    wanted to prove [double_injective] by induction on [m] instead of
    [n]. *)

Theorem double_injective_take2_FAILED : forall n m,
     double n = double m ->
     n = m.
Proof.
  intros n m. induction m as [| m'].
  Case "m = O". simpl. intros eq. destruct n as [| n'].
    SCase "n = O". reflexivity.
    SCase "n = S n'". inversion eq.
  Case "m = S m'". intros eq. destruct n as [| n'].
    SCase "n = O". inversion eq.
    SCase "n = S n'".  apply f_equal.
        (* Stuck again here, just like before. *)
Abort.

(** The problem is that, to do induction on [m], we must first
    introduce [n].  (If we simply say [induction m] without
    introducing anything first, Coq will automatically introduce
    [n] for us!)   *)

(** What can we do about this?  One possibility is to rewrite the
    statement of the lemma so that [m] is quantified before [n].  This
    will work, but it's not nice: We don't want to have to mangle the
    statements of lemmas to fit the needs of a particular strategy for
    proving them -- we want to state them in the most clear and
    natural way. *)

(**  What we can do instead is to first introduce all the
    quantified variables and then _re-generalize_ one or more of
    them, taking them out of the context and putting them back at
    the beginning of the goal.  The [generalize dependent] tactic
    does this. *)

Theorem double_injective_take2 : forall n m,
     double n = double m ->
     n = m.
Proof.
  intros n m.
  (* [n] and [m] are both in the context *)
  generalize dependent n.
  (* Now [n] is back in the goal and we can do induction on
     [m] and get a sufficiently general IH. *)
  induction m as [| m'].
  Case "m = O". simpl. intros n eq. destruct n as [| n'].
    SCase "n = O". reflexivity.
    SCase "n = S n'". inversion eq.
  Case "m = S m'". intros n eq. destruct n as [| n'].
    SCase "n = O". inversion eq.
    SCase "n = S n'". apply f_equal.
      apply IHm'. inversion eq. reflexivity. Qed.

(** Let's look at an informal proof of this theorem.  Note that
    the proposition we prove by induction leaves [n] quantified,
    corresponding to the use of generalize dependent in our formal
    proof.

_Theorem_: For any nats [n] and [m], if [double n = double m], then
  [n = m].

_Proof_: Let [m] be a [nat]. We prove by induction on [m] that, for
  any [n], if [double n = double m] then [n = m].

  - First, suppose [m = 0], and suppose [n] is a number such
    that [double n = double m].  We must show that [n = 0].

    Since [m = 0], by the definition of [double] we have [double n =
    0].  There are two cases to consider for [n].  If [n = 0] we are
    done, since this is what we wanted to show.  Otherwise, if [n = S
    n'] for some [n'], we derive a contradiction: by the definition of
    [double] we would have [double n = S (S (double n'))], but this
    contradicts the assumption that [double n = 0].

  - Otherwise, suppose [m = S m'] and that [n] is again a number such
    that [double n = double m].  We must show that [n = S m'], with
    the induction hypothesis that for every number [s], if [double s =
    double m'] then [s = m'].

    By the fact that [m = S m'] and the definition of [double], we
    have [double n = S (S (double m'))].  There are two cases to
    consider for [n].

    If [n = 0], then by definition [double n = 0], a contradiction.
    Thus, we may assume that [n = S n'] for some [n'], and again by
    the definition of [double] we have [S (S (double n')) = S (S
    (double m'))], which implies by inversion that [double n' = double
    m'].

    Instantiating the induction hypothesis with [n'] thus allows us to
    conclude that [n' = m'], and it follows immediately that [S n' = S
    m'].  Since [S n' = n] and [S m' = m], this is just what we wanted
    to show. [] *)

(** **** Exercise: 3 stars (gen_dep_practice) *)

(** Prove this by induction on [l]. *)

Theorem index_after_last: forall (n : nat) (X : Type) (l : list X),
     length l = n ->
     index n l = None.
Proof.
  intros n X l eq1. generalize dependent n.
  induction l as [|x l'].
  Case "l = nil". reflexivity.
  Case "l = cons x l'". intros n eq1. simpl in eq1. destruct n.
    SCase "n = 0". inversion eq1.
    SCase "n = S n'". apply IHl'. inversion eq1. reflexivity.
Qed.
(** [] *)

(** **** Exercise: 3 stars, advanced, optional (index_after_last_informal) *)
(** Write an informal proof corresponding to your Coq proof
    of [index_after_last]:

     _Theorem_: For all sets [X], lists [l : list X], and numbers
      [n], if [length l = n] then [index n l = None].

     _Proof_:

     We will prove it by induction on [l].

     - Base case: l = nil

     The conclusion follows by observing that
     [length l = n = 0] and [index n l = None]

     - Inductive step: suppose l = x :: l',
       if [length l' = n'] then [index n' l' = None].

     Since [l] has at least one element, we know
     [length l = n > 0]. Let [n = S n'], by defintion of [length],
     we know [length l' = n'], therefore [index n' l' = None].
     The conclusion follows by observation that [length l = S (length (x :: l')) = n]
     and [index (S n') (x :: l') = None].

[]
*)

(** **** Exercise: 3 stars, optional (gen_dep_practice_more) *)
(** Prove this by induction on [l]. *)

Theorem length_snoc''' : forall (n : nat) (X : Type)
                              (v : X) (l : list X),
     length l = n ->
     length (snoc l v) = S n.
Proof.
  intros n X v l. generalize dependent n. induction l as [|x l'].
  Case "l = nil". intros n eq1. simpl in eq1.
    rewrite <- eq1. reflexivity.
  Case "l = cons x l'". intros n eq1. simpl in eq1. destruct n.
    SCase "n = 0". inversion eq1.
    SCase "n = S n'". inversion eq1. rewrite H0. simpl.
      apply f_equal. apply IHl'. apply H0.
Qed.
(** [] *)

(** **** Exercise: 3 stars, optional (app_length_cons) *)
(** Prove this by induction on [l1], without using [app_length]. *)

Theorem app_length_cons : forall (X : Type) (l1 l2 : list X)
                                  (x : X) (n : nat),
     length (l1 ++ (x :: l2)) = n ->
     S (length (l1 ++ l2)) = n.
Proof.
  intros X l1 l2 x n. generalize dependent n.
  induction l1 as [|x1 l1'].
  Case "l1 = nil". intros n eq1. simpl in eq1. destruct n.
    SCase "n = 0". inversion eq1.
    SCase "n = S n'". inversion eq1. apply f_equal. reflexivity.
  Case "l1 = cons x1 l1'". intros n eq1. simpl in eq1. destruct n.
    SCase "n = 0". inversion eq1.
    SCase "n = S n'". apply f_equal. apply IHl1'.
      inversion eq1. reflexivity.
Qed.
(** [] *)

(** **** Exercise: 4 stars, optional (app_length_twice) *)
(** Prove this by induction on [l], without using app_length. *)

Lemma app_nil : forall (X : Type) (l : list X),
  l ++ [] = l.
Proof.
  intros X l. induction l as [|x l'].
  Case "l = nil". reflexivity.
  Case "l = cons x l'". simpl. rewrite IHl'. reflexivity.
Qed.

Lemma app_commute_under_length : forall (X : Type) (l1 l2 : list X),
  length (l1 ++ l2) = length (l2 ++ l1).
Proof.
  intros X l1 l2. induction l1 as [|x l1'].
  Case "l1 = nil". apply f_equal. rewrite app_nil. reflexivity.
  Case "l1 = cons x l1'". simpl. rewrite IHl1'. apply app_length_cons with x.
    reflexivity.
Qed.

Theorem app_length_twice : forall (X:Type) (n:nat) (l:list X),
     length l = n ->
     length (l ++ l) = n + n.
Proof.
  intros X n l. generalize dependent n. induction l as [|x l'].
  Case "l = nil". intros n eq1. simpl in eq1.
    simpl. rewrite <- eq1. reflexivity.
  Case "l = cons x l'". intros n eq1. destruct n.
    SCase "n = 0". simpl in eq1. inversion eq1.
    SCase "n = S n'". simpl in eq1. inversion eq1.
      rewrite eq1. simpl. rewrite app_commute_under_length. simpl.
      rewrite <- plus_n_Sm. apply f_equal. apply f_equal.
      apply IHl'. apply H0.
Qed.
(** [] *)

(* ###################################################### *)
(** * Using [destruct] on Compound Expressions *)

(** We have seen many examples where the [destruct] tactic is
    used to perform case analysis of the value of some variable.  But
    sometimes we need to reason by cases on the result of some
    _expression_.  We can also do this with [destruct].

    Here are some examples: *)

Definition sillyfun (n : nat) : bool :=
  if beq_nat n 3 then false
  else if beq_nat n 5 then false
  else false.

Theorem sillyfun_false : forall (n : nat),
  sillyfun n = false.
Proof.
  intros n. unfold sillyfun.
  destruct (beq_nat n 3).
    Case "beq_nat n 3 = true". reflexivity.
    Case "beq_nat n 3 = false". destruct (beq_nat n 5).
      SCase "beq_nat n 5 = true". reflexivity.
      SCase "beq_nat n 5 = false". reflexivity.  Qed.

(** After unfolding [sillyfun] in the above proof, we find that
    we are stuck on [if (beq_nat n 3) then ... else ...].  Well,
    either [n] is equal to [3] or it isn't, so we use [destruct
    (beq_nat n 3)] to let us reason about the two cases.

    In general, 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 type [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].

*)

(** **** Exercise: 1 star (override_shadow) *)
Theorem override_shadow : forall (X:Type) x1 x2 k1 k2 (f : nat->X),
  (override (override f k1 x2) k1 x1) k2 = (override f k1 x1) k2.
Proof.
  intros X x1 x2 k1 k2 f. unfold override.
  destruct (beq_nat k1 k2).
  Case "beq_nat k1 k2 = true". reflexivity.
  Case "beq_nat k1 k2 = false". reflexivity.
Qed.
(** [] *)

(** **** Exercise: 3 stars, optional (combine_split) *)
(** Complete the proof below *)

Lemma pair_fst_snd : forall (X Y : Type) (p : X * Y),
  p = (fst p, snd p).
Proof.
  intros X Y p. destruct p. reflexivity.
Qed.

Theorem combine_split : forall X Y (l : list (X * Y)) l1 l2,
  split l = (l1, l2) ->
  combine l1 l2 = l.
Proof.
  intros X Y l. induction l as [|(x,y) l'].
  Case "l = nil". intros l1 l2 eq1.
    simpl in eq1. inversion eq1. reflexivity.
  Case "l = (x,y) :: l'". intros l1 l2 eq1. unfold combine.
    inversion eq1. apply f_equal. apply IHl'.
    apply pair_fst_snd.
Qed.
(** [] *)

(** Sometimes, doing a [destruct] on a compound expression (a
    non-variable) will erase information we need to complete a proof. *)
(** For example, suppose
    we define a function [sillyfun1] like this: *)

Definition sillyfun1 (n : nat) : bool :=
  if beq_nat n 3 then true
  else if beq_nat n 5 then true
  else false.

(** And suppose that we want to convince Coq of the rather
    obvious observation that [sillyfun1 n] yields [true] only when [n]
    is odd.  By analogy with the proofs we did with [sillyfun] above,
    it is natural to start the proof like this: *)

Theorem sillyfun1_odd_FAILED : forall (n : nat),
     sillyfun1 n = true ->
     oddb n = true.
Proof.
  intros n eq. unfold sillyfun1 in eq.
  destruct (beq_nat n 3).
  (* stuck... *)
Abort.

(** We get stuck at this point because 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 [beq_nat n 3], but we need to keep some
    memory of this expression and how it was destructed, because we
    need to be able to reason that since, in this branch of the case
    analysis, [beq_nat n 3 = true], it must be that [n = 3], from
    which it follows that [n] is odd.

    What we would really like is to substitute away all existing
    occurences of [beq_nat n 3], but at the same time add an equation
    to the context that records which case we are in.  The [eqn:]
    qualifier allows us to introduce such an equation (with whatever
    name we choose). *)

Theorem sillyfun1_odd : forall (n : nat),
     sillyfun1 n = true ->
     oddb n = true.
Proof.
  intros n eq. unfold sillyfun1 in eq.
  destruct (beq_nat n 3) eqn:Heqe3.
  (* Now we have the same state as at the point where we got stuck
    above, except that the context contains an extra equality
    assumption, which is exactly what we need to make progress. *)
    Case "e3 = true". apply beq_nat_true in Heqe3.
      rewrite -> Heqe3. reflexivity.
    Case "e3 = false".
     (* When we come to the second equality test in the body of the
       function we are reasoning about, we can use [eqn:] again in the
       same way, allow us to finish the proof. *)
      destruct (beq_nat n 5) eqn:Heqe5.
        SCase "e5 = true".
          apply beq_nat_true in Heqe5.
          rewrite -> Heqe5. reflexivity.
        SCase "e5 = false". inversion eq.  Qed.

(** **** Exercise: 2 stars (destruct_eqn_practice) *)
Theorem bool_fn_applied_thrice :
  forall (f : bool -> bool) (b : bool),
  f (f (f b)) = f b.
Proof.
  intros f b. destruct (f b) eqn:Hfb.
  Case "f b = true". destruct b eqn:Hb.
    SCase "b = true". rewrite Hfb. apply Hfb.
    SCase "b = false". destruct (f true) eqn:Hfb'.
      SSCase "f true = true". apply Hfb'.
      SSCase "f true = false". apply Hfb.
  Case "f b = false". destruct b eqn:Hb.
    SCase "b = true". destruct (f false) eqn:Hfb'.
      SSCase "f false = true". apply Hfb.
      SSCase "f false = false". apply Hfb'.
    SCase "b = false". rewrite Hfb. apply Hfb.
Qed.
(** [] *)

(** **** Exercise: 2 stars (override_same) *)
Theorem override_same : forall (X:Type) x1 k1 k2 (f : nat->X),
  f k1 = x1 ->
  (override f k1 x1) k2 = f k2.
Proof.
  intros X x1 k1 k2 f eq1. unfold override.
  destruct (beq_nat k1 k2) eqn:Heq12.
  Case "beq_nat k1 k2 = true".
    assert (k1 = k2). apply beq_nat_true. apply Heq12.
    rewrite <- H. symmetry. apply eq1.
  Case "beq_nat k1 k2 = false". reflexivity.
Qed.
(** [] *)

(* ################################################################## *)
(** * Review *)

(** We've now seen a bunch of Coq's fundamental tactics.  We'll
    introduce a few more as we go along through the coming lectures,
    and later in the course we'll introduce some more powerful
    _automation_ tactics that make Coq do more of the low-level work
    in many cases.  But basically we've got what we need to get work
    done.

    Here are the ones we've seen:

      - [intros]:
        move hypotheses/variables from goal to context

      - [reflexivity]:
        finish the proof (when the goal looks like [e = e])

      - [apply]:
        prove goal using a hypothesis, lemma, or constructor

      - [apply... in H]:
        apply a hypothesis, lemma, or constructor to a hypothesis in
        the context (forward reasoning)

      - [apply... with...]:
        explicitly specify values for variables that cannot be
        determined by pattern matching

      - [simpl]:
        simplify computations in the goal

      - [simpl in H]:
        ... or a hypothesis

      - [rewrite]:
        use an equality hypothesis (or lemma) to rewrite the goal

      - [rewrite ... in H]:
        ... or a hypothesis

      - [symmetry]:
        changes a goal of the form [t=u] into [u=t]

      - [symmetry in H]:
        changes a hypothesis of the form [t=u] into [u=t]

      - [unfold]:
        replace a defined constant by its right-hand side in the goal

      - [unfold... in H]:
        ... or a hypothesis

      - [destruct... as...]:
        case analysis on values of inductively defined types

      - [destruct... eqn:...]:
        specify the name of an equation to be added to the context,
        recording the result of the case analysis

      - [induction... as...]:
        induction on values of inductively defined types

      - [inversion]:
        reason by injectivity and distinctness of constructors

      - [assert (e) as H]:
        introduce a "local lemma" [e] and call it [H]

      - [generalize dependent x]:
        move the variable [x] (and anything else that depends on it)
        from the context back to an explicit hypothesis in the goal
        formula
*)

(* ###################################################### *)
(** * Additional Exercises *)

(** **** Exercise: 3 stars (beq_nat_sym) *)
Theorem beq_nat_sym : forall (n m : nat),
  beq_nat n m = beq_nat m n.
Proof.
  intros n. induction n as [|n'].
  Case "n = 0". intros m. simpl. destruct m as [|m'].
    SCase "m = 0". reflexivity.
    SCase "m = S m'". reflexivity.
  Case "n = S n'". intros m. simpl. destruct m as [|m'].
    SCase "m = 0". reflexivity.
    SCase "m = S m'". simpl. apply IHn'.
Qed.
(** [] *)

(** **** Exercise: 3 stars, advanced, optional (beq_nat_sym_informal) *)
(** Give an informal proof of this lemma that corresponds to your
    formal proof above:

   Theorem: For any [nat]s [n] [m], [beq_nat n m = beq_nat m n].

   Proof:
   We prove it by induction on [n].

   - Base case: n = 0.

     - if m = 0, then beq_nat m n = true = beq_nat n m.
     - if m > 0, then beq_nat m n = false = beq_nat n m.

   - Inductive step: n = S n'.

     The hypothesis is: for any natural number [m], we have:
     [beq_nat n' m = beq_nat m n'].

     - if m = 0, then [beq_nat (S n') m = false = beq_nat m (S n')].
     - if m = S m' > 0, we need to prove
       [beq_nat (S n') (S m') = beq_nat n' m' = beq_nat m' n' = beq_nat (S m') (S n')].
       This follows by applying the hypothesis.

    Therefore for any natural number [n] and [m], we have [beq_nat n m = beq_nat m n].

[]
 *)

(** **** Exercise: 3 stars, optional (beq_nat_trans) *)
Lemma beq_nat_n_n : forall n,
  beq_nat n n = true.
Proof.
  intros n. induction n as [|n'].
  Case "n = 0". reflexivity.
  Case "n = S n'". simpl. apply IHn'.
Qed.

Theorem beq_nat_trans : forall n m p,
  beq_nat n m = true ->
  beq_nat m p = true ->
  beq_nat n p = true.
Proof.
  intros n m p Hnm Hmp.
  assert (n = m). apply beq_nat_true. apply Hnm.
  assert (m = p). apply beq_nat_true. apply Hmp.
  assert (n = p). apply trans_eq with m. apply H.
  apply H0. rewrite H1. apply beq_nat_n_n.
Qed.
(** [] *)

(** **** Exercise: 3 stars, advanced (split_combine) *)
(** We have just proven that for all lists of pairs, [combine] is the
    inverse of [split].  How would you formalize the statement that
    [split] is the inverse of [combine]?

    Complete the definition of [split_combine_statement] below with a
    property that states that [split] is the inverse of
    [combine]. Then, prove that the property holds. (Be sure to leave
    your induction hypothesis general by not doing [intros] on more
    things than necessary.  Hint: what property do you need of [l1]
    and [l2] for [split] [combine l1 l2 = (l1,l2)] to be true?)  *)

Definition split_combine_statement : Prop :=
  forall (X : Type) (Y : Type)
         (l1 : list X) (l2 : list Y) (l : list (X * Y)),
      length l1 = length l2
   -> combine l1 l2 = l
   -> split l = (l1,l2).
(** [] *)

Theorem split_combine : split_combine_statement.
Proof.
  intros X Y l1. induction l1 as [|x1 l1'].
  Case "l1 = nil". intros l2 l eq1 eq2. destruct l2 as [|x2 l2'].
    SCase "l2 = nil". simpl in eq2. rewrite <- eq2. reflexivity.
    SCase "l2 = x2 :: l2'". inversion eq1.
  Case "l1 = x1 l1'". intros l2 l eq1 eq2. destruct l2 as [|x2 l2'].
    SCase "l2 = nil". inversion eq1.
    SCase "l2 = x2 l2'". destruct l as [|(a,b) l'].
      SSCase "l = nil". inversion eq2.
      SSCase "l = (a,b) :: l'". inversion eq1. inversion eq2.
      assert (split (combine l1' l2') = (l1',l2')) as IH.
        apply IHl1'. apply H0. reflexivity.
      simpl. rewrite IH. reflexivity.
Qed.

(** **** Exercise: 3 stars (override_permute) *)
Theorem override_permute : forall (X:Type) x1 x2 k1 k2 k3 (f : nat->X),
  beq_nat k2 k1 = false ->
  (override (override f k2 x2) k1 x1) k3 = (override (override f k1 x1) k2 x2) k3.
Proof.
  intros X x1 x2 k1 k2 k3 f eq1.
  unfold override. destruct (beq_nat k1 k3) eqn:H13.
  Case "beq_nat k1 k3 = true".
    assert (k1 = k3). apply beq_nat_true. apply H13.
    rewrite <- H. rewrite eq1. reflexivity.
  Case "beq_nat k1 k3 = false". reflexivity.
Qed.
(** [] *)

(** **** Exercise: 3 stars, advanced (filter_exercise) *)
(** This one is a bit challenging.  Pay attention to the form of your IH. *)

Theorem filter_exercise : forall (X : Type) (test : X -> bool)
                             (x : X) (l lf : list X),
     filter test l = x :: lf ->
     test x = true.
Proof.
  intros X test x l lf.
  generalize dependent lf. generalize dependent x.
  induction l as [|a l'].
  Case "l = nil". intros x lf eq1.
    unfold filter in eq1. inversion eq1.
  Case "l = a :: l'". destruct (test a) eqn:Htx.
    SCase "test a = true".
      intros x lf eq1. unfold filter in eq1.
      rewrite Htx in eq1. inversion eq1.
      rewrite <- H0. apply Htx.
    SCase "test a = false". intros x lf eq1.
      apply IHl' with lf. unfold filter in eq1.
      rewrite Htx in eq1. apply eq1.
Qed.
(** [] *)

(** **** Exercise: 4 stars, advanced (forall_exists_challenge) *)
(** Define two recursive [Fixpoints], [forallb] and [existsb].  The
    first checks whether every element in a list satisfies a given
    predicate:
      forallb oddb [1;3;5;7;9] = true

      forallb negb [false;false] = true

      forallb evenb [0;2;4;5] = false

      forallb (beq_nat 5) [] = true
    The second checks whether there exists an element in the list that
    satisfies a given predicate:
      existsb (beq_nat 5) [0;2;3;6] = false

      existsb (andb true) [true;true;false] = true

      existsb oddb [1;0;0;0;0;3] = true

      existsb evenb [] = false
    Next, define a _nonrecursive_ version of [existsb] -- call it
    [existsb'] -- using [forallb] and [negb].

    Prove that [existsb'] and [existsb] have the same behavior.
*)

Fixpoint forallb {X : Type} (f : X -> bool) (xs : list X) : bool :=
  match xs with
  | [] => true
  | h :: t => if f h then forallb f t else false
  end.

Fixpoint existsb {X : Type} (f : X -> bool) (xs : list X) : bool :=
  match xs with
  | [] => false
  | h :: t => if f h then true else existsb f t
  end.

Definition existsb' {X : Type} (f : X -> bool) (xs : list X) : bool :=
  negb (forallb (fun x => negb (f x)) xs).

Example forallb_1 :
  forallb oddb [1;2;3] = false.
Proof. reflexivity. Qed.

Example forallb_2 :
  forallb oddb [1;3;5] = true.
Proof. reflexivity. Qed.

Example existsb_1 :
  existsb oddb [2;4;6] = false.
Proof. reflexivity. Qed.

Example existsb_2 :
  existsb oddb [2;4;5] = true.
Proof. reflexivity. Qed.

Theorem same_existsb_existsb' : forall (X : Type) (f : X -> bool) (xs : list X),
  existsb f xs = existsb' f xs.
Proof.
  intros X f xs. induction xs as [|h t].
  Case "xs = nil". unfold existsb.
    unfold existsb'. unfold forallb. reflexivity.
  Case "xs = h :: t". destruct (f h) eqn:Hfh.
    SCase "f h = true". unfold existsb. unfold existsb'.
      rewrite Hfh. simpl. rewrite Hfh. reflexivity.
    SCase "f h = false".
      unfold existsb. rewrite Hfh. fold (@existsb X).
      rewrite IHt. unfold existsb'. unfold forallb.
      rewrite Hfh. reflexivity.
Qed.
(** [] *)

(* $Date: 2013-07-17 16:19:11 -0400 (Wed, 17 Jul 2013) $ *)


Require Export D.

(** **** Problem #3 : 2 stars, advanced (currying) *)
(** In Coq, a function [f : A -> B -> C] really has the type [A
    -> (B -> C)].  That is, if you give [f] a value of type [A], it
    will give you function [f' : B -> C].  If you then give [f'] a
    value of type [B], it will return a value of type [C].  This
    allows for partial application, as in [plus3].  Processing a list
    of arguments with functions that return functions is called
    _currying_, in honor of the logician Haskell Curry.

    Conversely, we can reinterpret the type [A -> B -> C] as [(A *
    B) -> C].  This is called _uncurrying_.  With an uncurried binary
    function, both arguments must be given at once as a pair; there is
    no partial application. *)

(** We can define currying as follows: *)

Print prod_curry.

(** As an exercise, define its inverse, [prod_uncurry].  Then prove
    the theorems below to show that the two are inverses. *)

Definition prod_uncurry {X Y Z : Type}
  (f : X -> Y -> Z) (p : X * Y) : Z :=
match p with
|(x, y) => f x y
end.

(** (Thought exercise: before running these commands, can you
    calculate the types of [prod_curry] and [prod_uncurry]?) *)

Check @prod_curry.
Check @prod_uncurry.

Example test_uncurry:
  prod_uncurry plus (3,7) = 10.
Proof. reflexivity. Qed.

Theorem uncurry_curry : forall (X Y Z : Type) (f : X -> Y -> Z) x y,
  prod_curry (prod_uncurry f) x y = f x y.
Proof.
  intros. reflexivity.
Qed.

Theorem curry_uncurry : forall (X Y Z : Type)
                               (f : (X * Y) -> Z) (p : X * Y),
  prod_uncurry (prod_curry f) p = f p.
Proof.
  intros. destruct p. simpl. reflexivity.
Qed.


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import List.

Set Implicit Arguments.

Section Forall.

  Variable (X : Type) (P : X -> Prop).

  Fact Forall_cons_inv x l : Forall P (x::l) <-> P x /\ Forall P l.
  Proof.
    split.
    + inversion 1; auto.
    + constructor; tauto.
  Qed.

  Fact Forall_app_inv l m : Forall P (l++m) <-> Forall P l /\ Forall P m.
  Proof.
    induction l; simpl; try (repeat split; auto; tauto).
    do 2 rewrite Forall_cons_inv; tauto.
  Qed.

  Let Forall_rec_1 l : Forall P l -> Forall P (rev l).
  Proof.
    induction 1; simpl; auto.
    apply Forall_app_inv; simpl; auto.
  Qed.

  Fact Forall_rev l : Forall P (rev l) <-> Forall P l.
  Proof.
    split; auto.
    rewrite <- (rev_involutive l) at 2.
    apply Forall_rec_1.
  Qed.

End Forall.

Fact Forall2_lft_nil_inv X Y (R : X -> Y -> Prop) m : Forall2 R nil m -> m = nil.
Proof. inversion 1; auto. Qed.

Fact Forall2_lft_cons_inv X Y (R : X -> Y -> Prop) x l m : Forall2 R (x::l) m -> exists y m', m = y::m' /\ R x y /\ Forall2 R l m'.
Proof. inversion 1; subst; exists y, l'; auto. Qed.

Tactic Notation "inv" "Forall2" "nil" :=
  repeat match goal with H: Forall2 _ nil ?m |- _ => apply Forall2_lft_nil_inv in H; try discriminate; subst m end.

Tactic Notation "inv" "Forall2" "in" hyp(H) "with" ident(x) ident(m) := apply Forall2_lft_cons_inv in H; destruct H as (x & m & ? & ? & ?); subst.

Fact Forall2_fun X Y (R : X -> Y -> Prop) l : (forall x, In x l -> forall y1 y2, R x y1 -> R x y2 -> y1 = y2)
                                            -> forall m1 m2, Forall2 R l m1 -> Forall2 R l m2 -> m1 = m2.
Proof.
  induction l as [ | t l IHl ]; intros Hl l1 l2 H1 H2.
  inv Forall2 nil; auto.
  inv Forall2 in H1 with x1 m1.
  inv Forall2 in H2 with x2 m2.
  f_equal.
  apply Hl with t; simpl; auto.
  apply IHl; auto.
  intros ? ? ? ?; apply Hl; right; auto.
Qed.

Fact Forall2_mono X Y (R S : X -> Y -> Prop) : (forall x y, R x y -> S x y) -> forall l m, Forall2 R l m -> Forall2 S l m.
Proof. induction 2; simpl; auto. Qed.


Theorem and_commutative : (forall A B :Prop,  A /\ B -> B /\ A).
Proof.
intros.
elim H.
intros.
split.
auto.
auto.
Qed.

Theorem or_commutative : (forall A B : Prop, A \/ B -> B \/ A).
Proof.
        intros.
        elim H.
        intro HA.
        clear H. (* remove unnecessary proofs *)
        right.
        trivial.
        auto.
Qed.

Section Predicate_calculus.
        Variable D : Set.
        Variable R : D -> D -> Prop.
Section R_sym_trans.
Hypothesis R_symmetric: (forall x y : D, R x y -> R y x).
Hypothesis R_transitive: (forall x y z : D, R x y -> R y z -> R x z).

Lemma refl_if : forall x : D, (exists y , R x y) -> R x x.
Proof.
        intros x x_Rlinked.
        elim x_Rlinked.
        intros y Rxy.
        apply R_transitive with y.
        assumption.
        apply R_symmetric.
        assumption.
Qed.
End R_sym_trans.


Require Import Frap Helpers.

Require Import Problem.

Fixpoint fact (n: nat): nat :=
  0 (* Part 1: Implement this *)
.

Theorem fact_thm1:
  fact 5 = 120.
Proof.
  (* Part 1: Prove this after implementing fact *)
Admitted.

Theorem fact_thm2: forall (n: nat),
  n > 1 -> (exists (k: nat), fact n = 2 * k).
Proof.
  (* Part 2: Prove this after implementing fact *)
Admitted.

Fixpoint fact_CPS (n: nat) (C: nat -> nat): nat :=
  (* Part 3: Implement factorial using continuation passing style
     C is the continuation *)
  C 0.

Theorem CPS_correct: forall (n: nat) (f: nat -> nat),
 fact_CPS n f = f (fact n).
Proof.
  (* Part 3: Prove factorial using continuation passing style is correct *)
Admitted.

Theorem fact_CPS_thm2: forall (n: nat),
  n > 1 -> (exists (k: nat), fact_CPS n (fun R => R) = 2 * k).
Proof.
  (* Part 4: Freeby: Prove this using CPS_correct and fact_thm2! *)
Admitted.


Require Export "ProofObjects".

Check nat_ind.

Theorem mult_0_r' : forall n:nat,
  n * 0 = 0.
Proof.
  apply nat_ind.
  Case "O". reflexivity.
  Case "S n". intros n H. simpl. apply H.
Qed.

Theorem plus_one_r' : forall n:nat,
  n + 1 = S n.
Proof.
  apply nat_ind.
  Case "O". reflexivity.
  Case "S n". simpl. intros n H. apply f_equal. assumption.
Qed.

Inductive yesno : Type :=
| yes : yesno
| no : yesno.

(*
forall P : yesno -> Prop, P yes -> P no -> forall y, P y *)

Inductive rgb : Type :=
| red : rgb
| green : rgb
| blue : rgb.

(*
forall P : rgb -> Prop, P red -> P green -> P blue -> forall y, P y *)
Check rgb_ind.

Inductive natlist : Type :=
| nnil : natlist
| ncons : nat -> natlist -> natlist.

(*
forall P : natlist -> Prop, P nnil -> (forall (n : nat) (l : natlist),
P l -> P (ncons n l)) -> forall n : natlist, P n *)
Check natlist_ind.

Inductive natlist1 : Type :=
  | nnil1 : natlist1
  | nsnoc1 : natlist1 -> nat -> natlist1.

(*
 forall P : natlist1 -> Prop,
   P nnil1 -> (forall (n : nat) (l : natlist1), P l -> P (nsnoc1 l n)) ->
   forall (n : natlist1), P n *)
Check natlist1_ind.


(**********************************************************************
*
* This file contains a definition of the "look and say" sequence
* https://en.wikipedia.org/wiki/Look-and-say_sequence
*
* Along with a proof that it contains only numbers <= 3 and is decidable.
*
* MIT License
*
* Copyright (c) 2021 Cody Roux (codyroux), see LICENSE file for details.
*
*
*
***********************************************************************)

Require Import List Arith Lia.

Import ListNotations.

Print List.

Inductive LookAndSay : list nat -> list nat -> Prop :=
(* Look at an empty list, and say "empty list" *)
| LAS_nil : LookAndSay [] []
(* See a non-empty consecutive list of k "a"s, and then l1, and say "k a"
   and then whatever you'd have said for l1. *)
| LAS_Cons : forall l1 l2 a k, 0 < k -> hd_error l1 <> Some a -> LookAndSay l1 l2 -> LookAndSay ((repeat a k) ++ l1) (k::a::l2)
.

Hint Constructors LookAndSay.

(* Seems to work *)
Goal LookAndSay [1;1;1;2;2] [3;1;2;2].
Proof.
  replace ([1; 1; 1; 2; 2]) with (repeat 1 3 ++ repeat 2 2 ++ []) by reflexivity.
  apply LAS_Cons; [lia | simpl; congruence | ].
  apply LAS_Cons; [lia | simpl; congruence | ].
  now auto.
Qed.

(* the actual sequence. We could define it recursively, but this
   serves as well (and avoids an existential). *)
Inductive LookAndSay_n : nat -> list nat -> Prop :=
  | LAS_n_0 : LookAndSay_n 0 [1]
  | LAS_n_S : forall n l l', LookAndSay_n n l -> LookAndSay l l' -> LookAndSay_n (S n) l'
.

(* Suprisingly seems to be absent from std lib... *)
Lemma skipn_repeat : forall A n (a : A) k, skipn n (repeat a k) = repeat a (k - n).
Proof.
  induction n; simpl.
  - intros; rewrite Nat.sub_0_r; now auto.
  - induction k; simpl; auto.
Qed.

(* This is the critical trick: we need to bound both the values in the
   list, and the length of consecutive runs of a given value. Again we do
   this with an inductive predicate, since Coq likes these. *)
Inductive val_and_len_bounded : list nat -> Prop :=
| val_and_len_bounded_nil : val_and_len_bounded []
| val_and_len_bounded_cons : forall l1 l2 a k,
    0 < k <= 3 ->
    a <= 3 ->
    hd_error l1 <> Some a ->
    val_and_len_bounded l1 ->
    l2 = repeat a k ++ l1 ->
    val_and_len_bounded l2
.

Hint Constructors val_and_len_bounded.

(* This lemma is really powerful: it allows us to not reasona bout
   list lenght, but instead deduces the critical property for smaller
   lists from larger ones.

   Otherwise we'd have to do a well-founded induction on list length,
   which is tedious.  *)
Lemma bounded_cons : forall n l, val_and_len_bounded l -> val_and_len_bounded (skipn n l).
Proof.
  induction n using lt_wf_ind.
  intros l h.
  inversion h; subst; auto.
  - rewrite skipn_nil; auto.
  - rewrite skipn_app.
    rewrite repeat_length.
    rewrite skipn_repeat.
    destruct (Nat.le_gt_cases k n).
    + replace (k - n) with 0 by lia; simpl.
      apply H; [lia | now auto].
    + replace (n - k) with 0 by lia; simpl.
      apply val_and_len_bounded_cons with (l1 := l1) (a := a) (k := k - n); first [lia | congruence].
Qed.

(* Also surprisingly absent from the stdlib... *)
Lemma skipn_len_app : forall A l1 l2, skipn(A:=A) (length l1) (l1 ++ l2) = l2.
Proof.
  induction l1; simpl; auto.
Qed.

(* Trivial from bounded_cons. *)
Lemma bounded_extensions : forall l1 l2, val_and_len_bounded (l1 ++ l2) -> val_and_len_bounded l2.
Proof.
  intros.
  replace l2 with (skipn (length l1) (l1 ++ l2)) by apply skipn_len_app; auto.
  apply bounded_cons; auto.
Qed.

(* This is also an important property that corresponds to an insight:
   a given value in l1 will lead to the same value in l2, shifted by
   one. This means that a constraint on how many times a value can
   repeat in l1 will propagate to l2. *)
Lemma LAS_hd_second : forall l1 l2 k, LookAndSay l1 (k::l2) -> hd_error l1 = hd_error l2.
Proof.
  intros l1 l2 k h; inversion h.
  destruct k; simpl; [lia| now auto].
Qed.

(* The main lemma. *)
Lemma LAS_bounded : forall l l', LookAndSay l l' -> val_and_len_bounded l -> val_and_len_bounded l'.
Proof.
  intros l l' h.
  induction h.
  - auto.
  - intros h'.
    inversion h'.
    + destruct k; [lia| simpl in *; congruence].
    + clear H6.
      assert (a = a0) by (destruct k; destruct k0; simpl in H5; first [lia | congruence]).
      subst a0.
      destruct (Nat.eq_dec k a); subst.
      -- destruct l2.
         ++ apply val_and_len_bounded_cons with (l1 := []) (a := a) (k := 2);
              simpl; first [lia | congruence | constructor | idtac].
         ++ assert (hd_error l2 <> Some a) by (erewrite <- LAS_hd_second; [exact H0| exact h]).
            destruct (Nat.eq_dec a n); subst.
            { apply val_and_len_bounded_cons with (l1 := l2) (a := n) (k := 3); simpl; first [lia | congruence | auto].
              replace l2 with (skipn 1 (n::l2)) by reflexivity.
              apply bounded_cons.
              apply IHh.
              eapply bounded_extensions; eauto. }
            apply val_and_len_bounded_cons with (l1 := (n::l2)) (a := a) (k := 2); simpl; first [lia | congruence | auto].
            apply IHh; eapply bounded_extensions; eauto.
      -- assert (k = k0).
         (* Ugh I can make this a lemma as well... *)
         { revert H5 H3 H0; clear.
           revert k0 l0 l1 a.
           induction k; induction k0; simpl; auto.
           - intros.
             exfalso.
             destruct l1; simpl in *; congruence.
           - intros.
             destruct l0; simpl in *; congruence.
           - intros; f_equal; eapply IHk; inversion H5; eauto. }
         subst.
         apply val_and_len_bounded_cons with (l1 := (a::l2)) (a := k0) (k := 1); simpl; first [lia | congruence | auto].
         destruct l2.
         ++ apply val_and_len_bounded_cons with (l1 := []) (a := a) (k := 1);
              simpl; first [lia | congruence | constructor | idtac].
         ++ destruct (Nat.eq_dec a n0); subst.
            {
              assert (hd_error l2 <> Some n0) by (erewrite <- LAS_hd_second; [exact H0| exact h]).
              apply val_and_len_bounded_cons with (l1 := l2) (a := n0) (k := 2); simpl; first [lia | congruence | auto].
              replace l2 with (skipn 1 (n0::l2)) by reflexivity.
              apply bounded_cons.
              apply IHh.
              eapply bounded_extensions; eauto. }
            apply val_and_len_bounded_cons with (l1 := (n0::l2)) (a := a) (k := 1);
              simpl; first [lia | congruence | constructor | idtac].
            apply IHh; eapply bounded_extensions; eauto.
Qed.

(* We need to actually show that our strengthened property is stronger! *)
Lemma bounded_In : forall l a, val_and_len_bounded l -> In a l -> a <= 3.
Proof.
  intros l a h; revert a; induction h.
  - intros a h; inversion h.
  - intros b; rewrite H2.
    intros h'.
    generalize (in_app_or _ _ _ h').
    intro h''; destruct h''.
    + generalize (repeat_spec k a b H3); intros; subst; now auto.
    + now auto.
Qed.

(* And seed the recurrence. *)
Lemma bounded_init : val_and_len_bounded [1].
Proof.
  apply val_and_len_bounded_cons with (l1 := []) (a := 1) (k := 1); simpl; first [lia | congruence | auto].
Qed.

(* The main theorem follows as a pretty trivial corollary to the main lemma. *)
Theorem LookAndSay_less_than_3 : forall n l a, LookAndSay_n n l -> In a l -> a <= 3.
Proof.
  intros n l a h.
  apply bounded_In.
  induction h; [apply bounded_init |].
  eapply LAS_bounded; eauto.
Qed.

(*****************************************************************************************************)

(* We also build a quick and dirty proof of decidability for
   [LookAndSay l1 l2], i.e. from any given [l1], we can compute an
   [l2] such that [LookAndSay l1 l2] holds.

   This would be trivial in Prolog :). But in Coq it's a bit finicky,
   because we need to consume a chunk of l1 at each step: basically
   the whole list of contiguous equal elements (probably we could do
   it simply 3 at a time using the above theorem, but...).

   This makes Coq unhappy, because consuming some arbitrary but
   non-zero elements of a list, before a recursive call is
   non-structural.

   We adopt the only sane approach, which is to give a natural number
   as "gas", and proving that a certain number will always suffice to
   compute the result without running out of gas.

 *)

(* It turns out we can break the problem into 2 chunks: getting the
   remaining elements of the list, and counting the prefix of
   identical elements.

   It seems to be a good pattern to break things up like this, though
   it makes for some definition and proof duplication.  *)
Fixpoint get_prefix_tl (l : list nat) (a : nat) : list nat :=
  match l with
  | [] => []
  | b::l' =>
    if a =? b then
      get_prefix_tl l' a
    else l
  end.

Fixpoint get_prefix_len (l : list nat) (a : nat) : nat :=
  match l with
  | [] => 0
  | b::l' => if a =? b then
               S (get_prefix_len l' a)
             else 0
  end.

(* Testing functions in Coq is a surprisingly effective way of not
   getting stuck for hours on trying to prove incorrect theorems! *)
Eval compute in (get_prefix_len [1;1;1;1;1;1;1;2;1;1] 1).
Eval compute in (get_prefix_tl [1;1;1;1;1;1;1;2;1;1] 1).

Lemma get_prefix_len_gt : forall l a, hd_error l = Some a <-> 0 < get_prefix_len l a.
Proof.
  split.
  - destruct l; simpl; [congruence|].
    intros.
    inversion H.
    rewrite <- beq_nat_refl.
    lia.
  - destruct l; simpl; [lia|].
    case_eq (a =? n).
    + intro h; rewrite (beq_nat_true _ _ h); now auto.
    + lia.
Qed.

Lemma get_prefix_len_aux : forall l a, length (get_prefix_tl l a) + (get_prefix_len l a) = length l.
Proof.
  induction l; simpl; auto.
  intros b.
  destruct (b =? a); auto.
  erewrite <- IHl; now eauto.
Qed.

Lemma get_prefix_aux_head : forall l a, hd_error (get_prefix_tl l a) <> Some a.
Proof.
  induction l; simpl; [congruence|].
  intro b; case_eq (b =? a); intro eq_a; simpl.
  - apply IHl.
  - assert (b <> a) by (apply beq_nat_false; now auto).
    congruence.
Qed.

(* We don't use this anywhere, but it captures the spirit. *)
Lemma get_prefix_repeat : forall l a, l = (repeat a (get_prefix_len l a)) ++ (get_prefix_tl l a).
Proof.
  induction l; simpl; auto.
  intros b; case_eq (b =? a); intro eq_a.
  - assert (H : b = a) by (apply beq_nat_true; now auto).
    rewrite H; simpl.
    f_equal; now auto.
  - simpl; now auto.
Qed.

(* We often need finicky "inversion like" lemmas for inductive predicates *)
Lemma LAS_empty : forall l, LookAndSay [] l -> l = [].
Proof.
  intros l h; inversion h; auto.
  destruct k; simpl in *; first [lia | congruence].
Qed.

(* I originally defined this as a single recursive function without
   [get_prefix_foo], and pattern matching on the recursive call to do
   additional work.

   Proofs were not forthcoming.
 *)
Fixpoint look_and_say (gas : nat) (l : list nat) : option (list nat) :=
  match gas with
  | 0 => None
  | S k =>
    match l with
    | [] => Some []
    | a::l' =>
      option_map (fun l'' => S (get_prefix_len l' a) :: a :: l'') (look_and_say k (get_prefix_tl l' a))
    end
  end.

Lemma look_and_say_gas : forall k l, length l < k -> look_and_say k l <> None.
Proof.
  induction k; simpl.
  - lia.
  - intros l len.
    destruct l.
    + congruence.
    + unfold option_map.
       simpl in len.
       assert (length (get_prefix_tl l n) <= length l).
      -- erewrite <- (get_prefix_len_aux l) with (a := n).
         lia.
      -- assert (len' : length (get_prefix_tl l n) < k) by lia.
         generalize (IHk _ len'); intro H'.
         case_eq (look_and_say k (get_prefix_tl l n)); intros; simpl; congruence.
Qed.

(* the main lemma for [get_prefix_tl] *)
Lemma get_prefix_tl_repeat : forall l a k,
 hd_error l <> Some a ->
    get_prefix_tl (repeat a k ++ l) a = l.
  induction k; simpl.
  - induction l; simpl; auto.
    intro neq.
    assert (a <> a0) by congruence.
    rewrite<- Nat.eqb_neq in *.
    rewrite H; auto.
  - rewrite<- beq_nat_refl.
    auto.
Qed.

(* the main lemma for [get_prefix_len] *)
Lemma get_prefix_len_repeat : forall l a k,
 hd_error l <> Some a ->
 get_prefix_len (repeat a k ++ l) a = k.
Proof.
  induction k; simpl.
  - induction l; simpl; auto.
    intro neq.
    assert (a <> a0) by congruence.
    rewrite<- Nat.eqb_neq in *.
    rewrite H; auto.
  - rewrite<- beq_nat_refl.
    auto.
Qed.

(* The main lemma for [look_and_say], handles the non-trivial case of the theorem.*)
Lemma look_and_say_repeat : forall gas l a k,
    0 < k ->
    hd_error l <> Some a ->
    look_and_say (S gas) ((repeat a k) ++ l) = option_map (fun l'' => k :: a :: l'') (look_and_say gas l).
Proof.
  intros.
  simpl.
  destruct k; simpl; first [lia | congruence | idtac].
  rewrite get_prefix_len_repeat; auto.
  rewrite get_prefix_tl_repeat; auto.
Qed.

(* This theorem could be made simpler by simply fixing [gas = length l + 1], but we'd need this as a lemma. *)
Theorem LAS_cons : forall l l',
    LookAndSay l l' ->
    forall gas,
      length l < gas ->
      Some l' = look_and_say gas l.
Proof.
  intros l l' las.
  induction las.
  - simpl; destruct gas; first [lia | auto].
  - rewrite app_length, repeat_length.
    intros.
    destruct gas; [lia |].
    rewrite look_and_say_repeat; auto.
    erewrite <- IHlas; [eauto | lia ].
Qed.


Module Lecture10.

Print nat.

Theorem t1: 2 * 2 = 4.
Proof.
    Print "*".
    simpl.
    reflexivity.
Qed.

Theorem t2: exists x, x * 2 = 4.
Proof.
  exists 2.
  apply t1.
Qed.

Print t2.
Print t1.

Theorem t3: exists x y, x*y = 4.
Proof.
  exists 2.
  exists 2.
  apply t1.
Qed.

Print t3.

Inductive bool: Type :=
| true
| false
.

Check false.
Check (bool -> bool): Type.
Check (fun b: bool => b).

Check (fun b => bool).

Check (fun b => b) true.
Check fun (f: bool -> bool) => f true.

Compute (fun b => b) 1.

Definition i := fun b: bool => b.
Check i.
Compute i true.

Definition neg :=
  fun (b: bool) =>
    match b with
    | true  => false
    | false => true
  end.

Check neg.

Compute neg false.
Compute neg true.

Definition and (a b: bool) : bool :=
  match a with
  | false => false
  | true  => b
end.

Compute and true true.
Compute and true false.

(*

Set : Type(0)
Prop : Type(0)
\forall i Type(i)

BHK interptertation
 exists p:A . P(p) - (a \in A, P)
*)

Print "=".

(*
  A -> Prop

  (fun (x: nat) => x%2 == 0): nat -> Prop
*)

Inductive eq (A : Type) (x : A) : A -> Prop :=
  eq_refl : eq x x
.

Print nat.

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

Check S(S(S O)).

Definition succn := S.

(*
There are some possible signatures of pred is possible:
  predn: nat -> nat
  predn: nat -> Option nat
  predn: forall n: nat, (n <> 0) -> nat
*)

Definition predn (n :nat) : nat :=
  match n with
  | S x => x
  | O => O
end.

Fixpoint addn (n m: nat) {struct n}: nat :=
  match n with
  | O => m
  | S k => S (addn k m)
end.

Compute addn (S (S O)) (S (S O)).

Print list.

Inductive list (A : Type) : Type :=
	| nil : list A
  | cons : A -> list A -> list A
.

Theorem list2: list nat.
Proof.
  apply cons.
  {
    apply 1.
  }
  apply cons.
  {
    apply 2.
  }
  apply nil.
Qed.

Set Printing All.
Check 5 + 5.