Fixpoint string_compare_lex_compat (s0 s1 : string) : Compare lex_lt eq s0 s1.
refine
(match s0 as ss0, s1 as ss1 return (_ = ss0 -> _ = ss1 -> _) with
| EmptyString, EmptyString => fun H_eq H_eq' => EQ _
| EmptyString, String c' s'1 => fun H_eq H_eq' => LT _
| String c s'0, EmptyString => fun H_eq H_eq' => GT _
| String c s'0, String c' s'1 => fun H_eq H_eq' =>
match Nat.compare (nat_of_ascii c) (nat_of_ascii c') as cmp return (_ = cmp -> _) with
| Lt => fun H_eq_cmp => LT _
| Eq => fun H_eq_cmp =>
match string_compare_lex_compat s'0 s'1 with
| LT H_lt => LT _
| EQ H_eq_lex => EQ _
| GT H_gt => GT _
end
| Gt => fun H_eq_cmp => GT _
end (refl_equal _)
end (refl_equal _) (refl_equal _)); try (rewrite H_eq; rewrite H_eq'); auto.
- apply lex_lt_empty.
- apply lex_lt_empty.
- apply nat_compare_eq in H_eq_cmp.
apply nat_of_ascii_injective in H_eq_cmp.
rewrite H_eq_cmp.
apply lex_lt_eq.
assumption.
- apply nat_compare_eq in H_eq_cmp.
apply nat_of_ascii_injective in H_eq_cmp.
subst.
reflexivity.
- apply nat_compare_eq in H_eq_cmp.
apply nat_of_ascii_injective in H_eq_cmp.
rewrite H_eq_cmp.
apply lex_lt_eq.
assumption.
- apply nat_compare_lt in H_eq_cmp.
apply lex_lt_lt.
assumption.
- apply nat_compare_gt in H_eq_cmp.
apply lex_lt_lt.
auto with arith.
Defined.
Module string_lex_as_OT_compat <: UsualOrderedType.
Definition t := string.
Definition eq := @eq string.
Definition lt := lex_lt.
Definition eq_refl := @eq_refl string.
Definition eq_sym := @eq_sym string.
Definition eq_trans := @eq_trans string.
Definition lt_trans := lex_lt_trans.
Definition lt_not_eq := lex_lt_not_eq.
Definition compare := string_compare_lex_compat.
Definition eq_dec := string_dec.
End string_lex_as_OT_compat.

Theorem lex_lt_lt_compat : Proper (eq ==> eq ==> iff) lex_lt.
Fixpoint string_compare_lex (s0 s1 : string) : { cmp : comparison | CompSpec eq lex_lt s0 s1 cmp }.