#[local] Ltac list_auto :=
repeat lazymatch goal with
| |- ?x = ?x =>
reflexivity
| H : ?xs = ?xs ++ _ |- _ =>
rewrite <-(app_nil_r xs) in H at 1
| H : ?xs ++ _ = ?xs |- _ =>
symmetry in H
| H : ?xs ++ _ = ?xs ++ _ |- _ =>
apply app_inv_head in H
| H : _ :: _ = _ :: _ |- _ =>
injection H; intros; clear H; subst
| H : [] = _ :: _ |- _ =>
inversion H
| H : cmp ?x ?x = Lt |- _ =>
rewrite (proj2 (Hcmp _ _) eq_refl) in H; discriminate
| H : cmp ?x ?x = Gt |- _ =>
rewrite (proj2 (Hcmp _ _) eq_refl) in H; discriminate
| H1 : ?p1 ++ _ :: _ = ?p2 ++ _ :: _,
H2 : ?p2 ++ _ :: _ = ?p1 ++ _ :: _ |- _ =>
symmetry in H2
| H1 : ?p1 ++ ?x1 :: ?xs1 = ?p2 ++ ?x2 :: ?xs2,
H2 : ?p1 ++ ?y1 :: ?ys1 = ?p2 ++ ?y2 :: ?ys2 |- _ =>
assert (p1 = p2) as Hp;
[ eapply (prefix_eq H1 H2); intros Heq; subst
| subst; apply app_inv_head in H1, H2 ]
| H : cmp ?x ?x = _ |- _ =>
rewrite (proj2 (Hcmp _ _) eq_refl) in H; try discriminate H
| H1 : cmp ?x1 ?x2 = _,
H2 : cmp ?x1 ?x2 = _ |- _ =>
rewrite H1 in H2; discriminate H2
| Htrans : forall (x y z : A) (c : comparison), cmp x y = c -> cmp y z = c -> cmp x z = c,
H1 : cmp ?x1 ?x2 = ?c,
H2 : cmp ?x2 ?x3 = ?c |- _ =>
pose proof (Htrans x1 x2 x3 c H1 H2); clear H1 H2
| Hcmp_opp : (forall x y, cmp y x = CompOpp (cmp x y)),
H1 : cmp ?x1 ?x2 = ?c, H2 : cmp ?x2 ?x1 = ?c |- _ =>
rewrite Hcmp_opp, H2 in H1; simpl in H1; discriminate H1
end.
Inductive ListCompareSpec (xs ys : list A) : forall (c : comparison), Prop :=
| ListCompareEq :
xs = ys ->
ListCompareSpec xs ys Eq
| ListCompareShorter y ys' :
ys = xs ++ y :: ys' ->
ListCompareSpec xs ys Lt
| ListCompareLonger x xs' :
xs = ys ++ x :: xs' ->
ListCompareSpec xs ys Gt
| ListCompareLt prefix x xs' y ys' :
xs = prefix ++ x :: xs' ->
ys = prefix ++ y :: ys' ->
cmp x y = Lt ->
ListCompareSpec xs ys Lt
| ListCompareGt prefix x xs' y ys' :
xs = prefix ++ x :: xs' ->
ys = prefix ++ y :: ys' ->
cmp x y = Gt ->
ListCompareSpec xs ys Gt.

(* Specifications: *)
Lemma list_compareP (xs ys : list A) :
ListCompareSpec xs ys (list_compare xs ys).
Lemma list_compare_refl (xs ys : list A) :
list_compare xs ys = Eq <-> xs = ys.
Lemma list_compare_antisym (xs ys : list A) :
(forall x y, cmp y x = CompOpp (cmp x y)) ->
list_compare ys xs = CompOpp (list_compare xs ys).
Lemma list_compare_trans (xs ys zs : list A) (c : comparison) :
(forall x y z c, cmp x y = c -> cmp y z = c -> cmp x z = c) ->
(forall x y, cmp y x = CompOpp (cmp x y)) ->
list_compare xs ys = c -> list_compare ys zs = c -> list_compare xs zs = c.
Lemma list_compare_spec_complete (xs ys : list A) (c : comparison) :
ListCompareSpec xs ys c -> list_compare xs ys = c.