%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2008-2011 The University of Melbourne.
% Copyright (C) 2014-2015, 2017-2018, 2021, 2023 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: feedback.m.
% Main author: pbone.
%
% This module defines data structures for representing feedback information
% in Mercury code, as well as procedures for reading and writing the feedback
% files that represent such information on disk.
%
% This module is included both in the compiler and in the tools that
% generate this feedback data.
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- module mdbcomp.feedback.

:- interface.

% If you add any modules here, you should update the lists in
% deep_profiler/Mmakefile and slice/Mmakefile.
:- include_module automatic_parallelism.

:- import_module mdbcomp.feedback.automatic_parallelism.
:- import_module mdbcomp.program_representation.

:- import_module assoc_list.
:- import_module io.
:- import_module maybe.

%---------------------------------------------------------------------------%

    % The feedback_info type stores the data that may be fed back
    % into the compiler. For a detailed description, see the comment
    % on the non-abstract definition in the implementation section.
    %
:- type feedback_info.

    % init_feedback_info(ProfiledProgramName) = FeedbackInfo:
    %
    % Create a new empty feedback info structure, recording that it is
    % intended to hold feedback information for the program with the given
    % name.
    %
    % XXX The predicates that add information to feedback_infos now require
    % their callers to specify what profiled program their information is for,
    % and this is checked against the profiled program name in the
    % feedback_info. We could instead initialize feedback_infos *without*
    % storing the program name, and record that name on the first update
    % of the feedback_info instead. This would remove one source of possible
    % name mismatches.
    %
:- func init_feedback_info(string) = feedback_info.

%---------------------------------------------------------------------------%
%
% The kinds of information that we can record in a feedback file.
%
% Historically, we also supported a feedback type that was used by
% Jerome Tannier's attempt at discovering a useful set of conjunctions
% to parallelise. However, this early attempt at automatic parallelisation
% yielded results that were much inferior to our current system, so it
% should interest only historians. The code supporting Tanner's feedback
% type was removed from the feedback system on 2014 december 1;
% if you want it, look in the git archives for commits on that date.
%

    % Values of this type represent a list of candidate conjunctions
    % for implicit parallelism.
    %
:- type feedback_info_candidate_parallel_conjunctions
    --->    feedback_info_candidate_parallel_conjunctions(
                cpc_parameters      :: candidate_par_conjunctions_params,

                % For each procedure that has some candidate parallel
                % conjunctions, list those candidates.
                cpc_conjunctions    :: assoc_list(string_proc_label,
                                        candidate_par_conjunctions_proc)
            ).

%---------------------------------------------------------------------------%
%
% The getter predicates of feedback_info.
%

    % Get the name of the program whose profiled execution the given
    % feedback_info was derived from.
    %
:- func get_feedback_profiled_program_name(feedback_info) = string.

    % get_feedback_*(Info) = Data:
    %
    % Get any feedback data of the given kind from the given feedback_info.
    %
:- func get_feedback_candidate_parallel_conjunctions(feedback_info) =
    maybe(feedback_info_candidate_parallel_conjunctions).

    % Get all the information held in the given feedback info. Callers should
    % call this predicate, instead of the ones above, if they want to guarantee
    % that even if the feedback_info type is updated, they will still get
    % all the information present in the given feedback_info.
    %
:- pred get_all_feedback_info(feedback_info::in,
    string::out, maybe(feedback_info_candidate_parallel_conjunctions)::out)
    is det.

%---------------------------------------------------------------------------%
%
% The setter predicates of feedback_info.
%

    % add_feedback_*(ProfiledProgramName, Data, !Info)
    %
    % Put Data into the selected field of the feedback_info, which must hold
    % information about ProfiledProgramName. Requires the old feedback_info
    % to have no previous information in that field.
    %
:- pred add_feedback_candidate_parallel_conjunctions(string::in,
    feedback_info_candidate_parallel_conjunctions::in,
    feedback_info::in, feedback_info::out) is det.

    % replace_feedback_*(ProfiledProgramName, Data, !Info)
    %
    % Put Data into the selected field of the feedback_info, which must hold
    % information about ProfiledProgramName. Requires the old feedback_info
    % Any previous information in that field of feedback_info
    % is replaced by Data.
    %
