(* week-06_soundness-and-completeness-of-equality-predicates.v *)
(* LPP 2024 - CS3234 2023-2024, Sem2 *)
(* Olivier Danvy <danvy@yale-nus.edu.sg> *)
(* Version of 22 Feb 2024 *)

(* ********** *)

(* Paraphernalia: *)

Ltac fold_unfold_tactic name := intros; unfold name; fold name; reflexivity.

Require Import Arith Bool.

(* ********** *)

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

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

Search (eqb _ _ = true -> _ = _).
(* eqb_prop: forall a b : bool, eqb a b = true -> a = b *)

Search (eqb _ _ = true).
(* eqb_reflx: forall b : bool, eqb b b = true *)

Theorem soundness_of_equality_over_booleans :
  forall b1 b2 : bool,
    eqb b1 b2 = true -> b1 = b2.
Proof.
  exact eqb_prop.

  Restart.

  intros [ | ] [ | ].
  - intros _.
    reflexivity.
  - unfold eqb.
    intro H_absurd.
    discriminate H_absurd.
  - unfold eqb.
    intro H_absurd.
    exact H_absurd.
  - intros _.
    reflexivity.
Qed.

Theorem completeness_of_equality_over_booleans :
  forall b1 b2 : bool,
    b1 = b2 -> eqb b1 b2 = true.
Proof.
  intros b1 b2 H_b1_b2.
  rewrite <- H_b1_b2.
  Search (eqb _ _ = true).
  Check (eqb_reflx b1).
  exact (eqb_reflx b1).

  Restart.

  intros [ | ] [ | ].
  - intros _.
    unfold eqb.
    reflexivity.
  - intros H_absurd.
    discriminate H_absurd.
  - intros H_absurd.
    discriminate H_absurd.
  - intros _.
    unfold eqb.
    reflexivity.
Qed.

Corollary soundness_of_equality_over_booleans_the_remaining_case :
  forall b1 b2 : bool,
    eqb b1 b2 = false -> b1 <> b2.
Proof.
  intros b1 b2 H_eqb_b1_b2.
  unfold not.
  intros H_eq_b1_b2.
  Check (completeness_of_equality_over_booleans b1 b2 H_eq_b1_b2).
  rewrite -> (completeness_of_equality_over_booleans b1 b2 H_eq_b1_b2) in H_eqb_b1_b2.
  discriminate H_eqb_b1_b2.
Qed.

Corollary completeness_of_equality_over_booleans_the_remaining_case :
  forall b1 b2 : bool,
    b1 <> b2 -> eqb b1 b2 = false.
Proof.
  intros b1 b2 H_neq_b1_b2.
  unfold not in H_neq_b1_b2.
  Search (not (_ = true) -> _ = false).
  Check (not_true_is_false (eqb b1 b2)).
  apply (not_true_is_false (eqb b1 b2)).
  unfold not.
  intro H_eqb_b1_b2.
  Check (soundness_of_equality_over_booleans b1 b2 H_eqb_b1_b2).
  Check (H_neq_b1_b2 (soundness_of_equality_over_booleans b1 b2 H_eqb_b1_b2)).
  contradiction (H_neq_b1_b2 (soundness_of_equality_over_booleans b1 b2 H_eqb_b1_b2)).
(* Or alternatively:
  exact (H_neq_b1_b2 (soundness_of_equality_over_booleans b1 b2 H_eqb_b1_b2)).
*)
Qed. 

Check Bool.eqb_eq.
(* eqb_eq : forall x y : bool, Is_true (eqb x y) -> x = y *)

Search (eqb _ _ = true).
(* eqb_true_iff: forall a b : bool, eqb a b = true <-> a = b *)

Theorem soundness_and_completeness_of_equality_over_booleans :
  forall b1 b2 : bool,
    eqb b1 b2 = true <-> b1 = b2.
Proof.
  exact eqb_true_iff.

  Restart.

  intros b1 b2.
  split.
  - exact (soundness_of_equality_over_booleans b1 b2).
  - exact (completeness_of_equality_over_booleans b1 b2).
Qed.

