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

Require Import List Arith Bool Lia Eqdep_dec.

From Undecidability.Shared.Libs.DLW.Utils
  Require Import utils_tac utils_list utils_nat finite.

From Undecidability.Shared.Libs.DLW.Vec
  Require Import pos vec.

From Undecidability.FOL.TRAKHTENBROT
  Require Import notations utils decidable fol_ops fo_sig fo_terms fo_logic fo_sat.

Import fol_notations.

Set Implicit Arguments.

(* * From signatures with only constants functions to function symbol free signatures *)

Local Reserved Notation "⟪ A ⟫'" (at level 1, format "⟪ A ⟫'").

Local Notation ø := vec_nil.

Section remove_constants.

  Variable (Σ : fo_signature) (HΣ : forall s, ar_syms Σ s = 0)
           (ls : list (syms Σ)).

  Definition Σrem_cst : fo_signature.
  Proof using Σ.
    exists Empty_set (rels Σ).
    + intros [].
    + apply ar_rels.
  Defined.

  Notation Σ' := Σrem_cst.

  Notation 𝕋 := (fol_term Σ).
  Notation 𝔽 := (fol_form Σ).

  Notation 𝕋' := (fol_term Σ').
  Notation 𝔽' := (fol_form Σ').

  Implicit Type σ : syms Σ -> nat.

  Let convert_t σ (t : 𝕋) : 𝕋' :=
    match t with
      | in_var n   => in_var n
      | in_fot s _ => in_var (σ s)
    end.

  Local Fixpoint encode σ (A : 𝔽)  : 𝔽' :=
    match A with
      | ⊥              => ⊥
      | fol_atom r v   => @fol_atom Σ' r (vec_map (convert_t σ) v)
      | fol_bin b A B  => fol_bin b (encode σ A) (encode σ B)
      | fol_quant q A  => fol_quant q (encode (fun s => S (σ s)) A)
    end.

  Section soundness.

    Variable (X : Type) (M : fo_model Σ X).

    Definition Σrem_cst_model : fo_model Σ' X.
    Proof using M.
      split.
      + intros [].
      + apply (fom_rels M).
    Defined.

    Notation M' := Σrem_cst_model.

    Notation "⟪ A ⟫" := (fun φ => fol_sem M φ A).
    Notation "⟪ A ⟫'" := (fun ψ => fol_sem M' ψ A).

    Local Fact soundness σ (A : 𝔽) φ ψ :
            (forall s, In s ls -> In (σ s) (fol_vars A) -> False)
         -> (forall n, In n (fol_vars A) -> φ n = ψ n)
         -> (forall s, In s ls -> ψ (σ s) = fom_syms M s (cast ø (eq_sym (HΣ s))))
         -> incl (fol_syms A) ls
         ->  ⟪A⟫ φ <-> ⟪encode σ A⟫' ψ.
    Proof.
      induction A as [ | r v | b A HA B HB | q A HA ] in σ, φ, ψ |- *;
        intros H1 H2 H3 H4; simpl; try tauto.
      + rewrite vec_map_map.
        apply fol_equiv_ext; f_equal.
        apply vec_pos_ext; intro p; rew vec.
        cut (incl (fo_term_syms (vec_pos v p)) ls).
        2:{ intros s Hs; apply H4; simpl; apply in_flat_map.
            exists (vec_pos v p); split; auto.
            apply in_vec_list, in_vec_pos. }
        cut (forall n, In n (fo_term_vars (vec_pos v p)) -> φ n = ψ n).
        2:{ intros n Hn; apply H2, in_flat_map.
            exists (vec_pos v p); split; auto.
            apply in_vec_list, in_vec_pos. }
        generalize (vec_pos v p); intros [ n | s w ] H5 H6; simpl.
        - apply H5; simpl; auto.
        - rewrite H3; f_equal; auto.
          2: apply H6; rew fot; simpl; auto.
          clear H5 H6.
          revert w; rewrite HΣ; intros w.
          vec nil w; auto.
      + apply fol_bin_sem_ext.
        * apply HA; auto.
          - intros s G1 G2; apply (H1 _ G1), in_app_iff; auto.
          - intros; apply H2, in_app_iff; auto.
          - intros ? ?; apply H4, in_app_iff; auto.
        * apply HB; auto.
          - intros s G1 G2; apply (H1 _ G1), in_app_iff; auto.
          - intros; apply H2, in_app_iff; auto.
          - intros ? ?; apply H4, in_app_iff; auto.
      + apply fol_quant_sem_ext; intros x.
        apply HA; auto.
        * intros s G1 G2; apply (H1 _ G1).
          simpl; apply in_flat_map.
          exists (S (σ s)); simpl; auto.
        * intros [|n] Hn; simpl; auto.
          apply H2; simpl; apply in_flat_map.
          exists (S n); simpl; auto.
    Qed.

  End soundness.

  Section completeness.

    Variable (X : Type) (M' : fo_model Σ' X).

    Definition Σadd_cst_model σ (ψ : nat -> X) : fo_model Σ X.
    Proof using M'.
      split.
      + intros s _; exact (ψ (σ s)).
      + apply (fom_rels M').
    Defined.

    Notation M := Σadd_cst_model.

    Local Fact completeness σ (A : 𝔽) φ ψ :
            (forall s, In s ls -> In (σ s) (fol_vars A) -> False)
         -> (forall n, In n (fol_vars A) -> φ n = ψ n)
         -> incl (fol_syms A) ls
         -> fol_sem (Σadd_cst_model σ ψ) φ A
        <-> fol_sem M' ψ (encode σ A).
    Proof.
      induction A as [ | r v | b A HA B HB | q A HA ] in σ, φ, ψ |- *;
      intros H1 H2 H3; simpl; try tauto.
      + rewrite vec_map_map.
        apply fol_equiv_ext; f_equal.
        apply vec_pos_ext; intro p; rew vec.
        cut (incl (fo_term_syms (vec_pos v p)) ls).
        2:{ intros s Hs; apply H3; simpl; apply in_flat_map.
            exists (vec_pos v p); split; auto.
            apply in_vec_list, in_vec_pos. }
        cut (forall n, In n (fo_term_vars (vec_pos v p)) -> φ n = ψ n).
        2:{ intros n Hn; apply H2, in_flat_map.
            exists (vec_pos v p); split; auto.
            apply in_vec_list, in_vec_pos. }
        generalize (vec_pos v p); intros [ n | s w ] H5 H6; simpl; auto.
        apply H5; simpl; auto.
      + apply fol_bin_sem_ext.
        * apply HA; auto.
          - intros s G1 G2; apply (H1 _ G1), in_app_iff; auto.
          - intros; apply H2, in_app_iff; auto.
          - intros ? ?; apply H3, in_app_iff; auto.
        * apply HB; auto.
          - intros s G1 G2; apply (H1 _ G1), in_app_iff; auto.
          - intros; apply H2, in_app_iff; auto.
          - intros ? ?; apply H3, in_app_iff; auto.
      + apply fol_quant_sem_ext; intros x.
        rewrite <- HA with (φ := x·φ); unfold M; simpl; try tauto.
        * intros s G1 G2; apply (H1 _ G1).
          simpl; apply in_flat_map.
          exists (S (σ s)); simpl; auto.
        * intros [|n] Hn; simpl; auto.
          apply H2; simpl; apply in_flat_map.
          exists (S n); simpl; auto.
    Qed.

  End completeness.

End remove_constants.

Section reduction.

  Variable (Σ  : fo_signature)
           (Σ0 : forall s, ar_syms Σ s = 0)
           (Σd : discrete (syms Σ)).

  Section syms_map.

    Variable A : fol_form Σ.

    Let ls := fol_syms A.
    Let K := list_discr_pos_n Σd ls.

    Let n := projT1 K.
    Let v : vec _ n := projT1 (projT2 K).
    Let g : _ -> option (pos n) := proj1_sig (projT2 (projT2 K)).

    Let HK := proj2_sig (projT2 (projT2 K)).

    Let H1 x : in_vec x v <-> In x ls.
    Proof. apply (proj1 HK). Qed.

    Let H2 x : In x ls <-> g x <> None.
    Proof. apply (proj1 (proj2 HK)). Qed.

    Let H3 p : g (vec_pos v p) = Some p.
    Proof. apply (proj1 (proj2 (proj2 HK))). Qed.

    Let H4 x p : g x = Some p -> vec_pos v p = x.
    Proof. apply (proj2 (proj2 (proj2 HK))). Qed.

    Let σ s :=
      match g s with
        | Some p => pos2nat p
        | None   => 0
      end.

    Let f x : option (syms Σ) :=
      match le_lt_dec n x with
        | left _  => None
        | right H => Some (vec_pos v (nat2pos H))
      end.

    Let Hfσ s : In s ls -> f (σ s) = Some s.
    Proof.
      rewrite H2.
      unfold f, σ.
      generalize (H4 s).
      destruct (g s) as [ p | ].
      + intros E _.
        specialize (E _ eq_refl); subst.
        generalize (pos2nat_prop p).
        destruct (le_lt_dec n (pos2nat p)) as [ | H ].
        * intros; exfalso; lia.
        * rewrite nat2pos_pos2nat; auto.
      + intros _ []; auto.
    Qed.

    Local Fact syms_map : { σ  : syms Σ -> nat           &
                          { f  : nat -> option (syms Σ)  |
                            forall s, In s ls -> f (σ s) = Some s } }.
    Proof using Σd. exists σ, f; auto. Qed.

  End syms_map.

  Hint Resolve incl_refl : core.

  Theorem Sig_rem_cst_dep_red A : { B | @fo_form_fin_dec_SAT Σ A <-> @fo_form_fin_dec_SAT (Σrem_cst Σ) B }.
  Proof using Σ0 Σd.
    generalize (fol_vars_max_spec A).
    set (m := fol_vars_max A); intros Hm.
    destruct (syms_map A) as (g & f & Hfg).
    set (σ s := g s + S m).
    exists (encode σ A).
    split.
    + intros (X & M & G1 & G2 & phi & G3).
      exists X, (Σrem_cst_model M), G1.
      exists. { intros r; simpl; apply G2. }
      set (psi n :=
        match le_lt_dec (S m) n with
          | left _  =>
          match f (n - S m) with
            | Some s => fom_syms M s (cast ø (eq_sym (Σ0 _)))
            | None   => phi 0
          end
          | right _ => phi n
        end).
      exists psi.
      revert G3; apply soundness with (HΣ := Σ0) (ls := fol_syms A); auto.
      * intros s Hs; unfold σ; intros H.
        apply Hm in H; lia.
      * intros n Hn; apply Hm in Hn.
        unfold psi.
        destruct (le_lt_dec (S m) n); try lia; auto.
      * intros s Hs.
        unfold psi, σ.
        apply Hfg in Hs.
        replace (g s + S m - S m) with (g s) by lia.
        rewrite Hs.
        destruct (le_lt_dec (S m) (g s + S m)); auto; lia.
    + intros (X & M' & G1 & G2 & psi & G3).
      exists X, (Σadd_cst_model M' σ psi), G1.
      exists. { intros r; simpl; apply G2. }
      exists psi.
      revert G3; apply completeness with (ls := fol_syms A); auto.
      intros s Hs; unfold σ; intros H.
      apply Hm in H; lia.
  Qed.

End reduction.


(*
I hereby assign copyright in my past and future contributions
to the Software Foundations project to the Author of Record of
each volume or component, to be licensed under the same terms
as the rest of Software Foundations. I understand that, at present,
the Authors of Record are as follows: For Volumes 1 and 2, known
until 2016 as "Software Foundations" and from 2016 as (respectively)
"Logical Foundations" and "Programming Foundations," and for Volume 4,
"QuickChick: Property-Based Testing in Coq," the Author of Record is
Benjamin C. Pierce. For Volume 3, "Verified Functional Algorithms",
the Author of Record is Andrew W. Appel. For components outside of
designated volumes (e.g., typesetting and grading tools and other
software infrastructure), the Author of Record is Benjamin Pierce.
*)

Inductive day : Type :=
  | monday : day
  | tuesday : day
  | wednesday : day
  | thursday : day
  | friday : day
  | saturday : day
  | sunday : day.

Definition next_weekday (d:day) : day :=
  match d with
  | monday    => tuesday
  | tuesday   => wednesday
  | wednesday => thursday
  | thursday  => friday
  | friday    => monday
  | saturday  => monday
  | sunday    => monday
  end.

Compute (next_weekday friday).
(* ==> monday : day *)

Compute (next_weekday (next_weekday saturday)).
(* ==> tuesday : day *)

Example test_next_weekday:
  (next_weekday (next_weekday saturday)) = tuesday.

Proof. simpl. reflexivity.  Qed.

(** ** Booleans *)

Inductive bool : Type :=
  | true : bool
  | false : bool.

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

Definition andb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => b2
  | false => false
  end.

Definition orb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => true
  | false => b2
  end.

Example test_orb1:  (orb true  false) = true.
Proof. simpl. reflexivity.  Qed.
Example test_orb2:  (orb false false) = false.
Proof. simpl. reflexivity.  Qed.
Example test_orb3:  (orb false true)  = true.
Proof. simpl. reflexivity.  Qed.
Example test_orb4:  (orb true  true)  = true.
Proof. simpl. reflexivity.  Qed.

Notation "x && y" := (andb x y).
Notation "x || y" := (orb x y).

Example test_orb5:  false || false || true = true.
Proof. simpl. reflexivity. Qed.

(** **** Exercise: 1 star (nandb)  *)
(** Remove "[Admitted.]" and complete the definition of the following
    function; then make sure that the [Example] assertions below can
    each be verified by Coq.  (Remove "[Admitted.]" and fill in each
    proof, following the model of the [orb] tests above.) The function
    should return [true] if either or both of its inputs are
    [false]. *)

Definition nandb (b1:bool) (b2:bool) : bool
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.

Example test_nandb1:               (nandb true false) = true.
(* FILL IN HERE *) Admitted.
Example test_nandb2:               (nandb false false) = true.
(* FILL IN HERE *) Admitted.
Example test_nandb3:               (nandb false true) = true.
(* FILL IN HERE *) Admitted.
Example test_nandb4:               (nandb true true) = false.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star (andb3)  *)
(** Do the same for the [andb3] function below. This function should
    return [true] when all of its inputs are [true], and [false]
    otherwise. *)

Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.

Example test_andb31:                 (andb3 true true true) = true.
(* FILL IN HERE *) Admitted.
Example test_andb32:                 (andb3 false true true) = false.
(* FILL IN HERE *) Admitted.
Example test_andb33:                 (andb3 true false true) = false.
(* FILL IN HERE *) Admitted.
Example test_andb34:                 (andb3 true true false) = false.
(* FILL IN HERE *) Admitted.
(** [] *)

(* ================================================================= *)
(** ** Function Types *)

Check true.
(* ===> true : bool *)
Check (negb true).
(* ===> negb true : bool *)

Check negb.
(* ===> negb : bool -> bool *)

(* ================================================================= *)
(** ** Compound Types *)

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

Inductive color : Type :=
  | black : color
  | white : color
  | primary : rgb -> color.

(*
Exercise : What is the type of primary? What about primary blue?
Write appropriate commands that print the types of these expressions.
*)

Definition monochrome (c : color) : bool :=
  match c with
  | black => true
  | white => true
  | primary p => false
  end.

Definition isred (c : color) : bool :=
  match c with
  | black => false
  | white => false
  | primary red => true
  | primary _ => false
  end.

(*
Exercise: What is the type of each of these functions?
Write appropriate commands that print the types of these expressions.
*)

(*
Exercise: Prove that isred returns false when the color is blue.
You need to write an assertion that specifies this, and then
prove it.
*)

(* ================================================================= *)
(** ** Modules *)

Module NatPlayground.

(* ================================================================= *)
(** ** Numbers *)

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

Definition pred (n : nat) : nat :=
  match n with
    | O => O
    | S n' => n'
  end.

End NatPlayground.

Check (S (S (S (S O)))).
  (* ===> 4 : nat *)

Definition minustwo (n : nat) : nat :=
  match n with
    | O => O
    | S O => O
    | S (S n') => n'
  end.

Compute (minustwo 4).
  (* ===> 2 : nat *)

Check S.
Check pred.
Check minustwo.

Compute (S (minustwo (S (S O)))).

(*New Session!*)

Fixpoint evenb (n:nat) : bool :=
  match n with
  | O        => true
  | S O      => false
  | S (S n') => evenb n'
  end.

Definition oddb (n:nat) : bool   :=   negb (evenb n).

Example test_oddb1:    oddb 1 = true.
Proof. simpl. reflexivity.  Qed.
Example test_oddb2:    oddb 4 = false.
Proof. simpl. reflexivity.  Qed.

Module NatPlayground2.

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

Compute (plus 3 2).

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

Example test_mult1: (mult 3 3) = 9.
Proof. simpl. reflexivity.  Qed.

Fixpoint minus (n m:nat) : nat :=
  match n, m with
  | O   , _    => O
  | S _ , O    => n
  | S n', S m' => minus n' m'
  end.

End NatPlayground2.

Fixpoint exp (base power : nat) : nat :=
  match power with
    | O => S O
    | S p => mult base (exp base p)
  end.

(** **** Exercise: 1 star (factorial)  *)
(** Recall the standard mathematical factorial function:

       factorial(0)  =  1
       factorial(n)  =  n * factorial(n-1)     (if n>0)

    Translate this into Coq. *)

Fixpoint factorial (n:nat) : nat
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.

Example test_factorial1:          (factorial 3) = 6.
(* FILL IN HERE *) Admitted.
Example test_factorial2:          (factorial 5) = (mult 10 12).
(* FILL IN HERE *) Admitted.
(** [] *)

Notation "x + y" := (plus x y)
                       (at level 50, left associativity)
                       : nat_scope.
Notation "x - y" := (minus x y)
                       (at level 50, left associativity)
                       : nat_scope.
Notation "x * y" := (mult x y)
                       (at level 40, left associativity)
                       : nat_scope.

Check ((0 + 1) + 1).

Fixpoint beq_nat (n m : nat) : bool :=
  match n with
  | O => match m with
         | O => true
         | S m' => false
         end
  | S n' => match m with
            | O => false
            | S m' => beq_nat n' m'
            end
  end.

Fixpoint leb (n m : nat) : bool :=
  match n with
  | O => true
  | S n' =>
      match m with
      | O => false
      | S m' => leb n' m'
      end
  end.

Example test_leb1:             (leb 2 2) = true.
Proof. simpl. reflexivity.  Qed.
Example test_leb2:             (leb 2 4) = true.
Proof. simpl. reflexivity.  Qed.
Example test_leb3:             (leb 4 2) = false.
Proof. simpl. reflexivity.  Qed.

(** **** Exercise: 1 star (blt_nat)  *)
(** The [blt_nat] function tests [nat]ural numbers for [l]ess-[t]han,
    yielding a [b]oolean.  Instead of making up a new [Fixpoint] for
    this one, define it in terms of a previously defined function. *)

Definition blt_nat (n m : nat) : bool
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.

Example test_blt_nat1:             (blt_nat 2 2) = false.
(* FILL IN HERE *) Admitted.
Example test_blt_nat2:             (blt_nat 2 4) = true.
(* FILL IN HERE *) Admitted.
Example test_blt_nat3:             (blt_nat 4 2) = false.
(* FILL IN HERE *) Admitted.
(** [] *)

(* ################################################################# *)
(** * Proof by Simplification *)

Theorem plus_O_n : forall n : nat, 0 + n = n.
Proof.
  intros n. simpl. reflexivity.  Qed.

Theorem plus_O_n' : forall n : nat, 0 + n = n.
Proof.
  intros n. reflexivity. Qed.

Theorem plus_1_l : forall n:nat, 1 + n = S n.
Proof.
  intros n. reflexivity.  Qed.

Theorem mult_0_l : forall n:nat, 0 * n = 0.
Proof.
  intros n. reflexivity.  Qed.

(* ################################################################# *)
(** * Proof by Rewriting *)

Theorem plus_id_example : forall n m:nat,
  n = m ->
  n + n = m + m.

Proof.
  (* move both quantifiers into the context: *)
  intros n m.
  (* move the hypothesis into the context: *)
  intros H.
  (* rewrite the goal using the hypothesis: *)
  rewrite -> H.
  reflexivity.  Qed.

Theorem mult_0_plus : forall n m : nat,
  (0 + n) * m = n * m.

Proof.
  intros n m.
  rewrite -> plus_O_n.
  reflexivity.  Qed.

(** **** Exercise: 1 star (plus_id_exercise)  *)
(** Remove "[Admitted.]" and fill in the proof. *)

Theorem plus_id_exercise : forall n m o : nat,
  n = m -> m = o -> n + m = m + o.
Proof.
  intros n m o.
  intros H J.
  rewrite -> H.
  rewrite <- J.
  reflexivity.  Qed.

(** **** Exercise: 2 stars (mult_S_1)  *)
Theorem mult_S_1 : forall n m : nat,
  m = S n ->
  m * (1 + n) = m * m.
Proof.
  intros n m.
  intros H.
  rewrite -> H.
  reflexivity.  Qed.

(* ################################################################# *)
(** * Proof by Case Analysis *)

Theorem plus_1_neq_0_firsttry : forall n : nat,
  beq_nat (n + 1) 0 = false.
Proof.
  intros n.
  simpl.  (* does nothing! *)
Abort.

Theorem plus_1_neq_0 : forall n : nat,
  beq_nat (n + 1) 0 = false.
Proof.
  intros n. destruct n as [| n'].
  - reflexivity.
  - reflexivity.   Qed.

Theorem negb_involutive : forall b : bool,
  negb (negb b) = b.
Proof.
  intros b. destruct b.
  - reflexivity.
  - reflexivity.  Qed.

Theorem andb_commutative : forall b c, andb b c = andb c b.
Proof.
  intros b c. destruct b.
  - destruct c.
    + reflexivity.
    + reflexivity.
  - destruct c.
    + reflexivity.
    + reflexivity.
Qed.

Theorem andb_commutative' : forall b c, andb b c = andb c b.
Proof.
  intros b c. destruct b.
  { destruct c.
    { reflexivity. }
    { reflexivity. } }
  { destruct c.
    { reflexivity. }
    { reflexivity. } }
Qed.

Theorem andb3_exchange :
  forall b c d, andb (andb b c) d = andb (andb b d) c.
Proof.
  intros b c d. destruct b.
  - destruct c.
    { destruct d.
      - reflexivity.
      - reflexivity. }
    { destruct d.
      - reflexivity.
      - reflexivity. }
  - destruct c.
    { destruct d.
      - reflexivity.
      - reflexivity. }
    { destruct d.
      - reflexivity.
      - reflexivity. }
Qed.

Theorem plus_1_neq_0' : forall n : nat,
  beq_nat (n + 1) 0 = false.
Proof.
  intros [|n].
  - reflexivity.
  - reflexivity.  Qed.

Theorem andb_commutative'' :
  forall b c, andb b c = andb c b.
Proof.
  intros [] [].
  - reflexivity.
  - reflexivity.
  - reflexivity.
  - reflexivity.
Qed.

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

Theorem andb_true_elim2 : forall b c : bool,
  andb b c = true -> c = true.
Proof.
intros b c. intros H. destruct c.  - reflexivity.  - destruct b.    + simpl in H.    rewrite -> H.    reflexivity.    + simpl in H.    rewrite -> H.    reflexivity.  Qed.

(** [] *)

(** **** Exercise: 1 star (zero_nbeq_plus_1)  *)
Theorem zero_nbeq_plus_1 : forall n : nat,
  beq_nat 0 (n + 1) = false.
Proof.
  intros [|n].
  reflexivity.
  reflexivity.
  Qed.