[m-rev.] for review: library/digraph.m
Mark Brown
mark at csse.unimelb.edu.au
Fri Sep 7 21:37:20 AEST 2007
Estimated hours taken: 12
Branches: main
library/digraph.m:
New module for directed graphs. This is essentially the relation
module but with more consistent terminology, and with argument
ordering that suits state variables. Other differences with the
relation module:
- The digraph_key type has a phantom type parameter, which helps to
ensure that keys from one digraph are not used with another digraph.
- Exports a version of digraph.reduced which also returns the mapping
between the original digraph keys and the new ones.
- The implementation of compose/3 doesn't try to use the "domain" and
"range" of the graphs (which is meaningless in the relation module
anyway).
- New, more efficient algorithm for is_dag/1. Correctness proof is
documented.
- components/2 uses a more efficient data representation, and avoids
some intermediate data structures.
- reduced/{2,3} avoids some intermediate data structures.
- tc/2 avoids some intermediate data structures.
library/library.m:
Add the new module.
library/relation.m:
Document that this module is deprecated in favour of digraph.
Flag relation.init/{0,1} as obsolete (it would be better to flag
the entire module, or the relation/1 type as obsolete, but Mercury
does not support this).
compiler/*.m:
profiler/*.m:
Use the digraph module rather than the relation module.
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 7 Sep 2007 11:35:01 -0000
@@ -10,13 +10,13 @@
% Main authors: bromage, conway, stayl.
%
% The dependency_graph records which procedures depend on which other
-% procedures. It is defined as a relation (see hlds_module.m) R where xRy
-% means that the definition of x depends on the definition of y.
+% procedures. It is defined as a digraph (see hlds_module.m) R where
+% edge x -> y means that the definition of x depends on the definition of y.
% Note that imported procedures are not included in the dependency_graph
% (although opt_imported procedures are included).
%
% The other important structure is the dependency_ordering which is
-% a list of the cliques (strongly-connected components) of this relation,
+% a list of the cliques (strongly-connected components) of this graph,
% in topological order. This is very handy for doing fixpoint iterations.
%
%-----------------------------------------------------------------------------%
@@ -122,14 +122,15 @@
:- import_module parse_tree.prog_data.
:- import_module bool.
+:- import_module digraph.
:- import_module int.
:- import_module map.
:- import_module maybe.
:- import_module multi_map.
:- import_module pair.
-:- import_module relation.
:- import_module set.
:- import_module std_util.
+:- import_module svset.
:- import_module term.
:- import_module varset.
@@ -167,12 +168,12 @@
<= dependency_node(T).
build_dependency_graph(ModuleInfo, PredIds, Imported, !:DepInfo) :-
- relation.init(DepGraph0),
+ digraph.init(DepGraph0),
add_dependency_nodes(PredIds, ModuleInfo, Imported, DepGraph0, DepGraph1),
add_dependency_arcs(PredIds, ModuleInfo, Imported, DepGraph1, DepGraph),
hlds_dependency_info_init(!:DepInfo),
hlds_dependency_info_set_dependency_graph(DepGraph, !DepInfo),
- relation.atsort(DepGraph, DepOrd0),
+ digraph.atsort(DepGraph, DepOrd0),
sets_to_lists(DepOrd0, [], DepOrd),
hlds_dependency_info_set_dependency_ordering(DepOrd, !DepInfo).
@@ -238,7 +239,7 @@
add_proc_nodes([], _PredId, _ModuleInfo, !DepGraph).
add_proc_nodes([ProcId | ProcIds], PredId, ModuleInfo, !DepGraph) :-
- relation.add_element(!.DepGraph, proc(PredId, ProcId), _, !:DepGraph),
+ digraph.add_vertex(proc(PredId, ProcId), _, !DepGraph),
add_proc_nodes(ProcIds, PredId, ModuleInfo, !DepGraph).
%-----------------------------------------------------------------------------%
@@ -259,7 +260,7 @@
->
true
;
- relation.add_element(!.DepGraph, PredId, _, !:DepGraph)
+ digraph.add_vertex(PredId, _, !DepGraph)
),
add_pred_nodes(PredIds, ModuleInfo, IncludeImported, !DepGraph).
@@ -299,7 +300,7 @@
IncludeImported = do_not_include_imported,
proc_info_get_goal(ProcInfo0, Goal),
- relation.lookup_element(!.DepGraph, proc(PredId, ProcId), Caller),
+ digraph.lookup_key(!.DepGraph, proc(PredId, ProcId), Caller),
add_dependency_arcs_in_goal(Goal, Caller, !DepGraph)
;
IncludeImported = include_imported,
@@ -310,7 +311,7 @@
;
Imported = no,
proc_info_get_goal(ProcInfo0, Goal),
- relation.lookup_element(!.DepGraph, proc(PredId, ProcId), Caller),
+ digraph.lookup_key(!.DepGraph, proc(PredId, ProcId), Caller),
add_dependency_arcs_in_goal(Goal, Caller, !DepGraph)
)
),
@@ -335,7 +336,7 @@
clauses_info_get_clauses_rep(ClausesInfo, ClausesRep),
get_clause_list_any_order(ClausesRep, Clauses),
Goals = list.map(func(clause(_, Goal, _, _)) = Goal, Clauses),
- relation.lookup_element(!.DepGraph, PredId, Caller),
+ digraph.lookup_key(!.DepGraph, PredId, Caller),
add_dependency_arcs_in_list(Goals, Caller, !DepGraph)
),
add_pred_arcs(PredIds, ModuleInfo, IncludeImported, !DepGraph).
@@ -350,7 +351,7 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred add_dependency_arcs_in_goal(hlds_goal::in, relation_key::in,
+:- pred add_dependency_arcs_in_goal(hlds_goal::in, digraph_key(T)::in,
dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
@@ -381,12 +382,12 @@
true
;
(
- % If the node isn't in the relation, then we didn't insert it
+ % If the node isn't in the graph, then we didn't insert it
% because is was imported, and we don't consider it.
- relation.search_element(!.DepGraph,
+ digraph.search_key(!.DepGraph,
dependency_node(proc(PredId, ProcId)), Callee)
->
- relation.add(!.DepGraph, Caller, Callee, !:DepGraph)
+ digraph.add_edge(Caller, Callee, !DepGraph)
;
true
)
@@ -416,8 +417,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, digraph_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 +428,7 @@
%-----------------------------------------------------------------------------%
-:- pred add_dependency_arcs_in_cases(list(case)::in, relation_key::in,
+:- pred add_dependency_arcs_in_cases(list(case)::in, digraph_key(T)::in,
dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
@@ -439,7 +440,7 @@
%-----------------------------------------------------------------------------%
-:- pred add_dependency_arcs_in_cons(cons_id::in, relation_key::in,
+:- pred add_dependency_arcs_in_cons(cons_id::in, digraph_key(T)::in,
dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
@@ -451,12 +452,11 @@
!DepGraph) :-
PredProcId = unshroud_pred_proc_id(ShroudedPredProcId),
(
- % If the node isn't in the relation, then we didn't insert it
+ % If the node isn't in the graph, then we didn't insert it
% because it was imported, and we don't consider it.
- relation.search_element(!.DepGraph, dependency_node(PredProcId),
- Callee)
+ digraph.search_key(!.DepGraph, dependency_node(PredProcId), Callee)
->
- relation.add(!.DepGraph, Caller, Callee, !:DepGraph)
+ digraph.add_edge(Caller, Callee, !DepGraph)
;
true
).
@@ -564,27 +564,27 @@
write_graph(DepInfo, WriteNode, WriteLink, !IO) :-
hlds_dependency_info_get_dependency_graph(DepInfo, DepGraph),
- relation.domain(DepGraph, DomSet),
+ digraph.vertices(DepGraph, DomSet),
set.to_sorted_list(DomSet, DomList),
write_graph_nodes(DomList, DepGraph, WriteNode, WriteLink, !IO).
write_graph_nodes([], _Graph, _WriteNode, _WriteLink, !IO).
write_graph_nodes([Node | Nodes], Graph, WriteNode, WriteLink, !IO) :-
WriteNode(Node, !IO),
- relation.lookup_element(Graph, Node, NodeKey),
- relation.lookup_from(Graph, NodeKey, ChildrenSet),
+ digraph.lookup_key(Graph, Node, NodeKey),
+ digraph.lookup_from(Graph, NodeKey, ChildrenSet),
set.to_sorted_list(ChildrenSet, Children),
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.
write_graph_children([], _Parent, _Graph, _WriteLink, !IO).
write_graph_children([ChildKey | Children], Parent, Graph, WriteLink, !IO) :-
- relation.lookup_key(Graph, ChildKey, Child),
+ digraph.lookup_vertex(Graph, ChildKey, Child),
WriteLink(Parent, Child, !IO),
write_graph_children(Children, Parent, Graph, WriteLink, !IO).
@@ -618,10 +618,10 @@
module_info_dependency_info(ModuleInfo, DepInfo),
hlds_dependency_info_get_dependency_graph(DepInfo, DepGraph),
- relation.lookup_element(DepGraph, PredProcId, PredProcIdKey),
- relation.lookup_to(DepGraph, PredProcIdKey, CallingKeys),
+ digraph.lookup_key(DepGraph, PredProcId, PredProcIdKey),
+ digraph.lookup_to(DepGraph, PredProcIdKey, CallingKeys),
set.member(CallingKey, CallingKeys),
- relation.lookup_key(DepGraph, CallingKey, CallingPred),
+ digraph.lookup_vertex(DepGraph, CallingKey, CallingPred),
list.member(HigherSCC, HigherSCCs),
list.member(CallingPred, HigherSCC)
).
@@ -630,14 +630,14 @@
% Find the SCCs called from a given SCC.
%
-:- pred get_called_scc_ids(scc_id::in, relation(scc_id)::in, set(scc_id)::out)
+:- pred get_called_scc_ids(scc_id::in, digraph(scc_id)::in, set(scc_id)::out)
is det.
get_called_scc_ids(SCCid, SCCRel, CalledSCCSet) :-
- relation.lookup_element(SCCRel, SCCid, SCCidKey),
- relation.lookup_from(SCCRel, SCCidKey, CalledSCCKeys),
+ digraph.lookup_key(SCCRel, SCCid, SCCidKey),
+ digraph.lookup_from(SCCRel, SCCidKey, CalledSCCKeys),
set.to_sorted_list(CalledSCCKeys, CalledSCCKeyList),
- list.map(relation.lookup_key(SCCRel), CalledSCCKeyList, CalledSCCs),
+ list.map(digraph.lookup_vertex(SCCRel), CalledSCCKeyList, CalledSCCs),
set.list_to_set(CalledSCCs, CalledSCCSet).
%-----------------------------------------------------------------------------%
@@ -655,41 +655,41 @@
%
:- pred handle_higher_order_args(list(prog_var)::in, bool::in, scc_id::in,
multi_map(prog_var, pred_proc_id)::in, map(pred_proc_id, scc_id)::in,
- relation(scc_id)::in, relation(scc_id)::out,
+ digraph(scc_id)::in, digraph(scc_id)::out,
set(scc_id)::in, set(scc_id)::out) is det.
handle_higher_order_args([], _, _, _, _, !SCCRel, !NoMerge).
handle_higher_order_args([Arg | Args], IsAgg, SCCid, Map, PredSCC,
- !SCCRel, !NoMerge) :-
+ !SCCGraph, !NoMerge) :-
( multi_map.search(Map, Arg, PredProcIds) ->
list.foldl2(handle_higher_order_arg(PredSCC, IsAgg, SCCid),
- PredProcIds, !SCCRel, !NoMerge)
+ PredProcIds, !SCCGraph, !NoMerge)
;
true
),
handle_higher_order_args(Args, IsAgg, SCCid, Map, PredSCC,
- !SCCRel, !NoMerge).
+ !SCCGraph, !NoMerge).
:- pred handle_higher_order_arg(map(pred_proc_id, scc_id)::in, bool::in,
scc_id::in, pred_proc_id::in,
- relation(scc_id)::in, relation(scc_id)::out,
+ digraph(scc_id)::in, digraph(scc_id)::out,
set(scc_id)::in, set(scc_id)::out) is det.
handle_higher_order_arg(PredSCC, IsAgg, SCCid, PredProcId,
- !SCCRel, !NoMerge) :-
+ !SCCGraph, !NoMerge) :-
( map.search(PredSCC, PredProcId, CalledSCCid) ->
% Make sure anything called through an aggregate
% is not merged into the current sub-module.
(
IsAgg = yes,
- set.insert(!.NoMerge, CalledSCCid, !:NoMerge)
+ svset.insert(CalledSCCid, !NoMerge)
;
IsAgg = no
),
( CalledSCCid = SCCid ->
true
;
- relation.add_values(!.SCCRel, SCCid, CalledSCCid, !:SCCRel)
+ digraph.add_vertices_and_edge(SCCid, CalledSCCid, !SCCGraph)
)
;
true
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 7 Sep 2007 11:35:01 -0000
@@ -39,12 +39,12 @@
:- import_module recompilation.
:- import_module bool.
+:- import_module digraph.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module multi_map.
:- import_module pair.
-:- import_module relation.
:- import_module set.
:- implementation.
@@ -1376,8 +1376,9 @@
:- type dependency_ordering(T) == list(list(T)).
:- type dependency_ordering == dependency_ordering(pred_proc_id).
-:- type dependency_graph(T) == relation(T).
+:- type dependency_graph(T) == digraph(T).
:- type dependency_graph == dependency_graph(pred_proc_id).
+:- type dependency_graph_key == digraph_key(pred_proc_id).
:- type dependency_info(T).
:- type dependency_info == dependency_info(pred_proc_id).
@@ -1408,9 +1409,9 @@
).
hlds_dependency_info_init(DepInfo) :-
- relation.init(DepRel),
+ digraph.init(DepGraph),
DepOrd = [],
- DepInfo = dependency_info(DepRel, DepOrd).
+ DepInfo = dependency_info(DepGraph, DepOrd).
hlds_dependency_info_get_dependency_graph(DepInfo, DepInfo ^ dep_graph).
hlds_dependency_info_get_dependency_ordering(DepInfo, DepInfo ^ dep_ord).
Index: compiler/make.program_target.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.program_target.m,v
retrieving revision 1.78
diff -u -r1.78 make.program_target.m
--- compiler/make.program_target.m 27 Aug 2007 06:36:33 -0000 1.78
+++ compiler/make.program_target.m 7 Sep 2007 11:35:01 -0000
@@ -49,9 +49,9 @@
:- import_module transform_hlds.
:- import_module transform_hlds.mmc_analysis.
+:- import_module digraph.
:- import_module dir.
:- import_module getopt_io.
-:- import_module relation.
%-----------------------------------------------------------------------------%
@@ -798,8 +798,8 @@
reverse_ordered_modules(ModuleDeps, Modules0, Modules) :-
list.foldl2(add_module_relations(lookup_module_imports(ModuleDeps)),
- Modules0, relation.init, _IntRel, relation.init, ImplRel),
- relation.atsort(ImplRel, Order0),
+ Modules0, digraph.init, _IntDepsGraph, digraph.init, ImplDepsGraph),
+ digraph.atsort(ImplDepsGraph, Order0),
list.reverse(Order0, Order1),
list.map(set.to_sorted_list, Order1, Order2),
list.condense(Order2, Modules).
Index: compiler/mode_ordering.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_ordering.m,v
retrieving revision 1.23
diff -u -r1.23 mode_ordering.m
--- compiler/mode_ordering.m 7 Aug 2007 07:09:59 -0000 1.23
+++ compiler/mode_ordering.m 7 Sep 2007 11:35:01 -0000
@@ -63,8 +63,8 @@
:- import_module parse_tree.prog_data.
:- import_module assoc_list.
+:- import_module digraph.
:- import_module pair.
-:- import_module relation.
:- import_module set.
:- import_module solutions.
:- import_module stack.
@@ -434,28 +434,28 @@
set.to_sorted_list(G ^ hlds_goal_info ^ make_visible_vars), MVM0)
), GoalMap, map.init),
- Relation = map.foldl((func(I, G, R0) = R :-
+ Graph = map.foldl((func(I, G, !.R) = !:R :-
GI = G ^ hlds_goal_info,
- relation.add_element(R0, I, Key0, R1),
- R2 = list.foldl((func(V, R10) = R12 :-
+ digraph.add_vertex(I, Key0, !R),
+ !:R = list.foldl((func(V, !.R1) = !:R1 :-
( Index1 = map.search(ProdMap, V) ->
- relation.add_element(R10, Index1, Key1, R11),
- relation.add(R11, Key1, Key0, R12)
+ digraph.add_vertex(Index1, Key1, !R1),
+ digraph.add_edge(Key1, Key0, !R1)
;
- R12 = R10
+ true
)
- ), set.to_sorted_list(GI ^ consuming_vars), R1),
- R = list.foldl((func(V, R20) = R22 :-
+ ), set.to_sorted_list(GI ^ consuming_vars), !.R),
+ !:R = list.foldl((func(V, !.R2) = !:R2 :-
( Index2 = map.search(MakeVisMap, V) ->
- relation.add_element(R20, Index2, Key2, R21),
- relation.add(R21, Key2, Key0, R22)
+ digraph.add_vertex(Index2, Key2, !R2),
+ digraph.add_edge(Key2, Key0, !R2)
;
- R22 = R20
+ true
)
- ), set.to_sorted_list(GI ^ need_visible_vars), R2)
- ), GoalMap, relation.init),
+ ), set.to_sorted_list(GI ^ need_visible_vars), !.R)
+ ), GoalMap, digraph.init),
- ( relation.tsort(Relation, TSort) ->
+ ( digraph.tsort(Graph, TSort) ->
Goals = map.apply_to_list(TSort, GoalMap)
;
% XXX Report a mode error for this.
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 7 Sep 2007 11:35:01 -0000
@@ -51,12 +51,12 @@
:- import_module assoc_list.
:- import_module bool.
+:- import_module digraph.
:- import_module io.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
-:- import_module relation.
:- import_module set.
%-----------------------------------------------------------------------------%
@@ -637,8 +637,8 @@
% LookupModuleImports function.
%
:- pred add_module_relations(lookup_module_imports::lookup_module_imports,
- module_name::in, relation(module_name)::in, relation(module_name)::out,
- relation(module_name)::in, relation(module_name)::out) is det.
+ module_name::in, digraph(module_name)::in, digraph(module_name)::out,
+ digraph(module_name)::in, digraph(module_name)::out) is det.
:- type lookup_module_imports == (func(module_name) = module_imports).
:- mode lookup_module_imports == in(func(in) = out is det).
@@ -836,7 +836,6 @@
:- import_module sparse_bitset.
:- import_module string.
:- import_module svmap.
-:- import_module svrelation.
:- import_module svset.
:- import_module term.
:- import_module unit.
@@ -4174,15 +4173,16 @@
),
%
- % Compute the interface deps relation and the implementation deps
- % relation from the deps map.
+ % Compute the interface deps graph and the implementation deps
+ % graph from the deps map.
%
- relation.init(IntDepsRel0),
- relation.init(ImplDepsRel0),
+ digraph.init(IntDepsGraph0),
+ digraph.init(ImplDepsGraph0),
map.values(DepsMap, DepsList),
- deps_list_to_deps_rel(DepsList, DepsMap,
- IntDepsRel0, IntDepsRel, ImplDepsRel0, ImplDepsRel),
- maybe_output_imports_graph(ModuleName, IntDepsRel, ImplDepsRel, !IO),
+ deps_list_to_deps_graph(DepsList, DepsMap, IntDepsGraph0, IntDepsGraph,
+ ImplDepsGraph0, ImplDepsGraph),
+ maybe_output_imports_graph(ModuleName, IntDepsGraph, ImplDepsGraph,
+ !IO),
%
% Compute the trans-opt deps ordering, by doing an approximate
@@ -4190,7 +4190,7 @@
% the subset of those for which of those we have (or can make)
% trans-opt files.
%
- relation.atsort(ImplDepsRel, ImplDepsOrdering0),
+ digraph.atsort(ImplDepsGraph, ImplDepsOrdering0),
maybe_output_module_order(ModuleName, ImplDepsOrdering0, !IO),
list.map(set.to_sorted_list, ImplDepsOrdering0, ImplDepsOrdering),
list.condense(ImplDepsOrdering, TransOptDepsOrdering0),
@@ -4199,7 +4199,7 @@
get_opt_deps(yes, TransOptDepsOrdering0, IntermodDirs, ".trans_opt",
TransOptDepsOrdering, !IO),
- % relation.to_assoc_list(ImplDepsRel, ImplDepsAL),
+ % digraph.to_assoc_list(ImplDepsGraph, ImplDepsAL),
% print("ImplDepsAL:\n", !IO),
% write_list(ImplDepsAL, "\n", print, !IO), nl(!IO),
@@ -4210,8 +4210,8 @@
% of the interface dependencies, but we now include implementation
% details in the interface files).
%
- relation.tc(ImplDepsRel, TransImplDepsRel),
- relation.compose(ImplDepsRel, TransImplDepsRel, IndirectDepsRel),
+ digraph.tc(ImplDepsGraph, TransImplDepsGraph),
+ digraph.compose(ImplDepsGraph, TransImplDepsGraph, IndirectDepsGraph),
%
% Compute the indirect optimization dependencies: indirect
@@ -4223,7 +4223,7 @@
% of that module's implementation dependencies; in actual fact,
% it will be some subset of that.
%
- relation.tc(ImplDepsRel, IndirectOptDepsRel),
+ digraph.tc(ImplDepsGraph, IndirectOptDepsGraph),
(
Mode = output_d_file_only,
@@ -4232,8 +4232,8 @@
Mode = output_all_dependencies,
DFilesToWrite = DepsList
),
- generate_dependencies_write_d_files(DFilesToWrite,
- IntDepsRel, ImplDepsRel, IndirectDepsRel, IndirectOptDepsRel,
+ generate_dependencies_write_d_files(DFilesToWrite, IntDepsGraph,
+ ImplDepsGraph, IndirectDepsGraph, IndirectOptDepsGraph,
TransOptDepsOrdering, DepsMap, !IO)
),
%
@@ -4254,10 +4254,10 @@
).
:- pred maybe_output_imports_graph(module_name::in,
- relation(sym_name)::in, relation(sym_name)::in,
+ digraph(sym_name)::in, digraph(sym_name)::in,
io::di, io::uo) is det.
-maybe_output_imports_graph(Module, IntDepsRel, ImplDepsRel, !IO) :-
+maybe_output_imports_graph(Module, IntDepsGraph, ImplDepsGraph, !IO) :-
globals.io_lookup_bool_option(imports_graph, ImportsGraph, !IO),
globals.io_lookup_bool_option(verbose, Verbose, !IO),
(
@@ -4270,12 +4270,12 @@
(
ImpResult = ok(ImpStream),
- Rel0 = list.foldl(filter_imports_relation,
- relation.to_assoc_list(IntDepsRel), relation.init),
- Rel = list.foldl(filter_imports_relation,
- relation.to_assoc_list(ImplDepsRel), Rel0),
+ Deps0 = list.foldl(filter_imports_graph,
+ digraph.to_assoc_list(IntDepsGraph), digraph.init),
+ Deps = list.foldl(filter_imports_graph,
+ digraph.to_assoc_list(ImplDepsGraph), Deps0),
- write_relation(ImpStream, "imports", sym_name_to_node_id, Rel, !IO),
+ write_graph(ImpStream, "imports", sym_name_to_node_id, Deps, !IO),
io.close_output(ImpStream, !IO),
maybe_write_string(Verbose, " done.\n", !IO)
@@ -4292,18 +4292,16 @@
ImportsGraph = no
).
-:- func filter_imports_relation(pair(sym_name, sym_name),
- relation(sym_name)) = relation(sym_name).
+:- func filter_imports_graph(pair(sym_name, sym_name), digraph(sym_name)) =
+ digraph(sym_name).
-filter_imports_relation(A - B, Relation) =
+filter_imports_graph(A - B, DepsGraph) =
(
%
- % Don't keep the relation if it points to a builtin-module
- % or if the relationship is between two standard library
- % modules
+ % Don't keep the edge if it points to a builtin-module or if the
+ % relationship is between two standard library modules.
% XXX it would be better to change this to be only keep those
- % relations for which the left-hand side is in the current
- % directory.
+ % edges for which the left-hand side is in the current directory.
%
(
any_mercury_builtin_module(B)
@@ -4312,21 +4310,21 @@
is_std_lib_module_name(B, _)
)
->
- Relation
+ DepsGraph
;
- relation.add_values(Relation, A, B)
+ digraph.add_vertices_and_edge(A, B, DepsGraph)
).
:- type gen_node_name(T) == (func(T) = string).
-:- pred write_relation(io.output_stream::in, string::in,
- gen_node_name(T)::in, relation(T)::in, io::di, io::uo) is det.
+:- pred write_graph(io.output_stream::in, string::in,
+ gen_node_name(T)::in, digraph(T)::in, io::di, io::uo) is det.
-write_relation(Stream, Name, GenNodeName, Relation, !IO) :-
+write_graph(Stream, Name, GenNodeName, Graph, !IO) :-
io.write_string(Stream, "digraph " ++ Name ++ " {\n", !IO),
io.write_string(Stream, "label=\"" ++ Name ++ "\";\n", !IO),
io.write_string(Stream, "center=true;\n", !IO),
- relation.traverse(Relation, write_node(Stream, GenNodeName),
+ digraph.traverse(Graph, write_node(Stream, GenNodeName),
write_edge(Stream, GenNodeName), !IO),
io.write_string(Stream, "}\n", !IO).
@@ -4396,34 +4394,34 @@
%
% This predicate writes out the .d files for all the modules in the
% Modules list.
- % IntDepsRel gives the interface dependency relation.
- % ImplDepsRel gives the implementation dependency relation
- % IndirectDepsRel gives the indirect dependency relation
+ % IntDepsGraph gives the interface dependency graph.
+ % ImplDepsGraph gives the implementation dependency graph.
+ % IndirectDepsGraph gives the indirect dependency graph
% (this includes dependencies on `*.int2' files).
- % IndirectOptDepsRel gives the indirect optimization dependencies
+ % IndirectOptDepsGraph gives the indirect optimization dependencies
% (this includes dependencies via `.opt' and `.trans_opt' files).
% These are all computed from the DepsMap.
% TransOptOrder gives the ordering that is used to determine
% which other modules the .trans_opt files may depend on.
%
:- pred generate_dependencies_write_d_files(list(deps)::in,
- deps_rel::in, deps_rel::in, deps_rel::in, deps_rel::in,
+ deps_graph::in, deps_graph::in, deps_graph::in, deps_graph::in,
list(module_name)::in, deps_map::in, io::di, io::uo) is det.
generate_dependencies_write_d_files([], _, _, _, _, _, _, !IO).
generate_dependencies_write_d_files([Dep | Deps],
- IntDepsRel, ImplDepsRel, IndirectDepsRel, IndirectOptDepsRel,
+ IntDepsGraph, ImplDepsGraph, IndirectDepsGraph, IndirectOptDepsGraph,
TransOptOrder, DepsMap, !IO) :-
some [!Module] (
Dep = deps(_, !:Module),
%
% Look up the interface/implementation/indirect dependencies
- % for this module from the respective dependency relations,
+ % for this module from the respective dependency graphs,
% and save them in the module_imports structure.
%
module_imports_get_module_name(!.Module, ModuleName),
- get_dependencies_from_relation(IndirectOptDepsRel, ModuleName,
+ get_dependencies_from_graph(IndirectOptDepsGraph, ModuleName,
IndirectOptDeps),
globals.io_lookup_bool_option(intermodule_optimization, Intermod,
!IO),
@@ -4437,9 +4435,9 @@
IndirectDeps = IndirectOptDeps
;
Intermod = no,
- get_dependencies_from_relation(IntDepsRel, ModuleName, IntDeps),
- get_dependencies_from_relation(ImplDepsRel, ModuleName, ImplDeps),
- get_dependencies_from_relation(IndirectDepsRel, ModuleName,
+ get_dependencies_from_graph(IntDepsGraph, ModuleName, IntDeps),
+ get_dependencies_from_graph(ImplDepsGraph, ModuleName, ImplDeps),
+ get_dependencies_from_graph(IndirectDepsGraph, ModuleName,
IndirectDeps)
),
@@ -4489,19 +4487,20 @@
;
true
),
- generate_dependencies_write_d_files(Deps, IntDepsRel, ImplDepsRel,
- IndirectDepsRel, IndirectOptDepsRel, TransOptOrder, DepsMap, !IO)
+ generate_dependencies_write_d_files(Deps, IntDepsGraph, ImplDepsGraph,
+ IndirectDepsGraph, IndirectOptDepsGraph, TransOptOrder, DepsMap,
+ !IO)
).
-:- pred get_dependencies_from_relation(deps_rel::in, module_name::in,
+:- pred get_dependencies_from_graph(deps_graph::in, module_name::in,
list(module_name)::out) is det.
-get_dependencies_from_relation(DepsRel0, ModuleName, Deps) :-
- svrelation.add_element(ModuleName, ModuleKey, DepsRel0, DepsRel),
- relation.lookup_key_set_from(DepsRel, ModuleKey, DepsKeysSet),
+get_dependencies_from_graph(DepsGraph0, ModuleName, Deps) :-
+ digraph.add_vertex(ModuleName, ModuleKey, DepsGraph0, DepsGraph),
+ digraph.lookup_key_set_from(DepsGraph, ModuleKey, DepsKeysSet),
sparse_bitset.foldl(
(pred(Key::in, Deps0::in, [Dep | Deps0]::out) is det :-
- relation.lookup_key(DepsRel, Key, Dep)
+ digraph.lookup_vertex(DepsGraph, Key, Dep)
), DepsKeysSet, [], Deps).
% This is the data structure we use to record the dependencies.
@@ -4514,8 +4513,9 @@
module_imports
).
- % (Module1 deps_rel Module2) means Module1 is imported by Module2.
-:- type deps_rel == relation(module_name).
+ % (Module1 -> Module2) means Module1 is imported by Module2.
+:- type deps_graph == digraph(module_name).
+:- type deps_graph_key == digraph_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.
@@ -4561,42 +4561,44 @@
true
).
- % Construct a pair of dependency relations (the interface dependencies
+ % Construct a pair of dependency graphs (the interface dependencies
% and the implementation dependencies) for all the modules in the program.
%
-:- pred deps_list_to_deps_rel(list(deps)::in, deps_map::in,
- deps_rel::in, deps_rel::out, deps_rel::in, deps_rel::out) is det.
+:- pred deps_list_to_deps_graph(list(deps)::in, deps_map::in,
+ deps_graph::in, deps_graph::out, deps_graph::in, deps_graph::out) is det.
-deps_list_to_deps_rel([], _, !IntRel, !ImplRel).
-deps_list_to_deps_rel([Deps | DepsList], DepsMap, !IntRel, !ImplRel) :-
+deps_list_to_deps_graph([], _, !IntDepsGraph, !ImplDepsGraph).
+deps_list_to_deps_graph([Deps | DepsList], DepsMap, !IntDepsGraph,
+ !ImplDepsGraph) :-
Deps = deps(_, ModuleImports),
ModuleError = ModuleImports ^ error,
( ModuleError \= fatal_module_errors ->
- module_imports_to_deps_rel(ModuleImports,
- lookup_module_imports(DepsMap), !IntRel, !ImplRel)
+ module_imports_to_deps_graph(ModuleImports,
+ lookup_module_imports(DepsMap), !IntDepsGraph, !ImplDepsGraph)
;
true
),
- deps_list_to_deps_rel(DepsList, DepsMap, !IntRel, !ImplRel).
+ deps_list_to_deps_graph(DepsList, DepsMap, !IntDepsGraph, !ImplDepsGraph).
:- func lookup_module_imports(deps_map, module_name) = module_imports.
lookup_module_imports(DepsMap, ModuleName) = ModuleImports :-
map.lookup(DepsMap, ModuleName, deps(_, ModuleImports)).
-add_module_relations(LookupModuleImports, ModuleName, !IntRel, !ImplRel) :-
+add_module_relations(LookupModuleImports, ModuleName, !IntDepsGraph,
+ !ImplDepsGraph) :-
ModuleImports = LookupModuleImports(ModuleName),
- module_imports_to_deps_rel(ModuleImports, LookupModuleImports,
- !IntRel, !ImplRel).
+ module_imports_to_deps_graph(ModuleImports, LookupModuleImports,
+ !IntDepsGraph, !ImplDepsGraph).
-:- pred module_imports_to_deps_rel(module_imports::in,
+:- pred module_imports_to_deps_graph(module_imports::in,
lookup_module_imports::lookup_module_imports,
- deps_rel::in, deps_rel::out, deps_rel::in, deps_rel::out) is det.
+ deps_graph::in, deps_graph::out, deps_graph::in, deps_graph::out) is det.
-module_imports_to_deps_rel(ModuleImports, LookupModuleImports,
- !IntRel, !ImplRel) :-
+module_imports_to_deps_graph(ModuleImports, LookupModuleImports,
+ !IntDepsGraph, !ImplDepsGraph) :-
%
- % Add interface dependencies to the interface deps relation.
+ % Add interface dependencies to the interface deps graph.
%
% Note that we need to do this both for the interface imports
% of this module and for the *implementation* imports of
@@ -4614,13 +4616,13 @@
%
ModuleName = ModuleImports ^ module_name,
ParentDeps = ModuleImports ^ parent_deps,
- svrelation.add_element(ModuleName, IntModuleKey, !IntRel),
- add_int_deps(IntModuleKey, ModuleImports, !IntRel),
+ digraph.add_vertex(ModuleName, IntModuleKey, !IntDepsGraph),
+ add_int_deps(IntModuleKey, ModuleImports, !IntDepsGraph),
add_parent_impl_deps_list(LookupModuleImports, IntModuleKey, ParentDeps,
- !IntRel),
+ !IntDepsGraph),
%
- % Add implementation dependencies to the impl. deps relation.
+ % Add implementation dependencies to the impl. deps graph.
% (The implementation dependencies are a superset of the
% interface dependencies.)
%
@@ -4629,61 +4631,63 @@
% because this module may depend on things imported
% only by its parents.
%
- svrelation.add_element(ModuleName, ImplModuleKey, !ImplRel),
- add_impl_deps(ImplModuleKey, ModuleImports, !ImplRel),
+ digraph.add_vertex(ModuleName, ImplModuleKey, !ImplDepsGraph),
+ add_impl_deps(ImplModuleKey, ModuleImports, !ImplDepsGraph),
add_parent_impl_deps_list(LookupModuleImports, ImplModuleKey, ParentDeps,
- !ImplRel).
+ !ImplDepsGraph).
- % Add interface dependencies to the interface deps relation.
+ % Add interface dependencies to the interface deps graph.
%
-:- pred add_int_deps(relation_key::in, module_imports::in,
- deps_rel::in, deps_rel::out) is det.
+:- pred add_int_deps(deps_graph_key::in, module_imports::in,
+ deps_graph::in, deps_graph::out) is det.
-add_int_deps(ModuleKey, ModuleImports, Rel0, Rel) :-
+add_int_deps(ModuleKey, ModuleImports, !DepsGraph) :-
AddDep = add_dep(ModuleKey),
- list.foldl(AddDep, ModuleImports ^ parent_deps, Rel0, Rel1),
- list.foldl(AddDep, ModuleImports ^ int_deps, Rel1, Rel).
+ list.foldl(AddDep, ModuleImports ^ parent_deps, !DepsGraph),
+ list.foldl(AddDep, ModuleImports ^ int_deps, !DepsGraph).
% Add direct implementation dependencies for a module to the
- % implementation deps relation.
+ % implementation deps graph.
%
-:- pred add_impl_deps(relation_key::in, module_imports::in,
- deps_rel::in, deps_rel::out) is det.
+:- pred add_impl_deps(deps_graph_key::in, module_imports::in,
+ deps_graph::in, deps_graph::out) is det.
-add_impl_deps(ModuleKey, ModuleImports, !Rel) :-
+add_impl_deps(ModuleKey, ModuleImports, !DepsGraph) :-
% The implementation dependencies are a superset of the
% interface dependencies, so first we add the interface deps.
- add_int_deps(ModuleKey, ModuleImports, !Rel),
+ add_int_deps(ModuleKey, ModuleImports, !DepsGraph),
% then we add the impl deps
module_imports_get_impl_deps(ModuleImports, ImplDeps),
- list.foldl(add_dep(ModuleKey), ImplDeps, !Rel).
+ list.foldl(add_dep(ModuleKey), ImplDeps, !DepsGraph).
% Add parent implementation dependencies for the given Parent module
- % to the impl. deps relation values for the given ModuleKey.
+ % to the impl. deps graph 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_graph_key::in, module_name::in, deps_graph::in, deps_graph::out)
+ is det.
-add_parent_impl_deps(LookupModuleImports, ModuleKey, Parent, !Rel) :-
+add_parent_impl_deps(LookupModuleImports, ModuleKey, Parent, !DepsGraph) :-
ParentModuleImports = LookupModuleImports(Parent),
- add_impl_deps(ModuleKey, ParentModuleImports, !Rel).
+ add_impl_deps(ModuleKey, ParentModuleImports, !DepsGraph).
:- 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_graph_key::in, list(module_name)::in, deps_graph::in, deps_graph::out)
is det.
-add_parent_impl_deps_list(LookupModuleImports, ModuleKey, Parents, !Rel) :-
+add_parent_impl_deps_list(LookupModuleImports, ModuleKey, Parents,
+ !DepsGraph) :-
list.foldl(add_parent_impl_deps(LookupModuleImports, ModuleKey), Parents,
- !Rel).
+ !DepsGraph).
- % Add a single dependency to a relation.
+ % Add a single dependency to a graph.
%
-:- pred add_dep(relation_key::in, T::in, relation(T)::in, relation(T)::out)
+:- pred add_dep(digraph_key(T)::in, T::in, digraph(T)::in, digraph(T)::out)
is det.
-add_dep(ModuleRelKey, Dep, !Rel) :-
- svrelation.add_element(Dep, DepRelKey, !Rel),
- svrelation.add(ModuleRelKey, DepRelKey, !Rel).
+add_dep(ModuleKey, Dep, !DepsGraph) :-
+ digraph.add_vertex(Dep, DepKey, !DepsGraph),
+ digraph.add_edge(ModuleKey, DepKey, !DepsGraph).
:- type submodule_kind
---> toplevel
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 7 Sep 2007 11:35:01 -0000
@@ -68,16 +68,15 @@
:- import_module assoc_list.
:- import_module bimap.
:- import_module bool.
+:- import_module digraph.
:- import_module int.
:- import_module map.
:- import_module maybe.
:- import_module pair.
-:- import_module relation.
:- import_module set.
:- import_module string.
:- import_module svbimap.
:- import_module svmap.
-:- import_module svrelation.
:- import_module svset.
:- import_module term.
@@ -347,7 +346,7 @@
%
% Stage 1 is done by build_plain_type_map. This records the types of all
% of the ordinary and synthesized attributes in AttrTypeMap0, builds up
- % KeyMap, which maps each attribute name to its relation_key in DepRel0,
+ % KeyMap, which maps each attribute name to its digraph_key in DepRel0,
% and builds DepRel0, which at the end of stage 1 just contains one key
% for each attribute with no relationships between them.
%
@@ -363,19 +362,19 @@
build_plain_type_map(EventName, FileName, EventLineNumber, AttrTerms,
0, map.init, _AttrNumMap, map.init, AttrNameMap,
map.init, AttrTypeMap0, bimap.init, KeyMap,
- relation.init, DepRel0, !ErrorSpecs),
+ digraph.init, DepRel0, !ErrorSpecs),
build_dep_map(EventName, FileName, AttrNameMap, KeyMap, AttrTerms,
AttrTypeMap0, AttrTypeMap, DepRel0, DepRel, !ErrorSpecs),
convert_terms_to_attrs(EventName, FileName, AttrNameMap,
AttrTypeMap, 0, AttrTerms, [], RevAttrs, !ErrorSpecs),
- ( relation.tsort(DepRel, AllAttrNameOrder) ->
+ ( digraph.tsort(DepRel, AllAttrNameOrder) ->
% There is an order for computing the synthesized attributes.
keep_only_synth_attr_nums(AttrNameMap, AllAttrNameOrder,
SynthAttrNumOrder)
;
% It would be nice to print a list of the attributes involved in the
- % (one or more) circular dependencies detected by relation.tsort,
- % but at present relation.m does not have any predicates that can
+ % (one or more) circular dependencies detected by digraph.tsort,
+ % but at present digraph.m does not have any predicates that can
% report the information we would need for that.
Pieces = [words("Circular dependency among"),
words("the synthesized attributes of event"),
@@ -443,8 +442,9 @@
%
% 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_dep_rel == digraph(string).
+:- type attr_key == digraph_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.
@@ -464,7 +464,7 @@
AttrTerm = event_attr_term(AttrName, AttrLineNumber, AttrTypeTerm),
AttrInfo = attr_info(AttrNum, AttrName, AttrLineNumber, AttrTypeTerm),
svmap.det_insert(AttrNum, AttrInfo, !AttrNumMap),
- svrelation.add_element(AttrName, AttrKey, !DepRel),
+ digraph.add_vertex(AttrName, AttrKey, !DepRel),
( svbimap.insert(AttrName, AttrKey, !KeyMap) ->
svmap.det_insert(AttrName, AttrInfo, !AttrNameMap)
;
@@ -586,7 +586,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.
@@ -595,7 +595,7 @@
SynthAttrName, SynthAttrKey, [AttrName | AttrNames],
!DepRel, !ErrorSpecs) :-
( bimap.search(KeyMap, AttrName, AttrKey) ->
- svrelation.add(AttrKey, SynthAttrKey, !DepRel)
+ digraph.add_edge(AttrKey, SynthAttrKey, !DepRel)
;
Pieces = [words("Attribute"), quote(SynthAttrName),
words("of event"), quote(EventName),
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 7 Sep 2007 11:35:01 -0000
@@ -69,10 +69,10 @@
:- import_module assoc_list.
:- import_module bool.
+:- import_module digraph.
:- import_module list.
:- import_module map.
:- import_module pair.
-:- import_module relation.
:- import_module set.
:- import_module string.
@@ -81,7 +81,7 @@
module_info_dependency_info(!.ModuleInfo, DepInfo),
hlds_dependency_info_get_dependency_graph(DepInfo, DepGraph0),
- relation.atsort(DepGraph0, FOSCCs1),
+ digraph.atsort(DepGraph0, FOSCCs1),
dep_sets_to_lists_and_sets(FOSCCs1, [], FOSCCs),
globals.io_lookup_bool_option(warn_non_stratification, Warn, !IO),
module_info_get_stratified_preds(!.ModuleInfo, StratifiedPreds),
@@ -93,7 +93,7 @@
% higher order proc is hidden in some complex data structure
%
% gen_conservative_graph(!ModuleInfo, DepGraph0, DepGraph, HOInfo),
- % relation.atsort(DepGraph, HOSCCs1),
+ % digraph.atsort(DepGraph, HOSCCs1),
% dep_sets_to_lists_and_sets(HOSCCs1, [], HOSCCs),
% higher_order_check_sccs(HOSCCs, HOInfo, !ModuleInfo, !IO).
@@ -584,20 +584,20 @@
( set.member(Caller, CallsHO) ->
CallerInfo = info(PossibleCallees0, _),
set.to_sorted_list(PossibleCallees0, PossibleCallees),
- relation.lookup_element(!.DepGraph, Caller, CallerKey),
+ digraph.lookup_key(!.DepGraph, Caller, CallerKey),
add_new_arcs2(PossibleCallees, CallerKey, !DepGraph)
;
true
),
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).
add_new_arcs2([Callee | Cs], CallerKey, !DepGraph) :-
- relation.lookup_element(!.DepGraph, Callee, CalleeKey),
- relation.add(!.DepGraph, CallerKey, CalleeKey, !:DepGraph),
+ digraph.lookup_key(!.DepGraph, Callee, CalleeKey),
+ digraph.add_edge(CallerKey, CalleeKey, !DepGraph),
add_new_arcs2(Cs, CallerKey, !DepGraph).
% For each given pred id, pass all non imported procs onto the
Index: compiler/tupling.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/tupling.m,v
retrieving revision 1.38
diff -u -r1.38 tupling.m
--- compiler/tupling.m 7 Aug 2007 07:10:07 -0000 1.38
+++ compiler/tupling.m 7 Sep 2007 11:35:01 -0000
@@ -127,6 +127,7 @@
:- import_module assoc_list.
:- import_module bool.
:- import_module counter.
+:- import_module digraph.
:- import_module float.
:- import_module int.
:- import_module list.
@@ -134,7 +135,6 @@
:- import_module maybe.
:- import_module multi_map.
:- import_module pair.
-:- import_module relation.
:- import_module set.
:- import_module string.
:- import_module svmap.
@@ -309,8 +309,8 @@
is semidet.
proc_has_local_callers(CalleeProc, DepGraph) :-
- relation.lookup_element(DepGraph, CalleeProc, CalleeKey),
- relation.lookup_to(DepGraph, CalleeKey, CallingKeys),
+ digraph.lookup_key(DepGraph, CalleeProc, CalleeKey),
+ digraph.lookup_to(DepGraph, CalleeKey, CallingKeys),
not set.empty(CallingKeys).
%-----------------------------------------------------------------------------%
Index: library/digraph.m
===================================================================
RCS file: library/digraph.m
diff -N library/digraph.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/digraph.m 7 Sep 2007 11:35:01 -0000
@@ -0,0 +1,1144 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% 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: digraph.m
+% Main author: bromage, petdr
+% Stability: medium
+%
+% This module defines a data type representing directed graphs. A directed
+% graph of type digraph(T) is logically equivalent to a set of vertices of
+% type T, and a set of edges of type pair(T). The endpoints of each edge
+% must be included in the set of vertices; cycles and loops are allowed.
+%
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+:- module digraph.
+:- interface.
+
+:- import_module assoc_list.
+:- import_module enum.
+:- import_module list.
+:- import_module map.
+:- import_module pair.
+:- import_module set.
+:- import_module sparse_bitset.
+
+%------------------------------------------------------------------------------%
+
+ % The type of directed graphs with vertices in T.
+ %
+:- type digraph(T).
+
+ % The abstract type that indexes vertices in a digraph. Each key is only
+ % valid with the digraph it was created from -- predicates and functions
+ % in this module may throw an exception if an invalid key is used.
+ %
+:- type digraph_key(T).
+
+:- instance enum(digraph_key(T)).
+
+:- type digraph_key_set(T) == sparse_bitset(digraph_key(T)).
+
+ % digraph.init creates an empty digraph.
+ %
+:- func digraph.init = digraph(T).
+:- pred digraph.init(digraph(T)::out) is det.
+
+ % digraph.add_vertex adds a vertex to the domain of a digraph.
+ % Returns the old key if one already exists for this vertex, or
+ % else allocates a new key.
+ %
+:- pred digraph.add_vertex(T::in, digraph_key(T)::out,
+ digraph(T)::in, digraph(T)::out) is det.
+
+ % digraph.search_key returns the key associated with a vertex. Fails if
+ % the vertex is not in the graph.
+ %
+:- pred digraph.search_key(digraph(T)::in, T::in, digraph_key(T)::out)
+ is semidet.
+
+ % digraph.lookup_key returns the key associated with a vertex. Aborts if
+ % the vertex is not in the graph.
+ %
+:- func digraph.lookup_key(digraph(T), T) = digraph_key(T).
+:- pred digraph.lookup_key(digraph(T)::in, T::in, digraph_key(T)::out)
+ is det.
+
+ % digraph.lookup_vertex returns the vertex associated with a key.
+ %
+:- func digraph.lookup_vertex(digraph(T), digraph_key(T)) = T.
+:- pred digraph.lookup_vertex(digraph(T)::in, digraph_key(T)::in, T::out)
+ is det.
+
+ % digraph.add_edge adds an edge to the digraph if it doesn't already
+ % exist, and leaves the digraph unchanged otherwise.
+ %
+:- func digraph.add_edge(digraph_key(T), digraph_key(T), digraph(T)) =
+ digraph(T).
+:- pred digraph.add_edge(digraph_key(T)::in, digraph_key(T)::in,
+ digraph(T)::in, digraph(T)::out) is det.
+
+ % digraph.add_vertices_and_edge adds a pair of vertices and an edge
+ % between them to the digraph.
+ %
+ % digraph.add_vertices_and_edge(X, Y, !G) :-
+ % digraph.add_vertex(X, XKey, !G),
+ % digraph.add_vertex(Y, YKey, !G),
+ % digraph.add_edge(XKey, YKey, !G).
+ %
+:- func digraph.add_vertices_and_edge(T, T, digraph(T)) = digraph(T).
+:- pred digraph.add_vertices_and_edge(T::in, T::in,
+ digraph(T)::in, digraph(T)::out) is det.
+
+ % As above, but takes a pair of vertices in a single argument.
+ %
+:- func digraph.add_vertex_pair(pair(T), digraph(T)) = digraph(T).
+:- pred digraph.add_vertex_pair(pair(T)::in,
+ digraph(T)::in, digraph(T)::out) is det.
+
+ % digraph.add_assoc_list adds a list of edges to a digraph.
+ %
+:- func digraph.add_assoc_list(assoc_list(digraph_key(T), digraph_key(T)),
+ digraph(T)) = digraph(T).
+:- pred digraph.add_assoc_list(assoc_list(digraph_key(T), digraph_key(T))::in,
+ digraph(T)::in, digraph(T)::out) is det.
+
+ % digraph.delete_edge deletes an edge from the digraph if it exists,
+ % and leaves the digraph unchanged otherwise.
+ %
+:- func digraph.delete_edge(digraph_key(T), digraph_key(T), digraph(T)) =
+ digraph(T).
+:- pred digraph.delete_edge(digraph_key(T)::in, digraph_key(T)::in,
+ digraph(T)::in, digraph(T)::out) is det.
+
+ % digraph.delete_assoc_list deletes a list of edges from a digraph.
+ %
+:- func digraph.delete_assoc_list(assoc_list(digraph_key(T), digraph_key(T)),
+ digraph(T)) = digraph(T).
+:- pred digraph.delete_assoc_list(
+ assoc_list(digraph_key(T), digraph_key(T))::in,
+ digraph(T)::in, digraph(T)::out) is det.
+
+ % digraph.is_edge checks to see if an edge is in the digraph.
+ %
+:- pred digraph.is_edge(digraph(T), digraph_key(T), digraph_key(T)).
+:- mode digraph.is_edge(in, in, out) is nondet.
+:- mode digraph.is_edge(in, in, in) is semidet.
+
+ % digraph.is_edge_rev is equivalent to digraph.is_edge, except that
+ % the nondet mode works in the reverse direction.
+ %
+:- pred digraph.is_edge_rev(digraph(T), digraph_key(T), digraph_key(T)).
+:- mode digraph.is_edge_rev(in, out, in) is nondet.
+:- mode digraph.is_edge_rev(in, in, in) is semidet.
+
+ % Given key x, digraph.lookup_from returns the set of keys y such that
+ % there is an edge (x,y) in the digraph.
+ %
+:- func digraph.lookup_from(digraph(T), digraph_key(T)) = set(digraph_key(T)).
+:- pred digraph.lookup_from(digraph(T)::in, digraph_key(T)::in,
+ set(digraph_key(T))::out) is det.
+
+ % As above, but returns a digraph_key_set.
+ %
+:- func digraph.lookup_key_set_from(digraph(T), digraph_key(T)) =
+ digraph_key_set(T).
+:- pred digraph.lookup_key_set_from(digraph(T)::in, digraph_key(T)::in,
+ digraph_key_set(T)::out) is det.
+
+ % Given a key y, digraph.lookup_to returns the set of keys x such that
+ % there is an edge (x,y) in the digraph.
+ %
+:- func digraph.lookup_to(digraph(T), digraph_key(T)) = set(digraph_key(T)).
+:- pred digraph.lookup_to(digraph(T)::in, digraph_key(T)::in,
+ set(digraph_key(T))::out) is det.
+
+ % As above, but returns a digraph_key_set.
+ %
+:- func digraph.lookup_key_set_to(digraph(T), digraph_key(T)) =
+ digraph_key_set(T).
+:- pred digraph.lookup_key_set_to(digraph(T)::in, digraph_key(T)::in,
+ digraph_key_set(T)::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+ % digraph.to_assoc_list turns a digraph into a list of pairs of vertices,
+ % one for each edge.
+ %
+:- func digraph.to_assoc_list(digraph(T)) = assoc_list(T, T).
+:- pred digraph.to_assoc_list(digraph(T)::in, assoc_list(T, T)::out) is det.
+
+ % digraph.to_key_assoc_list turns a digraph into a list of pairs of keys,
+ % one for each edge.
+ %
+:- func digraph.to_key_assoc_list(digraph(T)) =
+ assoc_list(digraph_key(T), digraph_key(T)).
+:- pred digraph.to_key_assoc_list(digraph(T)::in,
+ assoc_list(digraph_key(T), digraph_key(T))::out) is det.
+
+ % digraph.from_assoc_list turns a list of pairs of vertices into a digraph.
+ %
+:- func digraph.from_assoc_list(assoc_list(T, T)) = digraph(T).
+:- pred digraph.from_assoc_list(assoc_list(T, T)::in, digraph(T)::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+ % digraph.dfs(G, Key, Dfs) is true if Dfs is a depth-first sorting of G
+ % starting at Key. The set of keys in the list Dfs is equal to the
+ % set of keys reachable from Key.
+ %
+:- func digraph.dfs(digraph(T), digraph_key(T)) = list(digraph_key(T)).
+:- pred digraph.dfs(digraph(T)::in, digraph_key(T)::in,
+ list(digraph_key(T))::out) is det.
+
+ % digraph.dfsrev(G, Key, DfsRev) is true if DfsRev is a reverse
+ % depth-first sorting of G starting at Key. The set of keys in the
+ % list DfsRev is equal to the set of keys reachable from Key.
+ %
+:- func digraph.dfsrev(digraph(T), digraph_key(T)) = list(digraph_key(T)).
+:- pred digraph.dfsrev(digraph(T)::in, digraph_key(T)::in,
+ list(digraph_key(T))::out) is det.
+
+ % digraph.dfs(G, Dfs) is true if Dfs is a depth-first sorting of G,
+ % i.e. a list of all the keys in G such that all keys for children of
+ % a vertex are placed in the list before the parent key. If the
+ % digraph is cyclic, the position in which cycles are broken (that is,
+ % in which a child is placed *after* its parent) is undefined.
+ %
+:- func digraph.dfs(digraph(T)) = list(digraph_key(T)).
+:- pred digraph.dfs(digraph(T)::in, list(digraph_key(T))::out) is det.
+
+ % digraph.dfsrev(G, DfsRev) is true if DfsRev is a reverse depth-first
+ % sorting of G. That is, DfsRev is the reverse of Dfs from digraph.dfs/2.
+ %
+:- func digraph.dfsrev(digraph(T)) = list(digraph_key(T)).
+:- pred digraph.dfsrev(digraph(T)::in, list(digraph_key(T))::out) is det.
+
+ % digraph.dfs(G, Key, !Visit, Dfs) is true if Dfs is a depth-first
+ % sorting of G starting at Key, assuming we have already visited !.Visit
+ % vertices. That is, Dfs is a list of vertices such that all the
+ % unvisited children of a vertex are placed in the list before the
+ % parent. !.Visit allows us to initialise a set of previously visited
+ % vertices. !:Visit is Dfs + !.Visit.
+ %
+:- pred digraph.dfs(digraph(T)::in, digraph_key(T)::in, digraph_key_set(T)::in,
+ digraph_key_set(T)::out, list(digraph_key(T))::out) is det.
+
+ % digraph.dfsrev(G, Key, !Visit, DfsRev) is true if DfsRev is a
+ % reverse depth-first sorting of G starting at Key providing we have
+ % already visited !.Visit nodes, ie the reverse of Dfs from digraph.dfs/5.
+ % !:Visit is !.Visit + DfsRev.
+ %
+:- pred digraph.dfsrev(digraph(T)::in, digraph_key(T)::in,
+ digraph_key_set(T)::in, digraph_key_set(T)::out,
+ list(digraph_key(T))::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+ % digraph.vertices returns the set of vertices in a digraph.
+ %
+:- func digraph.vertices(digraph(T)) = set(T).
+:- pred digraph.vertices(digraph(T)::in, set(T)::out) is det.
+
+ % digraph.inverse(G, G') is true iff the domains of G and G' are equal,
+ % and for all x, y in this domain, (x,y) is an edge in G iff (y,x) is
+ % an edge in G'.
+ %
+:- func digraph.inverse(digraph(T)) = digraph(T).
+:- pred digraph.inverse(digraph(T)::in, digraph(T)::out) is det.
+
+ % digraph.compose(G1, G2, G) is true if G is the composition
+ % of the digraphs G1 and G2. That is, there is an edge (x,y) in G iff
+ % there exists vertex m such that (x,m) is in G1 and (m,y) is in G2.
+ %
+:- func digraph.compose(digraph(T), digraph(T)) = digraph(T).
+:- pred digraph.compose(digraph(T)::in, digraph(T)::in, digraph(T)::out)
+ is det.
+
+ % digraph.is_dag(G) is true iff G is a directed acyclic graph.
+ %
+:- pred digraph.is_dag(digraph(T)::in) is semidet.
+
+ % digraph.components(G, Comp) is true if Comp is the set of the
+ % connected components of G.
+ %
+:- func digraph.components(digraph(T)) = set(set(digraph_key(T))).
+:- pred digraph.components(digraph(T)::in, set(set(digraph_key(T)))::out)
+ is det.
+
+ % digraph.cliques(G, Cliques) is true if Cliques is the set of the
+ % cliques (strongly connected components) of G.
+ %
+:- func digraph.cliques(digraph(T)) = set(set(digraph_key(T))).
+:- pred digraph.cliques(digraph(T)::in, set(set(digraph_key(T)))::out) is det.
+
+ % digraph.reduced(G, R) is true if R is the reduced digraph (digraph of
+ % cliques) obtained from G.
+ %
+:- func digraph.reduced(digraph(T)) = digraph(set(T)).
+:- pred digraph.reduced(digraph(T)::in, digraph(set(T))::out) is det.
+
+ % As above, but also return a map from each key in the original digraph
+ % to the key for its clique in the reduced digraph.
+ %
+:- pred digraph.reduced(digraph(T)::in, digraph(set(T))::out,
+ map(digraph_key(T), digraph_key(set(T)))::out) is det.
+
+ % digraph.tsort(G, TS) is true if TS is a topological sorting of G.
+ % It fails if G is cyclic.
+ %
+:- pred digraph.tsort(digraph(T)::in, list(T)::out) is semidet.
+
+ % digraph.atsort(G, ATS) is true if ATS is a topological sorting
+ % of the cliques in G.
+ %
+:- func digraph.atsort(digraph(T)) = list(set(T)).
+:- pred digraph.atsort(digraph(T)::in, list(set(T))::out) is det.
+
+ % digraph.sc(G, SC) is true if SC is the symmetric closure of G.
+ % That is, (x,y) is in SC iff either (x,y) or (y,x) is in G.
+ %
+:- func digraph.sc(digraph(T)) = digraph(T).
+:- pred digraph.sc(digraph(T)::in, digraph(T)::out) is det.
+
+ % digraph.tc(G, TC) is true if TC is the transitive closure of G.
+ %
+:- func digraph.tc(digraph(T)) = digraph(T).
+:- pred digraph.tc(digraph(T)::in, digraph(T)::out) is det.
+
+ % digraph.rtc(G, RTC) is true if RTC is the reflexive transitive closure
+ % of G.
+ %
+:- func digraph.rtc(digraph(T)) = digraph(T).
+:- pred digraph.rtc(digraph(T)::in, digraph(T)::out) is det.
+
+ % digraph.traverse(G, ProcessVertex, ProcessEdge) will traverse a digraph
+ % calling ProcessVertex for each vertex in the digraph and ProcessEdge for
+ % each edge in the digraph. Each vertex is processed followed by all the
+ % edges originating at that vertex, until all vertices have been processed.
+ %
+:- pred digraph.traverse(digraph(T), pred(T, A, A), pred(T, T, A, A), A, A).
+:- mode digraph.traverse(in, pred(in, di, uo) is det,
+ pred(in, in, di, uo) is det, di, uo) is det.
+:- mode digraph.traverse(in, pred(in, in, out) is det,
+ pred(in, in, in, out) is det, in, out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module bimap.
+:- import_module int.
+:- import_module require.
+:- import_module svmap.
+:- import_module svset.
+
+%-----------------------------------------------------------------------------%
+
+:- type digraph_key(T)
+ ---> digraph_key(int).
+
+:- instance enum(digraph_key(T)) where [
+ to_int(digraph_key(Int)) = Int,
+ from_int(Int) = digraph_key(Int)
+].
+
+:- type digraph(T)
+ ---> digraph(
+ next_key :: int,
+ % Next unallocated key number.
+
+ vertex_map :: bimap(T, digraph_key(T)),
+ % Maps vertices to their keys.
+
+ fwd_map :: key_set_map(T),
+ % Maps each vertex to its direct
+ % successors.
+
+ bwd_map :: key_set_map(T)
+ % Maps each vertex to its direct
+ % predecessors.
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % Note that the integer keys in these maps are actually digraph keys.
+ % We use the raw integers as keys to allow type specialization.
+ %
+:- type key_map(T) == map(int, digraph_key(T)).
+:- type key_set_map(T) == map(int, digraph_key_set(T)).
+
+:- func key_set_map_add(key_set_map(T), int, digraph_key(T)) = key_set_map(T).
+
+key_set_map_add(Map0, XI, Y) = Map :-
+ ( map.search(Map0, XI, SuccXs0) ->
+ ( contains(SuccXs0, Y) ->
+ Map = Map0
+ ;
+ insert(SuccXs0, Y, SuccXs),
+ Map = map.det_update(Map0, XI, SuccXs)
+ )
+ ;
+ init(SuccXs0),
+ insert(SuccXs0, Y, SuccXs),
+ Map = map.det_insert(Map0, XI, SuccXs)
+ ).
+
+:- func key_set_map_delete(key_set_map(T), int, digraph_key(T)) =
+ key_set_map(T).
+
+key_set_map_delete(Map0, XI, Y) = Map :-
+ ( map.search(Map0, XI, SuccXs0) ->
+ delete(SuccXs0, Y, SuccXs),
+ Map = map.det_update(Map0, XI, SuccXs)
+ ;
+ Map = Map0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+digraph.init = G :-
+ digraph.init(G).
+
+digraph.init(digraph(0, VMap, FwdMap, BwdMap)) :-
+ bimap.init(VMap),
+ map.init(FwdMap),
+ map.init(BwdMap).
+
+%-----------------------------------------------------------------------------%
+
+digraph.add_vertex(Vertex, Key, !G) :-
+ ( bimap.search(!.G ^ vertex_map, Vertex, Key0) ->
+ Key = Key0
+ ;
+ allocate_key(Key, !G),
+ !:G = !.G ^ vertex_map := bimap.set(!.G ^ vertex_map, Vertex, Key)
+ ).
+
+:- pred allocate_key(digraph_key(T)::out, digraph(T)::in, digraph(T)::out)
+ is det.
+
+allocate_key(digraph_key(I), !G) :-
+ I = !.G ^ next_key,
+ !:G = !.G ^ next_key := I + 1.
+
+%-----------------------------------------------------------------------------%
+
+digraph.search_key(G, Vertex, Key) :-
+ bimap.search(G ^ vertex_map, Vertex, Key).
+
+digraph.lookup_key(G, Vertex) = Key :-
+ digraph.lookup_key(G, Vertex, Key).
+
+digraph.lookup_key(G, Vertex, Key) :-
+ ( digraph.search_key(G, Vertex, Key0) ->
+ Key = Key0
+ ;
+ error("digraph.lookup_key")
+ ).
+
+digraph.lookup_vertex(G, Key) = Vertex :-
+ digraph.lookup_vertex(G, Key, Vertex).
+
+digraph.lookup_vertex(G, Key, Vertex) :-
+ ( bimap.search(G ^ vertex_map, Vertex0, Key) ->
+ Vertex = Vertex0
+ ;
+ error("digraph.lookup_vertex")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+digraph.add_edge(X, Y, !.G) = !:G :-
+ digraph.add_edge(X, Y, !G).
+
+digraph.add_edge(X, Y, !G) :-
+ X = digraph_key(XI),
+ Y = digraph_key(YI),
+ !:G = !.G ^ fwd_map := key_set_map_add(!.G ^ fwd_map, XI, Y),
+ !:G = !.G ^ bwd_map := key_set_map_add(!.G ^ bwd_map, YI, X).
+
+digraph.add_vertices_and_edge(VX, VY, !.G) = !:G :-
+ digraph.add_vertices_and_edge(VX, VY, !G).
+
+digraph.add_vertices_and_edge(VX, VY, !G) :-
+ digraph.add_vertex(VX, X, !G),
+ digraph.add_vertex(VY, Y, !G),
+ digraph.add_edge(X, Y, !G).
+
+digraph.add_vertex_pair(Edge, !.G) = !:G :-
+ digraph.add_vertex_pair(Edge, !G).
+
+digraph.add_vertex_pair(VX - VY, !G) :-
+ digraph.add_vertices_and_edge(VX, VY, !G).
+
+digraph.add_assoc_list(Edges, !.G) = !:G :-
+ digraph.add_assoc_list(Edges, !G).
+
+digraph.add_assoc_list([], !G).
+digraph.add_assoc_list([X - Y | Edges], !G) :-
+ digraph.add_edge(X, Y, !G),
+ digraph.add_assoc_list(Edges, !G).
+
+%-----------------------------------------------------------------------------%
+
+digraph.delete_edge(X, Y, !.G) = !:G :-
+ digraph.delete_edge(X, Y, !G).
+
+digraph.delete_edge(X, Y, !G) :-
+ X = digraph_key(XI),
+ Y = digraph_key(YI),
+ !:G = !.G ^ fwd_map := key_set_map_delete(!.G ^ fwd_map, XI, Y),
+ !:G = !.G ^ bwd_map := key_set_map_delete(!.G ^ bwd_map, YI, X).
+
+digraph.delete_assoc_list(Edges, !.G) = !:G :-
+ digraph.delete_assoc_list(Edges, !G).
+
+digraph.delete_assoc_list([], !G).
+digraph.delete_assoc_list([X - Y | Edges], !G) :-
+ digraph.delete_edge(X, Y, !G),
+ digraph.delete_assoc_list(Edges, !G).
+
+%-----------------------------------------------------------------------------%
+
+digraph.is_edge(G, digraph_key(XI), Y) :-
+ map.search(G ^ fwd_map, XI, YSet),
+ member(Y, YSet).
+
+digraph.is_edge_rev(G, X, digraph_key(YI)) :-
+ map.search(G ^ bwd_map, YI, XSet),
+ member(X, XSet).
+
+%-----------------------------------------------------------------------------%
+
+digraph.lookup_from(G, X) = Ys :-
+ digraph.lookup_from(G, X, Ys).
+
+digraph.lookup_from(G, X, to_set(Ys)) :-
+ digraph.lookup_key_set_from(G, X, Ys).
+
+digraph.lookup_key_set_from(G, X) = Ys :-
+ digraph.lookup_key_set_from(G, X, Ys).
+
+digraph.lookup_key_set_from(G, digraph_key(XI), Ys) :-
+ ( map.search(G ^ fwd_map, XI, Ys0) ->
+ Ys = Ys0
+ ;
+ init(Ys)
+ ).
+
+digraph.lookup_to(G, Y) = Xs :-
+ digraph.lookup_to(G, Y, Xs).
+
+digraph.lookup_to(G, Y, to_set(Xs)) :-
+ digraph.lookup_key_set_to(G, Y, Xs).
+
+digraph.lookup_key_set_to(G, Y) = Xs :-
+ digraph.lookup_key_set_to(G, Y, Xs).
+
+digraph.lookup_key_set_to(G, digraph_key(YI), Xs) :-
+ ( map.search(G ^ bwd_map, YI, Xs0) ->
+ Xs = Xs0
+ ;
+ init(Xs)
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+digraph.to_assoc_list(G) = List :-
+ digraph.to_assoc_list(G, List).
+
+digraph.to_assoc_list(G, List) :-
+ Fwd = G ^ fwd_map,
+ map.keys(Fwd, FwdKeys),
+ digraph.to_assoc_list_2(Fwd, FwdKeys, G ^ vertex_map, [], List).
+
+:- pred digraph.to_assoc_list_2(key_set_map(T)::in, list(int)::in,
+ bimap(T, digraph_key(T))::in, assoc_list(T, T)::in, assoc_list(T, T)::out)
+ is det.
+
+digraph.to_assoc_list_2(_Fwd, [], _, !AL).
+digraph.to_assoc_list_2(Fwd, [XI | XIs], VMap, !AL) :-
+ digraph.to_assoc_list_2(Fwd, XIs, VMap, !AL),
+ bimap.reverse_lookup(VMap, VX, digraph_key(XI)),
+ map.lookup(Fwd, XI, SuccXs),
+ sparse_bitset.foldr(accumulate_rev_lookup(VMap, VX), SuccXs, !AL).
+
+:- pred accumulate_rev_lookup(bimap(T, digraph_key(T))::in, T::in,
+ digraph_key(T)::in, assoc_list(T, T)::in, assoc_list(T, T)::out) is det.
+
+accumulate_rev_lookup(VMap, VX, Y, !AL) :-
+ bimap.reverse_lookup(VMap, VY, Y),
+ !:AL = [VX - VY | !.AL].
+
+digraph.to_key_assoc_list(G) = List :-
+ digraph.to_key_assoc_list(G, List).
+
+digraph.to_key_assoc_list(G, List) :-
+ Fwd = G ^ fwd_map,
+ map.keys(Fwd, FwdKeys),
+ digraph.to_key_assoc_list_2(Fwd, FwdKeys, [], List).
+
+:- pred digraph.to_key_assoc_list_2(key_set_map(T)::in, list(int)::in,
+ assoc_list(digraph_key(T), digraph_key(T))::in,
+ assoc_list(digraph_key(T), digraph_key(T))::out) is det.
+
+digraph.to_key_assoc_list_2(_Fwd, [], !AL).
+digraph.to_key_assoc_list_2(Fwd, [XI | XIs], !AL) :-
+ digraph.to_key_assoc_list_2(Fwd, XIs, !AL),
+ map.lookup(Fwd, XI, SuccXs),
+ sparse_bitset.foldr(accumulate_with_key(digraph_key(XI)), SuccXs, !AL).
+
+:- pred accumulate_with_key(digraph_key(T)::in, digraph_key(T)::in,
+ assoc_list(digraph_key(T), digraph_key(T))::in,
+ assoc_list(digraph_key(T), digraph_key(T))::out) is det.
+
+accumulate_with_key(X, Y, !AL) :-
+ !:AL = [X - Y | !.AL].
+
+digraph.from_assoc_list(AL) = G :-
+ digraph.from_assoc_list(AL, G).
+
+digraph.from_assoc_list(AL, G) :-
+ list.foldl(add_vertex_pair, AL, digraph.init, G).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+digraph.dfs(G, X) = Dfs :-
+ digraph.dfs(G, X, Dfs).
+
+digraph.dfs(G, X, Dfs) :-
+ digraph.dfsrev(G, X, DfsRev),
+ list.reverse(DfsRev, Dfs).
+
+digraph.dfsrev(G, X) = DfsRev :-
+ digraph.dfsrev(G, X, DfsRev).
+
+digraph.dfsrev(G, X, DfsRev) :-
+ init(Vis0),
+ digraph.dfs_2(G, X, Vis0, _, [], DfsRev).
+
+digraph.dfs(G) = Dfs :-
+ digraph.dfs(G, Dfs).
+
+digraph.dfs(G, Dfs) :-
+ digraph.dfsrev(G, DfsRev),
+ list.reverse(DfsRev, Dfs).
+
+digraph.dfsrev(G) = DfsRev :-
+ digraph.dfsrev(G, DfsRev).
+
+digraph.dfsrev(G, DfsRev) :-
+ digraph.keys(G, Keys),
+ list.foldl2(digraph.dfs_2(G), Keys, init, _, [], DfsRev).
+
+digraph.dfs(G, X, !Visited, Dfs) :-
+ digraph.dfs_2(G, X, !Visited, [], DfsRev),
+ list.reverse(DfsRev, Dfs).
+
+digraph.dfsrev(G, X, !Visited, DfsRev) :-
+ digraph.dfs_2(G, X, !Visited, [], DfsRev).
+
+:- pred digraph.dfs_2(digraph(T)::in, digraph_key(T)::in,
+ digraph_key_set(T)::in, digraph_key_set(T)::out,
+ list(digraph_key(T))::in, list(digraph_key(T))::out) is det.
+
+digraph.dfs_2(G, X, !Visited, !DfsRev) :-
+ ( contains(!.Visited, X) ->
+ true
+ ;
+ digraph.lookup_key_set_from(G, X, SuccXs),
+ insert(!.Visited, X, !:Visited),
+
+ % Go and visit all of the node's children first.
+ sparse_bitset.foldl2(digraph.dfs_2(G), SuccXs, !Visited, !DfsRev),
+ !:DfsRev = [X | !.DfsRev]
+ ).
+
+%-----------------------------------------------------------------------------%
+
+digraph.vertices(G) = Vs :-
+ digraph.vertices(G, Vs).
+
+digraph.vertices(G, Vs) :-
+ bimap.ordinates(G ^ vertex_map, VsList),
+ sorted_list_to_set(VsList, Vs).
+
+:- pred digraph.keys(digraph(T)::in, list(digraph_key(T))::out) is det.
+
+digraph.keys(G, Keys) :-
+ bimap.coordinates(G ^ vertex_map, Keys).
+
+%-----------------------------------------------------------------------------%
+
+digraph.inverse(G) = InvG :-
+ digraph.inverse(G, InvG).
+
+digraph.inverse(G, InvG) :-
+ G = digraph(Next, VMap, Fwd, Bwd),
+ InvG = digraph(Next, VMap, Bwd, Fwd).
+
+%-----------------------------------------------------------------------------%
+
+digraph.compose(G1, G2) = Comp :-
+ digraph.compose(G1, G2, Comp).
+
+digraph.compose(G1, G2, !:Comp) :-
+ !:Comp = digraph.init,
+
+ % Find the set of vertices which occur in both G1 and G2.
+ digraph.vertices(G1, G1Vs),
+ digraph.vertices(G2, G2Vs),
+ Matches = set.intersect(G1Vs, G2Vs),
+
+ % Find the sets of keys to be matched in each digraph.
+ AL = list.map(
+ (func(Match) = Xs - Ys :-
+ digraph.lookup_key(G1, Match, M1),
+ digraph.lookup_key_set_to(G1, M1, Xs),
+ digraph.lookup_key(G2, Match, M2),
+ digraph.lookup_key_set_from(G2, M2, Ys)
+ ),
+ to_sorted_list(Matches)),
+
+ % Find the sets of keys in each digraph which will occur in
+ % the new digraph.
+ list.foldl2(find_necessary_keys, AL, sparse_bitset.init, Needed1,
+ sparse_bitset.init, Needed2),
+
+ % Add the elements to the composition.
+ sparse_bitset.foldl2(copy_vertex(G1), Needed1, !Comp, map.init, KMap1),
+ sparse_bitset.foldl2(copy_vertex(G2), Needed2, !Comp, map.init, KMap2),
+
+ % Add the edges to the composition.
+ list.foldl(add_composition_edges(KMap1, KMap2), AL, !Comp).
+
+:- pred find_necessary_keys(pair(digraph_key_set(T))::in,
+ digraph_key_set(T)::in, digraph_key_set(T)::out,
+ digraph_key_set(T)::in, digraph_key_set(T)::out) is det.
+
+find_necessary_keys(Xs - Ys, !Needed1, !Needed2) :-
+ sparse_bitset.union(Xs, !Needed1),
+ sparse_bitset.union(Ys, !Needed2).
+
+:- pred copy_vertex(digraph(T)::in, digraph_key(T)::in,
+ digraph(T)::in, digraph(T)::out, key_map(T)::in, key_map(T)::out)
+ is det.
+
+copy_vertex(G, X, !Comp, !KMap) :-
+ digraph.lookup_vertex(G, X, VX),
+ digraph.add_vertex(VX, CompX, !Comp),
+ X = digraph_key(XI),
+ svmap.det_insert(XI, CompX, !KMap).
+
+:- pred add_composition_edges(key_map(T)::in, key_map(T)::in,
+ pair(digraph_key_set(T))::in, digraph(T)::in, digraph(T)::out) is det.
+
+add_composition_edges(KMap1, KMap2, Xs - Ys, !Comp) :-
+ digraph.add_cartesian_product(map_digraph_key_set(KMap1, Xs),
+ map_digraph_key_set(KMap2, Ys), !Comp).
+
+:- func map_digraph_key_set(key_map(T), digraph_key_set(T)) =
+ digraph_key_set(T).
+
+map_digraph_key_set(KMap, Set0) = Set :-
+ sparse_bitset.foldl(accumulate_digraph_key_set(KMap), Set0, init, Set).
+
+:- pred accumulate_digraph_key_set(key_map(T)::in, digraph_key(T)::in,
+ digraph_key_set(T)::in, digraph_key_set(T)::out) is det.
+
+accumulate_digraph_key_set(KMap, X, !Set) :-
+ X = digraph_key(XI),
+ map.lookup(KMap, XI, Y),
+ !:Set = insert(!.Set, Y).
+
+%-----------------------------------------------------------------------------%
+
+ % Traverses the digraph depth-first, keeping track of all ancestors.
+ % Fails if we encounter an ancestor during the traversal, otherwise
+ % succeeds.
+ %
+ % not is_dag(G) <=> we encounter an ancestor at some stage:
+ %
+ % (=>) By assumption there exists a cycle. Since all vertices are reached
+ % in the traversal, we reach all vertices in the cycle at some stage.
+ % Let x be the vertex in the cycle that is reached first, and let y be
+ % the vertex preceding x in the cycle. Since x was first, y has not
+ % been visited and must therefore be reached at some stage in the depth-
+ % first traversal beneath x. At this stage we encounter x as both a
+ % child and an ancestor.
+ %
+ % (<=) If we encounter an ancestor in any traversal, then we have a cycle.
+ %
+digraph.is_dag(G) :-
+ digraph.keys(G, Keys),
+ foldl(digraph.is_dag_2(G, []), Keys, init, _).
+
+:- pred digraph.is_dag_2(digraph(T)::in, list(digraph_key(T))::in,
+ digraph_key(T)::in, digraph_key_set(T)::in, digraph_key_set(T)::out)
+ is semidet.
+
+digraph.is_dag_2(G, Ancestors, X, !Visited) :-
+ ( list.member(X, Ancestors) ->
+ fail
+ ; contains(!.Visited, X) ->
+ true
+ ;
+ digraph.lookup_key_set_from(G, X, SuccXs),
+ !:Visited = insert(!.Visited, X),
+ foldl(digraph.is_dag_2(G, [X | Ancestors]), SuccXs, !Visited)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+digraph.components(G) = Components :-
+ digraph.components(G, Components).
+
+digraph.components(G, Components) :-
+ digraph.keys(G, Keys),
+ list_to_set(Keys, KeySet : digraph_key_set(T)),
+ digraph.components_2(G, KeySet, init, Components).
+
+:- pred digraph.components_2(digraph(T)::in, digraph_key_set(T)::in,
+ set(set(digraph_key(T)))::in, set(set(digraph_key(T)))::out) is det.
+
+digraph.components_2(G, Xs0, !Components) :-
+ ( remove_least(Xs0, X, Xs1) ->
+ init(Comp0),
+ Keys0 = make_singleton_set(X),
+ digraph.reachable_from(G, Keys0, Comp0, Comp),
+ svset.insert(to_set(Comp), !Components),
+ difference(Xs1, Comp, Xs2),
+ digraph.components_2(G, Xs2, !Components)
+ ;
+ true
+ ).
+
+:- pred digraph.reachable_from(digraph(T)::in, digraph_key_set(T)::in,
+ digraph_key_set(T)::in, digraph_key_set(T)::out) is det.
+
+digraph.reachable_from(G, Keys0, !Comp) :-
+ % Invariant: Keys0 and !.Comp are disjoint.
+ ( remove_least(Keys0, X, Keys1) ->
+ insert(!.Comp, X, !:Comp),
+ digraph.lookup_key_set_from(G, X, FwdSet),
+ digraph.lookup_key_set_to(G, X, BwdSet),
+ union(FwdSet, BwdSet, NextSet0),
+ difference(NextSet0, !.Comp, NextSet),
+ union(Keys1, NextSet, Keys),
+ digraph.reachable_from(G, Keys, !Comp)
+ ;
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % digraph cliques
+ % take a digraph and return the set of strongly connected
+ % components
+ %
+ % Works using the following algorithm:
+ % 1. Reverse the digraph ie G'
+ % 2. Traverse G in reverse depth-first order. From the first vertex
+ % do a DFS on G'; all vertices visited are a member of the clique.
+ % 3. From the next non-visited vertex do a DFS on G', not including
+ % visited vertices. This is the next clique.
+ % 4. Repeat step 3 until all vertices visited.
+
+digraph.cliques(G) = Cliques :-
+ digraph.cliques(G, Cliques).
+
+digraph.cliques(G, Cliques) :-
+ digraph.dfsrev(G, DfsRev),
+ digraph.inverse(G, GInv),
+ set.init(Cliques0),
+ init(Visit),
+ digraph.cliques_2(DfsRev, GInv, Visit, Cliques0, Cliques).
+
+:- pred digraph.cliques_2(list(digraph_key(T))::in, digraph(T)::in,
+ digraph_key_set(T)::in, set(set(digraph_key(T)))::in,
+ set(set(digraph_key(T)))::out) is det.
+
+digraph.cliques_2([], _, _, !Cliques).
+digraph.cliques_2([X | Xs0], GInv, !.Visited, !Cliques) :-
+ % Do a DFS on G', starting from X, but not including visited vertices.
+ digraph.dfs_2(GInv, X, !Visited, [], CliqueList),
+
+ % Insert the cycle into the clique set.
+ list_to_set(CliqueList, Clique),
+ svset.insert(Clique, !Cliques),
+
+ % Delete all the visited vertices, so head of the list is the next
+ % highest non-visited vertex.
+ list.delete_elems(Xs0, CliqueList, Xs),
+ digraph.cliques_2(Xs, GInv, !.Visited, !Cliques).
+
+%-----------------------------------------------------------------------------%
+
+digraph.reduced(G) = R :-
+ digraph.reduced(G, R).
+
+digraph.reduced(G, R) :-
+ digraph.reduced(G, R, _).
+
+digraph.reduced(G, !:R, !:CliqMap) :-
+ digraph.cliques(G, Cliques),
+ set.to_sorted_list(Cliques, CliqList),
+ digraph.init(!:R),
+ map.init(!:CliqMap),
+ digraph.make_clique_map(G, CliqList, !CliqMap, !R),
+ digraph.to_key_assoc_list(G, AL),
+ digraph.make_reduced_graph(!.CliqMap, AL, !R).
+
+:- type clique_map(T) == map(digraph_key(T), digraph_key(set(T))).
+
+ % Add a vertex to the reduced graph for each clique, and build a map
+ % from each key in the clique to this new key.
+ %
+:- pred digraph.make_clique_map(digraph(T)::in,
+ list(set(digraph_key(T)))::in, clique_map(T)::in, clique_map(T)::out,
+ digraph(set(T))::in, digraph(set(T))::out) is det.
+
+digraph.make_clique_map(_, [], !CliqMap, !R).
+digraph.make_clique_map(G, [Clique | Cliques], !CliqMap, !R) :-
+ Vertices = set.map(digraph.lookup_vertex(G), Clique),
+ digraph.add_vertex(Vertices, CliqKey, !R),
+ set.fold(digraph.make_clique_map_2(CliqKey), Clique, !CliqMap),
+ digraph.make_clique_map(G, Cliques, !CliqMap, !R).
+
+:- pred digraph.make_clique_map_2(digraph_key(set(T))::in, digraph_key(T)::in,
+ clique_map(T)::in, clique_map(T)::out) is det.
+
+digraph.make_clique_map_2(CliqKey, X, !CliqMap) :-
+ svmap.set(X, CliqKey, !CliqMap).
+
+:- pred digraph.make_reduced_graph(clique_map(T)::in,
+ assoc_list(digraph_key(T), digraph_key(T))::in,
+ digraph(set(T))::in, digraph(set(T))::out) is det.
+
+digraph.make_reduced_graph(_, [], !R).
+digraph.make_reduced_graph(CliqMap, [X - Y | Edges], !R) :-
+ map.lookup(CliqMap, X, CliqX),
+ map.lookup(CliqMap, Y, CliqY),
+ ( CliqX = CliqY ->
+ true
+ ;
+ digraph.add_edge(CliqX, CliqY, !R)
+ ),
+ digraph.make_reduced_graph(CliqMap, Edges, !R).
+
+%-----------------------------------------------------------------------------%
+
+digraph.tsort(G, Tsort) :-
+ digraph.dfsrev(G, Tsort0),
+ digraph.check_tsort(G, init, Tsort0),
+ Tsort = list.map(digraph.lookup_vertex(G), Tsort0).
+
+:- pred digraph.check_tsort(digraph(T)::in, digraph_key_set(T)::in,
+ list(digraph_key(T))::in) is semidet.
+
+digraph.check_tsort(_, _, []).
+digraph.check_tsort(G, Vis0, [X | Xs]) :-
+ insert(Vis0, X, Vis),
+ digraph.lookup_key_set_from(G, X, SuccXs),
+ intersect(Vis, SuccXs, BackPointers),
+ empty(BackPointers),
+ digraph.check_tsort(G, Vis, Xs).
+
+%-----------------------------------------------------------------------------%
+
+ % digraph.atsort returns a topological sorting of the cliques in a digraph.
+ %
+ % The algorithm used is described in:
+ %
+ % R. E. Tarjan, "Depth-first search and
+ % linear graph algorithms," SIAM Journal
+ % on Computing, 1, 2 (1972).
+
+digraph.atsort(G) = ATsort :-
+ digraph.atsort(G, ATsort).
+
+digraph.atsort(G, ATsort) :-
+ digraph.dfsrev(G, DfsRev),
+ digraph.inverse(G, GInv),
+ init(Vis),
+ digraph.atsort_2(DfsRev, GInv, Vis, [], ATsort0),
+ list.reverse(ATsort0, ATsort).
+
+:- pred digraph.atsort_2(list(digraph_key(T))::in, digraph(T)::in,
+ digraph_key_set(T)::in, list(set(T))::in, list(set(T))::out) is det.
+
+digraph.atsort_2([], _, _, !ATsort).
+digraph.atsort_2([X | Xs], GInv, !.Vis, !ATsort) :-
+ ( contains(!.Vis, X) ->
+ true
+ ;
+ digraph.dfs_2(GInv, X, !Vis, [], CliqKeys),
+ list.map(digraph.lookup_vertex(GInv), CliqKeys, CliqList),
+ set.list_to_set(CliqList, Cliq),
+ !:ATsort = [Cliq | !.ATsort]
+ ),
+ digraph.atsort_2(Xs, GInv, !.Vis, !ATsort).
+
+%-----------------------------------------------------------------------------%
+
+digraph.sc(G) = Sc :-
+ digraph.sc(G, Sc).
+
+digraph.sc(G, Sc) :-
+ digraph.inverse(G, GInv),
+ digraph.to_key_assoc_list(GInv, GInvList),
+ digraph.add_assoc_list(GInvList, G, Sc).
+
+%-----------------------------------------------------------------------------%
+
+ % digraph.tc returns the transitive closure of a digraph.
+ % We use this procedure:
+ %
+ % - Compute the reflexive transitive closure.
+ % - Find the "fake reflexives", that is, the set of vertices x for
+ % which (x,x) is not an edge in G+. This is done by noting that
+ % G+ = G . G* (where '.' denotes composition). Therefore x is a
+ % fake reflexive iff there is no y such that (x,y) is an edge in G
+ % and (y,x) is an edge in G*.
+ % - Remove those edges from the reflexive transitive closure
+ % computed above.
+
+digraph.tc(G) = Tc :-
+ digraph.tc(G, Tc).
+
+digraph.tc(G, Tc) :-
+ digraph.rtc(G, Rtc),
+
+ % Find the fake reflexives.
+ digraph.keys(G, Keys),
+ digraph.detect_fake_reflexives(G, Rtc, Keys, [], Fakes),
+
+ % Remove them from the RTC, giving us the TC.
+ digraph.delete_assoc_list(Fakes, Rtc, Tc).
+
+:- pred digraph.detect_fake_reflexives(digraph(T)::in, digraph(T)::in,
+ list(digraph_key(T))::in, assoc_list(digraph_key(T), digraph_key(T))::in,
+ assoc_list(digraph_key(T), digraph_key(T))::out) is det.
+
+digraph.detect_fake_reflexives(_, _, [], !Fakes).
+digraph.detect_fake_reflexives(G, Rtc, [X | Xs], !Fakes) :-
+ digraph.lookup_key_set_from(G, X, SuccXs),
+ digraph.lookup_key_set_to(Rtc, X, PreXs),
+ intersect(SuccXs, PreXs, Ys),
+ ( empty(Ys) ->
+ !:Fakes = [X - X | !.Fakes]
+ ;
+ true
+ ),
+ digraph.detect_fake_reflexives(G, Rtc, Xs, !Fakes).
+
+%-----------------------------------------------------------------------------%
+
+ % digraph.rtc returns the reflexive transitive closure of a digraph.
+ %
+ % Note: This is not the most efficient algorithm (in the sense of minimal
+ % number of arc insertions) possible. However it "reasonably" efficient
+ % and, more importantly, is much easier to debug than some others.
+ %
+ % The algorithm is very simple, and is based on the observation that the
+ % RTC of any element in a clique is the same as the RTC of any other
+ % element in that clique. So we visit each clique in reverse topological
+ % sorted order, compute the RTC for each element in the clique and then
+ % add the appropriate edges.
+
+digraph.rtc(G) = Rtc :-
+ digraph.rtc(G, Rtc).
+
+digraph.rtc(G, !:Rtc) :-
+ digraph.dfs(G, Dfs),
+ init(Vis),
+
+ % First start with all the vertices in G, but no edges.
+ G = digraph(NextKey, VMap, _, _),
+ map.init(FwdMap),
+ map.init(BwdMap),
+ !:Rtc = digraph(NextKey, VMap, FwdMap, BwdMap),
+
+ digraph.rtc_2(Dfs, G, Vis, !Rtc).
+
+:- pred digraph.rtc_2(list(digraph_key(T))::in, digraph(T)::in,
+ digraph_key_set(T)::in, digraph(T)::in, digraph(T)::out) is det.
+
+digraph.rtc_2([], _, _, !Rtc).
+digraph.rtc_2([X | Xs], G, !.Vis, !Rtc) :-
+ ( contains(!.Vis, X) ->
+ true
+ ;
+ digraph.dfs_2(G, X, !Vis, [], CliqList),
+ list_to_set(CliqList, Cliq),
+ foldl(find_followers(G), Cliq, Cliq, Followers0),
+ foldl(find_followers(!.Rtc), Followers0, Cliq, Followers),
+ digraph.add_cartesian_product(Cliq, Followers, !Rtc)
+ ),
+ digraph.rtc_2(Xs, G, !.Vis, !Rtc).
+
+:- pred find_followers(digraph(T)::in, digraph_key(T)::in,
+ digraph_key_set(T)::in, digraph_key_set(T)::out) is det.
+
+find_followers(G, X, !Followers) :-
+ digraph.lookup_key_set_from(G, X, SuccXs),
+ union(SuccXs, !Followers).
+
+:- pred digraph.add_cartesian_product(digraph_key_set(T)::in,
+ digraph_key_set(T)::in, digraph(T)::in, digraph(T)::out) is det.
+
+digraph.add_cartesian_product(KeySet1, KeySet2, !Rtc) :-
+ foldl((pred(Key1::in, !.Rtc::in, !:Rtc::out) is det :-
+ foldl(digraph.add_edge(Key1), KeySet2, !Rtc)
+ ), KeySet1, !Rtc).
+
+%-----------------------------------------------------------------------------%
+
+digraph.traverse(G, ProcessVertex, ProcessEdge, !Acc) :-
+ digraph.keys(G, Keys),
+ digraph.traverse_2(Keys, G, ProcessVertex, ProcessEdge, !Acc).
+
+:- pred digraph.traverse_2(list(digraph_key(T)), digraph(T), pred(T, A, A),
+ pred(T, T, A, A), A, A).
+:- mode digraph.traverse_2(in, in, pred(in, di, uo) is det,
+ pred(in, in, di, uo) is det, di, uo) is det.
+:- mode digraph.traverse_2(in, in, pred(in, in, out) is det,
+ pred(in, in, in, out) is det, in, out) is det.
+
+digraph.traverse_2([], _, _, _, !Acc).
+digraph.traverse_2([X | Xs], G, ProcessVertex, ProcessEdge, !Acc) :-
+ % XXX avoid the sparse_bitset.to_sorted_list here
+ % (difficult to do using sparse_bitset.foldl because
+ % traverse_children has multiple modes).
+ VX = lookup_vertex(G, X),
+ Children = to_sorted_list(lookup_from(G, X)),
+ ProcessVertex(VX, !Acc),
+ digraph.traverse_children(Children, VX, G, ProcessEdge, !Acc),
+ digraph.traverse_2(Xs, G, ProcessVertex, ProcessEdge, !Acc).
+
+:- pred digraph.traverse_children(list(digraph_key(T)), T, digraph(T),
+ pred(T, T, A, A), A, A).
+:- mode digraph.traverse_children(in, in, in, pred(in, in, di, uo) is det,
+ di, uo) is det.
+:- mode digraph.traverse_children(in, in, in, pred(in, in, in, out) is det,
+ in, out) is det.
+
+digraph.traverse_children([], _, _, _, !Acc).
+digraph.traverse_children([X | Xs], Parent, G, ProcessEdge, !Acc) :-
+ Child = lookup_vertex(G, X),
+ ProcessEdge(Parent, Child, !Acc),
+ digraph.traverse_children(Xs, Parent, G, ProcessEdge, !Acc).
+
+%-----------------------------------------------------------------------------%
+:- end_module digraph.
+%-----------------------------------------------------------------------------%
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.115
diff -u -r1.115 library.m
--- library/library.m 22 Aug 2007 06:40:58 -0000 1.115
+++ library/library.m 7 Sep 2007 11:35:01 -0000
@@ -63,6 +63,7 @@
:- import_module cord.
:- import_module counter.
:- import_module deconstruct.
+:- import_module digraph.
:- import_module dir.
:- import_module enum.
:- import_module eqvclass.
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 7 Sep 2007 11:35:01 -0000
@@ -10,11 +10,8 @@
% Main author: bromage, petdr.
% Stability: low.
%
-% This module defines a data type for binary relations over reflexive
-% domains.
+% This module defines a data type for binary relations over a given domain.
%
-% In fact, this is exactly equivalent to a graph/1 type.
-%
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
@@ -28,6 +25,11 @@
:- import_module sparse_bitset.
%------------------------------------------------------------------------------%
+% The relation module is deprecated. Use digraph instead.
+%------------------------------------------------------------------------------%
+:- pragma obsolete(relation.init/0).
+:- pragma obsolete(relation.init/1).
+%------------------------------------------------------------------------------%
:- type relation(T).
@@ -338,7 +340,15 @@
%------------------------------------------------------------------------------%
-relation.init(relation(relation_key(0), ElMap, FwdMap, BwdMap)) :-
+relation.init = R :-
+ relation.init_internal(R).
+
+relation.init(R) :-
+ relation.init_internal(R).
+
+:- pred relation.init_internal(relation(T)::out) is det.
+
+relation.init_internal(relation(relation_key(0), ElMap, FwdMap, BwdMap)) :-
bimap.init(ElMap),
map.init(FwdMap),
map.init(BwdMap).
@@ -553,10 +563,11 @@
% relation.from_assoc_list turns a list of pairs of
% elements into a relation.
relation.from_assoc_list(AL, Rel) :-
+ relation.init_internal(Rel0),
Rel = list.foldl(
- (func(U - V, Rel0) = Rel1 :-
- relation.add_values(Rel0, U, V, Rel1)
- ), AL, relation.init).
+ (func(U - V, R0) = R :-
+ relation.add_values(R0, U, V, R)
+ ), AL, Rel0).
%------------------------------------------------------------------------------%
@@ -579,7 +590,7 @@
%------------------------------------------------------------------------------%
relation.compose(R1, R2, !:Compose) :-
- !:Compose = relation.init,
+ relation.init_internal(!:Compose),
% Find the set of elements which occur in both the
% range of R1 and the domain of R2.
@@ -823,7 +834,7 @@
relation.reduced(Rel, Red) :-
relation.cliques(Rel, Cliques),
set.to_sorted_list(Cliques, CliqList),
- relation.init(Red0),
+ relation.init_internal(Red0),
map.init(CliqMap0),
relation.make_clique_map(Rel, CliqList, CliqMap0, CliqMap, Red0, Red1),
relation.to_key_assoc_list(Rel, RelAL),
@@ -1063,9 +1074,6 @@
% Ralph Becket <rwab1 at cl.cam.ac.uk> 30/04/99
% Function forms added.
-relation.init = R :-
- relation.init(R).
-
relation.lookup_element(R, X) = K :-
relation.lookup_element(R, X, K).
Index: profiler/call_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/call_graph.m,v
retrieving revision 1.14
diff -u -r1.14 call_graph.m
--- profiler/call_graph.m 1 Dec 2006 15:04:39 -0000 1.14
+++ profiler/call_graph.m 7 Sep 2007 11:35:01 -0000
@@ -18,15 +18,15 @@
:- module call_graph.
:- interface.
+:- import_module digraph.
:- import_module io.
:- import_module list.
-:- import_module relation.
%-----------------------------------------------------------------------------%
:- pred build_call_graph(list(string)::in,
- relation(string)::in, relation(string)::out, io::di, io::uo) is det.
+ digraph(string)::in, digraph(string)::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -39,7 +39,6 @@
:- import_module bool.
:- import_module maybe.
-:- import_module svrelation.
%-----------------------------------------------------------------------------%
@@ -63,7 +62,7 @@
% Builds the static call graph located in the *.prof files.
%
:- pred build_static_call_graph(list(string)::in, bool::in,
- relation(string)::in, relation(string)::out, io::di, io::uo) is det.
+ digraph(string)::in, digraph(string)::out, io::di, io::uo) is det.
build_static_call_graph(Files, VeryVerbose, !StaticCallGraph, !IO) :-
list.foldl2(process_prof_file(VeryVerbose), Files, !StaticCallGraph, !IO).
@@ -71,10 +70,10 @@
% process_prof_file:
%
% Puts all the Caller and Callee label pairs from File into the
- % static call graph relation.
+ % static call graph.
%
:- pred process_prof_file(bool::in, string::in,
- relation(string)::in, relation(string)::out, io::di, io::uo) is det.
+ digraph(string)::in, digraph(string)::out, io::di, io::uo) is det.
process_prof_file(VeryVerbose, File, !StaticCallGraph, !IO) :-
maybe_write_string(VeryVerbose, "\n\tProcessing ", !IO),
@@ -94,16 +93,16 @@
),
maybe_write_string(VeryVerbose, " done", !IO).
-:- pred process_prof_file_2(relation(string)::in, relation(string)::out,
+:- pred process_prof_file_2(digraph(string)::in, digraph(string)::out,
io::di, io::uo) is det.
process_prof_file_2(!StaticCallGraph, !IO) :-
maybe_read_label_name(MaybeLabelName, !IO),
( MaybeLabelName = yes(CallerLabel) ->
read_label_name(CalleeLabel, !IO),
- relation.lookup_element(!.StaticCallGraph, CallerLabel, CallerKey),
- relation.lookup_element(!.StaticCallGraph, CalleeLabel, CalleeKey),
- svrelation.add(CallerKey, CalleeKey, !StaticCallGraph),
+ digraph.lookup_key(!.StaticCallGraph, CallerLabel, CallerKey),
+ digraph.lookup_key(!.StaticCallGraph, CalleeLabel, CalleeKey),
+ digraph.add_edge(CallerKey, CalleeKey, !StaticCallGraph),
process_prof_file_2(!StaticCallGraph, !IO)
;
true
Index: profiler/process_file.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/process_file.m,v
retrieving revision 1.23
diff -u -r1.23 process_file.m
--- profiler/process_file.m 10 Nov 2006 03:26:27 -0000 1.23
+++ profiler/process_file.m 7 Sep 2007 11:35:01 -0000
@@ -21,12 +21,12 @@
:- import_module prof_info.
+:- import_module digraph.
:- import_module io.
-:- import_module relation.
%-----------------------------------------------------------------------------%
-:- pred process_profiling_data_files(prof::out, relation(string)::out,
+:- pred process_profiling_data_files(prof::out, digraph(string)::out,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -46,7 +46,6 @@
:- import_module require.
:- import_module string.
:- import_module svmap.
-:- import_module svrelation.
:- import_module unit.
%-----------------------------------------------------------------------------%
@@ -229,7 +228,7 @@
% times a predicate is called.
%
:- pred process_addr_pair(prof_node_map::in, prof_node_map::out,
- addrdecl::in, addrdecl::out, relation(string)::out, io::di, io::uo)
+ addrdecl::in, addrdecl::out, digraph(string)::out, io::di, io::uo)
is det.
process_addr_pair(!ProfNodeMap, !AddrDecl, DynamicCallGraph, !IO) :-
@@ -238,7 +237,7 @@
io.see(PairFile, Result, !IO),
(
Result = ok,
- process_addr_pair_2(Dynamic, relation.init, DynamicCallGraph,
+ process_addr_pair_2(Dynamic, digraph.init, DynamicCallGraph,
!ProfNodeMap, !AddrDecl, !IO),
io.seen(!IO)
;
@@ -249,7 +248,7 @@
).
:- pred process_addr_pair_2(bool::in,
- relation(string)::in, relation(string)::out,
+ digraph(string)::in, digraph(string)::out,
prof_node_map::in, prof_node_map::out,
addrdecl::in, addrdecl::out, io::di, io::uo) is det.
@@ -290,9 +289,9 @@
% Add edge to call graph if generating dynamic call graph.
(
Dynamic = yes,
- svrelation.add_element(CallerName, CallerKey, !DynamicCallGraph),
- svrelation.add_element(CalleeName, CalleeKey, !DynamicCallGraph),
- svrelation.add(CallerKey, CalleeKey, !DynamicCallGraph)
+ digraph.add_vertex(CallerName, CallerKey, !DynamicCallGraph),
+ digraph.add_vertex(CalleeName, CalleeKey, !DynamicCallGraph),
+ digraph.add_edge(CallerKey, CalleeKey, !DynamicCallGraph)
;
Dynamic = no
),
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 7 Sep 2007 11:35:01 -0000
@@ -26,11 +26,11 @@
:- import_module prof_info.
:- import_module io.
-:- import_module relation.
+:- import_module digraph.
%-----------------------------------------------------------------------------%
-:- pred propagate_counts(relation(string)::in, prof::in, prof::out,
+:- pred propagate_counts(digraph(string)::in, prof::in, prof::out,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -84,29 +84,29 @@
% multimap which associates with each cycle number a list of preds.
% Also approximate topologically sorts the call graph.
%
-:- pred identify_cycles(relation(string)::in, list(string)::out,
+:- pred identify_cycles(digraph(string)::in, list(string)::out,
cycle_info::out) is det.
-identify_cycles(Rel, ATSort, cycle_info(PredToCycleMap, CycleToPredsMap)) :-
- relation.dfsrev(Rel, DfsRev),
- relation.inverse(Rel, RelInv),
- identify_cycles_2(DfsRev, 1, RelInv, sparse_bitset.init,
+identify_cycles(G, ATSort, cycle_info(PredToCycleMap, CycleToPredsMap)) :-
+ digraph.dfsrev(G, DfsRev),
+ digraph.inverse(G, InvG),
+ identify_cycles_2(DfsRev, 1, InvG, 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(digraph_key(string))::in, int::in,
+ digraph(string)::in, digraph_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.
identify_cycles_2([], _, _, _, !ATSort, !PredToCycleMap, !CycleToPredsMap).
-identify_cycles_2([Key | Keys0], CycleNum0, RelInv, Visit0, !ATSort,
+identify_cycles_2([Key | Keys0], CycleNum0, InvG, Visit0, !ATSort,
!PredToCycleMap, !CycleToPredsMap) :-
- % Do a depth-first search on R'. The nodes we can get to and have not
+ % Do a depth-first search on G'. The nodes we can get to and have not
% already visited before are one cycle in the call graph.
- relation.dfsrev(RelInv, Key, Visit0, Visit, DfsRev0),
- list.map(relation.lookup_key(RelInv), DfsRev0, DfsRev),
+ digraph.dfsrev(InvG, Key, Visit0, Visit, DfsRev0),
+ list.map(digraph.lookup_vertex(InvG), DfsRev0, DfsRev),
(
DfsRev = [],
@@ -125,7 +125,7 @@
% Delete all visited elements from Keys0 as they have already been
% identified as part of a cycle.
list.delete_elems(Keys0, DfsRev0, Keys),
- identify_cycles_2(Keys, CycleNum, RelInv, Visit, !ATSort,
+ identify_cycles_2(Keys, CycleNum, InvG, Visit, !ATSort,
!PredToCycleMap, !CycleToPredsMap).
% add_to_cycle_map(Preds, CycleNum, !PredToCycleMap, !CycleToPredsMap):
--------------------------------------------------------------------------
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