[m-rev.] for review: fix relation.m performance bugs
Simon Taylor
stayl at cs.mu.OZ.AU
Fri Dec 19 17:47:57 AEDT 2003
Estimated hours taken: 12
Branches: main
Fix performance bugs in library/relation.m which caused
`mmc --generate-dependencies' to choke on large programs
(e.g. the compiler).
`mmc --generate-dependencies top_level' now takes
about 8 seconds on jupiter, compared to over 2 minutes
before.
library/relation.m:
Use sparse_bitset for sets of relation_keys.
Rewrite relation__compose to use the indexing
in the relation structure, rather than just
doing a naive nested loop join.
Clean up and fix a bug in relation__is_dag.
Rewrite algorithms to avoid using to_sorted_list
on sparse_bitsets of relation keys; this is not
a cheap operation as it is with set.sets.
Use sparse_bitset.fold{l,r} instead where
possible.
library/sparse_bitset.m:
Add new functions to_set and from_set,
which convert between sparse_bitsets
and set.sets.
Add predicate versions of foldl and foldr with
the same modes as the list version.
compiler/modules.m:
Use sparse_bitset.foldl rather than sparse_bitset.to_sorted_list
followed by list.map.
profiler/propagate.m:
relation__dfsrev now takes a sparse_bitset(relation_key),
not set_bbbtree(relation_key).
library/map.m:
library/tree234.m:
Type specialize map__det_update for term.var and int.
NEWS:
Document new predicates and functions.
tests/hard_coded/relation_test.{m,exp}:
Test relation__is_dag.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.324
diff -u -u -r1.324 NEWS
--- NEWS 18 Dec 2003 07:48:19 -0000 1.324
+++ NEWS 19 Dec 2003 05:59:16 -0000
@@ -125,6 +125,23 @@
input_stream_foldl2_io_maybe_stop/{6,7},
binary_input_stream_foldl2_io_maybe_stop/{6,7}.
+* We've added predicates relation__lookup_key_set_from/3 and
+ relation__lookup_key_set_to/3.
+
+* The type of the arguments giving the initial set of visited nodes
+ to relation__dfs and relation__dfsrev has changed from set_bbbtree
+ to sparse_bitset.
+
+* Efficiency of the operations in the relation module has been
+ greatly improved.
+
+* Some predicates and functions have been added to the sparse_bitset_module:
+ to_set/1,
+ from_set/1,
+ member/2,
+ foldl/4,
+ foldr/4.
+
* exception.m now contains a predicate finally/6 which can be used to
ensure that resources are released whether a called closure exits
normally or throws an exception.
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.282
diff -u -u -r1.282 modules.m
--- compiler/modules.m 1 Dec 2003 15:55:43 -0000 1.282
+++ compiler/modules.m 19 Dec 2003 03:44:07 -0000
@@ -810,7 +810,7 @@
:- import_module string, map, term, varset, dir, library.
:- import_module assoc_list, relation, char, require.
-:- import_module getopt, multi_map.
+:- import_module getopt, multi_map, sparse_bitset.
%-----------------------------------------------------------------------------%
@@ -3819,9 +3819,11 @@
get_dependencies_from_relation(DepsRel0, ModuleName, Deps) :-
relation__add_element(DepsRel0, ModuleName, ModuleKey, DepsRel),
- relation__lookup_from(DepsRel, ModuleKey, DepsKeysSet),
- set__to_sorted_list(DepsKeysSet, DepsKeys),
- list__map(relation__lookup_key(DepsRel), DepsKeys, Deps).
+ relation__lookup_key_set_from(DepsRel, ModuleKey, DepsKeysSet),
+ foldl(
+ (pred(Key::in, Deps0::in, [Dep | Deps0]::out) is det :-
+ relation__lookup_key(DepsRel, Key, Dep)
+ ), DepsKeysSet, [], Deps).
% This is the data structure we use to record the dependencies.
% We keep a map from module name to information about the module.
Index: library/map.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/map.m,v
retrieving revision 1.87
diff -u -u -r1.87 map.m
--- library/map.m 9 Dec 2003 12:47:12 -0000 1.87
+++ library/map.m 19 Dec 2003 02:49:58 -0000
@@ -435,6 +435,9 @@
:- pragma type_spec(map__set(in, in, in, out), K = var(_)).
:- pragma type_spec(map__set/3, K = var(_)).
+:- pragma type_spec(map__det_update/4, K = var(_)).
+:- pragma type_spec(map__det_update/4, K = int).
+
:- pragma type_spec(map__overlay/2, K = var(_)).
:- pragma type_spec(map__overlay/3, K = var(_)).
Index: library/relation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/relation.m,v
retrieving revision 1.30
diff -u -u -r1.30 relation.m
--- library/relation.m 5 Nov 2003 03:17:49 -0000 1.30
+++ library/relation.m 19 Dec 2003 06:22:18 -0000
@@ -18,12 +18,16 @@
:- module relation.
:- interface.
-:- import_module list, set, set_bbbtree, assoc_list.
+:- import_module enum, list, set, assoc_list, sparse_bitset.
:- type relation(T).
:- type relation_key.
+:- instance enum(relation_key).
+
+:- type relation_key_set == sparse_bitset(relation_key).
+
% relation__init creates a new relation.
:- pred relation__init(relation(T)).
:- mode relation__init(out) is det.
@@ -124,6 +128,13 @@
:- func relation__lookup_from(relation(T), relation_key) = set(relation_key).
+:- pred relation__lookup_key_set_from(relation(T),
+ relation_key, relation_key_set).
+:- mode relation__lookup_key_set_from(in, in, out) is det.
+
+:- func relation__lookup_key_set_from(relation(T),
+ relation_key) = set(relation_key).
+
% relation__lookup_to returns the set of elements
% x such that xRy, given some y.
:- pred relation__lookup_to(relation(T), relation_key, set(relation_key)).
@@ -131,6 +142,13 @@
:- func relation__lookup_to(relation(T), relation_key) = set(relation_key).
+:- pred relation__lookup_key_set_to(relation(T),
+ relation_key, relation_key_set).
+:- mode relation__lookup_key_set_to(in, in, out) is det.
+
+:- func relation__lookup_key_set_to(relation(T),
+ relation_key) = relation_key_set.
+
% relation__to_assoc_list turns a relation into a list of
% pairs of elements.
:- pred relation__to_assoc_list(relation(T), assoc_list(T, T)).
@@ -220,8 +238,8 @@
% 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), relation_key, set_bbbtree(relation_key),
- set_bbbtree(relation_key), list(relation_key)).
+:- pred relation__dfs(relation(T), relation_key, relation_key_set,
+ relation_key_set, list(relation_key)).
:- mode relation__dfs(in, in, in, out, out) is det.
% relation__dfsrev(Rel, X, Visit0, Visit, DfsRev) is true if
@@ -230,7 +248,7 @@
% ie the reverse of Dfs from relation__dfs/5.
% Visit is Visit0 + DfsRev.
:- pred relation__dfsrev(relation(T), relation_key,
- set_bbbtree(relation_key), set_bbbtree(relation_key),
+ relation_key_set, relation_key_set,
list(relation_key)).
:- mode relation__dfsrev(in, in, in, out, out) is det.
@@ -313,23 +331,30 @@
:- implementation.
:- import_module map, bimap, int, std_util, list, queue, stack.
-:- import_module require.
-
-:- type relation_key == int.
+:- import_module require, sparse_bitset.
+:- type relation_key ---> relation_key(int).
+:- instance enum(relation_key) where [
+ to_int(relation_key(Int)) = Int,
+ 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(
relation_key, % Next key
bimap(T, relation_key), % Elements <-> keys
- map(relation_key, set(relation_key)), % The mapping U -> V
- map(relation_key, set(relation_key)) % The reverse mapping
+ map(int, relation_key_set), % The mapping U -> V
+ map(int, relation_key_set) % The reverse mapping
% V -> U
).
%------------------------------------------------------------------------------%
% relation__init creates a new relation.
-relation__init(relation(0, ElMap, FwdMap, BwdMap)) :-
+relation__init(relation(relation_key(0), ElMap, FwdMap, BwdMap)) :-
bimap__init(ElMap),
map__init(FwdMap),
map__init(BwdMap).
@@ -339,12 +364,12 @@
% 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(Key0, ElMap0, Fwd, Rev),
- Elem, NewKey, relation(Key, ElMap, Fwd, Rev)) :-
+relation__add_element(relation(relation_key(Key0), ElMap0, Fwd, Rev),
+ Elem, NewKey, relation(relation_key(Key), ElMap, Fwd, Rev)) :-
( bimap__search(ElMap0, Elem, NewKey0) ->
Key = Key0, NewKey = NewKey0, ElMap = ElMap0
;
- NewKey = Key0,
+ NewKey = relation_key(Key0),
Key = Key0 + 1,
bimap__set(ElMap0, Elem, NewKey, ElMap)
).
@@ -389,22 +414,31 @@
relation__add(R2, XKey, YKey, R).
% relation__add adds an element to the relation.
-relation__add(relation(Key, ElMap, FwdIn, BwdIn), U, V,
+relation__add(relation(Key, ElMap, FwdIn, BwdIn),
+ UKey @ relation_key(U), VKey @ relation_key(V),
relation(Key, ElMap, FwdOut, BwdOut)) :-
( map__search(FwdIn, U, VSet0) ->
- set__insert(VSet0, V, VSet1),
- map__det_update(FwdIn, U, VSet1, FwdOut)
+ ( contains(VSet0, VKey) ->
+ FwdOut = FwdIn
+ ;
+ insert(VSet0, VKey, VSet1),
+ map__det_update(FwdIn, U, VSet1, FwdOut)
+ )
;
- set__init(VSet0),
- set__insert(VSet0, V, VSet1),
+ init(VSet0),
+ insert(VSet0, VKey, VSet1),
map__det_insert(FwdIn, U, VSet1, FwdOut)
),
( map__search(BwdIn, V, USet0) ->
- set__insert(USet0, U, USet1),
- map__det_update(BwdIn, V, USet1, BwdOut)
+ ( contains(USet0, UKey) ->
+ BwdOut = BwdIn
+ ;
+ insert(USet0, UKey, USet1),
+ map__det_update(BwdIn, V, USet1, BwdOut)
+ )
;
- set__init(USet0),
- set__insert(USet0, U, USet1),
+ init(USet0),
+ insert(USet0, UKey, USet1),
map__det_insert(BwdIn, V, USet1, BwdOut)
).
@@ -420,16 +454,17 @@
%------------------------------------------------------------------------------%
% relation__remove removes an element from the relation.
-relation__remove(relation(Key, ElMap, FwdIn, BwdIn), U, V,
+relation__remove(relation(Key, ElMap, FwdIn, BwdIn),
+ UKey @ relation_key(U), VKey @ relation_key(V),
relation(Key, ElMap, FwdOut, BwdOut)) :-
( map__search(FwdIn, U, VSet0) ->
- set__delete(VSet0, V, VSet1),
+ delete(VSet0, VKey, VSet1),
map__det_update(FwdIn, U, VSet1, FwdOut)
;
FwdIn = FwdOut
),
( map__search(BwdIn, V, USet0) ->
- set__delete(USet0, U, USet1),
+ delete(USet0, UKey, USet1),
map__det_update(BwdIn, V, USet1, BwdOut)
;
BwdIn = BwdOut
@@ -448,38 +483,47 @@
% relation__lookup checks to see if an element is
% in the relation.
-relation__lookup(relation(_Key, _ElMap, Fwd, _Bwd), U, V) :-
+relation__lookup(relation(_Key, _ElMap, Fwd, _Bwd), relation_key(U), V) :-
map__search(Fwd, U, VSet),
- set__member(V, 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, V) :-
+relation__reverse_lookup(relation(_Key, _ElMap, _Fwd, Bwd),
+ U, relation_key(V)) :-
map__search(Bwd, V, USet),
- set__member(U, USet).
+ member(U, USet).
%------------------------------------------------------------------------------%
+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_from(relation(_Key, _ElMap, Fwd, _Bwd), U, Vs) :-
+relation__lookup_key_set_from(relation(_Key, _ElMap, Fwd, _Bwd),
+ relation_key(U), Vs) :-
( map__search(Fwd, U, Vs0) ->
Vs = Vs0
;
- set__init(Vs)
+ init(Vs)
).
%------------------------------------------------------------------------------%
+relation__lookup_to(R, U, to_set(Vs)) :-
+ relation__lookup_key_set_to(R, U, Vs).
+
% relation__lookup_to returns the set of elements
% x such that xRy, given some y.
-relation__lookup_to(relation(_Key, _ElMap, _Fwd, Bwd), V, Us) :-
+relation__lookup_key_set_to(relation(_Key, _ElMap, _Fwd, Bwd),
+ relation_key(V), Us) :-
( map__search(Bwd, V, Us0) ->
Us = Us0
;
- set__init(Us)
+ init(Us)
).
%------------------------------------------------------------------------------%
@@ -488,55 +532,51 @@
% 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).
+ relation__to_assoc_list_2(Fwd, FwdKeys, ElMap, [], List).
-:- pred relation__to_assoc_list_2(map(relation_key, set(relation_key)),
- list(relation_key), bimap(T, relation_key), assoc_list(T, T)).
-:- mode relation__to_assoc_list_2(in, in, in, out) is det.
-relation__to_assoc_list_2(_Fwd, [], _, []).
-relation__to_assoc_list_2(Fwd, [Key | Keys], ElementMap, AssocList) :-
- relation__to_assoc_list_2(Fwd, Keys, ElementMap, AssocList1),
+:- pred relation__to_assoc_list_2(map(int, relation_key_set),
+ list(int), bimap(T, relation_key),
+ assoc_list(T, T), assoc_list(T, T)).
+:- mode relation__to_assoc_list_2(in, in, in, in, out) is det.
+relation__to_assoc_list_2(_Fwd, [], _, !AssocList).
+relation__to_assoc_list_2(Fwd, [Key | Keys], ElementMap, !AssocList) :-
+ relation__to_assoc_list_2(Fwd, Keys, ElementMap, !AssocList),
+ bimap__reverse_lookup(ElementMap, KeyEl, relation_key(Key)),
map__lookup(Fwd, Key, Set),
- set__to_sorted_list(Set, List),
- bimap__reverse_lookup(ElementMap, KeyEl, Key),
- Lookup = (pred(U::in, V::out) is det :-
- bimap__reverse_lookup(ElementMap, V, U)),
- list__map(Lookup, List, ListEls),
- relation__append_to(KeyEl, ListEls, AssocList2),
- list__append(AssocList1, AssocList2, AssocList).
+ !:AssocList =
+ foldr(
+ (func(U, AL) = [KeyEl - V | AL] :-
+ bimap__reverse_lookup(ElementMap, V, U)
+ ), Set, !.AssocList).
% 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).
+ relation__to_key_assoc_list_2(Fwd, FwdKeys, [], List).
-:- pred relation__to_key_assoc_list_2(map(relation_key, set(relation_key)),
- list(relation_key), assoc_list(relation_key, relation_key)).
-:- mode relation__to_key_assoc_list_2(in, in, out) is det.
-relation__to_key_assoc_list_2(_Fwd, [], []).
-relation__to_key_assoc_list_2(Fwd, [Key | Keys], AssocList) :-
- relation__to_key_assoc_list_2(Fwd, Keys, AssocList1),
+:- pred relation__to_key_assoc_list_2(map(int, relation_key_set),
+ list(int), assoc_list(relation_key, relation_key),
+ assoc_list(relation_key, relation_key)).
+:- mode relation__to_key_assoc_list_2(in, in, in, 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),
- set__to_sorted_list(Set, List),
- relation__append_to(Key, List, AssocList2),
- list__append(AssocList1, AssocList2, AssocList).
-
-:- pred relation__append_to(T1, list(T2), assoc_list(T1, T2)).
-:- mode relation__append_to(in, in, out) is det.
-relation__append_to(_U, [], []).
-relation__append_to(U, [V | Vs], [U - V | UVs]) :-
- relation__append_to(U, Vs, UVs).
+ !:AssocList =
+ foldr(
+ (func(U, AL) = [relation_key(Key) - U | AL]),
+ Set, !.AssocList).
%------------------------------------------------------------------------------%
% relation__from_assoc_list turns a list of pairs of
% elements into a relation.
-relation__from_assoc_list([], Rel) :-
- relation__init(Rel).
-relation__from_assoc_list([U - V | List], Rel) :-
- relation__from_assoc_list(List, Rel1),
- relation__add_values(Rel1, U, V, Rel).
+relation__from_assoc_list(AL, Rel) :-
+ Rel = list__foldl(
+ (func(U - V, Rel0) = Rel1 :-
+ relation__add_values(Rel0, U, V, Rel1)
+ ), AL, relation__init).
%------------------------------------------------------------------------------%
@@ -544,7 +584,7 @@
% of a relation.
relation__domain(relation(_Key, ElMap, _Fwd, _Bwd), Dom) :-
bimap__ordinates(ElMap, DomList),
- set__sorted_list_to_set(DomList, Dom).
+ sorted_list_to_set(DomList, Dom).
:- pred relation__domain_sorted_list(relation(T), list(relation_key)).
:- mode relation__domain_sorted_list(in, out) is det.
@@ -564,42 +604,71 @@
% relation__compose(R1, R2, R) is true iff R is the
% composition of the relations R1 and R2.
-relation__compose(R1, R2, Compose) :-
- relation__domain(R1, DomainSet),
- set__to_sorted_list(DomainSet, DomainList),
- relation__init(Compose0),
- list__foldl(relation__compose_2(R1, R2), DomainList,
- Compose0, Compose).
-
- % relation__compose_2(R1, R2, X, Comp0, Comp):
- % Comp is the union of Comp0 and CompX,
- % where CompX = { (X, Z) : some [Y] (X R1 Y, Y R2 Z) }.
-:- pred relation__compose_2(relation(T), relation(T), T,
- relation(T), relation(T)).
-:- mode relation__compose_2(in, in, in, in, out) is det.
-relation__compose_2(R1, R2, X, Comp0, Comp) :-
- relation__lookup_element(R1, X, X_R1Key),
- relation__lookup_from(R1, X_R1Key, Ys_R1KeysSet),
- set__to_sorted_list(Ys_R1KeysSet, Ys_R1Keys),
- list__map(relation__lookup_key(R1), Ys_R1Keys, Ys),
- list__foldl(relation__compose_3(R2, X), Ys, Comp0, Comp).
-
- % relation__compose_3(R2, X, Y, Comp0, Comp):
- % Comp is the union of Comp0 and CompXY,
- % where CompXY = { (X, Z) : Y R2 Z }.
-:- pred relation__compose_3(relation(T), T, T, relation(T), relation(T)).
-:- mode relation__compose_3(in, in, in, in, out) is det.
-relation__compose_3(R2, X, Y, Comp0, Comp) :-
- ( relation__search_element(R2, Y, Y_R2Key) ->
- relation__lookup_from(R2, Y_R2Key, Zs_R2Keys_Set),
- set__to_sorted_list(Zs_R2Keys_Set, Zs_R2Keys),
- list__map(relation__lookup_key(R2), Zs_R2Keys, Zs),
- AddValue = (pred(Z::in, Rel0::in, Rel::out) is det :-
- relation__add_values(Rel0, X, Z, Rel)),
- list__foldl(AddValue, Zs, Comp0, Comp)
- ;
- Comp = Comp0
- ).
+relation__compose(R1, R2, !:Compose) :-
+ !:Compose = relation__init,
+
+ % Find the set of elements which occur in both the
+ % range of R1 and the domain of R2.
+ relation__domain(relation__inverse(R1), R1Range),
+ relation__domain(R2, R2Domain),
+ MatchElements = set__intersect(R1Range, R2Domain),
+
+ % Find the sets of keys to be matched in each relation.
+ KeyAL = list__map(
+ (func(MatchElem) = R1Keys - R2Keys :-
+ relation__lookup_element(R1, MatchElem, R1Key),
+ relation__lookup_key_set_to(R1, R1Key, R1Keys),
+ relation__lookup_element(R2, MatchElem, R2Key),
+ relation__lookup_key_set_from(R2, R2Key, R2Keys)
+ ),
+ to_sorted_list(MatchElements)),
+
+ % Find the sets of keys in each relation which will occur in
+ % the new relation.
+ list__foldl2(
+ (pred((R1Keys - R2Keys)::in, R1NeededKeys0::in, R1NeededKeys1::out,
+ R2NeededKeys0::in, R2NeededKeys1::out) is det :-
+ R1NeededKeys1 = sparse_bitset__union(R1NeededKeys0, R1Keys),
+ R2NeededKeys1 = sparse_bitset__union(R2NeededKeys0, R2Keys)
+ ), KeyAL, sparse_bitset__init, R1NeededKeys,
+ sparse_bitset__init, R2NeededKeys),
+
+ % Add the elements to the composition.
+ {!:Compose, KeyMap1} = foldl(copy_element(R1), R1NeededKeys,
+ {!.Compose, map__init}),
+ {!:Compose, KeyMap2} = foldl(copy_element(R2), R2NeededKeys,
+ {!.Compose, map__init}),
+
+ % Add the arcs to the composition.
+ list__foldl(
+ (pred((R1Keys - R2Keys)::in, !.Compose::in,
+ !:Compose::out) is det :-
+ relation__add_cartesian_product(
+ map_key_set(KeyMap1, R1Keys),
+ map_key_set(KeyMap2, R2Keys),
+ !Compose)
+ ), KeyAL, !Compose).
+
+:- func copy_element(relation(T), relation_key,
+ {relation(T), map(int, relation_key)}) =
+ {relation(T), map(int, relation_key)}.
+
+copy_element(R0, Key, {Compose0, KeyMap0}) = {Compose, KeyMap} :-
+ relation__lookup_key(R0, Key, Elem),
+ relation__add_element(Compose0, Elem, ComposeKey, Compose),
+ Key = relation_key(KeyInt),
+ map__det_insert(KeyMap0, KeyInt, ComposeKey, KeyMap).
+
+:- func map_key_set(map(int, relation_key),
+ relation_key_set) = relation_key_set.
+
+map_key_set(KeyMap, Set0) = Set :-
+ Set = foldl(
+ (func(Key0, Set1) = Set2 :-
+ Key0 = relation_key(KeyInt),
+ map__lookup(KeyMap, KeyInt, Key),
+ Set2 = insert(Set1, Key)
+ ), Set0, init).
%------------------------------------------------------------------------------%
@@ -614,15 +683,15 @@
% a relation. It returns the elements in reverse visited
% order.
relation__dfsrev(Rel, X, DfsRev) :-
- set_bbbtree__init(Vis0),
- relation__dfs_3([X], Rel, Vis0, [], _, 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__dfsrev(Rel, X, Visited0, Visited, DfsRev),
+ relation__dfs_2(Rel, X, Visited0, Visited, [], DfsRev),
list__reverse(DfsRev, Dfs).
% relation__dfsrev/5 performs a depth-first search of
@@ -630,7 +699,7 @@
% order. Providing the nodes Visited0 have already been
% visited.
relation__dfsrev(Rel, X, Visited0, Visited, DfsRev) :-
- relation__dfs_3([X], Rel, Visited0, [], Visited, DfsRev).
+ relation__dfs_2(Rel, X, Visited0, Visited, [], DfsRev).
% relation__dfs(Rel, Dfs) is true if Dfs is a depth-
@@ -645,43 +714,30 @@
% order visited.
relation__dfsrev(Rel, DfsRev) :-
relation__domain_sorted_list(Rel, DomList),
- set_bbbtree__init(Visit),
- relation__dfs_2(DomList, Rel, Visit, [], DfsRev).
-
+ list__foldl2(relation__dfs_2(Rel), DomList, init, _, [], DfsRev).
-:- pred relation__dfs_2(list(relation_key), relation(T),
- set_bbbtree(relation_key), list(relation_key), list(relation_key)).
-:- mode relation__dfs_2(in, in, in, in, out) is det.
-
-relation__dfs_2([], _, _, DfsRev, DfsRev).
-relation__dfs_2([Node | Nodes], Rel, Visit0, DfsRev0, DfsRev) :-
- relation__dfs_3([Node], Rel, Visit0, DfsRev0, Visit, DfsRev1),
- relation__dfs_2(Nodes, Rel, Visit, DfsRev1, DfsRev).
-
-
-:- pred relation__dfs_3(list(relation_key), relation(T),
- set_bbbtree(relation_key), list(relation_key),
- set_bbbtree(relation_key), list(relation_key)).
-:- mode relation__dfs_3(in, in, in, in, out, out) is det.
+:- pred relation__dfs_2(relation(T), relation_key,
+ relation_key_set, relation_key_set,
+ list(relation_key), list(relation_key)).
+:- mode relation__dfs_2(in, in, in, out, in, out) is det.
-relation__dfs_3([], _Rel, Visit, Dfs, Visit, Dfs).
-relation__dfs_3([Node | Nodes], Rel, Visit0, Dfs0, Visit, Dfs) :-
+relation__dfs_2(Rel, Node, !Visit, !DfsRev) :-
(
- set_bbbtree__member(Node, Visit0)
+ contains(!.Visit, Node)
->
- relation__dfs_3(Nodes, Rel, Visit0, Dfs0, Visit, Dfs)
+ true
;
- relation__lookup_from(Rel, Node, AdjSet),
- set__to_sorted_list(AdjSet, AdjList),
- set_bbbtree__insert(Visit0, Node, Visit1),
+ relation__lookup_key_set_from(Rel, Node, AdjSet),
+ insert(!.Visit, Node, !:Visit),
- % Go and visit all a nodes children first
- relation__dfs_3(AdjList, Rel, Visit1, Dfs0, Visit2, Dfs1),
-
- Dfs2 = [ Node | Dfs1 ],
+ % Go and visit all a nodes children first
+ {!:Visit, !:DfsRev} = foldl(
+ (func(Adj, {!.Visit, !.DfsRev}) =
+ {!:Visit, !:DfsRev} :-
+ relation__dfs_2(Rel, Adj, !Visit, !DfsRev)
+ ), AdjSet, {!.Visit, !.DfsRev}),
- % Go and visit the rest
- relation__dfs_3(Nodes, Rel, Visit2, Dfs2, Visit, Dfs)
+ !:DfsRev = [Node | !.DfsRev]
).
@@ -690,37 +746,18 @@
% relation__is_dag
% Does a DFS on the relation. It is a directed acylic graph
- % if at each node we never visit and already visited node.
+ % if at each node we never visit an already visited node.
relation__is_dag(R) :-
relation__domain_sorted_list(R, DomList),
- set_bbbtree__init(Visit),
- set_bbbtree__init(AllVisit),
- relation__is_dag_2(DomList, R, Visit, AllVisit).
-
-:- pred relation__is_dag_2(list(relation_key), relation(T),
- set_bbbtree(relation_key), set_bbbtree(relation_key)).
-:- mode relation__is_dag_2(in, in, in, in) is semidet.
-
- % If a node hasn't already been visited check if the DFS from that node
- % has any cycles in it.
-relation__is_dag_2([], _, _, _).
-relation__is_dag_2([Node | Nodes], Rel, Visit0, AllVisited0) :-
- (
- set_bbbtree__member(Node, AllVisited0)
- ->
- AllVisited = AllVisited0
- ;
- relation__is_dag_3([Node],Rel, Visit0, AllVisited0, AllVisited)
- ),
- relation__is_dag_2(Nodes, Rel, Visit0, AllVisited).
-
-
-:- pred relation__is_dag_3(list(relation_key), relation(T),
- set_bbbtree(relation_key), set_bbbtree(relation_key),
- set_bbbtree(relation_key)).
-:- mode relation__is_dag_3(in, in, in, in, out) is semidet.
+ init(Visit),
+ init(AllVisit),
+ foldl(relation__is_dag_2(R, Visit), DomList, AllVisit, _).
+
+:- pred relation__is_dag_2(relation(T), relation_key_set,
+ relation_key, relation_key_set, relation_key_set).
+:- mode relation__is_dag_2(in, in, in, in, out) is semidet.
- % Provided that we never encounter a node that we haven't visited before
+ % Provided that we never encounter a node that we've visited before
% during the current DFS, the graph isn't cyclic.
% NB It is possible that we have visited a node before while doing a
% DFS from another node.
@@ -732,58 +769,56 @@
%
% 1 will be visited by a DFS from both 2 and 3.
%
-relation__is_dag_3([Node | Nodes], Rel, Visited0, AllVisited0, AllVisited) :-
- not set_bbbtree__member(Node, Visited0),
- relation__lookup_from(Rel, Node, AdjSet),
- set__to_sorted_list(AdjSet, AdjList),
- set_bbbtree__insert(Visited0, Node, Visited),
- set_bbbtree__insert(AllVisited0, Node, AllVisited1),
-
- % Go and visit all a nodes children first
- relation__is_dag_3(AdjList, Rel, Visited, AllVisited1, AllVisited1),
-
- % Go and visit the rest
- relation__is_dag_3(Nodes, Rel, Visited0, AllVisited1, AllVisited).
+relation__is_dag_2(Rel, Visit, Node, !AllVisited) :-
+ ( contains(Visit, Node) ->
+ fail
+ ; contains(!.AllVisited, Node) ->
+ true
+ ;
+ relation__lookup_key_set_from(Rel, Node, AdjSet),
+ !:AllVisited = insert(!.AllVisited, Node),
+ 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),
- set__init(Comp0),
- relation__components_2(Rel, DomList, Comp0, Set).
+ relation__components_2(Rel, DomList, set__init, SetofBitsets),
+ Set = set__map(to_set, SetofBitsets).
:- pred relation__components_2(relation(T), list(relation_key),
- set(set(relation_key)), set(set(relation_key))).
+ set(relation_key_set), set(relation_key_set)).
:- mode relation__components_2(in, in, in, out) is det.
relation__components_2(_Rel, [], Comp, Comp).
-relation__components_2(Rel, [ X | Xs ], Comp0, Comp) :-
- set__init(Set0),
+relation__components_2(Rel, [X | Xs], Comp0, Comp) :-
+ init(Set0),
queue__list_to_queue([X], Q0),
relation__reachable_from(Rel, Set0, Q0, Component),
set__insert(Comp0, Component, Comp1),
- set__list_to_set(Xs, XsSet),
- set__difference(XsSet, Component, Xs1Set),
- set__to_sorted_list(Xs1Set, Xs1),
+ list_to_set(Xs, XsSet `with_type` relation_key_set),
+ difference(XsSet, Component, Xs1Set),
+ to_sorted_list(Xs1Set, Xs1),
relation__components_2(Rel, Xs1, Comp1, Comp).
-:- pred relation__reachable_from(relation(T), set(relation_key),
- queue(relation_key), set(relation_key)).
+:- pred relation__reachable_from(relation(T), relation_key_set,
+ queue(relation_key), relation_key_set).
:- mode relation__reachable_from(in, in, in, out) is det.
relation__reachable_from(Rel, Set0, Q0, Set) :-
( queue__get(Q0, X, Q1) ->
- ( set__member(X, Set0) ->
+ ( contains(Set0, X) ->
relation__reachable_from(Rel, Set0, Q1, Set)
;
- relation__lookup_from(Rel, X, FwdSet),
- relation__lookup_to(Rel, X, BwdSet),
- set__union(FwdSet, BwdSet, NextSet0),
- set__difference(NextSet0, Set0, NextSet1),
- set__to_sorted_list(NextSet1, NextList),
+ relation__lookup_key_set_from(Rel, X, FwdSet),
+ relation__lookup_key_set_to(Rel, X, BwdSet),
+ union(FwdSet, BwdSet, NextSet0),
+ difference(NextSet0, Set0, NextSet1),
+ to_sorted_list(NextSet1, NextList),
queue__put_list(Q0, NextList, Q2),
- set__insert(Set0, X, Set1),
+ insert(Set0, X, Set1),
relation__reachable_from(Rel, Set1, Q2, Set)
)
;
@@ -812,21 +847,22 @@
relation__dfsrev(Rel, DfsRev),
relation__inverse(Rel, RelInv),
set__init(Cliques0),
- set_bbbtree__init(Visit),
- relation__cliques_2(DfsRev, RelInv, Visit, Cliques0, Cliques).
+ init(Visit),
+ relation__cliques_2(DfsRev, RelInv, Visit, Cliques0, Cliques1),
+ Cliques = set__map(to_set, Cliques1).
:- pred relation__cliques_2(list(relation_key), relation(T),
- set_bbbtree(relation_key), set(set(relation_key)),
- set(set(relation_key))).
+ relation_key_set, set(relation_key_set),
+ set(relation_key_set)).
:- mode relation__cliques_2(in, in, in, in, out) is det.
relation__cliques_2([], _, _, Cliques, Cliques).
relation__cliques_2([H | T0], RelInv, Visit0, Cliques0, Cliques) :-
% Do a DFS on R'
- relation__dfs_3([H], RelInv, Visit0, [], Visit, StrongComponent),
+ relation__dfs_2(RelInv, H, Visit0, Visit, [], StrongComponent),
% Insert the cycle into the clique set.
- set__list_to_set(StrongComponent, StrongComponentSet),
+ list_to_set(StrongComponent, StrongComponentSet),
set__insert(Cliques0, StrongComponentSet, Cliques1),
% Delete all the visited elements, so first element of the
@@ -855,9 +891,9 @@
:- 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) :-
- set__to_sorted_list(S, SList),
+ to_sorted_list(S, SList),
list__map(relation__lookup_key(Rel), SList, EList),
- set__list_to_set(EList, ESet),
+ 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).
@@ -899,42 +935,45 @@
relation__tsort_2(Rel, Tsort) :-
relation__domain_sorted_list(Rel, DomList),
- set__init(Vis0),
+ init(Vis0),
relation__c_dfs(Rel, DomList, Vis0, _Vis, [], Tsort),
relation__check_tsort(Rel, Vis0, Tsort).
-:- pred relation__check_tsort(relation(T), set(relation_key),
+:- pred relation__check_tsort(relation(T), relation_key_set,
list(relation_key)).
:- mode relation__check_tsort(in, in, in) is semidet.
relation__check_tsort(_Rel, _Vis, []).
relation__check_tsort(Rel, Vis, [X | Xs]) :-
- set__insert(Vis, X, Vis1),
- relation__lookup_from(Rel, X, RX),
- set__intersect(Vis1, RX, BackPointers),
- set__empty(BackPointers),
+ insert(Vis, X, Vis1),
+ relation__lookup_key_set_from(Rel, X, RX),
+ intersect(Vis1, RX, BackPointers),
+ empty(BackPointers),
relation__check_tsort(Rel, Vis1, Xs).
-:- pred relation__c_dfs(relation(T), list(relation_key), set(relation_key),
- set(relation_key), list(relation_key), list(relation_key)).
+:- pred relation__c_dfs(relation(T), list(relation_key), relation_key_set,
+ relation_key_set, list(relation_key), list(relation_key)).
:- mode relation__c_dfs(in, in, in, out, in, out) is det.
-relation__c_dfs(_Rel, [], Vis, Vis, Dfs, Dfs).
-relation__c_dfs(Rel, [X | Xs], VisIn, VisOut, DfsIn, DfsOut) :-
- ( set__member(X, VisIn) ->
- VisIn = Vis1, DfsIn = Dfs1
- ;
- relation__c_dfs_2(Rel, X, VisIn, Vis1, DfsIn, Dfs1)
- ),
- relation__c_dfs(Rel, Xs, Vis1, VisOut, Dfs1, DfsOut).
+relation__c_dfs(_Rel, [], !Vis, !Dfs).
+relation__c_dfs(Rel, [X | Xs], !Vis, !Dfs) :-
+ ( contains(!.Vis, X) ->
+ true
+ ;
+ relation__c_dfs_2(Rel, X, !Vis, !Dfs)
+ ),
+ relation__c_dfs(Rel, Xs, !Vis, !Dfs).
-:- pred relation__c_dfs_2(relation(T), relation_key, set(relation_key),
- set(relation_key), list(relation_key), list(relation_key)).
+:- pred relation__c_dfs_2(relation(T), relation_key, relation_key_set,
+ relation_key_set, list(relation_key), list(relation_key)).
:- mode relation__c_dfs_2(in, in, in, out, in, out) is det.
-relation__c_dfs_2(Rel, X, VisIn, VisOut, DfsIn, DfsOut) :-
- set__insert(VisIn, X, Vis1),
- relation__lookup_from(Rel, X, RelX),
- set__to_sorted_list(RelX, RelXList),
- relation__c_dfs(Rel, RelXList, Vis1, VisOut, DfsIn, Dfs1),
- DfsOut = [X | Dfs1].
+relation__c_dfs_2(Rel, X, !Vis, !Dfs) :-
+ insert(!.Vis, X, !:Vis),
+ relation__lookup_key_set_from(Rel, X, FromXs),
+ foldl(
+ (pred(FromX::in, {!.Vis, !.Dfs}::in,
+ {!:Vis, !:Dfs}::out) is det :-
+ relation__c_dfs_2(Rel, FromX, !Vis, !Dfs)
+ ), FromXs, {!.Vis, !.Dfs}, {!:Vis, !:Dfs}),
+ !:Dfs = [X | !.Dfs].
%------------------------------------------------------------------------------%
@@ -949,21 +988,21 @@
relation__atsort(Rel, ATsort) :-
relation__dfsrev(Rel, DfsRev),
relation__inverse(Rel, RelInv),
- set_bbbtree__init(Visit),
+ init(Visit),
relation__atsort_2(DfsRev, RelInv, Visit, [], ATsort0),
list__reverse(ATsort0, ATsort).
:- pred relation__atsort_2(list(relation_key), relation(T),
- set_bbbtree(relation_key), list(set(T)),
+ relation_key_set, list(set(T)),
list(set(T))).
:- mode relation__atsort_2(in, in, in, in, out) is det.
relation__atsort_2([], _, _, ATsort, ATsort).
relation__atsort_2([H | T], RelInv, Visit0, ATsort0, ATsort) :-
- ( set_bbbtree__member(H, Visit0) ->
+ ( contains(Visit0, H) ->
relation__atsort_2(T, RelInv, Visit0, ATsort0, ATsort)
;
- relation__dfs_3([H], RelInv, Visit0, [], Visit, CliqueL),
+ 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],
@@ -1010,10 +1049,10 @@
relation__detect_fake_reflexives(_Rel, _Rtc, [], []).
relation__detect_fake_reflexives(Rel, Rtc, [X | Xs], FakeRefl) :-
relation__detect_fake_reflexives(Rel, Rtc, Xs, Fake1),
- relation__lookup_from(Rel, X, RelX),
- relation__lookup_to(Rtc, X, RtcX),
- set__intersect(RelX, RtcX, Between),
- ( set__empty(Between) ->
+ relation__lookup_key_set_from(Rel, X, RelX),
+ relation__lookup_key_set_to(Rtc, X, RtcX),
+ intersect(RelX, RtcX, Between),
+ ( empty(Between) ->
FakeRefl = [X | Fake1]
;
FakeRefl = Fake1
@@ -1038,7 +1077,7 @@
%
relation__rtc(Rel, RTC) :-
relation__dfs(Rel, Dfs),
- set_bbbtree__init(Visit),
+ init(Visit),
Rel = relation(NextElement, ElMap, _, _),
map__init(FwdMap),
@@ -1048,47 +1087,43 @@
relation__rtc_2(Dfs, Rel, Visit, RTC0, RTC).
:- pred relation__rtc_2(list(relation_key), relation(T),
- set_bbbtree(relation_key), relation(T), relation(T)).
+ relation_key_set, relation(T), relation(T)).
:- mode relation__rtc_2(in, in, in, in, out) is det.
relation__rtc_2([], _, _, !RTC).
relation__rtc_2([H | T], Rel, Visit0, !RTC) :-
- ( set_bbbtree__member(H, Visit0) ->
+ ( contains(Visit0, H) ->
relation__rtc_2(T, Rel, Visit0, !RTC)
;
- relation__dfs_3([H], Rel, Visit0, [], Visit, CliqueL0),
- list__sort_and_remove_dups(CliqueL0, CliqueL),
- list__foldl((pred(K :: in, L0 :: in, L :: out) is det :-
- relation__lookup_from(Rel, K, Followers0),
- set__to_sorted_list(Followers0, Followers),
- list__merge_and_remove_dups(Followers, L0, L)
- ), CliqueL, CliqueL, CliqueFollowers),
- list__foldl((pred(K :: in, L0 :: in, L :: out) is det :-
- relation__lookup_from(!.RTC, K, Followers0),
- set__to_sorted_list(Followers0, Followers),
- list__merge_and_remove_dups(Followers, L0, L)
- ), CliqueFollowers, CliqueL, NewFollowers),
+ 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),
relation__add_cartesian_product(CliqueL, NewFollowers, !RTC),
relation__rtc_2(T, Rel, Visit, !RTC)
).
-:- pred relation__add_cartesian_product(list(relation_key), list(relation_key),
- relation(T), relation(T)).
-:- mode relation__add_cartesian_product(in, in, in, out) is det.
+:- pred find_followers(relation(T), relation_key,
+ relation_key_set, relation_key_set).
+:- mode find_followers(in, in, in, out) is det.
+
+find_followers(Rel, K, L0, L) :-
+ relation__lookup_key_set_from(Rel, K, Followers),
+ union(Followers, L0, L).
-relation__add_cartesian_product([], _, RTC, RTC).
-relation__add_cartesian_product([K1 | Ks1], Ks2, RTC0, RTC) :-
- relation__add_cartesian_product_2(K1, Ks2, RTC0, RTC1),
- relation__add_cartesian_product(Ks1, Ks2, RTC1, RTC).
-
-:- pred relation__add_cartesian_product_2(relation_key, list(relation_key),
+:- pred relation__add_cartesian_product(relation_key_set, relation_key_set,
relation(T), relation(T)).
-:- mode relation__add_cartesian_product_2(in, in, in, out) is det.
+:- mode relation__add_cartesian_product(in, in, in, out) is det.
-relation__add_cartesian_product_2(_, [], RTC, RTC).
-relation__add_cartesian_product_2(K1, [K2 | Ks2], RTC0, RTC) :-
- relation__add(RTC0, K1, K2, RTC1),
- relation__add_cartesian_product_2(K1, Ks2, RTC1, RTC).
+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)
+ ), KeySet1, !RTC).
%------------------------------------------------------------------------------%
@@ -1105,6 +1140,9 @@
relation__traverse_nodes([], _, _, _) --> [].
relation__traverse_nodes([Node | Nodes], Relation, ProcessNode, ProcessEdge) -->
+ % XXX avoid the sparse_bitset.to_sorted_list here
+ % (difficult to do using sparse_bitset.foldl because
+ % traverse_children has multiple modes).
{ Children = to_sorted_list(lookup_from(Relation,
lookup_element(Relation, Node))) },
ProcessNode(Node),
Index: library/sparse_bitset.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/sparse_bitset.m,v
retrieving revision 1.17
diff -u -u -r1.17 sparse_bitset.m
--- library/sparse_bitset.m 20 Oct 2003 07:29:27 -0000 1.17
+++ library/sparse_bitset.m 19 Dec 2003 02:49:58 -0000
@@ -42,6 +42,7 @@
:- interface.
:- import_module enum, list, term.
+:- use_module set.
:- type sparse_bitset(T). % <= enum(T).
@@ -80,7 +81,13 @@
:- pred sorted_list_to_set(list(T), sparse_bitset(T)) <= enum(T).
:- mode sorted_list_to_set(in, out) is det.
- % `to_sorted_list(Set, List)' returns a list
+ % `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.
:- func to_sorted_list(sparse_bitset(T)) = list(T) <= enum(T).
@@ -88,6 +95,11 @@
:- pred to_sorted_list(sparse_bitset(T), list(T)) <= enum(T).
:- mode to_sorted_list(in, out) is det.
+ % `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'.
:- func make_singleton_set(T) = sparse_bitset(T) <= enum(T).
@@ -114,6 +126,12 @@
:- pred contains(sparse_bitset(T), T) <= enum(T).
:- mode contains(in, in) is semidet.
+ % `member(Set, X)' is true iff `X' is a member of `Set'.
+ % Takes O(rep_size(Set)) time.
+:- pred member(T, sparse_bitset(T)) <= enum(T).
+:- 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.
@@ -214,6 +232,14 @@
% 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 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
@@ -221,6 +247,14 @@
% 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 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.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -239,6 +273,12 @@
:- pragma type_spec(to_sorted_list/1, T = var(_)).
:- pragma type_spec(to_sorted_list/1, T = int).
+:- pragma type_spec(to_set/1, T = var(_)).
+:- pragma type_spec(to_set/1, T = int).
+
+:- pragma type_spec(from_set/1, T = var(_)).
+:- pragma type_spec(from_set/1, T = int).
+
:- pragma type_spec(make_singleton_set/1, T = var(_)).
:- pragma type_spec(make_singleton_set/1, T = int).
@@ -260,9 +300,15 @@
:- pragma type_spec(foldr/3, T = int).
:- pragma type_spec(foldr/3, T = var(_)).
+:- pragma type_spec(foldr/4, T = int).
+:- pragma type_spec(foldr/4, T = var(_)).
+
:- pragma type_spec(foldl/3, T = int).
:- pragma type_spec(foldl/3, T = var(_)).
+:- pragma type_spec(foldl/4, T = int).
+:- pragma type_spec(foldl/4, T = var(_)).
+
:- pragma type_spec(list_to_set/2, T = var(_)).
:- pragma type_spec(list_to_set/2, T = int).
@@ -326,60 +372,95 @@
to_sorted_list(Set) = foldr(func(Elem, Acc0) = [Elem | Acc0], Set, []).
+to_set(Set) = set.sorted_list_to_set(to_sorted_list(Set)).
+
+from_set(Set) = sorted_list_to_set(set.to_sorted_list(Set)).
+
%-----------------------------------------------------------------------------%
-foldl(F, sparse_bitset(Set), Acc0) = foldl_2(F, Set, Acc0).
+foldl(P, sparse_bitset(Set), !Acc) :-
+ foldl_2(P, Set, !Acc).
+
+foldl(F, sparse_bitset(Set), Acc0) = Acc :-
+ foldl_2(
+ (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.
-:- func foldl_2(func(T, U) = U, bitset_impl, U) = U <= enum(T).
-:- pragma type_spec(foldl_2/3, T = int).
-:- pragma type_spec(foldl_2/3, T = var(_)).
-
-foldl_2(_, [], Acc) = Acc.
-foldl_2(F, [H | T], Acc0) = Acc :-
- Acc1 = fold_bits(low_to_high, F, H ^ offset, H ^ bits, Acc0),
- Acc = foldl_2(F, T, Acc1).
+:- pragma type_spec(foldl_2/4, T = int).
+:- pragma type_spec(foldl_2/4, T = var(_)).
-foldr(F, sparse_bitset(Set), Acc0) = foldr_2(F, Set, Acc0).
+foldl_2(_, [], !Acc).
+foldl_2(P, [H | T], !Acc) :-
+ fold_bits(low_to_high, P, H ^ offset, H ^ bits, bits_per_int, !Acc),
+ foldl_2(P, T, !Acc).
+
+foldr(P, sparse_bitset(Set), !Acc) :-
+ foldr_2(P, Set, !Acc).
+
+foldr(F, sparse_bitset(Set), Acc0) = Acc :-
+ foldr_2(
+ (pred(E::in, Acc1::in, Acc2::out) is det :-
+ Acc2 = F(E, Acc1)
+ ), Set, Acc0, Acc).
:- func foldr_2(func(T, U) = U, bitset_impl, U) = U <= enum(T).
:- pragma type_spec(foldr_2/3, T = int).
:- pragma type_spec(foldr_2/3, T = var(_)).
+:- 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.
+
% 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) = Acc.
-foldr_2(F, [H | T], Acc0) = Acc :-
- Acc1 = foldr_2(F, T, Acc0),
- Acc = fold_bits(high_to_low, F, H ^ offset, H ^ bits, Acc1).
-
-:- func fold_bits(fold_direction, func(T, U) = U, int, int, U) = U <= enum(T).
-:- pragma type_spec(fold_bits/5, T = int).
-:- pragma type_spec(fold_bits/5, T = var(_)).
+foldr_2(_, [], !Acc).
+foldr_2(P, [H | T], !Acc) :-
+ foldr_2(P, T, !Acc),
+ fold_bits(high_to_low, P, H ^ offset, H ^ bits, bits_per_int, !Acc).
-fold_bits(Dir, F, Offset, Bits, Acc0) = Acc :-
- Size = bits_per_int,
- Acc = fold_bits_2(Dir, F, Offset, Bits, Size, Acc0).
+ % 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 semidet,
+ in, in, in, in, out) is semidet.
+:- mode fold_bits(in, pred(in, in, out) is nondet,
+ in, in, in, in, out) is nondet.
+:- mode fold_bits(in, pred(in, di, uo) is cc_multi,
+ in, in, in, di, uo) is cc_multi.
+:- mode fold_bits(in, pred(in, in, out) is cc_multi,
+ in, in, in, in, out) is cc_multi.
+:- 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
.
- % Do a binary search for the 1 bits in an int.
-:- func fold_bits_2(fold_direction, func(T, U) = U,
- int, int, int, U) = U <= enum(T).
-:- pragma type_spec(fold_bits_2/6, T = int).
-:- pragma type_spec(fold_bits_2/6, T = var(_)).
-
-fold_bits_2(Dir, F, Offset, Bits, Size, Acc0) = Acc :-
+fold_bits(Dir, P, Offset, Bits, Size, !Acc) :-
( Bits = 0 ->
- Acc = Acc0
+ true
; Size = 1 ->
( Elem = from_int(Offset) ->
- Acc = F(Elem, Acc0)
+ P(Elem, !Acc)
;
% We only apply `from_int/1' to integers returned
% by `to_int/1', so it should never fail.
@@ -397,16 +478,15 @@
(
Dir = low_to_high,
- Acc1 = fold_bits_2(Dir, F, Offset, LowBits,
- HalfSize, Acc0),
- Acc = fold_bits_2(Dir, F, Offset + HalfSize, HighBits,
- HalfSize, Acc1)
+ fold_bits(Dir, P, Offset, LowBits, HalfSize, !Acc),
+ fold_bits(Dir, P, Offset + HalfSize, HighBits,
+ HalfSize, !Acc)
;
Dir = high_to_low,
- Acc1 = fold_bits_2(Dir, F, Offset + HalfSize, HighBits,
- HalfSize, Acc0),
- Acc = fold_bits_2(Dir, F, Offset, LowBits,
- HalfSize, Acc1)
+ fold_bits(Dir, P, Offset + HalfSize, HighBits,
+ HalfSize, !Acc),
+ fold_bits(Dir, P, Offset, LowBits,
+ HalfSize, !Acc)
)
).
@@ -621,6 +701,53 @@
get_bit(Data ^ bits, Index - Offset) \= 0
;
contains_2(Rest, Index)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pragma promise_pure(member/2).
+
+member(Elem::in, Set::in) :-
+ contains(Set, Elem).
+member(Elem::out, sparse_bitset(Set)::in) :-
+ member_2(Index, Set),
+ ( Elem0 = from_int(Index) ->
+ Elem = Elem0
+ ;
+ % 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")
+ ).
+
+:- pred member_2(int, bitset_impl).
+:- mode member_2(out, 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.
+
+member_3(Index, Offset, Size, Bits) :-
+ ( Bits = 0 ->
+ fail
+ ; Size = 1 ->
+ Index = Offset
+ ;
+ 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),
+
+ ( member_3(Index, Offset, HalfSize, LowBits)
+ ; member_3(Index, Offset + HalfSize, HalfSize, HighBits)
+ )
).
%-----------------------------------------------------------------------------%
Index: library/tree234.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/tree234.m,v
retrieving revision 1.39
diff -u -u -r1.39 tree234.m
--- library/tree234.m 31 Oct 2003 03:27:39 -0000 1.39
+++ library/tree234.m 19 Dec 2003 02:49:58 -0000
@@ -191,6 +191,9 @@
:- pragma type_spec(tree234__set(in, in, in, out), K = var(_)).
+:- pragma type_spec(tree234__update(in, in, in, out), K = var(_)).
+:- pragma type_spec(tree234__update(in, in, in, out), K = int).
+
%-----------------------------------------------------------------------------%
:- implementation.
Index: profiler/propagate.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/propagate.m,v
retrieving revision 1.10
diff -u -u -r1.10 propagate.m
--- profiler/propagate.m 27 Jul 1997 15:07:53 -0000 1.10
+++ profiler/propagate.m 19 Dec 2003 02:49:58 -0000
@@ -38,7 +38,7 @@
:- implementation.
:- import_module assoc_list, float, int, list, map, multi_map, require.
-:- import_module string, set_bbbtree, std_util.
+:- import_module string, sparse_bitset, std_util.
% :- import_module writeln.
:- type cycle_info == pair(
@@ -80,13 +80,13 @@
relation__dfsrev(Rel, DfsRev),
relation__inverse(Rel, RelInv),
cycle_info_init(CycleInfo0),
- set_bbbtree__init(Visit0),
+ init(Visit0),
propagate__identify_cycles_2(DfsRev, 1, RelInv, Visit0, [],
CycleInfo0, ATSort, CycleInfo).
:- pred propagate__identify_cycles_2(list(relation_key), int, relation(string),
- set_bbbtree(relation_key), list(string),
+ relation_key_set, list(string),
cycle_info, list(string), cycle_info).
:- mode propagate__identify_cycles_2(in, in, in, in, in, in, out, out) is det.
Index: tests/hard_coded/relation_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/relation_test.exp,v
retrieving revision 1.1
diff -u -u -r1.1 relation_test.exp
--- tests/hard_coded/relation_test.exp 27 Mar 1998 16:42:30 -0000 1.1
+++ tests/hard_coded/relation_test.exp 19 Dec 2003 06:31:48 -0000
@@ -58,3 +58,5 @@
"b" - "c1"
"c" - "d1"
+relation__is_dag(Rel) failed as expected
+relation__is_dag(Rel) succeeded
Index: tests/hard_coded/relation_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/relation_test.m,v
retrieving revision 1.1
diff -u -u -r1.1 relation_test.m
--- tests/hard_coded/relation_test.m 27 Mar 1998 16:42:32 -0000 1.1
+++ tests/hard_coded/relation_test.m 19 Dec 2003 06:17:05 -0000
@@ -31,7 +31,17 @@
print("rtc of Rel ="), nl, print_rel(RTC_Rel), nl,
print("Rel2 ="), nl, print_rel(Rel2), nl,
print("composition of Rel1 and Rel2 ="), nl,
- print_rel(ComposedRel), nl.
+ print_rel(ComposedRel), nl,
+ ( { relation__is_dag(Rel) } ->
+ io__write_string("Error: relation__is_dag(Rel) succeeded\n")
+ ;
+ io__write_string("relation__is_dag(Rel) failed as expected\n")
+ ),
+ ( { relation__is_dag(Rel2) } ->
+ io__write_string("relation__is_dag(Rel) succeeded\n")
+ ;
+ io__write_string("Error: relation__is_dag(Rel2) failed\n")
+ ).
:- pred print_rel(relation(T), state, state).
:- mode print_rel(in, di, uo) is det.
--------------------------------------------------------------------------
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