(* ***** *)

(* user-defined: *)

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

Theorem soundness_of_eqb_bool :
  forall b1 b2 : bool,
    eqb_bool b1 b2 = true ->
    b1 = b2.
Proof.
  intros [ | ] [ | ].
  - intros _.
    reflexivity.
  - unfold eqb_bool.
    intros H_absurd.
    discriminate H_absurd.
  - unfold eqb_bool.
    intros H_absurd.
    exact H_absurd.
  - intros _.
    reflexivity.
Qed.

Theorem completeness_of_eqb_bool :
  forall b1 b2 : bool,
    b1 = b2 ->
    eqb_bool b1 b2 = true.
Proof.
  intros [ | ] [ | ].
  - intros _.
    reflexivity.
  - intros H_absurd.
    discriminate H_absurd.
  - intros H_absurd.
    unfold eqb_bool.
    exact H_absurd.
  - intros _.
    unfold eqb_bool.
    reflexivity.
Qed.

(* ********** *)

Check Nat.eqb. (* : nat -> nat -> bool *)

Check beq_nat. (* : nat -> nat -> bool *)

Search (beq_nat _ _ = true -> _ = _).
(* beq_nat_true: forall n m : nat, (n =? m) = true -> n = m *)

Search (beq_nat _ _ = true).

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

Theorem soundness_and_completeness_of_equality_over_natural_numbers :
  forall n1 n2 : nat,
    n1 =? n2 = true <-> n1 = n2.
Proof.
  exact Nat.eqb_eq.
Qed.

(* ***** *)

(* user-defined: *)

Fixpoint eqb_nat (n1 n2 : nat) : bool :=
  match n1 with
    O =>
    match n2 with
      O =>
      true
    | S n2' =>
      false
    end
  | S n1' =>
    match n2 with
      O =>
      false
    | S n2' =>
      eqb_nat n1' n2'
    end
  end.

Lemma fold_unfold_eqb_nat_O :
  forall n2 : nat,
    eqb_nat O n2 =
    match n2 with
      O =>
      true
    | S n2' =>
      false
    end.
Proof.
  fold_unfold_tactic eqb_nat.
Qed.

