intros; subst; auto; destruct x'; auto.
Qed.
Ltac derive_morph :=
repeat
first [ lazymatch goal with
| |- Proper _ _ => red; intros
| |- (_ ==> _)%signature _ _ => red; intros
end
| apply respectful_red; intros
| apply respectful_if_bool; intros
| match goal with
| [ H : (_ ==> ?EQ)%signature ?F ?F' |- ?EQ (?F _) (?F' _) ] =>
apply H
| [ |- ?EQ (?F _) (?F _) ] =>
let inst := constr:(_ : Proper (_ ==> EQ) F) in
apply inst
| [ H : (_ ==> _ ==> ?EQ)%signature ?F ?F' |- ?EQ (?F _ _) (?F' _ _) ] =>
apply H
| [ |- ?EQ (?F _ _) (?F' _ _) ] =>
let inst := constr:(_ : Proper (_ ==> _ ==> EQ) F) in
apply inst
| [ |- ?EQ (?F _ _ _) (?F _ _ _) ] =>
let inst := constr:(_ : Proper (_ ==> _ ==> _ ==> EQ) F) in
apply inst
| [ |- ?EQ (?F _) (?F _) ] => unfold F
| [ |- ?EQ (?F _ _) (?F _ _) ] => unfold F
| [ |- ?EQ (?F _ _ _) (?F _ _ _) ] => unfold F
end ].
Global Instance Proper_andb : Proper (@eq bool ==> @eq bool ==> @eq bool) andb.
derive_morph; auto.
Qed.
Section K.
Variable F : bool -> bool -> bool.
Hypothesis Fproper : Proper (@eq bool ==> @eq bool ==> @eq bool) F.
Existing Instance Fproper.
Definition food (x y z : bool) : bool :=
F x (F y z).
Global Instance Proper_food : Proper (@eq bool ==> @eq bool ==> @eq bool ==> @eq bool) food.
Global Instance Proper_S : Proper (@eq nat ==> @eq nat) S.
End K.
Section Map.
Variable T : Type.
Variable eqT : relation T.
Inductive listEq {T} (eqT : relation T) : relation (list T) :=
| listEq_nil : listEq eqT nil nil
| listEq_cons : forall x x' y y', eqT x x' -> listEq eqT y y' ->listEq eqT (x :: y) (x' :: y').

Theorem listEq_match V U (eqV : relation V) (eqU : relation U) : forall x x' : list V,
forall X X' Y Y',
eqU X X' ->
(eqV ==> listEq eqV ==> eqU)%signature Y Y' ->
listEq eqV x x' ->
eqU (match x with
| nil => X
| x :: xs => Y x xs
end)
(match x' with
| nil => X'
| x :: xs => Y' x xs
end).