Inductive infrared : tree -> nat -> Prop :=
(* This predicate expresses, "the tree is a red-black tree, except that it is permitted to have two red nodes in a row at the very root (only)."  *)
| infrared_e: infrared EE 0
| infrared_r: forall tl k tr n,
is_redblack tl Black n ->
is_redblack tr Black n ->
infrared (T Red tl k tr) n
| infrared_b: forall tl k tr n,
is_redblack tl Black n ->
is_redblack tr Black n ->
infrared (T Black tl k tr) (S n).
Ltac infrared_tac :=
repeat (
auto ||
constructor ||
match goal with
| |- infrared (match ?A with
| EE => _
| T _ _ _ _ => _
end)  _ =>
match goal with
| H: is_redblack A _ _ |- _ => inv H
| H: infrared A _ |- _ => inv H
end
| |- is_redblack (match ?A with
| EE => _
| T _ _ _ _ => _
end)  _ _ =>
match goal with
| H: is_redblack A _ _ |- _ => inv H
| H: infrared A _ |- _ => inv H
end
| |- infrared (match K.compare ?A ?B with Eq => _ | Lt => _ | Gt => _ end)  _ =>
do_compare A B
| |- is_redblack (match K.compare ?A ?B with Eq => _ | Lt => _ | Gt => _ end)  _ _ =>
do_compare A B
end).

Lemma ins_is_redblack:
forall x s n,
(is_redblack s Black n -> infrared (ins x s) n) /\
(is_redblack s Red n -> is_redblack (ins x s) Black n).