Load loadpath.
Definition StrictCompSpec {A} (eq lt: A -> A -> Prop)
(cmp: A -> A -> comparison) :=
StrictOrder lt /\ forall x y, CompSpec eq lt x y (cmp x y).
Definition CompSpec' {A} (cmp: A -> A -> comparison) :=
StrictCompSpec (@Logic.eq A) (fun x y => Lt = cmp x y) cmp.
Ltac do_comp cspec x y := destruct (CompSpec2Type (proj2 cspec x y)).
Definition isGe (c: comparison) := match c with Lt => False | _ => True end.
Definition isGeq cc := match cc with Lt => false | _ => true end.
Fixpoint insert {A: Type} (cmp: A -> A -> comparison) (a: A) (l: list A)
: list A:=
match l with
| h :: t => if isGeq (cmp a h)
then a :: l
else h :: (insert cmp a t)
| nil => a :: nil
end.
Fixpoint rsort {A: Type} (cmp: A -> A -> comparison) (l: list A) : list A :=
match l with nil => nil | h::t => insert cmp h (rsort cmp t)
end.
Fixpoint insert_uniq {A: Type} (cmp: A -> A -> comparison) (a: A) (l: list A)
: list A:=
match l with
| h :: t => match cmp a h with
| Eq => l
| Gt => a :: l
| Lt => h :: (insert_uniq cmp a t)
end
| nil => a::nil
end.
Fixpoint rsort_uniq {A: Type} (cmp: A -> A -> comparison) (l: list A)
: list A :=
match l with nil => nil | h::t => insert_uniq cmp h (rsort_uniq cmp t)
end.
Proof with auto.
induction l; simpl; auto.
destruct (isGeq (cmp a a0)); try repeat constructor.
apply Permutation_refl.
apply Permutation_sym; apply Permutation_trans with (l' := a0 :: a :: l).
apply perm_swap. constructor; apply Permutation_sym...
Qed.
Fixpoint compare_list {A: Type} (f: A -> A -> comparison) (xl yl : list A)
: comparison :=
match xl , yl with
| x :: xl', y :: yl' => match f x y with
| Eq => compare_list f xl' yl'
| c => c
end
| nil , _ :: _ => Lt
| _ :: _ , nil => Gt
| nil, nil => Eq
end.
Hint Resolve @list_cspec.

Lemma Forall_sortu:
forall  {A} (f: A -> Prop) (cmp: A -> A -> comparison) l,
Forall f l -> Forall f  (rsort_uniq cmp l).