(** ** induction

induction term というのは数学的帰納法を適用する tactic です。
term は帰納的に定義された型である必要があります。

induction が構築する証明項をみるために、a + 0 = a を証明してみましょう。
加算 (Nat.add) は第1引数で場合分けして計算を進めます。
この a + 0 というのは第1引数が変数なため、その場合分けを行えず、
計算を進めることができません。
そのため、これを証明するには帰納法が必要になります。

*)

Goal forall a, a + 0 = a.
Proof.
  intros a.
(**
ゴール: <<a + 0 = a>>
*)
  Show Proof.
(**
証明項: <<(fun a : nat => ?Goal)>>

induction の直前では、intros で構築した関数抽象の本体がゴールとなっています。
*)
  induction a.
(**
ゴール1: <<0 + 0 = 0>>
ゴール2: <<S a + 0 = S a>>

induction の直後では、a が 0 の場合のゴールと、
a が 0 でない (つまり S a の場合の) ゴールのふたつのゴールが生成されています。
*)
    Show Proof.
(**
証明項:
<<(fun a : nat =>
 nat_ind (fun a0 : nat => a0 + 0 = a0)
   ?Goal
   (fun (a0 : nat) (IHa : a0 + 0 = a0) => ?Goal0@{a:=a0})
   a)>>

証明項をみると、nat_ind という関数を呼び出しており、
引数の中には ?Goal と ?Goal0@{n:=n0} があって、
ふたつのゴールがあることがわかります。

nat_ind がどんな関数なのか About でみてみましょう。
*)
    About nat_ind.
(**
<<
nat_ind :
forall P : nat -> Prop,
  P 0 ->
  (forall n : nat, P n -> P (S n)) ->
  forall n : nat,
  P n
>>

Display notations を無効にして About しなおすと以下のようになります。

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

- 第1引数 P として nat を受け取って命題を返す関数を受けとります。
- 第2引数に P 0 の証明を受け取ります。
- 第3引数に n と P n の証明を受け取って P (S n) の証明を返す関数を受けとります。
- 第4引数に n を受けとります。
- そして、P n の証明を返します。

直感的には、nat_ind は、第2引数から始めて第3引数を n 回適用したものを返すと
理解すればよさそうです。

証明項で実引数は以下のようになっています。

- 第1引数: (fun a0 : nat => a0 + 0 = a0)
- 第2引数: ?Goal
- 第3引数: (fun (a0 : nat) (IHa : a0 + 0 = a0) => ?Goal0@{a:=a0})
- 第4引数: a

返り値の型 P n は (fun a0 : nat => a0 + 0 = a0) a すなわち a + 0 = a であり、
induction を行う直前のゴールと一致しています。

nat_ind の第2引数の型 P 0 は (fun a0 : nat => a0 + 0 = a0) 0 すなわち 0 + 0 = 0 であり、
induction を行った後の最初のゴールと一致しています。

0 + 0 = 0 は計算すれば左右が同じになるので reflexivity で証明できます。
*)
    reflexivity.
  Show Proof.
(**
<<
(fun a : nat =>
 nat_ind (fun a0 : nat => a0 + 0 = a0) eq_refl
   (fun (a0 : nat) (IHa : a0 + 0 = a0) => ?Goal@{a:=a0}) a)
>>

最初のゴールは reflexivity で生成された eq_refl が埋まったことがわかります。
*)

(**
次に、ふたつめのゴールにとりかかることになります。
ここでは、以下の前提が表示されています。
<<
a : nat
IHa : a + 0 = a
>>
そして、<<S a + 0 = S a>> というゴールを証明しなければなりません。

nat_ind の第3引数の型 forall n : nat, P n -> P (S n) を展開すると
forall n : nat, n + 0 = n -> S n + 0 = S n となります。
第3引数の実引数は (fun (a0 : nat) (IHa : a0 + 0 = a0) => ?Goal0@{a:=a0}) であり、
すでに関数抽象が2段階生成されています。
表示されている a と IHa という前提はこの a0 と IHa に対応しています。
ゴールに @{a:=a0} と付記されているのは、
仮引数は a0 なのに前提は a という名前になっていることを示しているのでしょう。

これを証明するにはまず simpl としてゴール内で計算を進められるところを進めてしまいます。
*)
  simpl.
  Show Proof.
(**
ゴール: <<S (a + 0) = S a>>
証明項:
<<(fun a : nat =>
 nat_ind (fun a0 : nat => a0 + 0 = a0) eq_refl
   (fun (a0 : nat) (IHa : a0 + 0 = a0) => ?Goal@{a:=a0}) a)>>

simpl では計算を進めるだけで、そういう計算でたどり着ける項は等しいと考えるので、
証明項は変わりません。

simpl の結果、ゴール内に a + 0 という IHa で書き換えられる部分が出てきたので書き換えます。
*)
  rewrite IHa.
  Show Proof.
(**
ゴール: <<S a = S a>>
証明項:
<<(fun a : nat =>
 nat_ind (fun a0 : nat => a0 + 0 = a0) eq_refl
   (fun (a0 : nat) (IHa : a0 + 0 = a0) =>
    eq_ind_r (fun n : nat => S n = S a0) ?Goal@{a:=a0} IHa) a)>>

rewrite により、eq_ind_r の呼び出しが生成され、ゴールは S a = S a に変化します。
このゴールは両辺が等しいので、reflexivity で証明できます。
*)
  reflexivity.
  Show Proof.
(**
証明項:
<<(fun a : nat =>
 nat_ind (fun a0 : nat => a0 + 0 = a0) eq_refl
   (fun (a0 : nat) (IHa : a0 + 0 = a0) =>
    eq_ind_r (fun n : nat => S n = S a0) eq_refl IHa) a)>>

ゴールに eq_refl が埋まって、ゴールがなくなったのでこれで証明は終了です。
*)
Qed.

(**
induction が nat_ind を呼び出す関数呼び出しを構築することがわかりました。

そこで、induction ではなく、apply で同じ証明項を構築してみましょう。
*)

Goal forall a, a + 0 = a.
Proof.
  intros a.
(**
induction a とするかわりに、(nat_ind (fun a0 : nat => a0 + 0 = a0)) という
関数の呼び出しを構築します。
第1引数を指定しているのは、指定しない場合に Coq が推論する項はこれとは異なる項になってしまうからです。
指定しない場合については後でみてみましょう。
*)
  apply (nat_ind (fun a0 : nat => a0 + 0 = a0)).
  Show Proof.
(**
ゴール1: <<0 + 0 = 0>>
ゴール2: <<forall n : nat, n + 0 = n -> S n + 0 = S n>>
証明項: <<(fun a : nat => nat_ind (fun a0 : nat => a0 + 0 = a0) ?Goal ?Goal0 a)>>

期待通り nat_ind の呼び出しが構築されています。
induction とは異なり、第3引数の関数抽象は構築されていませんが、
apply は関数呼び出しを構築するものですからしょうがないでしょう。

最初のゴールは reflexivity で証明できます。
*)
    reflexivity.
  Show Proof.
(**
証明項: <<(fun a : nat => nat_ind (fun a0 : nat => a0 + 0 = a0) eq_refl ?Goal a)>>

induction による証明項と同じ証明項を作るには、
つぎのゴールに関数抽象を作る必要があります。
これは intros で可能ですが、ひとつ問題なのは前提にすでに a が存在するため、
intro a がエラーになることです。
*)
  Fail intro a.
(**
そこで、まず前提の a を消去します。
これには clear を使います。
*)
  clear a.
  Show Proof.
(**
証明項: <<(fun a : nat => nat_ind (fun a0 : nat => a0 + 0 = a0) eq_refl ?Goal a)>>
clear が前提から消去するのは、束縛された変数を前提としてアクセスできなくするというだけで、
証明項は変わりません。

これで前提が空になったので、intros a IHa として関数抽象を2段階構築します。
*)
  intros a IHa.
  Show Proof.
(**
<<(fun a : nat =>
 nat_ind (fun a0 : nat => a0 + 0 = a0) (@eq_refl nat 0)
   (fun (a0 : nat) (IHa : a0 + 0 = a0) => ?Goal@{a:=a0}) a)>>
これで、induction a 相当の証明項を構築できました。
あとは前と同じように証明します。
*)
  simpl.
  rewrite IHa.
  reflexivity.
Qed.

(**
apply nat_ind とだけ指定した場合にどうなるかみてみましょう。
*)

Goal forall a, a + 0 = a.
Proof.
  intros a.
  apply nat_ind.
  Show Proof.
(**
ゴール1: <<a + 0 = 0>>
ゴール2: <<forall n : nat, a + 0 = n -> a + 0 = S n>>
証明項: <<(fun a : nat => nat_ind (@eq nat (a + 0)) ?Goal ?Goal0 a)>>

ゴール1をみるとこれはあからさまに証明できないので、なにか間違えたことがわかります。

証明項をみると、第1引数P には (@eq nat (a + 0)) が渡されています。
eq の型をみてみましょう。
*)
About eq.
(**
<<
eq : forall A : Type, A -> A -> Prop
>>

最初の Type 型引数 A に nat が渡されており、つぎの A (つまり nat) 型引数に a + 0 が
渡されています。
最後の A (つまり nat) 型引数は渡されていないので、
結局、(@eq nat (a + 0)) は nat を受け取って Prop を返す関数となります。
これは nat_ind の第1引数の型とあっていますが、期待した引数ではありません。

induction は induction a というように引数を指定するので、
その引数を利用して期待した P を作ってくれるのでしょう。
*)
Abort.


Section PropositionalLogic.

Variables A B C : Prop.

Definition anb1 :
  A /\ B -> A
:=
  fun '(conj a _) => a.

Definition impl_trans :
  (A -> B) -> (B -> C) -> A -> C
:=
  fun ab => fun bc => fun a => bc (ab a).

Definition HilbertS :
  (A -> B -> C) -> (A -> B) -> A -> C
:=
  fun abc => fun ab => fun a => abc a (ab a).

(* ~ A = A -> False *)
(* ~ ~ A = (A -> False) -> False *)
(* ~ ~ ~ A = ((A -> False) -> False) -> False *)
Definition DNE_triple_neg :
  ~ ~ ~ A -> ~ A
:=
  fun nnna => fun a => nnna (fun a2f => a2f a).

Definition or_comm :
  A \/ B -> B \/ A
:=
  fun ab =>
    match ab with
    | or_introl l => or_intror l
    | or_intror r => or_introl r
    end.

End PropositionalLogic.

Section Quantifiers.

Definition forall_conj_to (A: Type) (P Q : A -> Prop) :
  (forall x, P x /\ Q x) -> (forall x, Q x /\ P x)
:=
  fun x_pq => fun x =>
    match x_pq x with
    | conj p q => conj q p
    end.

Definition forall_disj_to (A: Type) (P Q : A -> Prop) :
  (forall x, P x \/ Q x) -> (forall x, Q x \/ P x)
:=
  fun x_pq => fun x =>
    match x_pq x with
    | or_introl p => or_intror p
    | or_intror q => or_introl q
    end.

Variable T : Type.
Variable A : Prop.
Variable P Q : T -> Prop.
Definition forall_conj_comm :
  (forall x, P x /\ Q x) <-> (forall x, Q x /\ P x)
:=
  conj (forall_conj_to T P Q) (forall_conj_to T Q P).

Definition forall_disj_comm :
  (forall x, P x \/ Q x) <-> (forall x, Q x \/ P x)
:=
  conj (forall_disj_to T P Q) (forall_disj_to T Q P).

(* (ex_intro x px -> False) -> x -> P x -> False*)
Definition not_exists_forall_not :
  ~(exists x, P x) -> forall x, ~P x
:=
  fun (x_px2F : (@ex T P) -> False) => fun (x : T) => fun (px : P x) =>
    x_px2F (@ex_intro T P x px).

Definition exists_forall_not_ :
(exists x, A -> P x) -> (forall x, ~P x) -> ~A.
Proof. Admitted.

(** Extra exercise (feel free to skip): the dual Frobenius rule *)
Definition LEM :=
  forall P : Prop, P \/ ~ P.

Definition Frobenius2 :=
  forall (A : Type) (P : A -> Prop) (Q : Prop),
    (forall x, Q \/ P x) <-> (Q \/ forall x, P x).

Definition lem_to_frob1  :
  (forall {Q : Prop}, Q \/ ~ Q) -> (forall (A : Type) (P : A -> Prop) (Q : Prop), (forall x, Q \/ P x) -> (Q \/ forall x, P x))
:=
  fun lem _ _ qt => fun x2QOrPx =>
    match lem qt with
    | or_introl q => or_introl q
    | or_intror notQ => or_intror (fun x => match x2QOrPx x with
      | or_intror px => px
      | or_introl q => match notQ q with end
      end)
    end.

Definition lem_to_frob2 :
  (forall (Q : Prop), Q \/ ~ Q) -> (forall (A : Type) (P : A -> Prop) (Q : Prop), (Q \/ forall x, P x) -> (forall x, Q \/ P x))
:=
  fun lem _ _ qt => fun qOrPx =>
    match lem qt with
    | or_introl q => (fun x => or_introl q)
    | or_intror notQ =>
      match qOrPx with
      | or_introl q => match notQ q with end
      | or_intror xPx => (fun x => or_intror (xPx x))
      end
    end.

Definition lem_to_frob :
  (forall (Q : Prop), Q \/ ~ Q) -> (forall (A : Type) (P : A -> Prop) (Q : Prop), (forall x, Q \/ P x) <-> (Q \/ forall x, P x))
:=
  fun lem a p q => conj (@lem_to_frob1 lem a p q) (@lem_to_frob2 lem a p q).

Definition lem_to_Frobenius2 : LEM -> Frobenius2
:= lem_to_frob.

Inductive prop_holds (A : Prop) : Type :=
  | a_holds : A -> prop_holds A.

Definition frob_to_lem :
  (forall (A : Type) (P : A -> Prop) (Q : Prop), (forall x, Q \/ P x) <-> (Q \/ forall x, P x))
  ->
  (forall (Q : Prop), Q \/ ~ Q)
:=
  fun frob (tQ : Prop) =>
    match frob (prop_holds tQ) (fun _ => False) tQ with
    | conj fw _ =>
      match fw (fun ph => match ph with a_holds _ q => or_introl q end) with
      | or_introl q => or_introl q
      | or_intror xPx => or_intror (fun Q => xPx (a_holds tQ Q))
      end
    end.

Definition lem_iff_Frobenius2 :
  LEM <-> Frobenius2
:= conj lem_to_frob frob_to_lem.

End Quantifiers.

Variable PP : Prop.
Variable frob: Frobenius2.
Check frob PP (fun _ => False) PP.

(* Section ExtensionalEqualityAndComposition. *)

From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat eqtype.

Variables A B C D : Type.

