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

Require Import Arith Omega List Relations.

Set Implicit Arguments.

Section list_splits.

  Variables (X : Type).

  Implicit Types (l : list X).

  Fixpoint list_splits l :=
    match l with
      | nil =>  ((nil,nil)::nil)
      | x::l => (nil,x::l)::map (fun (c : list X * list X) => let (u,v) := c in (x::u,v)) (list_splits l)
    end.

  Fact list_splits_spec l x y : In (x,y) (list_splits l) <-> x++y = l.
  Proof.
    revert x y.
    induction l as [ | a l IH ]; intros x y; simpl; split.
    intros [ H | [] ]; injection H; intros; subst; auto.
    destruct x; destruct y; try discriminate 1; tauto.
    intros [ H | H ].
    injection H; intros; subst; auto.
    apply in_map_iff in H.
    destruct H as ((u,v) & H1 & H2).
    injection H1; clear H1; intros ? ?; subst x y.
    rewrite IH in H2.
    rewrite <- H2; auto.
    intros H.
    destruct x as [ | a' x ].
    simpl in H; subst y; left; auto.
    injection H; clear H; intros ? ?; subst a' l; right.
    apply in_map_iff.
    exists (x,y).
    rewrite IH; auto.
  Qed.

  Definition lmr l := flat_map (fun c => match c with (_,nil) => nil | (l,x::r) => (l,(x,r))::nil end) (list_splits l).

  Fact lmr_spec ll w : In w (lmr ll) <-> exists l x r, ll = l++x::r /\ w = (l,(x,r)).
  Proof.
    unfold lmr; rewrite in_flat_map.
    split.

    intros ((l,[ | x r ]) & H1 & H2).
    destruct H2.
    destruct H2 as [ H2 | [] ]; subst.
    apply list_splits_spec in H1; subst.
    exists l, x, r; auto.

    intros (l & x & r & H1 & H2); subst.
    exists (l,x::r); split; simpl; auto.
    rewrite list_splits_spec; auto.
  Qed.

  Let list_msplits k l : { ll | forall m, In m ll <-> flat_map (fun x => x) m = l /\ length m = S k }.
  Proof.
    revert l; induction k as [ | k IH ]; intros l.

    exists ((l::nil)::nil); split.
    intros [ ? | [] ]; subst; simpl; rewrite <- app_nil_end; auto.
    intros (H1 & H2).
    destruct m as [ | a [ | ] ]; try discriminate H2; simpl in H1.
    rewrite <- app_nil_end in H1; subst a; left; auto.

    set (h l := proj1_sig (IH l)).
    assert (Hh : forall l m, In m (h l) <-> flat_map (fun x => x) m = l /\ length m = S k).
      intros u; apply (proj2_sig (IH u)).
    generalize h Hh; clear h Hh IH; intros h Hh.

    set (g (c : list X * list X) := let (w1,w2) := c in map (fun d => w1::d) (h w2)).

    exists (flat_map g (list_splits l)).
    intros m; split.

    rewrite in_flat_map.
    intros ((u,v) & H1 & H2).
    unfold g in H2.
    rewrite list_splits_spec in H1.
    rewrite in_map_iff in H2.
    destruct H2 as (ll & H2 & H3).
    rewrite Hh in H3.
    destruct H3 as (H3 & H4).
    subst m l v; split; simpl; auto.

    intros (H1 & H2).
    rewrite in_flat_map.
    destruct m as [ | a m ]; try discriminate H2.
    simpl in H2; injection H2; clear H2; intros H2.
    simpl in H1; subst l.
    exists (a, flat_map (fun x => x) m); split.
    rewrite list_splits_spec; auto.
    unfold g.
    rewrite in_map_iff.
    exists m; split; auto.
    rewrite Hh; split; auto.
  Qed.

  Definition list_multi_splits k l := proj1_sig (list_msplits k l).

  Fact list_multi_splits_spec k l mm : In mm (list_multi_splits k l) <-> flat_map (fun x => x) mm = l /\ length mm = S k.
  Proof.
    apply (proj2_sig (list_msplits k l)).
  Qed.

End list_splits.


(*|
########################################
Inductive definition for family of types
########################################

:Link: https://stackoverflow.com/q/37366941
|*)

(*|
Question
********

I have been struggling on this for a while now. I have an inductive
type:
|*)

Definition char := nat.
Definition string := list char.

Inductive Exp : Set :=
| Lit  : char -> Exp
| And  : Exp -> Exp -> Exp
| Or   : Exp -> Exp -> Exp
| Many : Exp -> Exp.

(*| from which I define a family of types inductively: |*)

Inductive Language : Exp -> Set :=
| LangLit     : forall c : char, Language (Lit c)
| LangAnd     :
  forall r1 r2 : Exp, Language(r1) -> Language(r2) -> Language(And r1 r2)
| LangOrLeft  : forall r1 r2 : Exp, Language(r1) -> Language(Or r1 r2)
| LangOrRight : forall r1 r2 : Exp, Language(r2) -> Language(Or r1 r2)
| LangEmpty   : forall r : Exp, Language (Many r)
| LangMany    :
  forall r : Exp, Language (Many r) -> Language r -> Language (Many r).

(*|
The rational here is that given a regular expression ``r : Exp`` I am
attempting to represent the language associated with ``r`` as a type
``Language r``, and I am doing so with a single inductive definition.

I would like to prove:
|*)

Lemma L1 : forall (c : char) (x : Language (Lit c)),
    x = LangLit c.
Abort. (* .none *)

(*|
(In other words, the type ``Language (Lit c)`` has only one element,
i.e. the language of the regular expression ``'c'`` is made of the
single string ``"c"``. Of course I need to define some semantics
converting elements of ``Language r`` to ``string``)

Now the specifics of this problem are not important and simply serve
to motivate my question: let us use ``nat`` instead of ``Exp`` and let
us define a type ``List n`` which represents the lists of length
``n``:
|*)

Parameter A : Set.
Inductive List : nat -> Set :=
| ListNil  : List 0
| ListCons : forall n : nat, A -> List n -> List (S n).

(*|
Here again I am using a single inductive definition to define a family
of types ``List n``.

I would like to prove:
|*)

Lemma L2 : forall x : List 0, x = ListNil.
Abort. (* .none *)

(*|
(in other words, the type ``List 0`` has only one element).

I have run out of ideas on this one.

Normally when attempting to prove (negative) results with inductive
types (or predicates), I would use the ``elim`` tactic (having made
sure all the relevant hypothesis are inside my goal (``generalize``)
and only variables occur in the type constructors). But ``elim`` is no
good in this case.
|*)

(*|
Answer
******

If you are willing to accept more than just the basic logic of Coq,
you can just use the ``dependent destruction`` tactic, available in
the ``Program`` library (I've taken the liberty of rephrasing your
last example in terms of standard-library vectors):
|*)

Require Coq.Vectors.Vector.

Require Import Program.

Lemma l0 A (v : Vector.t A 0) : v = @Vector.nil A.
Proof.
  now dependent destruction v.
Qed.

(*|
If you inspect the term, you'll see that this tactic relied on the
``JMeq_eq`` axiom to get the proof to go through:
|*)

Print Assumptions l0. (* .unfold *)

(*|
Fortunately, it is possible to prove ``l0`` without having to resort
to features outside of Coq's basic logic, by making a small change to
the statement of the previous lemma.
|*)

Lemma l0_gen A n (v : Vector.t A n) :
  match n return Vector.t A n -> Prop with
  | 0 => fun v => v = @Vector.nil A
  | _ => fun _ => True
  end v.
Proof.
  now destruct v.
Qed.

Lemma l0' A (v : Vector.t A 0) : v = @Vector.nil A.
Proof.
  exact (l0_gen A 0 v).
Qed.

(*|
We can see that this new proof does not require any additional axioms:
|*)

Print Assumptions l0'. (* .unfold *)

(*|
What happened here? The problem, roughly speaking, is that in Coq we
cannot perform case analysis on terms of dependent types whose indices
have a specific shape (such as ``0``, in your case) *directly*.
Instead, we must prove a more general statement where the problematic
indices are replaced by variables. This is exactly what the ``l0_gen``
lemma is doing. Notice how we had to make the match on ``n`` return a
function that abstracts on ``v``. This is another instance of what is
known as `"convoy pattern"
<http://adam.chlipala.net/cpdt/html/Cpdt.MoreDep.html>`__. Had we
written

.. code-block:: coq

    match n with
    | 0 => v = @Vector.nil A
    | _ => True
    end.

Coq would see the ``v`` in the ``0`` branch as having type ``Vector.t
A n``, making that branch ill-typed.

Coming up with such generalizations is one of the big pains of doing
dependently typed programming in Coq. Other systems, such as Agda,
make it possible to write this kind of code with much less effort, but
it was only recently `shown
<https://people.cs.kuleuven.be/~jesper.cockx/Without-K/Pattern-matching-without-K.pdf>`__
that this can be done without relying on the extra axioms that Coq
wanted to avoid including in its basic theory. We can only hope that
this will be simplified in future versions.

----

**A:** I also find this alternative proof ``by apply: eq_dep_eq; move
E: {1 2}0 v => iz v; case: iz / v E.`` useful sometimes. Indeed,
``eq_dep`` and similar tricks can be very useful when working with
dependent types.
|*)


(** * Logic: Logic in Coq *)
(* Zhiwei Wu, Wenrui Meng  5 hours for each*)

Require Export MoreProp.
Inductive Ptree (X:Type) : Type :=
 | c1 : X -> X -> Ptree X
 | c2 : Ptree X -> Ptree X -> Ptree X
.
Implicit Arguments c1 [[X]].
Implicit Arguments c2 [[X]].
Fixpoint flug {X Y : Type } (l : Ptree X) (f : X->Y) : Ptree Y :=
match l with
|  c1 x1 x2 => c1 (f x1) (f x2)
|  c2 p1 p2 => c2 (flug p1 f) (flug p2 f)
end
.

(** Coq's built-in logic is very small: the only primitives are
    [Inductive] definitions, universal quantification ([forall]), and
    implication ([->]), while all the other familiar logical
    connectives -- conjunction, disjunction, negation, existential
    quantification, even equality -- can be encoded using just these.

    This chapter explains the encodings and shows how the tactics
    we've seen can be used to carry out standard forms of logical
    reasoning involving these connectives. *)

(* ########################################################### *)
(** * Conjunction *)

(** The logical conjunction of propositions [P] and [Q] can be
    represented using an [Inductive] definition with one
    constructor. *)

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

(** Note that, like the definition of [ev] in the previous
    chapter, this definition is parameterized; however, in this case,
    the parameters are themselves propositions, rather than numbers. *)

(** The intuition behind this definition is simple: to
    construct evidence for [and P Q], we must provide evidence
    for [P] and evidence for [Q].  More precisely:

    - [conj p q] can be taken as evidence for [and P Q] if [p]
      is evidence for [P] and [q] is evidence for [Q]; and

    - this is the _only_ way to give evidence for [and P Q] --
      that is, if someone gives us evidence for [and P Q], we
      know it must have the form [conj p q], where [p] is
      evidence for [P] and [q] is evidence for [Q].

   Since we'll be using conjunction a lot, let's introduce a more
   familiar-looking infix notation for it. *)

Notation "P /\ Q" := (and P Q) : type_scope.

(** (The [type_scope] annotation tells Coq that this notation
    will be appearing in propositions, not values.) *)

(** Consider the "type" of the constructor [conj]: *)

Check conj.
(* ===>  forall P Q : Prop, P -> Q -> P /\ Q *)

(** Notice that it takes 4 inputs -- namely the propositions [P]
    and [Q] and evidence for [P] and [Q] -- and returns as output the
    evidence of [P /\ Q]. *)

(** Besides the elegance of building everything up from a tiny
    foundation, what's nice about defining conjunction this way is
    that we can prove statements involving conjunction using the
    tactics that we already know.  For example, if the goal statement
    is a conjuction, we can prove it by applying the single
    constructor [conj], which (as can be seen from the type of [conj])
    solves the current goal and leaves the two parts of the
    conjunction as subgoals to be proved separately. *)

Theorem and_example :
  (beautiful 0) /\ (beautiful 3).
Proof.
  apply conj.
  (* Case "left". *) apply b_0.
  (* Case "right". *) apply b_3.  Qed.

(** Let's take a look at the proof object for the above theorem. *)

Print and_example.
(* ===>  conj (beautiful 0) (beautiful 3) b_0 b_3
            : beautiful 0 /\ beautiful 3 *)

(** Note that the proof is of the form
    conj (beautiful 0) (beautiful 3)
         (...pf of beautiful 3...) (...pf of beautiful 3...)
    as you'd expect, given the type of [conj]. *)

(** Just for convenience, we can use the tactic [split] as a shorthand for
    [apply conj]. *)

Theorem and_example' :
  (ev 0) /\ (ev 4).
Proof.
  split.
    Case "left". apply ev_0.
    Case "right". apply ev_SS. apply ev_SS. apply ev_0.  Qed.

(** Conversely, the [inversion] tactic can be used to take a
    conjunction hypothesis in the context, calculate what evidence
    must have been used to build it, and add variables representing
    this evidence to the proof context. *)

Theorem proj1 : forall P Q : Prop,
  P /\ Q -> P.
Proof.
  intros P Q H.
  inversion H as [HP HQ].
  apply HP.  Qed.

(** **** Exercise: 1 star, optional (proj2) *)
Theorem proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
 intros. inversion H as [HP HQ].
 apply HQ. Qed.

(** [] *)

Theorem and_commut : forall P Q : Prop,
  P /\ Q -> Q /\ P.
Proof.
  (* WORKED IN CLASS *)
  intros P Q H.
  inversion H as [HP HQ].
  split.
    (* Case "left". *) apply HQ.
    (* Case "right".*) apply HP.  Qed.

(** Once again, we have commented out the [Case] tactics to make the
    proof object for this theorem easy to understand.  Examining it
    shows that all that is really happening is taking apart a record
    containing evidence for [P] and [Q] and rebuilding it in the
    opposite order: *)

Print and_commut.
(* ===>
   and_commut =
     fun (P Q : Prop) (H : P /\ Q) =>
     let H0 := match H with
               | conj HP HQ => conj Q P HQ HP
               end
     in H0
     : forall P Q : Prop, P /\ Q -> Q /\ P *)

(** **** Exercise: 2 stars (and_assoc) *)
(** In the following proof, notice how the _nested pattern_ in the
    [inversion] breaks the hypothesis [H : P /\ (Q /\ R)] down into
    [HP: P], [HQ : Q], and [HR : R].  Finish the proof from there: *)

Theorem and_assoc : forall P Q R : Prop,
  P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
  intros P Q R H.
  inversion H as [HP [HQ HR]].
  split. split. apply HP. apply HQ. apply HR.
  Qed.

(** [] *)

(** **** Exercise: 2 stars (even__ev) *)
(** Now we can prove the other direction of the equivalence of [even]
   and [ev], which we left hanging in chapter [Prop].  Notice that the
   left-hand conjunct here is the statement we are actually interested
   in; the right-hand conjunct is needed in order to make the
   induction hypothesis strong enough that we can carry out the
   reasoning in the inductive step.  (To see why this is needed, try
   proving the left conjunct by itself and observe where things get
   stuck.) *)

Theorem even__ev : forall n : nat,
  (even n -> ev n) /\ (even (S n) -> ev (S n)).
Proof.
  intros. induction n as [| n'].
  Case "n = 0".
  split. intro. apply ev_0.
  intro. inversion H.

  Case "n = S n'".
  split. inversion IHn' as [HN HS].
  apply HS.
  inversion IHn' as [H1 H2]. intro.
  inversion H. unfold even in H1. apply H1 in H3.
  apply ev_SS. apply H3.
  Qed.

(** [] *)

(** **** Exercise: 2 stars, optional (conj_fact) *)
(** Construct a proof object demonstrating the following proposition. *)
Theorem conj_fact' : forall P Q R, P /\ Q -> Q /\ R -> P /\ R.
Proof.
intros. apply conj. apply proj1 in H. apply H.
apply proj2 in H0. apply H0. Qed.

Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R :=
fun P Q R (H1:(P /\ Q)) ( H2:( Q /\ R))
=> conj P R  (proj1 P Q H1) (proj2 Q R H2).

(** [] *)

(* ###################################################### *)
(** ** Iff *)

(** The handy "if and only if" connective is just the conjunction of
    two implications. *)

Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P).

Notation "P <-> Q" := (iff P Q)
                      (at level 95, no associativity)
                      : type_scope.

Theorem iff_implies : forall P Q : Prop,
  (P <-> Q) -> P -> Q.
Proof.
  intros P Q H.
  inversion H as [HAB HBA]. apply HAB.  Qed.

Theorem iff_sym : forall P Q : Prop,
  (P <-> Q) -> (Q <-> P).
Proof.
  (* WORKED IN CLASS *)
  intros P Q H.
  inversion H as [HAB HBA].
  split.
    Case "->". apply HBA.
    Case "<-". apply HAB.  Qed.

(** **** Exercise: 1 star, optional (iff_properties) *)
(** Using the above proof that [<->] is symmetric ([iff_sym]) as
    a guide, prove that it is also reflexive and transitive. *)

Theorem iff_refl : forall P : Prop,
  P <-> P.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem iff_trans : forall P Q R : Prop,
  (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
  (* FILL IN HERE *) Admitted.

(** Hint: If you have an iff hypothesis in the context, you can use
    [inversion] to break it into two separate implications.  (Think
    about why this works.) *)
(** [] *)

(** **** Exercise: 2 stars, advanced (beautiful_iff_gorgeous) *)

(** We have seen that the families of propositions [beautiful] and
    [gorgeous] actually characterize the same set of numbers.
    Prove that [beautiful n <-> gorgeous n] for all [n].  Just for
    fun, write your proof as an explicit proof object, rather than
    using tactics. (_Hint_: if you make use of previously defined
    theorems, you should only need a single line!) *)

Definition beautiful_iff_gorgeous :
  forall n, beautiful n <-> gorgeous n :=
fun n => conj (beautiful n -> gorgeous n) (gorgeous n -> beautiful n)
(beautiful__gorgeous n) (gorgeous__beautiful n).

(** [] *)

(** Some of Coq's tactics treat [iff] statements specially, thus
    avoiding the need for some low-level manipulation when reasoning
    with them.  In particular, [rewrite] can be used with [iff]
    statements, not just equalities. *)

(* ############################################################ *)
(** * Disjunction *)

(** Disjunction ("logical or") can also be defined as an
    inductive proposition. *)

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

Notation "P \/ Q" := (or P Q) : type_scope.

(** Consider the "type" of the constructor [or_introl]: *)

Check or_introl.
(* ===>  forall P Q : Prop, P -> P \/ Q *)

(** It takes 3 inputs, namely the propositions [P], [Q] and
    evidence of [P], and returns, as output, the evidence of [P \/ Q].
    Next, look at the type of [or_intror]: *)

Check or_intror.
(* ===>  forall P Q : Prop, Q -> P \/ Q *)

(** It is like [or_introl] but it requires evidence of [Q]
    instead of evidence of [P]. *)

(** Intuitively, there are two ways of giving evidence for [P \/ Q]:

    - give evidence for [P] (and say that it is [P] you are giving
      evidence for -- this is the function of the [or_introl]
      constructor), or

    - give evidence for [Q], tagged with the [or_intror]
      constructor. *)

(** Since [P \/ Q] has two constructors, doing [inversion] on a
    hypothesis of type [P \/ Q] yields two subgoals. *)

Theorem or_commut : forall P Q : Prop,
  P \/ Q  -> Q \/ P.
Proof.
  intros P Q H.
  inversion H as [HP | HQ].
    Case "left". apply or_intror. apply HP.
    Case "right". apply or_introl. apply HQ.  Qed.

(** From here on, we'll use the shorthand tactics [left] and [right]
    in place of [apply or_introl] and [apply or_intror]. *)

Theorem or_commut' : forall P Q : Prop,
  P \/ Q  -> Q \/ P.
Proof.
  intros P Q H.
  inversion H as [HP | HQ].
    Case "left". right. apply HP.
    Case "right". left. apply HQ.  Qed.

(** **** Exercise: 2 stars, 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!). *)

(* FILL IN HERE *)
(** [] *)

Theorem or_distributes_over_and_1 : forall P Q R : Prop,
  P \/ (Q /\ R) -> (P \/ Q) /\ (P \/ R).
Proof.
  intros P Q R. intros H. inversion H as [HP | [HQ HR]].
    Case "left". split.
      SCase "left". left. apply HP.
      SCase "right". left. apply HP.
    Case "right". split.
      SCase "left". right. apply HQ.
      SCase "right". right. apply HR.  Qed.

(** **** Exercise: 2 stars (or_distributes_over_and_2) *)
Theorem or_distributes_over_and_2 : forall P Q R : Prop,
  (P \/ Q) /\ (P \/ R) -> P \/ (Q /\ R).
Proof.
 intros. inversion H.
 inversion H0.
 Case "P".
 apply or_introl. apply H2.
 Case "Q R". inversion H1.
   SCase "P". apply or_introl. apply H3.
   SCase "Q". apply or_intror. split. apply H2. apply H3.
Qed.

(** [] *)

(** **** Exercise: 1 star, optional (or_distributes_over_and) *)
Theorem or_distributes_over_and : forall P Q R : Prop,
  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ################################################### *)
(** ** Relating [/\] and [\/] with [andb] and [orb] (advanced) *)

(** We've already seen several places where analogous structures
    can be found in Coq's computational ([Type]) and logical ([Prop])
    worlds.  Here is one more: the boolean operators [andb] and [orb]
    are clearly analogs of the logical connectives [/\] and [\/].
    This analogy can be made more precise by the following theorems,
    which show how to translate knowledge about [andb] and [orb]'s
    behaviors on certain inputs into propositional facts about those
    inputs. *)

Theorem andb_true__and : forall b c,
  andb b c = true -> b = true /\ c = true.
Proof.
  (* WORKED IN CLASS *)
  intros b c H.
  destruct b.
    Case "b = true". destruct c.
      SCase "c = true". apply conj. reflexivity. reflexivity.
      SCase "c = false". inversion H.
    Case "b = false". inversion H.  Qed.

Theorem and__andb_true : forall b c,
  b = true /\ c = true -> andb b c = true.
Proof.
  (* WORKED IN CLASS *)
  intros b c H.
  inversion H.
  rewrite H0. rewrite H1. reflexivity. Qed.

(** **** Exercise: 2 stars, optional (bool_prop) *)
Theorem andb_false : forall b c,
  andb b c = false -> b = false \/ c = false.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem orb_true : forall b c,
  orb b c = true -> b = true \/ c = true.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem orb_false : forall b c,
  orb b c = false -> b = false /\ c = false.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ################################################### *)
(** * Falsehood *)

(** Logical falsehood can be represented in Coq as an inductively
    defined proposition with no constructors. *)

Inductive False : Prop := .

(** Intuition: [False] is a proposition for which there is no way
    to give evidence. *)

(** Since [False] has no constructors, inverting an assumption
    of type [False] always yields zero subgoals, allowing us to
    immediately prove any goal. *)

Theorem False_implies_nonsense :
  False -> 2 + 2 = 5.
Proof.
  intros contra.
  inversion contra.  Qed.

(** How does this work? The [inversion] tactic breaks [contra] into
    each of its possible cases, and yields a subgoal for each case.
    As [contra] is evidence for [False], it has _no_ possible cases,
    hence, there are no possible subgoals and the proof is done. *)

(** Conversely, the only way to prove [False] is if there is already
    something nonsensical or contradictory in the context: *)

Theorem nonsense_implies_False :
  2 + 2 = 5 -> False.
Proof.
  intros contra.
  inversion contra.  Qed.

(** Actually, since the proof of [False_implies_nonsense]
    doesn't actually have anything to do with the specific nonsensical
    thing being proved; it can easily be generalized to work for an
    arbitrary [P]: *)

Theorem ex_falso_quodlibet : forall (P:Prop),
  False -> P.
Proof.
  (* WORKED IN CLASS *)
  intros P contra.
  inversion contra.  Qed.

(** The Latin _ex falso quodlibet_ means, literally, "from
    falsehood follows whatever you please."  This theorem is also
    known as the _principle of explosion_. *)

(* #################################################### *)
(** ** Truth *)

(** Since we have defined falsehood in Coq, one might wonder whether
    it is possible to define truth in the same way.  We can. *)

(** **** Exercise: 2 stars, advanced (True) *)
(** Define [True] as another inductively defined proposition.  (The
    intution is that [True] should be a proposition for which it is
    trivial to give evidence.) *)

Inductive True : Prop := P.

(** [] *)

(** However, unlike [False], which we'll use extensively, [True] is
    just a theoretical curiosity: it is trivial (and therefore
    uninteresting) to prove as a goal, and it carries no useful
    information as a hypothesis. *)

(* #################################################### *)
(** * Negation *)

(** The logical complement of a proposition [P] is written [not
    P] or, for shorthand, [~P]: *)

Definition not (P:Prop) := P -> False.

(** The intuition is that, if [P] is not true, then anything at
    all (even [False]) follows from assuming [P]. *)

Notation "~ x" := (not x) : type_scope.

Check not.
(* ===> Prop -> Prop *)

(** It takes a little practice to get used to working with
    negation in Coq.  Even though you can see perfectly well why
    something is true, it can be a little hard at first to get things
    into the right configuration so that Coq can see it!  Here are
    proofs of a few familiar facts about negation to get you warmed
    up. *)

Theorem not_False :
  ~ False.
Proof.
  unfold not. intros H. inversion H.  Qed.

Theorem contradiction_implies_anything : forall P Q : Prop,
  (P /\ ~P) -> Q.
Proof.
  (* WORKED IN CLASS *)
  intros P Q H. inversion H as [HP HNA]. unfold not in HNA.
  apply HNA in HP. inversion HP.  Qed.

Theorem double_neg : forall P : Prop,
  P -> ~~P.
Proof.
  (* WORKED IN CLASS *)
  intros P H. unfold not. intros G. apply G. apply H.  Qed.

(** **** Exercise: 2 stars, advanced (double_neg_inf) *)
(** Write an informal proof of [double_neg]:

   _Theorem_: [P] implies [~~P], for any proposition [P].

   _Proof_:
           Suppose P as a Prop, we must show (P->False)->False according to the definition of not.
           Suppose (P-> False) as H, we need make a implication False according to the hypertheses.
           We can apply P in H, then we get False, which is exact the goal.
(* FILL IN HERE *)
   []

*)

(** **** Exercise: 2 stars (contrapositive) *)
Theorem contrapositive : forall P Q : Prop,
  (P -> Q) -> (~Q -> ~P).
Proof.
intros. unfold not in H0.
unfold not. intro.
apply H in H1. apply H0 in H1.
apply H1.
Qed.

(** [] *)

(** **** Exercise: 1 star (not_both_true_and_false) *)
Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
intros. unfold not. intro.
inversion H. apply H1 in H0. apply H0.
Qed.

(** [] *)

(** **** Exercise: 1 star, advanced (informal_not_PNP) *)
(** Write an informal proof (in English) of the proposition [forall P
    : Prop, ~(P /\ ~P)]. *)

(* FILL IN HERE *)
(**
_Proof_:
By the definition of not, we must show  P/\ ~P -> False.
Then we split the hyperthesis P/\~P into two hypertheses P as H1 and ~P as H2.
We change H2 to P -> False according to the definition of not.
Applying H1 in H2, we can get False.
 *)

Theorem five_not_even :
  ~ ev 5.
Proof.
  (* WORKED IN CLASS *)
  unfold not. intros Hev5. inversion Hev5 as [|n Hev3 Heqn].
  inversion Hev3 as [|n' Hev1 Heqn']. inversion Hev1.  Qed.

(** **** Exercise: 1 star (ev_not_ev_S) *)
(** Theorem [five_not_even] confirms the unsurprising fact that five
    is not an even number.  Prove this more interesting fact: *)

Theorem ev_not_ev_S : forall n,
  ev n -> ~ ev (S n).
Proof.
  unfold not. intros n H. induction H. (* not n! *)
  Case "basecase".
  intro H'. inversion H'.
  Case "inductive".
  intro. apply SSev__even in H0. apply IHev in H0.
  apply H0. Qed.

(** [] *)

(** Note that some theorems that are true in classical logic are _not_
    provable in Coq's (constructive) logic.  E.g., let's look at how
    this proof gets stuck... *)

Theorem classic_double_neg : forall P : Prop,
  ~~P -> P.
Proof.
  (* WORKED IN CLASS *)
  intros P H. unfold not in H.
  (* But now what? There is no way to "invent" evidence for [~P]
     from evidence for [P]. *)
  Admitted.

(** **** Exercise: 5 stars, advanced, optional (classical_axioms) *)
(** For those who like a challenge, here is an exercise
    taken from the Coq'Art book (p. 123).  The following five
    statements are often considered as characterizations of
    classical logic (as opposed to constructive logic, which is
    what is "built in" to Coq).  We can't prove them in Coq, but
    we can consistently add any one of them as an unproven axiom
    if we wish to work in classical logic.  Prove that these five
    propositions are equivalent. *)

Definition peirce := forall P Q: Prop,
  ((P->Q)->P)->P.
Definition classic := forall P:Prop,
  ~~P -> P.
Definition excluded_middle := forall P:Prop,
  P \/ ~P.
Definition de_morgan_not_and_not := forall P Q:Prop,
  ~(~P/\~Q) -> P\/Q.
Definition implies_to_or := forall P Q:Prop,
  (P->Q) -> (~P\/Q).

(* FILL IN HERE *)
(** [] *)

(* ########################################################## *)
(** ** Inequality *)

(** Saying [x <> y] is just the same as saying [~(x = y)]. *)

Notation "x <> y" := (~ (x = y)) : type_scope.

(** Since inequality involves a negation, it again requires
    a little practice to be able to work with it fluently.  Here
    is one very useful trick.  If you are trying to prove a goal
    that is nonsensical (e.g., the goal state is [false = true]),
    apply the lemma [ex_falso_quodlibet] to change the goal to
    [False].  This makes it easier to use assumptions of the form
    [~P] that are available in the context -- in particular,
    assumptions of the form [x<>y]. *)

Theorem not_false_then_true : forall b : bool,
  b <> false -> b = true.
Proof.
  intros b H. destruct b.
  Case "b = true". reflexivity.
  Case "b = false".
    unfold not in H.
    apply ex_falso_quodlibet.
    apply H. reflexivity.   Qed.

(** **** Exercise: 2 stars (not_eq_beq_false) *)
Theorem not_eq_beq_false : forall n n' : nat,
     n <> n' ->
     beq_nat n n' = false.
Proof.
 intros n n'. remember (beq_nat n n') as b.
 destruct b.
 Case "true". intro. apply beq_nat_eq in Heqb.
 unfold not in H. apply H in Heqb. inversion Heqb.
 Case "false". intro. reflexivity. Qed.

(** [] *)

(** **** Exercise: 2 stars, optional (beq_false_not_eq) *)
Theorem beq_false_not_eq : forall n m,
  false = beq_nat n m -> n <> m.
Proof.

  (* FILL IN HERE *) Admitted.
(** [] *)

(* ############################################################ *)
(** * Existential Quantification *)

(** Another critical logical connective is _existential
    quantification_.  We can express it with the following
    definition: *)

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

(** That is, [ex] is a family of propositions indexed by a type [X]
    and a property [P] over [X].  In order to give evidence for the
    assertion "there exists an [x] for which the property [P] holds"
    we must actually name a _witness_ -- a specific value [x] -- and
    then give evidence for [P x], i.e., evidence that [x] has the
    property [P].

    For example, consider this existentially quantified proposition: *)

Definition some_nat_is_even : Prop :=
  ex nat ev.

(** To prove this proposition, we need to choose a particular number
    as witness -- say, 4 -- and give some evidence that that number is
    even. *)

Definition snie : some_nat_is_even :=
  ex_intro _ ev 4 (ev_SS 2 (ev_SS 0 ev_0)).

(** Coq's [Notation] facility can be used to introduce more
    familiar notation for writing existentially quantified
    propositions, exactly parallel to the built-in syntax for
    universally quantified propositions.  Instead of writing [ex nat
    ev] to express the proposition that there exists some number that
    is even, for example, we can write [exists x:nat, ev x].  (It is
    not necessary to understand exactly how the [Notation] definition
    works.) *)

Notation "'exists' x , p" := (ex _ (fun x => p))
  (at level 200, x ident, right associativity) : type_scope.
Notation "'exists' x : X , p" := (ex _ (fun x:X => p))
  (at level 200, x ident, right associativity) : type_scope.

(** We can use the usual set of tactics for
    manipulating existentials.  For example, to prove an
    existential, we can [apply] the constructor [ex_intro].  Since the
    premise of [ex_intro] involves a variable ([witness]) that does
    not appear in its conclusion, we need to explicitly give its value
    when we use [apply]. *)

Example exists_example_1 : exists n, n + (n * n) = 6.
Proof.
  apply ex_intro with (witness:=2).
  reflexivity.  Qed.

(** Note, again, that we have to explicitly give the witness. *)

(** Or, instead of writing [apply ex_intro with (witness:=e)] all the
    time, we can use the convenient shorthand [exists e], which means
    the same thing. *)

Example exists_example_1' : exists n, n + (n * n) = 6.
Proof.
  exists 2.
  reflexivity.  Qed.

(** Conversely, if we have an existential hypothesis in the
    context, we can eliminate it with [inversion].  Note the use
    of the [as...] pattern to name the variable that Coq
    introduces to name the witness value and get evidence that
    the hypothesis holds for the witness.  (If we don't
    explicitly choose one, Coq will just call it [witness], which
    makes proofs confusing.) *)

Theorem exists_example_2 : forall n,
  (exists m, n = 4 + m) ->
  (exists o, n = 2 + o).
Proof.
  intros n H.
  inversion H as [m Hm].
  exists (2 + m).
  apply Hm.  Qed.

(** **** Exercise: 1 star, optional (english_exists) *)
(** In English, what does the proposition
      ex nat (fun n => beautiful (S n))
]]
    mean? *)

(* FILL IN HERE *)

(** Complete the definition of the following proof object: *)

Definition p : ex nat (fun n => beautiful (S n)) :=
(* FILL IN HERE *) admit.
(** [] *)

(** **** Exercise: 1 star (dist_not_exists) *)
(** Prove that "[P] holds for all [x]" and "there is no [x] for
    which [P] does not hold" are equivalent assertions. *)

Theorem dist_not_exists : forall (X:Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  intro X. intro P. intro H. unfold not.
  intro H0. elim H0. intros.
  assert (P witness). apply H. apply H1 in H2. inversion H2.
  Qed.

(** [] *)

(** **** Exercise: 3 stars, optional (not_exists_dist) *)
(** (The other direction of this theorem requires the classical "law
    of the excluded middle".) *)

Theorem not_exists_dist :
  excluded_middle ->
  forall (X:Type) (P : X -> Prop),
    ~ (exists x, ~ P x) -> (forall x, P x).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars (dist_exists_or) *)
(** Prove that existential quantification distributes over
    disjunction. *)

Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
intros X P. split. intro H.
inversion H as [x H1]. inversion H1 as [HL | HR].
apply or_introl. apply ex_intro with (witness := x). apply HL.
apply or_intror. apply ex_intro with (witness := x). apply HR.

intro H. inversion H. inversion H0 as [x H1].
apply ex_intro with (witness := x). apply or_introl. apply H1.
inversion H0. apply ex_intro with (witness := witness). apply or_intror.
apply H1. Qed.

(** [] *)

Print dist_exists_or.

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

(** Even Coq's equality relation is not built in.  It has (roughly)
    the following inductive definition. *)

(* (We enclose the definition in a module to avoid confusion with the
    standard library equality, which we have used extensively
    already.) *)

Module MyEquality.

Inductive eq (X:Type) : X -> X -> Prop :=
  refl_equal : forall x, eq X x x.

(** Standard infix notation: *)

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

(** The definition of [=] is a bit subtle.  The way to think about it
    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 [refl_equal] to a
    type [X] and a value [x : X] yields evidence that [x] is equal to
    [x]. *)

(** **** Exercise: 2 stars (leibniz_equality) *)
(** The inductive definitions of equality corresponds to _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 leibniz_equality : forall (X : Type) (x y: X),
 x = y -> forall P : X -> Prop, P x -> P y.
Proof.
intros X x y H P.
inversion H.
trivial.
Qed.

(** [] *)

(** We can use
    [refl_equal] to construct evidence that, for example, [2 = 2].
    Can we also use it to construct evidence that [1 + 1 = 2]?  Yes:
    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 [Eval simpl], include
    evaluation of function application, inlining of definitions, and
    simplification of [match]es.

    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 :=
  refl_equal nat 4.

Definition singleton : forall (X:Set) (x:X), []++[x] = x::[]  :=
  fun (X:Set) (x:X) => refl_equal (list X) [x].

End MyEquality.

(* ####################################################### *)
(** ** Inversion, Again (Advanced) *)

(** 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
n   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 [refl_equal] 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.  *)

(** **** Exercise: 1 star, optional (dist_and_or_eq_implies_and) *)
Lemma dist_and_or_eq_implies_and : forall P Q R,
P /\ (Q \/ R) /\ Q = R -> P/\Q.
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(* ########################################################### *)
(** * Quantification and Implication *)

(** In fact, the built-in logic is even smaller than it appears, since
    [->] and [forall] are actually the _same_ primitive!

    The [->] notation is actually just a shorthand for a degenerate
    use of [forall]. *)

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

Definition funny_prop1 :=
  forall n, forall (E : beautiful n), beautiful (n+3).

(** A proof term inhabiting this proposition would be a function
    with two arguments: a number [n] and some evidence [E] that [n] is
    beautiful.  But the name [E] for this evidence is not used in the
    rest of the statement of [funny_prop1], 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 funny_prop1' :=
  forall n, forall (_ : beautiful n), beautiful (n+3).

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

Definition funny_prop1'' :=
  forall n, beautiful n -> beautiful (n+3).

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

(* ####################################################### *)
(** * Relations *)

(** A proposition parameterized by a number (such as [ev] or
    [beautiful]) can be thought of as a _property_ -- i.e., it defines
    a subset of [nat], namely those numbers for which the proposition
    is provable.  In the same way, a two-argument proposition can be
    thought of as a _relation_ -- i.e., it defines a set of pairs for
    which the proposition is provable. *)

Module LeModule.

(** We've seen an inductive definition of one fundamental relation:
    equality.  Another useful one is the "less than or equal to"
    relation on numbers: *)

(** The following definition should be fairly intuitive.  It
    says that there are two ways to give evidence that one number is
    less than or equal to another: either observe that they are the
    same number, or give evidence that the first is less than or equal
    to the predecessor of the second. *)

Inductive le : nat -> nat -> Prop :=
  | le_n : forall n, le n n
  | le_S : forall n m, (le n m) -> (le n (S m)).

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

(** Proofs of facts about [<=] using the constructors [le_n] and
    [le_S] follow the same patterns as proofs about properties, like
    [ev] in chapter [Prop].  We can [apply] the constructors to prove [<=]
    goals (e.g., to show that [3<=3] or [3<=6]), and we can use
    tactics like [inversion] to extract information from [<=]
    hypotheses in the context (e.g., to prove that [~(2 <= 1)].) *)

(** Here are 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] and
    [reflexivity] don't do the job, because the proofs aren't just a
    matter of simplifying computations.) *)

Theorem test_le1 :
  3 <= 3.
Proof.
  (* WORKED IN CLASS *)
  apply le_n.  Qed.

Theorem test_le2 :
  3 <= 6.
Proof.
  (* WORKED IN CLASS *)
  apply le_S. apply le_S. apply le_S. apply le_n.  Qed.

Theorem test_le3 :
  ~ (2 <= 1).
Proof.
  (* WORKED IN CLASS *)
  intros H. inversion H. inversion H2.  Qed.

(** The "strictly less than" relation [n < m] can now be defined
    in terms of [le]. *)

End LeModule.

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 (n * n).

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

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

(** **** Exercise: 2 stars (total_relation) *)
(** Define an inductive binary relation [total_relation] that holds
    between every pair of natural numbers. *)

Inductive total_relation : nat -> nat -> Prop :=
tr : forall n1 n2 : nat, total_relation n1 n2.

(** [] *)

(** **** Exercise: 2 stars (empty_relation) *)
(** Define an inductive binary relation [empty_relation] (on numbers)
    that never holds. *)
Inductive empty_relation : nat -> nat -> Prop :=
er : forall n m : nat, False -> empty_relation n m.

(** [] *)

(** **** Exercise: 3 stars (R_provability) *)
Module R.
(** We can define three-place relations, four-place relations,
    etc., in just the same way as binary relations.  For example,
    consider the following three-place relation on numbers: *)

Inductive R : nat -> nat -> nat -> Prop :=
   | c1 : R 0 0 0
   | c2 : forall m n o, R m n o -> R (S m) n (S o)
   | c3 : forall m n o, R m n o -> R m (S n) (S o)
   | c4 : forall m n o, R (S m) (S n) (S (S o)) -> R m n o
   | c5 : forall m n o, R m n o -> R n m o.

(** - Which of the following propositions are provable?
      - [R 1 1 2]
      - [R 2 2 6]

    - If we dropped constructor [c5] from the definition of [R],
      would the set of provable propositions change?  Briefly (1
      sentence) explain your answer.

    - If we dropped constructor [c4] from the definition of [R],
      would the set of provable propositions change?  Briefly (1
      sentence) explain your answer.

(* FILL IN HERE
[R 1 1 2] is provable. The other is not.
No, it wouldn't change.

No, it wouldn't change. c1 and c2 can derive c4.

 *)
[]
*)

(** **** Exercise: 3 stars, optional (R_fact) *)
(** State and prove an equivalent characterization of the relation
    [R].  That is, if [R m n o] is true, what can we say about [m],
    [n], and [o], and vice versa?
*)

(* FILL IN HERE *)
(** [] *)

End R.

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

(** **** Exercise: 3 stars (all_forallb) *)
(** Inductively define a property [all] of lists, parameterized by a
    type [X] and a property [P : X -> Prop], such that [all X P l]
    asserts that [P] is true for every element of the list [l]. *)

Inductive all (X : Type) (P : X -> Prop) : list X -> Prop :=
| all_nil : all X P []
| all_recursive : forall (hd : X) (l : list X), P hd -> all X P l
                                                -> all X P (hd::l).
  (* FILL IN HERE *)

(** Recall the function [forallb], from the exercise
    [forall_exists_challenge] in chapter [Poly]: *)

(*Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool :=
  match l with
    | [] => true
    | x :: l' => andb (test x) (forallb test l')
  end.
*)
(** Using the property [all], write down a specification for [forallb],
    and prove that it satisfies the specification. Try to make your
    specification as precise as possible.

    Are there any important properties of the function [forallb] which
    are not captured by your specification? *)

Theorem all_forallb : forall (X : Type) (test : X -> bool) (l : list X), (all X (fun x:X => (test x = true)) l) <-> (forallb  test l = true).
Proof.
intros. split.
Case "forward".
intro H. induction l as [| h tl].
   SCase "nil for l". reflexivity.
   SCase "inductive case". simpl. inversion H. rewrite H2.
   simpl. apply IHtl. apply H3.

Case "backward".
intro H. induction l as [| h tl].
    SCase "nil for l". apply all_nil.
    SCase "inductive case". apply all_recursive.
    simpl in H. apply andb_true_elim1 in H. apply H.
    simpl in H. apply andb_true_elim2 in H. apply IHtl. apply H.
Qed.
(** [] *)

(** **** Exercise: 4 stars, advanced (filter_challenge) *)
(** One of the main purposes of Coq is to prove that programs match
    their specifications.  To this end, let's prove that our
    definition of [filter] matches a specification.  Here is the
    specification, written out informally in English.

    Suppose we have a set [X], a function [test: X->bool], and a list
    [l] of type [list X].  Suppose further that [l] is an "in-order
    merge" of two lists, [l1] and [l2], such that every item in [l1]
    satisfies [test] and no item in [l2] satisfies test.  Then [filter
    test l = l1].

    A list [l] is an "in-order merge" of [l1] and [l2] if it contains
    all the same elements as [l1] and [l2], in the same order as [l1]
    and [l2], but possibly interleaved.  For example,
    [1,4,6,2,3]
    is an in-order merge of
    [1,6,2]
    and
    [4,3].
    Your job is to translate this specification into a Coq theorem and
    prove it.  (Hint: You'll need to begin by defining what it means
    for one list to be a merge of two others.  Do this with an
    inductive relation, not a [Fixpoint].)  *)
Inductive in_order_merge {X:Type}: list X -> list X -> list X -> Prop :=
| nil_l : forall l, in_order_merge nil l l
| l_nil : forall l, in_order_merge l nil l
| head_l: forall (x:X) (l1 l2 l: list X),
  in_order_merge l1 l2 l -> in_order_merge (x::l1) l2 (x::l)
| l_head: forall (x:X) (l1 l2 l: list X),
  in_order_merge l1 l2 l -> in_order_merge l1 (x::l2) (x::l).

Lemma all_false_filter_empty : forall (X : Type) (l : list X) (test: X->bool),
all X (fun x => test x = false) l -> filter test l = [].
Proof.
intros. induction l as [| hd tl].
Case "[]". reflexivity.
Case "hd :: l'".
inversion H.
apply IHtl in H3.
simpl. rewrite H2. apply H3.
Qed.

Lemma all_true_filter_full : forall (X : Type) (l : list X) (test: X->bool),
all X (fun x => test x = true) l -> filter test l = l.
Proof.
intros. induction l as [| hd tl].
Case "[]". reflexivity.
Case "hd :: l'".
inversion H.
apply IHtl in H3.
simpl. rewrite H2. rewrite H3.
reflexivity. Qed.

Theorem filter_challenge : forall (X : Type) (l l1 l2 : list X) (test : X -> bool),
all X  (fun x => test x = true) l1 ->
all X  (fun x => test x = false) l2 ->
in_order_merge l1 l2 l ->
filter test l = l1.
Proof.
intros.  induction H1.
Case "nil_l ". apply all_false_filter_empty.  apply H0.
Case "l_nil".  apply all_true_filter_full.   apply H.
Case "head_l ". inversion H. apply IHin_order_merge in H5. simpl.
                rewrite H4. rewrite H5. reflexivity.
                apply H0.
Case "l_head". inversion H0. simpl. rewrite H4.
               apply IHin_order_merge. apply H. apply H5.
Qed.
(** [] *)

(** **** Exercise: 5 stars, advanced, optional (filter_challenge_2) *)
(** A different way to formally characterize the behavior of [filter]
    goes like this: Among all subsequences of [l] with the property
    that [test] evaluates to [true] on all their members, [filter test
    l] is the longest.  Express this claim formally and prove it. *)

(* FILL IN HERE *)
(** [] *)

(** **** Exercise: 4 stars, advanced (no_repeats) *)
(** The following inductively defined proposition... *)

Inductive appears_in {X:Type} (a:X) : list X -> Prop :=
  | ai_here : forall l, appears_in a (a::l)
  | ai_later : forall b l, appears_in a l -> appears_in a (b::l).

(** ...gives us a precise way of saying that a value [a] appears at
    least once as a member of a list [l].

    Here's a pair of warm-ups about [appears_in].
*)
Check ai_later.
Check ai_here.
Definition appears_example : forall x y : nat, appears_in  4 [x, 4, y]:=
fun x y => ai_later 4 x [4, y] (ai_here 4 [y]).

Lemma appears_in_app : forall {X:Type} (xs ys : list X) (x:X),
     appears_in x (xs ++ ys) -> appears_in x xs \/ appears_in x ys.
Proof.
intros. induction xs as [|h l'].
Case "xs = []". simpl in H. apply or_intror. apply H.
Case "xs = h :: l'". inversion H.
      SCase "ai_here". rewrite <- H1. apply or_introl. apply ai_here.
      SCase "ai_later". apply IHl' in H1. inversion H1. apply or_introl.
                        apply ai_later. apply H3.
                        apply or_intror. apply H3.
Qed.

Lemma app_appears_in : forall {X:Type} (xs ys : list X) (x:X),
     appears_in x xs \/ appears_in x ys -> appears_in x (xs ++ ys).
Proof.
intros. inversion H.
Case "left".
induction xs as [| hd l].
        SCase "xs = []". inversion H0.
        SCase "xs = hd :: l". inversion H0. apply ai_here.
                unfold app. apply ai_later. assert (appears_in x l \/ appears_in x ys).
                apply or_introl. apply H2. apply IHl in H4. apply H4. apply H2.
Case "right".
induction xs as [| hd l].
        SCase "xs = nil". apply H0.
        SCase "xs = hd :: l". apply ai_later. assert (appears_in x l \/ appears_in x ys).
                  apply or_intror. apply H0. apply IHl in H1. apply H1.
Qed.

(** Now use [appears_in] to define a proposition [disjoint X l1 l2],
    which should be provable exactly when [l1] and [l2] are
    lists (with elements of type X) that have no elements in common. *)

Definition disjoint (X:Type) (l1 l2 : list X) :=
    forall x:X, appears_in x l1 -> not (appears_in x l2).

(* FILL IN HERE *)

(** Next, use [appears_in] to define an inductive proposition
    [no_repeats X l], which should be provable exactly when [l] is a
    list (with elements of type [X]) where every member is different
    from every other.  For example, [no_repeats nat [1,2,3,4]] and
    [no_repeats bool []] should be provable, while [no_repeats nat
    [1,2,1]] and [no_repeats bool [true,true]] should not be.  *)

Inductive no_repeats (X : Type) : list X -> Prop :=
| nil_case : no_repeats X nil
| head_case : forall x l, ~(appears_in x l) -> no_repeats X l
                                           -> no_repeats X (x::l).

(* FILL IN HERE *)

(** Finally, state and prove one or more interesting theorems relating
    [disjoint], [no_repeats] and [++] (list append).  *)
(*I proved two related theorems*)
Lemma head_not_appears : forall (X : Type) (x:X) (l1 l2 : list X),
no_repeats X ((x::l1) ++ l2) -> ~ appears_in x l2.
Proof.
intros.
induction l1 as [| hd l'].
simpl in H. inversion H. apply H2.
simpl in H. inversion H. inversion H3.

assert (~ appears_in x (l'++l2)). unfold not.
intro. assert (appears_in x (hd::l'++l2)). apply ai_later. apply H8.
unfold not in H2. apply H2 in H9. apply H9.

apply IHl'. apply head_case. apply H8. apply H7.
Qed.

Theorem disjoint_no_repeats : forall (X : Type) (l1 l2 : list X),
 no_repeats X (l1 ++ l2) -> disjoint X l1 l2.
Proof.
intros. induction l1 as [| x l'].
Case "l1 = nil".
unfold disjoint. intros z H1.  inversion H1.
Case "l1 = x :: l'".
inversion H. apply IHl' in H3.

assert (~ appears_in x l2). apply head_not_appears with (l1:=l').
apply H.

unfold disjoint. intros. inversion H5.
      SCase "x1 = x". apply H4.
      SCase "x1 is not head". unfold disjoint in H3.
             apply H3 in H7. apply H7.
Qed.

(** [] *)

(** **** Exercise: 2 stars, optional (le_exercises) *)
(** Here are a number of facts about the [<=] and [<] relations that
    we are going to need later in the course.  The proofs make good
    practice exercises. *)

Theorem O_le_n : forall n,
  0 <= n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem n_le_m__Sn_le_Sm : forall n m,
  n <= m -> S n <= S m.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem Sn_le_Sm__n_le_m : forall n m,
  S n <= S m -> n <= m.
Proof.
  intros n m.  generalize dependent n.  induction m.
  (* FILL IN HERE *) Admitted.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem plus_lt : forall n1 n2 m,
  n1 + n2 < m ->
  n1 < m /\ n2 < m.
Proof.
 (* FILL IN HERE *) Admitted.

Theorem lt_S : forall n m,
  n < m ->
  n < S m.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem ble_nat_true : forall n m,
  ble_nat n m = true -> n <= m.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem ble_nat_n_Sn_false : forall n m,
  ble_nat n (S m) = false ->
  ble_nat n m = false.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem ble_nat_false : forall n m,
  ble_nat n m = false -> ~(n <= m).
Proof.
  (* Hint: Do the right induction! *)
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars (nostutter) *)
(** Formulating inductive definitions of predicates is an important
    skill you'll need in this course.  Try to solve this exercise
    without any help at all (except from your study group partner, if
    you have one).

    We say that a list of numbers "stutters" if it repeats the same
    number consecutively.  The predicate "[nostutter mylist]" means
    that [mylist] does not stutter.  Formulate an inductive definition
    for [nostutter].  (This is different from the [no_repeats]
    predicate in the exercise above; the sequence [1,4,1] repeats but
    does not stutter.) *)

Inductive nostutter:  list nat -> Prop :=
 | nil_nostutter : nostutter nil
 | one_nostutter : forall (x : nat), nostutter [x]
 | two_nostutter : forall (x y : nat), (x <> y) -> nostutter [x,y]
 | heads_nostutter : forall (x y : nat) (l : list nat),
                            nostutter (y :: l) -> (x <> y) -> nostutter (x::y::l).

(** Make sure each of these tests succeeds, but you are free
    to change the proof if the given one doesn't work for you.
    Your definition might be different from mine and still correct,
    in which case the examples might need a different proof.

    The suggested proofs for the examples (in comments) use a number
    of tactics we haven't talked about, to try to make them robust
    with respect to different possible ways of defining [nostutter].
    You should be able to just uncomment and use them as-is, but if
    you prefer you can also prove each example with more basic
    tactics.  *)

Example test_nostutter_1:      nostutter [3,1,4,1,5,6].
Proof. repeat constructor; apply beq_false_not_eq; auto. Qed.

Example test_nostutter_2:  nostutter [].
Proof. repeat constructor; apply beq_false_not_eq; auto. Qed.

Example test_nostutter_3:  nostutter [5].
Proof. repeat constructor; apply beq_false_not_eq; auto. Qed.

Example test_nostutter_4:      not (nostutter [3,1,1,4]).
  Proof. intro.
  repeat match goal with
    h: nostutter _ |- _ => inversion h; clear h; subst
  end.
  contradiction H5;  auto. contradiction H5. auto.
Qed.
(** [] *)

(** **** Exercise: 4 stars, advanced (pigeonhole principle) *)
(** The "pigeonhole principle" states a basic fact about counting:
   if you distribute more than [n] items into [n] pigeonholes, some
   pigeonhole must contain at least two items.  As is often the case,
   this apparently trivial fact about numbers requires non-trivial
   machinery to prove, but we now have enough... *)

(** First a pair of useful lemmas (we already proved these for lists
    of naturals, but not for arbitrary lists). *)

Lemma app_length : forall {X:Type} (l1 l2 : list X),
  length (l1 ++ l2) = length l1 + length l2.
Proof.
intros. induction l1 as [| hd tl].
Case "l1 = []".
reflexivity.
Case "l1 = hd :: tl".
simpl. rewrite IHtl. reflexivity.
Qed.

Lemma appears_in_app_split : forall {X:Type} (x:X) (l:list X),
  appears_in x l ->
  exists l1, exists l2, l = l1 ++ (x::l2).
Proof.
intros.
induction l as [| hd tl].
Case "l = nil".
inversion H.
Case "l = hd :: tl".
inversion H. SCase "x = hd". exists nil. exists tl. reflexivity.
             SCase "ai_later". apply IHtl in H1. inversion H1 as [l1' Hl2].
                               inversion Hl2 as [l2' Hl12].
                               exists (hd::l1'). exists (l2'). simpl.
                               rewrite Hl12. reflexivity.
Qed.

(** Now define a predicate [repeats] (analogous to [no_repeats] in the
   exercise above), such that [repeats X l] asserts that [l] contains
   at least one repeated element (of type [X]).  *)

Inductive repeats {X:Type} : list X -> Prop :=
 | repeat_head : forall (x : X) (l : list X), appears_in x l -> repeats (x::l)
 | repeat_tail : forall (x : X) (l : list X), repeats l -> repeats (x::l)
.

(** Now here's a way to formalize the pigeonhole principle. List [l2]
   represents a list of pigeonhole labels, and list [l1] represents an
   assignment of items to labels: if there are more items than labels,
   at least two items must have the same label.  You will almost
   certainly need to use the [excluded_middle] hypothesis. *)

Lemma pigeonhole_helper: forall {X:Type} (x y : X) (l1 l2 : list X),
appears_in x (l1++(y::l2)) -> x<>y -> appears_in x (l1++l2).
Proof.
intros. induction l1 as [| hd tl].
Case "l1 = nil". simpl in H. inversion H. contradiction H0. apply H2.
Case "l1 = hd::tl". inversion H. apply ai_here.
apply IHtl in H2. apply ai_later. apply H2.
Qed.

Theorem pigeonhole_principle: forall {X:Type} (l1 l2:list X),
  excluded_middle ->
  (forall x, appears_in x l1 -> appears_in x l2) ->
  length l2 < length l1 ->
  repeats l1.
Proof.  intros. generalize dependent l2.
induction l1 as [| hd tl].
Case "l1 = nil".
intros. inversion H1.
Case "l1 = hd :: tl".
assert ((appears_in hd tl) \/ (~ appears_in hd tl)).
apply H.
inversion H0. intros.
   SCase "repeat_head appears_in hd tl". apply repeat_head. apply H1.
   SCase "repeat_tail ~ appears_in hd tl". intros.
          assert (appears_in hd l2). apply H2. apply ai_here.
          apply appears_in_app_split in H4. inversion H4 as [ la Hb ].
          inversion Hb as [lb].
          remember (la ++ lb) as l2'. apply repeat_tail.  apply IHtl with (l2:= l2').

          intros. assert (x <> hd). unfold not. intro. rewrite H7 in H6.
          apply H1 in H6. apply H6. rewrite Heql2'.
          apply ai_later with (b := hd) in H6. apply H2 in H6. rewrite H5 in H6.
          apply pigeonhole_helper in H6. apply H6. apply H7.

          rewrite H5 in H3.  rewrite app_length in H3. simpl in H3.
          rewrite <- plus_n_Sm in H3. rewrite <- app_length in H3. rewrite Heql2'.
          apply Lt.lt_S_n. apply H3.
Qed.
(** [] *)

(* $Date: 2013-02-06 20:50:09 -0500 (Wed, 06 Feb 2013) $ *)

Inductive ptree (X:Type) : Type :=
| c11 : X -> X -> ptree X
| c21 : ptree X -> ptree X -> ptree X.

Definition exam_test1 : forall (P Q R : Prop), (P \/ Q -> R) -> Q -> R :=
fun (P Q R : Prop) => fun (H: P \/ Q -> R) (X:Q) => H (or_intror P Q X).
Check le_n. Check (le_n 1 ).

(*Fixpoint remove {X:Type} (l1 : list X) (x: X) : list X :=
match l1 with
[] => []
|hd::l1' => if hd = x then l1' else [hd]++ remove l1' x
end. *)


From mathcomp Require Import all_ssreflect.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(**

----------------------------------------------------------
#
#
** Lesson 8: summary

- OOP with mix-ins
- subtypes & automation

Let's remember the truth:

#
#
Coq is an object oriented
programming language.
#
#

#
#
----------------------------------------------------------
#
#
** OOP

# #

Let's see another interface, the one of finite types

#
#
*)

Print Finite.class_of. (* we extend choice with a mix in *)

Print Finite.mixin_of. (* we mix in countable and two specific
                          fields: an enumeration and an axiom *)

Print Finite.axiom.
Print count_mem.

Eval lazy in count_mem 3 [:: 1;2;3;4;3;2;1].

(* The property of finite types is that *)

Check fun (T : eqType) (enum : seq T) =>
        forall x : T, count_mem x enum = 1.

Section Example.

Variable T : finType.

(* Cardinality of a finite type *)
Check #| T |.

(* "bounded" quantification *)
Check [forall x : T, x == x] && false.
Fail Check (forall x : T, x == x) && false.

End Example.

(**
#
#

#
(notes)
#
This slide corresponds to
section 6.1 and 6.2 of
#the Mathematical Components book#
#

#

#

#
#
#

----------------------------------------------------------
#
#
** Sub types

A sub type extends another type by adding a property.
The new type has a richer theory.
The new type inherits the original theory.

Let's define the type of homogeneous tuples

#
#
*)

Module Tup.

Record tuple_of n T := Tuple {
  tval  :> seq T;
  tsize :  size tval == n
}.
Notation "n .-tuple" := (tuple_of n) : type_scope.

Lemma size_tuple T n (t : n .-tuple T) : size t = n.
Proof. by case: t => s /= /eqP. Qed.

Example seq_on_tuple (n : nat) (t : n .-tuple nat) :
  size (rev [seq 2 * x | x <- rev t]) = size t.
Proof.
by rewrite map_rev revK size_map.
Undo.
rewrite size_tuple.
Fail rewrite size_tuple.
Abort.

(**
#
#

We instrument Coq to automatically promote
sequences to tuples.

#
#
*)

Lemma rev_tupleP n A (t : n .-tuple A) : size (rev t) == n.
Proof. by rewrite size_rev size_tuple. Qed.
Canonical rev_tuple n A (t : n .-tuple A) := Tuple (rev_tupleP t).

Lemma map_tupleP n A B (f: A -> B) (t: n .-tuple A) : size (map f t) == n.
Proof. by rewrite size_map size_tuple. Qed.
Canonical map_tuple n A B (f: A -> B) (t: n .-tuple A) := Tuple (map_tupleP f t).

Example seq_on_tuple2 n (t : n .-tuple nat) :
  size (rev [seq 2 * x | x <- rev t]) = size t.
Proof. rewrite size_tuple. rewrite size_tuple. by []. Qed.

(**
#
#

Reamrk how [t] is a tuple, then it becomes a list by going
trough rev and map, and is finally "promoted" back to a tuple
by this [Canonical] magic.

Now we the tuple type to form an eqType,
exactly as seq does.

Which is the expected comparison for tuples?

#
#
*)

Lemma p1 : size [:: 1;2] == 2. Proof. by []. Qed.
Lemma p2 : size ([:: 1] ++ [::2]) == 2. Proof. by rewrite cat_cons cat0s. Qed.

Definition t1 := {| tval := [::1;2];        tsize := p1 |}.
Definition t2 := {| tval := [::1] ++ [::2]; tsize := p2 |}.

Lemma tuple_uip : t1 = t2.
Proof.
rewrite /t1 /t2. rewrite /=.
Fail by [].
congr (Tuple _).
Fail by [].
(*About bool_irrelevance.*)
apply: bool_irrelevance.
Qed.

(**
#
#

Given that propositions are expressed (whenever possible)
as booleans we can systematically prove that proofs
of these properties are irrelevant.

As a consequence we can form subtypes and systematically
prove that the projection to the supertype is injective,
that means we can craft an eqType.

#
#
*)

Canonical tuple_subType n T := Eval hnf in [subType for (@tval n T)].
Definition tuple_eqMixin n (T : eqType) := Eval hnf in [eqMixin of n .-tuple T by <:].
Canonical tuple_eqType n (T : eqType) := Eval hnf in EqType (n .-tuple T) (tuple_eqMixin n T).

Check [eqType of 3.-tuple nat].

Example test_eqtype (x y : 3.-tuple nat) : x == y -> True.
Proof.
move=> /eqP H.
Abort.

End Tup.

(**
#
#

Tuples is are part of the library, that also contains
many other "promotions"

#
#
*)

Check [finType of 3.-tuple bool].
Fail Check [finType of 3.-tuple nat].

(**
#
#

Tuples is not the only subtype part of the library.
Another one is ['I_n], the finite type of natural
numbers smaller than n.

#
#
*)

Print ordinal.
Check [eqType of 'I_3].
Check [finType of 'I_3].

About tnth. (* like the safe nth function for vectors *)

(**
#
#

It is easy to combine these bricks by subtyping (and "specialization")

#
#
*)

Check {set 'I_4} : Type.
Check forall a : {set 'I_4}, (a == set0) || (1 < #| a | < 4).
Print set_type.
Check {ffun 'I_4 -> bool} : Type.
Print finfun_type.
Check [eqType of #| 'I_4 | .-tuple bool].
Check [finType of #| 'I_4 | .-tuple bool].

Check {ffun 'I_4 * 'I_6 -> nat} : Type.
Check [eqType of {ffun 'I_4 * 'I_6 -> nat}] : Type.

From mathcomp Require Import all_algebra.
Open Scope ring_scope.

Print matrix.

Section Rings.

Variable R : ringType.

Check forall x : R, x * 1 == x.

Check forall m : 'M[R]_(4,4), m == m * m.

End Rings.

(**
#
#

#
(notes)
#
This slide corresponds to
section 6.1 and 6.2 of
#the Mathematical Components book#
#

#

#

#
#
#

----------------------------------------------------------
#
#
** Sum up

- subtypes add properties and inherit the theory of the supertype
  thanks to boolean predicates (UIP).
  In some cases the property can be inferred by Coq, letting one apply
  a lemma about the subtype on terms of the supertype.

#
#

*)


Set Implicit Arguments.
Set Asymmetric Patterns.
Require Import Cpdt.CpdtTactics.
Require Import Classical_Prop.
Require Import List.
Require Import Bool.Bool.

Definition var := nat % type.
Definition total_map := var -> bool.
Definition t_empty : total_map :=
  (fun _ => false).
Definition t_update (m : total_map)
                    (x : var) (v : bool) :=
  fun x' => if PeanoNat.Nat.eqb x x' then v else m x'.
(* to create an empty total map with default value *)
Notation "'_' '!->' v" := t_empty
                            (at level 100, right associativity).
(* extending existing map with some bindings *)
Notation "x '!->' v ';' m" := (t_update m x v)
                              (at level 100, v at next level, right associativity).

Lemma t_update_eq : forall (m : total_map) x v,
  (x !-> v ; m) x = v.
Proof. intros.
       unfold t_update. rewrite PeanoNat.Nat.eqb_refl. crush. Qed.

Definition tvals := total_map.

Inductive formula : Set :=
| Var : var -> formula
| Not : var -> formula
| Disj : formula -> formula -> formula
| Conj : formula -> formula -> formula.

Definition eq_nat_dec (n m : var) : {n = m} + {n <> m}.
decide equality.
Defined.
(*
Definition In_lst (x : var) (ls : list var) : {In x ls} + {~(In x ls)}.
  induction ls.
  - crush.
  - inversion IHls.
    left. crush.
    destruct (eq_nat_dec x a).
    + left. crush.
    + right. crush.
Defined.

Fixpoint remove_dups ls : list var :=
  match ls with
  | nil => nil
  | x :: xs => match (In_lst x xs) with
                 | left _ => remove_dups xs
                 | right _ => x :: remove_dups xs
                 end
  end.
 *)

Definition nodup_var := nodup eq_nat_dec.

Fixpoint vars_in_formula f : list var :=
  match f with
  | Var v => v :: nil
  | Not v => v :: nil
  | Disj f1 f2 => nodup_var (vars_in_formula f1 ++ vars_in_formula f2)
  | Conj f1 f2 => nodup_var (vars_in_formula f1 ++ vars_in_formula f2)
  end.

Inductive maybe (A : Set) (P : A -> Prop) : Set :=
| Unknown : maybe P
| Found : forall x : A, P x -> maybe P.

(* we can define some new notations for convenient usage of type maybe. *)
Notation "{{ x | P }}" := (maybe (fun x => P)).
Notation "??" := (Unknown _ ).
Notation "[| x |]" := (Found _ x _).

Fixpoint evalFormula f map {struct f} : bool :=
  match f with
  | Var v => map v
  | Not v => negb (map v)
  | Disj f1 f2 => orb (evalFormula f1 map) (evalFormula f2 map)
  | Conj f1 f2 => andb (evalFormula f1 map) (evalFormula f2 map)
  end.

Fixpoint CreateAllFalsesMap (ls : list var) map : tvals :=
  match ls with
  | nil => map
  | x :: xs => CreateAllFalsesMap xs (x !-> false ; map)
  end.

Eval simpl in CreateAllFalsesMap (1 :: 2 :: 3 :: nil) t_empty.
(* remove_dups (vars_in_formula_dupl f) - all vars in formula

checkVars начинает работу с карты, на которой all vars = false.
1) пробует изменить первую вару на тру. если нашли решение - возвращаем
2)

*)

Definition checkVars : forall (ls : list var) (f : formula) (map : tvals), {{ map' | evalFormula f map' = true }}.
  refine (fix F (ls : list var) (f : formula) (map : tvals) : {{ map' | evalFormula f map' = true }} :=
  match ls with
  | nil => _
  | x :: xs => match F xs f (x !-> true; map) with
               | ?? => F xs f (x !-> false; map)
               | res => res
               end
  end).
  destruct (evalFormula f map) eqn:E.
  - eapply (Found _ map E).
  - apply ??.
Defined.

Definition f :=  (Disj (Var 1) (Disj (Var 2) (Not 3))).
Eval simpl in checkVars (nodup_var (vars_in_formula f)) f t_empty.

Definition f1 :=  (Conj (Var 1) (Not 1)).
Eval simpl in checkVars ((vars_in_formula f1)) f1 t_empty.

Search PeanoNat.Nat.eqb.
Locate PeanoNat.Nat.eqb.
Check PeanoNat.Nat.eqb.

Print In.
(* отличается от библиотечного In тем, что возвращает bool, а не Prop *)
Fixpoint In_var_ls' (x : var) (ls : list var) : bool :=
  match ls with
  | nil => false
  | x' :: xs => match PeanoNat.Nat.eqb x x' with
                | true => true
                | false => In_var_ls' x xs
                end
  end.

Eval simpl in In_var_ls' 0 (1 :: 2 :: 3 :: nil).

Locate reflect.
Print Coq.Bool.Bool.reflect.
(*
Inductive reflect (P : Prop) : bool -> Set :=
    ReflectT : P -> reflect P true | ReflectF : ~ P -> reflect P false
*)
Lemma In_reflect : forall x ls, reflect (In x ls) (In_var_ls' x ls).
  intros. induction ls.
  - crush.
  - destruct (PeanoNat.Nat.eqb x a) eqn:E.
    + crush. constructor. left.
      apply PeanoNat.Nat.eqb_eq. rewrite PeanoNat.Nat.eqb_sym. auto.
    + crush. inversion IHls. constructor. crush. constructor. crush.
      Search PeanoNat.Nat.eqb. assert (H' : PeanoNat.Nat.eqb x x = true ).
      apply (PeanoNat.Nat.eqb_refl x). crush.
Qed.

(* Definition In_var_ls : forall x ls, {In_var_ls' x ls = true} + {~(In_var_ls' x ls = true)}. *)

Inductive formula_List_Vars : list var -> formula -> Set :=
| FVars_Var : forall v ls, In_var_ls' v ls  = true -> formula_List_Vars ls (Var v)
| FVars_Not : forall v ls, In_var_ls' v ls = true -> formula_List_Vars ls (Not v)
| FVars_Disj : forall f1 f2 ls1 ls2, formula_List_Vars ls1 f1->
                                     formula_List_Vars ls2 f2 ->
                                     formula_List_Vars (nodup_var (ls1 ++ ls2)) (Disj f1 f2)
| FVars_Conj : forall f1 f2 ls1 ls2, formula_List_Vars ls1 f1 ->
                                     formula_List_Vars ls2 f2 ->
                                     formula_List_Vars (nodup_var (ls1 ++ ls2)) (Conj f1 f2).
Search list.
Inductive formula_List_Vars_sub : list var -> formula -> Set :=
| FVars_Var : forall v ls, In_var_ls' v ls  = true -> formula_List_Vars ls (Var v)
| FVars_Not : forall v ls, In_var_ls' v ls = true -> formula_List_Vars ls (Not v)
| FVars_Disj : forall f1 f2 ls1 ls2, formula_List_Vars ls1 f1->
                                     formula_List_Vars ls2 f2 ->
                                     formula_List_Vars (nodup_var (ls1 ++ ls2)) (Disj f1 f2)
| FVars_Conj : forall f1 f2 ls1 ls2, formula_List_Vars ls1 f1 ->
                                     formula_List_Vars ls2 f2 ->
                                     formula_List_Vars (nodup_var (ls1 ++ ls2)) (Conj f1 f2).

Lemma flv : forall f, formula_List_Vars (vars_in_formula f) f.
  intros. induction f0.
  - crush. constructor. crush. rewrite (PeanoNat.Nat.eqb_refl v). reflexivity.
  - crush. constructor. crush. rewrite (PeanoNat.Nat.eqb_refl v). reflexivity.
  - simpl. constructor. crush. crush.
  - simpl. constructor. crush. crush.
Qed.

Fixpoint eq_map (ls : list var) (m1 m2 : tvals) : bool :=
  match ls with
  | nil => true
  | x :: xs => if eqb (m1 x) (m2 x) then eq_map xs m1 m2 else false
  end.

Notation "m1 '==(' vrs ')' m2" := (eq_map vrs m1 m2 = true) (at level 50).

Lemma inFalse : forall v vrs m1, In_var_ls' v vrs = true -> (v !-> true ; m1) ==(vrs) (v !-> false ; m1). Admitted.

Inductive formulaTrue : tvals -> formula -> Prop :=
| TVar : forall tv var, tv var = true -> formulaTrue tv (Var var)
| TNot : forall tv var, tv var = false -> formulaTrue tv (Not var)
| TDisj : forall f1 f2 tv, formulaTrue tv f1 \/ formulaTrue tv f2 ->
                           formulaTrue tv (Disj f1 f2)
| TConj : forall f1 f2 tv, formulaTrue tv f1 -> formulaTrue tv f2 -> formulaTrue tv (Conj f1 f2).

Inductive formula_map : tvals -> formula -> Set :=
| FM_Var_True : forall map var, map var = true -> formula_map map (Var var)
| FM_Var_False : forall map var, map var = false -> formula_map map (Var var)
| FM_Not_True : forall map var, map var = true -> formula_map map (Not var)
| FM_Not_False : forall map var, map var = false -> formula_map map (Not var)
| FM_Disj : forall f1 f2 map, formula_map map f1 ->
                              formula_map map f2 ->
                              formula_map map (Disj f1 f2)
| FM_Conj : forall f1 f2 map, formula_map map f1 ->
                              formula_map map f2 ->
                              formula_map map (Conj f1 f2).

Lemma t_empty_map : forall f, formula_map t_empty f.
  intros. induction f0. apply FM_Var_False. unfold t_empty. auto.
  apply FM_Not_False. unfold t_empty. auto. constructor. auto. crush. constructor. crush. crush.
Qed.

Definition checkOneMap (f : formula) (map : tvals) : {formulaTrue map f} + {~formulaTrue map f}.
  Hint Constructors formulaTrue.
  induction f.
  - destruct (map v) eqn:G. left. constructor. auto. right.
      unfold not. intros. inversion H. crush.
  - destruct (map v) eqn:G. right; crush. inversion H. crush.
    left. constructor. auto.
  - inversion IHf1; inversion IHf2; crush. right. intros. inversion H1. crush.
  - inversion IHf1; inversion IHf2; crush. right. intros. inversion H1. crush.
    right. intros. inversion H1. crush. right. intros. inversion H1. crush.
Defined.

Lemma not_nil : forall f, formula_List_Vars nil f -> forall truth, ~ formulaTrue truth f.
  intros.
  induction f0.
  - crush. inversion H. inversion H3.
  - crush. inversion H. inversion H3.
  - unfold not. intros. inversion H. crush.
    inversion H0.
    (* доказать, что ls1 = nil /\ ls2 = nil, subst.  *)
Admitted.

Definition CheckFormulaHelp : forall f ls map, formula_List_Vars_sub ls f -> formula_map map f -> {truth : tvals | formulaTrue truth f } + {forall truth, ~ formulaTrue truth f }.
refine (fix F f ls map pf1 pf2 : {truth : tvals | formulaTrue truth f } + {forall truth, ~ formulaTrue truth f } :=
          match ls return {truth : tvals | formulaTrue truth f } + {forall truth, ~ formulaTrue truth f } with
          | nil => _
          | x :: xs => match F f xs (x !-> true; map) _ _ with
                       | ?? => F xs f (x !-> false; map)
                       | res => res
                       end
          end).
- admit.
-

  Definition CheckFormula (f : formula) : {truth : tvals | formulaTrue truth f } + {forall truth, ~ formulaTrue truth f } := @CheckFormulaHelp f (vars_in_formula f) t_empty (flv f) (t_empty_map f).

Definition checkFormula : forall (f : formula) (pf :  formula_List_Vars (vars_in_formula f) f),
    {truth : tvals | evalFormula f truth = true } + {forall truth, evalFormula f truth = false}.
refine (fix F f pf : {truth : tvals | evalFormula f truth = true } + {forall truth, evalFormula f truth = false} :=
          match f return {truth : tvals | evalFormula f truth = true } + {forall truth, evalFormula f truth = false} with
          | Var v => _
          | Not v => _
          | Disj f1 f2 => _
          | Conj f1 f2 => _
          end).

(* Definition CheckFormulaHelp : forall f ls map, formula_List_Vars ls f -> formula_map map f -> *)
(*   {truth : tvals | formula_map truth f -> formulaDenote truth f = true} + {forall truth, formula_map truth f ->  evalFormula truth f = false}. *)

Definition checkVars : forall (ls : list var) (f : formula) (map : tvals), {{ map' | evalFormula f map' = true }}.

1. как показать, что если ls = nil то map уже не удастся изменять. Не нашли
2. как показать, что если map изменить нельзя, то не существует возможной оценки.
3. что значит, что map изменять нельзя.

Definition checkVars' : forall (ls : list var) (f : formula) (map : tvals), { map' | evalFormula f map' = true } + {
forall map', map'
evalFormula f map' = false
                                                                                }.

  refine (fix F (ls : list var) (f : formula) (map : tvals) : { map' | evalFormula f map' = true } + {forall map', evalFormula f map' = false} :=
  match ls with
  | nil => _
  | x :: xs => match F xs f (x !-> true; map) with
               | ?? => F xs f (x !-> false; map)
               | res => res
               end
  end).
  destruct (evalFormula f map) eqn:E.
  - eapply (Found _ map E).
  - apply ??.
Defined.

(* BELOW NAT"S DEFINITIONS *)

Inductive formulaTrue : tvals -> formula -> Prop :=
| TVar : forall tv var, tv var = Some true -> formulaTrue tv (Lit (Var var))
| TNot : forall tv var, tv var = Some false -> formulaTrue tv (Lit (Not var)).

(* что список принадлежит формуле (это ее контекст) with duplicates, I probably don't need this Prop *)
Inductive formula_List_Vars : list var -> formula -> Prop :=
| FVars_Var : forall var ls, In var ls -> formula_List_Vars ls (Lit (Var var))
| FVars_Not : forall var ls, In var ls -> formula_List_Vars ls (Lit (Not var)).

(* что мапа принадлежит формуле, может формула и не true на этой мапе. НАДО? *)
Inductive formula_map : tvals -> formula -> Set :=
| FM_Var_True : forall map var, map var = Some true -> formula_map map (Lit (Var var))
| FM_Var_False : forall map var, map var = Some false -> formula_map map (Lit (Var var))
| FM_Not_True : forall map var, map var = Some true -> formula_map map (Lit (Not var))
| FM_Not_False : forall map var, map var = Some false -> formula_map map (Lit (Not var)).

Inductive formula_all_maps : list tvals -> formula -> Type :=
| FAM_Var : forall map ls v, In map ls -> formula_map map (Lit (Var v)) -> length ls = 2  -> formula_all_maps ls (Lit (Var v))
| FAM_Not : forall map ls v, In map ls -> formula_map map (Lit (Not v)) -> length ls = 2  -> formula_all_maps ls (Lit (Not v)).

Theorem all_maps_not_nil : forall f, formula_all_maps nil f -> False.
  intros. induction f; destruct l; crush. inversion X. crush. inversion X. crush.
Qed.

Definition checkOneMap (f : formula) (map : tvals) : {formulaTrue map f} + {~formulaTrue map f}.
  Hint Constructors formulaTrue.
  induction f.
  - induction l.
    + destruct (map v) eqn:G. destruct b eqn:E. left. constructor. auto. right.
      unfold not. intros. inversion H. crush. right. unfold not. intros. inversion H. crush.
    + destruct (map v) eqn:G. (destruct b); crush. right; crush. inversion H. crush.
      right. unfold not. intros. inversion H. crush.
Defined.

Definition equal_maps_on_formula (m1 m2 : tvals) : Prop :=
  forall (v : var) (f : formula) (ls : list var), formula_List_Vars ls f /\ m1 v = m2 v /\ In v ls.

(* теорема в своем док-ве опирается на длину списка всех возможных для формулы мапов *)
Theorem FAM : forall f t, formula_all_maps (t :: nil) f -> ~ formulaTrue t f -> (forall truth, ~formulaTrue truth f ).
  intros. unfold not. intros.
inversion X. crush. crush. Qed.

(* ПЛАН РАБОТЫ
0) ввести длину списка в formula_all_maps
0) переписать определение (In map tvals) чтобы оно было ориентировано на tvals
1) создать подтип от formula_all_maps, formula_all_maps_sub : list tvals -> formula -> n
*)

Definition checkFormula : forall f : formula, {truth : tvals | formulaTrue truth f } + {forall truth, ~formulaTrue truth f }.
  intros f.
  assert (H : formula_List_Vars (remove_dups (vars_in_formula_dupl f)) f ).
  { induction f. induction l. simpl. constructor. crush. simpl. constructor. crush. }
  assert (G : formula_all_maps (makeAllMaps (remove_dups (vars_in_formula_dupl f)) ( (CreateAllFalsesMap (remove_dups (vars_in_formula_dupl f)) empty) :: nil)) f).
  { induction f.
    - induction l.
      + simpl in H. simpl. eapply FAM_Var. simpl. crush. constructor.
        rewrite update_shadow. rewrite update_eq. reflexivity. crush.
      + simpl in H. simpl. eapply FAM_Not. simpl. crush. constructor.
        rewrite update_shadow. rewrite update_eq. reflexivity. crush.
  }
  remember (remove_dups (vars_in_formula_dupl f)) as fav.
  remember (makeAllMaps fav (CreateAllFalsesMap fav empty :: nil)) as fam.
  clear Heqfav H Heqfam fav.
    generalize dependent f. generalize dependent fam.
  refine (fix F fam f pf :  {truth : tvals | formulaTrue truth f} + {forall truth : tvals, ~ formulaTrue truth f} :=
            match f return  {truth : tvals | formulaTrue truth f} + {forall truth : tvals, ~ formulaTrue truth f}
            with
            | Lit (Var v) => _
            | Lit (Not v) => _
            end).
  - destruct fam.
    + crush. apply all_maps_not_nil in pf. inversion pf.
    +

  - admit.
  - left. exists x. auto.
  -


Inductive bool := true | false.

Inductive even : nat -> Prop :=
  | zero_even: even 0
  | ssn_even: forall n, even n -> even (S (S n)).

Lemma ev8 : even 8. apply ssn_even. apply ssn_even. apply ssn_even. apply ssn_even.
                    apply zero_even.
                    Qed.