1 (* Pasted from Pottier's PP compiler *)
3 (* This module offers sets of elements where each element carries an
4 integer priority. All operations execute in logarithmic time with
5 respect to the number of elements in the set. *)
7 module Make (X : Set.OrderedType)
10 (* First, define normal sets and maps. *)
12 module Set = Set.Make(X)
14 module Map = MyMap.Make(X)
16 (* Next, define maps of integers to nonempty sets of elements. *)
18 module IntMap = struct
20 module M = MyMap.Make (struct
27 module H = SetMap.MakeHetero(Set)(M)
33 (* Now, define priority sets. *)
37 (* A mapping of elements to priorities. *)
41 (* A mapping of priorities to sets of elements. By convention, a
42 priority has no entry in this table if that entry would be an
43 empty set of elements. This allows finding the
44 lowest-priority element in logarithmic time. *)
50 (* [empty] is the empty set. *)
58 (* [priority x s] looks up the priority of element [x]. *)
66 (* [add x p s] inserts element [x] with priority [p]. *)
69 assert (not (Map.mem x s.priority));
71 priority = Map.add x p s.priority;
72 level = IntMap.update p (Set.add x) s.level
75 (* [remove x s] removes element [x]. *)
80 Map.find_remove x s.priority
85 IntMap.update p (function xs ->
86 assert (Set.mem x xs);
95 (* [change x p s] changes the priority of element [x] to [p]. *)
98 let p0 = priority x s in
103 priority = Map.add x p1 s.priority; (* overriding previous entry *)
104 level = IntMap.update p1 (Set.add x) (IntMap.update p0 (Set.remove x) s.level)
107 (* [increment x d s] increases the priority of element [x] by [d]. *)
109 let increment x d s =
110 change x (priority x s + d) s
112 (* [incrementifx x p s] increases the priority of element [x] by [d]
113 if [x] is a member of the priority set. *)
115 let incrementifx x d s =
116 if Map.mem x s.priority then
121 (* [lowest s] returns [Some (x, p)], where element [x] has minimum
122 priority [p] among all elements of [s]. It returns [None] if [s]
127 let p, xs = IntMap.minimum s.level in (* can fail if set is empty *)
129 Some (Set.choose xs, p) (* cannot fail *)
135 (* [fold f s accu] fold over the set [s]. Elements are presented
136 to [f] in increasing order of priority. *)
139 IntMap.fold (fun p xs accu ->
140 Set.fold (fun x accu ->