(** A tactic for cleaning hypothesis after use of functional induction. *)

Ltac clearf :=
 match goal with
  | H := _ |- _ => subst; subst H; clearf
  | H : (@Logic.eq (Compare _ _ _ _) _ _) |- _ => clear H; clearf
  | H : (@Logic.eq (sumbool _ _) _ _) |- _ => clear H; clearf
  | _ => idtac
 end.(** A tactic to repeat [inversion_clear] on all hyps of the
    form [(f (Node ...))] *)

Ltac inv f :=
  match goal with
     | H:f (Leaf _) |- _ => inversion_clear H; inv f
     | H:f _ (Leaf _) |- _ => inversion_clear H; inv f
     | H:f _ _ (Leaf _) |- _ => inversion_clear H; inv f
     | H:f _ _ _ (Leaf _) |- _ => inversion_clear H; inv f
     | H:f (Node _ _ _ _ _) |- _ => inversion_clear H; inv f
     | H:f _ (Node _ _ _ _ _) |- _ => inversion_clear H; inv f
     | H:f _ _ (Node _ _ _ _ _) |- _ => inversion_clear H; inv f
     | H:f _ _ _ (Node _ _ _ _ _) |- _ => inversion_clear H; inv f
     | _ => idtac
  end.Ltac inv_all f :=
  match goal with
   | H: f _ |- _ => inversion_clear H; inv f
   | H: f _ _ |- _ => inversion_clear H; inv f
   | H: f _ _ _ |- _ => inversion_clear H; inv f
   | H: f _ _ _ _ |- _ => inversion_clear H; inv f
   | _ => idtac
  end.(** Helper tactic concerning order of elements. *)

Ltac order := match goal with
 | U: lt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order
 | U: gt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order
 | _ => MX.order
end.Ltac intuition_in := repeat (intuition auto; inv In; inv MapsTo).(* Function/Functional Scheme can't deal with internal fix.
   Let's do its job by hand: *)

Ltac join_tac :=
 intros ?l; induction l as [| ?ll _ ?lx ?ld ?lr ?Hlr ?lh];
   [ | intros ?x ?d ?r; induction r as [| ?rl ?Hrl ?rx ?rd ?rr _ ?rh]; unfold join;
     [ | destruct (gt_le_dec lh (rh+2)) as [?GT|?LE];
       [ match goal with |- context [ bal ?u ?v ?w ?z ] =>
           replace (bal u v w z)
           with (bal ll lx ld (join lr x d (Node rl rx rd rr rh))); [ | auto]
         end
       | destruct (gt_le_dec rh (lh+2)) as [?GT'|?LE'];
         [ match goal with |- context [ bal ?u ?v ?w ?z ] =>
             replace (bal u v w z)
             with (bal (join (Node ll lx ld lr lh) x d rl) rx rd rr); [ | auto]
           end
         | ] ] ] ]; intros.Implicit Types m r : t elt.

(* Specifications: *)
Lemma MapsTo_In : forall k e m, MapsTo k e m -> In k m.
Lemma In_MapsTo : forall k m, In k m -> exists e, MapsTo k e m.
Lemma In_alt : forall k m, In0 k m <-> In k m.
Lemma MapsTo_1 : forall m x y e, X.eq x y -> MapsTo x e m -> MapsTo y e m.
Lemma In_1 : forall m x y, X.eq x y -> In x m -> In y m.
Lemma In_node_iff : forall l x e r h y, In y (Node l x e r h) <-> In y l \/ X.eq y x \/ In y r.
Lemma lt_leaf : forall x, lt_tree x (Leaf elt).
Lemma gt_leaf : forall x, gt_tree x (Leaf elt).
Lemma lt_tree_node : forall x y l r e h, lt_tree x l -> lt_tree x r -> X.lt y x -> lt_tree x (Node l y e r h).
Lemma gt_tree_node : forall x y l r e h, gt_tree x l -> gt_tree x r -> X.lt x y -> gt_tree x (Node l y e r h).
Lemma lt_left : forall x y l r e h, lt_tree x (Node l y e r h) -> lt_tree x l.
Lemma lt_right : forall x y l r e h, lt_tree x (Node l y e r h) -> lt_tree x r.
Lemma gt_left : forall x y l r e h, gt_tree x (Node l y e r h) -> gt_tree x l.
Lemma gt_right : forall x y l r e h, gt_tree x (Node l y e r h) -> gt_tree x r.
Lemma lt_tree_not_in : forall x m, lt_tree x m -> ~ In x m.
Lemma lt_tree_trans : forall x y, X.lt x y -> forall m, lt_tree x m -> lt_tree y m.
Lemma gt_tree_not_in : forall x m, gt_tree x m -> ~ In x m.
Lemma gt_tree_trans : forall x y, X.lt y x -> forall m, gt_tree x m -> gt_tree y m.