Module Import MX := OrderedTypeFacts X.
(** ** Automation and dedicated tactics *)
Scheme tree_ind := Induction for tree Sort Prop.
Scheme bst_ind := Induction for bst Sort Prop.
Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans ok : core.
Local Hint Immediate MX.eq_sym : core.
Local Hint Unfold In lt_tree gt_tree : core.
Local Hint Constructors InT bst : core.
Local Hint Unfold Ok : core.
(** Automatic treatment of [Ok] hypothesis *)
Ltac clear_inversion H := inversion H; clear H; subst.
Ltac inv_ok := match goal with
| H:Ok (Node _ _ _ _) |- _ => clear_inversion H; inv_ok
| H:Ok Leaf |- _ => clear H; inv_ok
| H:bst ?x |- _ => change (Ok x) in H; inv_ok
| _ => idtac
end.
(** A tactic to repeat [inversion_clear] on all hyps of the form [(f (Node _ _ _ _))] *)
Ltac is_tree_constr c :=
match c with
| Leaf => idtac
| Node _ _ _ _ => idtac
| _ => fail
end.
Ltac invtree f :=
match goal with
| H:f ?s |- _ => is_tree_constr s; clear_inversion H; invtree f
| H:f _ ?s |- _ => is_tree_constr s; clear_inversion H; invtree f
| H:f _ _ ?s |- _ => is_tree_constr s; clear_inversion H; invtree f
| _ => idtac
end.
Ltac inv := inv_ok; invtree InT.
Ltac intuition_in := repeat (intuition; inv).
(** Helper tactic concerning order of elements. *)
Ltac order := match goal with
| U: lt_tree _ ?s, V: InT _ ?s |- _ => generalize (U _ V); clear U; order
| U: gt_tree _ ?s, V: InT _ ?s |- _ => generalize (U _ V); clear U; order
| _ => MX.order
end.
(** [isok] is indeed a decision procedure for [Ok] *)
Instance isok_Ok s : isok s = true -> Ok s | 10.
Local Hint Immediate In_1 : core.
Instance In_compat : Proper (X.eq==>eq==>iff) InT.
(** Results about [lt_tree] and [gt_tree] *)
Local Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node : core.
Instance lt_tree_compat : Proper (X.eq ==> Logic.eq ==> iff) lt_tree.
Instance gt_tree_compat : Proper (X.eq ==> Logic.eq ==> iff) gt_tree.
Local Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans : core.
Ltac induct s x :=
induction s as [|i l IHl x' r IHr]; simpl; intros;
[|elim_compare x x'; intros; inv].
Ltac auto_tc := auto with typeclass_instances.
Ltac ok :=
inv; change bst with Ok in *;
match goal with
| |- Ok (Node _ _ _ _) => constructor; auto_tc; ok
| |- lt_tree _ (Node _ _ _ _) => apply lt_tree_node; ok
| |- gt_tree _ (Node _ _ _ _) => apply gt_tree_node; ok
| _ => eauto with typeclass_instances
end.
(** ** Empty set *)
Instance empty_ok : Ok empty.
(** ** Emptyness test *)

Lemma is_empty_spec : forall s, is_empty s = true <-> Empty s.