Section establishing_decidability.
Reserved Notation "x ≺ y" (at level 70, no associativity).
Inductive bt_lt : bt -> bt -> Prop :=
| in_btlt_0 : forall s t,                   ∅ ≺ s⪧t
| in_btlt_1 : forall s s' t t', s ≺ s' -> s⪧t ≺ s'⪧t'
| in_btlt_2 : forall s t t',    t ≺ t' -> s⪧t ≺ s⪧t'
where "s ≺ t" := (bt_lt s t).
Hint Constructors bt_lt : core.
Fact bt_lt_irrefl s : ~ s ≺ s.
Fact bt_lt_trans r s t : r ≺ s -> s ≺ t -> r ≺ t.
Fact bt_lt_eq_lt_dec s t : { s ≺ t } + { s = t } + { t ≺ s }.
Fixpoint bt_insert s t : bt :=
match t with
| ∅   => s⪧∅
| t⪧u => match bt_lt_eq_lt_dec s t with
| inleft (left _)  => s⪧t⪧u
| inleft (right _) => t⪧u
| inright _        => t⪧(s→u)
end
end
where "s → t" := (bt_insert s t).
Fact bt_lt_eq_lt_dec_refl s : exists H, bt_lt_eq_lt_dec s s = inleft (right H).
Ltac bt_lt_eq H :=
match goal with
|- context [bt_lt_eq_lt_dec ?x ?x]
=> destruct (bt_lt_eq_lt_dec_refl x) as (H & ->)
end.
Fact bt_insert_leaf s : s→∅ = s⪧∅.
Fact bt_insert_gt s t u : t ≺ s -> s→t⪧u = t⪧(s→u).
Fact bt_insert_equiv s t : s→t ≈ s⪧t.
Fixpoint bt_norm t :=
match t with
| ∅   => ∅
| s⪧t => s† → t†
end
where "t †" := (bt_norm t).
Hint Resolve bt_insert_equiv : core.
Fact bt_norm_eq t : t† ≈ t.
Opaque bt_insert.
Tactic Notation "rew" "bt" "insert" :=
repeat match goal with
|             |- context[_→∅]     => rewrite bt_insert_leaf
|             |- context[?x→?x⪧_] => rewrite bt_insert_eq
| H : ?x ≺ ?y |- context[?x→?y⪧_] => rewrite bt_insert_lt with (1 := H)
| H : ?x ≺ ?y |- context[?y→?x⪧_] => rewrite bt_insert_gt with (1 := H)
end.
Tactic Notation "bt" "insert" "case" hyp(x) hyp(y) :=
destruct (bt_lt_eq_lt_dec x y) as [ [|] | ]; subst; rew bt insert; auto.
Tactic Notation "bt" "lt" "trans" constr(t) := apply bt_lt_trans with t; auto.
Tactic Notation "bt" "lt" "cycle" :=
match goal with
| H1 : ?x ≺ ?x |- _  => destruct (@bt_lt_irrefl x); auto
| H1 : ?x ≺ ?y,
H2 : ?y ≺ ?x |- _  => destruct (@bt_lt_irrefl x); bt lt trans y
| H1 : ?x ≺ ?y,
H2 : ?y ≺ ?z,
H3 : ?z ≺ ?x |- _  => destruct (@bt_lt_irrefl x); bt lt trans y; bt lt trans z
end.
Fact bt_insert_cntr s t : s→s→t = s→t.
Fact bt_insert_comm s t u : s→t→u = t→s→u.
Hint Resolve bt_insert_cntr bt_insert_comm bt_norm_eq : core.
End establishing_decidability.
End btm_ex_dec.
(* Univ. quantification of subsets *)
(* Decidable separation *)
Definition btm_select (P : _ -> Prop) t :
(forall s t, s ≈ t -> P s -> P t)
-> (forall x, x ∈ t -> { P x } + { ~ P x })
-> { s | forall x, x ∈ s <-> x ∈ t /\ P x }.
(* When x ∈ s, one can compute t st s = {x} U t /\ x ∉ t *)
Definition btm_partition x s : x ∈ s -> { t | s ≈ x⪧t /\ x ∉ t }.
End more_decidability.
Definition bt_incl x y := forall u, u ∈ x -> u ∈ y.
Local Infix "⊆" := bt_incl.
Add Parametric Morphism: (bt_incl) with signature
(bt_equiv) ==> (bt_equiv) ==> (iff) as bti_congr.
Fact bti_refl x : x ⊆ x.
Fact bti_mono_r x s t : s ⊆ t -> x⪧s ⊆ x⪧t.
Fact bti_congr_r x s t : s ≈ t -> x ⊆ s -> x ⊆ t.
Hint Resolve bti_0 bti_refl bti_comp bti_mono_r : core.
(* I wonder whether the proof of this important result could be split  The proof can be done by generalising seteq.v to contraction under an equivalence (instead of @eq) This would avoid using decidable equality and would allow for the development of HF-Sets with UR-elements over a non-decidable type *)
Fact bte_incl_equiv s t : s ≈ t <-> s ⊆ t /\ t ⊆ s.
Fact bte_ext s t : s ≈ t <-> forall x, x ∈ s <-> x ∈ t.
(* Set union *)
Fixpoint bt_cup s t :=
match s with
| ∅   => t
| x⪧s => x⪧(s ∪ t)
end
where "s ∪ t" := (bt_cup s t).
Fact bt_cup_left s t : s ⊆ s ∪ t.
Fact bt_cup_incl s t x : s ∪ t ⊆ x <-> s ⊆ x /\ t ⊆ x.
Fact bt_cup_mono s s' t t' : s ⊆ s' -> t ⊆ t' -> s ∪ t ⊆ s' ∪ t'.
Hint Resolve bt_cup_mono : core.
(* We compute the transitive closure *)
Definition bt_transitive t := forall u v, u ∈ v -> v ∈ t -> u ∈ t.
Fact bt_transitive_incl u t : bt_transitive t -> u ∈ t -> u ⊆ t.
Fixpoint bt_tc t :=
match t with
| ∅   => ∅
| s⪧t => s⪧(↓s ∪ ↓t)
end
where "↓ t" := (bt_tc t).
(* ↓t contains t *)
Fact bt_tc_incr t : t ⊆ ↓t.
Hint Resolve bt_tc_incr : core.
(* ↓t is transitive *)

Theorem bt_tc_trans t : bt_transitive ↓t.