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.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.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').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').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).