Module BE.
Definition bool_eq {A: Type} (x y: A) : Type := bool.
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.
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_refl_case :=
match goal with
| [ |- true = true ] => reflexivity
| [ |- proj_sumbool _ = true ] => apply proj_sumbool_is_true
| [ |- _ && _ = true ] => apply andb_true_iff; split; bool_eq_refl_case
| _ => auto
end.
Ltac bool_eq_refl :=
let H := fresh "Hrec" in let x := fresh "x" in
fix H 1; intros x; destruct x; simpl; bool_eq_refl_case.

Lemma proj_sumbool_true:
forall (A: Type) (x y: A) (a: {x=y} + {x<>y}),
proj_sumbool a = true -> x = y.