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.

Lemma singleton_valid: forall k, valid (T Black EE k EE).