[m-rev.] diff: speed up relation.m

Zoltan Somogyi zs at cs.mu.OZ.AU
Thu Sep 1 12:22:22 AEST 2005


library/sparse_bitset.m:
	Provide versions of foldl and fold2 that work with two accumulators.

	Convert to four-space indentation.

library/relation.m:
	Fix some efficiency problems caused by folds on sparse_bitsets.
	Use the new two-accumulator variants instead of using pairs,
	which avoids memory allocation. Use the folds over predicates
	instead of the folds over functions, since sparse_bitset.m implements
	the folds over functions by converting the function into a predicate,
	which takes time.

	Make some lambda expressions into named predicates.

	Convert to four-space indentation.

Zoltan.

cvs diff: Diffing .
Index: relation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/relation.m,v
retrieving revision 1.36
diff -u -b -r1.36 relation.m
--- relation.m	16 Jun 2005 04:08:03 -0000	1.36
+++ relation.m	31 Aug 2005 07:10:16 -0000
@@ -1,4 +1,6 @@
 %---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
 % Copyright (C) 1995-1999,2002-2005 The University of Melbourne.
 % This file may only be copied under the terms of the GNU Library General
 % Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -38,33 +40,33 @@
 :- func relation__init = relation(T).
 :- pred relation__init(relation(T)::out) is det.
 
-	% relation__add_element adds an element to the domain of a
-	% relation.  Return the old relation_key if one already exists.
+    % relation__add_element adds an element to the domain of a relation.
+    % Return the old relation_key if one already exists.
 	%
 :- pred relation__add_element(relation(T)::in, T::in, relation_key::out,
 	relation(T)::out) is det.
 
-	% relation__search_element returns the relation_key associated
-        % with a domain element.  Fail if the relation_key is not valid.
+    % relation__search_element returns the relation_key associated with a
+    % domain element. Fail if the relation_key is not valid.
         %
 :- pred relation__search_element(relation(T)::in, T::in, relation_key::out)
 	is semidet.
 
-	% relation__lookup_element returns the relation_key associated
-        % with a domain element.  Abort if the relation_key is not valid.
+    % relation__lookup_element returns the relation_key associated with a
+    % domain element. Abort if the relation_key is not valid.
 	%
 :- func relation__lookup_element(relation(T), T) = relation_key.
 :- pred relation__lookup_element(relation(T)::in, T::in, relation_key::out)
 	is det.
 
-	% relation__search_key returns the domain element associated
-	% with a relation_key.  Fail if the relation_key is not valid.
+    % relation__search_key returns the domain element associated with a
+    % relation_key. Fail if the relation_key is not valid.
 	%
 :- pred relation__search_key(relation(T)::in, relation_key::in, T::out)
 	is semidet.
 
-	% relation__lookup_key returns the domain element associated
-	% with a relation_key.  Abort if the relation_key is not valid.
+    % relation__lookup_key returns the domain element associated with a
+    % relation_key. Abort if the relation_key is not valid.
 	%
 :- func relation__lookup_key(relation(T), relation_key) = T.
 :- pred relation__lookup_key(relation(T)::in, relation_key::in, T::out) is det.
@@ -87,8 +89,7 @@
 :- pred relation__add_values(relation(T)::in, T::in, T::in, relation(T)::out)
 	is det.
 
-	% relation__add_assoc_list adds a list of elements to a
-	% relation.
+    % relation__add_assoc_list adds a list of elements to a relation.
 	%
 :- func relation__add_assoc_list(relation(T),
 	assoc_list(relation_key, relation_key)) = relation(T).
@@ -102,31 +103,27 @@
 :- pred relation__remove(relation(T)::in, relation_key::in, relation_key::in,
 	relation(T)::out) is det.
 
-	% relation__remove_assoc_list removes a list of elements
-	% from a relation.
+    % relation__remove_assoc_list removes a list of elements from a relation.
 	%
 :- func relation__remove_assoc_list(relation(T),
 	assoc_list(relation_key, relation_key)) = relation(T).
 :- pred relation__remove_assoc_list(relation(T)::in,
 	assoc_list(relation_key, relation_key)::in, relation(T)::out) is det.
 
-
-	% relation__lookup checks to see if an element is
-	% in the relation.
+    % relation__lookup checks to see if an element is in the relation.
 	% 
 :- pred relation__lookup(relation(T), relation_key, relation_key).
 :- mode relation__lookup(in, in, out) is nondet.
 :- mode relation__lookup(in, in, in) is semidet.
 
-	% relation__reverse_lookup checks to see if an element is
-	% in the relation.
+    % relation__reverse_lookup checks to see if an element is in the relation.
 	% 
 :- pred relation__reverse_lookup(relation(T), relation_key, relation_key).
 :- mode relation__reverse_lookup(in, out, in) is nondet.
 :- mode relation__reverse_lookup(in, in, in) is semidet.
 
