Files
mercury/mdbcomp/trace_counts.m
Zoltan Somogyi 3c07fc2121 Use explicit streams in deep_profiler/*.m.
deep_profiler/analysis_utils.m:
deep_profiler/autopar_find_best_par.m:
deep_profiler/autopar_reports.m:
deep_profiler/autopar_search_callgraph.m:
deep_profiler/autopar_search_goals.m:
deep_profiler/callgraph.m:
deep_profiler/canonical.m:
deep_profiler/cliques.m:
deep_profiler/coverage.m:
deep_profiler/dump.m:
deep_profiler/mdprof_cgi.m:
deep_profiler/mdprof_create_feedback.m:
deep_profiler/mdprof_dump.m:
deep_profiler/mdprof_procrep.m:
deep_profiler/mdprof_report_feedback.m:
deep_profiler/mdprof_test.m:
deep_profiler/profile.m:
deep_profiler/read_profile.m:
deep_profiler/recursion_patterns.m:
deep_profiler/startup.m:
deep_profiler/var_use_analysis.m:
    Replace implicit streams with explicit streams.

    In some places, simplify some code, often using constructs such as
    string.format that either did not exist or were too expensive to use
    when the original code was written.

    Consistenly use the spelling StdErr over Stderr.

    In mdbprof_dump.m, put filename and reason-for-failing-to-open-that-file
    in the right order in an error message.

deep_profiler/DEEP_FLAGS.in:
    Turn on --warn-implicit-stream-calls for the entire deep_profiler
    directory.

mdbcomp/program_representation.m:
mdbcomp/trace_counts.m:
    Replace implicit streams with explicit streams. These are the two mdbcomp
    modules that (a) used to use implicit streams, and (2) are used by the
    deep profiler.

mdbcomp/Mercury.options:
    Turn on --warn-implicit-stream-calls for these two modules.

slice/mcov.m:
slice/mtc_union.m:
    Conform to the changes in mdbcomp.
2021-03-06 18:30:50 +11:00

994 lines
38 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
% Copyright (C) 2005-2008, 2010-2012 The University of Melbourne.
% Copyright (C) 2014-2015, 2017-2018 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: trace_counts.m.
% Main author: wangp.
% Modifications by zs and maclarty.
%
% This module defines predicates to read in the execution trace summaries
% generated by programs compiled using the compiler's tracing options.
%
%---------------------------------------------------------------------------%
:- module mdbcomp.trace_counts.
:- interface.
:- import_module mdbcomp.goal_path.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module io.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module set.
%---------------------------------------------------------------------------%
:- type all_or_nonzero
---> user_all
% The file contains counts for all labels from user-defined
% procedures.
; user_nonzero.
% The file contains counts for all labels from user-defined
% procedures, provided the count is nonzero.
:- type base_count_file_type
---> base_count_file_type(all_or_nonzero, string).
% The first argument says whether we have all the counts;
% the second gives the name of the program.
:- type trace_count_file_type
---> single_file(base_count_file_type)
% The file contains counts from a single execution.
; union_file(int, list(trace_count_file_type))
% The file is a union of some other trace count files.
% The number of test cases in the union is recorded, and
% so is the set of kinds of trace count files they came from.
% (We represent the set as a sorted list, because we write out
% values of trace_count_file_type to files, and we don't want to
% expose the implementation of sets.)
; diff_file(trace_count_file_type, trace_count_file_type).
% The file is a difference between two other trace count files.
:- func sum_trace_count_file_type(trace_count_file_type, trace_count_file_type)
= trace_count_file_type.
:- type trace_counts == map(proc_label_in_context, proc_trace_counts).
:- type proc_label_in_context
---> proc_label_in_context(
context_module_symname :: sym_name,
context_filename :: string,
proc_label :: proc_label
).
:- type proc_trace_counts == map(path_port, line_no_and_count).
:- type path_port
---> port_only(trace_port)
; path_only(reverse_goal_path)
; port_and_path(trace_port, reverse_goal_path).
:- type line_no_and_count
---> line_no_and_count(
line_number :: int,
exec_count :: int,
num_tests :: int
).
:- func make_path_port(reverse_goal_path, trace_port) = path_port.
:- pred summarize_trace_counts_list(list(trace_counts)::in, trace_counts::out)
is det.
:- pred sum_trace_counts(trace_counts::in, trace_counts::in, trace_counts::out)
is det.
:- pred diff_trace_counts(trace_counts::in, trace_counts::in,
trace_counts::out) is det.
%---------------------------------------------------------------------------%
:- type read_trace_counts_result
---> ok(trace_count_file_type, trace_counts)
; syntax_error(string)
; error_message(string)
; open_error(io.error)
; io_error(io.error).
% read_trace_counts(FileName, Result, !IO):
%
% Read in the trace counts stored in FileName.
%
:- pred read_trace_counts(string::in, read_trace_counts_result::out,
io::di, io::uo) is det.
:- type read_trace_counts_list_result
---> list_ok(trace_count_file_type, trace_counts)
; list_error_message(string).
% read_trace_counts_source(FileName, Result, !IO):
%
% Read in trace counts stored in a given trace count file.
%
:- pred read_trace_counts_source(string::in,
read_trace_counts_list_result::out, io::di, io::uo) is det.
% read_trace_counts_list(ShowProgress, FileName, Result, !IO):
%
% Read the trace_counts in the files whose names appear in FileName.
% The result is a union of all the trace counts.
% If ShowProgress is yes(Stream) then print to Stream the name of
% each file just before it is read.
%
:- pred read_trace_counts_list(maybe(io.text_output_stream)::in, string::in,
read_trace_counts_list_result::out, io::di, io::uo) is det.
% read_and_union_trace_counts(ShowProgress, FileNames, NumTests, TestKinds,
% TraceCounts, MaybeError, !IO):
%
% Invoke read_trace_counts_source for each of the supplied filenames, and
% union the resulting trace counts. If there is a problem with reading in
% the trace counts, MaybeError will be `yes' wrapped around the error
% message. Otherwise, MaybeError will be `no', TraceCounts will contain
% the union of the trace counts and NumTests will contain the number of
% tests the trace counts come from.
%
% If the source is a list of files and ShowProgress is yes then
% the name of each file read will be printed to the current output
% stream just before it is read.
%
:- pred read_and_union_trace_counts(maybe(io.text_output_stream)::in,
list(string)::in, int::out, set(trace_count_file_type)::out,
trace_counts::out, maybe(string)::out, io::di, io::uo) is det.
% write_trace_counts_to_file(FileType, TraceCounts, FileName, Result, !IO):
%
% Write the given trace counts to FileName in a format suitable for
% reading with read_trace_counts/4.
%
:- pred write_trace_counts_to_file(trace_count_file_type::in, trace_counts::in,
string::in, io.res::out, io::di, io::uo) is det.
% Write out the given proc_label.
%
:- pred write_proc_label(io.text_output_stream::in, proc_label::in,
io::di, io::uo) is det.
:- pred restrict_trace_counts_to_module(module_name::in, trace_counts::in,
trace_counts::out) is det.
% Return the number of tests cases used to generate the trace counts with
% the given list of file types.
%
:- func calc_num_tests(list(trace_count_file_type)) = int.
% Return the number of tests used to create a trace counts file of the
% given type.
%
:- func num_tests_for_file_type(trace_count_file_type) = int.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module exception.
:- import_module int.
:- import_module integer.
:- import_module lexer.
:- import_module require.
:- import_module string.
:- import_module term_io.
:- import_module univ.
%---------------------------------------------------------------------------%
sum_trace_count_file_type(Type1, Type2) = UnionType :-
(
Type1 = single_file(_),
Type2 = single_file(_),
UnionType = union_file(2, sort_and_remove_dups([Type1, Type2]))
;
Type1 = single_file(_),
Type2 = union_file(N, IncludedTypes2),
UnionType = union_file(N + 1,
insert_into_list_as_set(IncludedTypes2, Type1))
;
Type1 = single_file(_),
Type2 = diff_file(_, _),
UnionType = union_file(2, sort_and_remove_dups([Type1, Type2]))
;
Type1 = union_file(N, IncludedTypes1),
Type2 = single_file(_),
UnionType = union_file(N + 1,
insert_into_list_as_set(IncludedTypes1, Type2))
;
Type1 = union_file(N1, IncludedTypes1),
Type2 = union_file(N2, IncludedTypes2),
UnionType = union_file(N1 + N2,
sort_and_remove_dups(IncludedTypes1 ++ IncludedTypes2))
;
Type1 = union_file(N, IncludedTypes1),
Type2 = diff_file(_, _),
UnionType = union_file(N + 1,
insert_into_list_as_set(IncludedTypes1, Type2))
;
Type1 = diff_file(_, _),
Type2 = single_file(_),
UnionType = union_file(2, sort_and_remove_dups([Type1, Type2]))
;
Type1 = diff_file(_, _),
Type2 = union_file(N, IncludedTypes2),
UnionType = union_file(N + 1,
insert_into_list_as_set(IncludedTypes2, Type1))
;
Type1 = diff_file(_, _),
Type2 = diff_file(_, _),
UnionType = union_file(2, sort_and_remove_dups([Type1, Type2]))
).
:- func insert_into_list_as_set(list(T), T) = list(T).
insert_into_list_as_set(List0, Item) = List :-
set.list_to_set(List0, Set0),
set.insert(Item, Set0, Set),
set.to_sorted_list(Set, List).
%---------------------------------------------------------------------------%
% This function should be kept in sync with the MR_named_count_port array
% in runtime/mercury_trace_base.c.
%
make_path_port(_GoalPath, port_call) = port_only(port_call).
make_path_port(_GoalPath, port_exit) = port_only(port_exit).
make_path_port(_GoalPath, port_redo) = port_only(port_redo).
make_path_port(_GoalPath, port_fail) = port_only(port_fail).
make_path_port(GoalPath, port_tailrec_call) = path_only(GoalPath).
make_path_port(_GoalPath, port_exception) = port_only(port_exception).
make_path_port(GoalPath, port_ite_cond) = path_only(GoalPath).
make_path_port(GoalPath, port_ite_then) = path_only(GoalPath).
make_path_port(GoalPath, port_ite_else) = path_only(GoalPath).
make_path_port(GoalPath, port_neg_enter) =
port_and_path(port_neg_enter, GoalPath).
make_path_port(GoalPath, port_neg_success) =
port_and_path(port_neg_success, GoalPath).
make_path_port(GoalPath, port_neg_failure) =
port_and_path(port_neg_failure, GoalPath).
make_path_port(GoalPath, port_disj_first) = path_only(GoalPath).
make_path_port(GoalPath, port_disj_later) = path_only(GoalPath).
make_path_port(GoalPath, port_switch) = path_only(GoalPath).
make_path_port(_GoalPath, port_user) = port_only(port_user).
%---------------------------------------------------------------------------%
summarize_trace_counts_list(TraceCountsList, TraceCounts) :-
( if TraceCountsList = [TraceCountsPrime] then
% optimize the common case
TraceCounts = TraceCountsPrime
else
list.foldl(sum_trace_counts, TraceCountsList, map.init, TraceCounts)
).
sum_trace_counts(TraceCountsA, TraceCountsB, TraceCounts) :-
map.union(sum_proc_trace_counts, TraceCountsA, TraceCountsB, TraceCounts).
:- pred sum_proc_trace_counts(proc_trace_counts::in, proc_trace_counts::in,
proc_trace_counts::out) is det.
sum_proc_trace_counts(ProcTraceCountsA, ProcTraceCountsB, ProcTraceCounts) :-
ProcTraceCounts = map.union(sum_counts_on_line,
ProcTraceCountsA, ProcTraceCountsB).
:- func sum_counts_on_line(line_no_and_count, line_no_and_count)
= line_no_and_count.
sum_counts_on_line(LC1, LC2) = LC :-
% We don't check that LineNumber1 = LineNumber2 since that does not
% necessarily represent an error. (Consider the case when the two trace
% files are derived from sources that are identical except for the addition
% of a comment.)
LC1 = line_no_and_count(LineNumber1, Count1, NumTests1),
LC2 = line_no_and_count(_LineNumber, Count2, NumTests2),
LC = line_no_and_count(LineNumber1, Count1 + Count2,
NumTests1 + NumTests2).
%---------------------------------------------------------------------------%
diff_trace_counts(TraceCountsA, TraceCountsB, TraceCounts) :-
map.foldl(diff_trace_counts_acc(TraceCountsB), TraceCountsA,
map.init, TraceCounts).
:- pred diff_trace_counts_acc(trace_counts::in,
proc_label_in_context::in, proc_trace_counts::in,
trace_counts::in, trace_counts::out) is det.
diff_trace_counts_acc(TraceCountsB, ProcLabelInContextA, ProcTraceCountsA,
!TraceCounts) :-
( if map.search(TraceCountsB, ProcLabelInContextA, ProcTraceCountsB) then
ProcTraceCounts = diff_proc_counts(ProcTraceCountsA, ProcTraceCountsB),
map.det_insert(ProcLabelInContextA, ProcTraceCounts, !TraceCounts)
else
map.det_insert(ProcLabelInContextA, ProcTraceCountsA, !TraceCounts)
).
:- func diff_proc_counts(proc_trace_counts, proc_trace_counts)
= proc_trace_counts.
diff_proc_counts(ProcTraceCountsA, ProcTraceCountsB) = ProcTraceCounts :-
map.foldl(diff_proc_counts_acc(ProcTraceCountsB), ProcTraceCountsA,
map.init, ProcTraceCounts).
:- pred diff_proc_counts_acc(proc_trace_counts::in,
path_port::in, line_no_and_count::in,
proc_trace_counts::in, proc_trace_counts::out) is det.
diff_proc_counts_acc(ProcTraceCountsB, PathPortA, LineNoCountA,
!ProcTraceCounts) :-
( if map.search(ProcTraceCountsB, PathPortA, LineNoCountB) then
LineNoCount = diff_counts_on_line(LineNoCountA, LineNoCountB),
map.det_insert(PathPortA, LineNoCount, !ProcTraceCounts)
else
map.det_insert(PathPortA, LineNoCountA, !ProcTraceCounts)
).
:- func diff_counts_on_line(line_no_and_count, line_no_and_count)
= line_no_and_count.
diff_counts_on_line(LC1, LC2) = LC :-
% We don't check that LineNumber1 = LineNumber2 since that does not
% necessarily represent an error. (Consider the case when the two trace
% files are derived from sources that are identical except for the addition
% of a comment.)
% The number of tests field doesn't make sense in the result of a diff
% operation. We signal this fact by using a plainly dummy value.
LC1 = line_no_and_count(LineNumber1, Count1, _NumTests1),
LC2 = line_no_and_count(_LineNumber, Count2, _NumTests2),
LC = line_no_and_count(LineNumber1, Count1 - Count2, -1).
%---------------------------------------------------------------------------%
read_trace_counts(FileName, ReadResult, !IO) :-
% XXX We should be using zcat here, to avoid deleting the gzipped file
% and having to recreate it again. Unfortunately, we don't have any
% facilities equivalent to popen in Unix, and I don't know how to
% write one in a way that is portable to Windows. zs.
% XXX ... and we certainly shouldn't be hardcoding the names of the
% gzip / gunzip executables. juliensf.
( if string.remove_suffix(FileName, ".gz", BaseName) then
io.call_system("gunzip " ++ FileName, _UnzipResult, !IO),
ActualFileName = BaseName,
GzipCmd = "gzip " ++ BaseName
else
ActualFileName = FileName,
GzipCmd = ""
),
io.open_input(ActualFileName, Result, !IO),
(
Result = ok(FileStream),
io.read_line_as_string(FileStream, IdReadResult, !IO),
( if
IdReadResult = ok(FirstLine),
string.rstrip(FirstLine) = trace_count_file_id
then
promise_equivalent_solutions [ReadResult, !:IO] (
read_trace_counts_from_stream(FileStream, ReadResult, !IO)
)
else
ReadResult = syntax_error("no trace count file id")
),
io.close_input(FileStream, !IO)
;
Result = error(IOError),
ReadResult = open_error(IOError)
),
( if GzipCmd = "" then
true
else
io.call_system(GzipCmd, _ZipResult, !IO)
).
:- pred read_trace_counts_from_stream(io.text_input_stream::in,
read_trace_counts_result::out, io::di, io::uo) is cc_multi.
read_trace_counts_from_stream(InputStream, ReadResult, !IO) :-
io.read(InputStream, FileTypeResult, !IO),
(
FileTypeResult = ok(FileType),
io.read_line_as_string(InputStream, NewlineResult, !IO),
( if NewlineResult = ok("\n") then
try_io(read_trace_counts_setup(InputStream, map.init),
Result, !IO),
(
Result = succeeded(TraceCounts),
ReadResult = ok(FileType, TraceCounts)
;
Result = exception(Exception),
( if Exception = univ(IOError) then
ReadResult = io_error(IOError)
else if Exception = univ(Message) then
ReadResult = error_message(Message)
else if Exception = univ(trace_count_syntax_error(Error)) then
ReadResult = syntax_error(Error)
else
unexpected($pred,
"unexpected exception type: " ++ string(Exception))
)
)
else
ReadResult = syntax_error("no info on trace count file type")
)
;
( FileTypeResult = eof
; FileTypeResult = error(_, _)
),
ReadResult = syntax_error("no info on trace count file type")
).
:- pred read_trace_counts_setup(io.text_input_stream::in,
trace_counts::in, trace_counts::out, io::di, io::uo) is det.
read_trace_counts_setup(InputStream, !TraceCounts, !IO) :-
io.get_line_number(InputStream, LineNumber, !IO),
io.read_line_as_string(InputStream, Result, !IO),
(
Result = ok(Line),
% The code in mercury_trace_counts.c always generates output that will
% cause read_proc_trace_counts below to override these dummy module
% and file names before they are referenced.
CurModuleNameSym = unqualified(""),
CurFileName = "",
read_proc_trace_counts(InputStream, LineNumber, Line,
CurModuleNameSym, CurFileName, !TraceCounts, !IO)
;
Result = eof
;
Result = error(Error),
throw(Error)
).
:- type trace_count_syntax_error
---> trace_count_syntax_error(string).
:- pred read_proc_trace_counts(io.text_input_stream::in, int::in, string::in,
sym_name::in, string::in, trace_counts::in, trace_counts::out,
io::di, io::uo) is det.
read_proc_trace_counts(InputStream, HeaderLineNumber, HeaderLine,
CurModuleNameSym, CurFileName, !TraceCounts, !IO) :-
lexer.string_get_token_list_max(HeaderLine, string.length(HeaderLine),
TokenList, posn(HeaderLineNumber, 1, 0), _),
( if TokenList = token_cons(name(TokenName), _, TokenListRest) then
( if
TokenName = "module",
TokenListRest =
token_cons(name(NextModuleName), _,
token_nil)
then
NextModuleNameSym = string_to_sym_name(NextModuleName),
io.read_line_as_string(InputStream, Result, !IO),
(
Result = ok(Line),
io.get_line_number(InputStream, LineNumber, !IO),
read_proc_trace_counts(InputStream, LineNumber, Line,
NextModuleNameSym, CurFileName, !TraceCounts, !IO)
;
Result = eof
;
Result = error(Error),
throw(Error)
)
else if
TokenName = "file",
TokenListRest =
token_cons(name(NextFileName), _,
token_nil)
then
io.read_line_as_string(InputStream, Result, !IO),
(
Result = ok(Line),
io.get_line_number(InputStream, LineNumber, !IO),
read_proc_trace_counts(InputStream, LineNumber, Line,
CurModuleNameSym, NextFileName, !TraceCounts, !IO)
;
Result = eof
;
Result = error(Error),
throw(Error)
)
else if
% At the moment runtime/mercury_trace_base.c doesn't write out
% data for unify, compare, index or init procedures.
(
TokenName = "pproc",
TokenListRest =
token_cons(name(Name), _,
token_cons(ArityToken, _,
token_cons(ModeToken, _,
token_nil))),
decimal_token_to_int(ArityToken, Arity),
decimal_token_to_int(ModeToken, Mode),
ProcLabel = ordinary_proc_label(CurModuleNameSym, pf_predicate,
CurModuleNameSym, Name, Arity, Mode)
;
TokenName = "fproc",
TokenListRest =
token_cons(name(Name), _,
token_cons(ArityToken, _,
token_cons(ModeToken, _,
token_nil))),
decimal_token_to_int(ArityToken, Arity),
decimal_token_to_int(ModeToken, Mode),
ProcLabel = ordinary_proc_label(CurModuleNameSym, pf_function,
CurModuleNameSym, Name, Arity, Mode)
;
TokenName = "pprocdecl",
TokenListRest =
token_cons(name(DeclModuleName), _,
token_cons(name(Name), _,
token_cons(ArityToken, _,
token_cons(ModeToken, _,
token_nil)))),
decimal_token_to_int(ArityToken, Arity),
decimal_token_to_int(ModeToken, Mode),
DeclModuleNameSym = string_to_sym_name(DeclModuleName),
ProcLabel = ordinary_proc_label(CurModuleNameSym, pf_predicate,
DeclModuleNameSym, Name, Arity, Mode)
;
TokenName = "fprocdecl",
TokenListRest =
token_cons(name(DeclModuleName), _,
token_cons(name(Name), _,
token_cons(ArityToken, _,
token_cons(ModeToken, _,
token_nil)))),
decimal_token_to_int(ArityToken, Arity),
decimal_token_to_int(ModeToken, Mode),
DeclModuleNameSym = string_to_sym_name(DeclModuleName),
ProcLabel = ordinary_proc_label(CurModuleNameSym, pf_function,
DeclModuleNameSym, Name, Arity, Mode)
)
then
ProcLabelInContext = proc_label_in_context(CurModuleNameSym,
CurFileName, ProcLabel),
% For whatever reason some of the trace counts for a single
% procedure or function can be split over multiple spans.
% We collate them as if they appeared in a single span.
( if map.remove(ProcLabelInContext, ProbeCounts, !TraceCounts) then
StartCounts = ProbeCounts
else
StartCounts = map.init
),
read_proc_trace_counts_2(InputStream, ProcLabelInContext,
StartCounts, !TraceCounts, !IO)
else
string.format("parse error on line %d of execution trace",
[i(HeaderLineNumber)], Message),
throw(trace_count_syntax_error(Message))
)
else
string.format("parse error on line %d of execution trace",
[i(HeaderLineNumber)], Message),
throw(trace_count_syntax_error(Message))
).
:- pred read_proc_trace_counts_2(io.text_input_stream::in,
proc_label_in_context::in, proc_trace_counts::in,
trace_counts::in, trace_counts::out, io::di, io::uo) is det.
read_proc_trace_counts_2(InputStream, ProcLabelInContext,
ProcCounts0, !TraceCounts, !IO) :-
io.read_line_as_string(InputStream, Result, !IO),
(
Result = ok(Line),
( if
parse_path_port_line(Line, PathPort, LineNumber, ExecCount,
NumTests)
then
LineNoAndCount =
line_no_and_count(LineNumber, ExecCount, NumTests),
map.det_insert(PathPort, LineNoAndCount, ProcCounts0, ProcCounts),
read_proc_trace_counts_2(InputStream, ProcLabelInContext,
ProcCounts, !TraceCounts, !IO)
else
map.det_insert(ProcLabelInContext, ProcCounts0, !TraceCounts),
io.get_line_number(InputStream, LineNumber, !IO),
CurModuleNameSym = ProcLabelInContext ^ context_module_symname,
CurFileName = ProcLabelInContext ^ context_filename,
read_proc_trace_counts(InputStream, LineNumber, Line,
CurModuleNameSym, CurFileName, !TraceCounts, !IO)
)
;
Result = eof,
map.det_insert(ProcLabelInContext, ProcCounts0, !TraceCounts)
;
Result = error(Error),
throw(Error)
).
:- pred parse_path_port_line(string::in, path_port::out, int::out, int::out,
int::out) is semidet.
parse_path_port_line(Line, PathPort, LineNumber, ExecCount, NumTests) :-
Words = string.words(Line),
( if
Words = [Word1, LineNumberStr | Rest],
( if string_to_trace_port(Word1, Port) then
PathPortPrime = port_only(Port)
else if Path = string_to_goal_path(Word1) then
PathPortPrime = path_only(Path)
else
fail
),
string.to_int(LineNumberStr, LineNumberPrime),
parse_path_port_line_rest(Rest, ExecCountPrime, NumTestsPrime)
then
PathPort = PathPortPrime,
LineNumber = LineNumberPrime,
ExecCount = ExecCountPrime,
NumTests = NumTestsPrime
else
Words = [PortStr, PathStr, LineNumberStr | Rest],
string_to_trace_port(PortStr, Port),
Path = string_to_goal_path(PathStr),
PathPort = port_and_path(Port, Path),
string.to_int(LineNumberStr, LineNumber),
parse_path_port_line_rest(Rest, ExecCount, NumTests)
).
:- pred parse_path_port_line_rest(list(string)::in, int::out, int::out)
is semidet.
parse_path_port_line_rest(Rest, ExecCount, NumTests) :-
(
Rest = [],
ExecCount = 0,
NumTests = 1
;
Rest = [ExecCountStr],
string.to_int(ExecCountStr, ExecCount),
NumTests = 1
;
Rest = [ExecCountStr, NumTestsStr],
string.to_int(ExecCountStr, ExecCount),
string.to_int(NumTestsStr, NumTests)
).
%---------------------------------------------------------------------------%
read_trace_counts_source(FileName, Result, !IO) :-
read_trace_counts(FileName, ReadTCResult, !IO),
(
ReadTCResult = ok(FileType, TraceCount),
Result = list_ok(FileType, TraceCount)
;
ReadTCResult = io_error(IOError),
ErrMsg = io.error_message(IOError),
Result = list_error_message("I/O error reading file " ++
"`" ++ FileName ++ "': " ++ ErrMsg)
;
ReadTCResult = open_error(IOError),
ErrMsg = io.error_message(IOError),
Result = list_error_message("I/O error opening file " ++
"`" ++ FileName ++ "': " ++ ErrMsg)
;
ReadTCResult = syntax_error(ErrMsg),
Result = list_error_message("Syntax error in file `" ++
FileName ++ "': " ++ ErrMsg)
;
ReadTCResult = error_message(ErrMsg),
Result = list_error_message("Error reading trace counts " ++
"from file `" ++ FileName ++ "': " ++ ErrMsg)
).
read_trace_counts_list(ShowProgress, FileName, Result, !IO) :-
io.open_input(FileName, OpenResult, !IO),
(
OpenResult = ok(FileStream),
read_trace_counts_list_stream(ShowProgress, union_file(0, []),
map.init, FileName, FileStream, Result, !IO)
% XXX Is there some reason why we do not close FileStream?
;
OpenResult = error(IOError),
Result = list_error_message("Error opening file `" ++ FileName ++
"': " ++ string.string(IOError))
).
% Same as read_trace_counts_list/5, but read the filenames containing
% the trace_counts from the given stream. MainFileName is the
% name of the file being read and is only used for error messages.
%
:- pred read_trace_counts_list_stream(maybe(io.text_output_stream)::in,
trace_count_file_type::in, trace_counts::in, string::in,
io.input_stream::in, read_trace_counts_list_result::out,
io::di, io::uo) is det.
read_trace_counts_list_stream(ShowProgress, FileType0, TraceCounts0,
MainFileName, Stream, Result, !IO) :-
io.read_line_as_string(Stream, ReadResult, !IO),
(
ReadResult = ok(Line),
% Remove trailing whitespace:
FileName = string.rstrip(Line),
( if
% Ignore blank lines.
FileName = ""
then
read_trace_counts_list_stream(ShowProgress, FileType0,
TraceCounts0, MainFileName, Stream, Result, !IO)
else
(
ShowProgress = yes(ProgressStream),
io.write_string(ProgressStream, FileName, !IO),
io.nl(ProgressStream, !IO)
;
ShowProgress = no
),
read_trace_counts(FileName, ReadTCResult, !IO),
(
ReadTCResult = ok(FileType1, TraceCounts1),
summarize_trace_counts_list([TraceCounts0, TraceCounts1],
TraceCounts),
FileType = sum_trace_count_file_type(FileType0, FileType1),
read_trace_counts_list_stream(ShowProgress, FileType,
TraceCounts, MainFileName, Stream, Result, !IO)
;
ReadTCResult = io_error(IOError),
ErrMsg = io.error_message(IOError),
Result = list_error_message("I/O error reading file " ++
"`" ++ FileName ++ "': " ++ ErrMsg)
;
ReadTCResult = open_error(IOError),
ErrMsg = io.error_message(IOError),
Result = list_error_message("I/O error opening file " ++
"`" ++ FileName ++ "': " ++ ErrMsg)
;
ReadTCResult = syntax_error(ErrMsg),
Result = list_error_message("Syntax error in file `" ++
FileName ++ "': " ++ ErrMsg)
;
ReadTCResult = error_message(ErrMsg),
Result = list_error_message("Error reading trace counts " ++
"from file `" ++ FileName ++ "': " ++ ErrMsg)
)
)
;
ReadResult = error(Error),
Result = list_error_message("IO error reading file " ++ "`" ++
MainFileName ++ "': " ++ string.string(Error))
;
ReadResult = eof,
Result = list_ok(FileType0, TraceCounts0)
).
:- func string_to_goal_path(string) = reverse_goal_path is semidet.
string_to_goal_path(String) = Path :-
string.prefix(String, "<"),
string.suffix(String, ">"),
string.length(String, Length),
string.between(String, 1, Length - 1, SubString),
rev_goal_path_from_string(SubString, Path).
:- pred decimal_token_to_int(token::in, int::out) is semidet.
decimal_token_to_int(Token, Int) :-
Token = integer(base_10, Integer, signed, size_word),
integer.to_int(Integer, Int).
%---------------------------------------------------------------------------%
read_and_union_trace_counts(ShowProgress, Files, NumTests, TestKinds,
TraceCounts, MaybeError, !IO) :-
read_and_union_trace_counts_2(ShowProgress, Files,
union_file(0, []), FileType, map.init, TraceCounts, MaybeError, !IO),
(
FileType = union_file(NumTests, TestKindList),
set.list_to_set(TestKindList, TestKinds)
;
FileType = single_file(_),
error("read_and_union_trace_counts: single_file")
;
FileType = diff_file(_, _),
error("read_and_union_trace_counts: diff_file")
).
:- pred read_and_union_trace_counts_2(maybe(io.text_output_stream)::in,
list(string)::in, trace_count_file_type::in, trace_count_file_type::out,
trace_counts::in, trace_counts::out, maybe(string)::out,
io::di, io::uo) is det.
read_and_union_trace_counts_2(_, [], !FileType, !TraceCounts, no, !IO).
read_and_union_trace_counts_2(ShowProgress, [FileName | FileNames],
!FileType, !TraceCounts, MaybeError, !IO) :-
(
ShowProgress = yes(ProgressStream),
io.write_string(ProgressStream, FileName, !IO),
io.nl(ProgressStream, !IO)
;
ShowProgress = no
),
read_trace_counts_source(FileName, TCResult, !IO),
(
TCResult = list_ok(FileType, NewTraceCounts),
summarize_trace_counts_list([!.TraceCounts, NewTraceCounts],
!:TraceCounts),
!:FileType = sum_trace_count_file_type(!.FileType, FileType),
read_and_union_trace_counts_2(ShowProgress, FileNames,
!FileType, !TraceCounts, MaybeError, !IO)
;
TCResult = list_error_message(Message),
MaybeError = yes(Message)
).
%---------------------------------------------------------------------------%
:- func trace_count_file_id = string.
trace_count_file_id = "Mercury trace counts file".
%---------------------------------------------------------------------------%
write_trace_counts_to_file(FileType, TraceCounts, FileName, Result, !IO) :-
io.open_output(FileName, FileResult, !IO),
(
FileResult = ok(FileStream),
Result = ok,
io.write_string(FileStream, trace_count_file_id, !IO),
io.nl(FileStream, !IO),
write_trace_counts(FileStream, FileType, TraceCounts, !IO),
io.close_output(FileStream, !IO)
;
FileResult = error(Error),
Result = error(Error)
).
:- pred write_trace_counts(io.text_output_stream::in,
trace_count_file_type::in, trace_counts::in, io::di, io::uo) is det.
write_trace_counts(OutputStream, FileType, TraceCounts, !IO) :-
io.write(OutputStream, FileType, !IO),
io.write_string(OutputStream, ".\n", !IO),
map.foldl3(write_proc_label_and_file_trace_counts(OutputStream),
TraceCounts, unqualified(""), _, "", _, !IO).
:- pred write_proc_label_and_file_trace_counts(io.text_output_stream::in,
proc_label_in_context::in, proc_trace_counts::in,
sym_name::in, sym_name::out, string::in, string::out,
io::di, io::uo) is det.
write_proc_label_and_file_trace_counts(OutputStream, ProcLabelInContext,
PathPortCounts, !CurModuleNameSym, !CurFileName, !IO) :-
ProcLabelInContext = proc_label_in_context(ModuleNameSym, FileName,
ProcLabel),
( if ModuleNameSym = !.CurModuleNameSym then
true
else
ModuleName = sym_name_to_string(ModuleNameSym),
io.write_string(OutputStream, "module ", !IO),
term_io.quote_atom(OutputStream, ModuleName, !IO),
io.write_string(OutputStream, "\n", !IO),
!:CurModuleNameSym = ModuleNameSym
),
( if FileName = !.CurFileName then
true
else
io.write_string(OutputStream, "file ", !IO),
term_io.quote_atom(OutputStream, FileName, !IO),
io.write_string(OutputStream, "\n", !IO),
!:CurFileName = FileName
),
write_proc_label_and_check(OutputStream, ModuleNameSym, ProcLabel, !IO),
map.foldl(write_path_port_count(OutputStream), PathPortCounts, !IO).
:- pred write_proc_label_and_check(io.text_output_stream::in, sym_name::in,
proc_label::in, io::di, io::uo) is det.
write_proc_label_and_check(OutputStream, ModuleNameSym, ProcLabel, !IO) :-
(
ProcLabel = ordinary_proc_label(DefModuleSym, _, _, _, _, _),
require(unify(ModuleNameSym, DefModuleSym),
"write_proc_label_and_check: module mismatch")
;
% We don't record trace counts in special preds.
ProcLabel = special_proc_label(_, _, _, _, _, _),
error("write_proc_label: special_pred")
),
write_proc_label(OutputStream, ProcLabel, !IO).
write_proc_label(OutputStream, ProcLabel, !IO) :-
(
ProcLabel = ordinary_proc_label(DefModuleSym, PredOrFunc,
DeclModuleSym, Name, Arity, Mode),
(
PredOrFunc = pf_predicate,
( if DeclModuleSym = DefModuleSym then
io.write_string(OutputStream, "pproc ", !IO)
else
DeclModule = sym_name_to_string(DeclModuleSym),
io.write_string(OutputStream, "pprocdecl ", !IO),
term_io.quote_atom(OutputStream, DeclModule, !IO),
io.write_string(OutputStream, " ", !IO)
)
;
PredOrFunc = pf_function,
( if DeclModuleSym = DefModuleSym then
io.write_string(OutputStream, "fproc ", !IO)
else
DeclModule = sym_name_to_string(DeclModuleSym),
io.write_string(OutputStream, "fprocdecl ", !IO),
term_io.quote_atom(OutputStream, DeclModule, !IO),
io.write_string(OutputStream, " ", !IO)
)
),
term_io.quote_atom(OutputStream, Name, !IO),
io.format(OutputStream, " %d %d\n", [i(Arity), i(Mode)], !IO)
;
% We don't record trace counts in special preds.
ProcLabel = special_proc_label(_, _, _, _, _, _),
error("write_proc_label: special_pred")
).
:- pred write_path_port_count(io.text_output_stream::in,
path_port::in, line_no_and_count::in, io::di, io::uo) is det.
write_path_port_count(OutputStream, PathPort, LineNoAndCount, !IO) :-
LineNoAndCount = line_no_and_count(LineNo, ExecCount, NumTests),
(
PathPort = port_only(Port),
string_to_trace_port(PortStr, Port),
io.format(OutputStream, "%s %d %d %d\n",
[s(PortStr), i(LineNo), i(ExecCount), i(NumTests)], !IO)
;
PathPort = path_only(Path),
io.format(OutputStream, "<%s> %d %d %d\n",
[s(rev_goal_path_to_string(Path)),
i(LineNo), i(ExecCount), i(NumTests)], !IO)
;
PathPort = port_and_path(Port, Path),
string_to_trace_port(PortStr, Port),
io.format(OutputStream, "%s <%s> %d %d %d\n",
[s(PortStr), s(rev_goal_path_to_string(Path)),
i(LineNo), i(ExecCount), i(NumTests)], !IO)
).
%---------------------------------------------------------------------------%
restrict_trace_counts_to_module(ModuleName, TraceCounts0, TraceCounts) :-
map.foldl(restrict_trace_counts_2(ModuleName), TraceCounts0,
map.init, TraceCounts).
:- pred restrict_trace_counts_2(module_name::in, proc_label_in_context::in,
proc_trace_counts::in, trace_counts::in, trace_counts::out) is det.
restrict_trace_counts_2(ModuleName, ProcLabelInContext, ProcCounts,
!TraceCounts) :-
ProcLabel = ProcLabelInContext ^ proc_label,
( if ProcLabel = ordinary_proc_label(ModuleName, _, _, _, _, _) then
map.det_insert(ProcLabelInContext, ProcCounts, !TraceCounts)
else
true
).
%---------------------------------------------------------------------------%
calc_num_tests([]) = 0.
calc_num_tests([FileType | Rest]) =
num_tests_for_file_type(FileType) + calc_num_tests(Rest).
num_tests_for_file_type(union_file(N, _)) = N.
num_tests_for_file_type(single_file(_)) = 1.
num_tests_for_file_type(diff_file(_, _)) = -1.