mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
759 lines
30 KiB
Mathematica
759 lines
30 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, 2021-2026 The Mercury team.
|
|
% This file is distributed under the terms specified in COPYING.LIB.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: read_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.read_trace_counts.
|
|
:- interface.
|
|
|
|
:- import_module mdbcomp.trace_counts.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
:- import_module set.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% read_and_union_trace_counts(ShowProgress, FileNames, NumTests, TestKinds,
|
|
% TraceCounts, MaybeError, !IO):
|
|
%
|
|
% Invoke read_trace_counts_file 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 ShowProgress is yes(Stream), then the name of each file
|
|
% will be printed to 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.
|
|
|
|
%---------------------%
|
|
|
|
:- type read_trace_counts_file_result
|
|
---> rtcf_ok(trace_count_file_type, trace_counts)
|
|
; rtcf_error_message(string).
|
|
|
|
% read_trace_counts_file(FileName, Result, !IO):
|
|
%
|
|
% Read in trace counts stored in a given trace count file.
|
|
%
|
|
:- pred read_trace_counts_file(string::in,
|
|
read_trace_counts_file_result::out, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module mdbcomp.goal_path.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
|
|
:- import_module exception.
|
|
:- import_module int.
|
|
:- import_module integer.
|
|
:- import_module io.call_system.
|
|
:- import_module map.
|
|
:- import_module mercury_term_lexer.
|
|
:- import_module mercury_term_parser.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term_conversion.
|
|
:- import_module univ.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
read_and_union_trace_counts(ShowProgress, Files, NumTests, TestKinds,
|
|
TraceCounts, MaybeError, !IO) :-
|
|
read_and_union_trace_counts_loop(ShowProgress, Files,
|
|
union_file(0, []), FileType, map.init, TraceCounts, MaybeError, !IO),
|
|
FileType = union_file(NumTests, TestKindList),
|
|
set.list_to_set(TestKindList, TestKinds).
|
|
|
|
:- pred read_and_union_trace_counts_loop(maybe(io.text_output_stream)::in,
|
|
list(string)::in,
|
|
trace_count_file_type::in(union_file),
|
|
trace_count_file_type::out(union_file),
|
|
trace_counts::in, trace_counts::out, maybe(string)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
read_and_union_trace_counts_loop(_, [], !FileType, !TraceCounts, no, !IO).
|
|
read_and_union_trace_counts_loop(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_file(FileName, TCResult, !IO),
|
|
(
|
|
TCResult = rtcf_ok(FileType, NewTraceCounts),
|
|
summarize_trace_counts_list([!.TraceCounts, NewTraceCounts],
|
|
!:TraceCounts),
|
|
!:FileType = sum_trace_count_file_type(!.FileType, FileType),
|
|
read_and_union_trace_counts_loop(ShowProgress, FileNames,
|
|
!FileType, !TraceCounts, MaybeError, !IO)
|
|
;
|
|
TCResult = rtcf_error_message(Message),
|
|
MaybeError = yes(Message)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
read_trace_counts_file(FileName, Result, !IO) :-
|
|
read_trace_counts_base(FileName, ReadTCResult, !IO),
|
|
old_read_trace_counts_base(FileName, OldReadTCResult, !IO),
|
|
( if ReadTCResult = OldReadTCResult then
|
|
(
|
|
ReadTCResult = rtc_ok(FileType, TraceCount),
|
|
Result = rtcf_ok(FileType, TraceCount)
|
|
;
|
|
ReadTCResult = rtc_error(ReadTCError),
|
|
ErrorMsg = read_trace_counts_error_to_str(FileName, ReadTCError),
|
|
Result = rtcf_error_message(ErrorMsg)
|
|
)
|
|
else
|
|
unexpected($pred, "ReadTCResult != OldReadTCResult")
|
|
).
|
|
|
|
:- func read_trace_counts_error_to_str(string, read_trace_counts_error)
|
|
= string.
|
|
|
|
read_trace_counts_error_to_str(FileName, ReadTCError) = ErrorMsg :-
|
|
(
|
|
ReadTCError = rtce_open_error(IOError),
|
|
IOErrorMsg = io.error_message(IOError),
|
|
string.format("I/O error opening file `%s': %s",
|
|
[s(FileName), s(IOErrorMsg)], ErrorMsg)
|
|
;
|
|
ReadTCError = rtce_io_error(IOError),
|
|
IOErrorMsg = io.error_message(IOError),
|
|
string.format("I/O error reading file `%s': %s",
|
|
[s(FileName), s(IOErrorMsg)], ErrorMsg)
|
|
;
|
|
ReadTCError = rtce_syntax_error(SyntaxMsg),
|
|
string.format("Syntax error in file `%s': %s",
|
|
[s(FileName), s(SyntaxMsg)], ErrorMsg)
|
|
;
|
|
ReadTCError = rtce_error_message(ErrMsg),
|
|
string.format("Error reading trace counts from in file `%s': %s",
|
|
[s(FileName), s(ErrMsg)], ErrorMsg)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type read_trace_counts_result
|
|
---> rtc_ok(trace_count_file_type, trace_counts)
|
|
; rtc_error(read_trace_counts_error).
|
|
|
|
:- type read_trace_counts_error
|
|
---> rtce_open_error(io.error)
|
|
; rtce_io_error(io.error)
|
|
; rtce_syntax_error(string)
|
|
; rtce_error_message(string).
|
|
|
|
% read_trace_counts_base(FileName, Result, !IO):
|
|
%
|
|
% Read in the trace counts stored in FileName. Return detailed info
|
|
% about any errors.
|
|
%
|
|
% XXX The only caller of this predicate, read_trace_counts_file,
|
|
% throws away all the details in these errors. Therefore
|
|
% representing errors as simple strings inside this predicate
|
|
% would allow read_trace_counts_file and read_trace_counts_base
|
|
% to be merged into one predicate.
|
|
%
|
|
:- pred read_trace_counts_base(string::in, read_trace_counts_result::out,
|
|
io::di, io::uo) is det.
|
|
|
|
read_trace_counts_base(FileName, ReadResult, !IO) :-
|
|
% XXX We should be using zcat here, to avoid deleting the gzipped file
|
|
% and having to recreate it again. Unfortunately, Mercury does not 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.read_named_file_as_lines_wf(ActualFileName, Result, !IO),
|
|
(
|
|
Result = ok(Lines1),
|
|
( if
|
|
Lines1 = [Line1 | Lines2],
|
|
Line1 = trace_count_file_id
|
|
then
|
|
read_file_type_trace_counts(FileName, 2, Lines2, ReadResult, !IO)
|
|
else
|
|
ReadError = rtce_syntax_error("no trace count file id"),
|
|
ReadResult = rtc_error(ReadError)
|
|
)
|
|
;
|
|
Result = error(IOError),
|
|
ReadError = rtce_open_error(IOError),
|
|
ReadResult = rtc_error(ReadError)
|
|
),
|
|
( if GzipCmd = "" then
|
|
true
|
|
else
|
|
io.call_system.call_system(GzipCmd, _ZipResult, !IO)
|
|
).
|
|
|
|
:- pred read_file_type_trace_counts(string::in, int::in, list(string)::in,
|
|
read_trace_counts_result::out, io::di, io::uo) is det.
|
|
|
|
read_file_type_trace_counts(FileName, CurLineNum, Lines0, ReadResult, !IO) :-
|
|
(
|
|
Lines0 = [],
|
|
ReadError = rtce_syntax_error("no info on trace count file type"),
|
|
ReadResult = rtc_error(ReadError)
|
|
;
|
|
Lines0 = [FileTypeLine | Lines1],
|
|
string.length(FileTypeLine, FileTypeLineLen),
|
|
StartPos = init_posn,
|
|
mercury_term_lexer.string_get_token_list_max(FileTypeLine,
|
|
FileTypeLineLen, FileTypeTokens, StartPos, _EndPos),
|
|
mercury_term_parser.parse_tokens(FileName, FileTypeTokens,
|
|
FileTypeResult),
|
|
( if
|
|
FileTypeResult = term(_VarSet : varset, FileTypeTerm),
|
|
term_to_type(FileTypeTerm, FileType)
|
|
then
|
|
% The code in runtime/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.
|
|
TCModuleNameSym0 = unqualified(""),
|
|
TCFileName0 = "",
|
|
map.init(TraceCounts0),
|
|
read_proc_trace_counts(FileName, CurLineNum + 1, Lines1,
|
|
TCModuleNameSym0, TCFileName0, MaybeError,
|
|
TraceCounts0, TraceCounts, !IO),
|
|
(
|
|
MaybeError = no,
|
|
ReadResult = rtc_ok(FileType, TraceCounts)
|
|
;
|
|
MaybeError = yes(ReadError),
|
|
ReadResult = rtc_error(ReadError)
|
|
)
|
|
else
|
|
ReadError = rtce_syntax_error("no info on trace count file type"),
|
|
ReadResult = rtc_error(ReadError)
|
|
)
|
|
).
|
|
|
|
:- pred read_proc_trace_counts(string::in, int::in, list(string)::in,
|
|
sym_name::in, string::in, maybe(read_trace_counts_error)::out,
|
|
trace_counts::in, trace_counts::out, io::di, io::uo) is det.
|
|
|
|
read_proc_trace_counts(FileName, LineNumber0, Lines0,
|
|
TCModuleNameSym0, TCFileName0, MaybeError, !TraceCounts, !IO) :-
|
|
(
|
|
Lines0 = [],
|
|
MaybeError = no
|
|
;
|
|
Lines0 = [Line0 | Lines1],
|
|
LineNumber1 = LineNumber0 + 1,
|
|
string.length(Line0, Line0Len),
|
|
StartPos = posn(LineNumber0, 1, 0),
|
|
mercury_term_lexer.string_get_token_list_max(Line0, Line0Len,
|
|
TokenList, StartPos, _EndPos),
|
|
( if TokenList = token_cons(name(TokenName), _, TokenListRest) then
|
|
( if
|
|
TokenName = "module",
|
|
TokenListRest =
|
|
token_cons(name(NextModuleName), _,
|
|
token_nil)
|
|
then
|
|
TCModuleNameSym1 = string_to_sym_name(NextModuleName),
|
|
read_proc_trace_counts(FileName, LineNumber1, Lines1,
|
|
TCModuleNameSym1, TCFileName0, MaybeError,
|
|
!TraceCounts, !IO)
|
|
else if
|
|
TokenName = "file",
|
|
TokenListRest =
|
|
token_cons(name(TCFileName1), _,
|
|
token_nil)
|
|
then
|
|
read_proc_trace_counts(FileName, LineNumber1, Lines1,
|
|
TCModuleNameSym0, TCFileName1, MaybeError,
|
|
!TraceCounts, !IO)
|
|
else if
|
|
% At the moment runtime/mercury_trace_base.c does not 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(TCModuleNameSym0,
|
|
pf_predicate, TCModuleNameSym0, 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(TCModuleNameSym0,
|
|
pf_function, TCModuleNameSym0, 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(TCModuleNameSym0,
|
|
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(TCModuleNameSym0,
|
|
pf_function, DeclModuleNameSym, Name, Arity, Mode)
|
|
)
|
|
then
|
|
ProcLabelInContext = proc_label_in_context(TCModuleNameSym0,
|
|
TCFileName0, 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
|
|
ProcCounts1 = ProbeCounts
|
|
else
|
|
ProcCounts1 = map.init
|
|
),
|
|
read_proc_path_trace_counts(ProcLabelInContext,
|
|
LineNumber1, LineNumber2, Lines1, Lines2,
|
|
ProcCounts1, ProcCounts, !IO),
|
|
map.det_insert(ProcLabelInContext, ProcCounts, !TraceCounts),
|
|
|
|
read_proc_trace_counts(FileName, LineNumber2, Lines2,
|
|
TCModuleNameSym0, TCFileName0, MaybeError,
|
|
!TraceCounts, !IO)
|
|
else
|
|
string.format("parse error on line %d of execution trace",
|
|
[i(LineNumber0)], Message),
|
|
MaybeError = yes(rtce_syntax_error(Message))
|
|
)
|
|
else
|
|
string.format("parse error on line %d of execution trace",
|
|
[i(LineNumber0)], Message),
|
|
MaybeError = yes(rtce_syntax_error(Message))
|
|
)
|
|
).
|
|
|
|
:- pred read_proc_path_trace_counts(proc_label_in_context::in,
|
|
int::in, int::out, list(string)::in, list(string)::out,
|
|
proc_trace_counts::in, proc_trace_counts::out, io::di, io::uo) is det.
|
|
|
|
read_proc_path_trace_counts(ProcLabelInContext, LineNumber0, LineNumber,
|
|
Lines0, Lines, ProcCounts0, ProcCounts, !IO) :-
|
|
(
|
|
Lines0 = [],
|
|
LineNumber = LineNumber0,
|
|
Lines = Lines0,
|
|
ProcCounts = ProcCounts0
|
|
;
|
|
Lines0 = [Line0 | Lines1],
|
|
LineNumber1 = LineNumber0 + 1,
|
|
( if
|
|
parse_path_port_line(Line0, PathPort, TCLineNumber, ExecCount,
|
|
NumTests)
|
|
then
|
|
LineNoAndCount =
|
|
line_no_and_count(TCLineNumber, ExecCount, NumTests),
|
|
map.det_insert(PathPort, LineNoAndCount, ProcCounts0, ProcCounts1),
|
|
read_proc_path_trace_counts(ProcLabelInContext,
|
|
LineNumber1, LineNumber, Lines1, Lines,
|
|
ProcCounts1, ProcCounts, !IO)
|
|
else
|
|
LineNumber = LineNumber0,
|
|
Lines = Lines0,
|
|
ProcCounts = ProcCounts0
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred old_read_trace_counts_base(string::in, read_trace_counts_result::out,
|
|
io::di, io::uo) is det.
|
|
|
|
old_read_trace_counts_base(FileName, ReadResult, !IO) :-
|
|
% XXX We should be using zcat here, to avoid deleting the gzipped file
|
|
% and having to recreate it again. Unfortunately, Mercury does not 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] (
|
|
old_read_trace_counts_from_stream(FileStream, ReadResult, !IO)
|
|
)
|
|
else
|
|
ReadError = rtce_syntax_error("no trace count file id"),
|
|
ReadResult = rtc_error(ReadError)
|
|
),
|
|
io.close_input(FileStream, !IO)
|
|
;
|
|
Result = error(IOError),
|
|
ReadError = rtce_open_error(IOError),
|
|
ReadResult = rtc_error(ReadError)
|
|
),
|
|
( if GzipCmd = "" then
|
|
true
|
|
else
|
|
io.call_system.call_system(GzipCmd, _ZipResult, !IO)
|
|
).
|
|
|
|
:- type trace_count_syntax_error
|
|
---> trace_count_syntax_error(string).
|
|
|
|
:- pred old_read_trace_counts_from_stream(io.text_input_stream::in,
|
|
read_trace_counts_result::out, io::di, io::uo) is cc_multi.
|
|
|
|
old_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(old_read_trace_counts_setup(InputStream, map.init),
|
|
Result, !IO),
|
|
(
|
|
Result = succeeded(TraceCounts),
|
|
ReadResult = rtc_ok(FileType, TraceCounts)
|
|
;
|
|
Result = exception(Exception),
|
|
( if Exception = univ(IOError) then
|
|
ReadError = rtce_io_error(IOError)
|
|
else if Exception = univ(Message) then
|
|
ReadError = rtce_error_message(Message)
|
|
else if Exception = univ(trace_count_syntax_error(Error)) then
|
|
ReadError = rtce_syntax_error(Error)
|
|
else
|
|
unexpected($pred,
|
|
"unexpected exception type: " ++ string(Exception))
|
|
),
|
|
ReadResult = rtc_error(ReadError)
|
|
)
|
|
else
|
|
ReadError = rtce_syntax_error("no info on trace count file type"),
|
|
ReadResult = rtc_error(ReadError)
|
|
)
|
|
;
|
|
( FileTypeResult = eof
|
|
; FileTypeResult = error(_, _)
|
|
),
|
|
ReadError = rtce_syntax_error("no info on trace count file type"),
|
|
ReadResult = rtc_error(ReadError)
|
|
).
|
|
|
|
:- pred old_read_trace_counts_setup(io.text_input_stream::in,
|
|
trace_counts::in, trace_counts::out, io::di, io::uo) is det.
|
|
|
|
old_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 = "",
|
|
old_read_proc_trace_counts(InputStream, LineNumber, Line,
|
|
CurModuleNameSym, CurFileName, !TraceCounts, !IO)
|
|
;
|
|
Result = eof
|
|
;
|
|
Result = error(Error),
|
|
throw(Error)
|
|
).
|
|
|
|
:- pred old_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.
|
|
|
|
old_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),
|
|
old_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),
|
|
old_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
|
|
),
|
|
old_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 old_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.
|
|
|
|
old_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),
|
|
old_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,
|
|
old_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 string_to_goal_path(Word1, Path) 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),
|
|
string_to_goal_path(PathStr, Path),
|
|
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)
|
|
).
|
|
|
|
:- pred string_to_goal_path(string::in, reverse_goal_path::out) 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).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module mdbcomp.read_trace_counts.
|
|
%---------------------------------------------------------------------------%
|