:- pred replace_feedback_candidate_parallel_conjunctions(string::in,
    feedback_info_candidate_parallel_conjunctions::in,
    feedback_info::in, feedback_info::out) is det.

%---------------------------------------------------------------------------%
%
% Reading in feedback files.
%

:- type feedback_read_result(T) == maybe_error(T, feedback_read_error).

:- type feedback_read_error
    --->    fre_open_error(io.error)
    ;       fre_read_error(io.error)
    ;       fre_parse_error(
                fre_pe_message          :: string,
                fre_pe_line_no          :: int
            )
    ;       fre_unexpected_eof
    ;       fre_incorrect_version(string)
    ;       fre_incorrect_first_line
    ;       fre_incorrect_profiled_program_name(
                fre_ippn_expected       :: string,
                fre_ippn_got            :: string
            )
    ;       fre_repeated_component(
                fre_component_name      :: string
            ).

    % feedback_read_error_message_string(File, Error, Message):
    %
    % Create a string describing the read error.
    %
:- pred feedback_read_error_message_string(string::in, feedback_read_error::in,
    string::out) is det.

    % read_or_create_feedback_file(Path, ProfiledProgramName, Result, !IO):
    %
    % If Path stores a feedback file for ProfiledProgramName, read it in.
    % If it does not exist, return an empty feedback state for
    % ProfiledProgramName, and return that. Return an error if Path does exist,
    % but either does not contain a valid feedback file, or contains a valid
    % feedback file for some other profiled program.
    %
    % ProfiledProgramName is the name of the program whose profiled execution
    % the feedback file was (or should be) generated from.
    % We record this to avoid mixing the feedback information of unrelated
    % executables.
    %
:- pred read_or_create_feedback_file(string::in, string::in,
    feedback_read_result(feedback_info)::out, io::di, io::uo) is det.

    % read_feedback_file(Path, MaybeProfiledProgramName, FeedbackInfo, !IO):
    %
    % This predicate attempts to read in feedback data from Path. If
    % MaybeProfiledProgramName is yes(ProfiledProgramName), generate an
    % error if the feedback data is not for ProfiledProgramName.
    %
    % This predicate should be called once per compiler invocation.
    %
:- pred read_feedback_file(string::in, maybe(string)::in,
    feedback_read_result(feedback_info)::out, io::di, io::uo) is det.

%---------------------------------------------------------------------------%
%
% Writing out feedback files.
%

:- type feedback_write_result
    --->    fwr_ok
    ;       fwr_open_error(io.error)
    ;       fwr_write_error(io.error).

    % write_feedback_file(Path, FeedbackInfo, FeedbackWriteResult, !IO):
    %
    % Write out the feedback data in FeedbackWriteResult to Path.
    %
:- pred write_feedback_file(string::in, feedback_info::in,
    feedback_write_result::out, io::di, io::uo) is det.

%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- implementation.

:- import_module list.
:- import_module require.
:- import_module string.

% There are several kinds of information that we may be interested in
% feeding back to the compiler. Our design for representing feedback
% information allows for a tool to generate an arbitrary subset of
% the possible kinds of information. A feedback-generating tool will
% put each kind of information that it generates in its assigned slot
% with a yes(...) wrapped around it, while it will put a "no" in all
% other slots.
%
% If you want add a new kind of feedback information, you will need to
%
%   - add a new maybe field to the feedback_info type;
%   - add a getter predicate and two setter predicates for that field;
%   - update the init_feedback_info predicate;
%   - update the get_all_feedback_info predicate;
%   - update the print_feedback_report predicate;
%   - add a new alternative to the feedback_component_wrapper type;
%   - add code to add_feedback_components to read in the new kind of
%     information;
%   - add code to actually_write_feedback_file to write out the new kind of
%     information;
%   - increment the file format version number at the bottom of this file.
%
% You will also need to increment the file format version number
% if you change the definition of any of the types referred to, directly
% or indirectly, by the feedback_component_wrapper type, including the types
% in mdbcomp.program_representation.

