%---------------------------------------------------------------------------% % 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 io.call_system. :- import_module mercury_term_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.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.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) :- mercury_term_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.text_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. %---------------------------------------------------------------------------% :- end_module mdbcomp.trace_counts. %---------------------------------------------------------------------------%