Section Quantifiers.
Variable f : positive -> bool.
Fixpoint xforall (m : t) (i : positive) :=
match m with
| Leaf => true
| Node l o r =>
(negb o ||| f (rev i)) &&& xforall r i~1 &&& xforall l i~0
end.
Definition for_all m := xforall m 1.
Fixpoint xexists (m : t) (i : positive) :=
match m with
| Leaf => false
| Node l o r => (o &&& f (rev i)) ||| xexists r i~1 ||| xexists l i~0
end.
Definition exists_ m := xexists m 1.
Fixpoint xfilter (m : t) (i : positive) : t :=
match m with
| Leaf => Leaf
| Node l o r => node (xfilter l i~0) (o &&& f (rev i)) (xfilter r i~1)
end.
Definition filter m := xfilter m 1.
Fixpoint xpartition (m : t) (i : positive) : t * t :=
match m with
| Leaf => (Leaf,Leaf)
| Node l o r =>
let (lt,lf) := xpartition l i~0 in
let (rt,rf) := xpartition r i~1 in
if o then
let fi := f (rev i) in
(node lt fi rt, node lf (negb fi) rf)
else
(node lt false rt, node lf false rf)
end.
Definition partition m := xpartition m 1.
End Quantifiers.
(** uses [a] to accumulate values rather than doing a lot of concatenations *)
Fixpoint xelements (m : t) (i : positive) (a: list positive) :=
match m with
| Leaf => a
| Node l false r => xelements l i~0 (xelements r i~1 a)
| Node l true r => xelements l i~0 (rev i :: xelements r i~1 a)
end.
Definition elements (m : t) := xelements m 1 nil.
Fixpoint cardinal (m : t) : nat :=
match m with
| Leaf => O
| Node l false r => (cardinal l + cardinal r)%nat
| Node l true r => S (cardinal l + cardinal r)
end.
(** would it be more efficient to use a path like in the above functions ? *)
Fixpoint choose (m: t) : option elt :=
match m with
| Leaf => None
| Node l o r => if o then Some 1 else
match choose l with
| None => option_map xI (choose r)
| Some i => Some i~0
end
end.
Fixpoint min_elt (m: t) : option elt :=
match m with
| Leaf => None
| Node l o r =>
match min_elt l with
| None => if o then Some 1 else option_map xI (min_elt r)
| Some i => Some i~0
end
end.
Fixpoint max_elt (m: t) : option elt :=
match m with
| Leaf => None
| Node l o r =>
match max_elt r with
| None => if o then Some 1 else option_map xO (max_elt l)
| Some i => Some i~1
end
end.
(** lexicographic product, defined using a notation to keep things lazy *)
Notation lex u v := match u with Eq => v | Lt => Lt | Gt => Gt end.
Definition compare_bool a b :=
match a,b with
| false, true => Lt
| true, false => Gt
| _,_ => Eq
end.
Fixpoint compare (m m': t): comparison :=
match m,m' with
| Leaf,_ => if is_empty m' then Eq else Lt
| _,Leaf => if is_empty m then Eq else Gt
| Node l o r,Node l' o' r' =>
lex (compare_bool o o') (lex (compare l l') (compare r r'))
end.
Definition In i t := mem i t = true.
Definition Equal s s' := forall a : elt, In a  s <-> In a  s'.
Definition Subset s s' := forall a : elt, In a s -> In a s'.
Definition Empty s := forall a : elt, ~ In a s.
Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x.
Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x.
Notation "s  [=]  t" := (Equal s t) (at level 70, no associativity).
Notation "s  [<=]  t" := (Subset s t) (at level 70, no associativity).
Definition eq := Equal.
Definition lt m m' := compare m m' = Lt.
(** Specification of [In] *)
Instance In_compat : Proper (E.eq==>Logic.eq==>iff) In.
(** Specification of [eq] *)
Local Instance eq_equiv : Equivalence eq.
Local Opaque node.
(** Specification of [is_empty] *)
(** Specification of [subset] *)
(** Specification of [equal] (via subset) *)

Lemma compare_spec : forall s s' : t, CompSpec eq lt s s' (compare s s').