(* Set Printing All imi fuctiona doar cu optiunea "Display all basic low-level contents" (Shift + Alt + A) *)

(* EX 1 : *)

(* Vom considera cunoscute următoarele definiții: *)
Inductive Var := a | b | c | x | y | z | n | s | i .

Inductive AExp :=
| anum : nat -> AExp
| aplus : AExp -> AExp -> AExp
| amul : AExp -> AExp -> AExp
| avar : Var -> AExp. (*Modificare*)

Coercion anum : nat >-> AExp.
Notation "A +' B" := (aplus A B) (at level 60, right associativity).
Notation "A *' B" := (amul A B) (at level 58, left associativity).
Coercion avar : Var >-> AExp. (*Modificare*)

(*Modificați definiția expresiilor aritmetice (AExp de mai sus) astfel încât aceasta să permită utilizarea de variabile (Var).
Testați modificările făcute pe următoarele cazuri: *)

Check 2 +' (avar n).
Check n +' 1.
Check s +' i.

(* EX 2 : *)

(*Definiți un tip de date pentru expresii booleene care să includă valorile de adevăr, negații, conjuncții și comparații între expresii aritmetice.
Testați modificările făcute pe următoarele cazuri: *)

Inductive BExp :=
| btrue : BExp
| bfalse : BExp
| bnot : BExp -> BExp
| band : BExp -> BExp -> BExp
| blessthan : AExp -> AExp -> BExp
| bmorethan : AExp -> AExp -> BExp.

Notation "A <' B" := (blessthan A B) (at level 70).
Notation "A >' B" := (bmorethan A B) (at level 70).
Infix "and'" := band (at level 80).
(* Se poate folosi si : Notation "A 'and'' B" := (band A B) (at level 80). *)
Notation "!" := bnot (at level 80).
(* Se poate folosi si : Notation "! A" := (bnot A) (at level 80) *)

Check btrue.
Check bfalse.
Check ! (x <' 10).
Check btrue and' (n >' 0).

(* EX 3 : *)

(*Definiți un tip de date pentru instrucțiunile unui limbaj de programare simplu.
Instrucțiunile sunt: atribuiri, bucle (de tip while) și secvențe de instrucțiuni.
Pentru teste, utilizați cazurile de mai jos.
Atenție la notații: acestea vă pot ajuta să determinați forma instrucțiunilor utilizate. *)

Require Import String.
Inductive Stmt :=
| assignment : Var-> AExp -> Stmt
| sequence : Stmt -> Stmt -> Stmt
| iforelse : BExp -> Stmt -> Stmt.

Notation "X ::= A" := (assignment X A) (at level 80).
Notation "S1 ;; S2" := (sequence S1 S2) (at level 98, left associativity).
Notation "'while' ( A ) (  B )":= (iforelse A B)(at level 99).
(* Daca nu sunt puse parantezele de la ( A ) ( B ), va da eroare constructor operator level 200*)

Check n ::= 10.
Check s ::= 0.
Check n ::= 10 ;; s ::= 0 ;; i ::= 0.
Check n ::= 10 ;;
      s ::= 0 ;;
      i ::= 0 ;;
      while (i <' n +' 1) (
            s ::= s +' i ;;
            i ::= i +' 1
      ).


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

Set Warnings "-notation-overridden,-parsing".
Require Export IndProp.
Check evenb.

(** "_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 [ev]), 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 [ev] property.  *)

Print ev.
(* ==>
  Inductive ev : nat -> Prop :=
    | ev_0 : ev 0
    | ev_SS : forall n, ev n -> ev (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 [ev] declares that [ev_0 : ev
    0].  Instead of "[ev_0] has type [ev 0]," we can say that "[ev_0]
    is a proof of [ev 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] for a brief history and an 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,
                  ev n ->
                  ev (S (S n)) *)

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

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

Theorem ev_4 : ev 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)
     : ev 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)).
