Ltac bool_eq :=
  match goal with
  | [ |- ?A -> ?A -> bool ] =>
      let f := fresh "rec" in let x := fresh "x" in let y := fresh "y" in
      fix f 1; intros x y; change (bool_eq x y); destruct x, y; bool_eq_case
  | [ |- _ -> _ ] =>
      let eq := fresh "eq" in intro eq; bool_eq
  end.Ltac bool_eq_base x y :=
  change (bool_eq x y);
  match goal with
  | [ H: forall (x y: ?A), bool |- @bool_eq ?A x y ] => exact (H x y)
  | [ H: forall (x y: ?A), {x=y} + {x<>y}  |- @bool_eq ?A x y ] => exact (proj_sumbool (H x y))
  | _ => idtac
  end.Ltac bool_eq_case :=
  match goal with
  | |- bool_eq (?C ?x1 ?x2 ?x3 ?x4) (?C ?y1 ?y2 ?y3 ?y4) =>
         refine (_ && _ && _ && _); [bool_eq_base x1 y1|bool_eq_base x2 y2|bool_eq_base x3 y3|bool_eq_base x4 y4]
  | |- bool_eq (?C ?x1 ?x2 ?x3) (?C ?y1 ?y2 ?y3) =>
         refine (_ && _ && _); [bool_eq_base x1 y1|bool_eq_base x2 y2|bool_eq_base x3 y3]
  | |- bool_eq (?C ?x1 ?x2) (?C ?y1 ?y2) =>
         refine (_ && _); [bool_eq_base x1 y1|bool_eq_base x2 y2]
  | |- bool_eq (?C ?x1) (?C ?y1) => bool_eq_base x1 y1
  | |- bool_eq ?C ?C => exact true
  | |- bool_eq _ _ => exact false
  end.

(* Specifications: *)
Lemma proj_sumbool_is_true: forall (A: Type) (f: forall (x y: A), {x=y} + {x<>y}) (x: A), proj_sumbool (f x x) = true.