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).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).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).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).

(* Specifications: *)
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).
Lemma insert_is_redblack: forall x s n, is_redblack s Red n -> exists n', is_redblack (insert x s) Red n'.