(* ===> ev 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 [ev 2] and [ev 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, ev n -> ev (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': ev 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'' : ev 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''' : ev 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) : ev 4 *)
Print ev_4'.
(* ===> ev_4'   =   ev_SS 2 (ev_SS 0 ev_0) : ev 4 *)
Print ev_4''.
(* ===> ev_4''  =   ev_SS 2 (ev_SS 0 ev_0) : ev 4 *)
Print ev_4'''.
(* ===> ev_4''' =   ev_SS 2 (ev_SS 0 ev_0) : ev 4 *)

(** **** Exercise: 2 stars (eight_is_even)  *)
(** Give a tactic proof and a proof object showing that [ev 8]. *)

Theorem ev_8 : ev 8.
Proof.
  apply (ev_SS  6  (ev_SS 4 ev_4)).
Qed.

Definition ev_8' : ev 8 := ev_SS 6 (ev_SS 4 ev_4).

(** [] *)

(* ################################################################# *)
(** * 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, ev n -> ev (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, ev n ->
    ev (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: *)
Check ev_SS.
Definition ev_plus4' : forall n, ev n -> ev (4 + n) :=
  fun (n : nat) => fun (H : ev 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 : ev n)
                    : ev (4 + n) :=
  ev_SS (S (S n)) (ev_SS n H).

Check ev_plus4''.
(* ===>
     : forall n : nat, ev n -> ev (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, [ev 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 : ev n), ev (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 (_ : ev n), ev (n + 2).

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

Definition ev_plus2'' : Prop :=
  forall n, ev n -> ev (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 and quantifiers we have seen so far.  Indeed, only
    universal quantification (and thus implication) 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 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 only
    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) :=
  match H with
  | conj HP HQ => conj HQ HP
  end.
Check and_comm'_aux.

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

(** **** Exercise: 2 stars, optional (conj_fact)  *)
(** Construct a proof object demonstrating the following proposition. *)

Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R:=
  fun(P Q R:Prop) => fun (HPQ: P /\ Q) => fun(HQR: Q/\R) => match HPQ with
        | conj HP HQ => match HQR with
                                  | conj _ HR => conj HP HR
                                 end
        end.
Check conj_fact.
(** [] *)

(** ** 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, 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 :=
  fun(P Q:Prop) => fun(Hpq:P \/ Q) =>
      match Hpq with
      | or_introl HP => or_intror HP
      | or_intror HQ => or_introl HQ
      end.

Check or_comm.
Print or_commut.
(** [] *)

(** ** 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 => ev n).
(* ===> exists n : nat, ev n
        : Prop *)
Print ev.
Check ((ev_SS 2 (ev_SS 0 ev_0)) ).

(** Here's how to define an explicit proof object involving [ex]: *)
Check ex_intro ev 2 (ev_SS 0 ev_0).

(* ev is a parameter from outside*)
Definition some_nat_is_even : exists n, ev n :=
  ex_intro  ev 4 (ev_SS 2 (ev_SS 0 ev_0)).

(** **** Exercise: 2 stars, optional (ex_ev_Sn)  *)
(** Complete the definition of the following proof object: *)
Check (ex (fun n => ev (S n))).

Definition ex_ev_Sn : ex (fun n => ev (S n)) :=
  ex_intro (fun n => ev (S n)) 1 (ev_SS 0 ev_0).

(** [] *)

(* ================================================================= *)
(** ** [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 small 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 each member of this family:
    applying the constructor [eq_refl] to a type [X] and a value [x :
    X] yields evidence that [x] is equal to [x]. *)

(** 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 short-hand 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].

End MyEquality.

(** **** Exercise: 2 stars (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.
  intros X x y H P Px.
  rewrite <- H.
  apply Px.
Qed.
(** [] *)

(** **** Exercise: 5 stars, optional (leibniz_equality__equality)  *)
(** Show that, in fact, the inductive definition of equality is
    _equivalent_ to Leibniz equality: *)
Print excluded_middle.

Lemma leibniz_equality__equality : forall (X : Type) (x y: X),
  (forall P:X->Prop, P x -> P y) -> x = y.
Proof.
  intros X x y H.
  apply H.
  reflexivity.
Qed.

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


Require Import init.

Declare Scope nat_scope.
Delimit Scope nat_scope with nat.

Inductive nat : Set :=
    | nat_zero : nat
    | nat_suc : nat → nat.
Bind Scope nat_scope with nat.

Fixpoint iterate_func {U} (f : U → U) n :=
    match n with
    | nat_zero => identity
    | nat_suc n' => λ x, f (iterate_func f n' x)
    end.

Definition sequence (U : Type) := nat → U.

Theorem nat_zero_suc : ∀ {n}, nat_zero ≠ nat_suc n.
Proof.
    intros n eq.
    inversion eq.
Qed.

Theorem nat_suc_eq : ∀ {a b}, nat_suc a = nat_suc b ↔ a = b.
Proof.
    intros a b.
    split.
    -   intros eq.
        inversion eq.
        reflexivity.
    -   intros eq.
        subst.
        reflexivity.
Qed.

Theorem nat_neq_suc : ∀ n, n ≠ nat_suc n.
Proof.
    induction n.
    -   apply nat_zero_suc.
    -   intro contr.
        rewrite nat_suc_eq in contr.
        contradiction.
Qed.


(** Well-founded order on product and applications to products of nat *)

From Coq Require Import Relation_Definitions Wf_nat Lia.

Set Implicit Arguments.

(** * Non-Dependant Product of two [well_founded] relations *)

Section Product.

  Variable A B : Type.
  Variable RA : relation A.
  Variable RB : relation B.
  Hypothesis WA : well_founded RA.
  Hypothesis WB : well_founded RB.

  (* more general but slightly different type
  Definition lt_prod v1 v2 := lexprod _ _ RA (fun _ => RB) v1 v2.
  Definition wf_prod := wf_lexprod _ _ _ _ WA (fun _ => WB).
  *)
  Definition lt_prod v1 v2 := RA (fst v1) (fst v2)
       \/ (fst v1 = fst v2 /\ RB (snd v1) (snd v2)).

  Lemma wf_prod : well_founded lt_prod.
  Proof.
  intros [a b]; revert b.
  induction a using (well_founded_induction WA);
    induction b using (well_founded_induction WB).
  constructor.
  intros [a' b'] [Ho | [L R]].
  - now apply H.
  - now simpl in L; subst; apply H0.
  Qed.

End Product.

(** * Well founded order on pairs of [nat] *)

(*
Definition lt_nat_nat := lexprod _ _ lt (fun _ => lt).
Definition wf_nat_nat := wf_lexprod _ _ _ _ lt_wf (fun _ => lt_wf).
*)
Definition lt_nat_nat := lt_prod lt lt.
Definition wf_nat_nat := wf_prod lt_wf lt_wf.

Ltac lt_nat_nat_solve :=
  match goal with
  | |- lt_nat_nat ?v1 ?v2 => try (left; simpl; lia);
                             try (right; split; simpl; lia);
                             fail
  | |- lt_prod lt lt ?v1 ?v2 => try (left; simpl; lia);
                                try (right; split; simpl; lia);
                                fail
  end.

(** * Well founded order on triples of [nat] *)

Definition lt_nat_nat_nat := lt_prod lt lt_nat_nat.
Definition wf_nat_nat_nat := wf_prod lt_wf wf_nat_nat.

Ltac lt_nat_nat_nat_solve :=
  match goal with
  | |- lt_nat_nat_nat ?v1 ?v2 =>
     try (left; simpl; lia);
     try (right; split; [ | left ]; simpl; lia);
     try (right; split; [ | right; split ]; simpl; lia);
     fail
  | |- lt_prod lt lt_nat_nat ?v1 ?v2 =>
     try (left; simpl; lia);
     try (right; split; [ | left ]; simpl; lia);
     try (right; split; [ | right; split ]; simpl; lia);
     fail
  | |- lt_prod lt (lt_prod lt lt) ?v1 ?v2 =>
     try (left; simpl; lia);
     try (right; split; [ | left ]; simpl; lia);
     try (right; split; [ | right; split ]; simpl; lia);
     fail
  end.


(**************************************************************************
* TLC: A library for Coq                                                  *
* Core logical definitions (all imported from the Prelude)                *
**************************************************************************)

Set Implicit Arguments.

(* ********************************************************************** *)
(** * Basic logical connectives *)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [True] *)

(** From Prelude:

    Inductive True : Prop :=
      | I : True.

    Hint Constructors True : core.

  Remark: [constructor] should be renamed to [True_intro].
  Single-letter variable names should be reserved to the user.

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [False] *)

(** From Prelude:

    Inductive False : Prop := .

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [not] *)

(** From Prelude:

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

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

  Hint Unfold not : core.

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [and] *)

(** From Prelude:

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

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

    Hint Constructors and : core.

    Lemma proj1 : forall (P Q : Prop), P /\ Q -> P.
    Proof using. autos*. Qed.

    Lemma proj2 : forall (P Q : Prop), P /\ Q -> Q.
    Proof using. autos*. Qed.

  Remark: to follow conventions, [conj] should be renamed to [and_intro].

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [or] *)

(** From Prelude:

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

    Notation "A \/ B" := (or A B) : type_scope.

    Hint Constructors or : core.

  Remark: to follow conventions, constructors should be [or_l] and [or_r].

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [iff] *)

(** From Prelude:

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

      Notation "P <-> Q" := (iff P Q) : type_scope.

      Hint Unfold iff.

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [eq] *)

(** From Prelude:

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

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

      Arguments eq_ind [A].
      Arguments eq_rec [A].
      Arguments eq_rect [A].

      Hint Constructors eq : core.

  Remark : to follow conventions, constructors should be named [eq_intro],
  or [refl_eq].
*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [exists x, P] *)

(** From Prelude:

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

    Notation "'exists' x , p" := (ex (fun x => p))
      (at level 200, x ident, right associativity) : type_scope.
    Notation "'exists' x : t , p" := (ex (fun x:t => p))
      (at level 200, x ident, right associativity,
        format "'[' 'exists'  '/  ' x  :  t ,  '/  ' p ']'")
      : type_scope.

    Hint Constructors ex : core.

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [forall x, P] and [P -> Q] *)

(** [forall] and [->] are builtin in the logic.
    [P -> Q] is short for [forall (_:P), Q]. *)

(** From Prelude:

    Definition all (A : Type) (P : A->Prop) := forall (x:A), P x.

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [{x | P}] (subset type) *)

(** From Prelude:

    Inductive sig (A : Type) (P : A->Prop) : Type :=
      | exist : forall x, P x -> sig P.

    Notation "{ x | P }" := (sig (fun x => P)) : type_scope.
    Notation "{ x : A | P }" := (sig (fun x:A => P)) : type_scope.
    Add Printing Let sig.

  Remark : to follow conventions, constructor should be named [sig_intro].

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [{x & P}] (subset type in Type) *)

(** From Prelude:

    Inductive sigT (A : Type) (P : A -> Type) : Type :=
      | existT : forall x, P x -> sigT P.

    Notation "{ x & P }" := (sigT (fun x:A => P)) : type_scope.
    Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope.
    Add Printing Let sigT.

  Remark : to follow conventions, constructor should be named [sigT_intro].

*)


Require Export "Prop_J".

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

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

Check conj.

Theorem and_example:
  (ev 0) /\ (ev 4).
Proof.
  apply conj.
  apply ev_0.
  apply ev_SS. apply ev_SS. apply ev_0.
Qed.

Print and_example.

Theorem and_example':
  (ev 0) /\ (ev 4).
Proof.
  split.
  - apply ev_0.
  - apply ev_SS. apply ev_SS. apply ev_0.
Qed.

Theorem proj1: forall P Q: Prop,
                 P /\ Q -> P.
Proof.
  intros P Q H.
  inversion H.
  apply H0.
Qed.

Theorem proj2: forall P Q: Prop,
                 P /\ Q -> Q.
Proof.
  intros P Q H.
  inversion H as [ Hp Hq].
  apply Hq.
Qed.

Theorem and_commut: forall P Q: Prop,
                      P /\ Q -> Q /\ P.
Proof.
  intros P Q H.
  inversion H as [Hp Hq].
  split.
  - apply Hq.
  - apply Hp.
Qed.

Print and_commut.

Theorem and_assoc: forall P Q R: Prop,
                     P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
  intros P Q R H.
  inversion H as [Hp Hqr].
  inversion Hqr as [Hq Hr].
  split.
  split.
  apply Hp.
  apply Hq.
  apply Hr.
Qed.

Theorem even_ev: forall n: nat,
                   (even n -> ev n)  /\ (even (S n) -> ev (S n)).
Proof.
  induction n.
  + split.
    intros H.
    apply ev_0.
    intros H.
    inversion H.
  + split.
    apply IHn.
    intros H.
    apply ev_SS.
    inversion IHn.
    apply H0.
    apply H.
Qed.

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

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.
  apply H0.
Qed.

Theorem iff_sym: forall P Q: Prop,
                   (P <-> Q) -> (Q <-> P).
Proof.
  intros P Q H.
  inversion H.
  split.
  apply H1.
  apply H0.
Qed.

Theorem iff_refl: forall P: Prop,
                    P <-> P.
Proof.
  intros P.
  split.
  intros H.
  apply H.
  intros H.
  apply H.
Qed.

Theorem iff_trans: forall P Q R: Prop,
                     (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
  intros P Q R H1 H2.
  inversion H1.
  inversion H2.
  split.
  intros Hp.
  apply H3.
  apply H.
  apply Hp.
  intros Hr.
  apply H0.
  apply H4.
  apply Hr.
Qed.

Definition MyProp_iff_ev: forall n, MyProp n <-> ev n :=
  (fun (n: nat) => conj (MyProp n -> ev n) (ev n -> MyProp n) (ev_MyProp n) (MyProp_ev n)).

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.

Check or_introl.
Check or_intror.

Theorem or_commut: forall P Q: Prop,
                     P \/ Q -> Q \/ P.
Proof.
  intros P Q H.
  inversion H.
  + apply or_intror.
    apply H0.
  + apply or_introl.
    apply H0.
Qed.

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

Print or_commut.

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]].
  + split.
    left. apply HP.
    left. apply HP.
  + split.
    right. apply HQ.
    right. apply HR.
Qed.

Theorem or_distributes_over_and_2: forall P Q R: Prop,
                                     (P \/ Q) /\ (P \/ R) -> P \/ (Q /\ R).
Proof.
  intros P Q R. intros H. inversion H.
  inversion H0. inversion H1.
  left. apply H3.
  left. apply H2.
  inversion H1.
  left. apply H3.
  right. split. apply H2. apply H3.
Qed.

Theorem or_distributes_over_and: forall P Q R: Prop,
                                   P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  intros P Q R.
  split.
  + apply or_distributes_over_and_1.
  + apply or_distributes_over_and_2.
Qed.

Theorem andb_true__and: forall b c,
                          andb b c = true -> b = true /\ c = true.
Proof.
  intros b c H.
  destruct b.
  + destruct c.
    - apply conj. reflexivity. reflexivity.
    - inversion H.
      + inversion H.
Qed.

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

Theorem andb_false: forall b c,
                      andb b c = false -> b = false \/ c = false.
Proof.
  intros b c H.
  destruct H.
  destruct b.
  right.  reflexivity.
  left. reflexivity.
Qed.

Theorem orb_true: forall b c,
                    orb b c = true -> b = true \/ c = true.
Proof.
  intros b c H.
  destruct b.
  + left. reflexivity.
  + simpl in H. right. apply H.
Qed.

Theorem orb_false: forall b c,
                     orb b c = false -> b = false /\ c = false.
Proof.
  intros b c H.
  destruct b.
  + simpl in H. inversion H.
  +  apply conj. reflexivity. simpl in H. apply H.
Qed.

Inductive False: Prop :=.

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

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

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

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

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

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

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

Theorem double_neg: forall P: Prop,
                      P -> ~~P.
Proof.
  intros P H.
  unfold not.
  intros I.
  apply I in H.
  inversion H.
Qed.

Theorem contrapositive: forall P Q: Prop,
                          (P -> Q) -> (~Q -> ~P).
Proof.
  intros P Q H.
  unfold not.
  intros I.
  intros J.
  apply H in J.
  apply I in J.
  inversion J.
Qed.

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

Theorem five_not_even:
  ~ ev 5.
Proof.
  unfold not. intros H.
  inversion H.
  inversion H1.
  inversion H3.
Qed.

Theorem ev_not_ev_S: forall n,
                       ev n -> ~ ev (S n).
Proof.
  unfold not.
  intros n H.
  induction H.
  + intros I. inversion I.
  + intros I.
    inversion I.
    apply IHev in H1.
    inversion H1.
Qed.

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

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

Theorem not_eq_beq_false: forall n n': nat,
                            n <> n' -> beq_nat n n' = false.
Proof.
  intros n.
  induction n.
  + intros n'.
    induction n'.
  - simpl. intros H.
    apply ex_falso_quodlibet.
    apply H. reflexivity.
  - intros H. simpl. reflexivity.
    + intros n'. induction n'.
  - intros H. reflexivity.
  - intros H. simpl.
    apply IHn.
    unfold not in H.
    unfold not.
    replace (S n = S n') with (n = n') in H.
    apply H.
Admitted.

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

Definition some_nat_is_even: Prop :=
  ex nat ev.

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

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.

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

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

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

Definition p: ex nat (fun n => ev (S n)) :=
  ex_intro _ (fun n =>  ev (S n)) 1 (ev_SS 0 ev_0).

Theorem dist_not_exists: forall (X: Type) (P: X -> Prop),
                           (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  intros X P. intros H.
  unfold not.
  intros I.
  inversion I.
  apply H0.
  apply H.
Qed.

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).

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).
  intros X P Q.
  split.
  + intros H.
    inversion H.
    inversion H0.
    left.  exists witness. apply H1.
    right. exists witness. apply H1.
  + intros H.
    inversion H.
    inversion H0.
    exists witness. left. apply H1.
    inversion H0.
    exists witness. right. apply H1.
Qed.

Module MyEquality.
  Inductive eq (X: Type): X -> X -> Prop :=
    refl_equal: forall x, eq X x x.
  Notation "x = y" := (eq _ x y)
                        (at level 70, no associativity): type_scope.

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

  Notation "x =' y" := (eq' _ x y)
                         (at level 70, no associativity): type_scope.
  Theorem two_defs_of_equal_concide: forall (X: Type) (x y: X),
                                       x = y <-> x =' y.
  Proof.
    intros X x y.
    split.
    intros H.
    inversion H.
    reflexivity.
    intros H.
    inversion H.
    apply refl_equal.
  Qed.

  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.

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

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

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

Check le_ind.

Theorem test_le1:
  3 <= 3.
Proof.
  apply le_n.
Qed.

Theorem test_le2:
  3 <= 6.
Proof.
  apply le_S. apply le_S. apply le_S.
  apply le_n.
Qed.

Theorem test_le3:
  ~(2 <= 1).
Proof.
  intros H.
  inversion H.
  inversion H1.
Qed.

Definition lt (n m: nat) := le (S n) m.

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

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)).

Module R.
  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.

End R.

(*
Theorem not_exists_dist:
  excluded_middle ->
  forall (X: Type) (P: X -> Prop),
    ~(exists x, ~ P x) -> (forall x, P x).
Proof.
  intros Ex X P H x.
  unfold not in H.
  unfold excluded_middle in Ex.
  apply Ex with (P x)
*)


(** * 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 [ev]), 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 [ev] property.  *)

Print ev.
(* ==>
  Inductive ev : nat -> Prop :=
    | ev_0 : ev 0
    | ev_SS : forall n, ev n -> ev (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 [ev] declares that [ev_0 : ev
    0].  Instead of "[ev_0] has type [ev 0]," we can say that "[ev_0]
    is a proof of [ev 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,
                  ev n ->
                  ev (S (S n)) *)

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

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

Theorem ev_4 : ev 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)
     : ev 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)).
(* ===> ev 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 [ev 2] and [ev 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, ev n -> ev (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': ev 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'' : ev 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''' : ev 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) : ev 4 *)
Print ev_4'.
(* ===> ev_4'   =   ev_SS 2 (ev_SS 0 ev_0) : ev 4 *)
Print ev_4''.
(* ===> ev_4''  =   ev_SS 2 (ev_SS 0 ev_0) : ev 4 *)
Print ev_4'''.
(* ===> ev_4''' =   ev_SS 2 (ev_SS 0 ev_0) : ev 4 *)

(** **** Exercise: 2 stars (eight_is_even)  *)
(** Give a tactic proof and a proof object showing that [ev 8]. *)

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

Definition ev_8' : ev 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, ev n -> ev (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, ev n ->
    ev (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, ev n -> ev (4 + n) :=
  fun (n : nat) => fun (H : ev 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 : ev n)
                    : ev (4 + n) :=
  ev_SS (S (S n)) (ev_SS n H).

Check ev_plus4''.
(* ===>
     : forall n : nat, ev n -> ev (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, [ev 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 : ev n), ev (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 (_ : ev n), ev (n + 2).

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

Definition ev_plus2'' : Prop :=
  forall n, ev n -> ev (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 and quantifiers we have seen so far.  Indeed, only
    universal quantification (and thus implication) 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 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 only
    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) :=
  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, 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, 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 => ev n).
(* ===> exists n : nat, ev n
        : Prop *)

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

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

(** **** Exercise: 2 stars, optional (ex_ev_Sn)  *)
(** Complete the definition of the following proof object: *)

Definition ex_ev_Sn : ex (fun n => ev (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 small 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 each member of this family:
    applying the constructor [eq_refl] to a type [X] and a value [x :
    X] yields evidence that [x] is equal to [x]. *)

(** 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 short-hand 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].

End MyEquality.

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

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


(** * 3. Coq でのプログラミング *)
(** 3.2 再帰的な型と関数 *)
Module Section3_2.

(** 自然数 nat について *)
Print nat.
(* Inductive nat : Set :=
   O : nat
 | S : nat -> nat
*)

Eval compute in (S (S (S O))).

(** 自然数の加法 *)
Fixpoint add(n m:nat):nat :=
match n with
| O => m
| S n' => S (add n' m)
end.

Eval compute in (add (S (S O)) (S (S (S O)))).

(** 自然数の比較 *)
Fixpoint eq_nat(n m:nat):bool :=
match n,m with
| O,O => true
| S n', S m' => eq_nat n' m'
| _,_ => false
end.

Eval compute in (eq_nat 3 3).
Eval compute in (eq_nat 3 2).

(*
Fixpoint le_nat(n m:nat):bool :=
(* code here *)

Eval compute in (le_nat 2 3).  (* = true *)
Eval compute in (le_nat 3 3).  (* = true *)
Eval compute in (le_nat 4 3).  (* = false *)

*)

(** 再帰関数の停止性 *)
Fixpoint add'(n m:nat){struct n}:nat :=
match n with
| O => m
| S n' => S (add n' m)
end.

(** 課題２：自然数の関数 *)
(* 1. 掛け算を行う関数 mul を add を参考に定義せよ。 *)
(*
Fixpoint mul(n m:nat) :=
(* code here *)

Eval compute in (mul 2 3). (* = 6 *)
*)

(* 2. mul を用いて階乗を計算する関数 fact を定義せよ。*)
(*
Fixpoint fact(n:nat) :=
(* code here *)

Eval compute in (fact 4). (* = 24 *)
*)

(* 3. 引き算を行う関数 sub を定義してみよ。但し n = 0 の場合は sub 0 m = 0と定義する。*)
(*
Fixpoint sub(n m:nat):nat :=
(* code here *)

Eval compute in (sub 5 2). (* = 3 *)
Eval compute in (sub 4 4). (* = 0 *)
Eval compute in (sub 2 5). (* = 0 *)
*)

(* 4. 次の関数 div3 は何を計算する関数か考えよ。また Eval を用いて 動作を確認してみよ。*)
Fixpoint div3(n:nat) :=
match n with
| S (S (S n')) => S (div3 n')
| _ => O
end.

Eval compute in (div3 2).
Eval compute in (div3 6).
Eval compute in (div3 7).

End Section3_2.

(** 3.3 多相型 *)
Module Section3_3.

(** 多相型とは *)
Definition cond{A:Set}(c:bool)(vt vf:A) : A :=
match c with
| true => vt
| false => vf
end.

Eval compute in (cond true 2 3).
Eval compute in (cond false false true).
Eval compute in (@cond nat false 2 3).

(** option型 *)
Print option.
(* Inductive option (A : Type) : Type :=  Some : A -> option A | None : option A *)

Definition option_map {A B:Type}(f:A->B)(o:option A) :=
match o with
| Some a => Some (f a)
| None => None
end.

Eval compute in (option_map (fun x => x+1) (Some 1)).
Eval compute in (option_map (fun x => x+1) None).

(** prod型とsum型 *)

Print prod.
(* Inductive prod (A B : Type) : Type :=  pair : A -> B -> A * B *)

Print sum.
(* Inductive sum (A B : Type) : Type :=  inl : A -> A + B | inr : B -> A + B *)

Check (2,true,3).

Definition test_sum(s:sum nat bool) :=
match s with
| inl n => n
| inr true => 1
| inr false => 0
end.

(** List型 *)
Require Import List.
Print list.
(* Inductive list (A : Type) : Type :=
    nil : list A
  | cons : A -> list A -> list A
*)

Check (1::2::nil).

(** List に対する再帰関数 *)
(* Listの連結 *)
Fixpoint append{A:Type}(xs ys:list A):=
match xs with
| nil => ys
| x::xs' => x::(append xs' ys)
end.
Eval compute in (append (1::2::nil) (3::4::nil)).

(* Listの最後の要素 *)
Fixpoint olast{A:Type}(xs:list A):option A :=
match xs with
| nil => None
| a::nil => Some a
| _::xs' => olast xs'
end.
Eval compute in (olast (1::2::3::nil)).
Eval compute in (olast (1::nil)).
Eval compute in (olast (@nil nat)).

(** 課題３：Listへの関数 *)
(* 1. リストの長さを与える関数 len{A:Type}(xs:list A):nat を定義 せよ。*)
(*
Fixpoint len{A:Type}(xs:list A):nat :=

Eval compute in (len (1::2::3::nil)). (* = 3 *)
*)

(* 2. list bool の入力を受け取り、全要素が true の時 true を返す関数
 all_true(xs:list bool):bool を定義せよ。
但し nil に対し ては true を返すとせよ。*)
(*
Fixpoint all_true(xs:list bool):bool :=

Eval compute in (all_true (@nil bool)).  (* = true *)
Eval compute in (all_true (true::true::nil)).  (* = true *)
Eval compute in (all_true (true::true::false::nil)).  (* = false *)
*)

(* 3. リストの先頭要素 x があれば Some x を、空リストに対しては
None を返す、関数 ohead{A:Type}(xs:list A):option A を
定義せよ。*)
(*
Definition ohead{A:Type}(xs:list A):option A :=

Eval compute in (ohead (@nil nat)).  (* = None *)
Eval compute in (ohead (1::nil)).  (* = Some 1 *)
Eval compute in (ohead (1::2::nil)).  (* = Some 1 *)
*)

(* 4. 自然数s,nに対してs :: s+1 :: ... :: (s+n-1) :: nilを
 返す関数 nat_list(s n:nat):list nat を定義せよ。*)
(*
Fixpoint nat_list(s n:nat):list nat :=

Eval compute in (nat_list 3 5).  (* = 3::4::5::6::7::nil *)
*)

(* 5. リストを反転する関数 reverse{A:Type}(xs:list A):list A を
 定義せよ。必要なら append を使え。*)
(*
Fixpoint reverse{A:Type}(xs:list A):list A :=

Eval compute in (reverse (1::2::3::nil)). (* =  3::2::1::nil *)
*)
End Section3_3.


Require Import Nat PeanoNat Bool BoolEq EqNat Le Orders.
Require Import Lia ZifyBool.

Open Scope nat_scope.

Theorem refl : forall a : nat, a = a.
Proof.
  intro.
  reflexivity.
Qed.

Locate Nat.
Locate beq_nat.

Definition refl_example : S (S (S O)) = 3 := eq_refl 3.

Inductive List : Set :=
  | nil : List
  | cons (n : nat) (tail : List) : List.

Definition Empty (l : List) : Prop := match l with
  | nil => True
  | cons _ _ => False
  end.

Fixpoint length (l : List) : nat := match l with
  | nil => 0
  | cons _ rest => 1 + length rest
  end.

Fixpoint sum (l : List) : nat := match l with
  | nil => 0
  | cons n rest => n + sum rest
  end.

Theorem sum_example : sum (cons 5 (cons 4 (cons 8 nil))) = 17.
Proof.
  cbv delta; fold Nat.add; cbv iota; fold sum.
  cbv beta.
  cbv iota.
  cbv.
  reflexivity.
Qed.

Inductive Sorted: List -> Prop :=
  | Sorted_empty : Sorted nil
    (* prázdný List je vždy seřazen *)
  | Sorted_one (n : nat) : Sorted(cons n nil)
    (* List s jedním prvkem je také vždy seřazen *)
  | Sorted_recursive (n : nat) (m : nat) (rest : List)
    (* List s více prvky [n, m, ...rest] je seřazen, když:*)
      (* 1. n a m jsou správně seřazeny: *)
        (first_pair_sorted : n <= m)
      (* 2. zbytek [m, ...rest] je seřazen: *)
        (rest_sorted : Sorted (cons m rest))
      : Sorted (cons n (cons m rest)).

Theorem example_sorted : Sorted (cons 2 (cons 3 (cons 5 nil))).
Proof.
  refine (Sorted_recursive 2 3 (cons 5 nil) _ _).
  auto.
  (* Dokonce lze odvodit úplně vše *)
  (* refine (recursive_sorted _ _ _ _ _). *)
  constructor.
  auto.
  (* Zbytek už je jednoduchý *)
  refine (Sorted_one 5).
Qed.

Theorem example_not_sorted : ~ Sorted (cons 5 (cons 5 (cons 2 nil))).
Proof.
  unfold not.
  intro S.
  inversion S.
  clear n m rest first_pair_sorted H0 H1 H2 S.

  inversion rest_sorted.
  clear n m rest H0 H1 H2 rest_sorted rest_sorted0.

  repeat apply le_S_n in first_pair_sorted.
  apply Nat.nle_succ_0 in first_pair_sorted.
  apply first_pair_sorted.
Qed.

Fixpoint min_elem (l:List) : option nat := match l with
  | nil => None
  | cons n r => Some (match min_elem r with
    | None => n
    | Some m => if n <? m then n else m
  end)
end.

Theorem example_min_elem : min_elem (cons 4 (cons 6 (cons 2 nil))) = Some 2.
Proof.
  compute.
  reflexivity.
Qed.

Theorem has_min : forall (l : List), length l > 0 -> exists (n : nat), min_elem l = Some n.
Proof.
  intros.
  induction l.
  - compute in H.
    apply le_n_0_eq in H.
    discriminate.
  - clear IHl H.
    simpl.
    eauto.
  (* Show Proof. *)
Qed.

Fixpoint elem (n:nat) (l:List) : bool := match l with
  | nil => false
  | cons m r => (if n =? m then true else elem n r)
end.

Inductive Elem (n: nat) : List -> Prop :=
  | Elem_triv : forall l, Elem n (cons n l)
  | Elem_cons : forall l u, Elem n l -> Elem n (cons u l).

Theorem Elem_tail: forall l n u, Elem n (cons u l) -> n <> u -> Elem n l.
Proof.
  intros.
  inversion H.
  - contradiction.
  - exact H2.
Qed.

Theorem Elem_el: forall l n u, Elem n (cons u l) <-> n = u \/ Elem n l.
Proof.
  intros.
  split.
  - destruct (Nat.eq_decidable n u).
    left. exact H.
    right.
    apply (Elem_tail _ _ _ H0 H).
  - intros.
    destruct H as [-> | E].
    apply Elem_triv.
    apply Elem_cons.
    exact E.
Qed.

Theorem elem_spec n l: Elem n l <-> elem n l = true.
Proof.
  split.
  - intro E.
    induction l.
    + inversion E.
    + simpl.
      Search reflect.
      destruct (Nat.eqb_spec n n0); [reflexivity| ].
      apply IHl.
      apply Elem_el in E.
      destruct E; [contradiction |].
      exact H.
  - intro E.
    induction l.
    + simpl in E.
      discriminate E.
    + simpl in E.
      destruct (Nat.eqb_spec n n0) as [-> | D].
      * apply Elem_triv.
      * apply Elem_cons.
        exact (IHl E).
Qed.

Theorem elem_reflect n l: reflect (Elem n l) (elem n l).
  induction l.
  simpl.
  apply ReflectF.
  intro.
  inversion H.
  inversion IHl.
  simpl.
  destruct (Nat.eqb_spec n n0).
  apply ReflectT.
  rewrite e.
  apply Elem_triv.
  rewrite <- H.
  apply ReflectT.
  apply Elem_cons.
  exact H0.
  simpl.
  destruct (Nat.eqb_spec n n0).
  apply ReflectT.
  rewrite e.
  apply Elem_triv.
  rewrite <- H.
  apply ReflectF.
  intro.
  apply Elem_el in H1.
  destruct H1; contradiction.
Qed.

Theorem elem_not_nil : forall l n, Elem n l -> length l > 0.
Proof.
  intros.
  induction l.
  - compute in H.
    inversion H.
  - compute.
    apply le_n_S.
    apply le_0_n.
Qed.

Fixpoint remove_elem n l: List :=
  match l with
    | nil => nil
    | cons m l' => if m =? n then remove_elem n l' else cons m (remove_elem n l')
  end.

Ltac conv_eq := match goal with
                  | H : (?a =? ?b) = true  |- _ => apply beq_nat_true  in H; conv_eq
                  | H : (?a =? ?b) = false |- _ => apply beq_nat_false in H; conv_eq
                  | _ => idtac
                end.

Ltac conv_ord := conv_eq; match goal with
                  | H : (?a <? ?b) = true  |- _ => apply Nat.ltb_lt    in H; conv_ord
                  | H : (?a <? ?b) = false |- _ => apply Nat.ltb_ge    in H; conv_ord
                  | _ => idtac
                end.

Theorem elem_remove_elem: forall l n m, Elem n l -> n <> m -> Elem n (remove_elem m l).
Proof.
  intros.
  induction l.
  compute.
  exact H.
  simpl.
  destruct (n0 =? m) eqn:E.
  - conv_eq.
    destruct E.
    pose proof (Elem_tail _ _ _ H H0).
    exact (IHl H1).
  -
    destruct (Nat.eq_decidable n0 n).
    + destruct H1.
      apply Elem_triv.
    + apply Elem_cons.
      apply Elem_tail in H; [ |apply not_eq_sym; exact H1].
      apply IHl.
      exact H.
Qed.

Theorem len_gt_0_cons : forall l, length l > 0 -> exists n i, l = cons n i.
Proof.
  intros.
  induction l.
  compute in H.
  apply Nat.nle_succ_0 in H.
  contradiction.
  eauto.
Qed.

Theorem len_gt_0_not_nil : forall l, length l > 0 <-> l <> nil.
Proof.
  split.
  intros.
  induction l.
  compute in H.
  apply Nat.nle_succ_0 in H.
  contradiction.
  discriminate.
  intros.
  induction l.
  contradiction.
  simpl.
  compute.
  apply le_n_S.
  apply le_0_n.
Qed.

Theorem min_elem_cons : forall l n, min_elem (cons n l) <> None.
Proof.
  intros.
  simpl.
  discriminate.
Qed.

Theorem total : forall l, length l > 0 -> min_elem l <> None.
Proof.
  intros.
  apply len_gt_0_cons in H.
  destruct H as [n [ll e]].
  rewrite e.
  simpl.
  discriminate.
Qed.

Definition min_elem1 (l:List) (D: length l > 0): nat :=
  match min_elem l as min return min <> None -> nat with
    | Some a => fun _ => a
    | None => fun E => match E eq_refl with end
  end (total l D).

Definition min_elem1_alt (l:List) (D: length l > 0): nat.
  refine (match min_elem l as min return min <> None -> nat with
    | Some a => fun _ => a
    | None => fun E => _
  end (total l D)).
  destruct E.
  reflexivity.
  (* Show Proof. *)
Defined.

Definition min_elem1_alt2 (l:List) (D: length l > 0): nat.
  destruct (min_elem l) eqn:E.
  - exact n.
  - pose proof (total l D).
    contradiction (H E).
Defined.

Definition min_elem1_alt3 (l:List) (D: length l > 0): nat :=
  match min_elem l as min return min <> None -> nat with
    | Some a => fun _ => a
    | None => fun E => ltac:(contradiction)
  end (total l D).

Definition min_elem1_alt4 (l:List) (D: length l > 0): nat :=
  match min_elem l as min return min <> None -> nat with
    | Some a => fun _ => a
    | None => fun E: None <> None => ltac:(contradiction)
  end (total l D).

Print min_elem1_alt.
Print min_elem1_alt2.
Print min_elem1_alt3.
Print min_elem1_alt4.
(* Search beq_nat. *)

Theorem min_spec_elem: forall l H, Elem (min_elem1 l H) l.
Proof.
  intro.
  destruct l.
  - intros L.
    pose proof (Nat.nle_succ_0 _ L).
    contradiction H.
  - induction l; intros.
    + unfold min_elem1.
      simpl.
      apply Elem_triv.
    + assert (length (cons n l) > 0) by (simpl; lia).
      pose proof (IHl H0).
      clear IHl.
      unfold min_elem1 in *.
      simpl in *.
      destruct (min_elem l).
      destruct (n <? n1) eqn:E1;
      destruct (n0 <? n1) eqn:E2;
      destruct (n <? n0) eqn:E3;
      try rewrite E1.
      apply Elem_triv.
      apply Elem_cons. apply Elem_triv.
      apply Elem_triv.
      apply Elem_triv.
      apply Elem_triv.
      apply Elem_cons. apply Elem_triv.
      destruct (Nat.eq_dec n n1).
      rewrite e.
      apply Elem_triv.
      assert (n1 <> n) by auto.
      pose proof (Elem_tail _ _ _ H1 H2).
      apply Elem_cons.
      apply Elem_cons.
      exact H3.
      destruct (Nat.eq_dec n n1).
      rewrite e.
      apply Elem_triv.
      assert (n1 <> n) by auto.
      pose proof (Elem_tail _ _ _ H1 H2).
      apply Elem_cons.
      apply Elem_cons.
      exact H3.
      destruct (n <? n0) eqn:E3.
      apply Elem_triv.
      apply Elem_cons. apply Elem_triv.
Qed.

Theorem min_spec_min: forall (l:List) (n:nat) (E : Elem n l),
  let E1 := elem_not_nil l n E in min_elem1 l E1 <= n.
Proof.
  intro l.
  destruct l.
  - intros.
    compute in E.
    inversion E.
  - intros. induction l.
    + compute.
      destruct (n0 =? n) eqn:Eqn.
      * lia.
      * apply beq_nat_false in Eqn.
        pose proof (Elem_tail _ _ _ E Eqn) as H.
        inversion H.
    + unfold min_elem1.
      subst E1.
      simpl.
      destruct (n0 =? n1) eqn:Eqn.
      * apply beq_nat_true in Eqn.
        destruct (min_elem l).
        -- destruct (n1 <? n2) eqn:Eqn1,
                    (n  <? n1) eqn:Eqn2,
                    (n  <? n2) eqn:Eqn3.
           lia. lia. lia. lia. lia. lia. lia. lia.
        -- destruct (n <? n1) eqn:Eqn2.
           lia. lia.
      * rewrite elem_spec in E.
        simpl in E.
        rewrite Eqn in E.
        apply beq_nat_false in Eqn.
        assert ((if n0 =? n then true else elem n0 l) = elem n0 (cons n l)) by auto.
        rewrite H in E.
        rewrite <- elem_spec in E.
        clear H. pose proof (IHl E) as IHL. clear IHl.
        unfold min_elem1 in IHL.
        simpl in IHL.
        destruct (min_elem l).
        -- destruct (n1 <? n2) eqn:Eqn1,
                    (n  <? n1) eqn:Eqn2,
                    (n  <? n2) eqn:Eqn3;
           lia.
        -- destruct (n <? n1) eqn:Eqn2;
           lia.
Qed.

Theorem Min1_spec :
  forall l n (E: Elem n l),
  let D := elem_not_nil l n E in
  Elem (min_elem1 l D) l
  /\ min_elem1 l D <= n.
Proof.
 intros.
 split.
 apply min_spec_elem.
 apply min_spec_min.
Qed.

Fixpoint min_def n l: nat:= match l with
                            | nil => n
                            | cons m l' => let min' := min_def n l' in if min' <? m then min' else m
                          end.

Fixpoint remove_once n l: List := match l with
                                    | nil => nil
                                    | cons m l' => if n =? m then l' else cons m (remove_once n l')
                                  end.

Fixpoint emplace n l: List := match l with
  | nil => cons n nil
  | cons m l' => if m <? n then cons m (emplace n l') else cons n l
end.

Definition insert_sort l: List := (fix ins o i := match i with
      | nil => o
      | cons m l' => ins (emplace m o) l'
end) nil l.

Eval vm_compute in insert_sort (cons 4 (cons 6 (cons 1 (cons 3 (cons 2 nil))))).
Eval vm_compute in insert_sort (cons 5 (cons 4 (cons 3 (cons 2 (cons 1 nil))))).
Eval vm_compute in insert_sort (cons 5 (cons 4 (cons 5 (cons 8 (cons 5 (cons 3 nil)))))).

Theorem Sorted_le: forall a b l, Sorted (cons a (cons b l)) -> a <= b.
  intros.
  inversion H.
  exact first_pair_sorted.
Qed.

Theorem Sorted_tail: forall n l, Sorted (cons n l) -> Sorted l.
  intros.
  inversion H.
  - apply Sorted_empty.
  - exact  rest_sorted.
Qed.

Theorem Sorted_under: forall a b l, Sorted (cons a (cons b l)) -> Sorted (cons a l).
  intros.
  destruct l.
  apply Sorted_one.
  inversion H.
  inversion rest_sorted.
  apply Sorted_recursive.
  lia.
  exact rest_sorted0.
Qed.

Ltac miniinv0 H := try pose proof (Sorted_tail _ _ H) as ?H;
                   try pose proof (Sorted_le _ _ _ H) as ?Le;
                   try pose proof (Sorted_under _ _ _ H) as ?U.

Ltac miniinv H := miniinv0 H.

Theorem Sorted_under2: forall a b c l, Sorted (cons a (cons b (cons c l))) -> Sorted (cons a (cons b l)).
  intros.
  miniinv H.
  apply Sorted_recursive.
  lia.
  miniinv H0.
  assumption.
Qed.

Theorem Sorted_min: forall n l, Sorted (cons n l) -> n <= min_def n l.
  intros.
  induction l.
  - simpl.
    lia.
  - miniinv H.
    miniinv U.
    simpl.
    pose proof (IHl U) as IH.
    destruct (min_def n l <? n0).
    exact IH.
    lia.
Qed.

Ltac miniinv2 H := try pose proof (Sorted_tail _ _ H) as ?H;
                   try pose proof (Sorted_min _ _ H) as ?Min;
                   try pose proof (Sorted_le _ _ _ H) as ?Le;
                   try pose proof (Sorted_under _ _ _ H) as ?U;
                   try pose proof (Sorted_under2 _ _ _ _ H) as ?dU.

Ltac miniinv H ::= miniinv2 H.

Fixpoint append (a b : List) : List := match a with
                              | nil => b
                              | cons h t => cons h (append t b)
                              end.

Theorem Sorted_append1 : forall a b, Sorted (append a b) -> Sorted a.
Proof.
  intros.
  destruct a.
  constructor.
  simpl in *.
  generalize dependent n.
  induction a; intros.
  constructor.
  simpl in *.
  miniinv H.
  constructor.
  exact Le.
  pose proof (IHa n H0) as IH.
  exact IH.
Qed.

Theorem Sorted_under_n: forall a m b, Sorted (append a (cons m b)) -> Sorted (append a b).
Proof.
  intros.
  generalize dependent b.
  induction a; intros.
  - simpl in H |- *.
    miniinv H.
    exact H0.
  - simpl in *.
    miniinv H.
    pose proof (IHa b H0) as IH.

Theorem emplace_spec: forall n l, Sorted l -> Sorted (emplace n l).
Proof.
  intros.
  destruct l.
    simpl. exact (Sorted_one _).
  simpl.
  destruct (n0 <? n) eqn:E.
  conv_ord.
  induction l.
  - simpl.
    apply Sorted_recursive;
    [lia | apply Sorted_one].
  - simpl.
    destruct (n1 <? n) eqn: E1.
    all: conv_ord.
    apply Sorted_recursive.
    miniinv H.
    lia.
    miniinv H.
    miniinv H0.
    pose proof (IHl U).
    miniinv H2.