:- type feedback_info
    --->    feedback_info(
                % The name of the program whose execution generated
                % the profiling data file that the feedback is derived from,
                % and therefore the program whose compilation the feedback
                % is intended for.
                fi_profiled_program_name     :: string,

                % The actual feedback data as read from the feedback file.
                % Should be set to yes(...) iff feedback of the given sort
                % is present in the file.
                fi_maybe_candidate_parallel_conjunctions ::
                        maybe(feedback_info_candidate_parallel_conjunctions)
            ).

:- type feedback_component_wrapper
    --->    fcw_candidate_parallel_conjunctions(
                feedback_info_candidate_parallel_conjunctions
            ).

%---------------------------------------------------------------------------%
%
% Initialization and getter and setter predicates for feedback_infos.
%

init_feedback_info(ProgramName) = feedback_info(ProgramName, no).

get_feedback_profiled_program_name(Info) = Info ^ fi_profiled_program_name.
get_feedback_candidate_parallel_conjunctions(Info) =
    Info ^ fi_maybe_candidate_parallel_conjunctions.

get_all_feedback_info(Info, ProfiledProgramName,
        MaybeCandidateParallelConjs) :-
    Info = feedback_info(ProfiledProgramName, MaybeCandidateParallelConjs).

add_feedback_candidate_parallel_conjunctions(ProfiledProgramName, Data,
        !Info) :-
    expect(unify(!.Info ^ fi_profiled_program_name, ProfiledProgramName),
        $pred, "adding candidate parallel conjunctions for wrong program"),
    expect(unify(!.Info ^ fi_maybe_candidate_parallel_conjunctions, no),
        $pred, "overwriting old candidate_parallel_conjunctions data"),
    !Info ^ fi_maybe_candidate_parallel_conjunctions := yes(Data).

replace_feedback_candidate_parallel_conjunctions(ProfiledProgramName, Data,
        !Info) :-
    expect(unify(!.Info ^ fi_profiled_program_name, ProfiledProgramName),
        $pred, "replacing candidate parallel conjunctions for wrong program"),
    !Info ^ fi_maybe_candidate_parallel_conjunctions := yes(Data).

%---------------------------------------------------------------------------%
%
% Interpreting the errors that can happen when reading in feedback files.
%

feedback_read_error_message_string(File, Error, Message) :-
    (
        ( Error = fre_open_error(Code)
        ; Error = fre_read_error(Code)
        ),
        error_message(Code, MessagePart)
    ;
        Error = fre_parse_error(ParseMessage, Line),
        MessagePart = ParseMessage ++ " on line " ++ string(Line)
    ;
        Error = fre_unexpected_eof,
        MessagePart = "Unexpected end of file"
    ;
        Error = fre_incorrect_version(Expected),
        MessagePart = "Incorrect file format version; expected " ++ Expected
    ;
        Error = fre_incorrect_first_line,
        MessagePart = "Incorrect file format"
    ;
        Error = fre_incorrect_profiled_program_name(Expected, Got),
        MessagePart =
            "The name of the program the feedback is for didn't match,"
            ++ " is this the right feedback file?\n"
            ++ string.format("Expected: '%s' Got: '%s'", [s(Expected), s(Got)])
    ;
        Error = fre_repeated_component(ComponentName),
        MessagePart = "File contains more than one "
            ++ ComponentName ++ " component"
    ),
    string.format("%s: %s\n", [s(File), s(MessagePart)], Message).

%---------------------------------------------------------------------------%
%
% Reading feedback files.
%

read_or_create_feedback_file(Path, ExpectedProfiledProgramName,
        FeedbackResult, !IO) :-
    read_feedback_file(Path, yes(ExpectedProfiledProgramName),
        ReadResult, !IO),
    (
        ReadResult = ok(_Feedback),
        FeedbackResult = ReadResult
    ;
        ReadResult = error(Error),
        (
            % XXX We assume that an open error is probably caused by the file
            % not existing, but we can't be sure because io.error is a string,
            % and the message string for any error may change.
            % XXX Given that ReadResult is given to us by the predicate
            % just below, we could get it to tell us *directly* whether
            % the error is caused by trying to open a non-existent file.
            Error = fre_open_error(_),
            FeedbackResult = ok(
                init_feedback_info(ExpectedProfiledProgramName))
        ;
            ( Error = fre_read_error(_)
            ; Error = fre_parse_error(_, _)
            ; Error = fre_unexpected_eof
            ; Error = fre_incorrect_version(_)
            ; Error = fre_incorrect_first_line
            ; Error = fre_incorrect_profiled_program_name(_, _)
            ; Error = fre_repeated_component(_)
            ),
            FeedbackResult = ReadResult
        )
    ).

