mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-06 07:49:02 +00:00
253 lines
9.4 KiB
Mathematica
253 lines
9.4 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2001, 2004-2006, 2008-2009 The University of Melbourne.
|
|
% Copyright (C) 2015, 2017, 2023 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: exclude.m.
|
|
% Author: zs.
|
|
%
|
|
% This module handles contour exclusion.
|
|
%
|
|
% When asking for the list of callers of a procedure, the user may ask for
|
|
% contour exclusion to be applied. This means that instead of deriving the
|
|
% displayed information from the immediate callers of the specified procedure,
|
|
% the system uses the nearest ancestors of the specified procedure that are not
|
|
% excluded. Contour exclusion draws a line through the program, with the
|
|
% excluded procedures below the line and the non-excluded procedures above;
|
|
% and when looking at the callers of a procedure, the system uses the nearest
|
|
% ancestor that is above the line.
|
|
%
|
|
% The read_exclude_file procedure reads in the file that specifies the set of
|
|
% excluded procedures. The exclusion file should consist of a sequence of
|
|
% lines, and each line should contain two words. The first word should be
|
|
% either "all" or "internal"; the second should the name of a module.
|
|
% If the first word is "all", then all procedures in the named module are
|
|
% excluded; if the first word is "internal", then all internal (non-exported)
|
|
% procedures in the named module are excluded. The first argument of
|
|
% read_exclude_file specifies the name of the exclusion file; the second is the
|
|
% main profiler data structure, which read_exclude_file uses to verify the
|
|
% existence of the named modules. Read_exclude_file returns an abstract data
|
|
% structure representing the contents of the file, provided that the file
|
|
% exists and has the proper structure.
|
|
%
|
|
% The only thing the caller can do with that abstract data structure is give it
|
|
% back to apply_contour_exclusion. This predicate applies contour exclusion by
|
|
% following the ancestors of the supplied call_site_dynamic_ptr until it
|
|
% arrives at a procedure which is not excluded.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module exclude.
|
|
:- interface.
|
|
|
|
:- import_module profile.
|
|
|
|
:- import_module io.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type exclude_file
|
|
---> exclude_file(
|
|
exclude_filename :: string,
|
|
exclude_file_contents :: exclude_contents
|
|
).
|
|
|
|
:- type exclude_contents
|
|
---> no_exclude_file
|
|
; unreadable_exclude_file(
|
|
exclude_syntax_error :: string
|
|
)
|
|
; readable_exclude_file(
|
|
exclude_specs :: excluded_modules,
|
|
exclude_maybe_error :: maybe(string)
|
|
).
|
|
|
|
:- type excluded_modules.
|
|
|
|
:- pred read_exclude_file(string::in, map(string, module_data)::in,
|
|
exclude_file::out, io::di, io::uo) is det.
|
|
|
|
:- func apply_contour_exclusion(deep, excluded_modules, call_site_dynamic_ptr)
|
|
= call_site_dynamic_ptr.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module bool.
|
|
:- import_module char.
|
|
:- import_module list.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type excluded_modules == set(exclude_spec).
|
|
|
|
:- type exclude_spec
|
|
---> exclude_spec(
|
|
string, % the name of a module
|
|
exclusion_type % which procedures in the module
|
|
% are excluded
|
|
).
|
|
|
|
:- type exclusion_type
|
|
---> exclude_all_procedures
|
|
% Exclude all procedures in the named module.
|
|
; exclude_internal_procedures.
|
|
% Exclude all procedures in the named module, except those
|
|
% which are exported from the module.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
read_exclude_file(FileName, ModuleDataMap, ExcludeFile, !IO) :-
|
|
io.open_input(FileName, MaybeStream, !IO),
|
|
(
|
|
MaybeStream = ok(InputStream),
|
|
read_exclude_lines(FileName, InputStream, [], MaybeSpecs, !IO),
|
|
io.close_input(InputStream, !IO),
|
|
(
|
|
MaybeSpecs = ok(Specs),
|
|
validate_exclude_lines(FileName, Specs, ModuleDataMap,
|
|
ExcludeContents)
|
|
;
|
|
MaybeSpecs = error(Msg),
|
|
ExcludeContents = unreadable_exclude_file(Msg)
|
|
)
|
|
;
|
|
MaybeStream = error(_),
|
|
% If we cannot open the file, simply return `no' as an indication
|
|
% that there is no exclude file there, at least not a readable one.
|
|
ExcludeContents = no_exclude_file
|
|
),
|
|
ExcludeFile = exclude_file(FileName, ExcludeContents).
|
|
|
|
:- pred read_exclude_lines(string::in, io.text_input_stream::in,
|
|
list(exclude_spec)::in, maybe_error(list(exclude_spec))::out,
|
|
io::di, io::uo) is det.
|
|
|
|
read_exclude_lines(FileName, InputStream, RevSpecs0, Res, !IO) :-
|
|
io.read_line_as_string(InputStream, Res0, !IO),
|
|
(
|
|
Res0 = ok(Line0),
|
|
( if string.remove_suffix(Line0, "\n", LinePrime) then
|
|
Line = LinePrime
|
|
else
|
|
Line = Line0
|
|
),
|
|
( if
|
|
Words = string.words_separator(char.is_whitespace, Line),
|
|
Words = [Scope, ModuleName],
|
|
(
|
|
Scope = "all",
|
|
ExclType = exclude_all_procedures
|
|
;
|
|
Scope = "internal",
|
|
ExclType = exclude_internal_procedures
|
|
)
|
|
then
|
|
Spec = exclude_spec(ModuleName, ExclType),
|
|
RevSpecs1 = [Spec | RevSpecs0],
|
|
read_exclude_lines(FileName, InputStream, RevSpecs1, Res, !IO)
|
|
else
|
|
Msg = string.format("file %s contains badly formatted line: %s",
|
|
[s(FileName), s(Line)]),
|
|
Res = error(Msg)
|
|
)
|
|
;
|
|
Res0 = eof,
|
|
Res = ok(RevSpecs0)
|
|
;
|
|
Res0 = error(Err),
|
|
io.error_message(Err, Msg),
|
|
Res = error(Msg)
|
|
).
|
|
|
|
:- pred validate_exclude_lines(string::in, list(exclude_spec)::in,
|
|
map(string, module_data)::in, exclude_contents::out) is det.
|
|
|
|
validate_exclude_lines(FileName, Specs, ModuleDataMap, ExcludeContents) :-
|
|
list.filter(has_valid_module_name(ModuleDataMap), Specs,
|
|
ValidSpecs, InvalidSpecs),
|
|
set.list_to_set(ValidSpecs, ModuleSpecs),
|
|
(
|
|
InvalidSpecs = [],
|
|
MaybeErrorMsg = no,
|
|
ExcludeContents = readable_exclude_file(ModuleSpecs, MaybeErrorMsg)
|
|
;
|
|
InvalidSpecs = [_ | _],
|
|
(
|
|
ValidSpecs = [_ | _],
|
|
InvalidModuleNames = list.map(spec_to_module_name, InvalidSpecs),
|
|
BadNames = string.join_list(", ", InvalidModuleNames),
|
|
Msg1 = string.format(
|
|
"Warning: %s contains unrecognized module names: %s.",
|
|
[s(FileName), s(BadNames)]),
|
|
Msg2 = "These modules either do not exist " ++
|
|
"or have no deep profiled procedures.",
|
|
Msg = Msg1 ++ Msg2,
|
|
MaybeErrorMsg = yes(Msg),
|
|
ExcludeContents = readable_exclude_file(ModuleSpecs, MaybeErrorMsg)
|
|
;
|
|
ValidSpecs = [],
|
|
Msg1 = string.format(
|
|
"Error: file %s contains only unrecognized module names.",
|
|
[s(FileName)]),
|
|
Msg2 = "These modules either do not exist " ++
|
|
"or have no deep profiled procedures.",
|
|
Msg = Msg1 ++ Msg2,
|
|
ExcludeContents = unreadable_exclude_file(Msg)
|
|
)
|
|
).
|
|
|
|
:- pred has_valid_module_name(map(string, module_data)::in, exclude_spec::in)
|
|
is semidet.
|
|
|
|
has_valid_module_name(ModuleDataMap, Spec) :-
|
|
map.search(ModuleDataMap, spec_to_module_name(Spec), _).
|
|
|
|
:- func spec_to_module_name(exclude_spec) = string.
|
|
|
|
spec_to_module_name(exclude_spec(ModuleName, _)) = ModuleName.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
apply_contour_exclusion(Deep, ExcludedSpecs, CSDPtr0) = CSDPtr :-
|
|
( if valid_call_site_dynamic_ptr(Deep, CSDPtr0) then
|
|
deep_lookup_call_site_dynamics(Deep, CSDPtr0, CSD),
|
|
PDPtr = CSD ^ csd_caller,
|
|
deep_lookup_proc_dynamics(Deep, PDPtr, PD),
|
|
PSPtr = PD ^ pd_proc_static,
|
|
deep_lookup_proc_statics(Deep, PSPtr, PS),
|
|
ModuleName = PS ^ ps_decl_module,
|
|
( if
|
|
set.member(ExclSpec, ExcludedSpecs),
|
|
ExclSpec = exclude_spec(ModuleName, ExclType),
|
|
(
|
|
ExclType = exclude_all_procedures
|
|
;
|
|
ExclType = exclude_internal_procedures,
|
|
PS ^ ps_in_interface = no
|
|
)
|
|
then
|
|
deep_lookup_clique_index(Deep, PDPtr, CliquePtr),
|
|
deep_lookup_clique_parents(Deep, CliquePtr, EntryCSDPtr),
|
|
CSDPtr = apply_contour_exclusion(Deep, ExcludedSpecs, EntryCSDPtr)
|
|
else
|
|
CSDPtr = CSDPtr0
|
|
)
|
|
else
|
|
CSDPtr = CSDPtr0
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module exclude.
|
|
%---------------------------------------------------------------------------%
|