(** Exercise 2a *)
(** [\o] is a notation for function composition in MathComp, prove that it's associative *)

Definition compA (f : A -> B) (g : B -> C) (h : C -> D) :
  (h \o g) \o f = h \o (g \o f)
:=
  erefl.

(** [=1] stands for extensional equality on unary functions,
    i.e. [f =1 g] means [forall x, f x = g x].
    This means it's an equivalence relation, i.e. it's reflexive, symmetric and transitive.
    Let us prove a number of facts about [=1]. *)

Search "=1".
Print frefl.
Print erefl.
Print eq_trans.

Search Logic.eq_refl.
Print Logic.eq_refl.

(*

            Parameter             Index
                |                   |
  Inductive eq (A : Type) (x : A) : A -> Prop :=
    eq_refl : eq x x
                 | |
             param ind

  match someEq in (_ = gx)
                   |
                impossible to match
      parameter, but possible to match index

  Index changable durint unification

*)

(** Exercise: Reflexivity *)
Definition eqext_refl :
  forall (f : A -> B), f =1 f
:= fun f => frefl f.

(** Exercise: Symmetry *)
Definition eqext_sym :
  forall (f g : A -> B), f =1 g -> g =1 f
:= fun f g efg x => match (efg x) in (_ = gx) return (gx = f x) with
                    | erefl => erefl
                    end.

Definition eqext_trans :
  forall (f g h : A -> B), f =1 g -> g =1 h -> f =1 h.
Proof. intros. intro x. rewrite (H x). apply (H0 x). Qed.

Print eqext_trans.

(** Exercise: Transitivity *)
Definition eqext_trans2 :
  forall (f g h : A -> B), f =1 g -> g =1 h -> f =1 h
:= fun f g h efg egh x =>
    (* Imagine that after PM all "right = side" replaced with "left = side" *)
    (* after unification "hx" will be replaced with "g x" *)
    match (egh x) in (_ = hx) return (f x = hx) with
    | erefl => (efg x)
    end.

Definition succ_inj (n m: nat) : n.+1 = m.+1 -> n = m :=
                        (* sm - will be replaced with (S n) during unification *)
                                              (* Also (S n).-1 willbe calculated *)
  fun Sn_Sm => match Sn_Sm in (_ = sm) return (n = sm.-1) with
               | erefl => erefl
               end.

Definition or_introl_inj (A B: Prop) (p1 p2: A) :
  or_introl p1 = or_introl p2 :> (A \/ B) -> p1 = p2
:=
  fun eq =>
    match eq
      in (_ = oil2)
      return (p1 = if oil2 is or_introl p2' then p2' else p2)
    with
    | erefl => erefl p1
    end.

(* return clause will be calculated twice. 1 - before PM, 2 - after PM *)
Definition discr_bool: false = true -> False
:=
  fun (eq: false = true) =>
    match eq
      in (_      = tr)
      return   (if tr then False else True)   (* large elimination, not possible for Prop *)
                (*  ^  tr will be true BEFORE pattern mach *)
    with
    | erefl => I (* after matching, return clause will be True*)
    end.

Definition discr_bool_r: true = false -> False
:=
  fun (eq: true = false) =>
    match eq
      in (_      = tr)
      return   (if tr then True else False)
    with
    | erefl => I
    end.

Locate "<>".

Fail Definition neq_sym A (x y: A) :
  x <> y -> y <> x
:=
  fun (neq_xy: x <> y) (eq_yx: y = x) =>
    match eq_yx
      in (_ = a)
      return False
    with
    | erefl => neq_xy _
    end.

Definition unification_test:
  (cons 1 (cons 2 (cons 3 nil))) = app (cons 1 (cons 2 nil)) (cons 3 nil)
:= erefl.

Definition neq_sym A (x y: A) :
  x <> y -> y <> x
:=
  fun (neq_xy: x <> y) (eq_yx: y = x) =>
    (match eq_yx
      in (_ = a)
      return (a <> y -> False) (* before pattern match a := x, afler a := y *)
    with
    | erefl => fun (neq_xy': y <> y) => neq_xy' (erefl y) (* "a" become "y = y" after patterm matching *)
    end) neq_xy.

Definition congr (A B: Type) (f: A -> B) x y:
  x = y -> f x = f y
:=
  fun eq_xy =>
    match eq_xy
      in (_ = a)
      return (f x = f a)
    with
    | erefl => erefl (f x)
    end.

Definition addn0 : forall n, n + 0 = n
:=
  fix rec (n: nat) : n + 0 = n :=
    match n as a return (a + 0 = a) with (* a  will be replaced with constructors  0 and (S n') *)
    | 0 => erefl      (* 0 + 0 = 0 *)
                 (* (S n') + 0 = S n' *)
    | S n' => congr nat nat S (n' + 0) n' (rec n')
    end.

Definition Pred (n: nat) : Type :=
  if n is S n' then nat else unit.

Definition predn_dep (n: nat): Pred n :=
  if n is S n' then n' else tt.

Compute Pred 0.
Compute predn_dep 0.

Compute Pred 42.
Compute predn_dep 42.

Definition pred (n: {x: nat | ~~ (x == 0)}) : nat :=
  match n with
  | exist x pneq0 => predn x
  end.

Definition pred2 (n: {x: nat | x <> 0}) : nat :=
  match n with
  | exist x pneq0 => predn x
  end.

Definition pred3 (n: {x: nat | x <> 0}) : nat :=
  match n with
  | exist x pneq0 =>(match x
                      as a
                      return ((a = 0 -> False) -> nat)
                     with
                     | 0    => fun contra => match (contra erefl) with end
                     | S x' => fun _ => x'
                     end) pneq0
  end.

(** Exercise: left congruence *)
Definition eq_compl :
  forall (f g : A -> B) (h : B -> C),
    f =1 g -> h \o f =1 h \o g
:=

(** Exercise: right congruence *)
Definition eq_compr :
  forall (f g : B -> C) (h : A -> B),
    f =1 g -> f \o h =1 g \o h
:=

End ExtensionalEqualityAndComposition.

From mathcomp Require Import ssreflect ssrfun ssrbool eqtype.

(* After importing `eqtype` you need to either use a qualified name for
`eq_refl`: `Logic.eq_refl`, or use the `erefl` notation.
This is because `eqtype` reuses the `eq_refl` identifier for a
different lemma.
 *)

Definition iff_is_if_and_only_if :
  forall a b : bool, (a ==> b) && (b ==> a) = (a == b)
:=

Definition negbNE :
  forall b : bool, ~~ ~~ b = true -> b = true
:=


(*
@hatsugai さんの等式論理の証明チェッカ
http://www.principia-m.com/ts/0072/index-jp.html
を自分でもやりたくて、Coq/SSReflect で「==」を「=」にReflectすることまでは考えついた。
でも、実際には、move=>とcaseで、trueとfalseの場合分けを尽すだけで解けてしまう。

曰く、
Goal forall p q, p && q == p == q == p || q.
Proof. move=> p q. by case p; case q. Qed.

Goal forall p q r, p || (q == r) == p || q == p || r.
Proof. move=> p q r. by case p; case q; case r. Qed.

ProofとQedを含めても、5語でできる証明チェッカですね。
ここで、「==」はbool->bool->bool 、「=」はbool->bool->Propです。

これでは、おもしろくないので、caseを使わない証明を考えよう。
*)

Require Import ssreflect ssrbool eqtype ssrnat.
Require Import seq ssrfun.

Section Equational_logic.

  Check eq_op.                              (* == *)
  Check eqP.                                (* reflect (?2 = ?3) (?2 == ?3) *)
  Check _ =P _.                             (* reflect (?2 = ?3) (?2 == ?3) *)

  Check eqb.                                (* bool -> bool -> bool *)

(*
  Lemma predU1P : reflect (p = q \/ b) ((p == q) || b).
  Lemma pred2P : reflect (p = q \/ z = u) ((p == q) || (z == u)).
*)

  Theorem eq_refl : forall (p : bool), p == p.
  Proof.
    move=> p.
      by apply/eqP.
  Qed.

  Lemma eq_assoc : forall p q r,
                     (p == q == r) = (p == (q == r)).
  Proof.
    move=> p q r.
      by case: p; case: q; case r.
  Qed.

  Lemma eq_sym' : forall (p q : bool), (p == q) = (q == p).
  Proof.
    move=> p q.
      by case p; case q.
  Qed.

  Theorem eq_sym : forall (p q : bool), p == q == q == p.
  Proof.
    move=> p q.
    rewrite eq_assoc.
    apply/eqP. apply eq_sym'.
  Qed.

  Lemma ne_sym' : forall (p q : bool), (p != q) = (q != p).
  Proof.
    move=> p q.
      by case p; case q.
  Qed.

  Theorem ne_sym : forall (p q : bool), (p != q) == (q != p).
    move=> p q.
    apply/eqP. apply ne_sym'.
  Qed.

  Lemma eq_del_true' : forall (p : bool), (true == p) = p.
  Proof.
    done.
  Qed.

  Theorem eq_del_true : forall (p : bool), true == p == p.
  Proof.
    move=> p.
    apply/eqP.
    apply eq_del_true'.
  Qed.
(*
    move=> p.
    split.
    (* -> *)
    move=> H. case H.
    done.
    (* <- *)
    move/eqP=> H.
    bq rewrite -H.
*)

  Lemma eq_del_false' : forall (p : bool), false == p = ~~p.
  Proof.
    done.
  Qed.

  Theorem eq_del_false : forall (p : bool), false == p = ~~p.
  Proof.
    done.
  Qed.

  Theorem eq_del_true'' : forall (p : bool), reflect p (true == p).
  Proof.
    move=> p. case: p.
      by apply ReflectT.
        by apply ReflectF.
  Qed.

  Lemma eq_neg' : forall (p q : bool), ~~(p == q) = (~~p == q).
  Proof.
    move=> p q.
    by case p; case q.
  Qed.

  Theorem eq_nag : forall (p q : bool), ~~(p == q) == ~~p == q.
  Proof.
    move=> p q.
      by case p; case q.
(*
    rewrite eq_assoc.
    apply/eqP.
    apply eq_neg'.
*)
  Qed.

  Theorem eq_false : false == ~~true.
  Proof.
    done.
  Qed.

  Lemma eq_notp_q' : forall p q, (~~p == q) = (p == ~~q).
  Proof.
    move=> p q.
    rewrite [_ == ~~_]eq_sym'.
    rewrite -[~~_ == _]eq_neg'.
    rewrite -[~~_ == _]eq_neg'.
    rewrite -ne_sym'.
    done.
  Qed.

  Theorem eq_notp_q : forall p q, ~~p == q == p == ~~q.
  Proof.
    move=> p q.
      by case p; case q.
(*
    rewrite eq_assoc.
    apply/eqP.
    apply eq_notp_q'.
*)
  Qed.

  Lemma eq_dbl_neg' : forall p, ~~ ~~p = p.
  Proof.
    move=> p.
    case p; rewrite //.
  Qed.

  Theorem eq_dbl_neg : forall p, ~~ ~~p == p.
  Proof.
    move=> p.
    by case p.
(*
    apply/eqP.
    apply eq_dbl_neg'.
*)
  Qed.

  Theorem eq_or : forall p q r, p || (q == r) == p || q == p || r.
  Proof.
    move=> p q r.
    by case p; case q; case r.
  Qed.

  Theorem eq_imp : forall p q, p ==> q == p || q == q.
  Proof.
    move=> p q.
      by case p; case q.
  Qed.

  Theorem eq_gold_law : forall p q, p && q == p == q == p || q.
  Proof.
    move=> p q.
    by case p; case q.
  Qed.

End Equational_logic.


Require Import Reals.
Local Open Scope R_scope.
From ValidSDP Require Import validsdp.

Let p (x0 x1 x2 : R) :=
  (x0 - x1)^2 + (x1 - 1)^2 + (x0 - (x2)^2)^2 + (x2 - 1)^2.

Let b1 (x0 x1 x2 : R) :=
  (x0 + 10) * (10 - x0).

Let b2 (x0 x1 x2 : R) :=
  (x1 + 10) * (10 - x1).

Let b3 (x0 x1 x2 : R) :=
  (x2 + 10) * (10 - x2).

Let lb := -1/10000.

Theorem p_ge_lb (x0 x1 x2 : R) :
  b1 x0 x1 x2 >= 0 ->
  b2 x0 x1 x2 >= 0 ->
  b3 x0 x1 x2 >= 0 ->
  lb <= p x0 x1 x2.
Proof.
unfold b1, b2, b3, p, lb.
validsdp.
Qed.


Require Import Labels.
From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat eqtype seq.

(** The two point finite lattice *)
Inductive Lab2 : Set :=
  | L : Lab2
  | H : Lab2.

Instance JoinSemiLattice_Lab2 : JoinSemiLattice Lab2 :=
{  bot := L
;  join l1 l2 :=
     match l1, l2 with
       | H, _ => H
       | _, H => H
       | L, L => L
     end
; flows l1 l2 :=
    match l1, l2 with
      | L, _ => true
      | _, H => true
      | _, _ => false
    end
; meet l1 l2 :=
    match l1, l2 with
    | L, _ => L
    | _, L => L
    | H, H => H
    end
}.
Proof.
auto.
intros l; destruct l; auto.
intros l1 l2 l3; destruct l1, l2, l3; auto.
intros l1 l2; destruct l1, l2; auto.
by [].
by [].
intros l1 l2; destruct l1, l2; auto.
intros l1 l2; destruct l1, l2; auto.
intros l1 l2 l; destruct l1, l2, l; auto.
Defined.

Instance Lattice_Lab2 : Lattice Lab2 := { top := H }.
Proof. intros l; destruct l; auto. Defined.

Instance FiniteLattice_Lab2 : FiniteLattice Lab2 := { elems := [:: L;H] }.
Proof. by case. Defined.


Require Import GeoCoq.Axioms.parallel_postulates.
Require Import GeoCoq.Tarski_dev.Annexes.saccheri.

Section rah_existential_saccheri.

Context `{TnEQD:Tarski_neutral_dimensionless_with_decidable_point_equality}.

Lemma rah__existential_saccheri : postulate_of_right_saccheri_quadrilaterals -> postulate_of_existence_of_a_right_saccheri_quadrilateral.
Proof.
  intro rah.
  destruct ex_saccheri as [A [B [C [D HSac]]]].
  exists A; exists B; exists C; exists D.
  split.
    assumption.
    apply (rah A B C D HSac).
Qed.

End rah_existential_saccheri.


Require Import Arith Lia Unicode.Utf8.
Require Import Coq.Classes.RelationClasses.

Lemma mod_unique_rev: ∀ (a b r : nat),
  r < b → r = a mod b →
  exists q, a = b * q + r.
Proof.
  intros a b r Hq Hmod.
  exists (a / b).
  assert (a = b * (a / b) + (a mod b)) as Heq.
  { apply Nat.div_mod; auto. lia. }
  rewrite <- Hmod in Heq; auto.
Qed.

Lemma mod_div_sub : ∀ a b c, b < a →
  c mod (2 * a) = a + b → Nat.divide a (c - b).
Proof.
  intros a b y Hblta H.
  symmetry in H.
  apply mod_unique_rev with (a:=y) (b:=2 * a) (r:=a + b) in H.
  destruct H.
  rewrite H.
  assert (2 * a * x + (a + b) - b = (2 * x + 1) * a) as h by lia. rewrite h; clear h.
  apply Nat.divide_factor_r.
  lia.
Qed.

Definition R (x y : nat) := 0 < x ->
  (Nat.Odd x -> 0 < y -> y mod 6 = 4 ->
   y = 3 * x + 1 <-> (y - 1) / 3 = x) /\
  (Nat.Even x -> x mod 2 = 0 ->
   y = x / 2 <-> 2 * y = x).

Lemma R_Reflexive_f : Reflexive R.
Proof.
  unfold Reflexive. intros x.
  unfold R in *. split.
  + intros Hodd Hygt0 Hmod.
    split.
    - intros.
      apply Nat.mul_cancel_l with (p:=3) (n:=((x - 1) / 3)) (m:=x); auto.
      rewrite <- Nat.divide_div_mul_exact; lia; auto.
    - intros h.
      apply Nat.mul_cancel_l with (p:=3) (n:=((x - 1) / 3)) (m:=x) in h; auto.
      rewrite <- Nat.divide_div_mul_exact in h; auto.
      rewrite Nat.mul_comm in h.
      rewrite Nat.div_mul in h; lia; auto.
      apply mod_div_sub; auto.
  + intros Heven Hmod. split.
    - intros Hx.
      apply Nat.mul_cancel_l with (p:=2) (n:=x) (m:=x / 2) in Hx; auto.
      rewrite <- Nat.div_exact with (a:=x) (b:=2) in Hmod;auto; rewrite <- Hmod in Hx; auto.
    - intros Hx.
      symmetry.
      apply Nat.mul_cancel_l with (p:=2) (n:=(x / 2)) (m:=x); auto.
      rewrite <- Nat.div_exact with (a:=x) (b:=2) in Hmod; auto; rewrite <- Hmod; auto.
Qed.

Lemma R_Transitive_f : Transitive R.
Proof.
  unfold Transitive. intros x y z Rxy Ryz.
  unfold R in *.
  split.
  + intros Hodd Hzgt0 Hmod.
    split.
    - intros h.
      apply Nat.mul_cancel_l with (p:=3) (n:=((z - 1) / 3)) (m:=x); auto.
      rewrite <- Nat.divide_div_mul_exact; auto.
      rewrite Nat.mul_comm; auto.
      rewrite Nat.div_mul; auto; lia.
      apply mod_div_sub; auto.
    - intros h.
      apply Nat.mul_cancel_l with (p:=3) (n:=((z - 1) / 3)) (m:=x) in h; auto.
      rewrite <- Nat.divide_div_mul_exact in h; auto.
      rewrite Nat.mul_comm in h.
      rewrite Nat.div_mul in h; lia; auto.
      apply mod_div_sub; auto.
  + intros Heven Hmod.
    split.
    - intros Hx.
      apply Nat.mul_cancel_l with (p:=2) (n:=z) (m:=x / 2) in Hx; auto.
      rewrite <- Nat.div_exact with (a:=x) (b:=2) in Hmod; auto. rewrite Hx; auto.
    - intros Hx.
      symmetry.
      apply Nat.mul_cancel_l with (p:=2) (n:=(x / 2)) (m:=z); auto.
      rewrite <- Nat.div_exact with (a:=x) (b:=2) in Hmod; auto; rewrite <- Hmod; auto.
  Qed.


(** * Poly: 다형성과 고차원 함수 *)

(* 마지막 알림: 연습문제들에 대한 해답을 공개적으로 접근 가능한 곳에
   두지 마시오. 감사합니다!!  *)

(* Coq에서 일부 귀찮은 경고들을 내지 않도록 하려면: *)
Set Warnings "-notation-overridden,-parsing".
Require Export Lists.

(*** 다형성 *)

(** 이 장에서 함수형 프로그래밍의 기본 개념들을 계속 발전시킨다.
    중요한 새로운 생각은 _다형성_ (함수가 다루는 데이터의 타입에 관해
    함수를 추상화)과 _고차원 함수_ (함수를 데이터로 다루기)이다.
    다형성부터 시작한다.  *)

(* ================================================================= *)
(** ** 다형 리스트 *)

(** 지난 두 장에서 단지 숫자 리스트를 가지고 논의해왔었다. 흥미로운 프로그램이라면 분명히
    다른 타입의 원소들로 구성된 리스트들을 다룰 있어야 한다. 문자열 리스트, 부울 리스트,
    리스트의 리스트 등. 각 종류의 리스트에 대해 새로운 귀납적 데이터 타입을 _정의할 수도_
    있다. 예를 들어... *)

Inductive boollist : Type :=
  | bool_nil : boollist
  | bool_cons : bool -> boollist -> boollist.

(** ... 하지만 이렇게 매번 새로 정의하는 것은 금방 지루한 일이 될
    것이다. 왜냐하면 각 데이터 타입에 대해 다른 생성자 이름들을
    만들어야 하기 때문이기도 하고, 더 중요한 이유는 각 새로운 데이터
    타입 정의 별로 리스트를 다루는 함수들 ([length], [rev], 등)을 모두
    새로운 버전을 정의해야 하기 때문이다.
*)

(** 이런 반복을 모두 피하기 위해 콕은 _다형성_ 귀납적 타입을 정의하는
    방법을 지원한다.  예를 들어 _다형 리스트_ 데이터 타입은 다음과
    같다.

*)

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

(** 이 정의는 이전 장의 [natlist] 정의와 똑같다. 다만 [cons] 생성자의
    [nat] 인자를 임의의 타입 [X]로 대체하고, [X]에 대한 바인딩을
    헤더에 추가했으며, 생성자들 타입에 [natlist]를 [list X]로 바꾼
    것이 다르다. ([nil]과 [cons] 생성자 이름들을 재사용할 수
    있다. 왜냐하면 [natlist] 정의는 [Module] 정의 안에 있고 이 정의는
    현재 범위 밖에 있기 때문이다.)

    [list]의 실체는 무엇일까? 한 가지 좋은 설명은 [list]는 [Type]에서
    [Inductive] 정의로 매핑하는 _함수_라고 생각하는 것이다. 또는 달리
    설명하자면, [list]는 [Type]에서 [Type]으로 매핑하는 함수라고
    얘기할 수 있다. 어떤 특정 타입 [X]에 대해 [list X] 타입은 타입
    [X]의 원소들로 구성된 리스트들의 집합을 [Inductive](귀납적으로)
    정의한다. *)

Check list.
(* ===> list : Type -> Type *)

(** [list] 정의의 인자 [X]는 생성자 [nil]과 [cons]의 인자가 된다. 즉,
    [nil]과 [cons]는 다형성 생성자로, 이 생성자에 만들고자 하는
    리스트의 타입을 인자로 제공해야 한다. 예를 들어, [nil nat]은 [nat]
    타입의 빈 리스트이다.  *)

Check (nil nat).
(* ===> nil nat : list nat *)

(** 동일한 설명으로, [cons nat]은 [list nat] 타입의 리스트에 [nat]
    타입의 원소를 포함시킨다. 여기 자연수 3만을 포함하는 리스트를
    구성하는 예가 있다.
*)

Check (cons nat 3 (nil nat)).
(* ===> cons nat 3 (nil nat) : list nat *)

(** [nil]의 타입은 무엇이 될까? 그 정의로부터 [list X] 타입을 읽을 수
    있지만, [list]의 인자인 [X]에 무엇이 바인딩되는지 모른다. [Type ->
    list X]으로 [X]의 의미를 설명할 수 없다. [(X : Type) -> list X]로
    조금 더 설명할 수 있다. 이러한 상황에 대한 콕의 표기법은 [forall X
    : Type, list X]이다.  *)

Check nil.
(* ===> nil : forall X : Type, list X *)

(** 비슷한 상황으로, [cons]의 타입은 그 정의로부터 [X -> list X ->
    list X]로 읽을 수 있다. 하지만 콕의 표기법으로 [X]의 의미를
    설명하자면 [forall X, X -> list X -> list X]이다.
    *)

Check cons.
(* ===> cons : forall X : Type, X -> list X -> list X *)

(** (표기법에 관한 풀이: .v 파일에서 "forall" 한정자를 문자로
    작성한다. 이 파일로부터 생성한 HTML 파일에서 그리고 다양한
    통합개발환경에서 .v 파일을 보여주는 방식에서 ( 표시 방식을 적절히
    설정하면) [forall]은 흔히 알고 있는 수학의 "뒤집어진 A"로
    표시한다. 하지만 몇 군데에서는 "forall"를 작성하는 것을 여전히
    보게 될 것이다.  이것은 조판 방식의 스타일일 뿐 의미에서는 차이가
    없다.) *)

(** 리스트 생성자를 사용할 때마다 타입 인자를 지정하는 것은 어색한
    부담으로 보일 수도 있지만 이 부담을 줄이는 방법을 곧 알게 될
    것이다. *)

Check (cons nat 2 (cons nat 1 (nil nat))).

(** (여기서 [nil]과 [cons]를 명시적으로 작성해왔는데 그 이유는 새로운
    버전의 리스트에 대해 [ [] ]과 [::] 표기법을 아직 정의하지 않았기
    때문이다. 곧 이 표기법을 정의할 것이다.) *)

(** 이제 돌아가 이전에 작성한 모든 리스트 처리 함수들의 다형성
    버전들을 만들 수 있다.  여기 [repeat]를 예로 보면: *)

Fixpoint repeat (X : Type) (x : X) (count : nat) : list X :=
  match count with
  | 0 => nil X
  | S count' => cons X x (repeat X x count')
  end.

(** [nil]과 [cons]에서와 같이 [repeat]를 사용할 때도 우선 타입 인자에
    이 함수를 적용하고 그런 다음 이 타입의 요소(와 숫자)에 적용한다:
    *)

Example test_repeat1 :
  repeat nat 4 2 = cons nat 4 (cons nat 4 (nil nat)).
Proof. reflexivity.  Qed.

(** [repeat]를 다른 종류의 리스트를 만들기 위해 사용하려면 간단히
    적절한 타입 인자를 지정하기만 하면 된다. *)

Example test_repeat2 :
  repeat bool false 1 = cons bool false (nil bool).
Proof. reflexivity.  Qed.

Module MumbleGrumble.

(** **** 연습문제: 별 두 개 (mumble_grumble)  *)
(** 다음 두 개의 귀납적 정의 타입들을 고려하자.  *)

Inductive mumble : Type :=
  | a : mumble
  | b : mumble -> nat -> mumble
  | c : mumble.

Inductive grumble (X:Type) : Type :=
  | d : mumble -> grumble X
  | e : X -> grumble X.

(** 어떤 타입 [X]에 대해 [grumble X] 타입의 원소는 다음 중 어느 것인가?
      - [d (b a 5)]
      - [d mumble (b a 5)]
      - [d bool (b a 5)]
      - [e bool true]
      - [e mumble (b c 0)]
      - [e bool (b c 0)]
      - [c]
(* 여기를 채우시오 *)
*)
(** [] *)

End MumbleGrumble.

(* ----------------------------------------------------------------- *)
(** *** 타입 주석 추론 *)

(** [repeat] 정의를 다시 작성해보자. 이번에는 어느 인자의 타입도
    지정하지 않을 것이다.  콕 시스템은 여전히 이 정의를 받아들일까?
    *)

Fixpoint repeat' X x count : list X :=
  match count with
  | 0        => nil X
  | S count' => cons X x (repeat' X x count')
  end.

(** 정말로 받아들인다. 콕은 [repeat']에 어떤 타입을 매겼을지 보자: *)

Check repeat'.
(* ===> forall X : Type, X -> nat -> list X *)
Check repeat.
(* ===> forall X : Type, X -> nat -> list X *)

(** [repeat]와 정확히 동일한 타입이다. 콕은 _타입 유추_를 사용하여
    [X]의 타입, [x]의 타입, [count]의 타입이 무엇이어야 하는지 추론할
    수 있다. 예를 들어, [X]는 [cons]에 대한 인자로서 사용되기 때문에
    [Type]이어야 한다. 왜냐하면 [cons]는 첫 번째 인자로 [Type]을
    기대하기 때문이다. 그리고, [count]를 [0]과 [S]로 매칭 하므로 [nat]
    타입이어야 한다, 등등.

    이 강력한 방법으로 우리는 모든 곳에 타입 주석을 항상 명시적으로
    작성할 필요는 없다.  물론 명시적으로 타입을 작성해놓으면 문서로써
    그리고 제대로 작성되었는지 여부를 검사하는데도 여전히 매우
    유용하다. 여러분의 코드에서 지나치게 많이 타입 주석을 달아놓거나
    (혼란스럽고 산만할 수 있다) 너무 적게 작성하지 않도록 (여러분의
    코드를 이해하기 위해 독자가 머리 속으로 타입 유추를 수행해야 한다)
    적절한 균형을 찾도록 노력해야 한다.
     *)

(* ----------------------------------------------------------------- *)
(** *** 타입 인자 합성 *)

(** 다형 타입 함수를 사용하려면 다른 인자들과 함께 타입 인자들도
    전달해야 한다. 예를 들어, 위의 [repeat] 함수의 몸체에서 재귀
    호출은 타입 [X]를 함께 전달해야 한다. 그러나 [repeat]의 두 번째
    인자는 [X] 타입의 원소이기 때문에 첫 번째 인자는 오직 [X]만
    가능하다는 것은 온전히 명백하다. 따라서 왜 우리가 이 타입 인자
    [X]를 명시적으로 작성해야 하는가?

    다행히도 콕에서는 이런 종류의 중복을 피할 수 있다. 어떠한 타입
    인자 대신 "묵시적 인자" [_]를 작성할 수 있는데, 이 것은 "콕
    시스템에서 스스로 이 자리에 나올 것을 파악하도록 해주세요"라고
    해석할 수 있다. 더 정확히 설명하자면, 콕 시스템에서 [_]를 만날 때
    그 상황에서 사용 가능한 모든 정보를 _통합_할 것이다. 적용하려는
    함수의 타입 다른 인자들의 타입들, 적용을 하는 문맥에서 기대하는
    타입 등등. 그 결과로 [_]를 대체할 구체적인 타입을 결정한다.

    이 타입 인자 합성은 타입 주석 유추와 비슷하게 들릴 수도
    있다. 정말로 이 두 절차는 동일한 방법에 의존한다. 아래처럼 함수의
    어떤 인자들의 타입들을 그냥 생략하는 대신

      repeat' X x count : list X :=

    이 타입들을 [_]로 대체할 수도 있다.

      repeat' (X : _) (x : _) (count : _) : list X :=

    이 것은 콕 시스템으로 하여금 빠진 정보를 유추하도록 지시하는
    것이다.

    묵시적 인자들을 사용하면 이 [repeat] 함수를 다음과 같이 작성할 수
    있다: *)

Fixpoint repeat'' X x count : list X :=
  match count with
  | 0        => nil _
  | S count' => cons _ x (repeat'' _ x count')
  end.

(** 이 예에서, [X] 대신 [_]를 작성하기 때문에 그다지 많이 노력을
    줄이지 않는다.  하지만 많은 경우에 키를 누르고 코드를 읽는 면에
    있어서 사소하지 않은 차이를 보인다. 예를 들어 숫자들을 포함하는
    리스트 [1], [2], [3]을 작성하기를 원한다고 가정하자. 이렇게
    작성하는 대신에...  *)

Definition list123 :=
  cons nat 1 (cons nat 2 (cons nat 3 (nil nat))).

(** ...인자 합성을 사용하여 다음과 같이 작성한다:  *)

Definition list123' :=
  cons _ 1 (cons _ 2 (cons _ 3 (nil _))).

(* ----------------------------------------------------------------- *)
(** *** 묵시적 인자 *)

(** 한 단계 더 나아가 콕 시스템으로 하여금 주어진 함수의 타입 인자들을
    _항상_ 유추하도록 설정하여 대부분의 경우 [_]를 작성하는 것도 피할
    수도 있다.

    다음의 [Arguments] 지시어를 사용하여 함수 이름을 지정하고 그
    함수의 인자 이름들을 나열한다. 이때 중괄호로 묶인 인자들을 묵시적
    인자로 다루도록 지시한다. (만일 정의의 어떤 인자들에 이름이 없다면
    보통 생성자의 경우 그러한데, 와일드카드 패턴 [_]으로 표시할 수
    있다.)  *)

Arguments nil {X}.
Arguments cons {X} _ _.
Arguments repeat {X} x count.

(** 이제 타입 인자들을 전혀 작성할 필요가 없다:  *)

Definition list123'' := cons 1 (cons 2 (cons 3 nil)).

(** 또 다른 방법으로, 함수를 선언할 때 어떤 인자를 묵시적이라고 선언할
    수 있다.  해당 인자를 괄호 대신 중괄호로 감싸면 된다. 예를 들어:
    *)

Fixpoint repeat''' {X : Type} (x : X) (count : nat) : list X :=
  match count with
  | 0        => nil
  | S count' => cons x (repeat''' x count')
  end.

(** ([repeat''']의 재귀 호출에 타입 인자를 제공할 필요 조차도 없었음을
     보라.  타입 인자를 제공하면 무효가 될 것이다!)

    앞으로 가능하면 이 스타일을 사용할 것이지만 [Inductive] 생성자들에
    대해서는 명시적으로 [Argument] 선언하는 것을 계속 사용할 것이다.
    그 이유는 귀납적 타입의 인자를 묵시적으로 선언하면 그 타입 자체가
    묵시적이 되기 때문이다. 예를 들어 [list] 타입을 다음과 같이 선언해보자:
    *)

Inductive list' {X:Type} : Type :=
  | nil' : list'
  | cons' : X -> list' -> list'.

(** [X]를 [list'] 자체를 포함하는 귀납적 정의 _전체_에 대해 묵시적으로
    선언하기 때문에 [list' nat]이나 [list' bool] 등으로 작성하지
    못하고 단지 [list']로 이제 작성해야 한다. 이것은 의도하지 않게
    지나치게 나아간 것이다.
 *)

(** 이제 새로운 다형 리스트에 관한 두 세 가지 표준 리스트 함수들을
    다시 구현함으로써 마무리짓자... *)

Fixpoint app {X : Type} (l1 l2 : list X)
             : (list X) :=
  match l1 with
  | nil      => l2
  | cons h t => cons h (app t l2)
  end.

Fixpoint rev {X:Type} (l:list X) : list X :=
  match l with
  | nil      => nil
  | cons h t => app (rev t) (cons h nil)
  end.

Fixpoint length {X : Type} (l : list X) : nat :=
  match l with
  | nil => 0
  | cons _ l' => S (length l')
  end.

Example test_rev1 :
  rev (cons 1 (cons 2 nil)) = (cons 2 (cons 1 nil)).
Proof. reflexivity.  Qed.

Example test_rev2:
  rev (cons true nil) = cons true nil.
Proof. reflexivity.  Qed.

Example test_length1: length (cons 1 (cons 2 (cons 3 nil))) = 3.
Proof. reflexivity.  Qed.

(* ----------------------------------------------------------------- *)
(** *** 명시적으로 타입 인자들을 작성하기 *)

(** 때때로 콕 시스템은 타입 인자를 결정하기에 충분한 주변 정보를
    가지고 있지 않은 경우에 [Implicit]로 인자들을 선언할 때 작은
    문제가 발생할 수 있다. 그런 경우에 콕 시스템에 직접 그 인자를 이번
    단 한 번만 지정하기를 원할 필요가 있다. 예를 들어 다음과 같이
    작성하는 경우에: *)

Fail Definition mynil := nil.

(** ([Definition] 앞의 [Fail] 속성은 _어떠한_ 명령어와 함께 사용할 수
    있다.  그 의미는 이 명령어를 실행하면 정말로 실패한다는 것을
    알리는데 사용한다.  만일 이 명령어가 실패하면 콕 시스템은 해당
    에러 메시지를 출력하지만 그 다음을 계속해서 처리한다.)

    여기에서 콕 시스템은 [nil]에 어떤 타입 인자를 제공해야 할지 몰라서
    에러를 낸다. 명시적으로 타입을 선언하여 콕 시스템이 [nil]의
    "적용"에 도달할 때 더 많은 정보를 갖도록 도와줄 수 있다:
 *)

Definition mynil : list nat := nil.

(** 다른 방법으로는 함수 이름 앞에 [@]을 두어 묵시적 인자들을
    명시적으로 작성하도록 강제할 수 있다. *)

Check @nil.

Definition mynil' := @nil nat.

(** 인자 합성과 묵시적 인자를 사용하면 이전과 같이 리스트에 대한
    편리한 표기법을 사용할 수 있다. 생성자 타입 인자들을 묵시적으로
    만들었기 때문에 콕 시스템은 이 표기법을 사용할 때 마다 이 인자들을
    자동으로 유추할 것이다. *)

Notation "x :: y" := (cons x y)
                     (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y []) ..).
Notation "x ++ y" := (app x y)
                     (at level 60, right associativity).

(** 이제 리스트를 우리가 바라던대로 그대로 작성할 수 있다: *)

Definition list123''' := [1; 2; 3].

(* ----------------------------------------------------------------- *)
(** *** 연습문제 *)

(** **** 연습문제: 별 두 개, 선택 사항 (poly_exercises)  *)
(** 여기 두 세가지 간단한 연습문제가 있다. [Lists] 장에 있는
    연습문제들과 유사한데, 다형성을 가지고 연습하도록 구성되어
    있다. 아래에서 증명을 완성하시오. *)

Theorem app_nil_r : forall (X:Type), forall l:list X,
  l ++ [] = l.
Proof.
  (* 여기를 채우시오 *) Admitted.

Theorem app_assoc : forall A (l m n:list A),
  l ++ m ++ n = (l ++ m) ++ n.
Proof.
  (* 여기를 채우시오 *) Admitted.

Lemma app_length : forall (X:Type) (l1 l2 : list X),
  length (l1 ++ l2) = length l1 + length l2.
Proof.
  (* 여기를 채우시오 *) Admitted.
(** [] *)

(** **** 연습문제: 별 두 개, 선택 사항 (more_poly_exercises)  *)
(** 다음은 조금 더 흥미로운 연습문제들이다... *)

Theorem rev_app_distr: forall X (l1 l2 : list X),
  rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof.
  (* 여기를 채우시오 *) Admitted.

Theorem rev_involutive : forall X : Type, forall l : list X,
  rev (rev l) = l.
Proof.
  (* 여기를 채우시오 *) Admitted.
(** [] *)

(* ================================================================= *)
(** ** 다형성을 갖춘 쌍 *)

(** 동일한 패턴을 따라 지난 장에서 정의했던 숫자 쌍의 타입 정의를 보통
    _곱_이라고 부르는 _다형성을 갖춘 숫자 쌍_으로 일반화 시킬 수 있다: *)

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

Arguments pair {X} {Y} _ _.

(** 리스트에 대해 그랬던 것 처럼 타입 인자들을 묵시적으로 선언하고
    익숙한 표기법을 정의한다. *)

Notation "( x , y )" := (pair x y).

(** [Notation] 방법으로 곱 _타입_의 표준 표기법을 정의할 수도 있다: *)

Notation "X * Y" := (prod X Y) : type_scope.

(** ([: type_scope] 주석은 콕 시스템에게 이 축약 표기는 타입을 파싱할
    때 사용되기만 해야 한다고 알려준다. 이렇게 해야 곱셈 기호와 충돌을
    피한다.) *)

(** 처음에는 [(x,y)]와 [X*Y]를 혼동할 수 있다. [(x,y)]는 두 개의 다른 값들을
    조합해서 만든 _값_이고 [X*Y]는 두 개의 다른 타입들로 만든 _타입_이다.
    만일 [x]가 [X] 타입이고 [y]가 [Y] 타입이면 [(x,y)]는 [X*Y] 타입이다. *)

(** 첫 번째 원소와 두 번째 원소를 꺼내는 함수들은 이제 어떠한 함수형
    프로그래밍 언어에서 있는 것과 상당히 비슷하게 보인다. *)

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

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

(** 다음 함수는 두 개의 리스트들을을 받아 쌍들의 리스트로
    조합한다. 다른 함수형 언어에서 종종 [zip]이라 부르는데, 우리는 콕
    표준 라이브러리와의 일관성을 위해 [combine]이라 부른다. *)

Fixpoint combine {X Y : Type} (lx : list X) (ly : list Y)
           : list (X*Y) :=
  match lx, ly with
  | [], _ => []
  | _, [] => []
  | x :: tx, y :: ty => (x, y) :: (combine tx ty)
  end.

(** **** 연습문제: 별 한 개, 선택 사항 (combine_checks)  *)
(** 다음 질문들에 대한 답을 종이 위에 작성해 답해보고 콕 시스템으로 그 답을
    검사해보시오:
    - [combine]의 타입은 무엇인가 (즉, [Check @combine]으로
      무엇을 출력하는가?)
    - 아래 명령은 무엇을 출력하는가?

        Compute (combine [1;2] [false;false;true;true]).
 *)

(** [] *)

(** **** 연습문제: 별 두 개, 추천 (split)  *)

(** 함수 [split]은 [combine]의 오른쪽 역 함수이다. 쌍들의 리스트를
    받아 리스트들의 쌍을 리턴한다. 많은 함수형 언어에서 [unzip]이라
    부른다.

    아래에서 [split]의 정의를 채우시오. 반드시 주어진 단위 테스트를
    통과하도록 확인하시오. *)

Fixpoint split {X Y : Type} (l : list (X*Y))
               : (list X) * (list Y)
  (* 이 줄을  ":= _당신의 정의_ ."로 바꾸시오 *). Admitted.

Example test_split:
  split [(1,false);(2,false)] = ([1;2],[false;false]).
Proof.
(* 여기를 채우시오 *) Admitted.
(** [] *)

(* ================================================================= *)
(** ** 다형성을 갖춘 선택 *)

(** 일단 마지막 다형 타입: _다형성을 갖운 선택_,은 이전 장에서
    [natoption]을 일반화한 것이다: *)

Inductive option (X:Type) : Type :=
  | Some : X -> option X
  | None : option X.

Arguments Some {X} _.
Arguments None {X}.

(** [nth_error] 함수를 어떤 타입의 리스트에 대해서도 동작하도록 이제
    다시 작성할 수 있다. *)

Fixpoint nth_error {X : Type} (l : list X) (n : nat)
                   : option X :=
  match l with
  | [] => None
  | a :: l' => if beq_nat n O then Some a else nth_error l' (pred n)
  end.

Example test_nth_error1 : nth_error [4;5;6;7] 0 = Some 4.
Proof. reflexivity. Qed.
Example test_nth_error2 : nth_error [[1];[2]] 1 = Some [2].
Proof. reflexivity. Qed.
Example test_nth_error3 : nth_error [true] 2 = None.
Proof. reflexivity. Qed.

(** **** 연습문제: 별 한 개, 선택사항 (hd_error_poly)  *)
(** 이전 장의 [hd_error] 함수의 다형성을 갖춘 버전을 완성하시오. 아래에
    있는 단위 테스트들을 모두 통과하도록 확인하시오. *)

Definition hd_error {X : Type} (l : list X) : option X
  (* 이 줄을 ":= _당신의 정의_ ."로 대체하시오. *). Admitted.

(** 다시 한 번, 묵시적 인자들을 강제로 명시적으로 작성하게 만들려면 그
    함수 이름 앞에 [@]을 사용할 수 있다. *)

Check @hd_error.

Example test_hd_error1 : hd_error [1;2] = Some 1.
 (* 여기를 채우시오 *) Admitted.
Example test_hd_error2 : hd_error  [[1];[2]]  = Some [1].
 (* 여기를 채우시오 *) Admitted.
(** [] *)

(* ################################################################# *)
(** * 데이터로서 함수 *)

(** 모든 함수형 언어들 (ML, Haskell, Scheme, Scala, Clojure, 등)을
    포함한 많은 다른 현대 프로그래밍 언어와 같이 콕 시스템은 함수들을
    일등 시민으로 다룬다. 즉, 함수들을 다른 함수들의 인자로 전달하고
    그 결과로 리턴하며 자료 구조에 저장하는 등등.  *)

(* ================================================================= *)
(** ** 고차원 함수 *)

(** 다른 함수들을 다루는 함수들은 보통 _고차원_ 함수라 부른다. 여기
    간단한 고차원 함수가 있다: *)

Definition doit3times {X:Type} (f:X->X) (n:X) : X :=
  f (f (f n)).

(** 여기 인자 [f]는 그 자체로 함수 ([X]에서 [X]로
    매핑하는)이다. [doit3times]의 몸체에서 [f]를 어떤 값 [n]에 세 번
    적용한다.  *)

Check @doit3times.
(* ===> doit3times : forall X : Type, (X -> X) -> X -> X *)

Example test_doit3times: doit3times minustwo 9 = 3.
Proof. reflexivity.  Qed.

Example test_doit3times': doit3times negb true = false.
Proof. reflexivity.  Qed.

(* ================================================================= *)
(** ** 필터(Filter) *)

(** 여기 더 유용한 고차원 함수가 있다. [X] 타입의 리스트와 [X]에 관한
    _술어_([X]를 [bool]로 매핑하는 함수)를 받아 그 리스트를
    "필터링"하고 이 술어가 [true]인 원소들만을 포함하는 새로운
    리스트를 리턴한다. *)

Fixpoint filter {X:Type} (test: X->bool) (l:list X)
                : (list X) :=
  match l with
  | []     => []
  | h :: t => if test h then h :: (filter test t)
                        else       filter test t
  end.

(** 예를 들어, [filter]를 술어 [evenb]와 숫자 리스트 [l]에 적용하면
    [l]의 짝수들만을 포함하는 리스트를 리턴한다.  *)

Example test_filter1: filter evenb [1;2;3;4] = [2;4].
Proof. reflexivity.  Qed.

Definition length_is_1 {X : Type} (l : list X) : bool :=
  beq_nat (length l) 1.

Example test_filter2:
    filter length_is_1
           [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ]
  = [ [3]; [4]; [8] ].
Proof. reflexivity.  Qed.

(** [Lists] 장에서 정의한 [countoddmembers]을 [filter]를 사용하여
    간단하게 정의할 수 있다. *)

Definition countoddmembers' (l:list nat) : nat :=
  length (filter oddb l).

Example test_countoddmembers'1:   countoddmembers' [1;0;3;1;4;5] = 4.
Proof. reflexivity.  Qed.
Example test_countoddmembers'2:   countoddmembers' [0;2;4] = 0.
Proof. reflexivity.  Qed.
Example test_countoddmembers'3:   countoddmembers' nil = 0.
Proof. reflexivity.  Qed.

(* ================================================================= *)
(** ** 이름이 없는 함수 *)

(** 바로 위 예제에서 단지 [filter]의 인자로 전달하기 위해서 함수
    [length_is_1]을 정의하고 이름을 붙여야 하는 것은 거의 틀림없이
    약간 슬픈 일이다. 왜냐하면 이 함수는 결코 다시 사용하지 않을
    것이기 때문이다. 더우기 이것은 단발성 예제가 아니다. 고차원
    함수들을 사용할 때 다시 사용하지 않을 "단발성" 함수들을 인자들로
    전달하기를 원할 것이다. 이런 함수들에 이름을 지어야 하는 것은 매우
    번거로운 일이 될 것이다.

    다행히도 더 나은 방법이 있다. 함수를 상위 레벨에서 선언하거나
    이름을 붙이지 않고 "즉석으로" 함수를 만들 수 있다. *)

Example test_anon_fun':
  doit3times (fun n => n * n) 2 = 256.
Proof. reflexivity.  Qed.

(** 식 [(fun n => n * n)]은 "주어진 숫자 [n]으로 부터 [n * n]을 내는
    함수"로 읽을 수 있다. *)

(** 여기 [filter] 예제가 있다. 이름 없는 함수를 사용해서 다시
    작성하였다. *)

Example test_filter2':
    filter (fun l => beq_nat (length l) 1)
           [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ]
  = [ [3]; [4]; [8] ].
Proof. reflexivity.  Qed.

(** **** 연습문제: 별 두 개 (filter_even_gt7)  *)
(** ([Fixpoint] 대신) [filter]를 사용해서 콕 함수 [filter_even_gt7]을
    작성하시오. 이 함수는 입력으로 자연수 리스트를 받아 짝수이면서
    7보다 큰 숫자들만으로 이루어진 리스트를 리턴한다. *)

Definition filter_even_gt7 (l : list nat) : list nat
  (* 이 줄을 ":= _당신의 정의_ ."로 바꾸시오 *). Admitted.

Example test_filter_even_gt7_1 :
  filter_even_gt7 [1;2;6;9;10;3;12;8] = [10;12;8].
 (* 여기를 채우시오 *) Admitted.

Example test_filter_even_gt7_2 :
  filter_even_gt7 [5;2;6;19;129] = [].
 (* 여기를 채우시오 *) Admitted.
(** [] *)

(** **** 연습문제: 별 세 개 (partition)  *)
(** [filter]를 사용하여 콕 함수 [partition]을 작성하시오:

      partition : forall X : Type, (X -> bool) -> list X -> list X *
                  list X

   집합 [X], 타입 [X -> bool]의 테스트 함수와 [list X]가 주어지면
   [partition]은 리스트들의 쌍을 리턴한다. 이 쌍의 첫 번째 원소는 원래
   리스트의 서브 리스트로 그 테스트를 만족하는 원소들을 포함한다. 두
   번째 원소는 이 테스트에 실패한 원소들을 포함하는 서브
   리스트이다. 두 서브리스트들의 원소들의 순서는 원래 리스트에서
   순서와 동일해야 한다. *)

Definition partition {X : Type}
                     (test : X -> bool)
                     (l : list X)
                   : list X * list X
  (* 이 줄을 ":= _당신의 정의_ ."로 대체하시오 *). Admitted.

Example test_partition1: partition oddb [1;2;3;4;5] = ([1;3;5], [2;4]).
(* 여기를 채우시오 *) Admitted.
Example test_partition2: partition (fun x => false) [5;9;0] = ([], [5;9;0]).
(* 여기를 채우시오 *) Admitted.
(** [] *)

(* ================================================================= *)
(** ** 맵(Map) *)

(** 또 다른 편리한 고차원 함수 [map]이 있다. *)

Fixpoint map {X Y:Type} (f:X->Y) (l:list X) : (list Y) :=
  match l with
  | []     => []
  | h :: t => (f h) :: (map f t)
  end.

(** 함수 [f]와 리스트 [ l = [n1, n2, n3, ...] ]을 받아 리스트 [ [f n1,
    f n2, f n3,...] ]을 리턴한다. 이 리스트는 [f]를 [l]의 각 원소에
    차례로 적용한 결과이다. 예를 들어: *)

Example test_map1: map (fun x => plus 3 x) [2;0;2] = [5;3;5].
Proof. reflexivity.  Qed.

(** 입출력 리스트의 원소 타입들은 동일할 필요가 없다. 그래서 [map]은
    _두 개_의 타입 인자들 [X]와 [Y]를 받는다. 맵 함수는 숫자 리스트와
    숫자를 부울 값으로 매핑하는 함수에 적용하면 부울 값 리스트를 낼 수
    있다: *)

Example test_map2:
  map oddb [2;1;2;5] = [false;true;false;true].
Proof. reflexivity.  Qed.

(** 맵 함수는 숫자 리스트와 숫자를 _부울 리스트들_로 매핑하는 함수에
    적용해서 부울 _리스트들의 리스트_를 낼 수 있다: *)

Example test_map3:
    map (fun n => [evenb n;oddb n]) [2;1;2;5]
  = [[true;false];[false;true];[true;false];[false;true]].
Proof. reflexivity.  Qed.

(* ----------------------------------------------------------------- *)
(** *** 연습문제들 *)

(** **** 연습문제: 별 세 개 (map_rev)  *)
(** [map]과 [rev]의 교환 법칙을 보여준다. 보조 정리를 새로 정의할 필요가
    있다. *)

Theorem map_rev : forall (X Y : Type) (f : X -> Y) (l : list X),
  map f (rev l) = rev (map f l).
Proof.
  (* 여기를 채우시오 *) Admitted.
(** [] *)

(** **** 연습문제: 별 두 개, 추천 (flat_map)  *)
(** 함수 [map]은 [X -> Y] 타입의 함수를 사용하여 [list X]의 원소를
    [list Y] 원소로 매핑한다. 이와 비슷한 함수 [flat_map]을 정의하여
    [X -> list Y] 타입의 함수 [f]를 사용하여 [list X]의 원소를 [list
    Y]의 원소로 매핑한다. 이 함수의 정의는 아래와 같이 [f]의 결과를
    '펼치면서' 동작해야 한다:

        flat_map (fun n => [n;n+1;n+2]) [1;5;10] = [1; 2; 3; 5; 6; 7;
      10; 11; 12].  *)

Fixpoint flat_map {X Y:Type} (f:X -> list Y) (l:list X)
                   : (list Y)
  (* 이 줄을  ":= _당신의 정의_ ."로 대체하시오 *). Admitted.

Example test_flat_map1:
  flat_map (fun n => [n;n;n]) [1;5;4]
  = [1; 1; 1; 5; 5; 5; 4; 4; 4].
 (* 여기를 채우시오 *) Admitted.
(** [] *)

(** 리스트는 [map] 함수로 다룰 수 있는 유일한 귀납적 타입이 아니다.
    [option] 타입에 대한 [map] 함수는 이렇게 정의할 수 있다: *)

Definition option_map {X Y : Type} (f : X -> Y) (xo : option X)
                      : option Y :=
  match xo with
    | None => None
    | Some x => Some (f x)
  end.

(** **** 연습문제: 별 두 개, 선택사항 (implicit_args)  *)
(** [filter]와 [map]를 정의하고 사용할 때 많은 곳에서 묵시적 인자들을
    사용한다.  묵시적 인자들 주위의 중괄호들을 괄호로 바꾸고 필요한
    곳에 명시적으로 타입 인자들을 채운다. 콕 시스템을 사용하여 제대로
    바꾸었음을 확인하시오. (이 연습문제의 답은 제출하지 않는다. 이
    파일을 _복사_해서 연습문제를 풀고 나중에 버리는 것이 분명히 가장
    쉬울 것이다.)  *)
(** [] *)

(* ================================================================= *)
(** ** 접기(Fold) *)

(** 훨씬 더 강력한 고차원 함수 [fold]가 있다. 이 함수는 구글의
    맵/리듀스 분산 프로그래밍 프레임워크의 핵심에서 사용하는
    "[reduce]" 연산을 위한 영감을 제공한다.  *)

Fixpoint fold {X Y:Type} (f: X->Y->Y) (l:list X) (b:Y)
                         : Y :=
  match l with
  | nil => b
  | h :: t => f h (fold f t b)
  end.

(** 직관적으로 [fold] 연산의 동작은 주어진 이진 연산 [f]를 주어진 리스트의 원소들의
    각 쌍에 적용하는 것이다. 예를 들어 [ fold plus [1;2;3;4] ]는 직관적으로
    [1+2+3+4]가 된다. 자세히 설명하면, [f]에 대한 초기 두 번째 입력으로 사용할
    "시작 원소"도 필요하다. 예를 들어,

       fold plus [1;2;3;4] 0

    는 아래 결과를 낸다:

       1 + (2 + (3 + (4 + 0))).

    몇 가지 추가 예제들: *)

Check (fold andb).
(* ===> fold andb : list bool -> bool -> bool *)

Example fold_example1 :
  fold mult [1;2;3;4] 1 = 24.
Proof. reflexivity. Qed.

Example fold_example2 :
  fold andb [true;true;false;true] true = false.
Proof. reflexivity. Qed.

Example fold_example3 :
  fold app  [[1];[];[2;3];[4]] [] = [1;2;3;4].
Proof. reflexivity. Qed.

(** **** 연습문제: 별 한 개, 고급 (fold_types_different)  *)
(** [fold]의 타입은 _두 개_의 타입 변수들 [X]와 [Y] 패러미터로
    구성되어 있고, 인자 [f]는 [X]의 원소와 [Y]의 원소를 받아 [Y]의
    원소를 리턴하는 이진 연산이다. [X]와 [Y]와 다르면 유용한 상황이
    무엇일지 생각해보시오.  *)

(* 여기를 채우시오 *)
(** [] *)

(* ================================================================= *)
(** ** 함수를 만드는 함수 *)

(** 지금까지 이야기한 대부분의 고차원 함수들은 함수들을 인자로 받는
    것이었다. 다른 함수들의 결과로 함수들을 _리턴_하는 몇 가지 예제를
    살펴보자. 우선 (어떤 타입 [X]의) 값 [x]를 받고 [nat]에서 [X]로
    매핑하는 그래서 [x]를 내는 함수를 리턴하는 함수가 여기 있다.
    [nat] 인자는 무시한다. *)

Definition constfun {X: Type} (x: X) : nat->X :=
  fun (k:nat) => x.

Definition ftrue := constfun true.

Example constfun_example1 : ftrue 0 = true.
Proof. reflexivity. Qed.

Example constfun_example2 : (constfun 5) 99 = 5.
Proof. reflexivity. Qed.

(** 사실 이미 살펴본 다중 인자 함수들은 함수들을 데이터로 전달하는
    예제이기도 하다.  그 이유를 살펴보기 위해 [plus] 타입을 다시
    생각해본다. *)

Check plus.
(* ==> nat -> nat -> nat *)

(** 이 식에서 각 [->]은 실제로 타입에 대한 _이진_ 연산이다. 이 것은
    _우측으로 묶인_ 연산이다. 그래서 [plus]의 타입은 정말로 [nat ->
    (nat -> nat)]을 짧게 줄인 것이다. 즉, "[plus]는 단일 인자 함수로
    [nat]의 값을 받고 또 다른 단일 인자 함수를 리턴한다. 이 함수는
    [nat]의 값을 받아 [nat]의 값을 리턴한다"이다.  위 예제에서 항상
    [plus]를 한번에 두 개의 인자에 적용했지만 원한다면 단지 첫 번째
    인자만 줄 수 있다. 이러한 함수 사용을 _부분 적용_이라 부른다. *)

Definition plus3 := plus 3.
Check plus3.

Example test_plus3 :    plus3 4 = 7.
Proof. reflexivity.  Qed.
Example test_plus3' :   doit3times plus3 0 = 9.
Proof. reflexivity.  Qed.
Example test_plus3'' :  doit3times (plus 3) 0 = 9.
Proof. reflexivity.  Qed.

(* ################################################################# *)
(** * 추가 연습문제들 *)

Module Exercises.

(** **** 연습문제: 별 두 개 (fold_length)  *)
(** 리스트에 대한 많은 공통 함수들은 [fold]를 이용해서 구현할 수 있다.
    예를 들어, [length]를 이렇게 정의할 수도 있다: *)

Definition fold_length {X : Type} (l : list X) : nat :=
  fold (fun _ n => S n) l 0.

Example test_fold_length1 : fold_length [4;7;0] = 3.
Proof. reflexivity. Qed.

(** [fold_length]의 정확성을 증명하시오. *)

Theorem fold_length_correct : forall X (l : list X),
  fold_length l = length l.
(* 여기를 채우시오 *) Admitted.
(** [] *)

(** **** 연습문제: 별 세 개 (fold_map)  *)
(** [fold]를 사용하여 [map]도 정의할 수 있다. 아래의 [fold_map]을
    마무리 지으시오. *)

Definition fold_map {X Y:Type} (f : X -> Y) (l : list X) : list Y
  (* 이 줄을 ":= _당신의 정의_ "로 대체하시오. *). Admitted.

(** [fold_map]의 정확성을 기술하는 [fold_map_correct] 정리를 콕으로
    작성하고 증명하시오. *)

(* 여기를 채우시오 *)
(** [] *)

(** **** 연습문제: 별 두 개, 고급 (currying)  *)
(** 콕에서 함수 [f : A -> B -> C]는 실제로 [A -> (B -> C)]
    타입이다. 즉, [f]에 [A] 타입의 값을 주면 함수 [f' B -> C]를 낼
    것이다. [f']에 [B]를 주면 [C] 타입의 값을 리턴할 것이다. 이런
    방식으로 [plus3]에서 처럼 부분 적용을 사용한다. 일련의 인자들을
    함수를 리턴하는 함수로 처리하는 것을 _커링_이라 부른다. 논리학자
    하스켈 커리(Haskell Curry)의 이름을 따서 붙인 것이다.

    역으로 [A -> B -> C] 타입을 [(A * B) -> C]로 해석할 수 있다.  이
    것을 _언커링_이라 부른다. 언커링 이진 함수에는 두 인자들을 쌍으로
    한 번에 주어야 한다. 부분 적용을 허용하지 않는다. *)

(** 다음과 같이 커링을 정의할 수 있다: *)

Definition prod_curry {X Y Z : Type}
  (f : X * Y -> Z) (x : X) (y : Y) : Z := f (x, y).

(** 연습문제로 이 것의 역 [prod_uncurry]을 정의하시오. 그런 다음 이 두
    가지가 서로 역이라는 것을 보이는 정리들을 아래에서 증명하시오. *)

Definition prod_uncurry {X Y Z : Type}
  (f : X -> Y -> Z) (p : X * Y) : Z
  (* 이 줄을 ":= _당신의 정의_ "로 대체하시오. *). Admitted.

(** 커링이 유용한 (사소한) 예로써 위에서 본 예제들 중 하나를 짧게 하기
    위해 커링을 사용할 수 있다: *)

Example test_map1': map (plus 3) [2;0;2] = [5;3;5].
Proof. reflexivity.  Qed.

(** 사고 단련: 다음 명령어들을 실행하기 전에 [prod_curry]와
    [prod_uncurry]의 타입들을 계산해보자. *)

Check @prod_curry.
Check @prod_uncurry.

Theorem uncurry_curry : forall (X Y Z : Type)
                        (f : X -> Y -> Z)
                        x y,
  prod_curry (prod_uncurry f) x y = f x y.
Proof.
  (* 여기를 채우시오 *) Admitted.

Theorem curry_uncurry : forall (X Y Z : Type)
                        (f : (X * Y) -> Z) (p : X * Y),
  prod_uncurry (prod_curry f) p = f p.
Proof.
  (* 여기를 채우시오 *) Admitted.
(** [] *)

(** **** 연습문제: 별 두 개, 고급 (nth_error_informal)  *)
(** [nth_error] 함수의 정의를 생각해보자:

   Fixpoint nth_error {X : Type} (l : list X) (n : nat) : option X :=
     match l with
     | [] => None
     | a :: l' => if beq_nat n O then Some a else nth_error l' (pred n)
     end.

   다음 정리를 비형싲거으로 증명해보시오:

   forall X n l, length l = n -> @nth_error X l n = None

(* 여기를 채우시오 *)
*)
(** [] *)

(** **** 연습문제: 별 네 개, 고급 (church_numerals)  *)
(** 이 연습문제는 수학자 알론조 처치 이름을 따서 _처치 숫자_라고
    부르는 자연수를 정의하는 한 가지 방법을 탐구한다. 자연수 [n]을
    함수 [f]를 인자로 받고 [f]를 [n]번 반복하는 함수로 표현할 수
    있다. *)

Module Church.
Definition nat := forall X : Type, (X -> X) -> X -> X.

(** 이 표기법으로 몇 가지 숫자를 작성하는 법을 살펴보자. 함수를 한 번
    반복하는 것은 적용하는 것과 동일해야 한다. 그래서: *)

Definition one : nat :=
  fun (X : Type) (f : X -> X) (x : X) => f x.

(** 비슷하게 [two]는 [f]를 그 인자에 두 번 적용해야 한다: *)

Definition two : nat :=
  fun (X : Type) (f : X -> X) (x : X) => f (f x).

(** 다소 교묘하게 [zero]를 정의한다. 어떻게 "함수를 0번 적용"할 수
    있을까?  그 답은 실제로 간단하다. 그냥 인자를 건드리지 않고
    반환하면 된다. *)

Definition zero : nat :=
  fun (X : Type) (f : X -> X) (x : X) => x.

(** 더 일반적으로 숫자 [n]을 [fun X f x => f (f ... (f x) ...)]로
    [f]가 [n]번 나타나도록 작성할 수 있다. 특히 이전에 정의했던
    [doit3times] 함수가 실제로 [3]의 처치 표현임을 주목하라. *)

Definition three : nat := @doit3times.

(** 다음 함수들의 정의를 완성하시오. 해당하는 단위 테스트들을
    통과하는지 [reflexivity] 로 증명해서 확인하시오.  *)

(** 다음 자연수: *)

Definition succ (n : nat) : nat
  (* 이 줄을 ":= _당신의 정의_ "로 대체하시오 *). Admitted.

Example succ_1 : succ zero = one.
Proof. (* 여기를 채우시오 *) Admitted.

Example succ_2 : succ one = two.
Proof. (* 여기를 채우시오 *) Admitted.

Example succ_3 : succ two = three.
Proof. (* 여기를 채우시오 *) Admitted.

(** 두 자연수에 대한 덧셈: *)

Definition plus (n m : nat) : nat
  (* 이 줄을 ":= _당신의 정의_ "로 대체하시오 *). Admitted.

Example plus_1 : plus zero one = one.
Proof. (* 여기를 채우시오 *) Admitted.

Example plus_2 : plus two three = plus three two.
Proof. (* 여기를 채우시오 *) Admitted.

Example plus_3 :
  plus (plus two two) three = plus one (plus three three).
Proof. (* 여기를 채우시오 *) Admitted.

(** 곱셈: *)

Definition mult (n m : nat) : nat
  (* 이 줄을 ":= _당신의 정의_ "로 대체하시오 *). Admitted.

Example mult_1 : mult one one = one.
Proof. (* 여기를 채우시오 *) Admitted.

Example mult_2 : mult zero (plus three three) = zero.
Proof. (* 여기를 채우시오 *) Admitted.

Example mult_3 : mult two three = plus three three.
Proof. (* 여기를 채우시오 *) Admitted.

(** 누승: *)

(** (_힌트_: 다형성은 여기서 중요한 역할을 담당한다. 그러나 반복할
    적절한 타입을 선택하는 것이 까다롭다. 만일 "Universe
    inconsistency" 에러를 만나면 다른 타입에 대해 반복할 것을
    시도해보시오: [nat] 자체는 대체로 여러 문제가 있다.) *)

Definition exp (n m : nat) : nat
  (* 이 줄을 ":= _당신의 정의_ "로 대체하시오 *). Admitted.

Example exp_1 : exp two two = plus two two.
Proof. (* 여기를 채우시오 *) Admitted.

Example exp_2 : exp three two = plus (mult two (mult two two)) one.
Proof. (* 여기를 채우시오 *) Admitted.

Example exp_3 : exp three zero = one.
Proof. (* 여기를 채우시오 *) Admitted.

End Church.
(** [] *)

End Exercises.

(** $Date: 2017-09-06 11:44:36 -0400 (Wed, 06 Sep 2017) $ *)


(** * Perm: Basic Techniques for Comparisons and Permutations *)

(** Consider these algorithms and data structures:
    - sort a sequence of numbers
    - finite maps from numbers to (arbitrary-type) data
    - finite maps from any ordered type to (arbitrary-type) data
    - priority queues: finding/deleting the highest number in a set

    To prove the correctness of such programs, we need to reason about
    comparisons, and about whether two collections have the same
    contents.  In this chapter, we introduce some techniques for
    reasoning about:

    - less-than comparisons on natural numbers, and
    - permutations (rearrangements of lists).

    In later chapters, we'll apply these proof techniques to reasoning
    about algorithms and data structures. *)

Set Warnings "-notation-overridden,-parsing".
From Coq Require Import Strings.String.  (* for manual grading *)
From Coq Require Export Bool.Bool.
From Coq Require Export Arith.Arith.
From Coq Require Export Arith.EqNat.
From Coq Require Export Omega.
From Coq Require Export Lists.List.
Export ListNotations.
From Coq Require Export Permutation.

(* ################################################################# *)
(** * The Less-Than Order on the Natural Numbers *)

(** In our proofs about searching and sorting algorithms, we often
    have to reason about the less-than order on natural numbers.
    greater-than. Recall that the Coq standard library contains both
    propositional and Boolean less-than operators on natural numbers.
    We write [x < y] for the proposition that [x] is less than [y]: *)

Locate "_ < _". (* "x < y" := lt x y *)
Check lt : nat -> nat -> Prop.

(** And we write [x <? y] for the computation that returns [true] or
    [false] depending on whether [x] is less than [y]: *)

Locate "_ <? _". (* x <? y  := Nat.ltb x y *)
Check Nat.ltb : nat -> nat -> bool.

(** The two operators are a reflection of one another, as discussed in
    [Logic] and [IndProp]. The [Nat] module has a
    theorem showing how they relate: *)

Check Nat.ltb_lt : forall n m : nat, (n <? m) = true <-> n < m.

(** The [Nat] module contains a synonym for [lt]. *)

Print Nat.lt. (* Nat.lt = lt *)

(** For unknown reasons, [Nat] does not define notations
    for [>?] or [>=?].  So we define them here: *)

Notation  "a >=? b" := (Nat.leb b a)
                          (at level 70) : nat_scope.
Notation  "a >? b"  := (Nat.ltb b a)
                         (at level 70) : nat_scope.

(* ================================================================= *)
(** ** The Omega Tactic *)

(** Reasoning about inequalities by hand can be a little painful. Luckily, Coq
    provides a tactic called [omega] that is quite helpful. *)

Theorem omega_example1:
 forall i j k,
    i < j ->
    ~ (k - 3 <= j) ->
   k > i.
Proof.
  intros.

(** The hard way to prove this is by hand. *)

  (* try to remember the name of the lemma about negation and [<=] *)
  Search (~ _ <= _ -> _).
  apply not_le in H0.
  (* try to remember the name of the transitivity lemma about [>] *)
  Search (_ > _ -> _ > _ -> _ > _).
  apply gt_trans with j.
  apply gt_trans with (k-3).
  (* Is [k] greater than [k-3]? On the integers, sure. But we're working
     with natural numbers, which truncate subtraction at zero. *)
Abort.

Theorem truncated_subtraction: ~ (forall k:nat, k > k - 3).
Proof.
  intros contra.
  (* [specialize] applies a hypothesis to an argument *)
  specialize (contra 0).
  simpl in contra.
  inversion contra.
Qed.

(** Since subtraction is truncated, does [omega_example1] actually hold?
    It does. Let's try again, the hard way, to find the proof. *)

Theorem omega_example1:
 forall i j k,
    i < j ->
    ~ (k - 3 <= j) ->
   k > i.
Proof. (* try again! *)
  intros.
  apply not_le in H0.
  unfold gt in H0.
  unfold gt.
  (* try to remember the name ... *)
  Search (_ < _ -> _ <= _ -> _ < _).
  apply lt_le_trans with j.
  apply H.
  apply le_trans with (k-3).
  Search (_ < _ -> _ <= _).
  apply lt_le_weak.
  auto.
  apply le_minus.
Qed.

(** That was tedious.  Here's a much easier way: *)

Theorem omega_example2:
 forall i j k,
    i < j ->
    ~ (k - 3 <= j) ->
   k > i.
Proof.
  intros.
  omega.
Qed.

(** Omega is a decision procedure invented in 1991 by William Pugh for
    integer linear programming (ILP). The [omega] tactic was made
    available by importing [Coq.omega.Omega], at the beginning of the
    file.  It is an implementation of Pugh's algorithm.  The tactic
    works with Coq types [Z] and [nat], and these operators: [<] [=] [>]
    [<=] [>=] [+] [-] [~], as well as multiplication by small integer
    literals (such as 0,1,2,3...), and some uses of [\/] and [/\].

    Omega does not "understand" other operators.  It treats
    expressions such as [a * b] and [f x y] as variables.  That is, it
    can prove [f x y > a * b -> f x y + 3 >= a * b], in the same way it
    would prove [u > v -> u + 3 >= v]. But it cannot reason about, e.g.,
    multiplication. *)

Theorem omega_example_3 : forall (f : nat -> nat -> nat) a b x y,
    f x y > a * b -> f x y + 3 >= a * b.
Proof.
  intros. omega.
Qed.

Theorem omega_example_4 : forall a b,
    a * b = b * a.
Proof.
  intros. Fail omega.
Abort.

(** The Omega algorithm is NP-complete, so we might expect that
    this tactic is exponential-time in the worst case.  Indeed,
    if you have [N] equations, it could take [2^N] time.
    But in the typical cases that result from reasoning about
    programs, [omega] is much faster than that. *)

(* ################################################################# *)
(** * Swapping *)

(** Consider trying to sort a list of natural numbers.  As a small piece of
    a sorting algorithm, we might need to swap the first two elements of a list
    if they are out of order. *)

Definition maybe_swap (al: list nat) : list nat :=
  match al with
  | a :: b :: ar => if a >? b then b :: a :: ar else a :: b :: ar
  | _ => al
  end.

Example maybe_swap_123:
  maybe_swap [1; 2; 3] = [1; 2; 3].
Proof. reflexivity. Qed.

Example maybe_swap_321:
  maybe_swap [3; 2; 1] = [2; 3; 1].
Proof. reflexivity. Qed.

(** Applying [maybe_swap] twice should give the same result as applying it once.
    That is, [maybe_swap] is _idempotent_. *)

Theorem maybe_swap_idempotent: forall al,
    maybe_swap (maybe_swap al) = maybe_swap al.
Proof.
  intros [ | a [ | b al]]; simpl; try reflexivity.
  destruct (b <? a) eqn:Hb_lt_a; simpl.
  - destruct (a <? b) eqn:Ha_lt_b; simpl.
    + (** Now what?  We have a contradiction in the hypotheses: it
          cannot hold that [a] is less than [b] and [b] is less than
          [a].  Unfortunately, [omega] cannot immediately show that
          for us, because it reasons about comparisons in [Prop] not
          [bool]. *)
      Fail omega.
Abort.

(** Of course we could finish the proof by reasoning directly about
    inequalities in [bool].  But this situation is going to occur
    repeatedly in our study of sorting. *)

(** Let's set up some machinery to enable using [omega] on boolean
    tests. *)

(* ================================================================= *)
(** ** Reflection *)

(** The [reflect] type, defined in the standard library (and presented
    in [IndProp]), relates a proposition to a Boolean. That is,
    a value of type [reflect P b] contains a proof of [P] if [b] is
    [true], or a proof of [~ P] if [b] is [false]. *)

Print reflect.
(*
Inductive reflect (P : Prop) : bool -> Set :=
  | ReflectT :   P -> reflect P true
  | ReflectF : ~ P -> reflect P false
 *)

(** The standard library proves a theorem that says if [P] is provable
    whenever [b = true] is provable, then [P] and [b] are reflected. *)

Check iff_reflect : forall (P : Prop) (b : bool),
    P <-> b = true -> reflect P b.

(** Using that theorem, we can quickly prove that the (in)equality operators
    are reflections. *)

Lemma eqb_reflect : forall x y, reflect (x = y) (x =? y).
Proof.
  intros x y. apply iff_reflect. symmetry.
  apply Nat.eqb_eq.
Qed.

Lemma ltb_reflect : forall x y, reflect (x < y) (x <? y).
Proof.
  intros x y. apply iff_reflect. symmetry.
  apply Nat.ltb_lt.
Qed.

Lemma leb_reflect : forall x y, reflect (x <= y) (x <=? y).
Proof.
  intros x y. apply iff_reflect. symmetry.
  apply Nat.leb_le.
Qed.

(** Here's an example of how you could use these lemmas.  Suppose you
    have this simple program, [(if a <? 5 then a else 2)], and you
    want to prove that it evaluates to a number smaller than 6.  You
    can use [ltb_reflect] "by hand": *)

Example reflect_example1: forall a,
    (if a <? 5 then a else 2) < 6.
Proof.
  intros a.
  (* The next two lines aren't strictly necessary, but they
     help make it clear what [destruct] does. *)
  assert (R: reflect (a < 5) (a <? 5)) by apply ltb_reflect.
  remember (a <? 5) as guard.
  destruct R as [H|H] eqn:HR.
  * (* ReflectT *) omega.
  * (* ReflectF *) omega.
Qed.

(** For the [ReflectT] constructor, the guard [a <? 5] must be equal
    to [true]. The [if] expression in the goal has already been
    simplified to take advantage of that fact. Also, for [ReflectT] to
    have been used, there must be evidence [H] that [a < 5] holds.
    From there, all that remains is to show [a < 5] entails [a < 6].
    The [omega] tactic, which is capable of automatically proving some
    theorems about inequalities, succeeds.

    For the [ReflectF] constructor, the guard [a <? 5] must be equal
    to [false]. So the [if] expression simplifies to [2 < 6], which is
    immediately provable by [omega]. *)

(** A less didactic version of the above proof wouldn't do the
    [assert] and [remember]: we can directly skip to [destruct]. *)

Example reflect_example1': forall a,
    (if a <? 5 then a else 2) < 6.
Proof.
  intros a. destruct (ltb_reflect a 5); omega.
Qed.

(** But even that proof is a little unsatisfactory. The original expression,
    [a <? 5], is not perfectly apparent from the expression [ltb_reflect a 5]
    that we pass to [destruct]. *)

(** It would be nice to be able to just say something like [destruct
    (a <? 5)] and get the reflection "for free."  That's what we'll
    engineer, next. *)

(* ================================================================= *)
(** ** A Tactic for Boolean Destruction *)

(** We're now going to build a tactic that you'll want to _use_, but
    you won't need to understand the details of how to _build_ it
    yourself.

    Let's put several of these [reflect] lemmas into a Hint database.
    We call it [bdestruct], because we'll use it in our
    boolean-destruction tactic: *)

Hint Resolve ltb_reflect leb_reflect eqb_reflect : bdestruct.

(** Here is the tactic, the body of which you do not need to
    understand.  Invoking [bdestruct] on Boolean expression [b] does
    the same kind of reasoning we did above: reflection and
    destruction.  It also attempts to simplify negations involving
    inequalities in hypotheses. *)

Ltac bdestruct X :=
  let H := fresh in let e := fresh "e" in
   evar (e: Prop);
   assert (H: reflect e X); subst e;
    [eauto with bdestruct
    | destruct H as [H|H];
       [ | try first [apply not_lt in H | apply not_le in H]]].

(** This tactic makes quick, easy-to-read work of our running example. *)

Example reflect_example2: forall a,
    (if a <? 5 then a else 2) < 6.
Proof.
  intros.
  bdestruct (a <? 5);  (* instead of: [destruct (ltb_reflect a 5)]. *)
  omega.
Qed.

(* ================================================================= *)
(** ** Finishing the [maybe_swap] Proof *)

(** Now that we have [bdestruct], we can finish the proof of [maybe_swap]'s
    idempotence. *)

Theorem maybe_swap_idempotent: forall al,
    maybe_swap (maybe_swap al) = maybe_swap al.
Proof.
  intros [ | a [ | b al]]; simpl; try reflexivity.
  bdestruct (a >? b); simpl.
  (** Note how [b < a] is a hypothesis, rather than [b <? a = true]. *)
  - bdestruct (b >? a); simpl.
    + (** [omega] can take care of the contradictory propositional inequalities. *)
      omega.
    + reflexivity.
  - bdestruct (a >? b); simpl.
    + omega.
    + reflexivity.
Qed.

(** When proving theorems about a program that uses Boolean
    comparisons, use [bdestruct] followed by [omega], rather than
    [destruct] followed by application of various theorems about
    Boolean operators. *)

(* ################################################################# *)
(** * Permutations *)

(** Another useful fact about [maybe_swap] is that it doesn't add or
    remove elements from the list: it only reorders them.  That is,
    the output list is a permutation of the input.  List [al] is a
    _permutation_ of list [bl] if the elements of [al] can be
    reordered to get the list [bl].  Note that reordering does not
    permit adding or removing duplicate elements. *)

(** Coq's [Permutation] library has an inductive definition of
    permutations. *)

Print Permutation.

(*
 Inductive Permutation {A : Type} : list A -> list A -> Prop :=
    perm_nil : Permutation [] []
  | perm_skip : forall (x : A) (l l' : list A),
                Permutation l l' ->
                Permutation (x :: l) (x :: l')
  | perm_swap : forall (x y : A) (l : list A),
                Permutation (y :: x :: l) (x :: y :: l)
  | perm_trans : forall l l' l'' : list A,
                 Permutation l l' ->
                 Permutation l' l'' ->
                 Permutation l l''.
 *)

(** You might wonder, "is that really the right definition?"  And
    indeed, it's important that we get a right definition, because
    [Permutation] is going to be used in our specifications of
    searching and sorting algorithms.  If we have the wrong
    specification, then all our proofs of "correctness" will be
    useless.

    It's not obvious that this is indeed the right specification of
    permutations. (It happens to be, but that's not obvious.) To gain
    confidence that we have the right specification, let's use it
    prove some properties that permutations ought to have. *)

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

    Think of some desirable properties of the [Permutation] relation
    and write them down informally in English, or a mix of Coq and
    English.  Here are four to get you started:

     - 1. If [Permutation al bl], then [length al = length bl].
     - 2. If [Permutation al bl], then [Permutation bl al].
     - 3. [[1;1]] is NOT a permutation of [[1;2]].
     - 4. [[1;2;3;4]] IS a permutation of [[3;4;2;1]].

   YOUR TASK: Add three more properties. Write them here: *)

(** Now, let's examine all the theorems in the Coq library about
    permutations: *)

Search Permutation.  (* Browse through the results of this query! *)

(** Which of the properties that you wrote down above have already
    been proved as theorems by the Coq library developers?  Answer
    here:

*)
(* Do not modify the following line: *)
Definition manual_grade_for_Permutation_properties : option (nat*string) := None.
(** [] *)

(** Let's use the permutation theorems in the library to prove the
    following theorem. *)

Example butterfly: forall b u t e r f l y : nat,
  Permutation ([b;u;t;t;e;r]++[f;l;y]) ([f;l;u;t;t;e;r]++[b;y]).
Proof.
  intros.
  (** Let's group [[u;t;t;e;r]] together on both sides.  Tactic
      [change t with u] replaces [t] with [u].  Terms [t] and [u] must
      be _convertible_, here meaning that they evalute to the same
      term. *)
  change [b;u;t;t;e;r] with ([b]++[u;t;t;e;r]).
  change [f;l;u;t;t;e;r] with ([f;l]++[u;t;t;e;r]).

  (** We don't actually need to know the list elements in
      [[u;t;t;e;r]].  Let's forget about them and just remember them
      as a variable named [utter]. *)
  remember [u;t;t;e;r] as utter. clear Hequtter.

  (** Likewise, let's group [[f;l]] and remember it as a variable. *)
  change [f;l;y] with ([f;l]++[y]).
  remember [f;l] as fl. clear Heqfl.

  (** Next, let's cancel [fl] from both sides.  In order to do that,
      we need to bring it to the beginning of each list. For the right
      list, that follows easily from the associativity of [++].  *)
  replace ((fl ++ utter) ++ [b;y]) with (fl ++ utter ++ [b;y])
    by apply app_assoc.

  (** But for the left list, we can't just use associativity.
      Instead, we need to reason about permutations and use some
      library theorems. *)
  apply perm_trans with (fl ++ [y] ++ ([b] ++ utter)).
  - replace (fl ++ [y] ++ [b] ++ utter) with ((fl ++ [y]) ++ [b] ++ utter).
    + apply Permutation_app_comm.
    + rewrite <- app_assoc. reflexivity.

  - (** A library theorem will now help us cancel [fl]. *)
    apply Permutation_app_head.

  (** Next let's cancel [utter]. *)
    apply perm_trans with (utter ++ [y] ++ [b]).
    + replace ([y] ++ [b] ++ utter) with (([y] ++ [b]) ++ utter).
      * apply Permutation_app_comm.
      * rewrite app_assoc. reflexivity.
    + apply Permutation_app_head.

      (** Finally we're left with just [y] and [b]. *)
      apply perm_swap.
Qed.

(** That example illustrates a general method for proving permutations
    involving cons [::] and append [++]:

    - Identify some portion appearing in both sides.
    - Bring that portion to the front on each side using lemmas such
      as [Permutation_app_comm] and [perm_swap], with generous use of
      [perm_trans].
    - Use [Permutation_app_head] to cancel an appended head.  You can
      also use [perm_skip] to cancel a single element. *)

(** **** Exercise: 3 stars, standard (permut_example)

    Use the permutation rules in the library to prove the following
    theorem.  The following [Check] commands are a hint about useful
    lemmas.  You don't need all of them, and depending on your
    approach you will find lemmas to be more useful than others. Use
    [Search Permutation] to find others, if you like. *)

Check perm_skip.
Check perm_trans.
Check Permutation_refl.
Check Permutation_app_comm.
Check app_assoc.
Check app_nil_r.
Check app_comm_cons.

Example permut_example: forall (a b: list nat),
  Permutation (5 :: 6 :: a ++ b) ((5 :: b) ++ (6 :: a ++ [])).
Proof.
(* SOLUTION: *)
  intros. simpl. rewrite app_nil_r.
  apply perm_skip. rewrite app_comm_cons.
  apply Permutation_app_comm.
Qed.
(** [] *)

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

    Prove that [[1;1]] is not a permutation of [[1;2]].
    Hints are given as [Check] commands. *)

Check Permutation_cons_inv.
Check Permutation_length_1_inv.

Example not_a_permutation:
  ~ Permutation [1;1] [1;2].
Proof.
(* SOLUTION: *)
Proof.
  intros H.
  apply Permutation_cons_inv in H.
  apply Permutation_length_1_inv in H.
  discriminate.
Qed.
(** [] *)

(* ================================================================= *)
(** ** Correctness of [maybe_swap] *)

(** Now we can prove that [maybe_swap] is a permutation: it reorders
    elements but does not add or remove any. *)

Theorem maybe_swap_perm: forall al,
  Permutation al (maybe_swap al).
Proof.
  (* WORKED IN CLASS *)
  unfold maybe_swap.
  destruct al as [ | a [ | b al]].
  - simpl. apply perm_nil.
  - apply Permutation_refl.
  - bdestruct (b <? a).
    + apply perm_swap.
    + apply Permutation_refl.
Qed.

(** And, we can prove that [maybe_swap] permutes elements such that
    the first is less than or equal to the second. *)

Definition first_le_second (al: list nat) : Prop :=
  match al with
  | a :: b :: _ => a <= b
  | _ => True
  end.

Theorem maybe_swap_correct: forall al,
    Permutation al (maybe_swap al)
    /\ first_le_second (maybe_swap al).
Proof.
  intros. split.
  - apply maybe_swap_perm.
  - (* WORKED IN CLASS *)
    unfold maybe_swap.
    destruct al as [ | a [ | b al]]; simpl; auto.
    bdestruct (a >? b); simpl; omega.
Qed.

(* ################################################################# *)
(** * Summary: Comparisons and Permutations *)

(** To prove correctness of algorithms for sorting and searching,
    we'll reason about comparisons and permutations using the tools
    developed in this chapter.  The [maybe_swap] program is a tiny
    little example of a sorting program.  The proof style in
    [maybe_swap_correct] will be applied (at a larger scale) in
    the next few chapters. *)

(** **** Exercise: 3 stars, standard (Forall_perm)

    To close, we define a utility tactic and lemma.  First, the
    tactic. *)

(** Coq's [inversion H] tactic is so good at extracting
    information from the hypothesis [H] that [H] sometimes becomes
    completely redundant, and one might as well [clear] it from the
    goal.  Then, since the [inversion] typically creates some equality
    facts, why not then [subst] ?  Tactic [inv] does just that. *)

Ltac inv H := inversion H; clear H; subst.

(** Second, the lemma.  You will find [inv] useful in proving it.

    [Forall] is Coq library's version of the [All] proposition defined
    in [Logic], but defined as an inductive proposition rather
    than a fixpoint.  Prove this lemma by induction.  You will need to
    decide what to induct on: [al], [bl], [Permutation al bl], and
    [Forall f al] are possibilities. *)

Theorem Forall_perm: forall {A} (f: A -> Prop) al bl,
  Permutation al bl ->
  Forall f al -> Forall f bl.
Proof.
  (* SOLUTION: *)
  intros A f al bl Hperm.
  induction Hperm; simpl; intros; auto.
  - inv H. constructor; auto.
  - inv H. inv H3. constructor; auto.
Qed.
(** [] *)

(* Mon May 11 23:22:55 EDT 2020 *)


Set Warnings "-notation-overridden,-parsing".
From Coq Require Import Arith.Arith.
From Coq Require Import Arith.EqNat.
From Coq Require Import Init.Nat.
From Coq Require Import omega.Omega.
From Coq Require Import Lists.List.
Import ListNotations.
From PLF Require Import Maps.
From PLF Require Import Imp.

Inductive tm : Type :=
  | C : nat -> tm (* Constant *)
  | P : tm -> tm -> tm. (* Plus *)

Fixpoint evalF (t : tm) : nat :=
  match t with
  | C n => n
  | P a1 a2 => evalF a1 + evalF a2
  end.

Reserved Notation " t '==>' n " (at level 50, left associativity).

Inductive eval : tm -> nat -> Prop :=
  | E_Const : forall n,
      C n ==> n
  | E_Plus : forall t1 t2 n1 n2,
      t1 ==> n1 ->
      t2 ==> n2 ->
      P t1 t2 ==> (n1 + n2)
where " t '==>' n " := (eval t n).
Module SimpleArith1.
  Reserved Notation " t '-->' t' " (at level 40).
Inductive step : tm -> tm -> Prop :=
  | ST_PlusConstConst : forall n1 n2,
      P (C n1) (C n2) --> C (n1 + n2)
  | ST_Plus1 : forall t1 t1' t2,
      t1 --> t1' ->
      P t1 t2 --> P t1' t2
  | ST_Plus2 : forall n1 t2 t2',
      t2 --> t2' ->
      P (C n1) t2 --> P (C n1) t2'
where " t '-->' t' " := (step t t').

Example test_step_1 :
      P
        (P (C 0) (C 3))
        (P (C 2) (C 4))
      -->
      P
        (C (0 + 3))
        (P (C 2) (C 4)).
Proof.
  apply ST_Plus1. apply ST_PlusConstConst. Qed.

Example test_step_2 :
      P
        (C 0)
        (P
          (C 2)
          (P (C 0) (C 3)))
      -->
      P
        (C 0)
        (P
          (C 2)
          (C (0 + 3))).
Proof.
  repeat apply ST_Plus2. apply ST_PlusConstConst. Qed.

End SimpleArith1.

Definition relation (X : Type) := X -> X -> Prop.

Definition deterministic {X : Type} (R : relation X) :=
  forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2.

Module SimpleArith2.
  Import SimpleArith1.

Theorem step_deterministic:
  deterministic step.
Proof.
  unfold deterministic.
  intros x y1 y2 Hy1 Hy2.
  generalize dependent y2.
  induction Hy1; intros y2 Hy2.
  - inversion Hy2; subst. reflexivity.
    inversion H2; subst. inversion H2; subst.
  - inversion Hy2; subst.
    inversion Hy1. (* imposible case for different type of y1 and y2*)
    rewrite (IHHy1 t1'0). reflexivity. assumption.
    inversion Hy1. (* imposible *)
  - inversion Hy2; subst.
    inversion Hy1. (* imposible*)
    inversion H2. (* imposible *)
    rewrite (IHHy1 t2'0). reflexivity. assumption.
Qed.

End SimpleArith2.

Ltac solve_by_inverts n :=
  match goal with | H : ?T |- _ =>
  match type of T with Prop =>
    solve [
      inversion H;
      match n with S (S (?n')) => subst; solve_by_inverts (S n') end ]
  end end.

Ltac solve_by_invert :=
  solve_by_inverts 1.

Module SimpleArith3.
Import SimpleArith1.
Theorem step_deterministic_alt: deterministic step.
Proof.
  intros x y1 y2 Hy1 Hy2.
  generalize dependent y2.
  induction Hy1; intros y2 Hy2;
    inversion Hy2; subst; try solve_by_invert.
  - (* ST_PlusConstConst *) reflexivity.
  - (* ST_Plus1 *)
    apply IHHy1 in H2. rewrite H2. reflexivity.
  - (* ST_Plus2 *)
    apply IHHy1 in H2. rewrite H2. reflexivity.
Qed.
End SimpleArith3.

Inductive value : tm -> Prop :=
| v_const : forall n, value (C n).

Reserved Notation " t '-->' t' " (at level 40).
Inductive step : tm -> tm -> Prop :=
  | ST_PlusConstConst : forall n1 n2,
          P (C n1) (C n2)
      --> C (n1 + n2)
  | ST_Plus1 : forall t1 t1' t2,
        t1 --> t1' ->
        P t1 t2 --> P t1' t2
  | ST_Plus2 : forall v1 t2 t2',
        value v1 -> (* <--- n.b. *)
        t2 --> t2' ->
        P v1 t2 --> P v1 t2'
where " t '-->' t' " := (step t t').

Theorem step_deterministic :
  deterministic step.
Proof.
  intros x y1 y2 Hy1 Hy2.
  generalize dependent y2.
  induction Hy1; intros y2 Hy2.
  - inversion Hy2;subst. reflexivity.
    inversion H2.
    inversion H3.
  - inversion Hy2; subst. inversion Hy1.
    rewrite (IHHy1 t1'0). reflexivity. assumption.
    inversion Hy1; subst. inversion H1. (* both has the form P t11 t12 and is a value (hence has the form C n). *)
    inversion H1.
    rewrite (IHHy1 t0). inversion H1.
    inversion H1.
  - inversion Hy2; subst. inversion Hy1; subst.
    inversion H3; subst; inversion H.
    rewrite (IHHy1 t2'0). reflexivity. assumption.
Qed.

Theorem strong_progress : forall t,
    value t \/ (exists t', t --> t').
Proof.
  induction t.
  - left. apply v_const.
  - right. destruct IHt1.
    + destruct IHt2.
      inversion H; subst. inversion H0; subst.
      exists (C (n + n0)). apply ST_PlusConstConst.
      destruct H0.
      exists (P t1 x).
      apply ST_Plus2. assumption. assumption.
    + destruct H; destruct IHt2;
        exists (P x t2); apply ST_Plus1; assumption.
Qed.

Definition normal_form {X : Type} (R : relation X) (t : X) : Prop :=
  not (exists t', R t t').

Lemma value_is_nf : forall v,
  value v -> normal_form step v.
Proof.
  unfold normal_form. intros v H. inversion H.
  intros contra. inversion contra. inversion H1.
Qed.

Lemma nf_is_value : forall t,
  normal_form step t -> value t.
Proof. (* a corollary of strong_progress... *)
  unfold normal_form. intros t H.
  assert (G : value t \/ exists t', t --> t').
  { apply strong_progress. }
  destruct G as [G | G].
  - (* l *) apply G.
  - (* r *) exfalso. apply H. assumption.
Qed.

Corollary nf_same_as_value : forall t,
  normal_form step t <-> value t.
Proof.
  split. apply nf_is_value. apply value_is_nf.
Qed.

Module Temp1.
Inductive value : tm -> Prop :=
  | v_const : forall n, value (C n)
  | v_funny : forall t1 n2,
                value (P t1 (C n2)). (* <--- *)
Reserved Notation " t '-->' t' " (at level 40).
Inductive step : tm -> tm -> Prop :=
  | ST_PlusConstConst : forall n1 n2,
      P (C n1) (C n2) --> C (n1 + n2)
  | ST_Plus1 : forall t1 t1' t2,
      t1 --> t1' ->
      P t1 t2 --> P t1' t2
  | ST_Plus2 : forall v1 t2 t2',
      value v1 ->
      t2 --> t2' ->
      P v1 t2 --> P v1 t2'

where " t '-->' t' " := (step t t').

Lemma value_not_same_as_normal_form :
  exists v, value v /\ not (normal_form step v).
Proof.
  (* FILL IN HERE *) Admitted.
End Temp1.

Module Temp4.

Inductive tm : Type :=
  | tru : tm
  | fls : tm
  | test : tm -> tm -> tm -> tm.
Inductive value : tm -> Prop :=
  | v_tru : value tru
  | v_fls : value fls.
Reserved Notation " t '-->' t' " (at level 40).
Inductive step : tm -> tm -> Prop :=
  | ST_IfTrue : forall t1 t2,
      test tru t1 t2 --> t1
  | ST_IfFalse : forall t1 t2,
      test fls t1 t2 --> t2
  | ST_If : forall t1 t1' t2 t3,
      t1 --> t1' ->
      test t1 t2 t3 --> test t1' t2 t3

where " t '-->' t' " := (step t t').

Definition bool_step_prop1 :=
  fls --> fls.

Theorem not_bool_step_prop1:
  not bool_step_prop1.
Proof.
  unfold bool_step_prop1.
  intros contra. inversion contra. Qed.

Definition bool_step_prop2 :=
     test
       tru
       (test tru tru tru)
       (test fls fls fls)
  -->
  tru.

Theorem not_bool_step_prop2:
  not bool_step_prop2.
Proof.
  intros contra. inversion contra.
Qed.

Definition bool_step_prop3 :=
     test
       (test tru tru tru)
       (test tru tru tru)
       fls
   -->
     test
       tru
       (test tru tru tru)
       fls.

Theorem true_bool_step_prop3 :
  bool_step_prop3.
Proof.
  unfold bool_step_prop3. constructor. constructor.
Qed.

Theorem strong_progress : forall t,
  value t \/ (exists t', t --> t').
Proof.
  induction t.
  - left. apply v_tru.
  - left. apply v_fls.
  - right.
    destruct IHt1. inversion H; subst.
    exists t2. apply ST_IfTrue.
    exists t3. apply ST_IfFalse.
    destruct H.
    exists (test x t2 t3). apply ST_If. assumption.
Qed.

Theorem step_deterministic :
  deterministic step.
Proof.
  intros x y1 y2 Hy1 Hy2.
  generalize dependent y2.
  induction Hy1; intros y2 Hy2.
  - inversion Hy2;subst. reflexivity.
    inversion H3.
  - inversion Hy2; subst. reflexivity.
    inversion H3.
  - inversion Hy2; subst.
    inversion Hy1.
    inversion Hy1.
    rewrite (IHHy1 t1'0). reflexivity. assumption.
Qed.

Module Temp5.

Reserved Notation " t '-->' t' " (at level 40).
Inductive step : tm -> tm -> Prop :=
  | ST_IfTrue : forall t1 t2,
      test tru t1 t2 --> t1
  | ST_IfFalse : forall t1 t2,
      test fls t1 t2 --> t2
  | ST_If : forall t1 t1' t2 t3,
      t1 --> t1' ->
      test t1 t2 t3 --> test t1' t2 t3
  | ST_Short : forall t1 t2 ,
      test t1 t2 t2 --> t2
where " t '-->' t' " := (step t t').

Definition bool_step_prop4 :=
         test
            (test tru tru tru)
            fls
            fls
     -->
     fls.

Example bool_step_prop4_holds :
  bool_step_prop4.
Proof.
  unfold bool_step_prop4. apply ST_Short. Qed.

End Temp5.
End Temp4.

Inductive multi {X : Type} (R : relation X) : relation X :=
  | multi_refl : forall (x : X), multi R x x
  | multi_step : forall (x y z : X),
                    R x y ->
                    multi R y z ->
                    multi R x z.

Notation " t '-->*' t' " := (multi step t t') (at level 40).

Theorem multi_R : forall (X : Type) (R : relation X) (x y : X),
    R x y -> (multi R) x y.
Proof.
  intros X R x y H.
  apply multi_step with y. apply H. apply multi_refl.
Qed.

Theorem multi_trans :
  forall (X : Type) (R : relation X) (x y z : X),
      multi R x y ->
      multi R y z ->
      multi R x z.
Proof.
  intros X R x y z G H.
  induction G.
    - (* multi_refl *) assumption.
    - (* multi_step *)
      apply multi_step with y. assumption.
      apply IHG. assumption.
Qed.

Lemma test_multistep_1:
      P
        (P (C 0) (C 3))
        (P (C 2) (C 4))
   -->*
      C ((0 + 3) + (2 + 4)).
Proof.
  apply multi_step with
            (P (C (0 + 3))
               (P (C 2) (C 4))).
  { apply ST_Plus1. apply ST_PlusConstConst. }
  apply multi_step with
            (P (C (0 + 3))
               (C (2 + 4))).
  { apply ST_Plus2. apply v_const. apply ST_PlusConstConst. }
  apply multi_R.
  { apply ST_PlusConstConst. }
Qed.

Lemma test_multistep_1':
      P
        (P (C 0) (C 3))
        (P (C 2) (C 4))
  -->*
      C ((0 + 3) + (2 + 4)).
Proof.
  eapply multi_step. { apply ST_Plus1. apply ST_PlusConstConst. }
  eapply multi_step. { apply ST_Plus2. apply v_const.
                       apply ST_PlusConstConst. }
  eapply multi_step. { apply ST_PlusConstConst. }
  apply multi_refl.
Qed.

Lemma test_multistep_2:
  C 3 -->* C 3.
Proof.
  apply multi_refl. Qed.

Lemma test_multistep_3:
      P (C 0) (C 3)
   -->*
      P (C 0) (C 3).
Proof.
  apply multi_refl. Qed.

Lemma test_multistep_4:
      P
        (C 0)
        (P
          (C 2)
          (P (C 0) (C 3)))
  -->*
      P
        (C 0)
        (C (2 + (0 + 3))).
Proof.
  eapply multi_step. apply ST_Plus2. constructor.
  apply ST_Plus2. constructor. constructor.
  eapply multi_step. simpl.
  apply ST_Plus2. constructor. constructor.
  simpl.
  apply multi_refl.
Qed.

Definition step_normal_form := normal_form step.
Definition normal_form_of (t t' : tm) :=
  (t -->* t' /\ step_normal_form t').

Theorem normal_forms_unique:
  deterministic normal_form_of.
Proof.
  (* We recommend using this initial setup as-is! *)
  unfold deterministic. unfold normal_form_of.
  intros x y1 y2 P1 P2.
  inversion P1 as [P11 P12]; clear P1.
  inversion P2 as [P21 P22]; clear P2.
  generalize dependent y2.
  induction P11; intros.
  destruct x.
  inversion P21; subst. reflexivity.
  inversion H; subst.
  apply nf_is_value in P12. inversion P12.
  apply IHP11.
  assumption.
  inversion P21; subst.
Admitted.

Definition normalizing {X : Type} (R : relation X) :=
  forall t, exists t',
      (multi R) t t' /\ normal_form R t'.

Lemma multistep_congr_1 : forall t1 t1' t2,
     t1 -->* t1' ->
     P t1 t2 -->* P t1' t2.
Proof.
  intros t1 t1' t2 H. induction H.
  - (* multi_refl *) apply multi_refl.
  - (* multi_step *) apply multi_step with (P y t2).
    + apply ST_Plus1. apply H.
    + apply IHmulti.
Qed.

Lemma multistep_congr_2 : forall t1 t2 t2',
     value t1 ->
     t2 -->* t2' ->
     P t1 t2 -->* P t1 t2'.
Proof.
  intros.
  induction H0.
  - apply multi_refl.
  - apply multi_step with (P t1 y).
    apply ST_Plus2. assumption.
    assumption.
    assumption.
Qed.

Theorem step_normalizing :
  normalizing step.
Proof.
  unfold normalizing.
  induction t.
  - (* C *)
    exists (C n).
    split.
    + (* l *) apply multi_refl.
    + (* r *)
      (* We can use rewrite with "iff" statements, not
           just equalities: *)
      rewrite nf_same_as_value. apply v_const.
  - (* P *)
    destruct IHt1 as [t1' [Hsteps1 Hnormal1]].
    destruct IHt2 as [t2' [Hsteps2 Hnormal2]].
    rewrite nf_same_as_value in Hnormal1.
    rewrite nf_same_as_value in Hnormal2.
    inversion Hnormal1 as [n1 H1].
    inversion Hnormal2 as [n2 H2].
    rewrite <- H1 in Hsteps1.
    rewrite <- H2 in Hsteps2.
    exists (C (n1 + n2)).
    split.
    + (* l *)
      apply multi_trans with (P (C n1) t2).
      * apply multistep_congr_1. apply Hsteps1.
      * apply multi_trans with
        (P (C n1) (C n2)).
        { apply multistep_congr_2. apply v_const. apply Hsteps2. }
        apply multi_R. { apply ST_PlusConstConst. }
    + (* r *)
      rewrite nf_same_as_value. apply v_const.
Qed.

Theorem eval__multistep : forall t n,
    t ==> n -> t -->* C n.
Proof.
  intros.
  induction H.
  apply multi_refl.
  apply multi_trans with (P (C n1) t2).
  apply multistep_congr_1. assumption.
  apply multi_trans with (P (C n1) (C n2)).
  apply multistep_congr_2. apply v_const. assumption.
  eapply multi_R. apply ST_PlusConstConst.
Qed.

Lemma step__eval : forall t t' n,
     t --> t' ->
     t' ==> n ->
     t ==> n.
Proof.
  intros t t' n Hs. generalize dependent n.
  induction Hs; intros.
  - inversion H; subst.
    constructor. constructor.
    constructor.
  - inversion H; subst.
    constructor. apply IHHs. assumption.
    assumption.
  - inversion H; subst.
    inversion H0; subst.
    constructor. assumption.
    apply IHHs. assumption.
Qed.

Theorem multistep__eval : forall t t',
  normal_form_of t t' -> exists n, t' = C n /\ t ==> n.
Proof.
  intros.
  destruct H.
  induction H.
  apply nf_is_value in H0.
  inversion H0;subst. exists n.
  split. reflexivity. constructor.
  apply  IHmulti in H0.
  destruct H0 as [n [Hz Hp]]. exists n.
  inversion H; subst; split;
    try reflexivity;
    try eapply step__eval; eassumption; eassumption.
Qed.


Require Export List.
Require Export ListSet.
Set Implicit Arguments.
Unset Strict Implicit.

(*********************************************************************)
(*                  Some List Functions                              *)
(*********************************************************************)

Definition front (A : Set) (l : list A) : list A := rev (tail (rev l)).

Definition last (A : Set) (l : list A) := head (rev l).

Fixpoint take (A : Set) (n : nat) (l : list A) {struct l} :
 list A :=
  match l with
  | nil => nil (A:=A)
  | a :: l' => match n with
               | O => nil (A:=A)
               | S m => a :: take m l'
               end
  end.

Fixpoint allunique (A : Set) (l : list A) {struct l} : Prop :=
  match l with
  | nil => True
  | x :: l' => IF In x l' then False else allunique l'
  end.

(*********************************************************************)
(*                  Some Functions for ListSet                       *)
(*********************************************************************)

Definition IsEmpty (A : Set) (B : set A) := forall x : A, ~ set_In x B.

Definition Included (A : Set) (B C : set A) :=
  forall x : A, set_In x B -> set_In x C.

Lemma AllWaysIncluded : forall (A : Set) (B : set A), Included B B.
intros.
unfold Included in |- *.
auto.

Qed.

(*********************************************************************)
(*                  Some Results about ListSet                       *)
(*********************************************************************)
Section ListSetLemmas.

Variable A : Set.

Hypothesis Aeq_dec : forall x y : A, {x = y} + {x <> y}.

Lemma Set_union1 :
 forall (B C : set A) (x : A),
 set_In x (set_union Aeq_dec B C) -> ~ set_In x B -> set_In x C.
intros.
cut (set_In x B \/ set_In x C).
intro H1; elim H1.
tauto.

auto.

eapply (set_union_elim (Aeq_dec:=Aeq_dec)); auto.

Qed.

Lemma Set_union2 :
 forall (B C : set A) (x : A),
 set_In x (set_union Aeq_dec B C) -> set_In x (set_union Aeq_dec C B).
intros.
cut (set_In x C \/ set_In x B).
intro; apply set_union_intro.
auto.

cut (set_In x B \/ set_In x C).
tauto.

eapply (set_union_elim (Aeq_dec:=Aeq_dec)).
auto.

Qed.

Lemma Set_remove2 :
 forall (B : set A) (x y : A),
 set_In x (set_remove Aeq_dec y B) -> set_In x B.
intro; intro; intro.
induction  B as [| a B HrecB].
auto.

simpl in |- *.
elim (Aeq_dec y a).
intros.
right.
auto.

simpl in |- *.
intro.
intro.
elim H.
intro.
left; auto.

intro.
right.
auto.
Qed.

Lemma Set_add1 :
 forall (B : set A) (x y : A),
 set_In x (set_add Aeq_dec y B) -> x <> y -> set_In x B.
intros.
cut (x = y \/ set_In x B).
intro.
elim H1.
intro.
absurd (x = y).
auto.

auto.

intro.
auto.

eapply (set_add_elim (A:=A) (Aeq_dec:=Aeq_dec) (a:=x) (b:=y) (x:=B)).
auto.

Qed.

Lemma Set_add2 :
 forall (B : set A) (x y : A),
 x <> y -> ~ set_In x B -> ~ set_In x (set_add Aeq_dec y B).
intros.
intro.
apply H0.
eapply (Set_add1 (B:=B) (x:=x) (y:=y)); auto.

Qed.

End ListSetLemmas.

Hint Unfold IsEmpty Included.
Hint Resolve Set_remove2 Set_add1 AllWaysIncluded Set_union1 Set_union2
  Set_add2.

Lemma Listeq_dec :
 forall A : Set,
 (forall a b : A, {a = b} + {a <> b}) ->
 forall x y : list A, {x = y} + {x <> y}.
simple induction x.
simple induction y.
auto.

intros.
right.
unfold not in |- *; intro D; discriminate D.

intros.
induction  y as [| a0 y Hrecy].
right; unfold not in |- *; intro D; discriminate D.

elim (H0 y).
intro.
rewrite a1.
elim (H a a0).
intro.
rewrite a2.
left; auto.

intro.
right.
unfold not in |- *.
unfold not in b.
intro; apply b.
injection H1.
auto.

unfold not in |- *; intro.
right.
intro; apply b.
injection H1.
auto.

Qed.

Hint Resolve Listeq_dec.

Lemma Prodeq_dec :
 forall A B : Set,
 (forall x y : A, {x = y} + {x <> y}) ->
 (forall v w : B, {v = w} + {v <> w}) ->
 forall c d : A * B, {c = d} + {c <> d}.
intros.
elim c.
elim d.
intros.
elim (H a a0); intro.
rewrite a1.
elim (H0 b b0); intro.
rewrite a2.
left; auto.

right.
intro.
apply b1.
injection H1; auto.

right; intro; apply b1.
injection H1; auto.

Qed.

Hint Resolve Prodeq_dec.


Require Import Arith.
Require Import Coq.Strings.String.
Require Import Coq.Lists.List.
Require Import Coq.Init.Datatypes.
Set Implicit Arguments .

Check 1::2::3::nil.

Eval compute in (1::2::3::nil) ++ (4::5::nil).

Eval compute in length (1::2::nil).

Eval compute in map (fun x => x + 1) (1::2::3::nil).

Eval compute in
fold_right (fun x y => x + y) 0 (1::2::3::nil).

Definition ss :=
fold_right (fun x y => x /\ y) True (True::True::True::nil).

Eval compute in ss.

Check true.
Check andb.
Eval compute in
fold_right (fun x y => (andb x y)) false (true::nil).

Section nonemptylist.

Variable X : Set.

Inductive nonemptylist : Set :=
  | Single : X -> nonemptylist
  | NewList : X -> nonemptylist -> nonemptylist.

Fixpoint app_nonempty (l1 l2 : nonemptylist) : nonemptylist :=
  match l1 with
  | Single s  => NewList s l2
  | NewList s rest => NewList s (app_nonempty rest l2)
  end.

End nonemptylist.

Section Fold_Nonempty.
  Variables A B : Set.
  Variable f : B -> A -> A.
  Variable a0 : A.

  Fixpoint fold_nonempty (l:nonemptylist B) : A :=
    match l with
      | Single s => f s a0
      | NewList s rest => f s (fold_nonempty rest)
    end.

End Fold_Nonempty.

Check andb.
Definition ne2 := Single 2.

Check Single 2.

Check app.

Section MyPair.
  Variable X : Set.
  Variable Y : Set.

  Record Twos : Set :=
  mkTwos
  {
    left    : X;
    right   : Y
  }.
End MyPair.

Definition half := (mkTwos 2 5).

Eval compute in (left half).
Check half.
Check Twos.

Section Process_Lists.

Variable X : Set.
Variable Y : Set.
Variable Z : Set.

Fixpoint process_two_lists (l1 : nonemptylist X) (l2 : nonemptylist Y) :  nonemptylist (Twos X Y) :=

let process_element_list := (fix process_element_list (e1 : X) (l2 : nonemptylist Y) :  nonemptylist (Twos X Y) :=
  match l2 with
    | Single s => Single (mkTwos e1 s)
    | NewList s rest => app_nonempty (Single (mkTwos e1 s)) (process_element_list e1 rest)
  end) in

  match l1 with
    | Single s => process_element_list s l2
    | NewList s rest => app_nonempty (process_element_list s l2) (process_two_lists rest l2)
  end.

End Process_Lists.

Definition lst1 := process_two_lists (NewList 4 (NewList 8 (Single 8))) (NewList 3 (NewList 2 (Single 1))).
Eval compute in lst1.

(*
Eval compute in
fold_nonempty (fun x y => x + y) 0 lst1.
*)

Definition lst2 := process_two_lists (NewList 91 (Single 92)) (NewList 3 (NewList 2 (Single 1))).
Eval compute in lst2.