%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 1995-2012 The University of Melbourne. % Copyright (C) 2017 The Mercury Team. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %---------------------------------------------------------------------------% % % File: hlds_dependency_graph.m. % Main authors: bromage, conway, stayl, zs. % % The HLDS dependency graph is an instance of dependency_graph in which % the entities are the HLDS procedures in the module being compiled. % The criterion for inclusion in the dependency graph is "do we have access % to the body of this procedure?", which means that imported procedures % are *not* included, but opt_imported procedures *are*. % % The reason why we build the dependency graph is because from it, % dependency_graph.m can compute the list of the SCCs (strongly-connected % components) of this graph. This is very handy for doing fixpoint iterations. % %---------------------------------------------------------------------------% :- module hlds.hlds_dependency_graph. :- interface. :- import_module hlds.hlds_module. :- import_module hlds.hlds_pred. :- import_module libs. :- import_module libs.dependency_graph. :- import_module io. :- import_module list. :- import_module set. %---------------------------------------------------------------------------% :- type hlds_dependency_info == dependency_info(pred_proc_id). :- type hlds_dependency_graph == dependency_graph(pred_proc_id). :- type hlds_dependency_graph_key == dependency_graph_key(pred_proc_id). :- type hlds_bottom_up_dependency_sccs == bottom_up_dependency_sccs(pred_proc_id). %---------------------------------------------------------------------------% % Ensure that the module_info contains a version of the dependency_info % which only contains arcs between procedures for which there are clauses % defined (everything that is not imported, plus opt_imported). % Return this dependency_info. % % There is no guarantee that the dependency_info is current. % :- pred module_info_ensure_dependency_info(module_info::in, module_info::out, hlds_dependency_info::out) is det. % Ensure that the module_info contains a version of the dependency_info % which only contains arcs between procedures for which there are clauses % defined (everything that is not imported, plus opt_imported). % Return this dependency_info. % % The dependency_info will be up-to-date. % :- pred module_info_rebuild_dependency_info(module_info::in, module_info::out, hlds_dependency_info::out) is det. %---------------------% :- type include_imported ---> include_imported ; do_not_include_imported. % Should the dependency graph include an edge from p to q % only if p calls q in a tail call (only_tail_calls calls for this), % or if p calls q in any call, and if p references q in a unification % (all_calls_and_unifies). % % Note that only_tail_calls requires recursive calls to be marked by % mark_tail_calls.m, and mark_tail_calls.m requires a previously built % dependency graph, which therefore must have been built with % all_calls_and_unifies. % :- type what_dependency_edges ---> only_tail_calls ; only_all_calls ; all_calls_and_unifies. % Build the dependency graph for the given set of predicates, % after filtering out imported predicates if the last argument % is do_not_include_imported. % % Predicates without mode information have no idea what calls will % end up being tail calls, so for their dependency graphs, we cannot % restrict the edges to tail calls. % :- func build_pred_dependency_graph(module_info, list(pred_id), include_imported) = dependency_info(pred_id). % Build the dependency graph for the given set of procedures. % :- func build_proc_dependency_graph(module_info, set(pred_proc_id), what_dependency_edges) = dependency_info(pred_proc_id). %---------------------% :- type scc_with_entry_points ---> scc_with_entry_points( % The set of procedures in the SCC. swep_scc_procs :: set(pred_proc_id), swep_called_from_higher_sccs :: set(pred_proc_id), swep_exported_procs :: set(pred_proc_id) ). :- pred get_bottom_up_sccs_with_entry_points(module_info::in, hlds_dependency_info::in, list(scc_with_entry_points)::out) is det. %---------------------------------------------------------------------------% % Output a form of the static call graph to a file, in a format suitable % for use in .dependency_info files. After the heading, the format of % each line is % % CallerModeDecl \t CalleeModeDecl % :- pred write_dependency_graph(io.text_output_stream::in, module_info::in, module_info::out, io::di, io::uo) is det. % Output a form of the static call graph to a file for use by the profiler. % There is no heading, and the format of each line is % % CallerLabel \t CalleeLabel % :- pred write_prof_dependency_graph(io.text_output_stream::in, module_info::in, module_info::out, io::di, io::uo) is det. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module backend_libs. :- import_module backend_libs.name_mangle. :- import_module backend_libs.proc_label. :- import_module hlds.hlds_clauses. :- import_module hlds.hlds_goal. :- import_module mdbcomp. :- import_module mdbcomp.sym_name. :- import_module parse_tree. :- import_module parse_tree.parse_tree_out_info. :- import_module parse_tree.parse_tree_out_pred_decl. :- import_module parse_tree.prog_data. :- import_module assoc_list. :- import_module bool. :- import_module digraph. :- import_module int. :- import_module map. :- import_module maybe. :- import_module multi_map. :- import_module pair. :- import_module std_util. :- import_module term. :- import_module varset. %---------------------------------------------------------------------------% module_info_ensure_dependency_info(!ModuleInfo, DepInfo) :- module_info_get_maybe_dependency_info(!.ModuleInfo, MaybeDepInfo), ( MaybeDepInfo = yes(DepInfo) ; MaybeDepInfo = no, module_info_rebuild_dependency_info(!ModuleInfo, DepInfo) ). module_info_rebuild_dependency_info(!ModuleInfo, DepInfo) :- module_info_get_valid_pred_ids(!.ModuleInfo, PredIds), list.foldl(gather_pred_proc_ids(!.ModuleInfo, do_not_include_imported), PredIds, [], GatheredPredProcIds), DepInfo = build_proc_dependency_graph(!.ModuleInfo, set.list_to_set(GatheredPredProcIds), all_calls_and_unifies), module_info_set_dependency_info(DepInfo, !ModuleInfo). :- pred gather_pred_proc_ids(module_info::in, include_imported::in, pred_id::in, list(pred_proc_id)::in, list(pred_proc_id)::out) is det. gather_pred_proc_ids(ModuleInfo, Imported, PredId, !PredProcIds) :- module_info_pred_info(ModuleInfo, PredId, PredInfo), ( % Don't bother to add imported procedures, since we don't have % their bodies. % XXX We do have bodies for opt_imported procedures. Imported = do_not_include_imported, ProcIds = pred_info_valid_non_imported_procids(PredInfo) ; Imported = include_imported, ProcIds = pred_info_valid_procids(PredInfo) ), list.foldl(gather_pred_proc_id(PredId), ProcIds, !PredProcIds). :- pred gather_pred_proc_id(pred_id::in, proc_id::in, list(pred_proc_id)::in, list(pred_proc_id)::out) is det. gather_pred_proc_id(PredId, ProcId, !PredProcIds) :- !:PredProcIds = [proc(PredId, ProcId) | !.PredProcIds]. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% build_pred_dependency_graph(ModuleInfo, PredIds, Imported) = DepInfo :- list.foldl(gather_pred_ids(ModuleInfo, Imported), PredIds, [], GatheredPredIds), digraph.init(DepGraph0), list.map_foldl(add_vertex, GatheredPredIds, _VertexKeys, DepGraph0, DepGraph1), list.foldl( maybe_add_pred_arcs(DepGraph1, all_calls_and_unifies, ModuleInfo), PredIds, [], DepArcs), digraph.add_assoc_list(DepArcs, DepGraph1, DepGraph), DepInfo = make_dependency_info(DepGraph, DepArcs). :- pred gather_pred_ids(module_info::in, include_imported::in, pred_id::in, list(pred_id)::in, list(pred_id)::out) is det. gather_pred_ids(ModuleInfo, IncludeImported, PredId, !PredIds) :- module_info_pred_info(ModuleInfo, PredId, PredInfo), ( if IncludeImported = do_not_include_imported, pred_info_is_imported(PredInfo) then % Don't bother adding nodes (or arcs) for predicates % which are imported (i.e. which we don't have any `clauses' for). % XXX This is slightly wrong: if a predicate is opt_imported, % then pred_info_is_imported will succeed for it, but we *will* have % its clauses. true else !:PredIds = [PredId | !.PredIds] ). :- pred maybe_add_pred_arcs(dependency_graph(pred_id)::in, what_dependency_edges::in, module_info::in, pred_id::in, dep_arcs(pred_id)::in, dep_arcs(pred_id)::out) is det. maybe_add_pred_arcs(DepGraph, WhatEdges, ModuleInfo, PredId, !DepArcs) :- ( if digraph.search_key(DepGraph, PredId, Caller) then module_info_pred_info(ModuleInfo, PredId, PredInfo), pred_info_get_clauses_info(PredInfo, ClausesInfo), clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers), get_clause_list_maybe_repeated(ClausesRep, Clauses), Goals = list.map(clause_body, Clauses), add_dependency_arcs_in_goals(DepGraph, WhatEdges, Caller, Goals, !DepArcs) else true ). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% build_proc_dependency_graph(ModuleInfo, PredProcIds, WhatEdges) = DepInfo :- digraph.init(DepGraph0), set.map_fold(add_vertex, PredProcIds, _VertexKeys, DepGraph0, DepGraph1), PredIds = set.map(pred_proc_id_get_pred_id, PredProcIds), set.foldl(maybe_add_pred_proc_arcs(DepGraph1, WhatEdges, ModuleInfo), PredIds, [], DepArcs), digraph.add_assoc_list(DepArcs, DepGraph1, DepGraph), DepInfo = make_dependency_info(DepGraph, DepArcs). :- func pred_proc_id_get_pred_id(pred_proc_id) = pred_id. pred_proc_id_get_pred_id(proc(PredId, _ProcId)) = PredId. :- pred maybe_add_pred_proc_arcs(dependency_graph(pred_proc_id)::in, what_dependency_edges::in, module_info::in, pred_id::in, dep_arcs(pred_proc_id)::in, dep_arcs(pred_proc_id)::out) is det. maybe_add_pred_proc_arcs(DepGraph, WhatEdges, ModuleInfo, PredId, !DepArcs) :- module_info_pred_info(ModuleInfo, PredId, PredInfo), pred_info_get_proc_table(PredInfo, ProcTable), map.foldl(maybe_add_proc_arcs(DepGraph, WhatEdges, PredId), ProcTable, !DepArcs). :- pred maybe_add_proc_arcs(dependency_graph(pred_proc_id)::in, what_dependency_edges::in, pred_id::in, proc_id::in, proc_info::in, dep_arcs(pred_proc_id)::in, dep_arcs(pred_proc_id)::out) is det. maybe_add_proc_arcs(DepGraph, WhatEdges, PredId, ProcId, ProcInfo, !DepArcs) :- ( if digraph.search_key(DepGraph, proc(PredId, ProcId), Caller) then proc_info_get_goal(ProcInfo, Goal), add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, Goal, !DepArcs) else true ). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- typeclass dependency_node(T) where [ func dependency_node(pred_proc_id) = T ]. :- instance dependency_node(pred_proc_id) where [ func(dependency_node/1) is id ]. :- instance dependency_node(pred_id) where [ func(dependency_node/1) is pred_proc_id_get_pred_id ]. %---------------------% :- type dep_arcs(T) == assoc_list(dependency_graph_key(T)). %---------------------------------------------------------------------------% :- pred add_dependency_arcs_in_goal(dependency_graph(T)::in, what_dependency_edges::in, digraph_key(T)::in, hlds_goal::in, dep_arcs(T)::in, dep_arcs(T)::out) is det <= dependency_node(T). add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, Goal, !DepArcs) :- Goal = hlds_goal(GoalExpr, GoalInfo), ( ( GoalExpr = conj(_, Goals) ; GoalExpr = disj(Goals) ), add_dependency_arcs_in_goals(DepGraph, WhatEdges, Caller, Goals, !DepArcs) ; GoalExpr = switch(_Var, _CanFail, Cases), add_dependency_arcs_in_cases(DepGraph, WhatEdges, Caller, Cases, !DepArcs) ; GoalExpr = if_then_else(_Vars, Cond, Then, Else), add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, Cond, !DepArcs), add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, Then, !DepArcs), add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, Else, !DepArcs) ; GoalExpr = negation(SubGoal), add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, SubGoal, !DepArcs) ; GoalExpr = scope(Reason, SubGoal), ( if Reason = from_ground_term(_, FGT), ( FGT = from_ground_term_construct ; FGT = from_ground_term_deconstruct ) then % The scope references no predicates or procedures. true else add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, SubGoal, !DepArcs) ) ; GoalExpr = generic_call(_, _, _, _, _) ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _) ; GoalExpr = plain_call(PredId, ProcId, _, Builtin, _, _), ( Builtin = inline_builtin ; Builtin = not_builtin, ( if goal_info_has_feature(GoalInfo, feature_self_or_mutual_tail_rec_call) then EdgeKind = edge_tail_call else EdgeKind = edge_non_tail_call ), maybe_add_dependency_arc(DepGraph, WhatEdges, EdgeKind, Caller, proc(PredId, ProcId), !DepArcs) ) ; GoalExpr = unify(_,_,_,Unify,_), ( ( Unify = construct(_, ConsId, _, _, _, _, _) ; Unify = deconstruct(_, ConsId, _, _, _, _) ), add_dependency_arcs_in_cons(DepGraph, WhatEdges, Caller, ConsId, !DepArcs) ; ( Unify = assign(_, _) ; Unify = simple_test(_, _) ; Unify = complicated_unify(_, _, _) ) ) ; GoalExpr = shorthand(ShortHand), ( ShortHand = atomic_goal(_GoalType, _Outer, _Inner, _Vars, MainGoal, OrElseGoals, _OrElseInners), add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, MainGoal, !DepArcs), add_dependency_arcs_in_goals(DepGraph, WhatEdges, Caller, OrElseGoals, !DepArcs) ; ShortHand = try_goal(_, _, SubGoal), add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, SubGoal, !DepArcs) ; ShortHand = bi_implication(LHS, RHS), add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, LHS, !DepArcs), add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, RHS, !DepArcs) ) ). %---------------------------------------------------------------------------% :- pred add_dependency_arcs_in_goals(dependency_graph(T)::in, what_dependency_edges::in, digraph_key(T)::in, list(hlds_goal)::in, dep_arcs(T)::in, dep_arcs(T)::out) is det <= dependency_node(T). add_dependency_arcs_in_goals(_DepGraph, _WhatEdges, _Caller, [], !DepArcs). add_dependency_arcs_in_goals(DepGraph, WhatEdges, Caller, [Goal | Goals], !DepArcs) :- add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, Goal, !DepArcs), add_dependency_arcs_in_goals(DepGraph, WhatEdges, Caller, Goals, !DepArcs). :- pred add_dependency_arcs_in_cases(dependency_graph(T)::in, what_dependency_edges::in, digraph_key(T)::in, list(case)::in, dep_arcs(T)::in, dep_arcs(T)::out) is det <= dependency_node(T). add_dependency_arcs_in_cases(_DepGraph, _WhatEdges, _Caller, [], !DepArcs). add_dependency_arcs_in_cases(DepGraph, WhatEdges, Caller, [Case | Cases], !DepArcs) :- Case = case(MainConsId, OtherConsIds, Goal), add_dependency_arcs_in_cons(DepGraph, WhatEdges, Caller, MainConsId, !DepArcs), list.foldl(add_dependency_arcs_in_cons(DepGraph, WhatEdges, Caller), OtherConsIds, !DepArcs), add_dependency_arcs_in_goal(DepGraph, WhatEdges, Caller, Goal, !DepArcs), add_dependency_arcs_in_cases(DepGraph, WhatEdges, Caller, Cases, !DepArcs). %---------------------------------------------------------------------------% :- pred add_dependency_arcs_in_cons(dependency_graph(T)::in, what_dependency_edges::in, digraph_key(T)::in, cons_id::in, dep_arcs(T)::in, dep_arcs(T)::out) is det <= dependency_node(T). add_dependency_arcs_in_cons(DepGraph, WhatEdges, Caller, ConsId, !DepArcs) :- ( ConsId = closure_cons(ShroudedPredProcId, _), PredProcId = unshroud_pred_proc_id(ShroudedPredProcId), maybe_add_dependency_arc(DepGraph, WhatEdges, edge_unify, Caller, PredProcId, !DepArcs) ; ( ConsId = cons(_, _, _) ; ConsId = tuple_cons(_) ; ConsId = some_int_const(_) ; ConsId = float_const(_) ; ConsId = char_const(_) ; ConsId = string_const(_) ; ConsId = impl_defined_const(_) ; ConsId = type_ctor_info_const(_, _, _) ; ConsId = base_typeclass_info_const(_, _, _, _) ; ConsId = type_info_cell_constructor(_) ; ConsId = typeclass_info_cell_constructor ; ConsId = type_info_const(_) ; ConsId = typeclass_info_const(_) ; ConsId = ground_term_const(_, _) ; ConsId = tabling_info_const(_) ; ConsId = table_io_entry_desc(_) ; ConsId = deep_profiling_proc_layout(_) ) ). %---------------------------------------------------------------------------% :- type edge_kind ---> edge_non_tail_call ; edge_tail_call ; edge_unify. :- pred maybe_add_dependency_arc(dependency_graph(T)::in, what_dependency_edges::in, edge_kind::in, digraph_key(T)::in, pred_proc_id::in, dep_arcs(T)::in, dep_arcs(T)::out) is det <= dependency_node(T). maybe_add_dependency_arc(DepGraph, WhatEdges, EdgeKind, Caller, PredProcId, !DepArcs) :- % If the callee isn't in the graph, then we didn't create a node for it. % If we didn't create a node for it, then we are not interested in calls % to it. ( if digraph.search_key(DepGraph, dependency_node(PredProcId), Callee), require_complete_switch [WhatEdges] ( WhatEdges = only_tail_calls, EdgeKind = edge_tail_call ; WhatEdges = only_all_calls, ( EdgeKind = edge_tail_call ; EdgeKind = edge_non_tail_call ) ; WhatEdges = all_calls_and_unifies ) then !:DepArcs = [Caller - Callee | !.DepArcs] else true ). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- type scc_id == int. % An SCC cannot be merged into its parents if one of its procedures % is called as an aggregate query. % % XXX This predicate is not called from anywhere. Maybe it should be; % maybe not. % :- 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, digraph(scc_id)::in, digraph(scc_id)::out, set(scc_id)::in, set(scc_id)::out) is det. :- pragma consider_used(pred(handle_higher_order_args/9)). handle_higher_order_args([], _, _, _, _, !SCCRel, !NoMerge). handle_higher_order_args([Arg | Args], IsAgg, SCCid, Map, PredSCC, !SCCGraph, !NoMerge) :- ( if multi_map.search(Map, Arg, PredProcIds) then list.foldl2(handle_higher_order_arg(PredSCC, IsAgg, SCCid), PredProcIds, !SCCGraph, !NoMerge) else true ), handle_higher_order_args(Args, IsAgg, SCCid, Map, PredSCC, !SCCGraph, !NoMerge). :- pred handle_higher_order_arg(map(pred_proc_id, scc_id)::in, bool::in, scc_id::in, pred_proc_id::in, 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, !SCCGraph, !NoMerge) :- ( if map.search(PredSCC, PredProcId, CalledSCCid) then % Make sure anything called through an aggregate % is not merged into the current sub-module. ( IsAgg = yes, set.insert(CalledSCCid, !NoMerge) ; IsAgg = no ), ( if CalledSCCid = SCCid then true else digraph.add_vertices_and_edge(SCCid, CalledSCCid, !SCCGraph) ) else true ). %---------------------------------------------------------------------------% get_bottom_up_sccs_with_entry_points(ModuleInfo, DepInfo, BottomUpSCCsEntryPoints) :- DepGraph = dependency_info_get_graph(DepInfo), BottomUpSCCs = dependency_info_get_bottom_up_sccs(DepInfo), list.reverse(BottomUpSCCs, TopDownSCCs), find_scc_entry_points(ModuleInfo, DepGraph, TopDownSCCs, set.init, TopDownSCCsEntryPoints), list.reverse(TopDownSCCsEntryPoints, BottomUpSCCsEntryPoints). :- pred find_scc_entry_points(module_info::in, dependency_graph(pred_proc_id)::in, list(scc)::in, set(pred_proc_id)::in, list(scc_with_entry_points)::out) is det. find_scc_entry_points(_, _, [], _, []). find_scc_entry_points(ModuleInfo, DepGraph, [SCC | SCCs], !.CalledFromHigherSCC, [SCCEntryPoints | SCCsEntryPoints]) :- set.intersect(!.CalledFromHigherSCC, SCC, SCCProcsCalledFromHigherSCCs), set.filter(proc_is_exported(ModuleInfo), SCC, ExportedSCCProcs), SCCEntryPoints = scc_with_entry_points(SCC, SCCProcsCalledFromHigherSCCs, ExportedSCCProcs), % The set of procedures called from SCCs at or above this SCC is % the set of procedures called from SCCs above this SCC, plus % the set of procedures called from this SCC. set.map(find_callee_keys(DepGraph), SCC, CalleeKeySets), CalleeKeys = set.power_union(CalleeKeySets), set.map(lookup_vertex(DepGraph), CalleeKeys, Callees), set.union(Callees, !CalledFromHigherSCC), % When we process the lower SCCs, we won't care whether the procedures % of *this* SCC get called or not. Deleting them should reduce the % growth of CalledFromHigherSCC; for many modules, its size should remain % roughly constant, instead of growing linearly in the number of SCCs % processed so far. This is good, because the cost of the operations % on CalledFromHigherSCC would then remain roughly constant as well. set.difference(!.CalledFromHigherSCC, SCC, !:CalledFromHigherSCC), find_scc_entry_points(ModuleInfo, DepGraph, SCCs, !.CalledFromHigherSCC, SCCsEntryPoints). :- pred find_callee_keys(dependency_graph(pred_proc_id)::in, pred_proc_id::in, set(dependency_graph_key(pred_proc_id))::out) is det. find_callee_keys(DepGraph, ParentId, ChildKeys) :- digraph.lookup_key(DepGraph, ParentId, ParentKey), digraph.lookup_from(DepGraph, ParentKey, ChildKeys). :- pred proc_is_exported(module_info::in, pred_proc_id::in) is semidet. proc_is_exported(ModuleInfo, PredProcId) :- PredProcId = proc(PredId, ProcId), module_info_pred_info(ModuleInfo, PredId, PredInfo), procedure_is_exported(ModuleInfo, PredInfo, ProcId). %---------------------------------------------------------------------------% :- pred write_dependency_ordering(io.text_output_stream::in, module_info::in, int::in, list(list(pred_proc_id))::in, io::di, io::uo) is det. :- pragma consider_used(pred(write_dependency_ordering/6)). write_dependency_ordering(Stream, _ModuleInfo, _CurSCCNum, [], !IO) :- io.write_string(Stream, "\n", !IO). write_dependency_ordering(Stream, ModuleInfo, CurSCCNum, [SCC | SCCs], !IO) :- io.write_string(Stream, "% SCC ", !IO), io.write_int(Stream, CurSCCNum, !IO), io.write_string(Stream, "\n", !IO), write_scc(Stream, ModuleInfo, SCC, !IO), write_dependency_ordering(Stream, ModuleInfo, CurSCCNum + 1, SCCs, !IO). :- pred write_scc(io.text_output_stream::in, module_info::in, list(pred_proc_id)::in, io::di, io::uo) is det. write_scc(_Stream, _ModuleInfo, [], !IO). write_scc(Stream, ModuleInfo, [PredProcId | PredProcIds], !IO) :- PredProcId = proc(PredId, ProcId), module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo), Name = pred_info_name(PredInfo), proc_info_get_declared_determinism(ProcInfo, Det), proc_info_get_argmodes(ProcInfo, Modes), varset.init(ModeVarSet), io.write_string(Stream, "% ", !IO), mercury_output_pred_mode_subdecl(Stream, output_mercury, ModeVarSet, unqualified(Name), Modes, Det, !IO), io.write_string(Stream, "\n", !IO), write_scc(Stream, ModuleInfo, PredProcIds, !IO). %---------------------------------------------------------------------------% write_dependency_graph(Stream, !ModuleInfo, !IO) :- module_info_ensure_dependency_info(!ModuleInfo, DepInfo), io.write_string(Stream, "% Dependency graph\n", !IO), io.write_string(Stream, "\n\n% Dependency ordering\n", !IO), digraph.traverse(dependency_info_get_graph(DepInfo), write_empty_node(Stream), write_dep_graph_link(Stream, !.ModuleInfo), !IO). write_prof_dependency_graph(Stream, !ModuleInfo, !IO) :- module_info_ensure_dependency_info(!ModuleInfo, DepInfo), digraph.traverse(dependency_info_get_graph(DepInfo), write_empty_node(Stream), write_prof_dep_graph_link(Stream, !.ModuleInfo), !IO). %---------------------------------------------------------------------------% :- pred write_empty_node(io.text_output_stream::in, pred_proc_id::in, io::di, io::uo) is det. write_empty_node(_, _, !IO). %---------------------------------------------------------------------------% :- pred write_prof_dep_graph_link(io.text_output_stream::in, module_info::in, pred_proc_id::in, pred_proc_id::in, io::di, io::uo) is det. write_prof_dep_graph_link(Stream, ModuleInfo, Parent, Child, !IO) :- Parent = proc(PPredId, PProcId), % Caller Child = proc(CPredId, CProcId), % Callee output_label_dependency(Stream, ModuleInfo, PPredId, PProcId, !IO), io.write_string(Stream, "\t", !IO), output_label_dependency(Stream, ModuleInfo, CPredId, CProcId, !IO), io.write_string(Stream, "\n", !IO). % Print out the label corresponding to the given pred_id and proc_id. % :- pred output_label_dependency(io.text_output_stream::in, module_info::in, pred_id::in, proc_id::in, io::di, io::uo) is det. output_label_dependency(Stream, ModuleInfo, PredId, ProcId, !IO) :- ProcLabel = make_proc_label(ModuleInfo, PredId, ProcId), io.write_string(Stream, proc_label_to_c_string(add_label_prefix, ProcLabel), !IO). :- pred write_dep_graph_link(io.text_output_stream::in, module_info::in, pred_proc_id::in, pred_proc_id::in, io::di, io::uo) is det. write_dep_graph_link(Stream, ModuleInfo, Parent, Child, !IO) :- Parent = proc(PPredId, PProcId), % Caller Child = proc(CPredId, CProcId), % Callee module_info_pred_proc_info(ModuleInfo, PPredId, PProcId, PPredInfo, PProcInfo), module_info_pred_proc_info(ModuleInfo, CPredId, CProcId, CPredInfo, CProcInfo), PName = pred_info_name(PPredInfo), proc_info_get_declared_determinism(PProcInfo, PDet), proc_info_get_argmodes(PProcInfo, PModes), CName = pred_info_name(CPredInfo), proc_info_get_declared_determinism(CProcInfo, CDet), proc_info_get_argmodes(CProcInfo, CModes), varset.init(ModeVarSet), mercury_output_pred_mode_subdecl(Stream, output_mercury, ModeVarSet, unqualified(PName), PModes, PDet, !IO), io.write_string(Stream, " -> ", !IO), mercury_output_pred_mode_subdecl(Stream, output_mercury, ModeVarSet, unqualified(CName), CModes, CDet, !IO), io.write_string(Stream, "\n", !IO). %---------------------------------------------------------------------------% :- end_module hlds.hlds_dependency_graph. %---------------------------------------------------------------------------%