read_feedback_file(Path, MaybeExpectedProfiledProgramName,
        ResultFeedbackInfo, !IO) :-
    io.open_input(Path, PathResult, !IO),
    (
        PathResult = ok(PathStream),
        some [!MaybeError] (
            % Each predicate we call below stops reading when given
            % !.MaybeError = yes(...).
            !:MaybeError = no,
            read_check_line(PathStream, feedback_first_line,
                fre_incorrect_first_line, !MaybeError, !IO),
            read_check_line(PathStream, feedback_version,
                fre_incorrect_version(feedback_version), !MaybeError, !IO),
            read_profiled_program_name(PathStream,
                MaybeExpectedProfiledProgramName,
                !.MaybeError, MaybeActualProfiledProgram, !IO),
            read_all_feedback_data(PathStream, MaybeActualProfiledProgram,
                ResultFeedbackInfo, !IO)
        ),
        io.close_input(PathStream, !IO)
    ;
        PathResult = error(ErrorCode),
        ResultFeedbackInfo = error(fre_open_error(ErrorCode))
    ).

    % Read and check a line of the file.
    %
:- pred read_check_line(io.text_input_stream::in, string::in,
    feedback_read_error::in,
    maybe(feedback_read_error)::in, maybe(feedback_read_error)::out,
    io::di, io::uo) is det.

read_check_line(Stream, TestLine, NotMatchError, !MaybeError, !IO) :-
    (
        !.MaybeError = yes(_)
    ;
        !.MaybeError = no,
        io.read_line_as_string(Stream, LineResult, !IO),
        (
            LineResult = ok(Line),
            ( if
                ( Line = TestLine
                ; Line = TestLine ++ "\n"
                )
            then
                !:MaybeError = no
            else
                !:MaybeError = yes(NotMatchError)
            )
        ;
            LineResult = eof,
            !:MaybeError = yes(fre_unexpected_eof)
        ;
            LineResult = error(Error),
            !:MaybeError = yes(fre_read_error(Error))
        )
    ).

:- pred read_profiled_program_name(io.text_input_stream::in, maybe(string)::in,
    maybe(feedback_read_error)::in,
    maybe_error(string, feedback_read_error)::out, io::di, io::uo) is det.

read_profiled_program_name(Stream, MaybeExpectedProfiledProgram,
        !.MaybeError, MaybeActualProfiledProgram, !IO) :-
    (
        !.MaybeError = yes(Error),
        MaybeActualProfiledProgram = error(Error)
    ;
        !.MaybeError = no,
        io.read_line_as_string(Stream, LineResult, !IO),
        (
            LineResult = ok(String),
            ActualProfiledProgram = string.strip(String),
            (
                MaybeExpectedProfiledProgram = no,
                MaybeActualProfiledProgram = ok(ActualProfiledProgram)
            ;
                MaybeExpectedProfiledProgram = yes(ExpectedProfiledProgram),
                ( if ActualProfiledProgram = ExpectedProfiledProgram then
                    MaybeActualProfiledProgram = ok(ActualProfiledProgram)
                else
                    MaybeActualProfiledProgram =
                        error(fre_incorrect_profiled_program_name(
                            ExpectedProfiledProgram, ActualProfiledProgram))
                )
            )
        ;
            LineResult = eof,
            MaybeActualProfiledProgram = error(fre_unexpected_eof)
        ;
            LineResult = error(Error),
            MaybeActualProfiledProgram = error(fre_read_error(Error))
        )
    ).

    % Read the feedback data from the file.
    %
    % The feedback data in the file should be a single large term.
    % This term should be a list, each element of which is an identifying
    % wrapper around a feedback component.
    %
    % The overall term is handled by read_all_feedback_data, while
    % the list elements are handled by add_feedback_components.
    %
:- pred read_all_feedback_data(io.text_input_stream::in,
    maybe_error(string, feedback_read_error)::in,
    feedback_read_result(feedback_info)::out, io::di, io::uo) is det.

