(** * B3: Reszta logiki konstruktywnej [TODO] *)

From Typonomikon Require Export B2.

(** * Kombinatory taktyk *)

(** Przyjrzyjmy się jeszcze raz twierdzeniu [iff_intro] (lekko
    zmodernizowanemu przy pomocy kwantyfikacji uniwersalnej). *)

Lemma iff_intro' :
  forall P Q : Prop,
    (P -> Q) -> (Q -> P) -> (P <-> Q).
Proof.
  intros. split.
  - intro. apply H. assumption.
  - intro. apply H0. assumption.
Qed.

(** Jego dowód wygląda dość schematycznie. Taktyka [split] generuje
    nam dwa podcele będące implikacjami — na każdym z osobna używamy
    następnie [intro], a kończymy [assumption]. Jedyne, czym różnią
    się dowody podcelów, to nazwa aplikowanej hipotezy.

    A co, gdyby jakaś taktyka wygenerowała nam 100 takich schematycznych
    podcelów? Czy musielibyśmy przechodzić przez mękę ręcznego dowodzenia
    tych niezbyt ciekawych przypadków? Czy da się powyższy dowód jakoś
    skrócić lub zautomatyzować?

    Odpowiedź na szczęście brzmi "tak". Z pomocą przychodzą nam kombinatory
    taktyk (ang. tacticals), czyli taktyki, które mogą przyjmować jako
    argumenty inne
    taktyki. Dzięki temu możemy łączyć proste taktyki w nieco bardziej
    skomplikowane lub jedynie zmieniać niektóre aspekty ich zachowań. *)

(** ** [;] (średnik) *)

Lemma iff_intro'' :
  forall P Q : Prop,
    (P -> Q) -> (Q -> P) -> (P <-> Q).
Proof.
  split; intros; [apply H | apply H0]; assumption.
Qed.

(** Najbardziej podstawowym kombinatorem jest [;] (średnik). Zapis
    [t1; t2] oznacza "użyj na obecnym celu taktyki [t1], a następnie
    na wszystkich podcelach wygenerowanych przez [t1] użyj taktyki
    [t2]".

    Zauważmy, że taktyka [split] działa nie tylko na koniunkcjach i
    równoważnościach, ale także wtedy, gdy są one konkluzją pewnej
    implikacji. W takich przypadkach taktyka [split] przed rozbiciem
    ich wprowadzi do kontekstu przesłanki implikacji (a także zmienne
    związane kwantyfikacją uniwersalną), zaoszczędzając nam użycia
    wcześniej taktyki [intros].

    Wobec tego, zamiast wprowadzać zmienne do kontekstu przy pomocy
    [intros], rozbijać cel [split]em, a potem jeszcze w każdym
    podcelu z osobna wprowadzać do kontekstu przesłankę implikacji,
    możemy to zrobić szybciej pisząc [split; intros].

    Drugie użycie średnika jest uogólnieniem pierwszego. Zapis
    [t; [t1 | t2 | ... | tn]] oznacza "użyj na obecnym podcelu
    taktyki [t]; następnie na pierwszym wygenerowanym przez nią
    podcelu użyj taktyki [t1], na drugim [t2], etc., a na n-tym
    użyj taktyki [tn]". Wobec tego zapis [t1; t2] jest jedynie
    skróconą formą [t1; [t2 | t2 | ... | t2]].

    Użycie tej formy kombinatora [;] jest uzasadnione tym, że
    w pierwszym z naszych podcelów musimy zaaplikować hipotezę
    [H], a w drugim [H0] — w przeciwnym wypadku nasza taktyka
    zawiodłaby (sprawdź to). Ostatnie użycie tego kombinatora
    jest identyczne jak pierwsze — każdy z podcelów kończymy
    taktyką [assumption].

    Dzięki średnikowi dowód naszego twierdzenia skurczył się z
    trzech linijek do jednej, co jest wyśmienitym wynikiem —
    trzy razy mniej linii kodu to trzy razy mniejszy problem
    z jego utrzymaniem. Fakt ten ma jednak również i swoją
    ciemną stronę. Jest nią utrata interaktywności — wykonanie
    taktyki przeprowadza dowód od początku do końca.

    Znalezienie odpowiedniego balansu między automatyzacją i
    interaktywnością nie jest sprawą łatwą. Dowodząc twierdzenia
    twoim pierwszym i podstawowym celem powinno być zawsze jego
    zrozumienie, co oznacza dowód mniej lub bardziej interaktywny,
    nieautomatyczny. Gdy uda ci się już udowodnić i zrozumieć dane
    twierdzenie, możesz przejść do automatyzacji. Proces ten jest
    analogiczny jak w przypadku inżynierii oprogramowania — najpierw
    tworzy się działający prototyp, a potem się go usprawnia.

    Praktyka pokazuje jednak, że naszym ostatecznym
    celem powinna być pełna automatyzacja, tzn. sytuacja, w
    której dowód każdego twierdzenia (poza zupełnie banalnymi)
    będzie się sprowadzał, jak w powyższym przykładzie, do
    użycia jednej, specjalnie dla niego stworzonej taktyki.
    Ma to swoje uzasadnienie:
    - zrozumienie cudzych dowodów jest zazwyczaj dość trudne,
      co ma spore znaczenie w większych projektach, w których
      uczestniczy wiele osób, z których część odchodzi, a na
      ich miejsce przychodzą nowe
    - przebrnięcie przez dowód interaktywny, nawet jeżeli
      ma walory edukacyjne i jest oświecające, jest zazwyczaj
      czasochłonne, a czas to pieniądz
    - skoro zrozumienie dowodu jest trudne i czasochłonne,
      to będziemy chcieli unikać jego zmieniania, co może
      nastąpić np. gdy będziemy chcieli dodać do systemu
      jakąś funkcjonalność i udowodnić, że po jej dodaniu
      system wciąż działa poprawnie *)

(** **** Ćwiczenie (średnik) *)

(** Poniższe twierdzenia udowodnij najpierw z jak największym zrozumieniem,
    a następnie zautomatyzuj tak, aby całość była rozwiązywana w jednym
    kroku przez pojedynczą taktykę. *)

Lemma or_comm_ex :
  forall P Q : Prop, P \/ Q -> Q \/ P.
(* begin hide *)
Proof.
  intros; destruct H; [right | left]; assumption.
Qed.
(* end hide *)

Lemma diamond :
  forall P Q R S : Prop,
    (P -> Q) \/ (P -> R) -> (Q -> S) -> (R -> S) -> P -> S.
(* begin hide *)
Proof.
  intros. destruct H.
    apply H0. apply H. assumption.
    apply H1. apply H. assumption.
Restart.
  intros; destruct H; [apply H0 | apply H1]; apply H; assumption.
Qed.
(* end hide *)

(** ** [||] (alternatywa) *)