-	% relation__lookup_from returns the set of elements
-	% y such that xRy, given an x.
+    % Given an x, relation__lookup_from returns the set of elements y
+    % such that xRy.
 	% 
 :- func relation__lookup_from(relation(T), relation_key) = set(relation_key).
 :- pred relation__lookup_from(relation(T)::in, relation_key::in,
@@ -137,8 +134,8 @@
 :- pred relation__lookup_key_set_from(relation(T)::in,
 	relation_key::in, relation_key_set::out) is det.
 
-	% relation__lookup_to returns the set of elements
-	% x such that xRy, given some y.
+    % Given some y, relation__lookup_to returns the set of elements x
+    % such that xRy.
 	%
 :- func relation__lookup_to(relation(T), relation_key) = set(relation_key).
 :- pred relation__lookup_to(relation(T)::in, relation_key::in,
@@ -149,71 +146,67 @@
 :- pred relation__lookup_key_set_to(relation(T)::in,
 	relation_key::in, relation_key_set::out) is det.
 
-	% relation__to_assoc_list turns a relation into a list of
-	% pairs of elements.
+    % relation__to_assoc_list turns a relation into a list of pairs of
+    % elements.
 	%
 :- func relation__to_assoc_list(relation(T)) = assoc_list(T, T).
 :- pred relation__to_assoc_list(relation(T)::in, assoc_list(T, T)::out) is det.
 
-	% relation__to_key_assoc_list turns a relation into a list of
-	% pairs of relation keys.
+    % relation__to_key_assoc_list turns a relation into a list of pairs of
+    % relation keys.
 	%
 :- func relation__to_key_assoc_list(relation(T))
 	= assoc_list(relation_key, relation_key).
 :- pred relation__to_key_assoc_list(relation(T)::in,
 	assoc_list(relation_key, relation_key)::out) is det.
 
-	% relation__from_assoc_list turns a list of pairs of
-	% elements into a relation.
+    % relation__from_assoc_list turns a list of pairs of elements into
+    % a relation.
 	%
 :- func relation__from_assoc_list(assoc_list(T, T)) = relation(T).
 :- pred relation__from_assoc_list(assoc_list(T, T)::in, relation(T)::out)
 	is det.
 
-	% relation__domain finds the set of all elements in the
-	% domain of a relation.
+    % relation__domain finds the set of all elements in the domain of a
+    % relation.
 	%
 :- func relation__domain(relation(T)) = set(T).
 :- pred relation__domain(relation(T)::in, set(T)::out) is det.
 
-	% relation__inverse(R, R') is true iff for all x, y
-	% in the domain of R, xRy if yR'x.
+    % relation__inverse(R, R') is true iff for all x, y in the domain of R,
+    % xRy if yR'x.
 	%
 :- func relation__inverse(relation(T)) = relation(T).
 :- pred relation__inverse(relation(T)::in, relation(T)::out) is det.
 
-	% relation__compose(R1, R2, R) is true if R is the
-	% composition of the relations R1 and R2.
+    % relation__compose(R1, R2, R) is true if R is the composition
+    % of the relations R1 and R2.
 	%
 :- func relation__compose(relation(T), relation(T)) = relation(T).
 :- pred relation__compose(relation(T)::in, relation(T)::in, relation(T)::out)
 	is det.
 
-	% relation__dfs(Rel, X, Dfs) is true if Dfs is a
-	% depth-first sorting of Rel starting at X.  The
-	% set of elements in the list Dfs is exactly equal
-	% to the set of elements y such that xR*y, where
-	% R* is the reflexive transitive closure of R.
+    % relation__dfs(Rel, X, Dfs) is true if Dfs is a depth-first sorting of Rel
+    % starting at X. The set of elements in the list Dfs is exactly equal to
+    % the set of elements y such that xR*y, where R* is the reflexive
+    % transitive closure of R.
 	%
 :- func relation__dfs(relation(T), relation_key) = list(relation_key).
 :- pred relation__dfs(relation(T)::in, relation_key::in,
 	list(relation_key)::out) is det.
 
-	% relation__dfsrev(Rel, X, DfsRev) is true if DfsRev is a
-	% reverse depth-first sorting of Rel starting at X.  The
-	% set of elements in the list Dfs is exactly equal
-	% to the set of elements y such that xR*y, where
-	% R* is the reflexive transitive closure of R.
+    % relation__dfsrev(Rel, X, DfsRev) is true if DfsRev is a reverse
+    % depth-first sorting of Rel starting at X. The R* is the reflexive
+    % transitive closure of R.
 	%
 :- func relation__dfsrev(relation(T), relation_key) = list(relation_key).
 :- pred relation__dfsrev(relation(T)::in, relation_key::in,
 	list(relation_key)::out) is det.
 
-	% relation__dfs(Rel, Dfs) is true if Dfs is a depth-
-	% first sorting of Rel, i.e. a list of the nodes in Rel
-	% such that it contains all elements in the relation and all
-	% the children of a node are placed in the list before
-	% the parent.
+    % relation__dfs(Rel, Dfs) is true if Dfs is a depth-first sorting of Rel,
+    % i.e. a list of the nodes in Rel such that it contains all elements
+    % in the relation and all the children of a node are placed in the list
+    % before the parent.
 	%
 :- func relation__dfs(relation(T)) = list(relation_key).
 :- pred relation__dfs(relation(T)::in, list(relation_key)::out) is det.
@@ -225,21 +218,18 @@
 :- func relation__dfsrev(relation(T)) = list(relation_key).
 :- pred relation__dfsrev(relation(T)::in, list(relation_key)::out) is det.
 
-	% relation__dfs(Rel, X, Visit0, Visit, Dfs) is true
-	% if Dfs is a depth-first sorting of Rel starting at
-	% X providing we have already visited Visit0 nodes,
-	% i.e.  a list of nodes such that all the unvisited
-	% children of a node are placed in the list before the
-	% parent.  Visit0 allows us to initialise a set of
-	% previously visited nodes.  Visit is Dfs + Visit0.
+    % relation__dfs(Rel, X, Visit0, Visit, Dfs) is true if Dfs is a depth-first
+    % sorting of Rel starting at X providing we have already visited Visit0
+    % nodes, i.e.  a list of nodes such that all the unvisited children of a
+    % node are placed in the list before the parent. Visit0 allows us to
+    % initialise a set of previously visited nodes. Visit is Dfs + Visit0.
 	%
 :- pred relation__dfs(relation(T)::in, relation_key::in, relation_key_set::in,
 	relation_key_set::out, list(relation_key)::out) is det.
 
-	% relation__dfsrev(Rel, X, Visit0, Visit, DfsRev) is true if
-	% DfsRev is a reverse depth-first sorting of Rel starting at X
-	% providing we have already visited Visit0 nodes,
-	% ie the reverse of Dfs from relation__dfs/5.
+    % relation__dfsrev(Rel, X, Visit0, Visit, DfsRev) is true if DfsRev is a
+    % reverse depth-first sorting of Rel starting at X providing we have
+    % already visited Visit0 nodes, ie the reverse of Dfs from relation__dfs/5.
 	% Visit is Visit0 + DfsRev.
 	%
 :- pred relation__dfsrev(relation(T)::in, relation_key::in,
@@ -250,23 +240,21 @@
 	%
 :- pred relation__is_dag(relation(T)::in) is semidet.
 
-	% relation__components(R, Comp) is true if Comp
-	% is the set of the connected components of R.
+    % relation__components(R, Comp) is true if Comp is the set of the
+    % connected components of R.
 	%
 :- func relation__components(relation(T)) = set(set(relation_key)).
 :- pred relation__components(relation(T)::in, set(set(relation_key))::out)
 	is det.
 
-	% relation__cliques(R, Cliques) is true if
-	% Cliques is the set of the strongly connected
-	% components (cliques) of R.
+    % relation__cliques(R, Cliques) is true if Cliques is the set of the
+    % strongly connected components (cliques) of R.
 	%
 :- func relation__cliques(relation(T)) = set(set(relation_key)).
 :- pred relation__cliques(relation(T)::in, set(set(relation_key))::out) is det.
 
-	% relation__reduced(R, Red) is true if Red is
-	% the reduced relation (relation of cliques)
-	% obtained from R.
+    % relation__reduced(R, Red) is true if Red is the reduced relation
+    % (relation of cliques) obtained from R.
 	%
 :- func relation__reduced(relation(T)) = relation(set(T)).
 :- pred relation__reduced(relation(T)::in, relation(set(T))::out) is det.
@@ -276,37 +264,34 @@
 	%
 :- pred relation__tsort(relation(T)::in, list(T)::out) is semidet.
 
-	% relation__atsort(R, ATS) is true if ATS is
-	% a topological sorting of the cliques in R.
+    % relation__atsort(R, ATS) is true if ATS is a topological sorting
+    % of the cliques in R.
 	%
 :- func relation__atsort(relation(T)) = list(set(T)).
 :- pred relation__atsort(relation(T)::in, list(set(T))::out) is det.
 
-	% relation__sc(R, SC) is true if SC is the
-	% symmetric closure of R.  In graph terms,
-	% symmetric closure is the same as turning
-	% a directed graph into an undirected graph.
+    % relation__sc(R, SC) is true if SC is the symmetric closure of R.
+    % In graph terms, symmetric closure is the same as turning a directed graph
+    % into an undirected graph.
 	%
 :- func relation__sc(relation(T)) = relation(T).
 :- pred relation__sc(relation(T)::in, relation(T)::out) is det.
 
-	% relation__tc(R, TC) is true if TC is the
-	% transitive closure of R.
+    % relation__tc(R, TC) is true if TC is the transitive closure of R.
 	%
 :- func relation__tc(relation(T)) = relation(T).
 :- pred relation__tc(relation(T)::in, relation(T)::out) is det.
 
-	% relation__rtc(R, RTC) is true if RTC is the
-	% reflexive transitive closure of R.
+    % relation__rtc(R, RTC) is true if RTC is the reflexive transitive closure
+    % of R.
 	%
 :- func relation__rtc(relation(T)) = relation(T).
 :- pred relation__rtc(relation(T)::in, relation(T)::out) is det.
 
-	% relation__traverse(R, ProcessNode, ProcessEdge) will
-	% traverse a relation calling ProcessNode for each node in the
-	% relation and ProcessEdge for each edge in the relation.
-	% Each node is processed followed by all the edges originating
-	% at that node, until all nodes have been processed.
+    % relation__traverse(R, ProcessNode, ProcessEdge) will traverse a relation
+    % calling ProcessNode for each node in the relation and ProcessEdge for
+    % each edge in the relation. Each node is processed followed by all the
+    % edges originating at that node, until all nodes have been processed.
 	%
 :- pred relation__traverse(relation(K), pred(K, T, T), pred(K, K, T, T), T, T).
 :- mode relation__traverse(in, pred(in, di, uo) is det,
@@ -340,21 +325,18 @@
 	from_int(Int) = relation_key(Int)
 ].
 
-	% Note that the integer keys in the maps below are
-	% actually relation keys.  We use the raw integers as
-	% keys to allow type specialization.
-:- type relation(T) --->
-	relation(
+    % Note that the integer keys in the maps below are actually relation keys.
+    % We use the raw integers as keys to allow type specialization.
+:- type relation(T)
+    --->    relation(
 		relation_key,				% Next key
 		bimap(T, relation_key),			% Elements <-> keys
 		key_set_map,				% The mapping U -> V
-		key_set_map				% The reverse mapping
-							% V -> U
+                key_set_map                     % The reverse mapping V -> U
 	).
 
 %------------------------------------------------------------------------------%
 
-	% relation__init creates a new relation.
 relation__init(relation(relation_key(0), ElMap, FwdMap, BwdMap)) :-
 	bimap__init(ElMap),
 	map__init(FwdMap),
@@ -362,27 +344,23 @@
 
 %------------------------------------------------------------------------------%
 
-	% relation__add_element adds an element to the domain of a relation.
-	% Return the old relation_key if one already exists.
-relation__add_element(relation(relation_key(Key0), ElMap0, Fwd, Rev),
-		Elem, NewKey, relation(relation_key(Key), ElMap, Fwd, Rev)) :-
+relation__add_element(Rel0, Elem, NewKey, Rel) :-
+    Rel0 = relation(relation_key(Key0), ElMap0, Fwd, Rev),
 	( bimap__search(ElMap0, Elem, NewKey0) ->
-		Key = Key0, NewKey = NewKey0, ElMap = ElMap0
+        NewKey = NewKey0,
+        Rel = Rel0
 	;
 		NewKey = relation_key(Key0),
 		Key = Key0 + 1,
-		bimap__set(ElMap0, Elem, NewKey, ElMap)
+        bimap__set(ElMap0, Elem, NewKey, ElMap),
+        Rel = relation(relation_key(Key), ElMap, Fwd, Rev)
 	).
 
 %------------------------------------------------------------------------------%
 
-	% relation__search_element returns the relation_key associated
-        % with a domain element.  Fail if the relation_key is not valid.
 relation__search_element(relation(_Key, ElMap, _Fwd, _Rev), Elem, Key) :-
         bimap__search(ElMap, Elem, Key).
 
-	% relation__lookup_element returns the relation_key associated
-        % with a domain element.  Abort if the relation_key is not valid.
 relation__lookup_element(Rel, Elem, Key) :-
 	( relation__search_element(Rel, Elem, Key0) ->
 		Key = Key0
@@ -392,13 +370,9 @@
 
 %------------------------------------------------------------------------------%
 
-	% relation__search_key returns the domain element associated
-	% with a relation_key.  Fail if the relation_key is not valid.
 relation__search_key(relation(_Key, ElMap, _Fwd, _Rev), Key, Elem) :-
 	bimap__search(ElMap, Elem, Key).
 
-	% relation__lookup_key returns the domain element associated
-	% with a relation_key.  Abort if the relation_key is not valid.
 relation__lookup_key(Rel, Key, Elem) :-
 	( relation__search_key(Rel, Key, Elem0) ->
 		Elem = Elem0
@@ -413,10 +387,8 @@
 	relation__add_element(R1, Y, YKey, R2),
 	relation__add(R2, XKey, YKey, R).
 
-	% relation__add adds an element to the relation.
-relation__add(relation(Key, ElMap, FwdIn, BwdIn),
-		UKey @ relation_key(U), VKey @ relation_key(V),
-		relation(Key, ElMap, FwdOut, BwdOut)) :-
+relation__add(Rel0, UKey @ relation_key(U), VKey @ relation_key(V), Rel) :-
+    Rel0 = relation(Key, ElMap, FwdIn, BwdIn),
 	( map__search(FwdIn, U, VSet0) ->
 		( contains(VSet0, VKey) ->
 			FwdOut = FwdIn
@@ -440,23 +412,26 @@
 		init(USet0),
 		insert(USet0, UKey, USet1),
 		map__det_insert(BwdIn, V, USet1, BwdOut)
-	).
+    ),
+    Rel = relation(Key, ElMap, FwdOut, BwdOut).
+
+:- pred relation__sv_add(relation_key::in, relation_key::in,
+    relation(T)::in, relation(T)::out) is det.
+
+relation__sv_add(UKey, VKey, Rel0, Rel) :-
+    relation__add(Rel0, UKey, VKey, Rel).
 
 %------------------------------------------------------------------------------%
 
-	% relation__add_assoc_list adds a list of elements to
-	% a relation.
 relation__add_assoc_list(Rel, [], Rel).
-relation__add_assoc_list(Rel0, [U - V | Elems], Rel1) :-
-	relation__add(Rel0, U, V, Rel2),
-	relation__add_assoc_list(Rel2, Elems, Rel1).
+relation__add_assoc_list(Rel0, [U - V | Elems], Rel) :-
+    relation__add(Rel0, U, V, Rel1),
+    relation__add_assoc_list(Rel1, Elems, Rel).
 
 %------------------------------------------------------------------------------%
 
-	% relation__remove removes an element from the relation.
-relation__remove(relation(Key, ElMap, FwdIn, BwdIn),
-		UKey @ relation_key(U), VKey @ relation_key(V),
-		relation(Key, ElMap, FwdOut, BwdOut)) :-
+relation__remove(Rel0, UKey @ relation_key(U), VKey @ relation_key(V), Rel) :-
+    Rel0 = relation(Key, ElMap, FwdIn, BwdIn),
 	( map__search(FwdIn, U, VSet0) ->
 		delete(VSet0, VKey, VSet1),
 		map__det_update(FwdIn, U, VSet1, FwdOut)
@@ -468,31 +443,26 @@
 		map__det_update(BwdIn, V, USet1, BwdOut)
 	;
 		BwdIn = BwdOut
-	).
+    ),
+    Rel = relation(Key, ElMap, FwdOut, BwdOut).
 
 %------------------------------------------------------------------------------%
 
-	% relation__remove_assoc_list removes a list of elements
-	% from a relation.
 relation__remove_assoc_list(Rel, [], Rel).
-relation__remove_assoc_list(Rel0, [U - V | Elems], Rel1) :-
-	relation__remove(Rel0, U, V, Rel2),
-	relation__remove_assoc_list(Rel2, Elems, Rel1).
+relation__remove_assoc_list(Rel0, [U - V | Elems], Rel) :-
+    relation__remove(Rel0, U, V, Rel1),
+    relation__remove_assoc_list(Rel1, Elems, Rel).
 
 %------------------------------------------------------------------------------%
 
-	% relation__lookup checks to see if an element is
-	% in the relation.
 relation__lookup(relation(_Key, _ElMap, Fwd, _Bwd), relation_key(U), V) :-
 	map__search(Fwd, U, VSet),
 	member(V, VSet).
 
 %------------------------------------------------------------------------------%
 
-	% relation__reverse_lookup checks to see if an element is
-	% in the relation.
-relation__reverse_lookup(relation(_Key, _ElMap, _Fwd, Bwd),
-		U, relation_key(V)) :-
+relation__reverse_lookup(Rel, U, relation_key(V)) :-
+    Rel = relation(_Key, _ElMap, _Fwd, Bwd),
 	map__search(Bwd, V, USet),
 	member(U, USet).
 
@@ -501,10 +471,8 @@
 relation__lookup_from(R, U, to_set(Vs)) :-
 	relation__lookup_key_set_from(R, U, Vs).
 
-	% relation__lookup_from returns the set of elements
-	% y such that xRy, given an x.
-relation__lookup_key_set_from(relation(_Key, _ElMap, Fwd, _Bwd),
-		relation_key(U), Vs) :-
+relation__lookup_key_set_from(Rel, relation_key(U), Vs) :-
+    Rel = relation(_Key, _ElMap, Fwd, _Bwd),
 	( map__search(Fwd, U, Vs0) ->
 		Vs = Vs0
 	;
@@ -521,8 +489,8 @@
 
 	% relation__lookup_to returns the set of elements
 	% x such that xRy, given some y.
-relation__lookup_key_set_to(relation(_Key, _ElMap, _Fwd, Bwd),
-		relation_key(V), Us) :-
+relation__lookup_key_set_to(Rel, relation_key(V), Us) :-
+    Rel = relation(_Key, _ElMap, _Fwd, Bwd),
 	( map__search(Bwd, V, Us0) ->
 		Us = Us0
 	;
@@ -534,8 +502,6 @@
 
 %------------------------------------------------------------------------------%
 
-	% relation__to_assoc_list turns a relation into a list of
-	% pairs of elements.
 relation__to_assoc_list(relation(_Key, ElMap, Fwd, _Bwd), List) :-
 	map__keys(Fwd, FwdKeys),
 	relation__to_assoc_list_2(Fwd, FwdKeys, ElMap, [], List).
@@ -549,28 +515,37 @@
 	relation__to_assoc_list_2(Fwd, Keys, ElementMap, !AssocList),
 	bimap__reverse_lookup(ElementMap, KeyEl, relation_key(Key)),
 	map__lookup(Fwd, Key, Set),
-	!:AssocList = sparse_bitset__foldr(
-		(func(U, AL) = [KeyEl - V | AL] :-
-			bimap__reverse_lookup(ElementMap, V, U)
-		), Set, !.AssocList).
+    sparse_bitset__foldr(accumulate_rev_lookup(ElementMap, KeyEl), Set,
+        !AssocList).
+
+:- pred accumulate_rev_lookup(bimap(T, relation_key)::in, T::in,
+    relation_key::in, assoc_list(T, T)::in, assoc_list(T, T)::out) is det.
+
+accumulate_rev_lookup(ElementMap, KeyEl, U, !AL) :-
+    bimap__reverse_lookup(ElementMap, V, U),
+    !:AL = [KeyEl - V | !.AL].
 
-	% relation__to_key_assoc_list turns a relation into a list of
-	% pairs of elements.
 relation__to_key_assoc_list(relation(_Key, _ElMap, Fwd, _Bwd), List) :-
 	map__keys(Fwd, FwdKeys),
 	relation__to_key_assoc_list_2(Fwd, FwdKeys, [], List).
 
-:- pred relation__to_key_assoc_list_2(key_set_map::in,
-	list(int)::in, assoc_list(relation_key, relation_key)::in,
+:- pred relation__to_key_assoc_list_2(key_set_map::in, list(int)::in,
+    assoc_list(relation_key, relation_key)::in,
 	assoc_list(relation_key, relation_key)::out) is det.
 
 relation__to_key_assoc_list_2(_Fwd, [], !AssocList).
 relation__to_key_assoc_list_2(Fwd, [Key | Keys], !AssocList) :-
 	relation__to_key_assoc_list_2(Fwd, Keys, !AssocList),
 	map__lookup(Fwd, Key, Set),
-	!:AssocList = sparse_bitset__foldr(
-		(func(U, AL) = [relation_key(Key) - U | AL]),
-		Set, !.AssocList).
+    sparse_bitset__foldr(accumulate_with_key(relation_key(Key)), Set,
+        !AssocList).
+
+:- pred accumulate_with_key(relation_key::in, relation_key::in, 
+    assoc_list(relation_key, relation_key)::in,
+    assoc_list(relation_key, relation_key)::out) is det.
+
+accumulate_with_key(RelKey, U, !AL) :-
+    !:AL = [RelKey - U | !.AL].
 
 %------------------------------------------------------------------------------%
 
@@ -584,8 +559,6 @@
 
 %------------------------------------------------------------------------------%
 
-	% relation__domain finds the set of all elements in the domain
-	% of a relation.
 relation__domain(relation(_Key, ElMap, _Fwd, _Bwd), Dom) :-
 	bimap__ordinates(ElMap, DomList),
 	sorted_list_to_set(DomList, Dom).
@@ -598,16 +571,12 @@
 
 %------------------------------------------------------------------------------%
 
-	% relation__inverse(R, R') is true iff R is the
-	% inverse of R'.  Given our representation, this
-	% is incredibly easy to achieve.
-relation__inverse(relation(Key, ElMap, Fwd, Bwd),
-		relation(Key, ElMap, Bwd, Fwd)).
+relation__inverse(Rel, InvRel) :-
+    Rel = relation(Key, ElMap, Fwd, Bwd),
+    InvRel = relation(Key, ElMap, Bwd, Fwd).
 
 %------------------------------------------------------------------------------%
 
-	% relation__compose(R1, R2, R) is true iff R is the
-	% composition of the relations R1 and R2.
 relation__compose(R1, R2, !:Compose) :-
 	!:Compose = relation__init,
 
@@ -634,10 +603,10 @@
 		sparse_bitset__init, R2NeededKeys),
 
 	% Add the elements to the composition.
-	{!:Compose, KeyMap1} = sparse_bitset__foldl(copy_element(R1),
-		R1NeededKeys, {!.Compose, map__init}),
-	{!:Compose, KeyMap2} = sparse_bitset__foldl(copy_element(R2),
-		R2NeededKeys, {!.Compose, map__init}),
+    sparse_bitset__foldl2(copy_element(R1), R1NeededKeys, !Compose,
+        map__init, KeyMap1),
+    sparse_bitset__foldl2(copy_element(R2), R2NeededKeys, !Compose,
+        map__init, KeyMap2),
 
 	% Add the arcs to the composition.
 	list__foldl(add_compose_arcs(KeyMap1, KeyMap2), KeyAL, !Compose).
@@ -660,66 +629,49 @@
 		map_key_set(KeyMap2, R2Keys),
 		!Compose).
 
-:- func copy_element(relation(T), relation_key, {relation(T), key_map}) =
-	{relation(T), key_map}.
+:- pred copy_element(relation(T)::in, relation_key::in,
+    relation(T)::in, relation(T)::out, key_map::in, key_map::out) is det.
 
-copy_element(R0, Key, {Compose0, KeyMap0}) = {Compose, KeyMap} :-
+copy_element(R0, Key, !Compose, !KeyMap) :-
 	relation__lookup_key(R0, Key, Elem),
-	relation__add_element(Compose0, Elem, ComposeKey, Compose),
+    relation__add_element(!.Compose, Elem, ComposeKey, !:Compose),
 	Key = relation_key(KeyInt),
-	map__det_insert(KeyMap0, KeyInt, ComposeKey, KeyMap).
+    map__det_insert(!.KeyMap, KeyInt, ComposeKey, !:KeyMap).
 
 :- func map_key_set(key_map, relation_key_set) = relation_key_set.
 
 map_key_set(KeyMap, Set0) = Set :-
-	Set = sparse_bitset__foldl(
-		(func(Key0, Set1) = Set2 :-
+    sparse_bitset__foldl(accumulate_key_set(KeyMap), Set0, init, Set).
+
+:- pred accumulate_key_set(key_map::in, relation_key::in,
+    relation_key_set::in, relation_key_set::out) is det.
+
+accumulate_key_set(KeyMap, Key0, !Set) :-
 			Key0 = relation_key(KeyInt),
 			map__lookup(KeyMap, KeyInt, Key),
-			Set2 = insert(Set1, Key)
-		), Set0, init).
+    !:Set = insert(!.Set, Key).
 
 %------------------------------------------------------------------------------%
 
-	% relation__dfs/3 performs a depth-first search of
-	% a relation.  It returns the elements in visited
-	% order.
 relation__dfs(Rel, X, Dfs) :-
 	relation__dfsrev(Rel, X, DfsRev),
 	list__reverse(DfsRev, Dfs).
 
-	% relation__dfsrev/3 performs a depth-first search of
-	% a relation.  It returns the elements in reverse visited
-	% order.
 relation__dfsrev(Rel, X, DfsRev) :-
 	init(Vis0),
 	relation__dfs_2(Rel, X, Vis0, _, [], DfsRev).
 
-	% relation__dfs/5 performs a depth-first search of
-	% a relation.  It returns the elements in visited
-	% order.  Providing the nodes Visited0 have already been
-	% visited.
 relation__dfs(Rel, X, Visited0, Visited, Dfs) :-
 	relation__dfs_2(Rel, X, Visited0, Visited, [], DfsRev),
 	list__reverse(DfsRev, Dfs).
 
-	% relation__dfsrev/5 performs a depth-first search of
-	% a relation.  It returns the elements in reverse visited
-	% order.  Providing the nodes Visited0 have already been
-	% visited.
 relation__dfsrev(Rel, X, Visited0, Visited, DfsRev) :-
 	relation__dfs_2(Rel, X, Visited0, Visited, [], DfsRev).
 
-	% relation__dfs(Rel, Dfs) is true if Dfs is a depth-
-	% first sorting of Rel.  Where the nodes are in the
-	% order visited.
 relation__dfs(Rel, Dfs) :-
 	relation__dfsrev(Rel, DfsRev),
 	list__reverse(DfsRev, Dfs).
 
-	% relation__dfsrev(Rel, Dfs) is true if Dfs is a depth-
-	% first sorting of Rel.  Where the nodes are in the reverse
-	% order visited.
 relation__dfsrev(Rel, DfsRev) :-
 	relation__domain_sorted_list(Rel, DomList),
 	list__foldl2(relation__dfs_2(Rel), DomList, init, _, [], DfsRev).
@@ -735,22 +687,16 @@
 		relation__lookup_key_set_from(Rel, Node, AdjSet),
 		insert(!.Visit, Node, !:Visit),
 
-		% Go and visit all of the node's children first
-		{!:Visit, !:DfsRev} = foldl(
-			(func(Adj, {!.Visit, !.DfsRev}) =
-					{!:Visit, !:DfsRev} :-
-				relation__dfs_2(Rel, Adj, !Visit, !DfsRev)
-			), AdjSet, {!.Visit, !.DfsRev}),
-
+        % Go and visit all of the node's children first.
+        sparse_bitset__foldl2(relation__dfs_2(Rel), AdjSet, !Visit, !DfsRev),
 		!:DfsRev = [Node | !.DfsRev]
 	).
 
 %------------------------------------------------------------------------------%
 
-	% relation__is_dag
+relation__is_dag(R) :-
 	%	Does a DFS on the relation.  It is a directed acylic graph
 	%	if at each node we never visit an already visited node.
-relation__is_dag(R) :-
 	relation__domain_sorted_list(R, DomList),
 	init(Visit),
 	init(AllVisit),
@@ -780,14 +726,12 @@
 	;
 		relation__lookup_key_set_from(Rel, Node, AdjSet),
 		!:AllVisited = insert(!.AllVisited, Node),
-		foldl(relation__is_dag_2(Rel, insert(Visit, Node)),
-			AdjSet, !AllVisited)
+        foldl(relation__is_dag_2(Rel, insert(Visit, Node)), AdjSet,
+            !AllVisited)
 	).
 
 %------------------------------------------------------------------------------%
 
-	% relation__components takes a relation and returns
-	% a set of the connected components.
 relation__components(Rel, Set) :-
 	relation__domain_sorted_list(Rel, DomList),
 	relation__components_2(Rel, DomList, set__init, SetofBitsets),
@@ -868,16 +812,13 @@
 	list_to_set(StrongComponent, StrongComponentSet),
 	set__insert(Cliques0, StrongComponentSet, Cliques1),
 
-		% Delete all the visited elements, so first element of the
-		% list is the next highest number node.
+    % Delete all the visited elements, so first element of the list
+    % is the next highest number node.
 	list__delete_elems(T0, StrongComponent, T),
 	relation__cliques_2(T, RelInv, Visit, Cliques1, Cliques).
 
 %------------------------------------------------------------------------------%
 
-	% relation__reduced(R, Red) is true if Red is
-	% the reduced relation (relation of cliques)
-	% obtained from R.
 relation__reduced(Rel, Red) :-
 	relation__cliques(Rel, Cliques),
 	set__to_sorted_list(Cliques, CliqList),
@@ -887,56 +828,54 @@
 	relation__to_key_assoc_list(Rel, RelAL),
 	relation__make_reduced_graph(CliqMap, RelAL, Red1, Red).
 
-:- pred relation__make_clique_map(relation(T), list(set(relation_key)),
-		map(relation_key, relation_key),
-		map(relation_key, relation_key),
-		relation(set(T)), relation(set(T))).
-:- mode relation__make_clique_map(in, in, in, out, in, out) is det.
-relation__make_clique_map(_Rel, [], Map, Map, Red, Red).
-relation__make_clique_map(Rel, [S | Ss], Map0, Map, Red0, Red) :-
+:- pred relation__make_clique_map(relation(T)::in, list(set(relation_key))::in,
+    map(relation_key, relation_key)::in,
+    map(relation_key, relation_key)::out,
+    relation(set(T))::in, relation(set(T))::out) is det.
+
+relation__make_clique_map(_Rel, [], !Map, !Red).
+relation__make_clique_map(Rel, [S | Ss], !Map, !Red) :-
 	to_sorted_list(S, SList),
 	list__map(relation__lookup_key(Rel), SList, EList),
 	list_to_set(EList, ESet),
-	relation__add_element(Red0, ESet, SKey, Red1),
-	relation__make_clique_map_2(Map0, SKey, SList, Map1),
-	relation__make_clique_map(Rel, Ss, Map1, Map, Red1, Red).
-
-:- pred relation__make_clique_map_2(map(relation_key, relation_key),
-		relation_key, list(relation_key),
-		map(relation_key, relation_key)).
-:- mode relation__make_clique_map_2(in, in, in, out) is det.
-relation__make_clique_map_2(Map, _Key, [], Map).
-relation__make_clique_map_2(MapIn, Key, [X | Xs], MapOut) :-
-	map__set(MapIn, X, Key, Map1),
-	relation__make_clique_map_2(Map1, Key, Xs, MapOut).
-
-:- pred relation__make_reduced_graph(map(relation_key, relation_key),
-		assoc_list(relation_key, relation_key),
-		relation(set(T)), relation(set(T))).
-:- mode relation__make_reduced_graph(in, in, in, out) is det.
-relation__make_reduced_graph(_Map, [], Rel, Rel).
-relation__make_reduced_graph(Map, [U - V | Rest], Rel0, Rel) :-
+    relation__add_element(!.Red, ESet, SKey, !:Red),
+    relation__make_clique_map_2(SKey, SList, !Map),
+    relation__make_clique_map(Rel, Ss, !Map, !Red).
+
+:- pred relation__make_clique_map_2(relation_key::in, list(relation_key)::in,
+    map(relation_key, relation_key)::in, map(relation_key, relation_key)::out)
+    is det.
+
+relation__make_clique_map_2(_Key, [], !Map).
+relation__make_clique_map_2(Key, [X | Xs], !Map) :-
+    map__set(!.Map, X, Key, !:Map),
+    relation__make_clique_map_2(Key, Xs, !Map).
+
+:- pred relation__make_reduced_graph(map(relation_key, relation_key)::in,
+    assoc_list(relation_key, relation_key)::in,
+    relation(set(T))::in, relation(set(T))::out) is det.
+
+relation__make_reduced_graph(_Map, [], !Rel).
+relation__make_reduced_graph(Map, [U - V | Rest], !Rel) :-
 	map__lookup(Map, U, USet),
 	map__lookup(Map, V, VSet),
 	( USet = VSet ->
-		Rel1 = Rel0
+        true
 	;
-		relation__add(Rel0, USet, VSet, Rel1)
+        relation__add(!.Rel, USet, VSet, !:Rel)
 	),
-	relation__make_reduced_graph(Map, Rest, Rel1, Rel).
+    relation__make_reduced_graph(Map, Rest, !Rel).
 
 %------------------------------------------------------------------------------%
 
-	% relation__tsort returns a topological sorting
-	% of a relation.  It fails if the relation is cyclic.
 relation__tsort(Rel, Tsort) :-
 	relation__dfsrev(Rel, Tsort0),
 	relation__check_tsort(Rel, init, Tsort0),
 	Tsort = list__map(relation__lookup_key(Rel), Tsort0).
 
-:- pred relation__check_tsort(relation(T), relation_key_set,
-		list(relation_key)).
-:- mode relation__check_tsort(in, in, in) is semidet.
+:- pred relation__check_tsort(relation(T)::in, relation_key_set::in,
+    list(relation_key)::in) is semidet.
+
 relation__check_tsort(_Rel, _Vis, []).
 relation__check_tsort(Rel, Vis, [X | Xs]) :-
 	insert(Vis, X, Vis1),
@@ -947,6 +886,7 @@
 
 %------------------------------------------------------------------------------%
 
+relation__atsort(Rel, ATsort) :-
 	% relation__atsort returns a topological sorting
 	% of the cliques in a relation.
 	%
@@ -955,33 +895,28 @@
 	%	R. E. Tarjan, "Depth-first search and
 	%	linear graph algorithms,"  SIAM Journal
 	%	on Computing, 1, 2 (1972).
-relation__atsort(Rel, ATsort) :-
 	relation__dfsrev(Rel, DfsRev),
 	relation__inverse(Rel, RelInv),
 	init(Visit),
 	relation__atsort_2(DfsRev, RelInv, Visit, [], ATsort0),
 	list__reverse(ATsort0, ATsort).
 
-:- pred relation__atsort_2(list(relation_key), relation(T),
-	relation_key_set, list(set(T)), list(set(T))).
-:- mode relation__atsort_2(in, in, in, in, out) is det.
+:- pred relation__atsort_2(list(relation_key)::in, relation(T)::in,
+    relation_key_set::in, list(set(T))::in, list(set(T))::out) is det.
 
-relation__atsort_2([], _, _, ATsort, ATsort).
-relation__atsort_2([H | T], RelInv, Visit0, ATsort0, ATsort) :-
+relation__atsort_2([], _, _, !ATsort).
+relation__atsort_2([H | T], RelInv, Visit0, !ATsort) :-
 	( contains(Visit0, H) ->
-		relation__atsort_2(T, RelInv, Visit0, ATsort0, ATsort)
+        relation__atsort_2(T, RelInv, Visit0, !ATsort)
 	;
 		relation__dfs_2(RelInv, H, Visit0, Visit, [], CliqueL),
 		list__map(relation__lookup_key(RelInv), CliqueL, Clique),
 		set__list_to_set(Clique, CliqueSet),
-		relation__atsort_2(T, RelInv, Visit, [CliqueSet | ATsort0],
-				ATsort)
+        relation__atsort_2(T, RelInv, Visit, [CliqueSet | !.ATsort], !:ATsort)
 	).
 
 %------------------------------------------------------------------------------%
 
-	% relation__sc returns the symmetric closure of
-	% a relation.
 relation__sc(Rel, Sc) :-
 	relation__inverse(Rel, Inv),
 	relation__to_key_assoc_list(Inv, InvList),
@@ -989,8 +924,9 @@
 
 %------------------------------------------------------------------------------%
 
-	% relation__tc returns the transitive closure of
-	% a relation.  We use this procedure:
+relation__tc(Rel, Tc) :-
+    % relation__tc returns the transitive closure of a relation.
+    % We use this procedure:
 	%
 	%	- Compute the reflexive transitive closure.
 	%	- Find the "fake reflexives", that is, the
@@ -1001,10 +937,9 @@
 	%	  { x | yRx and xR*y } is empty.
 	%	- Remove those elements from the reflexive
 	%	  transitive closure computed above.
-relation__tc(Rel, Tc) :-
 	relation__rtc(Rel, Rtc),
 
-	% Find the fake reflexives
+    % Find the fake reflexives.
 	relation__domain_sorted_list(Rel, DomList),
 	relation__detect_fake_reflexives(Rel, Rtc, DomList, FakeRefl),
 
@@ -1012,9 +947,9 @@
 	assoc_list__from_corresponding_lists(FakeRefl, FakeRefl, FakeReflComp),
 	relation__remove_assoc_list(Rtc, FakeReflComp, Tc).
 
-:- pred relation__detect_fake_reflexives(relation(T), relation(T),
-		list(relation_key), list(relation_key)).
-:- mode relation__detect_fake_reflexives(in, in, in, out) is det.
+:- pred relation__detect_fake_reflexives(relation(T)::in, relation(T)::in,
+    list(relation_key)::in, list(relation_key)::out) is det.
+
 relation__detect_fake_reflexives(_Rel, _Rtc, [], []).
 relation__detect_fake_reflexives(Rel, Rtc, [X | Xs], FakeRefl) :-
 	relation__detect_fake_reflexives(Rel, Rtc, Xs, Fake1),
@@ -1029,22 +964,19 @@
 
 %------------------------------------------------------------------------------%
 
-	% relation__rtc returns the reflexive transitive closure
-	% of a relation.
+relation__rtc(Rel, RTC) :-
+    % relation__rtc returns the reflexive transitive closure of a relation.
 	%
-	% Note: This is not the most efficient algorithm (in the sense
-	% of minimal number of arc insertions) possible.  However it
-	% "reasonably" efficient and, more importantly, is much easier
-	% to debug than some others.
-	%
-	% The algorithm is very simple, and is based on the
-	% observation that the RTC of any element in a clique is the
-	% same as the RTC of any other element in that clique.  So
-	% we visit each clique in reverse topological sorted order,
-	% compute the RTC for each element in the clique and then
+    % Note: This is not the most efficient algorithm (in the sense of minimal
+    % number of arc insertions) possible. However it "reasonably" efficient
+    % and, more importantly, is much easier to debug than some others.
+    %
+    % The algorithm is very simple, and is based on the observation that the
+    % RTC of any element in a clique is the same as the RTC of any other
+    % element in that clique. So we visit each clique in reverse topological
+    % sorted order, compute the RTC for each element in the clique and then
 	% add the appropriate arcs.
 	%
-relation__rtc(Rel, RTC) :-
 	relation__dfs(Rel, Dfs),
 	init(Visit),
 
@@ -1055,9 +987,8 @@
 
 	relation__rtc_2(Dfs, Rel, Visit, RTC0, RTC).
 
-:- pred relation__rtc_2(list(relation_key), relation(T),
-	relation_key_set, relation(T), relation(T)).
-:- mode relation__rtc_2(in, in, in, in, out) is det.
+:- pred relation__rtc_2(list(relation_key)::in, relation(T)::in,
+    relation_key_set::in, relation(T)::in, relation(T)::out) is det.
 
 relation__rtc_2([], _, _, !RTC).
 relation__rtc_2([H | T], Rel, Visit0, !RTC) :-
@@ -1067,8 +998,7 @@
 		relation__dfs_2(Rel, H, Visit0, Visit, [], CliqueL0),
 		list_to_set(CliqueL0, CliqueL),
 		foldl(find_followers(Rel), CliqueL, CliqueL, CliqueFollowers),
-		foldl(find_followers(!.RTC), CliqueFollowers,
-			CliqueL, NewFollowers),
+        foldl(find_followers(!.RTC), CliqueFollowers, CliqueL, NewFollowers),
 		relation__add_cartesian_product(CliqueL, NewFollowers, !RTC),
 		relation__rtc_2(T, Rel, Visit, !RTC)
 	).
@@ -1084,20 +1014,15 @@
 	relation_key_set::in, relation(T)::in, relation(T)::out) is det.
 
 relation__add_cartesian_product(KeySet1, KeySet2, !RTC) :-
-    foldl(
-	(pred(Key1::in, !.RTC::in, !:RTC::out) is det :-
-	    foldl(
-		(pred(Key2::in, !.RTC::in, !:RTC::out) is det :-
-		    relation__add(!.RTC, Key1, Key2, !:RTC)
-		), KeySet2, !RTC)
+    foldl((pred(Key1::in, !.RTC::in, !:RTC::out) is det :-
+        foldl(relation__sv_add(Key1), KeySet2, !RTC)
 	), KeySet1, !RTC).
 
 %------------------------------------------------------------------------------%
 
 relation__traverse(Relation, ProcessNode, ProcessEdge, !Acc) :-
 	Domain = to_sorted_list(relation__domain(Relation)),
-	relation__traverse_nodes(Domain, Relation, ProcessNode, ProcessEdge,
-		!Acc).
+    relation__traverse_nodes(Domain, Relation, ProcessNode, ProcessEdge, !Acc).
 
 :- pred relation__traverse_nodes(list(K), relation(K), pred(K, T, T),
 	pred(K, K, T, T), T, T).
@@ -1115,10 +1040,8 @@
 	Children = to_sorted_list(lookup_from(Relation,
 		lookup_element(Relation, Node))),
 	ProcessNode(Node, !Acc),
-	relation__traverse_children(Children, Node, Relation, ProcessEdge,
-		!Acc),
-	relation__traverse_nodes(Nodes, Relation, ProcessNode, ProcessEdge,
-		!Acc).
+    relation__traverse_children(Children, Node, Relation, ProcessEdge, !Acc),
+    relation__traverse_nodes(Nodes, Relation, ProcessNode, ProcessEdge, !Acc).
 
 :- pred relation__traverse_children(list(relation_key), K, relation(K),
 	pred(K, K, T, T), T, T).
@@ -1132,8 +1055,7 @@
 		Relation, ProcessEdge, !Acc) :-
 	Child = lookup_key(Relation, ChildKey),
 	ProcessEdge(Parent, Child, !Acc),
-	relation__traverse_children(Children, Parent, Relation, ProcessEdge,
-		!Acc).
+    relation__traverse_children(Children, Parent, Relation, ProcessEdge, !Acc).
 
 %------------------------------------------------------------------------------%
 %------------------------------------------------------------------------------%
Index: sparse_bitset.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/sparse_bitset.m,v
retrieving revision 1.23
diff -u -b -r1.23 sparse_bitset.m
--- sparse_bitset.m	16 Jun 2005 04:08:04 -0000	1.23
+++ sparse_bitset.m	31 Aug 2005 07:10:16 -0000
@@ -1,8 +1,11 @@
 %-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
 % Copyright (C) 2000-2005 The University of Melbourne.
 % This file may only be copied under the terms of the GNU Library General
 % Public License - see the file COPYING.LIB in the Mercury distribution.
 %-----------------------------------------------------------------------------%
+%
 % File: sparse_bitset.m.
 % Author: stayl
 % Stability: medium.
@@ -12,7 +15,6 @@
 % is much more compact than the representation provided by set.m,
 % and the operations will be much faster.
 %
-%
 % Efficiency notes:
 %
 % A sparse bitset is represented as a sorted list of pairs of integers.
@@ -50,6 +52,7 @@
 :- type sparse_bitset(T). % <= enum(T).
 
 	% Return an empty set.
+    %
 :- func init = sparse_bitset(T).
 
 :- pred init(sparse_bitset(T)).
@@ -59,58 +62,50 @@
 :- mode empty(in) is semidet.
 :- mode empty(out) is det.
 
-	% `equal(SetA, SetB' is true iff `SetA' and `SetB'
-	% contain the same elements.
-	% Takes O(min(rep_size(SetA), rep_size(SetB))) time.
+    % `equal(SetA, SetB' is true iff `SetA' and `SetB' contain the same
+    % elements. Takes O(min(rep_size(SetA), rep_size(SetB))) time.
 	%
 :- pred equal(sparse_bitset(T)::in, sparse_bitset(T)::in) is semidet.
 
-	% `list_to_set(List)' returns a set
-	% containing only the members of `List'.
-	% In the worst case this will take O(length(List)^2) time
-	% and space. If the elements of the list are closely
-	% grouped, it will be closer to O(length(List)).
+    % `list_to_set(List)' returns a set containing only the members of `List'.
+    % In the worst case this will take O(length(List)^2) time and space.
+    % If the elements of the list are closely grouped, it will be closer
+    % to O(length(List)).
 	%
 :- func list_to_set(list(T)) = sparse_bitset(T) <= enum(T).
 :- pred list_to_set(list(T)::in, sparse_bitset(T)::out) is det <= enum(T).
 
-	% `sorted_list_to_set(List)' returns a set containing
-	% only the members of `List'.
-	% `List' must be sorted.
-	% Takes O(length(List)) time and space.
+    % `sorted_list_to_set(List)' returns a set containing only the members
+    % of `List'. `List' must be sorted. Takes O(length(List)) time and space.
 	%
 :- func sorted_list_to_set(list(T)) = sparse_bitset(T) <= enum(T).
 :- pred sorted_list_to_set(list(T)::in, sparse_bitset(T)::out)
 	is det <= enum(T).
 
-	% `sorted_list_to_set(Set)' returns a bitset containing
-	% only the members of `Set'.
-	% `List' must be sorted.
-	% Takes O(card(Set)) time and space.
+    % `sorted_list_to_set(Set)' returns a bitset containing only the members
+    % of `Set'. `List' must be sorted. Takes O(card(Set)) time and space.
 	%
 :- func from_set(set.set(T)) = sparse_bitset(T) <= enum(T).
 
-	% `to_sorted_list(Set)' returns a list
-	% containing all the members of `Set', in sorted order.
-	% Takes O(card(Set)) time and space.
+    % `to_sorted_list(Set)' returns a list containing all the members of `Set',
+    % in sorted order. Takes O(card(Set)) time and space.
 	%
 :- func to_sorted_list(sparse_bitset(T)) = list(T) <= enum(T).
 :- pred to_sorted_list(sparse_bitset(T)::in, list(T)::out) is det <= enum(T).
 
-	% `to_sorted_list(Set)' returns a set.set containing all
-	% the members of `Set', in sorted order.
-	% Takes O(card(Set)) time and space.
+    % `to_sorted_list(Set)' returns a set.set containing all the members
+    % of `Set', in sorted order. Takes O(card(Set)) time and space.
 	%
 :- func to_set(sparse_bitset(T)) = set.set(T) <= enum(T).
 
-	% `make_singleton_set(Elem)' returns a set
-	% containing just the single element `Elem'.
+    % `make_singleton_set(Elem)' returns a set containing just the single
+    % element `Elem'.
 	%
 :- func make_singleton_set(T) = sparse_bitset(T) <= enum(T).
 
-	% Note: set.m contains the reverse mode of this predicate,
-	% but it is difficult to implement both modes using
-	% the representation in this module.
+    % Note: set.m contains the reverse mode of this predicate, but it is
+    % difficult to implement both modes using the representation in this
+    % module.
 	%
 :- pred singleton_set(sparse_bitset(T)::out, T::in) is det <= enum(T).
 
@@ -119,8 +114,7 @@
 	%
 :- pred subset(sparse_bitset(T)::in, sparse_bitset(T)::in) is semidet.
 
-	% `superset(Superset, Set)' is true iff `Superset' is a
-	% superset of `Set'.
+    % `superset(Superset, Set)' is true iff `Superset' is a superset of `Set'.
 	% Same as `intersect(Superset, Set, Set)', but may be more efficient.
 	%
 :- pred superset(sparse_bitset(T)::in, sparse_bitset(T)::in) is semidet.
@@ -137,53 +131,49 @@
 :- mode member(in, in) is semidet.
 :- mode member(out, in) is nondet.
 
-	% `insert(Set, X)' returns the union
-	% of `Set' and the set containing only `X'.
-	% Takes O(rep_size(Set)) time and space.
+    % `insert(Set, X)' returns the union of `Set' and the set containing
+    % only `X'. Takes O(rep_size(Set)) time and space.
 	%
 :- func insert(sparse_bitset(T), T) = sparse_bitset(T) <= enum(T).
 :- pred insert(sparse_bitset(T)::in, T::in, sparse_bitset(T)::out)
 	is det <= enum(T).
 
-	% `insert_list(Set, X)' returns the union of `Set' and the set
-	% containing only the members of `X'.
-	% Same as `union(Set, list_to_set(X))', but may be more efficient.
+    % `insert_list(Set, X)' returns the union of `Set' and the set containing
+    % only the members of `X'. Same as `union(Set, list_to_set(X))', but may be
+    % more efficient.
 	%
 :- func insert_list(sparse_bitset(T), list(T)) = sparse_bitset(T) <= enum(T).
 :- pred insert_list(sparse_bitset(T)::in, list(T)::in, sparse_bitset(T)::out)
 	is det <= enum(T).
 
-	% `delete(Set, X)' returns the difference
-	% of `Set' and the set containing only `X'.
-	% Takes O(rep_size(Set)) time and space.
+    % `delete(Set, X)' returns the difference of `Set' and the set containing
+    % only `X'. Takes O(rep_size(Set)) time and space.
 	%
 :- func delete(sparse_bitset(T), T) = sparse_bitset(T) <= enum(T).
 :- pred delete(sparse_bitset(T)::in, T::in, sparse_bitset(T)::out)
 	is det <= enum(T).
 
 	% `delete_list(Set, X)' returns the difference of `Set' and the set
-	% containing only the members of `X'.
-	% Same as `difference(Set, list_to_set(X))', but may be more efficient.
+    % containing only the members of `X'. Same as
+    % `difference(Set, list_to_set(X))', but may be more efficient.
 	%
 :- func delete_list(sparse_bitset(T), list(T)) = sparse_bitset(T) <= enum(T).
 :- pred delete_list(sparse_bitset(T)::in, list(T)::in, sparse_bitset(T)::out)
 	is det <= enum(T).
 
-	% `remove(Set, X)' returns the difference
-	% of `Set' and the set containing only `X',
-	% failing if `Set' does not contain `X'.
-	% Takes O(rep_size(Set)) time and space.
+    % `remove(Set, X)' returns the difference of `Set' and the set containing
+    % only `X', failing if `Set' does not contain `X'. Takes O(rep_size(Set))
+    % time and space.
 	%
 :- func remove(sparse_bitset(T)::in, T::in) = (sparse_bitset(T)::out)
 	is semidet <= enum(T).
 :- pred remove(sparse_bitset(T)::in, T::in, sparse_bitset(T)::out)
 	is semidet <= enum(T).
 
-	% `remove_list(Set, X)' returns the difference of `Set'
-	% and the set containing all the elements of `X',
-	% failing if any element of `X' is not in `Set0'.
-	% Same as
-	%	`subset(list_to_set(X), Set), difference(Set, list_to_set(X))',
+    % `remove_list(Set, X)' returns the difference of `Set' and the set
+    % containing all the elements of `X', failing if any element of `X'
+    % is not in `Set0'.
+    % Same as `subset(list_to_set(X), Set), difference(Set, list_to_set(X))',
 	% but may be more efficient.
 	%
 :- func remove_list(sparse_bitset(T)::in, list(T)::in) = (sparse_bitset(T)::out)
@@ -191,53 +181,49 @@
 :- pred remove_list(sparse_bitset(T)::in, list(T)::in, sparse_bitset(T)::out)
 	is semidet <= enum(T).
 
-	% `remove_leq(Set, X)' returns `Set' with all elements less than
-	% or equal to `X' removed. In other words, it returns the set
-	% containing all the elements of `Set' which are greater than `X'.
+    % `remove_leq(Set, X)' returns `Set' with all elements less than or equal
+    % to `X' removed. In other words, it returns the set containing all the
+    % elements of `Set' which are greater than `X'.
 	%
 :- func remove_leq(sparse_bitset(T), T) = sparse_bitset(T) <= enum(T).
 :- pred remove_leq(sparse_bitset(T)::in, T::in, sparse_bitset(T)::out)
 	is det <= enum(T).
 
-	% `remove_gt(Set, X)' returns `Set' with all elements greater
-	% than `X' removed. In other words, it returns the set containing
-	% all the elements of `Set' which are less than or equal to `X'.
+    % `remove_gt(Set, X)' returns `Set' with all elements greater than `X'
+    % removed. In other words, it returns the set containing % all the elements
+    % of `Set' which are less than or equal to `X'.
 	%
 :- func remove_gt(sparse_bitset(T), T) = sparse_bitset(T) <= enum(T).
 :- pred remove_gt(sparse_bitset(T)::in, T::in, sparse_bitset(T)::out)
 	is det <= enum(T).
 
-	% `remove_least(Set0, X, Set)' is true iff `X' is the
-	% least element in `Set0', and `Set' is the set which
-	% contains all the elements of `Set0' except `X'.
-	% Takes O(1) time and space.
+    % `remove_least(Set0, X, Set)' is true iff `X' is the least element in
+    % `Set0', and `Set' is the set which contains all the elements of `Set0'
+    % except `X'. Takes O(1) time and space.
 	%
 :- pred remove_least(sparse_bitset(T)::in, T::out, sparse_bitset(T)::out)
 	is semidet <= enum(T).
 
-	% `union(SetA, SetB)' returns the union of `SetA' and `SetB'. 
-	% The efficiency of the union operation is not sensitive
-	% to the argument ordering.
-	% Takes O(rep_size(SetA) + rep_size(SetB)) time and space.
+    % `union(SetA, SetB)' returns the union of `SetA' and `SetB'. The
+    % efficiency of the union operation is not sensitive to the argument
+    % ordering. Takes O(rep_size(SetA) + rep_size(SetB)) time and space.
 	%
 :- func union(sparse_bitset(T), sparse_bitset(T)) = sparse_bitset(T).
 :- pred union(sparse_bitset(T)::in, sparse_bitset(T)::in,
 	sparse_bitset(T)::out) is det.
 
-	% `intersect(SetA, SetB)' returns the intersection of
-	% `SetA' and `SetB'. The efficiency of the intersection
-	% operation is not sensitive to the argument ordering.
-	% Takes O(rep_size(SetA) + rep_size(SetB)) time and
+    % `intersect(SetA, SetB)' returns the intersection of `SetA' and `SetB'.
+    % The efficiency of the intersection operation is not sensitive to the
+    % argument ordering. Takes O(rep_size(SetA) + rep_size(SetB)) time and
 	% O(min(rep_size(SetA)), rep_size(SetB)) space.
 	%
 :- func intersect(sparse_bitset(T), sparse_bitset(T)) = sparse_bitset(T).
 :- pred intersect(sparse_bitset(T)::in, sparse_bitset(T)::in,
 	sparse_bitset(T)::out) is det.
 
-	% `difference(SetA, SetB)' returns the set containing all the
-	% elements of `SetA' except those that occur in `SetB'.
-	% Takes O(rep_size(SetA) + rep_size(SetB)) time and
-	% O(rep_size(SetA)) space.
+    % `difference(SetA, SetB)' returns the set containing all the elements
+    % of `SetA' except those that occur in `SetB'. Takes
+    % O(rep_size(SetA) + rep_size(SetB)) time and O(rep_size(SetA)) space.
 	%
 :- func difference(sparse_bitset(T), sparse_bitset(T)) = sparse_bitset(T).
 :- pred difference(sparse_bitset(T)::in, sparse_bitset(T)::in,
@@ -248,38 +234,64 @@
 	%
 :- func count(sparse_bitset(T)) = int <= enum(T).
 
-	% `foldl(Func, Set, Start)' calls Func with each element
-	% of `Set' (in sorted order) and an accumulator
-	% (with the initial value of `Start'), and returns
-	% the final value.
-	% Takes O(card(Set)) time.
+    % `foldl(Func, Set, Start)' calls Func with each element of `Set'
+    % (in sorted order) and an accumulator (with the initial value of `Start'),
+    % and returns the final value. Takes O(card(Set)) time.
 	%
 :- func foldl(func(T, U) = U, sparse_bitset(T), U) = U <= enum(T).
 
 :- pred foldl(pred(T, U, U), sparse_bitset(T), U, U) <= enum(T).
-:- mode foldl(pred(in, in, out) is det, in, in, out) is det.
 :- mode foldl(pred(in, di, uo) is det, in, di, uo) is det.
+:- mode foldl(pred(in, in, out) is det, in, in, out) is det.
 :- mode foldl(pred(in, in, out) is semidet, in, in, out) is semidet.
 :- mode foldl(pred(in, in, out) is nondet, in, in, out) is nondet.
 :- mode foldl(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
 :- mode foldl(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
 
-	% `foldr(Func, Set, Start)' calls Func with each element
-	% of `Set' (in reverse sorted order) and an accumulator
-	% (with the initial value of `Start'), and returns
-	% the final value.
-	% Takes O(card(Set)) time.
+:- pred foldl2(pred(T, U, U, V, V), sparse_bitset(T), U, U, V, V) <= enum(T).
+:- mode foldl2(pred(in, di, uo, di, uo) is det, in, di, uo, di, uo) is det.
+:- mode foldl2(pred(in, in, out, di, uo) is det, in, in, out, di, uo) is det.
+:- mode foldl2(pred(in, in, out, in, out) is det, in, in, out, in, out) is det.
+:- mode foldl2(pred(in, in, out, in, out) is semidet, in, in, out, in, out)
+    is semidet.
+:- mode foldl2(pred(in, in, out, in, out) is nondet, in, in, out, in, out)
+    is nondet.
+:- mode foldl2(pred(in, di, uo, di, uo) is cc_multi, in, di, uo, di, uo)
+    is cc_multi.
+:- mode foldl2(pred(in, in, out, di, uo) is cc_multi, in, in, out, di, uo)
+    is cc_multi.
+:- mode foldl2(pred(in, in, out, in, out) is cc_multi, in, in, out, in, out)
+    is cc_multi.
+
+    % `foldr(Func, Set, Start)' calls Func with each element of `Set'
+    % (in reverse sorted order) and an accumulator (with the initial value
+    % of `Start'), and returns the final value. Takes O(card(Set)) time.
 	%
 :- func foldr(func(T, U) = U, sparse_bitset(T), U) = U <= enum(T).
 
 :- pred foldr(pred(T, U, U), sparse_bitset(T), U, U) <= enum(T).
-:- mode foldr(pred(in, in, out) is det, in, in, out) is det.
 :- mode foldr(pred(in, di, uo) is det, in, di, uo) is det.
+:- mode foldr(pred(in, in, out) is det, in, in, out) is det.
 :- mode foldr(pred(in, in, out) is semidet, in, in, out) is semidet.
 :- mode foldr(pred(in, in, out) is nondet, in, in, out) is nondet.
 :- mode foldr(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
 :- mode foldr(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
 
+:- pred foldr2(pred(T, U, U, V, V), sparse_bitset(T), U, U, V, V) <= enum(T).
+:- mode foldr2(pred(in, di, uo, di, uo) is det, in, di, uo, di, uo) is det.
+:- mode foldr2(pred(in, in, out, di, uo) is det, in, in, out, di, uo) is det.
+:- mode foldr2(pred(in, in, out, in, out) is det, in, in, out, in, out) is det.
+:- mode foldr2(pred(in, in, out, in, out) is semidet, in, in, out, in, out)
+    is semidet.
+:- mode foldr2(pred(in, in, out, in, out) is nondet, in, in, out, in, out)
+    is nondet.
+:- mode foldr2(pred(in, di, uo, di, uo) is cc_multi, in, di, uo, di, uo)
+    is cc_multi.
+:- mode foldr2(pred(in, in, out, di, uo) is cc_multi, in, in, out, di, uo)
+    is cc_multi.
+:- mode foldr2(pred(in, in, out, in, out) is cc_multi, in, in, out, in, out)
+    is cc_multi.
+
 	% `filter(Pred, Set)' removes those elements from `Set' for which
 	% `Pred' fails. In other words, it returns the set consisting of those
 	% elements of `Set' for which `Pred' succeeds.
@@ -414,65 +426,134 @@
 
 %-----------------------------------------------------------------------------%
 
-foldl(P, sparse_bitset(Set), !Acc) :-
-	foldl_2(P, Set, !Acc).
+:- type fold_direction
+    --->    low_to_high
+    ;       high_to_low.
 
 foldl(F, sparse_bitset(Set), Acc0) = Acc :-
-	foldl_2(
+    do_foldl_pred(
 		(pred(E::in, Acc1::in, Acc2::out) is det :-
 			Acc2 = F(E, Acc1)
 		), Set, Acc0, Acc).
 
-:- pred foldl_2(pred(T, U, U), bitset_impl, U, U) <= enum(T).
-:- mode foldl_2(pred(in, in, out) is det, in, in, out) is det.
-:- mode foldl_2(pred(in, di, uo) is det, in, di, uo) is det.
-:- mode foldl_2(pred(in, in, out) is semidet, in, in, out) is semidet.
-:- mode foldl_2(pred(in, in, out) is nondet, in, in, out) is nondet.
-:- mode foldl_2(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
-:- mode foldl_2(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
+foldl(P, sparse_bitset(Set), !Acc) :-
+    do_foldl_pred(P, Set, !Acc).
+
+foldl2(P, sparse_bitset(Set), !Acc1, !Acc2) :-
+    do_foldl2_pred(P, Set, !Acc1, !Acc2).
 
-:- pragma type_spec(foldl_2/4, T = int).
-:- pragma type_spec(foldl_2/4, T = var(_)).
+:- pred do_foldl_pred(pred(T, U, U), bitset_impl, U, U) <= enum(T).
+:- mode do_foldl_pred(pred(in, di, uo) is det, in, di, uo) is det.
+:- mode do_foldl_pred(pred(in, in, out) is det, in, in, out) is det.
+:- mode do_foldl_pred(pred(in, in, out) is semidet, in, in, out) is semidet.
+:- mode do_foldl_pred(pred(in, in, out) is nondet, in, in, out) is nondet.
+:- mode do_foldl_pred(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
+:- mode do_foldl_pred(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
 
-foldl_2(_, [], !Acc).
-foldl_2(P, [H | T], !Acc) :-
+:- pragma type_spec(do_foldl_pred/4, T = int).
+:- pragma type_spec(do_foldl_pred/4, T = var(_)).
+
+do_foldl_pred(_, [], !Acc).
+do_foldl_pred(P, [H | T], !Acc) :-
 	fold_bits(low_to_high, P, H ^ offset, H ^ bits, bits_per_int, !Acc),
-	foldl_2(P, T, !Acc).
+    do_foldl_pred(P, T, !Acc).
 
-foldr(P, sparse_bitset(Set), !Acc) :-
-	foldr_2(P, Set, !Acc).
+:- pred do_foldl2_pred(pred(T, U, U, V, V), bitset_impl, U, U, V, V) <= enum(T).
+:- mode do_foldl2_pred(pred(in, di, uo, di, uo) is det,
+    in, di, uo, di, uo) is det.
+:- mode do_foldl2_pred(pred(in, in, out, di, uo) is det,
+    in, in, out, di, uo) is det.
+:- mode do_foldl2_pred(pred(in, in, out, in, out) is det,
+    in, in, out, in, out) is det.
+:- mode do_foldl2_pred(pred(in, in, out, in, out) is semidet,
+    in, in, out, in, out) is semidet.
+:- mode do_foldl2_pred(pred(in, in, out, in, out) is nondet,
+    in, in, out, in, out) is nondet.
+:- mode do_foldl2_pred(pred(in, di, uo, di, uo) is cc_multi,
+    in, di, uo, di, uo) is cc_multi.
+:- mode do_foldl2_pred(pred(in, in, out, di, uo) is cc_multi,
+    in, in, out, di, uo) is cc_multi.
+:- mode do_foldl2_pred(pred(in, in, out, in, out) is cc_multi,
+    in, in, out, in, out) is cc_multi.
+
+:- pragma type_spec(do_foldl2_pred/6, T = int).
+:- pragma type_spec(do_foldl2_pred/6, T = var(_)).
+
+do_foldl2_pred(_, [], !Acc1, !Acc2).
+do_foldl2_pred(P, [H | T], !Acc1, !Acc2) :-
+    fold2_bits(low_to_high, P, H ^ offset, H ^ bits, bits_per_int,
+        !Acc1, !Acc2),
+    do_foldl2_pred(P, T, !Acc1, !Acc2).
 
 foldr(F, sparse_bitset(Set), Acc0) = Acc :-
-	foldr_2(
+    do_foldr_pred(
 		(pred(E::in, Acc1::in, Acc2::out) is det :-
 			Acc2 = F(E, Acc1)
 		), Set, Acc0, Acc).
 
-:- pred foldr_2(pred(T, U, U), bitset_impl, U, U) <= enum(T).
-:- mode foldr_2(pred(in, in, out) is det, in, in, out) is det.
-:- mode foldr_2(pred(in, di, uo) is det, in, di, uo) is det.
-:- mode foldr_2(pred(in, in, out) is semidet, in, in, out) is semidet.
-:- mode foldr_2(pred(in, in, out) is nondet, in, in, out) is nondet.
-:- mode foldr_2(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
-:- mode foldr_2(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
-:- pragma type_spec(foldr_2/4, T = int).
-:- pragma type_spec(foldr_2/4, T = var(_)).
-
-	% We don't just use list__foldr here because the
-	% overhead of allocating the closure for fold_bits
-	% is significant for the compiler's runtime,
-	% so it's best to avoid that even if
-	% `--optimize-higher-order' is not set.
-foldr_2(_, [], !Acc).
-foldr_2(P, [H | T], !Acc) :-
-	foldr_2(P, T, !Acc),
+foldr(P, sparse_bitset(Set), !Acc) :-
+    do_foldr_pred(P, Set, !Acc).
+
+foldr2(P, sparse_bitset(Set), !Acc1, !Acc2) :-
+    do_foldr2_pred(P, Set, !Acc1, !Acc2).
+
+:- pred do_foldr_pred(pred(T, U, U), bitset_impl, U, U) <= enum(T).
+:- mode do_foldr_pred(pred(in, di, uo) is det, in, di, uo) is det.
+:- mode do_foldr_pred(pred(in, in, out) is det, in, in, out) is det.
+:- mode do_foldr_pred(pred(in, in, out) is semidet, in, in, out) is semidet.
+:- mode do_foldr_pred(pred(in, in, out) is nondet, in, in, out) is nondet.
+:- mode do_foldr_pred(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
+:- mode do_foldr_pred(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
+
+:- pragma type_spec(do_foldr_pred/4, T = int).
+:- pragma type_spec(do_foldr_pred/4, T = var(_)).
+
+    % We don't just use list__foldr here because the overhead of allocating
+    % the closure for fold_bits is significant for the compiler's runtime,
+    % so it's best to avoid that even if `--optimize-higher-order' is not set.
+do_foldr_pred(_, [], !Acc).
+do_foldr_pred(P, [H | T], !Acc) :-
+    do_foldr_pred(P, T, !Acc),
 	fold_bits(high_to_low, P, H ^ offset, H ^ bits, bits_per_int, !Acc).
 
+:- pred do_foldr2_pred(pred(T, U, U, V, V), bitset_impl, U, U, V, V)
+    <= enum(T).
+:- mode do_foldr2_pred(pred(in, di, uo, di, uo) is det,
+    in, di, uo, di, uo) is det.
+:- mode do_foldr2_pred(pred(in, in, out, di, uo) is det,
+    in, in, out, di, uo) is det.
+:- mode do_foldr2_pred(pred(in, in, out, in, out) is det,
+    in, in, out, in, out) is det.
+:- mode do_foldr2_pred(pred(in, in, out, in, out) is semidet,
+    in, in, out, in, out) is semidet.
+:- mode do_foldr2_pred(pred(in, in, out, in, out) is nondet,
+    in, in, out, in, out) is nondet.
+:- mode do_foldr2_pred(pred(in, di, uo, di, uo) is cc_multi,
+    in, di, uo, di, uo) is cc_multi.
+:- mode do_foldr2_pred(pred(in, in, out, di, uo) is cc_multi,
+    in, in, out, di, uo) is cc_multi.
+:- mode do_foldr2_pred(pred(in, in, out, in, out) is cc_multi,
+    in, in, out, in, out) is cc_multi.
+
+:- pragma type_spec(do_foldr2_pred/6, T = int).
+:- pragma type_spec(do_foldr2_pred/6, T = var(_)).
+
+    % We don't just use list__foldr here because the overhead of allocating
+    % the closure for fold_bits is significant for the compiler's runtime,
+    % so it's best to avoid that even if `--optimize-higher-order' is not set.
+do_foldr2_pred(_, [], !Acc1, !Acc2).
+do_foldr2_pred(P, [H | T], !Acc1, !Acc2) :-
+    do_foldr2_pred(P, T, !Acc1, !Acc2),
+    fold2_bits(high_to_low, P, H ^ offset, H ^ bits, bits_per_int,
+        !Acc1, !Acc2).
+
 	% Do a binary search for the 1 bits in an int.
 :- pred fold_bits(fold_direction, pred(T, U, U),
 		int, int, int, U, U) <= enum(T).
-:- mode fold_bits(in, pred(in, in, out) is det, in, in, in, in, out) is det.
-:- mode fold_bits(in, pred(in, di, uo) is det, in, in, in, di, uo) is det.
+:- mode fold_bits(in, pred(in, in, out) is det,
+    in, in, in, in, out) is det.
+:- mode fold_bits(in, pred(in, di, uo) is det,
+    in, in, in, di, uo) is det.
 :- mode fold_bits(in, pred(in, in, out) is semidet,
 		in, in, in, in, out) is semidet.
 :- mode fold_bits(in, pred(in, in, out) is nondet,
@@ -484,11 +565,6 @@
 :- pragma type_spec(fold_bits/7, T = int).
 :- pragma type_spec(fold_bits/7, T = var(_)).
 
-:- type fold_direction
-	--->	low_to_high
-	;	high_to_low
-	.
-
 fold_bits(Dir, P, Offset, Bits, Size, !Acc) :-
 	( Bits = 0 ->
 		true
@@ -513,14 +589,66 @@
 		(
 			Dir = low_to_high,
 			fold_bits(Dir, P, Offset, LowBits, HalfSize, !Acc),
-			fold_bits(Dir, P, Offset + HalfSize, HighBits,
-					HalfSize, !Acc)
+            fold_bits(Dir, P, Offset + HalfSize, HighBits, HalfSize, !Acc)
 		;
 			Dir = high_to_low,
-			fold_bits(Dir, P, Offset + HalfSize, HighBits,
-					HalfSize, !Acc),
-			fold_bits(Dir, P, Offset, LowBits,
-					HalfSize, !Acc)
+            fold_bits(Dir, P, Offset + HalfSize, HighBits, HalfSize, !Acc),
+            fold_bits(Dir, P, Offset, LowBits, HalfSize, !Acc)
+        )
+    ).
+
+:- pred fold2_bits(fold_direction, pred(T, U, U, V, V),
+    int, int, int, U, U, V, V) <= enum(T).
+:- mode fold2_bits(in, pred(in, di, uo, di, uo) is det,
+    in, in, in, di, uo, di, uo) is det.
+:- mode fold2_bits(in, pred(in, in, out, di, uo) is det,
+    in, in, in, in, out, di, uo) is det.
+:- mode fold2_bits(in, pred(in, in, out, in, out) is det,
+    in, in, in, in, out, in, out) is det.
+:- mode fold2_bits(in, pred(in, in, out, in, out) is semidet,
+    in, in, in, in, out, in, out) is semidet.
+:- mode fold2_bits(in, pred(in, in, out, in, out) is nondet,
+    in, in, in, in, out, in, out) is nondet.
+:- mode fold2_bits(in, pred(in, di, uo, di, uo) is cc_multi,
+    in, in, in, di, uo, di, uo) is cc_multi.
+:- mode fold2_bits(in, pred(in, in, out, di, uo) is cc_multi,
+    in, in, in, in, out, di, uo) is cc_multi.
+:- mode fold2_bits(in, pred(in, in, out, in, out) is cc_multi,
+    in, in, in, in, out, in, out) is cc_multi.
+:- pragma type_spec(fold2_bits/9, T = int).
+:- pragma type_spec(fold2_bits/9, T = var(_)).
+
+fold2_bits(Dir, P, Offset, Bits, Size, !Acc1, !Acc2) :-
+    ( Bits = 0 ->
+        true
+    ; Size = 1 ->
+        ( Elem = from_int(Offset) ->
+            P(Elem, !Acc1, !Acc2)
+        ;
+            % We only apply `from_int/1' to integers returned
+            % by `to_int/1', so it should never fail.
+            error("sparse_bitset.m: `enum__from_int/1' failed")
+        )
+    ;
+        HalfSize = unchecked_right_shift(Size, 1),
+        Mask = mask(HalfSize),
+        
+        % Extract the low-order half of the bits.
+        LowBits = Mask /\ Bits,
+
+        % Extract the high-order half of the bits.
+        HighBits = Mask /\ unchecked_right_shift(Bits, HalfSize), 
+
+        (
+            Dir = low_to_high,
+            fold2_bits(Dir, P, Offset, LowBits, HalfSize, !Acc1, !Acc2),
+            fold2_bits(Dir, P, Offset + HalfSize, HighBits, HalfSize,
+                !Acc1, !Acc2)
+        ;
+            Dir = high_to_low,
+            fold2_bits(Dir, P, Offset + HalfSize, HighBits, HalfSize,
+                !Acc1, !Acc2),
+            fold2_bits(Dir, P, Offset, LowBits, HalfSize, !Acc1, !Acc2)
 		)
 	).
 
@@ -595,8 +723,7 @@
 		; Offset =< Index ->
 			(
 				Bits = Data ^ bits /\
-					unchecked_left_shift(\ 0,
-						Index - Offset + 1),
+                    unchecked_left_shift(\ 0, Index - Offset + 1),
 				Bits \= 0
 			->
 				[make_bitset_elem(Offset, Bits) | Rest]
@@ -623,8 +750,7 @@
 		; Offset =< Index ->
 			(
 				Bits = Data ^ bits /\
-					\ unchecked_left_shift(\ 0,
-						Index - Offset + 1),
+                    \ unchecked_left_shift(\ 0, Index - Offset + 1),
 				Bits \= 0
 			->
 				[make_bitset_elem(Offset, Bits)]
@@ -677,10 +803,8 @@
 		( LowBits \= 0 ->
 			BitNum = find_least_bit_2(LowBits, HalfSize, BitNum0)
 		;
-			HighBits =
-				Mask /\ unchecked_right_shift(Bits0, HalfSize),
-			BitNum = find_least_bit_2(HighBits, HalfSize,
-					BitNum0 + HalfSize)
+            HighBits = Mask /\ unchecked_right_shift(Bits0, HalfSize),
+            BitNum = find_least_bit_2(HighBits, HalfSize, BitNum0 + HalfSize)
 		)
 	).
 
@@ -689,11 +813,10 @@
 list_to_set(List) =
 	sparse_bitset(list_to_set_2(List, [])).
 
-	% Each pass over the input list selects out the elements which
-	% belong in the same bitset_elem as the first element.
-	% The assumption here is that the items in the input list
-	% will have similar values, so that only a few passes
-	% will be needed.
+    % Each pass over the input list selects out the elements which belong
+    % in the same bitset_elem as the first element. The assumption here is that
+    % the items in the input list will have similar values, so that only a few
+    % passes will be needed.
 :- func list_to_set_2(list(T), bitset_impl) = bitset_impl <= enum(T).
 :- pragma type_spec(list_to_set_2/2, T = var(_)).
 :- pragma type_spec(list_to_set_2/2, T = int).
@@ -702,30 +825,25 @@
 list_to_set_2([H | T], List0) = List :-
 	bits_for_index(enum__to_int(H), Offset, Bits0),
 	list_to_set_3(T, Offset, Bits0, Bits, [], Rest),
-	List1 = insert_bitset_elem(make_bitset_elem(Offset, Bits),
-			List0),
+    List1 = insert_bitset_elem(make_bitset_elem(Offset, Bits), List0),
 	List = list_to_set_2(Rest, List1).
 
-	% Go through the list picking out the elements
-	% which belong in the same bitset_elem as the first
-	% element, returning the uncollected elements.
-:- pred list_to_set_3(list(T), int, int, int,
-		list(T), list(T)) <= enum(T).
-:- mode list_to_set_3(in, in, in, out, in, out) is det.
+    % Go through the list picking out the elements which belong in the same
+    % bitset_elem as the first element, returning the uncollected elements.
+:- pred list_to_set_3(list(T)::in, int::in, int::in, int::out,
+    list(T)::in, list(T)::out) is det <= enum(T).
 :- pragma type_spec(list_to_set_3/6, T = var(_)).
 :- pragma type_spec(list_to_set_3/6, T = int).
 		
-list_to_set_3([], _, Bits, Bits, Rest, Rest).
-list_to_set_3([H | T], Offset, Bits0, Bits, Rest0, Rest) :-
+list_to_set_3([], _, !Bits, !Rest).
+list_to_set_3([H | T], Offset, !Bits, !Rest) :-
 	BitToSet = enum__to_int(H) - Offset,
 	( BitToSet >= 0, BitToSet < bits_per_int ->
-		Bits2 = set_bit(Bits0, BitToSet), 
-		Rest1 = Rest0
+        !:Bits = set_bit(!.Bits, BitToSet)
 	;
-		Bits2 = Bits0,
-		Rest1 = [H | Rest0]
+        !:Rest = [H | !.Rest]
 	),
-	list_to_set_3(T, Offset, Bits2, Bits, Rest1, Rest).
+    list_to_set_3(T, Offset, !Bits, !Rest).
 
 	% The list of elements here is pretty much guaranteed
 	% to be small, so use an insertion sort.
@@ -756,8 +874,8 @@
 		Set = [make_bitset_elem(Offset, Bits) | Set0]
 	).
 
-:- pred sorted_list_to_set_3(T, list(T), int, int, bitset_impl) <= enum(T).
-:- mode sorted_list_to_set_3(in, in, out, out, out) is det.
+:- pred sorted_list_to_set_3(T::in, list(T)::in, int::out, int::out,
+    bitset_impl::out) is det <= enum(T).
 :- pragma type_spec(sorted_list_to_set_3/5, T = var(_)).
 :- pragma type_spec(sorted_list_to_set_3/5, T = int).
 
@@ -787,8 +905,7 @@
 contains(sparse_bitset(Set), Elem) :-
 	contains_2(Set, enum__to_int(Elem)).
 
-:- pred contains_2(bitset_impl, int).
-:- mode contains_2(in, in) is semidet.
+:- pred contains_2(bitset_impl::in, int::in) is semidet.
 
 contains_2([Data | Rest], Index) :-
 	Offset = Data ^ offset,
@@ -815,16 +932,14 @@
 		error("sparse_bitset.m: `enum__from_int/1' failed")
 	).
 
-:- pred member_2(int, bitset_impl).
-:- mode member_2(out, in) is nondet.
+:- pred member_2(int::out, bitset_impl::in) is nondet.
 
 member_2(Index, [Elem | Elems]) :-
 	( member_3(Index, Elem ^ offset, bits_per_int, Elem ^ bits)
 	; member_2(Index, Elems)
 	).
 
-:- pred member_3(int, int, int, int).
-:- mode member_3(out, in, in, in) is nondet.
+:- pred member_3(int::out, int::in, int::in, int::in) is nondet.
 
 member_3(Index, Offset, Size, Bits) :-
 	( Bits = 0 ->
@@ -850,6 +965,7 @@
 
 :- func rest(bitset_impl::in(bound([ground | ground]))) =
 		(bitset_impl::out) is det.
+
 rest([_ | Rest]) = Rest.
 
 union(sparse_bitset(Set1), sparse_bitset(Set2)) =
@@ -868,8 +984,7 @@
 	Offset1 = Data1 ^ offset,
 	Offset2 = Data2 ^ offset,
 	( Offset1 = Offset2 ->
-		Elem = make_bitset_elem(Offset1,
-				(Data1 ^ bits) \/ (Data2 ^ bits)),
+        Elem = make_bitset_elem(Offset1, (Data1 ^ bits) \/ (Data2 ^ bits)),
 		Set = [Elem | union_2(Set1 ^ rest, Set2 ^ rest)]
 	; Offset1 < Offset2 ->
 		Set = [Data1 | union_2(Set1 ^ rest, Set2)]
@@ -917,7 +1032,7 @@
 
 difference_2([], []) = [].
 difference_2([], B) = [] :-
-	B = [_|_].
+    B = [_ | _].
 difference_2(A, []) = A :-
 	A = [_ | _].
 difference_2(Set1, Set2) = Set :-
@@ -941,12 +1056,9 @@
 
 %-----------------------------------------------------------------------------%
 
-	% Return the offset of the element of a set
-	% which should contain the given element,
-	% and an int with the bit corresponding to
-	% that element set.
-:- pred bits_for_index(int, int, int).
-:- mode bits_for_index(in, out, out) is det.
+    % Return the offset of the element of a set which should contain the given
+    % element, and an int with the bit corresponding to that element set.
+:- pred bits_for_index(int::in, int::out, int::out) is det.
 :- pragma inline(bits_for_index/3).
 
 bits_for_index(Index, Offset, Bits) :-
@@ -969,9 +1081,8 @@
 
 clear_bit(Int0, Bit) = Int0 /\ \ unchecked_left_shift(1, Bit).
 
-	% `mask(N)' returns a mask which can be `and'ed with an
-	% integer to return the lower `N' bits of the integer.
-	% `N' must be less than bits_per_int.
+    % `mask(N)' returns a mask which can be `and'ed with an integer to return
+    % the lower `N' bits of the integer. `N' must be less than bits_per_int.
 :- func mask(int) = int.
 :- pragma inline(mask/1).
 
@@ -983,20 +1094,17 @@
 %make_bitset_elem(A, B) = bitset_elem(A, B).
 
 :- pragma foreign_decl("C", "
-	#include ""mercury_heap.h""
-		/* for MR_tag_offset_incr_hp_atomic_msg() */
+    #include ""mercury_heap.h"" /* for MR_tag_offset_incr_hp_atomic_msg() */
 ").
 
-	% The bit pattern will often look like a pointer,
-	% so allocate the pairs using GC_malloc_atomic()
-	% to avoid unnecessary memory retention.
-	% Doing this slows down the compiler by about 1%,
-	% but in a library module it's better to be safe.
+    % The bit pattern will often look like a pointer, so allocate the pairs
+    % using GC_malloc_atomic() to avoid unnecessary memory retention. Doing
+    % this slows down the compiler by about 1%, but in a library module it is
+    % better to be safe.
 :- pragma foreign_proc("C",
 	make_bitset_elem(A::in, B::in) = (Pair::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "{
-
 #define ML_BITSET_TAG MR_FIRST_UNRESERVED_RAW_TAG
 
 	MR_tag_offset_incr_hp_atomic_msg(Pair, MR_mktag(ML_BITSET_TAG),
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list