[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