[m-rev.] for review: improvements to relation.m
Mark Brown
mark at csse.unimelb.edu.au
Wed Sep 5 02:19:28 AEST 2007
Estimated hours taken: 2
Branches: main
Improvements to the relation module.
library/relation.m:
Change the type relation_key/0 to relation_key/1. The argument is
a phantom type which provides some extra type safety.
Document this module using more consistent terminology. In
particular, for relation(T) an "element" refers to a value of
type T, a "key" is of type relation_key(T), and an "edge" is an
ordered pair of keys.
s/remove/delete/g, for consistency with other library modules.
Export a version of relation.reduced which also returns the map
from relation keys to clique keys. (This is needed by G12.)
Change the stability of this module to "medium", on the grounds
that it's been used reasonably widely now.
library/svrelation.m:
compiler/dependency_graph.m:
compiler/hlds_module.m:
compiler/modules.m:
compiler/prog_event.m:
compiler/stratify.m:
profiler/propagate.m:
Update to make use of the new types.
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.95
diff -u -r1.95 dependency_graph.m
--- compiler/dependency_graph.m 17 May 2007 03:52:41 -0000 1.95
+++ compiler/dependency_graph.m 4 Sep 2007 15:45:09 -0000
@@ -350,7 +350,7 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred add_dependency_arcs_in_goal(hlds_goal::in, relation_key::in,
+:- pred add_dependency_arcs_in_goal(hlds_goal::in, relation_key(T)::in,
dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
@@ -416,8 +416,8 @@
%-----------------------------------------------------------------------------%
-:- pred add_dependency_arcs_in_list(list(hlds_goal)::in,
- relation_key::in, dependency_graph(T)::in, dependency_graph(T)::out) is det
+:- pred add_dependency_arcs_in_list(list(hlds_goal)::in, relation_key(T)::in,
+ dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
add_dependency_arcs_in_list([], _Caller, !DepGraph).
@@ -427,7 +427,7 @@
%-----------------------------------------------------------------------------%
-:- pred add_dependency_arcs_in_cases(list(case)::in, relation_key::in,
+:- pred add_dependency_arcs_in_cases(list(case)::in, relation_key(T)::in,
dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
@@ -439,7 +439,7 @@
%-----------------------------------------------------------------------------%
-:- pred add_dependency_arcs_in_cons(cons_id::in, relation_key::in,
+:- pred add_dependency_arcs_in_cons(cons_id::in, relation_key(T)::in,
dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
@@ -577,7 +577,7 @@
write_graph_children(Children, Node, Graph, WriteLink, !IO),
write_graph_nodes(Nodes, Graph, WriteNode, WriteLink, !IO).
-:- pred write_graph_children(list(relation_key)::in, pred_proc_id::in,
+:- pred write_graph_children(list(dependency_graph_key)::in, pred_proc_id::in,
dependency_graph::in,
pred(pred_proc_id, pred_proc_id, io, io)::pred(in, in, di, uo) is det,
io::di, io::uo) is det.
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.154
diff -u -r1.154 hlds_module.m
--- compiler/hlds_module.m 13 Aug 2007 03:01:39 -0000 1.154
+++ compiler/hlds_module.m 4 Sep 2007 15:45:09 -0000
@@ -1378,6 +1378,7 @@
:- type dependency_graph(T) == relation(T).
:- type dependency_graph == dependency_graph(pred_proc_id).
+:- type dependency_graph_key == relation_key(pred_proc_id).
:- type dependency_info(T).
:- type dependency_info == dependency_info(pred_proc_id).
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.439
diff -u -r1.439 modules.m
--- compiler/modules.m 31 Aug 2007 07:16:42 -0000 1.439
+++ compiler/modules.m 4 Sep 2007 15:45:09 -0000
@@ -4516,6 +4516,7 @@
% (Module1 deps_rel Module2) means Module1 is imported by Module2.
:- type deps_rel == relation(module_name).
+:- type deps_rel_key == relation_key(module_name).
:- pred generate_deps_map(set(module_name)::in, bool::in,
deps_map::in, deps_map::out, io::di, io::uo) is det.
@@ -4636,7 +4637,7 @@
% Add interface dependencies to the interface deps relation.
%
-:- pred add_int_deps(relation_key::in, module_imports::in,
+:- pred add_int_deps(deps_rel_key::in, module_imports::in,
deps_rel::in, deps_rel::out) is det.
add_int_deps(ModuleKey, ModuleImports, Rel0, Rel) :-
@@ -4647,7 +4648,7 @@
% Add direct implementation dependencies for a module to the
% implementation deps relation.
%
-:- pred add_impl_deps(relation_key::in, module_imports::in,
+:- pred add_impl_deps(deps_rel_key::in, module_imports::in,
deps_rel::in, deps_rel::out) is det.
add_impl_deps(ModuleKey, ModuleImports, !Rel) :-
@@ -4662,14 +4663,14 @@
% to the impl. deps relation values for the given ModuleKey.
%
:- pred add_parent_impl_deps(lookup_module_imports::lookup_module_imports,
- relation_key::in, module_name::in, deps_rel::in, deps_rel::out) is det.
+ deps_rel_key::in, module_name::in, deps_rel::in, deps_rel::out) is det.
add_parent_impl_deps(LookupModuleImports, ModuleKey, Parent, !Rel) :-
ParentModuleImports = LookupModuleImports(Parent),
add_impl_deps(ModuleKey, ParentModuleImports, !Rel).
:- pred add_parent_impl_deps_list(lookup_module_imports::lookup_module_imports,
- relation_key::in, list(module_name)::in, deps_rel::in, deps_rel::out)
+ deps_rel_key::in, list(module_name)::in, deps_rel::in, deps_rel::out)
is det.
add_parent_impl_deps_list(LookupModuleImports, ModuleKey, Parents, !Rel) :-
@@ -4678,7 +4679,7 @@
% Add a single dependency to a relation.
%
-:- pred add_dep(relation_key::in, T::in, relation(T)::in, relation(T)::out)
+:- pred add_dep(relation_key(T)::in, T::in, relation(T)::in, relation(T)::out)
is det.
add_dep(ModuleRelKey, Dep, !Rel) :-
Index: compiler/prog_event.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_event.m,v
retrieving revision 1.12
diff -u -r1.12 prog_event.m
--- compiler/prog_event.m 1 May 2007 06:31:18 -0000 1.12
+++ compiler/prog_event.m 4 Sep 2007 15:45:09 -0000
@@ -444,7 +444,8 @@
% The attr_key_map maps the name of each attribute to its key in
% attr_dep_rel.
:- type attr_dep_rel == relation(string).
-:- type attr_key_map == bimap(string, relation_key).
+:- type attr_key == relation_key(string).
+:- type attr_key_map == bimap(string, attr_key).
% See the big comment in convert_term_to_spec_map for the documentation
% of this predicate.
@@ -586,7 +587,7 @@
!AttrTypeMap, !DepRel, !ErrorSpecs).
:- pred record_arg_dependencies(string::in, string::in, int::in,
- attr_key_map::in, string::in, relation_key::in,
+ attr_key_map::in, string::in, attr_key::in,
list(string)::in, attr_dep_rel::in, attr_dep_rel::out,
list(error_spec)::in, list(error_spec)::out) is det.
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.61
diff -u -r1.61 stratify.m
--- compiler/stratify.m 7 Aug 2007 07:10:05 -0000 1.61
+++ compiler/stratify.m 4 Sep 2007 15:45:09 -0000
@@ -591,7 +591,7 @@
),
add_new_arcs(Cs, CallsHO, !DepGraph).
-:- pred add_new_arcs2(list(pred_proc_id)::in, relation_key::in,
+:- pred add_new_arcs2(list(pred_proc_id)::in, dependency_graph_key::in,
dependency_graph::in, dependency_graph::out) is det.
add_new_arcs2([], _, !DepGraph).
Index: library/relation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/relation.m,v
retrieving revision 1.44
diff -u -r1.44 relation.m
--- library/relation.m 1 Dec 2006 15:04:37 -0000 1.44
+++ library/relation.m 4 Sep 2007 15:45:10 -0000
@@ -1,19 +1,20 @@
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
-% Copyright (C) 1995-1999,2002-2006 The University of Melbourne.
+% Copyright (C) 1995-1999,2002-2007 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: relation.m.
% Main author: bromage, petdr.
-% Stability: low.
+% Stability: medium
%
-% This module defines a data type for binary relations over reflexive
-% domains.
-%
-% In fact, this is exactly equivalent to a graph/1 type.
+% This module defines a data type relation(T) for binary relations over
+% domain T. A binary relation is equivalent to a directed graph with
+% elements of T as the vertices, with no data associated with the edges
+% (that is, an edge either exists or it doesn't, there is no further
+% information such as weight).
%
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
@@ -24,63 +25,78 @@
:- import_module assoc_list.
:- import_module enum.
:- import_module list.
+:- import_module map.
:- import_module set.
:- import_module sparse_bitset.
%------------------------------------------------------------------------------%
+ % The type of relations over domain T.
+ %
:- type relation(T).
-:- type relation_key.
+ % An abstract type which indexes elements of T in a relation. Relation
+ % keys must be created using add_element/4 before a given element of T
+ % can be used.
+ %
+:- type relation_key(T).
+
+:- instance enum(relation_key(T)).
+
+:- type relation_key_set(T) == sparse_bitset(relation_key(T)).
-:- instance enum(relation_key).
+:- type relation_key == relation_key(generic_relation_key).
+:- type relation_key_set == relation_key_set(generic_relation_key).
-:- type relation_key_set == sparse_bitset(relation_key).
+:- type generic_relation_key
+ ---> generic_relation_key.
- % relation.init creates a new relation.
+ % relation.init creates an empty relation.
%
:- 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.
+ % Return the old relation key if one already exists for this element.
%
-:- pred relation.add_element(relation(T)::in, T::in, relation_key::out,
+:- pred relation.add_element(relation(T)::in, T::in, relation_key(T)::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. Fails if the element has not been added.
%
-:- pred relation.search_element(relation(T)::in, T::in, relation_key::out)
+:- pred relation.search_element(relation(T)::in, T::in, relation_key(T)::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. Aborts if the element has not been added.
%
-:- func relation.lookup_element(relation(T), T) = relation_key.
-:- pred relation.lookup_element(relation(T)::in, T::in, relation_key::out)
+:- func relation.lookup_element(relation(T), T) = relation_key(T).
+:- pred relation.lookup_element(relation(T)::in, T::in, relation_key(T)::out)
is det.
% relation.search_key returns the domain element associated with a
- % relation_key. Fail if the relation_key is not valid.
+ % relation key. Fails if the relation key is not valid.
%
-:- pred relation.search_key(relation(T)::in, relation_key::in, T::out)
+:- pred relation.search_key(relation(T)::in, relation_key(T)::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 key. Aborts 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.
+:- func relation.lookup_key(relation(T), relation_key(T)) = T.
+:- pred relation.lookup_key(relation(T)::in, relation_key(T)::in, T::out)
+ is det.
- % relation.add adds an element to the relation.
+ % relation.add adds an edge to the relation.
%
-:- func relation.add(relation(T), relation_key, relation_key) = relation(T).
-:- pred relation.add(relation(T)::in, relation_key::in, relation_key::in,
+:- func relation.add(relation(T), relation_key(T), relation_key(T)) =
+ relation(T).
+:- pred relation.add(relation(T)::in, relation_key(T)::in, relation_key(T)::in,
relation(T)::out) is det.
% relation.add_values adds an pair of values to the relation's
- % domain and adds an element to the relation.
+ % domain and adds an edge between them to the relation.
%
% relation.add_values(R0, X, Y, R) :-
% relation.add_element(R0, X, XKey, R1),
@@ -91,62 +107,65 @@
:- 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 edges to a relation.
%
:- func relation.add_assoc_list(relation(T),
- assoc_list(relation_key, relation_key)) = relation(T).
+ assoc_list(relation_key(T), relation_key(T))) = relation(T).
:- pred relation.add_assoc_list(relation(T)::in,
- assoc_list(relation_key, relation_key)::in, relation(T)::out) is det.
+ assoc_list(relation_key(T), relation_key(T))::in, relation(T)::out) is det.
- % relation.remove removes an element from the relation.
+ % relation.delete deletes an edge from the relation if it exists,
+ % and leaves the relation unchanged otherwise.
%
-:- func relation.remove(relation(T), relation_key, relation_key)
+:- func relation.delete(relation(T), relation_key(T), relation_key(T))
= relation(T).
-:- pred relation.remove(relation(T)::in, relation_key::in, relation_key::in,
- relation(T)::out) is det.
+:- pred relation.delete(relation(T)::in, relation_key(T)::in,
+ relation_key(T)::in, relation(T)::out) is det.
- % relation.remove_assoc_list removes a list of elements from a relation.
+ % relation.delete_assoc_list deletes a list of edges 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.
+:- func relation.delete_assoc_list(relation(T),
+ assoc_list(relation_key(T), relation_key(T))) = relation(T).
+:- pred relation.delete_assoc_list(relation(T)::in,
+ assoc_list(relation_key(T), relation_key(T))::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 edge is in the relation.
%
-:- pred relation.lookup(relation(T), relation_key, relation_key).
+:- pred relation.lookup(relation(T), relation_key(T), relation_key(T)).
:- 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 is equivalent to relation.lookup, except that
+ % the nondet mode works in the reverse direction.
%
-:- pred relation.reverse_lookup(relation(T), relation_key, relation_key).
+:- pred relation.reverse_lookup(relation(T), relation_key(T), relation_key(T)).
:- mode relation.reverse_lookup(in, out, in) is nondet.
:- mode relation.reverse_lookup(in, in, in) is semidet.
- % Given an x, relation.lookup_from returns the set of elements y
- % such that xRy.
+ % Given the key for x, relation.lookup_from returns the set of keys for
+ % 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,
- set(relation_key)::out) is det.
+:- func relation.lookup_from(relation(T), relation_key(T)) =
+ set(relation_key(T)).
+:- pred relation.lookup_from(relation(T)::in, relation_key(T)::in,
+ set(relation_key(T))::out) is det.
-:- func relation.lookup_key_set_from(relation(T), relation_key)
- = relation_key_set.
+:- func relation.lookup_key_set_from(relation(T), relation_key(T))
+ = relation_key_set(T).
:- pred relation.lookup_key_set_from(relation(T)::in,
- relation_key::in, relation_key_set::out) is det.
+ relation_key(T)::in, relation_key_set(T)::out) is det.
- % Given some y, relation.lookup_to returns the set of elements x
- % such that xRy.
+ % Given the key for y, relation.lookup_to returns the set of keys for
+ % 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,
- set(relation_key)::out) is det.
+:- func relation.lookup_to(relation(T), relation_key(T)) = set(relation_key(T)).
+:- pred relation.lookup_to(relation(T)::in, relation_key(T)::in,
+ set(relation_key(T))::out) is det.
-:- func relation.lookup_key_set_to(relation(T), relation_key)
- = relation_key_set.
+:- func relation.lookup_key_set_to(relation(T), relation_key(T))
+ = relation_key_set(T).
:- pred relation.lookup_key_set_to(relation(T)::in,
- relation_key::in, relation_key_set::out) is det.
+ relation_key(T)::in, relation_key_set(T)::out) is det.
% relation.to_assoc_list turns a relation into a list of pairs of
% elements.
@@ -158,9 +177,9 @@
% relation keys.
%
:- func relation.to_key_assoc_list(relation(T))
- = assoc_list(relation_key, relation_key).
+ = assoc_list(relation_key(T), relation_key(T)).
:- pred relation.to_key_assoc_list(relation(T)::in,
- assoc_list(relation_key, relation_key)::out) is det.
+ assoc_list(relation_key(T), relation_key(T))::out) is det.
% relation.from_assoc_list turns a list of pairs of elements into
% a relation.
@@ -188,37 +207,40 @@
:- 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.
- %
-:- 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 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(R, X, Dfs) is true if Dfs is a depth-first sorting of Rel
+ % starting at X. The set of keys in the list Dfs is equal to the set of
+ % keys for elements y such that xR*y, where R* is the reflexive transitive
+ % closure of R.
+ %
+:- func relation.dfs(relation(T), relation_key(T)) = list(relation_key(T)).
+:- pred relation.dfs(relation(T)::in, relation_key(T)::in,
+ list(relation_key(T))::out) is det.
+
+ % relation.dfsrev(R, X, DfsRev) is true if DfsRev is a reverse
+ % depth-first sorting of Rel starting at X. The set of keys in the list
+ % DfsRev is equal to the set of keys for elements y such that xR*y, where
+ % R* is the reflexive transitive closure of R.
+ %
+:- func relation.dfsrev(relation(T), relation_key(T)) = list(relation_key(T)).
+:- pred relation.dfsrev(relation(T)::in, relation_key(T)::in,
+ list(relation_key(T))::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.
+ % before the parent. If the relation is cyclic, the position in which
+ % cycles are broken (that is, in which a child is placed *after* its
+ % parent) is undefined.
%
-:- func relation.dfs(relation(T)) = list(relation_key).
-:- pred relation.dfs(relation(T)::in, list(relation_key)::out) is det.
+:- func relation.dfs(relation(T)) = list(relation_key(T)).
+:- pred relation.dfs(relation(T)::in, list(relation_key(T))::out) is det.
% relation.dfsrev(Rel, DfsRev) is true if DfsRev is a reverse
% depth-first sorting of Rel. ie DfsRev is the reverse of Dfs
% from relation.dfs/2.
%
-:- func relation.dfsrev(relation(T)) = list(relation_key).
-:- pred relation.dfsrev(relation(T)::in, list(relation_key)::out) is det.
+:- func relation.dfsrev(relation(T)) = list(relation_key(T)).
+:- pred relation.dfsrev(relation(T)::in, list(relation_key(T))::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
@@ -226,34 +248,38 @@
% 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.
+:- pred relation.dfs(relation(T)::in, relation_key(T)::in,
+ relation_key_set(T)::in, relation_key_set(T)::out,
+ list(relation_key(T))::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.
% Visit is Visit0 + DfsRev.
%
-:- pred relation.dfsrev(relation(T)::in, relation_key::in,
- relation_key_set::in, relation_key_set::out, list(relation_key)::out)
- is det.
+:- pred relation.dfsrev(relation(T)::in, relation_key(T)::in,
+ relation_key_set(T)::in, relation_key_set(T)::out,
+ list(relation_key(T))::out) is det.
% relation.is_dag(R) is true iff R is a directed acyclic graph.
%
:- 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.
+ % connected components of R, where each component is represented by
+ % the set of keys for its elements.
%
-:- func relation.components(relation(T)) = set(set(relation_key)).
-:- pred relation.components(relation(T)::in, set(set(relation_key))::out)
+:- func relation.components(relation(T)) = set(set(relation_key(T))).
+:- pred relation.components(relation(T)::in, set(set(relation_key(T)))::out)
is det.
% relation.cliques(R, Cliques) is true if Cliques is the set of the
- % strongly connected components (cliques) of R.
+ % strongly connected components (cliques) of R, where each clique is
+ % represented by the set of keys for its elements.
%
-:- func relation.cliques(relation(T)) = set(set(relation_key)).
-:- pred relation.cliques(relation(T)::in, set(set(relation_key))::out) is det.
+:- func relation.cliques(relation(T)) = set(set(relation_key(T))).
+:- pred relation.cliques(relation(T)::in, set(set(relation_key(T)))::out)
+ is det.
% relation.reduced(R, Red) is true if Red is the reduced relation
% (relation of cliques) obtained from R.
@@ -261,6 +287,12 @@
:- func relation.reduced(relation(T)) = relation(set(T)).
:- pred relation.reduced(relation(T)::in, relation(set(T))::out) is det.
+ % As above, but also return a map from each key in the original relation
+ % to the key for its clique in the reduced relation.
+ %
+:- pred relation.reduced(relation(T)::in, relation(set(T))::out,
+ map(relation_key(T), relation_key(set(T)))::out) is det.
+
% relation.tsort(R, TS) is true if TS is a topological sorting of R.
% It fails if R is cyclic.
%
@@ -308,32 +340,32 @@
:- import_module bimap.
:- import_module int.
-:- import_module map.
:- import_module pair.
:- import_module queue.
:- import_module require.
%------------------------------------------------------------------------------%
-:- type relation_key
+:- type relation_key(T)
---> relation_key(int).
-:- type key_map == map(int, relation_key).
-:- type key_set_map == map(int, relation_key_set).
+ % Note that the integer keys in these maps are actually relation keys.
+ % We use the raw integers as keys to allow type specialization.
+ %
+:- type key_map(T) == map(int, relation_key(T)).
+:- type key_set_map(T) == map(int, relation_key_set(T)).
-:- instance enum(relation_key) where [
+:- instance enum(relation_key(T)) 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
- key_set_map, % The mapping U -> V
- key_set_map % The reverse mapping V -> U
+ relation_key(T), % Next key
+ bimap(T, relation_key(T)), % Elements <-> keys
+ key_set_map(T), % The mapping U -> V
+ key_set_map(T) % The reverse mapping V -> U
).
%------------------------------------------------------------------------------%
@@ -416,7 +448,7 @@
),
Rel = relation(Key, ElMap, FwdOut, BwdOut).
-:- pred relation.sv_add(relation_key::in, relation_key::in,
+:- pred relation.sv_add(relation_key(T)::in, relation_key(T)::in,
relation(T)::in, relation(T)::out) is det.
relation.sv_add(UKey, VKey, Rel0, Rel) :-
@@ -431,7 +463,7 @@
%------------------------------------------------------------------------------%
-relation.remove(Rel0, UKey @ relation_key(U), VKey @ relation_key(V), Rel) :-
+relation.delete(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),
@@ -449,10 +481,10 @@
%------------------------------------------------------------------------------%
-relation.remove_assoc_list(Rel, [], Rel).
-relation.remove_assoc_list(Rel0, [U - V | Elems], Rel) :-
- relation.remove(Rel0, U, V, Rel1),
- relation.remove_assoc_list(Rel1, Elems, Rel).
+relation.delete_assoc_list(Rel, [], Rel).
+relation.delete_assoc_list(Rel0, [U - V | Elems], Rel) :-
+ relation.delete(Rel0, U, V, Rel1),
+ relation.delete_assoc_list(Rel1, Elems, Rel).
%------------------------------------------------------------------------------%
@@ -507,8 +539,8 @@
map.keys(Fwd, FwdKeys),
relation.to_assoc_list_2(Fwd, FwdKeys, ElMap, [], List).
-:- pred relation.to_assoc_list_2(key_set_map::in,
- list(int)::in, bimap(T, relation_key)::in,
+:- pred relation.to_assoc_list_2(key_set_map(T)::in,
+ list(int)::in, bimap(T, relation_key(T))::in,
assoc_list(T, T)::in, assoc_list(T, T)::out) is det.
relation.to_assoc_list_2(_Fwd, [], _, !AssocList).
@@ -519,8 +551,8 @@
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.
+:- pred accumulate_rev_lookup(bimap(T, relation_key(T))::in, T::in,
+ relation_key(T)::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),
@@ -530,9 +562,9 @@
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,
- assoc_list(relation_key, relation_key)::out) is det.
+:- pred relation.to_key_assoc_list_2(key_set_map(T)::in, list(int)::in,
+ assoc_list(relation_key(T), relation_key(T))::in,
+ assoc_list(relation_key(T), relation_key(T))::out) is det.
relation.to_key_assoc_list_2(_Fwd, [], !AssocList).
relation.to_key_assoc_list_2(Fwd, [Key | Keys], !AssocList) :-
@@ -541,9 +573,9 @@
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.
+:- pred accumulate_with_key(relation_key(T)::in, relation_key(T)::in,
+ assoc_list(relation_key(T), relation_key(T))::in,
+ assoc_list(relation_key(T), relation_key(T))::out) is det.
accumulate_with_key(RelKey, U, !AL) :-
!:AL = [RelKey - U | !.AL].
@@ -564,7 +596,7 @@
bimap.ordinates(ElMap, DomList),
sorted_list_to_set(DomList, Dom).
-:- pred relation.domain_sorted_list(relation(T)::in, list(relation_key)::out)
+:- pred relation.domain_sorted_list(relation(T)::in, list(relation_key(T))::out)
is det.
relation.domain_sorted_list(relation(_Key, ElMap, _Fwd, _Bwd), Dom) :-
@@ -612,17 +644,17 @@
% Add the arcs to the composition.
list.foldl(add_compose_arcs(KeyMap1, KeyMap2), KeyAL, !Compose).
-:- pred find_new_rel_keys(pair(relation_key_set)::in,
- relation_key_set::in, relation_key_set::out,
- relation_key_set::in, relation_key_set::out) is det.
+:- pred find_new_rel_keys(pair(relation_key_set(T))::in,
+ relation_key_set(T)::in, relation_key_set(T)::out,
+ relation_key_set(T)::in, relation_key_set(T)::out) is det.
find_new_rel_keys(R1Keys - R2Keys,
R1NeededKeys0, R1NeededKeys1, R2NeededKeys0, R2NeededKeys1) :-
R1NeededKeys1 = sparse_bitset.union(R1NeededKeys0, R1Keys),
R2NeededKeys1 = sparse_bitset.union(R2NeededKeys0, R2Keys).
-:- pred add_compose_arcs(key_map::in, key_map::in, pair(relation_key_set)::in,
- relation(T)::in, relation(T)::out) is det.
+:- pred add_compose_arcs(key_map(T)::in, key_map(T)::in,
+ pair(relation_key_set(T))::in, relation(T)::in, relation(T)::out) is det.
add_compose_arcs(KeyMap1, KeyMap2, R1Keys - R2Keys, !Compose) :-
relation.add_cartesian_product(
@@ -630,8 +662,8 @@
map_key_set(KeyMap2, R2Keys),
!Compose).
-:- pred copy_element(relation(T)::in, relation_key::in,
- relation(T)::in, relation(T)::out, key_map::in, key_map::out) is det.
+:- pred copy_element(relation(T)::in, relation_key(T)::in,
+ relation(T)::in, relation(T)::out, key_map(T)::in, key_map(T)::out) is det.
copy_element(R0, Key, !Compose, !KeyMap) :-
relation.lookup_key(R0, Key, Elem),
@@ -639,13 +671,13 @@
Key = relation_key(KeyInt),
map.det_insert(!.KeyMap, KeyInt, ComposeKey, !:KeyMap).
-:- func map_key_set(key_map, relation_key_set) = relation_key_set.
+:- func map_key_set(key_map(T), relation_key_set(T)) = relation_key_set(T).
map_key_set(KeyMap, Set0) = Set :-
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.
+:- pred accumulate_key_set(key_map(T)::in, relation_key(T)::in,
+ relation_key_set(T)::in, relation_key_set(T)::out) is det.
accumulate_key_set(KeyMap, Key0, !Set) :-
Key0 = relation_key(KeyInt),
@@ -677,9 +709,9 @@
relation.domain_sorted_list(Rel, DomList),
list.foldl2(relation.dfs_2(Rel), DomList, init, _, [], DfsRev).
-:- pred relation.dfs_2(relation(T)::in, relation_key::in,
- relation_key_set::in, relation_key_set::out,
- list(relation_key)::in, list(relation_key)::out) is det.
+:- pred relation.dfs_2(relation(T)::in, relation_key(T)::in,
+ relation_key_set(T)::in, relation_key_set(T)::out,
+ list(relation_key(T))::in, list(relation_key(T))::out) is det.
relation.dfs_2(Rel, Node, !Visit, !DfsRev) :-
( contains(!.Visit, Node) ->
@@ -703,8 +735,8 @@
init(AllVisit),
foldl(relation.is_dag_2(R, Visit), DomList, AllVisit, _).
-:- pred relation.is_dag_2(relation(T)::in, relation_key_set::in,
- relation_key::in, relation_key_set::in, relation_key_set::out)
+:- pred relation.is_dag_2(relation(T)::in, relation_key_set(T)::in,
+ relation_key(T)::in, relation_key_set(T)::in, relation_key_set(T)::out)
is semidet.
% Provided that we never encounter a node that we've visited before
@@ -738,8 +770,8 @@
relation.components_2(Rel, DomList, set.init, SetofBitsets),
Set = set.map(to_set, SetofBitsets).
-:- pred relation.components_2(relation(T)::in, list(relation_key)::in,
- set(relation_key_set)::in, set(relation_key_set)::out) is det.
+:- pred relation.components_2(relation(T)::in, list(relation_key(T))::in,
+ set(relation_key_set(T))::in, set(relation_key_set(T))::out) is det.
relation.components_2(_Rel, [], !Comp).
relation.components_2(Rel, [X | Xs], !Comp) :-
@@ -747,13 +779,13 @@
queue.list_to_queue([X], Q0),
relation.reachable_from(Rel, Q0, Set0, Component),
set.insert(!.Comp, Component, !:Comp),
- list_to_set(Xs, XsSet `with_type` relation_key_set),
+ list_to_set(Xs, XsSet `with_type` relation_key_set(T)),
difference(XsSet, Component, Xs1Set),
to_sorted_list(Xs1Set, Xs1),
relation.components_2(Rel, Xs1, !Comp).
-:- pred relation.reachable_from(relation(T)::in, queue(relation_key)::in,
- relation_key_set::in, relation_key_set::out) is det.
+:- pred relation.reachable_from(relation(T)::in, queue(relation_key(T))::in,
+ relation_key_set(T)::in, relation_key_set(T)::out) is det.
relation.reachable_from(Rel, Q0, !Set) :-
( queue.get(Q0, X, Q1) ->
@@ -799,9 +831,9 @@
relation.cliques_2(DfsRev, RelInv, Visit, Cliques0, Cliques1),
Cliques = set.map(to_set, Cliques1).
-:- pred relation.cliques_2(list(relation_key), relation(T),
- relation_key_set, set(relation_key_set),
- set(relation_key_set)).
+:- pred relation.cliques_2(list(relation_key(T)), relation(T),
+ relation_key_set(T), set(relation_key_set(T)),
+ set(relation_key_set(T))).
:- mode relation.cliques_2(in, in, in, in, out) is det.
relation.cliques_2([], _, _, Cliques, Cliques).
@@ -821,6 +853,9 @@
%------------------------------------------------------------------------------%
relation.reduced(Rel, Red) :-
+ relation.reduced(Rel, Red, _).
+
+relation.reduced(Rel, Red, CliqMap) :-
relation.cliques(Rel, Cliques),
set.to_sorted_list(Cliques, CliqList),
relation.init(Red0),
@@ -829,9 +864,10 @@
relation.to_key_assoc_list(Rel, RelAL),
relation.make_reduced_graph(CliqMap, RelAL, Red1, 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,
+:- type clique_map(T) == map(relation_key(T), relation_key(set(T))).
+
+:- pred relation.make_clique_map(relation(T)::in,
+ list(set(relation_key(T)))::in, clique_map(T)::in, clique_map(T)::out,
relation(set(T))::in, relation(set(T))::out) is det.
relation.make_clique_map(_Rel, [], !Map, !Red).
@@ -843,8 +879,8 @@
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)
+:- pred relation.make_clique_map_2(relation_key(set(T))::in,
+ list(relation_key(T))::in, clique_map(T)::in, clique_map(T)::out)
is det.
relation.make_clique_map_2(_Key, [], !Map).
@@ -852,8 +888,8 @@
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,
+:- pred relation.make_reduced_graph(clique_map(T)::in,
+ assoc_list(relation_key(T), relation_key(T))::in,
relation(set(T))::in, relation(set(T))::out) is det.
relation.make_reduced_graph(_Map, [], !Rel).
@@ -874,8 +910,8 @@
relation.check_tsort(Rel, init, Tsort0),
Tsort = list.map(relation.lookup_key(Rel), Tsort0).
-:- pred relation.check_tsort(relation(T)::in, relation_key_set::in,
- list(relation_key)::in) is semidet.
+:- pred relation.check_tsort(relation(T)::in, relation_key_set(T)::in,
+ list(relation_key(T))::in) is semidet.
relation.check_tsort(_Rel, _Vis, []).
relation.check_tsort(Rel, Vis, [X | Xs]) :-
@@ -902,8 +938,8 @@
relation.atsort_2(DfsRev, RelInv, Visit, [], ATsort0),
list.reverse(ATsort0, ATsort).
-:- 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.
+:- pred relation.atsort_2(list(relation_key(T))::in, relation(T)::in,
+ relation_key_set(T)::in, list(set(T))::in, list(set(T))::out) is det.
relation.atsort_2([], _, _, !ATsort).
relation.atsort_2([H | T], RelInv, Visit0, !ATsort) :-
@@ -946,10 +982,10 @@
% Remove them from the RTC, giving us the TC.
assoc_list.from_corresponding_lists(FakeRefl, FakeRefl, FakeReflComp),
- relation.remove_assoc_list(Rtc, FakeReflComp, Tc).
+ relation.delete_assoc_list(Rtc, FakeReflComp, Tc).
:- pred relation.detect_fake_reflexives(relation(T)::in, relation(T)::in,
- list(relation_key)::in, list(relation_key)::out) is det.
+ list(relation_key(T))::in, list(relation_key(T))::out) is det.
relation.detect_fake_reflexives(_Rel, _Rtc, [], []).
relation.detect_fake_reflexives(Rel, Rtc, [X | Xs], FakeRefl) :-
@@ -988,8 +1024,8 @@
relation.rtc_2(Dfs, Rel, Visit, RTC0, RTC).
-:- pred relation.rtc_2(list(relation_key)::in, relation(T)::in,
- relation_key_set::in, relation(T)::in, relation(T)::out) is det.
+:- pred relation.rtc_2(list(relation_key(T))::in, relation(T)::in,
+ relation_key_set(T)::in, relation(T)::in, relation(T)::out) is det.
relation.rtc_2([], _, _, !RTC).
relation.rtc_2([H | T], Rel, Visit0, !RTC) :-
@@ -1004,15 +1040,15 @@
relation.rtc_2(T, Rel, Visit, !RTC)
).
-:- pred find_followers(relation(T)::in, relation_key::in,
- relation_key_set::in, relation_key_set::out) is det.
+:- pred find_followers(relation(T)::in, relation_key(T)::in,
+ relation_key_set(T)::in, relation_key_set(T)::out) is det.
find_followers(Rel, K, L0, L) :-
relation.lookup_key_set_from(Rel, K, Followers),
union(Followers, L0, L).
-:- pred relation.add_cartesian_product(relation_key_set::in,
- relation_key_set::in, relation(T)::in, relation(T)::out) is det.
+:- pred relation.add_cartesian_product(relation_key_set(T)::in,
+ relation_key_set(T)::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 :-
@@ -1044,7 +1080,7 @@
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 relation.traverse_children(list(relation_key(K)), K, relation(K),
pred(K, K, T, T), T, T).
:- mode relation.traverse_children(in, in, in, pred(in, in, di, uo) is det,
di, uo) is det.
@@ -1081,11 +1117,11 @@
relation.add_assoc_list(R1, AL) = R2 :-
relation.add_assoc_list(R1, AL, R2).
-relation.remove(R1, K1, K2) = R2 :-
- relation.remove(R1, K1, K2, R2).
+relation.delete(R1, K1, K2) = R2 :-
+ relation.delete(R1, K1, K2, R2).
-relation.remove_assoc_list(R1, AL) = R2 :-
- relation.remove_assoc_list(R1, AL, R2).
+relation.delete_assoc_list(R1, AL) = R2 :-
+ relation.delete_assoc_list(R1, AL, R2).
relation.lookup_from(R, K) = S :-
relation.lookup_from(R, K, S).
Index: library/svrelation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/svrelation.m,v
retrieving revision 1.6
diff -u -r1.6 svrelation.m
--- library/svrelation.m 19 Apr 2006 05:17:58 -0000 1.6
+++ library/svrelation.m 4 Sep 2007 15:45:10 -0000
@@ -1,7 +1,7 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%---------------------------------------------------------------------------%
-% Copyright (C) 2005-2006 The University of Melbourne.
+% Copyright (C) 2005-2007 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.
%------------------------------------------------------------------------------%
@@ -24,19 +24,19 @@
:- import_module assoc_list.
:- import_module relation.
- % svrelation.add_element adds an element to the domain of a
- % relation. Return the old relation_key if one already exists.
+ % svrelation.add_element adds an element to the domain of a relation.
+ % Return the old relation key if one already exists for this element.
%
-:- pred svrelation.add_element(T::in, relation_key::out,
+:- pred svrelation.add_element(T::in, relation_key(T)::out,
relation(T)::in, relation(T)::out) is det.
- % svrelation.add adds an element to the relation.
+ % svrelation.add adds an edge to the relation.
%
-:- pred svrelation.add(relation_key::in, relation_key::in,
+:- pred svrelation.add(relation_key(T)::in, relation_key(T)::in,
relation(T)::in, relation(T)::out) is det.
% svrelation.add_values adds an pair of values to the relation's
- % domain and adds an element to the relation.
+ % domain and adds an edge between them to the relation.
%
% svrelation.add_values(X, Y, !R) :-
% svrelation.add_element(X, XKey, !R),
@@ -46,22 +46,22 @@
:- pred svrelation.add_values(T::in, T::in, relation(T)::in, relation(T)::out)
is det.
- % svrelation.add_assoc_list adds a list of elements to a
- % relation.
+ % svrelation.add_assoc_list adds a list of edges to a relation.
%
-:- pred svrelation.add_assoc_list(assoc_list(relation_key, relation_key)::in,
+:- pred svrelation.add_assoc_list(
+ assoc_list(relation_key(T), relation_key(T))::in,
relation(T)::in, relation(T)::out) is det.
- % svrelation.remove removes an element from the relation.
+ % svrelation.delete deletes an edge from the relation if it exists,
+ % and leaves the relation unchanged otherwise.
%
-:- pred svrelation.remove(relation_key::in, relation_key::in,
+:- pred svrelation.delete(relation_key(T)::in, relation_key(T)::in,
relation(T)::in, relation(T)::out) is det.
- % svrelation.remove_assoc_list removes a list of elements
- % from a relation.
+ % svrelation.delete_assoc_list deletes a list of elements from a relation.
%
-:- pred svrelation.remove_assoc_list(
- assoc_list(relation_key, relation_key)::in,
+:- pred svrelation.delete_assoc_list(
+ assoc_list(relation_key(T), relation_key(T))::in,
relation(T)::in, relation(T)::out) is det.
%------------------------------------------------------------------------------%
@@ -81,8 +81,9 @@
svrelation.add_assoc_list(AssocList, !Rel) :-
relation.add_assoc_list(!.Rel, AssocList, !:Rel).
-svrelation.remove(Key1, Key2, !Rel) :-
- relation.remove(!.Rel, Key1, Key2, !:Rel).
+svrelation.delete(Key1, Key2, !Rel) :-
+ relation.delete(!.Rel, Key1, Key2, !:Rel).
+
+svrelation.delete_assoc_list(AssocList, !Rel) :-
+ relation.delete_assoc_list(!.Rel, AssocList, !:Rel).
-svrelation.remove_assoc_list(AssocList, !Rel) :-
- relation.remove_assoc_list(!.Rel, AssocList, !:Rel).
Index: profiler/propagate.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/propagate.m,v
retrieving revision 1.17
diff -u -r1.17 propagate.m
--- profiler/propagate.m 10 Nov 2006 03:26:28 -0000 1.17
+++ profiler/propagate.m 4 Sep 2007 15:45:10 -0000
@@ -93,8 +93,8 @@
identify_cycles_2(DfsRev, 1, RelInv, sparse_bitset.init,
[], ATSort, map.init, PredToCycleMap, multi_map.init, CycleToPredsMap).
-:- pred identify_cycles_2(list(relation_key)::in, int::in,
- relation(string)::in, relation_key_set::in,
+:- pred identify_cycles_2(list(relation_key(string))::in, int::in,
+ relation(string)::in, relation_key_set(string)::in,
list(string)::in, list(string)::out,
pred_to_cycle_map::in, pred_to_cycle_map::out,
cycle_to_preds_map::in, cycle_to_preds_map::out) is det.
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list