Parameter A : Set.
Inductive set : Set :=
| Empty : set
| Add : A -> set -> set.
Fixpoint In (a : A) (s : set) {struct s} : Prop :=
match s with
| Empty => False
| Add b s' => a = b \/ In a s'
end.
Definition same (s t : set) : Prop := forall a : A, In a s <-> In a t.
unfold same; split ; red.
red; auto.
red.
intros.
elim (H a); auto.
intros.
elim (H a); elim (H0 a).
split; auto.
Qed.
Add Setoid set same setoid_set as setsetoid.
Add Morphism In with signature (eq ==> same ==> iff) as In_ext.
unfold same; simple induction 2; intros.
rewrite H1.
simpl; left; reflexivity.
elim (H a).
intros.
simpl; right.
apply (H2 H1).
Qed.
Add Morphism Add with signature (eq ==> same ==> same) as Add_ext.
split; apply add_aux.
assumption.
rewrite H.
reflexivity.
Qed.
Fixpoint remove (a : A) (s : set) {struct s} : set :=
match s with
| Empty => Empty
| Add b t =>
match eq_dec a b with
| left _ => remove a t
| right _ => Add b (remove a t)
end
end.
intros.
setoid_replace (remove a (Add a Empty)) with Empty.
auto.
unfold same.
split.
simpl.
case (eq_dec a a).
intros e ff; elim ff.
intros; absurd (a = a); trivial.
simpl.
intro H; elim H.
Qed.
Parameter P : set -> Prop.
Parameter P_ext : forall s t : set, same s t -> P s -> P t.
Add Morphism P with signature (same ==> iff) as P_extt.
intros; split; apply P_ext; (assumption || apply (Seq_sym _ _ setoid_set); assumption).
Qed.

Lemma test_rewrite :
forall (a : A) (s t : set), same s t -> P (Add a s) -> P (Add a t).