read_all_feedback_data(Stream, MaybeActualProfiledProgram, Result, !IO) :-
    (
        MaybeActualProfiledProgram = error(Error),
        Result = error(Error)
    ;
        MaybeActualProfiledProgram = ok(ActualProfiledProgram),
        % XXX Note that the use of io.read here, and io.write in
        % actually_write_feedback_file below, are accident-prone, because
        % any change to any of the function symbols in the type tree of
        % feedback_info will result in a de-facto change in the format
        % of feedback files, *without this fact necessarily being apparent
        % to the person making the change*, which can thus easily result
        % in the file format version number NOT being incremented.
        io.read(Stream, ReadResult, !IO),
        (
            ReadResult = ok(Components),
            Info0 = init_feedback_info(ActualProfiledProgram),
            add_feedback_components(Components, Info0, Result)
            % XXX We should check there nothing in the input after this term.
            % XXX This would be easier to do if we read in the whole file
            % using io.read_named_file_as_lines, and parsed this last line
            % using read_term_from_string.
        ;
            ReadResult = eof,
            Result = error(fre_unexpected_eof)
        ;
            ReadResult = error(Error, Line),
            Result = error(fre_parse_error(Error, Line))
        )
    ).

:- pred add_feedback_components(list(feedback_component_wrapper)::in,
    feedback_info::in, feedback_read_result(feedback_info)::out) is det.

add_feedback_components([], !.Info, Result) :-
    Result = ok(!.Info).
add_feedback_components([Wrapper | Wrappers], !.Info, Result) :-
    (
        Wrapper = fcw_candidate_parallel_conjunctions(Candidates),
        MaybeCandidates0 = !.Info ^ fi_maybe_candidate_parallel_conjunctions,
        (
            MaybeCandidates0 = no,
            !Info ^ fi_maybe_candidate_parallel_conjunctions
                := yes(Candidates),
            add_feedback_components(Wrappers, !.Info, Result)
        ;
            MaybeCandidates0 = yes(_),
            Result = error(fre_repeated_component(
                "candidate_parallel_conjunctions"))
        )
    ).

%---------------------------------------------------------------------------%
%
% Writing feedback files.
%

write_feedback_file(Path, Feedback, Result, !IO) :-
    io.open_output(Path, PathResult, !IO),
    (
        PathResult = ok(PathStream),
        actually_write_feedback_file(PathStream, Feedback, !IO),
        io.close_output(PathStream, !IO),
        Result = fwr_ok
    ;
        PathResult = error(ErrorCode),
        Result = fwr_open_error(ErrorCode)
    ).

    % Write out the data. This is called by try_io to catch any exceptions
    % that close_output and the other predicates we call here (e.g. io.write)
    % may throw.
    % XXX This should NOT be necessary.
    %
:- pred actually_write_feedback_file(io.text_output_stream::in,
    feedback_info::in, io::di, io::uo) is det.

actually_write_feedback_file(Stream, FeedbackInfo, !IO) :-
    FeedbackInfo = feedback_info(ProfiledProgramName,
        MaybeCandidateParallelConjs),
    io.format(Stream, "%s\n%s\n%s\n",
        [s(feedback_first_line), s(feedback_version), s(ProfiledProgramName)],
        !IO),
    % In the future, we expect to support more than one kind of feedback.
    some [!RevComponents] (
        !:RevComponents = [],
        (
            MaybeCandidateParallelConjs = no
        ;
            MaybeCandidateParallelConjs = yes(Candidates),
            CandComponent = fcw_candidate_parallel_conjunctions(Candidates),
            !:RevComponents = [CandComponent | !.RevComponents]
        ),
        list.reverse(!.RevComponents, Components)
    ),
    % XXX See the comment on the corresponding io.read above.
    io.write(Stream, Components, !IO),
    io.write_string(Stream, ".\n", !IO).

%---------------------------------------------------------------------------%
%
% The identifying marks of feedback files.
%

:- func feedback_first_line = string.

feedback_first_line = "Mercury Compiler Feedback".

:- func feedback_version = string.

feedback_version = "19".

%---------------------------------------------------------------------------%
:- end_module mdbcomp.feedback.
%---------------------------------------------------------------------------%
