Hint Constructors interp.
Tactic Notation "do_hyp" hyp(H) :=
match type of H with ?a -> _ =>
let H1 := fresh in (assert (H1: a); [ |generalize (H H1); clear H H1; intro H]) end.
Ltac jax :=
repeat
match goal with
| H: interp EE _ |- _ => inv H
| |- interp match ?c with Red => _ | Black => _ end _ => destruct c
| |- interp match ?t with EE => _ | T _ _ _ _ => _ end _ =>
match t with balance' _ _ _ => fail 1 | append _ => fail 1 | _ =>  destruct t end
| H: interp (balance' _ _ _) _ |- _ =>
apply interp_balance' in H; destruct H as [?|[?|?]]
| |- interp (balance' _ _ _) _ =>
apply interp_balance'
| H: interp match ?c with Red => _ | Black => _ end _ |- _ => destruct c
| H: interp match ?t with EE => _ | T _ _ _ _ => _ end _ |- _  =>
match t with balance' _ _ _ => fail 1 | append _ => fail 1 | _ =>  destruct t end
| H: interp (T _ _ _ _) _ |- _ => inv H
| H: interp _ _ <-> interp _ _ \/ interp _ _ |- _ =>
solve [destruct H  as [H _]; destruct H; auto]
| |- _ => solve [auto 50]
| H: interp _ _ -> _ \/ _ |- _ \/ _ => solve [destruct H; auto]
| H: interp ?JJ  _, IHsz: forall _ _, _ -> _ |- _ =>
match JJ with context [append(?a,?b)] =>
let H99 := fresh in
destruct (IHsz a b) as [H99 _];  [simpl in *; omega | ];
destruct (append(a,b));
try  (destruct (H99 H); [ solve [auto] | | ])
end
|  IHsz: forall _ _, _ -> _ |- interp ?JJ _ =>
match JJ with context [append(?a,?b)] =>
let H99 := fresh in
destruct (IHsz a b) as [HA HB];  [simpl in *; omega | ];
destruct (append(a,b));
try (do_hyp HA; [solve [auto] | ]);
try (do_hyp HB; [solve [auto] | ])
end
end.

(* Specifications: *)
Lemma interp_append_aux:
forall x sz tl tr, size tl + size tr < sz ->
(interp (append(tl,tr)) x <-> (interp tl x \/ interp tr x)).
Lemma interp_append:
forall tl tr x, interp (append(tl,tr)) x <-> (interp tl x \/ interp tr x).
Lemma interp_sub1: forall t x, interp (sub1 t) x <-> interp t x.
Lemma del_ok:
forall x y t lo hi,
searchtree lo hi t ->
((~K.eq x y /\ interp t x) <-> interp (del y t) x).
Lemma interp_delete:
forall x y s,
searchtree None None s ->
((~K.eq x y /\ interp s x) <-> interp (delete y s) x).
Lemma insert_valid: forall x s, valid s -> valid (insert x s).
Lemma empty_valid: valid EE.
Lemma delete_searchtree: forall k s,
searchtree None None s -> searchtree None None (delete k s).
Lemma remove_valid: forall k s, valid s -> valid (delete k s).
Lemma singleton_valid: forall k, valid (T Black EE k EE).
Fixpoint gopher (s: tree) : tree :=
match s with
| EE => EE
| T _ sl k sr => match gopher sl with
| T _ sll j slr => T Red sll j (T Red slr k sr)
| EE => s
end
end.