Module R.
Inductive heap: Type :=
| Empty
| Node (l: heap) (x: E.t) (r: heap).
Fixpoint partition (pivot: E.t) (h: heap) { struct h } : heap * heap :=
match h with
| Empty => (Empty, Empty)
| Node a x b =>
match E.compare x pivot with
| EQ _ => (a, b)
| LT _ =>
match b with
| Empty => (h, Empty)
| Node b1 y b2 =>
match E.compare y pivot with
| EQ _ => (Node a x b1, b2)
| LT _ =>
let (small, big) := partition pivot b2
in (Node (Node a x b1) y small, big)
| GT _ =>
let (small, big) := partition pivot b1
in (Node a x small, Node big y b2)
end
end
| GT _ =>
match a with
| Empty => (Empty, h)
| Node a1 y a2 =>
match E.compare y pivot with
| EQ _ => (a1, Node a2 x b)
| LT _ =>
let (small, big) := partition pivot a2
in (Node a1 y small, Node big x b)
| GT _ =>
let (small, big) := partition pivot a1
in (small, Node big y (Node a2 x b))
end
end
end
end.
Definition insert (x: E.t) (h: heap) : heap :=
let (a, b) := partition x h in Node a x b.
Fixpoint findMin (h: heap) : option E.t :=
match h with
| Empty => None
| Node Empty x b => Some x
| Node a x b => findMin a
end.
Fixpoint deleteMin (h: heap) : heap :=
match h with
| Empty => Empty
| Node Empty x b => b
| Node (Node Empty x b) y c => Node b y c
| Node (Node a x b) y c => Node (deleteMin a) x (Node b y c)
end.
Fixpoint findMax (h: heap) : option E.t :=
match h with
| Empty => None
| Node a x Empty => Some x
| Node a x b => findMax b
end.
Fixpoint deleteMax (h: heap) : heap :=
match h with
| Empty => Empty
| Node b x Empty => b
| Node b x (Node c y Empty) => Node b x c
| Node a x (Node b y c) => Node (Node a x b) y (deleteMax c)
end.
(** Induction principles for some of the operators. *)
Scheme heap_ind := Induction for heap Sort Prop.
Functional Scheme partition_ind := Induction for partition Sort Prop.
Functional Scheme deleteMin_ind := Induction for deleteMin Sort Prop.
Functional Scheme deleteMax_ind := Induction for deleteMax Sort Prop.
(** Specification *)
Fixpoint In (x: E.t) (h: heap) : Prop :=
match h with
| Empty => False
| Node a y b => In x a \/ E.eq x y \/ In x b
end.
(** Invariants *)
Fixpoint lt_heap (h: heap) (x: E.t) : Prop :=
match h with
| Empty => True
| Node a y b => lt_heap a x /\ E.lt y x /\ lt_heap b x
end.
Fixpoint gt_heap (h: heap) (x: E.t) : Prop :=
match h with
| Empty => True
| Node a y b => gt_heap a x /\ E.lt x y /\ gt_heap b x
end.
Fixpoint bst (h: heap) : Prop :=
match h with
| Empty => True
| Node a x b => bst a /\ bst b /\ lt_heap a x /\ gt_heap b x
end.
Definition le (x y: E.t) := E.eq x y \/ E.lt x y.
(** Properties of [partition] *)
(** Properties of [insert] *)
(** Properties of [findMin] and [deleteMin] *)
(** Properties of [findMax] and [deleteMax]. *)
End R.
(** Wrapping in a dependent type *)
Definition t := { h: R.heap | R.bst h }.
(** Operations *)
Program Definition empty : t := R.Empty.
Program Definition insert (x: E.t) (h: t) : t := R.insert x h.
Next Obligation. apply R.insert_bst. apply proj2_sig. Qed.
Program Definition findMin (h: t) : option E.t := R.findMin h.
Program Definition deleteMin (h: t) : t := R.deleteMin h.
Next Obligation. apply R.deleteMin_bst. apply proj2_sig. Qed.
Program Definition findMax (h: t) : option E.t := R.findMax h.
Program Definition deleteMax (h: t) : t := R.deleteMax h.
Next Obligation. apply R.deleteMax_bst. apply proj2_sig. Qed.
(** Membership (for specification) *)
Program Definition In (x: E.t) (h: t) : Prop := R.In x h.
(** Properties of [empty] *)

Lemma In_empty: forall x, ~In x empty.