Lemma iff_intro''' :
  forall P Q : Prop,
    (P -> Q) -> (Q -> P) -> (P <-> Q).
Proof.
  split; intros; apply H0 || apply H; assumption.
Qed.

(** Innym przydatnym kombinatorem jest [||], który będziemy nazywać
    alternatywą. Żeby wyjaśnić jego działanie, posłużymy się pojęciem
    postępu. Taktyka dokonuje postępu, jeżeli wygenerowany przez nią
    cel różni się od poprzedniego celu. Innymi słowy, taktyka nie
    dokonuje postępu, jeżeli nie zmienia obecnego celu. Za pomocą
    [progress t] możemy sprawdzić, czy taktyka [t] dokona postępu
    na obecnym celu.

    Taktyka [t1 || t2] używa na obecnym celu [t1]. Jeżeli [t1] dokona
    postępu, to [t1 || t2] będzie miało taki efekt jak [t1] i skończy
    się sukcesem. Jeżeli [t1] nie dokona postępu, to na obecnym celu
    zostanie użyte [t2]. Jeżeli [t2] dokona postępu, to [t1 || t2]
    będzie miało taki efekt jak [t2] i skończy się sukcesem. Jeżeli
    [t2] nie dokona postępu, to [t1 || t2] zawiedzie i cel się nie
    zmieni.

    W naszym przypadku w każdym z podcelów wygenerowanych przez
    [split; intros] próbujemy zaaplikować najpierw [H0], a potem
    [H]. Na pierwszym podcelu [apply H0] zawiedzie (a więc nie
    dokona postępu), więc zostanie użyte [apply H], które zmieni
    cel. Wobec tego [apply H0 || apply H] na pierwszym podcelu
    będzie miało taki sam efekt, jak użycie [apply H]. W drugim
    podcelu [apply H0] skończy się sukcesem, więc tu [apply H0 ||
    apply H] będzie miało taki sam efekt, jak [apply H0]. *)

(** ** [idtac], [do] oraz [repeat] *)

Lemma idtac_do_example :
  forall P Q R S : Prop,
    P -> S \/ R \/ Q \/ P.
Proof.
  idtac. intros. do 3 right. assumption.
Qed.

(** [idtac] to taktyka identycznościowa, czyli taka, która nic
    nic robi. Sama w sobie nie jest zbyt użyteczna, ale przydaje
    się do czasem do tworzenia bardziej skomplikowanych taktyk.

    Kombinator [do] pozwala nam użyć danej taktyki określoną ilość
    razy. [do n t] na obecnym celu używa [t]. Jeżeli [t] zawiedzie,
    to [do n t] również zawiedzie. Jeżeli [t] skończy się sukcesem,
    to na każdym podcelu wygenerowanym przez [t] użyte zostanie
    [do (n - 1) t]. W szczególności [do 0 t] działa jak [idtac],
    czyli kończy się sukcesem nic nie robiąc.

    W naszym przypadku użycie taktyki [do 3 right] sprawi, że
    przy wyborze członu dysjunkcji, którego chcemy dowodzić,
    trzykrotnie pójdziemy w prawo. Zauważmy, że taktyka [do 4 right]
    zawiodłaby, gdyż po 3 użyciach [right] cel nie byłby już
    dysjunkcją, więc kolejne użycie [right] zawiodłoby, a wtedy
    cała taktyka [do 4 right] również zawiodłaby. *)

Lemma repeat_example :
  forall P A B C D E F : Prop,
    P -> A \/ B \/ C \/ D \/ E \/ F \/ P.
Proof.
  intros. repeat right. assumption.
Qed.

(** Kombinator [repeat] powtarza daną taktykę, aż ta rozwiąże cel,
    zawiedzie, lub nie zrobi postępu. Formalnie: [repeat t] używa
    na obecnym celu taktyki [t]. Jeżeli [t] rozwiąże cel, to
    [repeat t] kończy się sukcesem. Jeżeli [t] zawiedzie lub nie
    zrobi postępu, to [repeat t] również kończy się sukcesem.
    Jeżeli [t] zrobi jakiś postęp, to na każdym wygenerowaym przez
    nią celu zostanie użyte [repeat t].

    W naszym przypadku [repeat right] ma taki efekt, że przy wyborze
    członu dysjunkcji wybieramy człon będący najbardziej na prawo,
    tzn. dopóki cel jest dysjunkcją, aplikowana jest taktyka [right],
    która wybiera prawy człon. Kiedy nasz cel przestaje być dysjunkcją,
    taktyka [right] zawodzi i wtedy taktyka [repeat right] kończy swoje
    działanie sukcesem. *)

(** ** [try] i [fail] *)

Lemma iff_intro4 :
  forall P Q : Prop,
    (P -> Q) -> (Q -> P) -> (P <-> Q).
Proof.
  split; intros; try (apply H0; assumption; fail);
  try (apply H; assumption; fail).
Qed.

(** [try] jest kombinatorem, który zmienia zachowanie przekazanej mu
    taktyki. Jeżeli [t] zawiedzie, to [try t] zadziała jak [idtac],
    czyli nic nie zrobi i skończy się sukcesem. Jeżeli [t] skończy się
    sukcesem, to [try t] również skończy się sukcesem i będzie miało
    taki sam efekt, jak [t]. Tak więc, podobnie jak [repeat], [try]
    nigdy nie zawodzi.

    [fail] jest przeciwieństwem [idtac] — jest to taktyka, która zawsze
    zawodzi. Sama w sobie jest bezużyteczna, ale w tandemie z [try]
    oraz średnikiem daje nam pełną kontrolę nad tym, czy taktyka
    zakończy się sukcesem, czy zawiedzie, a także czy dokona postępu.

    Częstym sposobem użycia [try] i [fail] jest [try (t; fail)]. Taktyka
    ta na obecnym celu używa [t]. Jeżeli [t]
    rozwiąże cel, to [fail] nie zostanie wywołane i całe [try (t; fail)]
    zadziała tak jak [t], czyli rozwiąże cel. Jeżeli [t] nie rozwiąże celu,
    to na wygenerowanych podcelach wywoływane zostanie [fail], które
    zawiedzie — dzięki temu [t; fail] również zawiedzie, nie dokonując
    żadnych zmian w celu (nie dokona postępu), a całe [try (t; fail)]
    zakończy się sukcesem, również nie dokonując w celu żadnych zmian.
    Wobec tego działanie [try (t; fail)] można podsumować tak: "jeżeli [t]
    rozwiąże cel to użyj jej, a jeżeli nie, to nic nie rób".

    Postaraj się dokładnie zrozumieć, jak opis ten ma się do powyższego
    przykładu — spróbuj usunąć jakieś [try], [fail] lub średnik i zobacz,
    co się stanie.

    Oczywiście przykład ten jest bardzo sztuczny — najlepszym pomysłem
    udowodnienia tego twierdzenia jest użycie ogólnej postaci średnika
    [t; t1 | ... | tn], tak jak w przykładzie [iff_intro'']. Idiom
    [try (t; fail)] najlepiej sprawdza się, gdy użycie średnika w ten
    sposób jest niepraktyczne, czyli gdy celów jest dużo, a rozwiązać
    automatycznie potrafimy tylko część z nich. Możemy użyć go wtedy,
    żeby pozbyć się prostszych przypadków nie zaśmiecając sobie jednak
    kontekstu w pozostałych przypadkach. Idiom ten jest też dużo
    bardziej odporny na przyszłe zmiany w programie, gdyż użycie go
    nie wymaga wiedzy o tym, ile podcelów zostanie wygenerowanych.

    Przedstawione kombinatory są najbardziej użyteczne i stąd
    najpowszechniej używane. Nie są to jednak wszystkie kombinatory
    — jest ich znacznie więcej. Opisy taktyk i kombinatorów
    z biblioteki standardowej znajdziesz w
    #
    manualu#. *)

(** * Inne spójniki? (TODO) *)

(** ** Różnica między "lub" i "albo" *)

Definition xor (A B : Prop) : Prop :=
  (A /\ ~ B) \/ (~ A /\ B).

Lemma xor_irrefl :
  forall P : Prop, ~ xor P P.
(* begin hide *)
Proof.
  unfold xor. intros A H.
  destruct H as [[p np] | [np p]].
    apply np. assumption.
    apply np. assumption.
Qed.
(* end hide *)

Lemma xor_comm :
  forall P Q : Prop, xor P Q -> xor Q P.
(* begin hide *)
Proof.
  unfold xor. intros P Q H.
  destruct H as [[p nq] | [q np]].
    right. split; assumption.
    left. split; assumption.
Qed.
(* end hide *)

Lemma xor_comm' :
  forall P Q : Prop, xor P Q <-> xor Q P.
(* begin hide *)
Proof.
  split; apply xor_comm.
Qed.
(* end hide *)

Lemma xor_cotrans :
  (forall P : Prop, P \/ ~ P) ->
    (forall P Q R : Prop, xor P Q -> xor P R \/ xor Q R).
(* begin hide *)
Proof.
  unfold xor. intros LEM P Q R H.
  destruct H as [[p nq] | [q np]].
    destruct (LEM R) as [r | nr].
      right. right. split; assumption.
      left. left. split; assumption.
    destruct (LEM R) as [r | nr].
      left. right. split; assumption.
      right. left. split; assumption.
Qed.
(* end hide *)

Lemma Irrefutable_xor_cotrans :
  forall P Q R : Prop, ~ ~ (xor P Q -> xor P R \/ xor Q R).
(* begin hide *)
Proof. unfold xor; firstorder. Qed.
(* end hide *)

Lemma not_iff_xor :
  forall P Q : Prop, xor P Q -> ~ (P <-> Q).
(* begin hide *)
Proof.
  unfold xor, iff.
  intros P Q H1 H2.
  destruct H2 as [pq qp], H1 as [[p nq] | [np q]].
    apply nq, pq. assumption.
    apply np, qp. assumption.
Qed.
(* end hide *)

Lemma Irrefutable_xor_not_iff :
  forall P Q : Prop, ~ ~ (~ (P <-> Q) -> xor P Q).
(* begin hide *)
Proof. unfold xor; firstorder. Qed.
(* end hide *)

Lemma xor_spec :
  forall P Q : Prop, xor P Q <-> (P \/ Q) /\ (~ P \/ ~ Q).
(* begin hide *)
Proof.
  unfold xor, iff. split.
    intros [[p nq] | [np q]].
      split.
        left. assumption.
        right. assumption.
      split.
        right. assumption.
        left. assumption.
    intros [[p | q] [np | nq]].
      contradiction.
      left. split; assumption.
      right. split; assumption.
      contradiction.
Qed.
(* end hide *)

Lemma xor_False_r :
  forall P : Prop, xor P False <-> P.
(* begin hide *)
Proof.
  unfold xor, iff. split.
    intro H. destruct H as [[p _] | [_ f]].
      assumption.
      contradiction.
    intro p. left. split.
      assumption.
      intro f. contradiction.
Qed.
(* end hide *)

Lemma xor_False_l :
  forall P : Prop, xor False P <-> P.
(* begin hide *)
Proof.
  split.
    intro x. apply xor_comm in x. apply xor_False_r. assumption.
    intro p. unfold xor. right. split.
      intro f. contradiction.
      assumption.
Qed.
(* end hide *)

Lemma xor_True_l :
  forall P : Prop, xor True P <-> ~ P.
(* begin hide *)
Proof.
  unfold xor, iff. split.
    intros [[_ np] | [f _]].
      assumption.
      contradiction.
    intro np. left. split.
      trivial.
      assumption.
Qed.
(* end hide *)

Lemma xor_True_r :
  forall P : Prop, xor P True <-> ~ P.
(* begin hide *)
Proof.
  split.
    destruct 1 as [[p nt] | [np t]].
      contradiction.
      assumption.
    intro. right. split.
      assumption.
      trivial.
Qed.
(* end hide *)

Module xor_new.

Infix "`xor`" := xor (at level 85, right associativity).

Parameters P Q R : Prop.

(** ** [xor] *)

Lemma xor_True_l :
  True `xor` P <-> ~ P.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma xor_True_r :
  P `xor` True <-> ~ P.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma xor_False_l :
  False `xor` P <-> P.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma xor_False_r :
  P `xor` False <-> P.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma xor_True_l' :
  P -> P `xor` Q <-> ~ Q.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma xor_True_r' :
  Q -> P `xor` Q <-> ~ P.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma xor_False_l' :
  ~ P -> P `xor` Q <-> Q.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma xor_False_r' :
  ~ Q -> P `xor` Q <-> P.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma xor_irrefl :
  P `xor` P <-> False.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma xor_comm :
  P `xor` Q <-> Q `xor` P.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma Irrefutable_xor_assoc :
  ~ ~ (P `xor` (Q `xor` R) <-> (P `xor` Q) `xor` R).
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma or_xor :
  P `xor` Q -> P \/ Q.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma and_xor_l :
  (P `xor` Q) /\ R <-> (P /\ R) `xor` (Q /\ R).
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma and_xor_r :
  P /\ (Q `xor` R) <-> (P /\ Q) `xor` (P /\ R).
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma Irrefutable_not_xor_l :
  ~ ~ (~ (P `xor` Q) <-> ~ P `xor` Q).
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma Irrefutable_not_xor_r :
  ~ ~ (~ (P `xor` Q) <-> P `xor` ~ Q).
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma Irrefutable_xor_not :
  ~ ~ ((~ P) `xor` ~ Q -> P `xor` Q).
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma xor_not_conv :
  P `xor` Q -> ~ P `xor` ~ Q.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma xor_isolation :
  (P /\ ~ Q) `xor` (P /\ Q) -> P.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma Irrefutable_xor_isolation_conv :
  ~ ~ (P -> (P /\ ~ Q) `xor` (P /\ Q)).
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma Irrefutable_dd_and_xor :
  ~ ~ (P /\ (~ P `xor` Q) -> P /\ Q).
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma dd_and_xor_conv :
  P /\ Q -> P /\ (~ P `xor` Q).
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma dd_or_xor_r :
  P \/ (P `xor` Q) -> P \/ Q.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma Irrefutable_dd_or_xor_r_conv :
  ~ ~ (P \/ Q -> P \/ (P `xor` Q)).
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma dd_impl_xor_r :
  P -> (~ P `xor` Q) <-> P -> Q.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

Lemma dd_impl_xor_l :
  (P `xor` Q) -> Q <-> P -> Q.
(* begin hide *)
Proof. unfold xor; tauto. Qed.
(* end hide *)

End xor_new.

(** ** i/lub  *)

Definition andor (P Q : Prop) : Prop := P \/ Q \/ (P /\ Q).

Lemma and_or_l :
  forall P Q : Prop, P /\ Q -> P \/ Q.
(* begin hide *)
Proof.
  destruct 1 as [p q]. left. assumption.
Qed.
(* end hide *)

Lemma and_or_r :
  forall P Q : Prop, P /\ Q -> P \/ Q.
(* begin hide *)
Proof.
  destruct 1 as [p q]. right. assumption.
Qed.
(* end hide *)

Lemma andor_or :
  forall P Q : Prop, andor P Q <-> P \/ Q.
(* begin hide *)
Proof.
  unfold andor. intros P Q. split.
  - intros [p | [q | [p q]]].
    + left. assumption.
    + right. assumption.
    + left. assumption.
  - intros [p | q].
    + left. assumption.
    + right. left. assumption.
Qed.
(* end hide *)

(** *** i/lub po raz drugi *)

Definition andxor (P Q : Prop) : Prop := xor P (xor Q (P /\ Q)).

Lemma andxor_or :
  (forall P : Prop, P \/ ~ P) ->
    forall P Q : Prop, andxor P Q <-> P \/ Q.
(* begin hide *)
Proof.
  unfold andxor. intros lem P Q. split.
  - intros [[p _] | [_ [[q _] | H]]].
    + left. assumption.
    + right. assumption.
    + destruct H as (nq & _ & q). contradiction.
  - intros [p | q].
    + left. split.
      * assumption.
      * unfold xor. intros [[q npq] | (nq & _ & q)].
        -- apply npq. split; assumption.
        -- contradiction.
    + destruct (lem P) as [p | np].
      * left. split; [assumption |]. unfold xor. tauto.
      * right. split; [assumption |]. unfold xor. tauto.
Qed.
(* end hide *)

Lemma Irrefutable_andxor_or :
  forall P Q : Prop, ~ ~ (andxor P Q <-> P \/ Q).
(* begin hide *)
Proof. unfold andxor; firstorder. Qed.
(* end hide *)

(** ** Ani [P] ani [Q], czyli negacja dysjunkcji *)

Definition nor (P Q : Prop) : Prop := ~ (P \/ Q).

Lemma nor_comm :
  forall P Q : Prop,
    nor P Q <-> nor Q P.
(* begin hide *)
Proof.
  unfold nor. intros P Q. split.
  - intros f [q | p]; apply f; [right | left]; assumption.
  - intros f [p | q]; apply f; [right | left]; assumption.
Qed.
(* end hide *)

Lemma not_nor_assoc :
  exists P Q R : Prop,
    nor (nor P Q) R /\ ~ nor P (nor Q R).
(* begin hide *)
Proof.
  unfold nor. exists True, True, False. tauto.
Qed.
(* end hide *)

Lemma nor_True_l :
  forall P : Prop,
    nor True P <-> False.
(* begin hide *)
Proof.
  unfold nor.
  intros P. split.
  - intros f. apply f. left. trivial.
  - contradiction.
Qed.
(* end hide *)

Lemma nor_True_r :
  forall P : Prop,
    nor P True <-> False.
(* begin hide *)
Proof.
  unfold nor. intros P; split.
  - intros f. apply f. right. trivial.
  - contradiction.
Qed.
(* end hide *)

Lemma nor_False_l :
  forall P : Prop,
    nor False P <-> ~ P.
(* begin hide *)
Proof.
  unfold nor.
  split.
  - intros f p. apply f. right. assumption.
  - intros np [f | p]; contradiction.
Qed.
(* end hide *)

Lemma nor_False_r :
  forall P : Prop,
    nor P False <-> ~ P.
(* begin hide *)
Proof.
  unfold nor. intros P; split.
  - intros f p. apply f. left. assumption.
  - intros np [p | f]; contradiction.
Qed.
(* end hide *)

Lemma nor_antiidempotent :
  forall P : Prop,
    nor P P <-> ~ P.
(* begin hide *)
Proof.
  unfold nor. split.
  - intros f p. apply f. left. assumption.
  - intros f [p | p]; contradiction.
Qed.
(* end hide *)

(** W nieco innej wersji. *)

Definition nor' (P Q : Prop) : Prop := ~ P /\ ~ Q.

Lemma nor'_comm :
  forall P Q : Prop,
    nor' P Q <-> nor' Q P.
(* begin hide *)
Proof.
  unfold nor'.
  intros P Q. split.
  - intros [np nq]. split; assumption.
  - intros [nq np]. split; assumption.
Qed.
(* end hide *)

Lemma not_nor'_assoc :
  exists P Q R : Prop,
    nor' (nor' P Q) R /\ ~ nor' P (nor' Q R).
(* begin hide *)
Proof.
  unfold nor'. exists True, True, False. tauto.
Qed.
(* end hide *)

Lemma nor'_True_l :
  forall P : Prop,
    nor' True P <-> False.
(* begin hide *)
Proof.
  unfold nor'.
  intros P. split.
  - intros [? _]. contradiction.
  - contradiction.
Qed.
(* end hide *)

Lemma nor'_True_r :
  forall P : Prop,
    nor' P True <-> False.
(* begin hide *)
Proof.
  unfold nor'. intros P; split.
  - intros [_ ?]. contradiction.
  - contradiction.
Qed.
(* end hide *)

Lemma nor'_False_l :
  forall P : Prop,
    nor' False P <-> ~ P.
(* begin hide *)
Proof.
  unfold nor'. intros P. split.
  - intros [_ np]. assumption.
  - intros np. split.
    + intros e. contradiction.
    + assumption.
Qed.
(* end hide *)

Lemma nor'_False_r :
  forall P : Prop,
    nor' P False <-> ~ P.
(* begin hide *)
Proof.
  unfold nor'. intros P; split.
  - intros [np _]. assumption.
  - intros np. split.
    + assumption.
    + intros e. contradiction.
Qed.
(* end hide *)

Lemma nor'_antiidempotent :
  forall P : Prop,
    nor' P P <-> ~ P.
(* begin hide *)
Proof.
  unfold nor'. split.
  - intros [np _]. assumption.
  - intros np. split; assumption.
Qed.
(* end hide *)

(** Równoważność *)

Lemma nor_nor' :
  forall P Q : Prop, nor P Q <-> nor' P Q.
(* begin hide *)
Proof.
  unfold nor, nor'; split.
  - intros f. split.
    + intros p. apply f. left. assumption.
    + intros q. apply f. right. assumption.
  - intros [np nq] [p | q]; contradiction.
Qed.
(* end hide *)

(** ** [nand], czyli negacja koniunkcji *)

Definition nand (P Q : Prop) : Prop := ~ (P /\ Q).

Lemma nand_comm :
  forall P Q : Prop,
    nand P Q <-> nand Q P.
(* begin hide *)
Proof.
  unfold nand.
  intros P. split.
  - intros f [q p]. apply f; split; assumption.
  - intros f [p q]. apply f; split; assumption.
Qed.
(* end hide *)

Lemma not_nand_assoc :
  exists P Q R : Prop,
    nand (nand P Q) R /\ ~ nand P (nand Q R).
(* begin hide *)
Proof.
  unfold nand. exists True, True, False. tauto.
Qed.
(* end hide *)

Lemma nand_True_l :
  forall P : Prop,
    nand True P <-> ~ P.
(* begin hide *)
Proof.
  unfold nand.
  intros P. split.
  - intros f p. apply f. split; trivial.
  - intros np [_ p]. contradiction.
Qed.
(* end hide *)

Lemma nand_True_r :
  forall P : Prop,
    nand P True <-> ~ P.
(* begin hide *)
Proof.
  unfold nand; intros P; split.
  - intros f p. apply f. split; trivial.
  - intros np [p _]. contradiction.
Qed.
(* end hide *)

Lemma nand_False_l' :
  forall P : Prop,
    nand False P.
(* begin hide *)
Proof.
  unfold nand. intros P [[] _].
Qed.
(* end hide *)

Lemma nand_False_l :
  forall P : Prop,
    nand False P <-> True.
(* begin hide *)
Proof.
  split; intros.
  - trivial.
  - apply nand_False_l'.
Qed.
(* end hide *)

Lemma nand_False_r :
  forall P : Prop,
    nand P False <-> True.
(* begin hide *)
Proof.
  unfold nand; intros P; split.
  - intros _. trivial.
  - intros _ [p f]. contradiction.
Qed.
(* end hide *)

Lemma nand_antiidempotent :
  forall P : Prop,
    nand P P <-> ~ P.
(* begin hide *)
Proof.
  unfold nand. split.
  - intros f p. apply f. split; assumption.
  - intros np [p _]. contradiction.
Qed.
(* end hide *)

(** ** Antyimplikacja, czyli negacja implikacji *)

Definition nimpl (P Q : Prop) : Prop := ~ (P -> Q).

Lemma nimpl_False_l :
  forall P : Prop,
    ~ nimpl False P.
(* begin hide *)
Proof.
  unfold nimpl.
  intros P f. apply f. intros c. contradiction.
Qed.
(* end hide *)

Lemma nimpl_False_r:
  forall P : Prop,
    nimpl P False <-> ~ ~ P.
(* begin hide *)
Proof.
  unfold nimpl.
  intros P; split; intros; assumption.
Qed.
(* end hide *)

Lemma nimpl_True_l :
  forall P : Prop,
    nimpl True P <-> ~ P.
(* begin hide *)
Proof.
  unfold nimpl.
  intros P; split.
  - intros f p. apply f. intros _. assumption.
  - intros f p. apply f, p. trivial.
Qed.
(* end hide *)

Lemma nimpl_True_r :
  forall P : Prop,
    ~ nimpl P True.
(* begin hide *)
Proof.
  unfold nimpl.
  intros P f. apply f. intros _. trivial.
Qed.
(* end hide *)

Lemma nimpl_conv :
  forall P Q : Prop,
    nimpl (~ P) (~ Q) -> nimpl P Q.
(* begin hide *)
Proof.
  unfold nimpl.
  intros P Q f g.
  apply f. intros np q.
Abort.
(* end hide *)

Lemma nimpl_conv :
  forall P Q : Prop,
    nimpl P Q -> nimpl (~ Q) (~ P).
(* begin hide *)
Proof.
  unfold nimpl.
  intros P Q f g.
  apply f. intros p.
Abort.
(* end hide *)

(** **** Ćwiczenie (conditioned disjunction) *)

(** #
    Wikipedia# podaje poniższą definicję pewnego dziwnego spójnika: *)

Definition conditioned_disjunction (P Q R : Prop) : Prop :=
  (Q -> P) /\ (~ Q -> R).

(** Wyraź za jego pomocą wszystkie podstawowe spójniki, tj. implikację, dysjunkcję,
    koniunkcje i negację.

    Udowodnij też garść twierdzeń mówiących, co się stanie, gdy za [P], [Q] lub [R]
    wstawić [True] lub [False]. *)

(* begin hide *)
(* TODO: tu rozwiązania zadań o [conditioned_disjunction] *)
(* end hide *)

(** * Inne kwantyfikatory? (TODO) *)

(** Poznaliśmy jak dotąd trzy kwantyfikatory: uniwersalny ([forall]), egzystencjalny
    ([exists]) oraz unikalny, który był zdefiniowany za pomocą dwóch poprzednich
    oraz relacji równości ([=]).

    Skoro mogliśmy zdefiniować nowy kwantyfikator ze starych, to należy zadać
    sobie pytanie: czy istnieją jeszcze jakieś inne kwantyfikatory? I czy są
    one ciekawe?

    Odpowiedź na pierwsze pytanie brzmi: tak, i to nieskończenie wiele. Na drugie
    zaś: większość z nich nie jest zbyt ciekawa. Nie na tyle, żeby o nich tutaj
    wspominać. *)

(** ** Kwantyfikator unikatowy *)

Definition unique {A : Type} (P : A -> Prop) : Prop :=
  exists x : A, P x /\ forall y : A, P y -> x = y.

(** Poznawszy relację równości oraz kwantyfikatory uniwersalny i
    egzystencjalny, możemy zdefiniować inny bardzo ważny "kwantyfikator",
    a mianowicie kwantyfikator unikatowy, który głosi, że istnieje
    dokładnie jeden obiekt spełniający daną właściwość. *)

(** ** Kwantyfikator [xor]owy *)

(** Zauważmy, że kwantyfikator egzystencjalny jest podobny do "nieskończonej"
    dysjunkcji: [exists x : A, P x] znaczyłoby to samo, co [P x_0 \/ P x_1 \/ ...],
    gdyby rzecz jasna dało się takie nieskończenie długaśne zdanie zapisać. Ale
    się nie da - i dlatego właśnie mamy kwantyfikator egzystencjalny.

    W poprzednim podrozdziale poznaliśmy spójnik [xor], który możemy interpretować
    jako polskie "albo". [xor P Q] znaczy "albo zachodzi P (i nie zachodzi Q, albo
    zachodzi Q (i nie zachodzi P)", a zatem [xor] to wariant zwykłej dysjunkcji [\/],
    który jednak wyklucza możliwość zajścia więcej niż jednego ze swoich członów.

    Nieco sztucznym, acz potencjalnie ciekawym, kwantyfikatorem może być
    "kwantyfikator xorowy", który działa jak nieskończony [xor] - ma się
    on do [xor]a tak, jak kwantyfikator egzystencjalny do dysjunkcji. Zdefiniuj
    ten kwantyfikator, a następnie sprawdź, czy ma jakieś ciekawe właściwości. *)

(* begin hide *)
Definition qxor {A : Type} (P : A -> Prop) : Prop :=
  exists x : A, P x /\ forall y : A, x <> y -> ~ P y.
(* end hide *)

Lemma ex_qxor :
  forall {A : Type} (P : A -> Prop),
    qxor P -> ex P.
(* begin hide *)
Proof.
  intros A P (x & p & _).
  exists x. assumption.
Qed.
(* end hide *)

Lemma qxor_True_two_elems :
  forall {A : Type} {x y : A},
    x <> y -> ~ qxor (fun _ : A => True).
(* begin hide *)
Proof.
  intros A x y Hneq (z & _ & H).
  apply (H x).
  - intros ->. apply (H y); trivial.
  - trivial.
Qed.
(* end hide *)

Lemma qxor_False :
  forall A : Type,
    ~ qxor (fun _ : A => False).
(* begin hide *)
Proof.
  intros A (z & e & _).
  assumption.
Qed.
(* end hide *)

(** * Logika pierwszego rzędu a logika wyższego rzędu (TODO) *)

(** ** Logika pierwszego rzędu *)

(** ** Logika drugiego rzędu *)

(** ** Logika wyższego rzędu *)

(** * Paradoksy autoreferencji *)

(** ** Paradoks Curry'ego *)

Lemma Curry's_paradox :
  forall P Q : Prop,
    (P <-> (P -> Q)) -> Q.
Proof.
  destruct 1.
  apply H.
    apply H0. intro. apply H; assumption.
    apply H0. intro. apply H; assumption.
Qed.

(** **** Ćwiczenie *)

(** TODO: napisać polecenie *)

(* begin hide *)
Lemma mutual_reference :
  forall P Q : Prop,
    (P <-> (Q <-> True)) ->
    (Q <-> (P <-> False)) ->
      False.
Proof.
  firstorder.
Qed.
(* end hide *)

(** ** Paradoks golibrody *)

(** Języki naturalne, jakimi ludzie posługują się w życiu codziennym
    (polski, angielski suahili, język indian Navajo) zawierają spory
    zestaw spójników oraz kwantyfikatorów ("i", "a", "oraz", "lub",
    "albo", "jeżeli ... to", "pod warunkiem, że ", "wtedy", i wiele
    innych).

    Należy z całą stanowczością zaznaczyć, że te spójniki i kwantyfikatory,
    a w szczególności ich intuicyjna interpretacja, znacznie różnią się
    od analogicznych spójników i kwantyfikatorów logicznych, które mieliśmy
    okazję poznać w tym rozdziale. Żeby to sobie uświadomić, zapoznamy się
    z pewnego rodzaju "paradoksem". *)

Lemma barbers_paradox :
  forall (man : Type) (barber : man)
    (shaves : man -> man -> Prop),
      (forall x : man, shaves barber x <-> ~ shaves x x) -> False.
(* begin hide *)
Proof.
  intros. destruct (H barber). apply H0.
    apply H1. intro. apply H0; assumption.
    apply H1. intro. apply H0; assumption.
Qed.
(* end hide *)

(** Twierdzenie to formułowane jest zazwyczaj tak: nie istnieje człowiek,
    który goli wszystkich tych (i tylko tych), którzy sami siebie nie golą.

    Ale cóż takiego znaczy to przedziwne zdanie? Czy matematyka dają nam
    magiczną, aprioryczną wiedzę o fryzjerach?

    Odczytajmy je poetycko. Wyobraźmy sobie pewne miasteczko. Typ [man]
    będzie reprezentował jego mieszkańców. Niech term [barber] typu [man]
    oznacza hipotetycznego golibrodę. Hipotetycznego, gdyż samo użycie
    jakiejś nazwy nie powoduje automatycznie, że nazywany obiekt istnieje
    (przykładów jest masa, np. jednorożce, sprawiedliwość społeczna).

    Mamy też relację [shaves]. Będziemy ją interpretować w ten sposób, że
    [shaves a b] zachodzi, gdy [a] goli brodę [b]. Nasza hipoteza
    [forall x : man, shaves barber x <-> ~ shaves x x] jest zawoalowanym
    sposobem podania następującej definicji: golibrodą nazwiemy te osoby,
    który golą wszystkie te i tylko te osoby, które same siebie nie golą.

    Póki co sytuacja rozwija się w całkiem niekontrowersyjny sposób. Żeby
    zburzyć tę sielankę, możemy zadać sobie następujące pytanie: czy
    golibroda rzeczywiście istnieje? Dziwne to pytanie, gdy na każdym
    rogu ulicy można spotkać fryzjera, ale nie dajmy się zwieść.

    W myśl rzymskich sentencji "quis custodiet ipsos custodes?" ("kto będzie
    pilnował strażników?") oraz "medice, cure te ipsum!" ("lekarzu, wylecz
    sam siebie!") możemy zadać dużo bardziej konkretne pytanie: kto goli
    brody golibrody? A idąc jeszcze krok dalej: czy golibroda goli sam siebie?

    Rozstrzygnięcie jest banalne i wynika wprost z definicji: jeśli golibroda
    ([barber]) to ten, kto goli ([shaves barber x]) wszystkich tych i tylko
    tych ([forall x : man]), którzy sami siebie nie golą ([~ shaves x x]), to
    podstawiając [barber] za [x] otrzymujemy sprzeczność: [shaves barber
    barber] zachodzi wtedy i tylko wtedy, gdy [~ shaves barber barber].

    Tak więc golibroda, zupełnie jak Święty Mikołaj, nie istnieje. Zdanie to
    nie ma jednak wiele wspólnego ze światem rzeczywistym: wynika ono jedynie
    z takiej a nie innej, przyjętej przez nas całkowicie arbitralnie definicji
    słowa "golibroda". Można to łatwo zobrazować, przeformułowywując powyższe
    twierdzenie z użyciem innych nazw: *)

Lemma barbers_paradox' :
  forall (A : Type) (x : A) (P : A -> A -> Prop),
    (forall y : A, P x y <-> ~ P y y) -> False.
(* begin hide *)
Proof.
  intros. destruct (H x). apply H0.
    apply H1. intro. apply H0; assumption.
    apply H1. intro. apply H0; assumption.
Qed.
(* end hide *)

(** Nieistnienie "golibrody" i pokrewny mu paradoks pytania "czy golibroda
    goli sam siebie?" jest konsekwencją wyłącznie formy powyższego zdania
    logicznego i nie mówi nic o rzeczywistoświatych golibrodach.

    Paradoksalność całego "paradoksu" bierze się z tego, że typom, zmiennym
    i relacjom specjalnie nadano takie nazwy, żeby zwykły człowiek bez
    głębszych dywagacji nad definicją słowa "golibroda" przjął, że golibroda
    istnieje. Robiąc tak, wpada w sidła pułapki zastawionej przez logika i
    zostaje trafiony paradoksalną konkluzją: golibroda nie istnieje. *)

(** ** Inne paradoksy autoreferencji *)

(** **** Ćwiczenie *)

(** Poniższą zagadkę pozwolę sobie wesoło nazwać "paradoks hetero". Zagadka
    brzmi tak:

    Niektóre słowa opisują same siebie, np. słowo "krótki" jest krótkie,
    a niektóre inne nie, np. słowo "długi" nie jest długie. Podobnie słowo
    "polski" jest słowem polskim, ale słowo "niemiecki" nie jest słowem
    niemieckim. Słowa, które nie opisują samych siebie będziemy nazywać
    słowami heterologicznymi. Pytanie: czy słowo "heterologiczny" jest
    heterologiczne? *)

(** **** Ćwiczenie *)

(** TODO:
    - paradoks Richarda
    - Hilbert-Bernays: https://en.wikipedia.org/wiki/Hilbert-Bernays_paradox
    - Barbershop: https://en.wikipedia.org/wiki/Barbershop_paradox
    - paradoks kłamcy *)

(** **** Ćwiczenie *)

(** A jak jest z poniższym paradoksem wujka Janusza?

    Wujek Janusz lubi tych (i tylko tych) członków rodziny, którzy sami
    siebie nie lubią oraz nie lubi tych (i tylko tych), którzy sami siebie
    lubią. Czy wujek Janusz lubi sam siebie? *)

(** **** Ćwiczenie *)

(** Powyższe ćwiczenie miało być ostatnim, ale co tam, dam jeszcze trochę.
    Co czuje serce twoje (ewentualnie: co widzisz przed oczyma duszy swojej)
    na widok poniższych wesołych zdań?

    "To zdanie jest fałszywe."

    "Zdanie po prawej jest fałszywe. Zdanie po lewej jest prawdziwe."

    "Zdanie po prawej jest prawdziwe. Zdanie po lewej jest fałszywe."
*)

(** * Predykatywizm i kodowania impredykatywne (TODO) *)

(* begin hide *)
(* TODO: Tautologie na kodowaniach impredykatywnych jako ćwiczenia z funkcji anonimowych *)
(* end hide *)

Definition iand (P Q : Prop) : Prop :=
  forall C : Prop, (P -> Q -> C) -> C.

Definition ior (P Q : Prop) : Prop :=
  forall C : Prop, (P -> C) -> (Q -> C) -> C.

Definition iTrue : Prop :=
  forall C : Prop, C -> C.

Definition iFalse : Prop :=
  forall C : Prop, C.

Lemma iand_spec :
  forall P Q : Prop,
    iand P Q <-> P /\ Q.
(* begin hide *)
Proof.
  unfold iand. split.
    intro H. apply H. intros p q. split.
      assumption.
      assumption.
    intros [p q] C H. apply H.
      assumption.
      assumption.
Qed.
(* end hide *)

Lemma ior_spec :
  forall P Q : Prop,
    ior P Q <-> P \/ Q.
(* begin hide *)
Proof.
  unfold ior. split.
    intro H. apply H.
      intro p. left. assumption.
      intro q. right. assumption.
    intros [p | q] C pc qc.
      apply pc. assumption.
      apply qc. assumption.
Qed.
(* end hide *)

Lemma iTrue_spec :
  iTrue <-> True.
(* begin hide *)
Proof.
  unfold iTrue. split.
    intros _. trivial.
    intros _ C c. assumption.
Qed.
(* end hide *)

Lemma iFalse_False :
  iFalse <-> False.
(* begin hide *)
Proof.
  unfold iFalse. split.
    intro H. apply H.
    contradiction.
Qed.
(* end hide *)

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

Lemma iexists_spec :
  forall (A : Type) (P : A -> Prop),
    iexists A P <-> exists x : A, P x.
(* begin hide *)
Proof.
  unfold iexists. split.
    intro H. apply H. intros x p. exists x. assumption.
    intros [x p] C H. apply (H x). assumption.
Qed.
(* end hide *)

Definition ieq {A : Type} (x y : A) : Prop :=
  forall C : Prop, ((x = y) -> C) -> C.

Definition ieq' {A : Type} (x : A) : A -> Prop :=
  fun y : A =>
    forall P : A -> Prop, P x -> P y.

Lemma ieq_spec :
  forall (A : Type) (x y : A),
    ieq x y <-> x = y.
(* begin hide *)
Proof.
  unfold ieq. split.
    intro H. apply H. trivial.
    intros [] C H. apply H. reflexivity.
Qed.
(* end hide *)

Lemma ieq'_spec :
  forall (A : Type) (x y : A),
    ieq' x y <-> x = y.
(* begin hide *)
Proof.
  unfold ieq'. split.
    intro H. apply H. reflexivity.
    intros [] P px. assumption.
Qed.
(* end hide *)

(** * Spójniki pozytywne i negatywne (TODO) *)

(** TODO:
  - implikacja jest negatywna
  - koniunkcja jest negatywna
  - dysjunkcja jest pozytywna
  - fałsz jest pozytywny
  - prawda jest negatywna
  - słaba negacja jest negatywna
  - silna negacja jest pozytywna
  - równoważność jest negatywna
*)

(** * Esencjalizm vs strukturalizm (TODO) *)

(** * Harmonia logiki konstruktywnej i prawo zachowania informacji (TODO) *)

(** * Logika intuicjonistyczna jako logika certyfikatów (TODO) *)

(** * Aksjomaty i pojęcie "tabu" (TODO) *)

(** * Klasyfikacja zdań (TODO) *)

(** Tutaj drobna klasyfikacja na coś w stylu:
    - zdania prawdziwe ([P] zachodzi)
    - zdania fałszywe ([~ P] zachodzi)
    - zdania niezaprzeczalne ([~ ~ P] zachodzi)
    - zdania kontyngentne ([P] jest fałszywym zdaniem postaci
      [forall x : A, Q x] i zachodzi [exists x : A, Q x]. Inne
      podejście: tylko w kontekście, w którym zdanie [P] składa
      się z nieznanych części, np. [P -> Q] jest kontyngentne,
      bo [P -> P] zachodzi, zaś [True -> False] nie zachodzi.
    - zdania klasycznie prawdziwe ([P] zachodzi w logice klasycznej)
    - zdania tabu ([P] implikuje jakieś inne tabu, np. [LEM])

    TODO: być może dać to do podrozdziału o [WLEM] *)


(** * ImpParser: Lexing and Parsing in Coq *)

(** The development of the Imp language in [Imp.v] completely ignores
    issues of concrete syntax -- how an ascii string that a programmer
    might write gets translated into abstract syntax trees defined by
    the datatypes [aexp], [bexp], and [com].  In this chapter, we
    illustrate how the rest of the story can be filled in by building
    a simple lexical analyzer and parser using Coq's functional
    programming facilities.

    It is not important to understand all the details here (and
    accordingly, the explanations are fairly terse and there are no
    exercises).  The main point is simply to demonstrate that it can
    be done.  You are invited to look through the code -- most of it
    is not very complicated, though the parser relies on some
    "monadic" programming idioms that may require a little work to
    make out -- but most readers will probably want to just skim down
    to the Examples section at the very end to get the punchline. *)

Set Warnings "-notation-overridden,-parsing,-deprecated-implicit-arguments".
Require Import Coq.Strings.String.
Require Import Coq.Strings.Ascii.
Require Import Coq.Arith.Arith.
Require Import Coq.Arith.EqNat.
Require Import Coq.Lists.List.
Import ListNotations.
Require Import Maps Imp.

(* ################################################################# *)
(** * Internals *)

(* ================================================================= *)
(** ** Lexical Analysis *)

Definition isWhite (c : ascii) : bool :=
  let n := nat_of_ascii c in
  orb (orb (beq_nat n 32)   (* space *)
           (beq_nat n 9))   (* tab *)
      (orb (beq_nat n 10)   (* linefeed *)
           (beq_nat n 13)). (* Carriage return. *)

Notation "x '<=?' y" := (leb x y)
  (at level 70, no associativity) : nat_scope.

Definition isLowerAlpha (c : ascii) : bool :=
  let n := nat_of_ascii c in
    andb (97 <=? n) (n <=? 122).

Definition isAlpha (c : ascii) : bool :=
  let n := nat_of_ascii c in
    orb (andb (65 <=? n) (n <=? 90))
        (andb (97 <=? n) (n <=? 122)).

Definition isDigit (c : ascii) : bool :=
  let n := nat_of_ascii c in
     andb (48 <=? n) (n <=? 57).

Inductive chartype := white | alpha | digit | other.

Definition classifyChar (c : ascii) : chartype :=
  if isWhite c then
    white
  else if isAlpha c then
    alpha
  else if isDigit c then
    digit
  else
    other.

Fixpoint list_of_string (s : string) : list ascii :=
  match s with
  | EmptyString => []
  | String c s => c :: (list_of_string s)
  end.

Fixpoint string_of_list (xs : list ascii) : string :=
  fold_right String EmptyString xs.

Definition token := string.

Fixpoint tokenize_helper (cls : chartype) (acc xs : list ascii)
                       : list (list ascii) :=
  let tk := match acc with [] => [] | _::_ => [rev acc] end in
  match xs with
  | [] => tk
  | (x::xs') =>
    match cls, classifyChar x, x with
    | _, _, "("      =>
      tk ++ ["("]::(tokenize_helper other [] xs')
    | _, _, ")"      =>
      tk ++ [")"]::(tokenize_helper other [] xs')
    | _, white, _    =>
      tk ++ (tokenize_helper white [] xs')
    | alpha,alpha,x  =>
      tokenize_helper alpha (x::acc) xs'
    | digit,digit,x  =>
      tokenize_helper digit (x::acc) xs'
    | other,other,x  =>
      tokenize_helper other (x::acc) xs'
    | _,tp,x         =>
      tk ++ (tokenize_helper tp [x] xs')
    end
  end %char.

Definition tokenize (s : string) : list string :=
  map string_of_list (tokenize_helper white [] (list_of_string s)).

Example tokenize_ex1 :
    tokenize "abc12==3  223*(3+(a+c))" %string
  = ["abc"; "12"; "=="; "3"; "223";
       "*"; "("; "3"; "+"; "(";
       "a"; "+"; "c"; ")"; ")"]%string.
Proof. reflexivity. Qed.

(* ================================================================= *)
(** ** Parsing *)

(* ----------------------------------------------------------------- *)
(** *** Options With Errors *)

(** An [option] type with error messages: *)

Inductive optionE (X:Type) : Type :=
  | SomeE : X -> optionE X
  | NoneE : string -> optionE X.

Implicit Arguments SomeE [[X]].
Implicit Arguments NoneE [[X]].

(** Some syntactic sugar to make writing nested match-expressions on
    optionE more convenient. *)

Notation "'DO' ( x , y ) <== e1 ; e2"
   := (match e1 with
         | SomeE (x,y) => e2
         | NoneE err => NoneE err
       end)
   (right associativity, at level 60).

Notation "'DO' ( x , y ) <-- e1 ; e2 'OR' e3"
   := (match e1 with
         | SomeE (x,y) => e2
         | NoneE err => e3
       end)
   (right associativity, at level 60, e2 at next level).

(* ----------------------------------------------------------------- *)
(** *** Generic Combinators for Building Parsers *)

Open Scope string_scope.

Definition parser (T : Type) :=
  list token -> optionE (T * list token).

Fixpoint many_helper {T} (p : parser T) acc steps xs :=
  match steps, p xs with
  | 0, _ =>
      NoneE "Too many recursive calls"
  | _, NoneE _ =>
      SomeE ((rev acc), xs)
  | S steps', SomeE (t, xs') =>
      many_helper p (t::acc) steps' xs'
  end.

(** A (step-indexed) parser that expects zero or more [p]s: *)

Fixpoint many {T} (p : parser T) (steps : nat) : parser (list T) :=
  many_helper p [] steps.

(** A parser that expects a given token, followed by [p]: *)

Definition firstExpect {T} (t : token) (p : parser T)
                     : parser T :=
  fun xs => match xs with
            | x::xs' =>
              if string_dec x t
              then p xs'
              else NoneE ("expected '" ++ t ++ "'.")
            | [] =>
              NoneE ("expected '" ++ t ++ "'.")
            end.

(** A parser that expects a particular token: *)

Definition expect (t : token) : parser unit :=
  firstExpect t (fun xs => SomeE(tt, xs)).

(* ----------------------------------------------------------------- *)
(** *** A Recursive-Descent Parser for Imp *)

(** Identifiers: *)

Definition parseIdentifier (xs : list token)
                         : optionE (id * list token) :=
match xs with
| [] => NoneE "Expected identifier"
| x::xs' =>
    if forallb isLowerAlpha (list_of_string x) then
      SomeE (Id x, xs')
    else
      NoneE ("Illegal identifier:'" ++ x ++ "'")
end.

(** Numbers: *)

Definition parseNumber (xs : list token)
                     : optionE (nat * list token) :=
match xs with
| [] => NoneE "Expected number"
| x::xs' =>
    if forallb isDigit (list_of_string x) then
      SomeE (fold_left
               (fun n d =>
                  10 * n + (nat_of_ascii d -
                            nat_of_ascii "0"%char))
               (list_of_string x)
               0,
             xs')
    else
      NoneE "Expected number"
end.

(** Parse arithmetic expressions *)

Fixpoint parsePrimaryExp (steps:nat)
                         (xs : list token)
                       : optionE (aexp * list token) :=
  match steps with
  | 0 => NoneE "Too many recursive calls"
  | S steps' =>
      DO (i, rest) <-- parseIdentifier xs ;
          SomeE (AId i, rest)
      OR DO (n, rest) <-- parseNumber xs ;
          SomeE (ANum n, rest)
                OR (DO (e, rest) <== firstExpect "("
                       (parseSumExp steps') xs;
          DO (u, rest') <== expect ")" rest ;
          SomeE(e,rest'))
  end

with parseProductExp (steps:nat)
                     (xs : list token) :=
  match steps with
  | 0 => NoneE "Too many recursive calls"
  | S steps' =>
    DO (e, rest) <==
      parsePrimaryExp steps' xs ;
    DO (es, rest') <==
       many (firstExpect "*" (parsePrimaryExp steps'))
            steps' rest;
    SomeE (fold_left AMult es e, rest')
  end

with parseSumExp (steps:nat) (xs : list token)  :=
  match steps with
  | 0 => NoneE "Too many recursive calls"
  | S steps' =>
    DO (e, rest) <==
      parseProductExp steps' xs ;
    DO (es, rest') <==
      many (fun xs =>
        DO (e,rest') <--
           firstExpect "+"
             (parseProductExp steps') xs;
           SomeE ( (true, e), rest')
        OR DO (e,rest') <==
        firstExpect "-"
           (parseProductExp steps') xs;
            SomeE ( (false, e), rest'))
        steps' rest;
      SomeE (fold_left (fun e0 term =>
                          match term with
                            (true,  e) => APlus e0 e
                          | (false, e) => AMinus e0 e
                          end)
                       es e,
             rest')
  end.

Definition parseAExp := parseSumExp.

(** Parsing boolean expressions: *)

Fixpoint parseAtomicExp (steps:nat)
                        (xs : list token)  :=
match steps with
  | 0 => NoneE "Too many recursive calls"
  | S steps' =>
     DO    (u,rest) <-- expect "true" xs;
         SomeE (BTrue,rest)
     OR DO (u,rest) <-- expect "false" xs;
         SomeE (BFalse,rest)
     OR DO (e,rest) <--
            firstExpect "not"
               (parseAtomicExp steps')
               xs;
         SomeE (BNot e, rest)
     OR DO (e,rest) <--
              firstExpect "("
                (parseConjunctionExp steps') xs;
          (DO (u,rest') <== expect ")" rest;
              SomeE (e, rest'))
     OR DO (e, rest) <== parseProductExp steps' xs;
            (DO (e', rest') <--
              firstExpect "=="
                (parseAExp steps') rest;
              SomeE (BEq e e', rest')
             OR DO (e', rest') <--
               firstExpect "<="
                 (parseAExp steps') rest;
               SomeE (BLe e e', rest')
             OR
               NoneE
      "Expected '==' or '<=' after arithmetic expression")
end

with parseConjunctionExp (steps:nat)
                         (xs : list token) :=
  match steps with
  | 0 => NoneE "Too many recursive calls"
  | S steps' =>
    DO (e, rest) <==
      parseAtomicExp steps' xs ;
    DO (es, rest') <==
       many (firstExpect "&&"
               (parseAtomicExp steps'))
            steps' rest;
    SomeE (fold_left BAnd es e, rest')
  end.

Definition parseBExp := parseConjunctionExp.

Check parseConjunctionExp.

Definition testParsing {X : Type}
           (p : nat ->
                list token ->
                optionE (X * list token))
           (s : string) :=
  let t := tokenize s in
  p 100 t.

(*
Eval compute in
  testParsing parseProductExp "x*y*(x*x)*x".

Eval compute in
  testParsing parseConjunctionExp "not((x==x||x*x<=(x*x)*x)&&x==x".
*)

(** Parsing commands: *)

Fixpoint parseSimpleCommand (steps:nat)
                            (xs : list token) :=
  match steps with
  | 0 => NoneE "Too many recursive calls"
  | S steps' =>
    DO (u, rest) <-- expect "SKIP" xs;
      SomeE (SKIP, rest)
    OR DO (e,rest) <--
         firstExpect "IF" (parseBExp steps') xs;
       DO (c,rest')  <==
         firstExpect "THEN"
           (parseSequencedCommand steps') rest;
       DO (c',rest'') <==
         firstExpect "ELSE"
           (parseSequencedCommand steps') rest';
       DO (u,rest''') <==
         expect "END" rest'';
       SomeE(IFB e THEN c ELSE c' FI, rest''')
    OR DO (e,rest) <--
         firstExpect "WHILE"
           (parseBExp steps') xs;
       DO (c,rest') <==
         firstExpect "DO"
           (parseSequencedCommand steps') rest;
       DO (u,rest'') <==
         expect "END" rest';
       SomeE(WHILE e DO c END, rest'')
    OR DO (i, rest) <==
         parseIdentifier xs;
       DO (e, rest') <==
         firstExpect ":=" (parseAExp steps') rest;
       SomeE(i ::= e, rest')
  end

with parseSequencedCommand (steps:nat)
                           (xs : list token) :=
  match steps with
  | 0 => NoneE "Too many recursive calls"
  | S steps' =>
      DO (c, rest) <==
        parseSimpleCommand steps' xs;
      DO (c', rest') <--
        firstExpect ";;"
          (parseSequencedCommand steps') rest;
        SomeE(c ;; c', rest')
      OR
        SomeE(c, rest)
  end.

Definition bignumber := 1000.

Definition parse (str : string) : optionE (com * list token) :=
  let tokens := tokenize str in
  parseSequencedCommand bignumber tokens.

(* ################################################################# *)
(** * Examples *)

(*
Compute parse "
  IF x == y + 1 + 2 - y * 6 + 3 THEN
    x := x * 1;;
    y := 0
  ELSE
    SKIP
  END  ".
====>
  SomeE
     (IFB BEq (AId (Id 0))
              (APlus
                 (AMinus (APlus (APlus (AId (Id 1)) (ANum 1)) (ANum 2))
                    (AMult (AId (Id 1)) (ANum 6)))
                 (ANum 3))
      THEN Id 0 ::= AMult (AId (Id 0)) (ANum 1);; Id 1 ::= ANum 0
      ELSE SKIP FI, [])
*)

(*
Compute parse "
  SKIP;;
  z:=x*y*(x*x);;
  WHILE x==x DO
    IF z <= z*z && not x == 2 THEN
      x := z;;
      y := z
    ELSE
      SKIP
    END;;
    SKIP
  END;;
  x:=z  ".
====>
  SomeE
     (SKIP;;
      Id 0 ::= AMult (AMult (AId (Id 1)) (AId (Id 2)))
                     (AMult (AId (Id 1)) (AId (Id 1)));;
      WHILE BEq (AId (Id 1)) (AId (Id 1)) DO
        IFB BAnd (BLe (AId (Id 0)) (AMult (AId (Id 0)) (AId (Id 0))))
                  (BNot (BEq (AId (Id 1)) (ANum 2)))
           THEN Id 1 ::= AId (Id 0);; Id 2 ::= AId (Id 0)
           ELSE SKIP FI;;
        SKIP
      END;;
      Id 1 ::= AId (Id 0),
     [])
*)

(*
Compute parse "
  SKIP;;
  z:=x*y*(x*x);;
  WHILE x==x DO
    IF z <= z*z && not x == 2 THEN
      x := z;;
      y := z
    ELSE
      SKIP
    END;;
    SKIP
  END;;
  x:=z  ".
=====>
  SomeE
     (SKIP;;
      Id 0 ::= AMult (AMult (AId (Id 1)) (AId (Id 2)))
            (AMult (AId (Id 1)) (AId (Id 1)));;
      WHILE BEq (AId (Id 1)) (AId (Id 1)) DO
        IFB BAnd (BLe (AId (Id 0)) (AMult (AId (Id 0)) (AId (Id 0))))
                 (BNot (BEq (AId (Id 1)) (ANum 2)))
          THEN Id 1 ::= AId (Id 0);;
               Id 2 ::= AId (Id 0)
          ELSE SKIP
        FI;;
        SKIP
      END;;
      Id 1 ::= AId (Id 0),
     []).
*)

(** $Date: 2017-09-06 10:45:52 -0400 (Wed, 06 Sep 2017) $ *)


(** * Extraction: Extracting ML from Coq *)

(** * Basic Extraction *)

(** In its simplest form, extracting an efficient program from one
    written in Coq is completely straightforward.

    First we say what language we want to extract into.  Options are
    OCaml (the most mature), Haskell (which mostly works), and
    Scheme (a bit out of date). *)

Extraction Language Ocaml.

(** Now we load up the Coq environment with some definitions, either
    directly or by importing them from other modules. *)

Require Import Coq.Arith.Arith.
Require Import Coq.Arith.EqNat.
Require Import SfLib.
Require Import ImpCEvalFun.

(** Finally, we tell Coq the name of a definition to extract and the
    name of a file to put the extracted code into. *)

Extraction "imp1.ml" ceval_step.

(** When Coq processes this command, it generates a file [imp1.ml]
    containing an extracted version of [ceval_step], together with
    everything that it recursively depends on.  Compile the present
    [.v] file and have a look at [imp1.ml] now. *)

(* ############################################################## *)
(** * Controlling Extraction of Specific Types *)

(** We can tell Coq to extract certain [Inductive] definitions to
    specific OCaml types.  For each one, we must say
      - how the Coq type itself should be represented in OCaml, and
      - how each constructor should be translated. *)

Extract Inductive bool => "bool" [ "true" "false" ].

(** Also, for non-enumeration types (where the constructors take
    arguments), we give an OCaml expression that can be used as a
    "recursor" over elements of the type.  (Think Church numerals.) *)

Extract Inductive nat => "int"
  [ "0" "(fun x -> x + 1)" ]
  "(fun zero succ n ->
      if n=0 then zero () else succ (n-1))".

(** We can also extract defined constants to specific OCaml terms or
    operators. *)

Extract Constant plus => "( + )".
Extract Constant mult => "( * )".
Extract Constant beq_nat => "( = )".

(** Important: It is entirely _your responsibility_ to make sure that
    the translations you're proving make sense.  For example, it might
    be tempting to include this one

      Extract Constant minus => "( - )".

    but doing so could lead to serious confusion!  (Why?)
*)

Extraction "imp2.ml" ceval_step.

(** Have a look at the file [imp2.ml].  Notice how the fundamental
    definitions have changed from [imp1.ml]. *)

(* ############################################################## *)
(** * A Complete Example *)

(** To use our extracted evaluator to run Imp programs, all we need to
    add is a tiny driver program that calls the evaluator and prints
    out the result.

    For simplicity, we'll print results by dumping out the first four
    memory locations in the final state.

    Also, to make it easier to type in examples, let's extract a
    parser from the [ImpParser] Coq module.  To do this, we need a few
    magic declarations to set up the right correspondence between Coq
    strings and lists of OCaml characters. *)

Require Import Ascii String.
Extract Inductive ascii => char
[
"(* If this appears, you're using Ascii internals. Please don't *) (fun (b0,b1,b2,b3,b4,b5,b6,b7) -> let f b i = if b then 1 lsl i else 0 in Char.chr (f b0 0 + f b1 1 + f b2 2 + f b3 3 + f b4 4 + f b5 5 + f b6 6 + f b7 7))"
]
"(* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7))".
Extract Constant zero => "'\000'".
Extract Constant one => "'\001'".
Extract Constant shift =>
 "fun b c -> Char.chr (((Char.code c) lsl 1) land 255 + if b then 1 else 0)".
Extract Inlined Constant ascii_dec => "(=)".

(** We also need one more variant of booleans. *)

Extract Inductive sumbool => "bool" ["true" "false"].

(** The extraction is the same as always. *)

Require Import Imp.
Require Import ImpParser.
Extraction "imp.ml" empty_state ceval_step parse.

(** Now let's run our generated Imp evaluator.  First, have a look at
    [impdriver.ml].  (This was written by hand, not extracted.)

    Next, compile the driver together with the extracted code and
    execute it, as follows.

        ocamlc -w -20 -w -26 -o impdriver imp.mli imp.ml impdriver.ml
        ./impdriver

    (The [-w] flags to [ocamlc] are just there to suppress a few
    spurious warnings.) *)

(* ############################################################## *)
(** * Discussion *)

(** Since we've proved that the [ceval_step] function behaves the same
    as the [ceval] relation in an appropriate sense, the extracted
    program can be viewed as a _certified_ Imp interpreter.  Of
    course, the parser we're using is not certified, since we didn't
    prove anything about it! *)

(** $Date: 2016-05-26 12:03:56 -0400 (Thu, 26 May 2016) $ *)


(** * Induction: Proof by Induction *)
(* Name: Zhiwei Wu 3 hours
Wenrui Meng 3 hours

*)

(* $Date: 2012-12-26 16:12:50 -0500 (Wed, 26 Dec 2012) $ *)

(** The next line imports all of our definitions from the
    previous chapter. *)

Require Export Basics.

(** For it to work, you need to use [coqc] to compile [Basics.v]
    into [Basics.vo].  (This is like making a .class file from a .java
    file, or a .o file from a .c file.)

    Here are two ways to compile your code:

     - CoqIDE:

         Open [Basics.v].
         In the "Compile" menu, click on "Compile Buffer".

     - Command line:

         Run [coqc Basics.v]

    In this file, we again use the [Module] feature to wrap all of the
    definitions for pairs and lists of numbers in a module so that,
    later, we can reuse the same names for improved (generic) versions
    of the same operations. *)

(* ###################################################################### *)
(** * Naming Cases *)

(** The fact that there is no explicit command for moving from
    one branch of a case analysis to the next can make proof scripts
    rather hard to read.  In larger proofs, with nested case analyses,
    it can even become hard to stay oriented when you're sitting with
    Coq and stepping through the proof.  (Imagine trying to remember
    that the first five subgoals belong to the inner case analysis and
    the remaining seven cases are what remains of the outer one...)
    Disciplined use of indentation and comments can help, but a better
    way is to use the [Case] tactic.

    [Case] is not built into Coq: we need to define it ourselves.
    There is no need to understand how it works -- just skip over the
    definition to the example that follows.  It uses some facilities
    of Coq that we have not discussed -- the string library (just for
    the concrete syntax of quoted strings) and the [Ltac] command,
    which allows us to declare custom tactics.  Kudos to Aaron
    Bohannon for this nice hack! *)

Require String. Open Scope string_scope.

Ltac move_to_top x :=
  match reverse goal with
  | H : _ |- _ => try move x after H
  end.

Tactic Notation "assert_eq" ident(x) constr(v) :=
  let H := fresh in
  assert (x = v) as H by reflexivity;
  clear H.

Tactic Notation "Case_aux" ident(x) constr(name) :=
  first [
    set (x := name); move_to_top x
  | assert_eq x name; move_to_top x
  | fail 1 "because we are working on a different case" ].

Tactic Notation "Case" constr(name) := Case_aux Case name.
Tactic Notation "SCase" constr(name) := Case_aux SCase name.
Tactic Notation "SSCase" constr(name) := Case_aux SSCase name.
Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name.
Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name.
Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name.
Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name.
Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name.

(** Here's an example of how [Case] is used.  Step through the
   following proof and observe how the context changes. *)

Theorem andb_true_elim1 : forall b c : bool,
  andb b c = true -> b = true.
Proof.
  intros b c H.
  destruct b.
  Case "b = true".
    reflexivity.
  Case "b = false".
    rewrite <- H. reflexivity.  Qed.

(** [Case] does something very trivial: It simply adds a string
    that we choose (tagged with the identifier "Case") to the context
    for the current goal.  When subgoals are generated, this string is
    carried over into their contexts.  When the last of these subgoals
    is finally proved and the next top-level goal (a sibling of the
    current one) becomes active, this string will no longer appear in
    the context and we will be able to see that the case where we
    introduced it is complete.  Also, as a sanity check, if we try to
    execute a new [Case] tactic while the string left by the previous
    one is still in the context, we get a nice clear error message.

    For nested case analyses (i.e., when we want to use a [destruct]
    to solve a goal that has itself been generated by a [destruct]),
    there is an [SCase] ("subcase") tactic. *)

(** **** Exercise: 2 stars (andb_true_elim2) *)
(** Prove [andb_true_elim2], marking cases (and subcases) when
    you use [destruct]. *)

Theorem andb_true_elim2 : forall b c : bool,
  andb b c = true -> c = true.
Proof.
  (* FILL IN HERE *)
intros b c H. destruct c. Case "c = true". reflexivity.
Case "c = false". rewrite <- H. destruct b.
SCase " b= true". reflexivity.
SCase " b=false". reflexivity.  Qed.
(** [] *)

(** There are no hard and fast rules for how proofs should be
    formatted in Coq -- in particular, where lines should be broken
    and how sections of the proof should be indented to indicate their
    nested structure.  However, if the places where multiple subgoals
    are generated are marked with explicit [Case] tactics placed at
    the beginning of lines, then the proof will be readable almost no
    matter what choices are made about other aspects of layout.

    This is a good place to mention one other piece of (possibly
    obvious) advice about line lengths.  Beginning Coq users sometimes
    tend to the extremes, either writing each tactic on its own line
    or entire proofs on one line.  Good style lies somewhere in the
    middle.  In particular, one reasonable convention is to limit
    yourself to 80-character lines.  Lines longer than this are hard
    to read and can be inconvenient to display and print.  Many
    editors have features that help enforce this. *)

(* ###################################################################### *)
(** * Induction *)

(** We proved above that [0] is a neutral element for [+] on
    the left using a simple partial evaluation argument.  The fact
    that it is also a neutral element on the _right_... *)

Theorem plus_0_r_firsttry : forall n:nat,
  n + 0 = n.

(** ... cannot be proved in the same simple way.  Just applying
  [reflexivity] doesn't work: the [n] in [n + 0] is an arbitrary
  unknown number, so the [match] in the definition of [+] can't be
  simplified.  And reasoning by cases using [destruct n] doesn't get
  us much further: the branch of the case analysis where we assume [n
  = 0] goes through, but in the branch where [n = S n'] for some [n']
  we get stuck in exactly the same way.  We could use [destruct n'] to
  get one step further, but since [n] can be arbitrarily large, if we
  try to keep on going this way we'll never be done. *)

Proof.
  intros n.
  simpl. (* Does nothing! *)
Admitted.

(** Case analysis gets us a little further, but not all the way: *)

Theorem plus_0_r_secondtry : forall n:nat,
  n + 0 = n.
Proof.
  intros n. destruct n as [| n'].
  Case "n = 0".
    reflexivity. (* so far so good... *)
  Case "n = S n'".
    simpl.       (* ...but here we are stuck again *)
Admitted.

(** To prove such facts -- indeed, to prove most interesting
    facts about numbers, lists, and other inductively defined sets --
    we need a more powerful reasoning principle: _induction_.

    Recall (from high school) the principle of induction over natural
    numbers: If [P(n)] is some proposition involving a natural number
    [n] and we want to show that P holds for _all_ numbers [n], we can
    reason like this:
         - show that [P(O)] holds;
         - show that, for any [n'], if [P(n')] holds, then so does
           [P(S n')];
         - conclude that [P(n)] holds for all [n].

    In Coq, the steps are the same but the order is backwards: we
    begin with the goal of proving [P(n)] for all [n] and break it
    down (by applying the [induction] tactic) into two separate
    subgoals: first showing [P(O)] and then showing [P(n') -> P(S
    n')].  Here's how this works for the theorem we are trying to
    prove at the moment: *)

Theorem plus_0_r : forall n:nat, n + 0 = n.
Proof.
  intros n. induction n as [| n'].
  Case "n = 0".     reflexivity.
  Case "n = S n'".  simpl. rewrite -> IHn'. reflexivity.  Qed.

(** Like [destruct], the [induction] tactic takes an [as...]
    clause that specifies the names of the variables to be introduced
    in the subgoals.  In the first branch, [n] is replaced by [0] and
    the goal becomes [0 + 0 = 0], which follows by simplification.  In
    the second, [n] is replaced by [S n'] and the assumption [n' + 0 =
    n'] is added to the context (with the name [IHn'], i.e., the
    Induction Hypothesis for [n']).  The goal in this case becomes [(S
    n') + 0 = S n'], which simplifies to [S (n' + 0) = S n'], which in
    turn follows from the induction hypothesis. *)

Theorem minus_diag : forall n,
  minus n n = 0.
Proof.
  (* WORKED IN CLASS *)
  intros n. induction n as [| n'].
  Case "n = 0".
    simpl. reflexivity.
  Case "n = S n'".
    simpl. rewrite -> IHn'. reflexivity.  Qed.

(** **** Exercise: 2 stars, recommended (basic_induction) *)
Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  (* FILL IN HERE *)
intro. induction n as [|n'].
Case " n = 0 ". reflexivity.
Case " n = S n' ". simpl. rewrite -> IHn'. reflexivity. Qed.

Theorem plus_n_Sm : forall n m : nat,
  S (n + m) = n + (S m).
Proof.
  (* FILL IN HERE *)
intros. induction n as [| n'].
Case " n = 0 ". reflexivity.
Case " n = S n' ". simpl. rewrite IHn'.  reflexivity. Qed.

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  (* FILL IN HERE *)
intros. induction n as [| n'].
Case " n = 0 ". induction m as [| m'].
SCase " m = 0". reflexivity.
SCase " m = S m' ". simpl. rewrite <- IHm'. reflexivity.
Case " n = S n' ".  simpl.  induction m as [| m'].
SCase " m = 0 ".  rewrite IHn'. reflexivity.
SCase " m = S m' ". rewrite IHn'. rewrite plus_n_Sm. reflexivity. Qed.
(** [] *)

Fixpoint double (n:nat) :=
  match n with
  | O => O
  | S n' => S (S (double n'))
  end.

(** **** Exercise: 2 stars (double_plus) *)
Lemma double_plus : forall n, double n = n + n .
Proof.
  (* FILL IN HERE *)
intros. induction n as [| n'].
Case " n = 0 ". reflexivity.
Case " n = S n'". simpl. rewrite IHn'. rewrite <- plus_n_Sm. reflexivity. Qed.
(** [] *)

(** **** Exercise: 1 star (destruct_induction) *)
(** Briefly explain the difference between the tactics
    [destruct] and [induction].

Both tactics allow us to consider all cases of the variables assignments
in a proof. While general destruct considers substituting
variables exhaustively, induction allows us to prove just by looking at
the base case and derivation by inductive hypothesis.

(* FILL IN HERE *)

*)
(** [] *)

(* ###################################################################### *)
(** * Formal vs. Informal Proof *)

(** "Informal proofs are algorithms; formal proofs are code." *)

(** The question of what, exactly, constitutes a "proof" of a
    mathematical claim has challenged philosophers for millenia.  A
    rough and ready definition, though, could be this: a proof of a
    mathematical proposition [P] is a written (or spoken) text that
    instills in the reader or hearer the certainty that [P] is true.
    That is, a proof is an act of communication.

    Now, acts of communication may involve different sorts of readers.
    On one hand, the "reader" can be a program like Coq, in which case
    the "belief" that is instilled is a simple mechanical check that
    [P] can be derived from a certain set of formal logical rules, and
    the proof is a recipe that guides the program in performing this
    check.  Such recipes are _formal_ proofs.

    Alternatively, the reader can be a human being, in which case the
    proof will be written in English or some other natural language,
    thus necessarily _informal_.  Here, the criteria for success are
    less clearly specified.  A "good" proof is one that makes the
    reader believe [P].  But the same proof may be read by many
    different readers, some of whom may be convinced by a particular
    way of phrasing the argument, while others may not be.  One reader
    may be particularly pedantic, inexperienced, or just plain
    thick-headed; the only way to convince them will be to make the
    argument in painstaking detail.  But another reader, more familiar
    in the area, may find all this detail so overwhelming that they
    lose the overall thread.  All they want is to be told the main
    ideas, because it is easier to fill in the details for themselves.
    Ultimately, there is no universal standard, because there is no
    single way of writing an informal proof that is guaranteed to
    convince every conceivable reader.  In practice, however,
    mathematicians have developed a rich set of conventions and idioms
    for writing about complex mathematical objects that, within a
    certain community, make communication fairly reliable.  The
    conventions of this stylized form of communication give a fairly
    clear standard for judging proofs good or bad.

    Because we are using Coq in this course, we will be working
    heavily with formal proofs.  But this doesn't mean we can ignore
    the informal ones!  Formal proofs are useful in many ways, but
    they are _not_ very efficient ways of communicating ideas between
    human beings. *)

(** For example, here is a proof that addition is associative: *)

Theorem plus_assoc' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof. intros n m p. induction n as [| n']. reflexivity.
  simpl. rewrite -> IHn'. reflexivity.  Qed.

(** Coq is perfectly happy with this as a proof.  For a human,
    however, it is difficult to make much sense of it.  If you're used
    to Coq you can probably step through the tactics one after the
    other in your mind and imagine the state of the context and goal
    stack at each point, but if the proof were even a little bit more
    complicated this would be next to impossible.  Instead, a
    mathematician mighty write it like this: *)
(** - _Theorem_: For any [n], [m] and [p],
      n + (m + p) = (n + m) + p.
    _Proof_: By induction on [n].

    - First, suppose [n = 0].  We must show
        0 + (m + p) = (0 + m) + p.
      This follows directly from the definition of [+].

    - Next, suppose [n = S n'], where
        n' + (m + p) = (n' + m) + p.
      We must show
        (S n') + (m + p) = ((S n') + m) + p.
      By the definition of [+], this follows from
        S (n' + (m + p)) = S ((n' + m) + p),
      which is immediate from the induction hypothesis. [] *)

(** The overall form of the proof is basically similar.  This is
    no accident, of course: Coq has been designed so that its
    [induction] tactic generates the same sub-goals, in the same
    order, as the bullet points that a mathematician would write.  But
    there are significant differences of detail: the formal proof is
    much more explicit in some ways (e.g., the use of [reflexivity])
    but much less explicit in others; in particular, the "proof state"
    at any given point in the Coq proof is completely implicit,
    whereas the informal proof reminds the reader several times where
    things stand. *)

(** Here is a formal proof that shows the structure more
    clearly: *)

Theorem plus_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p. induction n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n'".
    simpl. rewrite -> IHn'. reflexivity.   Qed.

(** **** Exercise: 2 stars (plus_comm_informal) *)
(** Translate your solution for [plus_comm] into an informal proof. *)

(** Theorem: Addition is commutative.

    Proof: (*

Case " n = S n' ".  simpl.  induction m as [| m'].
SCase " m = 0 ".  rewrite IHn'. reflexivity.
SCase " m = S m' ". rewrite IHn'. rewrite plus_n_Sm. reflexivity. Qed.

Proof by induction on n.
For base case [n = 0].
We have the following inducion on m:
Sub-basecase: m = 0, we have m + n = 0 + 0 = n + m.
Sub-inductive: Assume that 0 + m' = m' + 0 for m' \geq 0.
We would have 0 + (m' + 1) = (m' + 1) + 0 by simplification.

For inductive case:
Assume n' + m  = m + n' for all natural numbers m, and n' \geq 0. Then
we want to show that (S n') + m = m + (S n').
We also have the following induction on m:
Sub-basecase: m = 0, we have m + (n' + 1) = (n' + 1) = (n' + 1) + m.
Sub-inductive: Assume that (n' + 1) + m' = m' + (n' + 1).
Then by applying the hypothesis twice, we have (n' + 1) + (m' + 1) = (n' + 1) + m' + 1 = m' + (n' + 1) + 1 = m' + 1 + (n' + 1).

Therefore, commutativity holds for all natural numbers m,n.
*)
[]
*)

(** **** Exercise: 2 stars, optional (beq_nat_refl_informal) *)
(** Write an informal proof of the following theorem, using the
    informal proof of [plus_assoc] as a model.  Don't just
    paraphrase the Coq tactics into English!

    Theorem: [true = beq_nat n n] for any [n].

    Proof: (* FILL IN HERE *)

[]
 *)

(** **** Exercise: 1 star, optional (beq_nat_refl) *)
Theorem beq_nat_refl : forall n : nat,
  true = beq_nat n n.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ###################################################################### *)
(** * Proofs Within Proofs *)

(** In Coq, as in informal mathematics, large proofs are very
    often broken into a sequence of theorems, with later proofs
    referring to earlier theorems.  Occasionally, however, a proof
    will need some miscellaneous fact that is too trivial (and of too
    little general interest) to bother giving it its own top-level
    name.  In such cases, it is convenient to be able to simply state
    and prove the needed "sub-theorem" right at the point where it is
    used.  The [assert] tactic allows us to do this.  For example, our
    earlier proof of the [mult_0_plus] theorem referred to a previous
    theorem named [plus_O_n].  We can also use [assert] to state and
    prove [plus_O_n] in-line: *)

Theorem mult_0_plus' : forall n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros n m.
  assert (H: 0 + n = n).
    Case "Proof of assertion". reflexivity.
  rewrite -> H.
  reflexivity.  Qed.

(** The [assert] tactic introduces two sub-goals.  The first is
    the assertion itself; by prefixing it with [H:] we name the
    assertion [H].  (Note that we could also name the assertion with
    [as] just as we did above with [destruct] and [induction], i.e.,
    [assert (0 + n = n) as H].  Also note that we mark the proof of
    this assertion with a [Case], both for readability and so that,
    when using Coq interactively, we can see when we're finished
    proving the assertion by observing when the ["Proof of assertion"]
    string disappears from the context.)  The second goal is the same
    as the one at the point where we invoke [assert], except that, in
    the context, we have the assumption [H] that [0 + n = n].  That
    is, [assert] generates one subgoal where we must prove the
    asserted fact and a second subgoal where we can use the asserted
    fact to make progress on whatever we were trying to prove in the
    first place. *)

(** Actually, [assert] will turn out to be handy in many sorts of
    situations.  For example, suppose we want to prove that [(n + m)
    + (p + q) = (m + n) + (p + q)]. The only difference between the
    two sides of the [=] is that the arguments [m] and [n] to the
    first inner [+] are swapped, so it seems we should be able to
    use the commutativity of addition ([plus_comm]) to rewrite one
    into the other.  However, the [rewrite] tactic is a little stupid
    about _where_ it applies the rewrite.  There are three uses of
    [+] here, and it turns out that doing [rewrite -> plus_comm]
    will affect only the _outer_ one. *)

Theorem plus_rearrange_firsttry : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  (* We just need to swap (n + m) for (m + n)...
     it seems like plus_comm should do the trick! *)
  rewrite -> plus_comm.
  (* Doesn't work...Coq rewrote the wrong plus! *)
Admitted.

(** To get [plus_comm] to apply at the point where we want it, we can
    introduce a local lemma stating that [n + m = m + n] (for
    the particular [m] and [n] that we are talking about here), prove
    this lemma using [plus_comm], and then use this lemma to do the
    desired rewrite. *)

Theorem plus_rearrange : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  assert (H: n + m = m + n).
    Case "Proof of assertion".
    rewrite -> plus_comm. reflexivity.
  rewrite -> H. reflexivity.  Qed.

(** **** Exercise: 4 stars, recommended (mult_comm) *)
(** Use [assert] to help prove this theorem.  You shouldn't need to
    use induction. *)

Theorem plus_swap : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  (* FILL IN HERE *)
intros. rewrite plus_comm. assert ( p+n = n+p).
Case "Proof in assertion ".
rewrite plus_comm. reflexivity.
rewrite  <- H. rewrite -> plus_assoc. reflexivity.
  Qed.

(** Now prove commutativity of multiplication.  (You will probably
    need to define and prove a separate subsidiary theorem to be used
    in the proof of this one.)  You may find that [plus_swap] comes in
    handy. *)
Theorem mult_1_r : forall n : nat,
n * 1 = n.
Proof.
intros. induction n as [| S n'].
Case " n = 0 ". reflexivity.
Case " n = S n' ". simpl. rewrite n'. reflexivity. Qed.
Theorem mult_1_plus' : forall m n : nat,
(1 + n ) * m = m + n * m.
Proof.
intros. simpl. reflexivity. Qed.

Theorem mult_comm : forall m n : nat,
 m * n = n * m.
Proof.
intros. induction m as [| m'].
Case " m = 0 ".
simpl. rewrite -> mult_0_r. reflexivity.
Case " m = S m' ".  simpl. rewrite IHm'. induction n as [|n'].
SCase " n = 0 ". reflexivity.
SCase " n = S n' ". simpl.  rewrite ->  plus_assoc.

assert ( m' + n' * S m' = n' * S m' ).
SSCase "Proof assertion ".
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (evenb_n__oddb_Sn) *)
Theorem evenb_n__oddb_Sn : forall n : nat,
  evenb n = negb (evenb (S n)).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ###################################################################### *)
(** * More Exercises *)

(** **** Exercise: 3 stars, optional (more_exercises) *)
(** Take a piece of paper.  For each of the following theorems, first
    _think_ about whether (a) it can be proved using only
    simplification and rewriting, (b) it also requires case
    analysis ([destruct]), or (c) it also requires induction.  Write
    down your prediction.  Then fill in the proof.  (There is no need
    to turn in your piece of paper; this is just to encourage you to
    reflect before hacking!) *)

Theorem ble_nat_refl : forall n:nat,
  true = ble_nat n n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem zero_nbeq_S : forall n:nat,
  beq_nat 0 (S n) = false.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem plus_ble_compat_l : forall n m p : nat,
  ble_nat n m = true -> ble_nat (p + n) (p + m) = true.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem S_nbeq_0 : forall n:nat,
  beq_nat (S n) 0 = false.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem all3_spec : forall b c : bool,
    orb
      (andb b c)
      (orb (negb b)
               (negb c))
  = true.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  (* FILL IN HERE *) Admitted.

Theorem mult_assoc : forall n m p : nat,
  n * (m * p) = (n * m) * p.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (plus_swap') *)
(** The [replace] tactic allows you to specify a particular subterm to
   rewrite and what you want it rewritten to.  More precisely,
   [replace (t) with (u)] replaces (all copies of) expression [t] in
   the goal by expression [u], and generates [t = u] as an additional
   subgoal. This is often useful when a plain [rewrite] acts on the wrong
   part of the goal.

   Use the [replace] tactic to do a proof of [plus_swap'], just like
   [plus_swap] but without needing [assert (n + m = m + n)].
*)

Theorem plus_swap' : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 4 stars, recommended (binary) *)
(** Consider a different, more efficient representation of natural
    numbers using a binary rather than unary system.  That is, instead
    of saying that each natural number is either zero or the successor
    of a natural number, we can say that each binary number is either

      - zero,
      - twice a binary number, or
      - one more than twice a binary number.

    (a) First, write an inductive definition of the type [bin]
        corresponding to this description of binary numbers.

    (Hint: recall that the definition of [nat] from class,
    Inductive nat : Type :=
      | O : nat
      | S : nat -> nat.
    says nothing about what [O] and [S] "mean".  It just says "[O] is
    a nat (whatever that is), and if [n] is a nat then so is [S n]".
    The interpretation of [O] as zero and [S] as successor/plus one
    comes from the way that we use nat values, by writing functions to
    do things with them, proving things about them, and so on.  Your
    definition of [bin] should be correspondingly simple; it is the
    functions you will write next that will give it mathematical
    meaning.)

    (b) Next, write an increment function for binary numbers, and a
        function to convert binary numbers to unary numbers.

    (c) Finally, prove that your increment and binary-to-unary
        functions commute: that is, incrementing a binary number and
        then converting it to unary yields the same result as first
        converting it to unary and then incrementing.
*)

Inductive bin : Type :=
  | zero : bin
  | T : bin -> bin
  | T1: bin -> bin.  (* Twice plus 1*)

Fixpoint increment (b : bin) : bin :=
  match b with
  | zero  => T1 zero
  | T b'  => T1 b'
  | T1 b' => T (increment b')
  end.

Fixpoint to_unary (b : bin) : nat :=
  match b with
  | zero => O
  | T b' => mult 2 (to_unary b')
  | T1 b' => plus (mult 2 (to_unary b')) 1
  end.

Example test_bin1: to_unary (increment (increment (increment zero))) = 3.
Proof. simpl. reflexivity. Qed.

Example test_bin2: to_unary (increment (increment (increment (T1 zero)))) = 4.
Proof. simpl. reflexivity. Qed.

(** [] *)

(** **** Exercise: 5 stars (binary_inverse) *)
(** This exercise is a continuation of the previous exercise about
    binary numbers.  You will need your definitions and theorems from
    the previous exercise to complete this one.

    (a) First, write a function to convert natural numbers to binary
        numbers.  Then prove that starting with any natural number,
        converting to binary, then converting back yields the same
        natural number you started with.

    (b) You might naturally think that we should also prove the
        opposite direction: that starting with a binary number,
        converting to a natural, and then back to binary yields the
        same number we started with.  However, it is not true!
        Explain what the problem is.

    (c) Define a function [normalize] from binary numbers to binary
        numbers such that for any binary number b, converting to a
        natural and then back to binary yields [(normalize b)].  Prove
        it.
*)

(*

 *)

(** **** Exercise: 2 stars, optional (decreasing) *)
(** The requirement that some argument to each function be
    "decreasing" is a fundamental feature of Coq's design: In
    particular, it guarantees that every function that can be defined
    in Coq will terminate on all inputs.  However, because Coq's
    "decreasing analysis" is not very sophisticated, it is sometimes
    necessary to write functions in slightly unnatural ways.

    To get a concrete sense of this, find a way to write a sensible
    [Fixpoint] definition (of a simple function on numbers, say) that
    _does_ terminate on all inputs, but that Coq will _not_ accept
    because of this restriction. *)

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