Lemma fold_unfold_eqb_nat_S :
  forall n1' n2 : nat,
    eqb_nat (S n1') n2 =
    match n2 with
      O =>
      false
    | S n2' =>
      eqb_nat n1' n2'
    end.
Proof.
  fold_unfold_tactic eqb_nat.
Qed.

Theorem soundness_of_eqb_nat :
  forall n1 n2 : nat,
    eqb_nat n1 n2 = true ->
    n1 = n2.
Proof.
  intro n1.
  induction n1 as [ | n1' IHn1'].
  - intros [ | n2'].
    + intros _.
      reflexivity.
    + rewrite -> fold_unfold_eqb_nat_O.
      intro H_absurd.
      discriminate H_absurd.
  - intros [ | n2'].
    + rewrite -> fold_unfold_eqb_nat_S.
      intro H_absurd.
      discriminate H_absurd.
    + rewrite -> fold_unfold_eqb_nat_S.
      intro H_n1'_n2'.
      Check (IHn1' n2' H_n1'_n2').
      rewrite -> (IHn1' n2' H_n1'_n2').
      reflexivity.
Qed.

Theorem completeness_of_eqb_nat :
  forall n1 n2 : nat,
    n1 = n2 ->
    eqb_nat n1 n2 = true.
Proof.
  intro n1.
  induction n1 as [ | n1' IHn1'].
  - intros [ | n2'].
    + intros _.
      rewrite -> fold_unfold_eqb_nat_O.
      reflexivity.
    + intro H_absurd.
      discriminate H_absurd.
  - intros [ | n2'].
    + intro H_absurd.
      discriminate H_absurd.
    + rewrite -> fold_unfold_eqb_nat_S.
      intro H_Sn1'_Sn2'.
      injection H_Sn1'_Sn2' as H_n1'_n2'.
      Check (IHn1' n2' H_n1'_n2').
      rewrite -> (IHn1' n2' H_n1'_n2').
      reflexivity.
Qed.

(* ********** *)

Lemma from_one_equivalence_to_two_implications :
  forall (V : Type)
         (eqb_V : V -> V -> bool),
    (forall v1 v2 : V,
        eqb_V v1 v2 = true <-> v1 = v2) ->
    (forall v1 v2 : V,
        eqb_V v1 v2 = true -> v1 = v2)
    /\
    (forall v1 v2 : V,
        v1 = v2 -> eqb_V v1 v2 = true).
Proof.
  intros V eqb_V H_eqv.
  split.
  - intros v1 v2 H_eqb.
    destruct (H_eqv v1 v2) as [H_key _].
    exact (H_key H_eqb).
  - intros v1 v2 H_eq.
    destruct (H_eqv v1 v2) as [_ H_key].
    exact (H_key H_eq).
Qed.

(* ********** *)

Definition eqb_option (V : Type) (eqb_V : V -> V -> bool) (ov1 ov2 : option V) : bool :=
  match ov1 with
    Some v1 =>
    match ov2 with
      Some v2 =>
      eqb_V v1 v2
    | None =>
      false
    end
  | None =>
    match ov2 with
      Some v2 =>
      false
    | None =>
      true
    end
  end.

Theorem soundness_of_equality_over_optional_values :
  forall (V : Type)
         (eqb_V : V -> V -> bool),
    (forall v1 v2 : V,
        eqb_V v1 v2 = true -> v1 = v2) ->
    forall ov1 ov2 : option V,
      eqb_option V eqb_V ov1 ov2 = true ->
      ov1 = ov2.
Proof.
  intros V eqb_V S_eqb_V [v1 | ] [v2 | ] H_eqb.
  - unfold eqb_option in H_eqb.
    Check (S_eqb_V v1 v2 H_eqb).
    rewrite -> (S_eqb_V v1 v2 H_eqb).
    reflexivity.
  - unfold eqb_option in H_eqb.
    discriminate H_eqb.
  - unfold eqb_option in H_eqb.
    discriminate H_eqb.
  - reflexivity.
Qed.

Theorem completeness_of_equality_over_optional_values :
  forall (V : Type)
         (eqb_V : V -> V -> bool),
    (forall v1 v2 : V,
        v1 = v2 -> eqb_V v1 v2 = true) ->
    forall ov1 ov2 : option V,
      ov1 = ov2 ->
      eqb_option V eqb_V ov1 ov2 = true.
Proof.
  intros V eqb_V C_eqb_V ov1 ov2 H_eq.
  rewrite -> H_eq.
  case ov1 as [v1 | ].
  - case ov2 as [v2 | ].
    -- unfold eqb_option.
       Check (eq_refl v2).
       Check (C_eqb_V v2 v2 (eq_refl v2)).
       exact (C_eqb_V v2 v2 (eq_refl v2)).
    -- discriminate H_eq.
  - case ov2 as [v2 | ].
    -- discriminate H_eq.
    -- unfold eqb_option.
       reflexivity.
Qed.

Theorem soundness_and_completeness_of_equality_over_optional_values :
  forall (V : Type)
         (eqb_V : V -> V -> bool),
    (forall v1 v2 : V,
        eqb_V v1 v2 = true <-> v1 = v2) ->
    forall ov1 ov2 : option V,
      eqb_option V eqb_V ov1 ov2 = true <-> ov1 = ov2.
Proof.
  intros V eqb_V SC_eqb_V.
  Check (from_one_equivalence_to_two_implications V eqb_V SC_eqb_V).
  destruct (from_one_equivalence_to_two_implications V eqb_V SC_eqb_V) as [S_eqb_V C_eqb_V].
  intros ov1 ov2.
  split.
  - exact (soundness_of_equality_over_optional_values V eqb_V S_eqb_V ov1 ov2).
  - exact (completeness_of_equality_over_optional_values V eqb_V C_eqb_V ov1 ov2).
Qed.

(* ********** *)

Definition eqb_pair (V : Type) (eqb_V : V -> V -> bool) (W : Type) (eqb_W : W -> W -> bool) (p1 p2 : V * W) : bool :=
  let (v1, w1) := p1 in
  let (v2, w2) := p2 in
  eqb_V v1 v2 && eqb_W w1 w2.

Theorem soundness_of_equality_over_pairs :
  forall (V : Type)
         (eqb_V : V -> V -> bool),
    (forall v1 v2 : V,
        eqb_V v1 v2 = true -> v1 = v2) ->
    forall (W : Type)
           (eqb_W : W -> W -> bool),
      (forall w1 w2 : W,
          eqb_W w1 w2 = true -> w1 = w2) ->
      forall p1 p2 : V * W,
        eqb_pair V eqb_V W eqb_W p1 p2 = true ->
        p1 = p2.
Proof.
  intros V eqb_V S_eqb_V W eqb_W S_eqb_W [v1 w1] [v2 w2] H_eqb.
  unfold eqb_pair in H_eqb.
  Search (_ && _ = true -> _ /\ _).
  Check (andb_prop (eqb_V v1 v2) (eqb_W w1 w2)).
  Check (andb_prop (eqb_V v1 v2) (eqb_W w1 w2) H_eqb).
  destruct (andb_prop (eqb_V v1 v2) (eqb_W w1 w2) H_eqb) as [H_eqb_V H_eqb_W].
  Check (S_eqb_V v1 v2 H_eqb_V).
  rewrite -> (S_eqb_V v1 v2 H_eqb_V).
  rewrite -> (S_eqb_W w1 w2 H_eqb_W).
  reflexivity.
Qed.

Theorem completeness_of_equality_over_pairs :
  forall (V : Type)
         (eqb_V : V -> V -> bool),
    (forall v1 v2 : V,
        v1 = v2 -> eqb_V v1 v2 = true) ->
    forall (W : Type)
           (eqb_W : W -> W -> bool),
      (forall w1 w2 : W,
          w1 = w2 -> eqb_W w1 w2 = true) ->
      forall p1 p2 : V * W,
        p1 = p2 ->
        eqb_pair V eqb_V W eqb_W p1 p2 = true.
Proof.
  intros V eqb_V S_eqb_V W eqb_W S_eqb_W [v1 w1] [v2 w2] H_eq.
  unfold eqb_pair.
  injection H_eq as H_eq_V H_eq_W.
  Check (S_eqb_V v1 v2 H_eq_V).
  rewrite -> (S_eqb_V v1 v2 H_eq_V).
  rewrite -> (S_eqb_W w1 w2 H_eq_W).
  unfold andb.
  reflexivity.
Qed.

Theorem soundness_and_completeness_of_equality_over_pairs :
  forall (V : Type)
         (eqb_V : V -> V -> bool),
    (forall v1 v2 : V,
        eqb_V v1 v2 = true <-> v1 = v2) ->
    forall (W : Type)
           (eqb_W : W -> W -> bool),
      (forall w1 w2 : W,
          eqb_W w1 w2 = true <-> w1 = w2) ->
      forall p1 p2 : V * W,
        eqb_pair V eqb_V W eqb_W p1 p2 = true <-> p1 = p2.
Proof.
  intros V eqb_V SC_eqb_V.
  Check (from_one_equivalence_to_two_implications V eqb_V SC_eqb_V).
  destruct (from_one_equivalence_to_two_implications V eqb_V SC_eqb_V) as [S_eqb_V C_eqb_V].
  intros W eqb_W SC_eqb_W.
  Check (from_one_equivalence_to_two_implications W eqb_W SC_eqb_W).
  destruct (from_one_equivalence_to_two_implications W eqb_W SC_eqb_W) as [S_eqb_W C_eqb_W].
  intros p1 p2.
  split.
  - exact (soundness_of_equality_over_pairs V eqb_V S_eqb_V W eqb_W S_eqb_W p1 p2).
  - exact (completeness_of_equality_over_pairs V eqb_V C_eqb_V W eqb_W C_eqb_W p1 p2).
Qed.

(* ********** *)

Inductive binary_tree (V : Type) : Type :=
  Leaf : V -> binary_tree V
| Node : binary_tree V -> binary_tree V -> binary_tree V.

Fixpoint eqb_binary_tree (V : Type) (eqb_V : V -> V -> bool) (t1 t2 : binary_tree V) : bool :=
  match t1 with
    Leaf _ v1 =>
    match t2 with
      Leaf _ v2 =>
      eqb_V v1 v2
    | Node _ t11 t12 =>
      false
    end
  | Node _ t11 t12 =>
    match t2 with
      Leaf _ v2 =>
      false
    | Node _ t21 t22 =>
      eqb_binary_tree V eqb_V t11 t21
      &&
      eqb_binary_tree V eqb_V t12 t22
    end
  end.

Lemma fold_unfold_eqb_binary_tree_Leaf :
  forall (V : Type)
         (eqb_V : V -> V -> bool)
         (v1 : V)
         (t2 : binary_tree V),
    eqb_binary_tree V eqb_V (Leaf V v1) t2 =
    match t2 with
      Leaf _ v2 =>
      eqb_V v1 v2
    | Node _ t11 t12 =>
      false
    end.
Proof.
  fold_unfold_tactic eqb_binary_tree.
Qed.

Lemma fold_unfold_eqb_binary_tree_Node :
  forall (V : Type)
         (eqb_V : V -> V -> bool)
         (t11 t12 t2 : binary_tree V),
    eqb_binary_tree V eqb_V (Node V t11 t12) t2 =
    match t2 with
      Leaf _ v2 =>
      false
    | Node _ t21 t22 =>
      eqb_binary_tree V eqb_V t11 t21
      &&
      eqb_binary_tree V eqb_V t12 t22
    end.
Proof.
  fold_unfold_tactic eqb_binary_tree.
Qed.

Theorem soundness_of_equality_over_binary_trees :
  forall (V : Type)
         (eqb_V : V -> V -> bool),
    (forall v1 v2 : V,
        eqb_V v1 v2 = true -> v1 = v2) ->
    forall t1 t2 : binary_tree V,
      eqb_binary_tree V eqb_V t1 t2 = true ->
      t1 = t2.
Proof.
  intros V eqb_V S_eqb_V t1.
  induction t1 as [v1 | t11 IHt11 t12 IHt12].
  - intros [v2 | t21 t22] H_eqb.
    -- rewrite -> (fold_unfold_eqb_binary_tree_Leaf V eqb_V v1 (Leaf V v2)) in H_eqb.
       Check (S_eqb_V v1 v2 H_eqb).
       rewrite -> (S_eqb_V v1 v2 H_eqb).
       reflexivity.
    -- rewrite -> (fold_unfold_eqb_binary_tree_Leaf V eqb_V v1 (Node V t21 t22)) in H_eqb.
       discriminate H_eqb.
  - intros [v2 | t21 t22] H_eqb.
    -- rewrite -> (fold_unfold_eqb_binary_tree_Node V eqb_V t11 t12 (Leaf V v2)) in H_eqb.
       discriminate H_eqb.
    -- rewrite -> (fold_unfold_eqb_binary_tree_Node V eqb_V t11 t12 (Node V t21 t22)) in H_eqb.
       Search (_ && _ = true -> _ /\ _).
       Check (andb_prop (eqb_binary_tree V eqb_V t11 t21) (eqb_binary_tree V eqb_V t12 t22)).
       Check (andb_prop (eqb_binary_tree V eqb_V t11 t21) (eqb_binary_tree V eqb_V t12 t22) H_eqb).
       destruct (andb_prop (eqb_binary_tree V eqb_V t11 t21) (eqb_binary_tree V eqb_V t12 t22) H_eqb) as [H_eqb_1 H_eqb_2].
       Check (IHt11 t21 H_eqb_1).
       rewrite -> (IHt11 t21 H_eqb_1).
       rewrite -> (IHt12 t22 H_eqb_2).
       reflexivity.
Qed.

Theorem completeness_of_equality_over_binary_trees :
  forall (V : Type)
         (eqb_V : V -> V -> bool),
    (forall v1 v2 : V,
        v1 = v2 -> eqb_V v1 v2 = true) ->
    forall t1 t2 : binary_tree V,
      t1 = t2 ->
      eqb_binary_tree V eqb_V t1 t2 = true.
Proof.
  intros V eqb_V C_eqb_V t1.
  induction t1 as [v1 | t11 IHt11 t12 IHt12].
  - intros [v2 | t21 t22] H_eq.
    -- rewrite -> (fold_unfold_eqb_binary_tree_Leaf V eqb_V v1 (Leaf V v2)).
       injection H_eq as H_eq_V.
       Check (C_eqb_V v1 v2).
       Check (C_eqb_V v1 v2 H_eq_V).
       exact (C_eqb_V v1 v2 H_eq_V).
    -- discriminate H_eq.
  - intros [v2 | t21 t22] H_eq.
    -- discriminate H_eq.
    -- rewrite -> (fold_unfold_eqb_binary_tree_Node V eqb_V t11 t12 (Node V t21 t22)).
       injection H_eq as H_eq_1 H_eq_2.
       Check (IHt11 t21 H_eq_1).
       rewrite -> (IHt11 t21 H_eq_1).
       Search (true && _ = _).
       rewrite -> (andb_true_l (eqb_binary_tree V eqb_V t12 t22)).
       exact (IHt12 t22 H_eq_2).
Qed.

Theorem soundness_and_completeness_of_equality_over_binary_trees :
  forall (V : Type)
         (eqb_V : V -> V -> bool),
    (forall v1 v2 : V,
        eqb_V v1 v2 = true <-> v1 = v2) ->
    forall t1 t2 : binary_tree V,
      eqb_binary_tree V eqb_V t1 t2 = true <-> t1 = t2.
Proof.
  intros V eqb_V SC_eqb_V t1 t2.
  Check (from_one_equivalence_to_two_implications V eqb_V SC_eqb_V).
  destruct (from_one_equivalence_to_two_implications V eqb_V SC_eqb_V) as [S_eqb_V C_eqb_V].
  split.
  - exact (soundness_of_equality_over_binary_trees V eqb_V S_eqb_V t1 t2).
  - exact (completeness_of_equality_over_binary_trees V eqb_V C_eqb_V t1 t2).

  Restart.

  intros V eqb_V SC_eqb_V t1.
  induction t1 as [v1 | t11 IHt11 t12 IHt12].
  - intros [v2 | t21 t22].
    + rewrite -> (fold_unfold_eqb_binary_tree_Leaf V eqb_V v1 (Leaf V v2)).
      split.
      * intro H_eqb_V.
        destruct (from_one_equivalence_to_two_implications V eqb_V SC_eqb_V) as [S_eqb_V _].
        rewrite -> (S_eqb_V v1 v2 H_eqb_V).
        reflexivity.
      * intro H_eq.
        injection H_eq as H_eq.
        destruct (from_one_equivalence_to_two_implications V eqb_V SC_eqb_V) as [_ C_eqb_V].
        exact (C_eqb_V v1 v2 H_eq).
    + rewrite -> (fold_unfold_eqb_binary_tree_Leaf V eqb_V v1 (Node V t21 t22)).
      split.
      * intro H_absurd.
        discriminate H_absurd.
      * intro H_absurd.
        discriminate H_absurd.
  - intros [v2 | t21 t22].
    + rewrite -> (fold_unfold_eqb_binary_tree_Node V eqb_V t11 t12 (Leaf V v2)).
      split.
      * intro H_absurd.
        discriminate H_absurd.
      * intro H_absurd.
        discriminate H_absurd.
    + rewrite -> (fold_unfold_eqb_binary_tree_Node V eqb_V t11 t12 (Node V t21 t22)).
      split.
      * intro H_eqb.
        destruct (andb_prop (eqb_binary_tree V eqb_V t11 t21) (eqb_binary_tree V eqb_V t12 t22) H_eqb) as [H_eqb_1 H_eqb_2].
        destruct (IHt11 t21) as [H_key1 _].
        destruct (IHt12 t22) as [H_key2 _].
        rewrite -> (H_key1 H_eqb_1).
        rewrite -> (H_key2 H_eqb_2).
        reflexivity.
      * intro H_eq.
        injection H_eq as H_eq_1 H_eq_2.
        destruct (IHt11 t21) as [_ H_key1].
        destruct (IHt12 t22) as [_ H_key2].
        rewrite -> (H_key1 H_eq_1).
        rewrite -> (andb_true_l (eqb_binary_tree V eqb_V t12 t22)).
        exact (H_key2 H_eq_2).
Qed.        

(* ********** *)

(* pilfering from the String library: *)

Require Import String Ascii.

Print string.

Check "foo"%string.

Definition eqb_char (c1 c2 : ascii) : bool :=
  match c1 with
    Ascii b11 b12 b13 b14 b15 b16 b17 b18 =>
    match c2 with
      Ascii b21 b22 b23 b24 b25 b26 b27 b28 =>
      eqb_bool b11 b21 && eqb_bool b12 b22 && eqb_bool b13 b23 && eqb_bool b14 b24 && eqb_bool b15 b25 && eqb_bool b16 b26 && eqb_bool b17 b27 && eqb_bool b18 b28
    end
  end.

Proposition soundness_of_eqb_char :
  forall c1 c2 : ascii,
    eqb_char c1 c2 = true -> c1 = c2.
Proof.
Admitted.

Proposition completeness_of_eqb_char :
  forall c1 c2 : ascii,
    c1 = c2 -> eqb_char c1 c2 = true.
Proof.
Admitted.

Fixpoint eqb_string (c1s c2s : string) : bool :=
  match c1s with
    String.EmptyString =>
    match c2s with
      String.EmptyString =>
      true
    |  String.String c2 c2s' =>
      false
    end
  | String.String c1 c1s' =>
    match c2s with
      String.EmptyString =>
      true
    | String.String c2 c2s' =>
      eqb_char c1 c2 && eqb_string c1s' c2s'
    end
  end.

Lemma fold_unfold_eqb_string_Empty :
  forall c2s : string,
    eqb_string String.EmptyString c2s =
    match c2s with
      String.EmptyString =>
      true
    | String.String c2 c2s' =>
      false
    end.
Proof.
  fold_unfold_tactic eqb_string.
Qed.

Lemma fold_unfold_eqb_string_String :
  forall (c1 : ascii)
         (c1s' c2s : string),
    eqb_string (String.String c1 c1s') c2s =
    match c2s with
      String.EmptyString =>
      true
    | String.String c2 c2s' =>
      eqb_char c1 c2 && eqb_string c1s' c2s'
    end.
Proof.
  fold_unfold_tactic eqb_string.
Qed.

Proposition soundness_of_eqb_string :
  forall c1s c2s : string,
    eqb_string c1s c2s = true -> c1s = c2s.
Proof.
Admitted.

Proposition completeness_of_eqb_string :
  forall c1s c2s : string,
    c1s = c2s -> eqb_string c1s c2s = true.
Proof.
Admitted.

(* ********** *)

Inductive funky_tree : Type :=
  Nat : nat -> funky_tree
| Bool : bool -> funky_tree
| String : string -> funky_tree
| Singleton : funky_tree -> funky_tree
| Pair : funky_tree -> funky_tree -> funky_tree
| Triple : funky_tree -> funky_tree -> funky_tree -> funky_tree.

(* ***** *)

(* A silly proposition, just to get a feel about how to destructure a value of type funky_tree: *)

Proposition identity_over_funky_tree :
  forall e : funky_tree,
    e = e.
Proof.
  intro e.
  case e as [n | b | s | e1 | e1 e2 | e1 e2 e3] eqn:H_e.
  - reflexivity.
  - reflexivity.
  - reflexivity.
  - reflexivity.
  - reflexivity.
  - reflexivity.
Qed.

(* ***** *)

(* Exercise: implement eqb_funky_tree and prove its soundness and completeness. *)

(* ********** *)

(* end of week-06_soundness-and-completeness-of-equality-predicates.v *)