%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2001, 2004-2011 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: read_profile.m.
% Authors: conway, zs.
%
% This module contains code for reading in a deep profiling data file.
% Such files, named Deep.data, are created by deep profiled executables.
%
%---------------------------------------------------------------------------%

:- module read_profile.
:- interface.

:- import_module profile.

:- import_module io.
:- import_module maybe.

:- pred read_call_graph(string::in, maybe_error(initial_deep)::out,
    io::di, io::uo) is det.

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

:- implementation.

:- import_module array_util.
:- import_module io_combinator.
:- import_module measurements.
:- import_module mdbcomp.
:- import_module mdbcomp.goal_path.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.program_representation.

:- import_module assoc_list.
:- import_module array.
:- import_module bool.
:- import_module char.
:- import_module int.
:- import_module list.
:- import_module pair.
:- import_module require.
:- import_module string.

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

:- type maybe_error2(T1, T2)
    --->    ok2(T1, T2)
    ;       error2(string).

:- type ptr_kind
    --->    ps
    ;       pd
    ;       css
    ;       csd.

read_call_graph(FileName, MaybeInitDeep, !IO) :-
    io.open_binary_input(FileName, OpenResult, !IO),
    (
        OpenResult = ok(FileStream),
        read_deep_id_string(FileStream, MaybeVersionNumber, !IO),
        (
            MaybeVersionNumber = ok(_VersionNumber),
            % In the future, we could use different code to read in
            % profiling data files with different version numbers.
            io_combinator.maybe_error_sequence_11(
                read_string(FileStream),
                read_fixed_size_int(FileStream),
                read_fixed_size_int(FileStream),
                read_fixed_size_int(FileStream),
                read_fixed_size_int(FileStream),
                read_fixed_size_int(FileStream),
                read_num(FileStream),
                read_num(FileStream),
                read_num(FileStream),
                read_num(FileStream),
                read_ptr(FileStream, pd),
                maybe_init_deep,
                MaybeInitDeepHeader, !IO),
            (
                MaybeInitDeepHeader = ok(InitDeep),
                % When we implement compression of data files, we would
                % want to pipe the rest of the input stream through the
                % decompression mechanism.
                read_nodes(FileStream, InitDeep, MaybeInitDeep, !IO)
            ;
                MaybeInitDeepHeader = error(Error),
                MaybeInitDeep = error(Error)
            )
        ;
            MaybeVersionNumber = error(Msg),
            MaybeInitDeep = error(Msg)
        ),
        io.close_binary_input(FileStream, !IO)
    ;
        OpenResult = error(Error),
        io.error_message(Error, Msg),
        MaybeInitDeep = error(Msg)
    ).

:- pred read_deep_id_string(io.binary_input_stream::in, maybe_error(int)::out,
    io::di, io::uo) is det.

read_deep_id_string(InputStream, MaybeVersionNumber, !IO) :-
    % The 10 extra chars should be ample for the version number and newline.
    FirstLineLenLimit = string.length(deep_id_prefix) + 10,
    read_line(InputStream, FirstLineLenLimit, MaybeLine, !IO),
    (
        MaybeLine = ok(Line0),
        Line = string.chomp(Line0),
        ( if
            string.append(deep_id_prefix, Suffix, Line),
            string.to_int(Suffix, VersionNumber)
        then
            ( if acceptable_version(VersionNumber) then
                MaybeVersionNumber = ok(VersionNumber)
            else
                MaybeVersionNumber = error("version number mismatch")
            )
        else
            MaybeVersionNumber = error("not a deep profiling data file")
        )
    ;
        MaybeLine = error(Error),
        MaybeVersionNumber = error(Error)
    ).

    % Return the constant prefix of the string identifying a file
    % as a deep profiling data file. The first line of a profiling data file
    % should contain this prefix and the version number of format used by the
    % file.
    %
    % This string must match the string written by the function
    % MR_write_out_deep_id_string in runtime/mercury_deep_profiling.c.
    %
:- func deep_id_prefix = string.

deep_id_prefix = "Mercury deep profiler data version ".

:- pred acceptable_version(int::in) is semidet.

acceptable_version(8).

:- pred maybe_init_deep(string::in, int::in, int::in, int::in, int::in,
    int::in, int::in, int::in, int::in, int::in, int::in,
    maybe_error(initial_deep)::out) is det.

maybe_init_deep(ProgName, FlagsInt, MaxCSD, MaxCSS, MaxPD, MaxPS, TicksPerSec,
        InstrumentQuanta, UserQuanta, NumCallSeqs, RootPDI, MaybeInitDeep) :-
    maybe_deep_flags(FlagsInt, MaybeFlags),
    (
        MaybeFlags = ok(Flags),
        InitStats = profile_stats(ProgName, MaxCSD, MaxCSS, MaxPD, MaxPS,
            TicksPerSec, InstrumentQuanta, UserQuanta, NumCallSeqs, Flags),
        InitDeep = initial_deep(
            InitStats,
            make_pdptr(RootPDI),
            array.init(MaxCSD + 1,
                call_site_dynamic(
                    make_dummy_pdptr,
                    make_dummy_pdptr,
                    zero_own_prof_info
                )),
            array.init(MaxPD + 1, proc_dynamic(make_dummy_psptr, array([]),
                no)),
            array.init(MaxCSS + 1,
                call_site_static(
                    make_dummy_psptr, -1,
                    normal_call_and_callee(make_dummy_psptr, ""), -1, rgp_nil
                )),
            array.init(MaxPS + 1,
                proc_static(dummy_proc_id, "", "", "", "", "", -1, no,
                    array([]), array([]), no, not_zeroed))
        ),
        MaybeInitDeep = ok(InitDeep)
    ;
        MaybeFlags = error(Error),
        MaybeInitDeep = error(Error)
    ).

:- pred maybe_deep_flags(int::in, maybe_error(deep_flags)::out) is det.

maybe_deep_flags(FlagsInt, MaybeFlags) :-
    BytesPerInt = (FlagsInt /\ deep_flag_bytes_per_int_mask)
        >> deep_flag_bytes_per_int_shift,
    Canonical = (FlagsInt /\ deep_flag_canonical_mask)
        >> deep_flag_canonical_shift,
    Compression = (FlagsInt /\ deep_flag_compression_mask)
        >> deep_flag_compression_shift,
    Coverage = (FlagsInt /\ deep_flag_coverage_mask)
        >> deep_flag_coverage_shift,
    ( if
        (
            Canonical = 0,
            CanonicalFlag = maybe_not_canonical
        ;
            Canonical = 1,
            CanonicalFlag = is_canonical
        ),
        (
            Compression = 0,
            CompressionFlag = no_compression
            % There is no compression alternative yet
        ),
        (
            Coverage = 0,
            CoverageFlag = no_coverage_data
        ;
            Coverage = 1,
            CoverageFlag = static_coverage_data
        ;
            Coverage = 2,
            CoverageFlag = dynamic_coverage_data
        ),
        0 = ((\ deep_flag_all_fields_mask) /\ FlagsInt)
    then
        MaybeFlags = ok(deep_flags(BytesPerInt, CanonicalFlag, CompressionFlag,
            CoverageFlag))
    else
        MaybeFlags = error(
            string.format("Error parsing flags in file header, flags are 0x%x",
                [i(FlagsInt)]))
    ).

    % Flags masks and shifts.
    % The following line provides a ruler to line up the hexadecimal values
    % with.
    %
    %                              48  32  16   0
    %
    % Bytes_per_int occupies the bottom 8 bits, bit 0 to 7.
    % The canonical flag occupies the next 2 bits, bit 8 to 9.
    % The compression flag occupies the next 2 bits, bit 10 to 11.
    % The coverage indication occupies the next 2 bits, bit 12 to 13.
    %
    % Some of these have more bits than they currently need, in order to
    % accommodate possible future growth.

:- func deep_flag_bytes_per_int_mask = int.
deep_flag_bytes_per_int_mask = 0x00000000000000FF.
:- func deep_flag_bytes_per_int_shift = int.
deep_flag_bytes_per_int_shift = 0.

:- func deep_flag_canonical_mask = int.
deep_flag_canonical_mask =     0x0000000000000300.
:- func deep_flag_canonical_shift = int.
deep_flag_canonical_shift = 8.

:- func deep_flag_compression_mask = int.
deep_flag_compression_mask =   0x0000000000000C00.
:- func deep_flag_compression_shift = int.
deep_flag_compression_shift = 10.

:- func deep_flag_coverage_mask = int.
deep_flag_coverage_mask =      0x0000000000003000.
:- func deep_flag_coverage_shift = int.
deep_flag_coverage_shift = 12.

:- func deep_flag_all_fields_mask = int.
deep_flag_all_fields_mask =
    deep_flag_bytes_per_int_mask \/
    deep_flag_canonical_mask \/
    deep_flag_compression_mask \/
    deep_flag_coverage_mask.

:- pred read_nodes(io.binary_input_stream::in, initial_deep::in,
    maybe_error(initial_deep)::out, io::di, io::uo) is det.

read_nodes(InputStream, InitDeep0, MaybeInitDeep, !IO) :-
    % Wrap the real function inside another loop. This strategy ensures that
    % this code works in grades that lack tail recursion, such as debugging
    % grades. read_nodes_2 will return after it has exceeded a depth limit,
    % unwinding its stack. The outer loop will continue as long as read_nodes_2
    % thinks that more work remains.
    %
    % The depth of 50,000 has been chosen as it is roughly less than half the
    % stack depth that causes crashes during debugging.
    read_nodes_2(InputStream, 50000, InitDeep0, MaybeInitDeep0, !IO),
    (
        MaybeInitDeep0 = init_deep_complete(InitDeep),
        MaybeInitDeep = ok(InitDeep)
    ;
        MaybeInitDeep0 = error(Error),
        MaybeInitDeep = error(Error)
    ;
        MaybeInitDeep0 = init_deep_incomplete(InitDeep1),
        read_nodes(InputStream, InitDeep1, MaybeInitDeep, !IO)
    ).

:- type maybe_init_deep_complete
    --->    init_deep_complete(initial_deep)
    ;       init_deep_incomplete(initial_deep)
    ;       error(string).

:- pred read_nodes_2(io.binary_input_stream::in, int::in, initial_deep::in,
    maybe_init_deep_complete::out, io::di, io::uo) is det.

read_nodes_2(InputStream, Depth, !.InitDeep, MaybeInitDeep, !IO) :-
    ( if Depth < 1 then
        MaybeInitDeep = init_deep_incomplete(!.InitDeep)
    else
        read_nodes_3(InputStream, Depth - 1, !.InitDeep, MaybeInitDeep, !IO)
    ).

:- pred read_nodes_3(io.binary_input_stream::in, int::in, initial_deep::in,
    maybe_init_deep_complete::out, io::di, io::uo) is det.

read_nodes_3(InputStream, Depth, !.InitDeep, MaybeInitDeep, !IO) :-
    ProfileStats = !.InitDeep ^ init_profile_stats,
    read_byte(InputStream, MaybeByte, !IO),
    (
        MaybeByte = ok(Byte),
        ( if is_next_item_token(Byte, NextItem) then
            (
                NextItem = deep_item_call_site_dynamic,
                read_call_site_dynamic(InputStream, MaybeCSD, !IO),
                (
                    MaybeCSD = ok2(CallSiteDynamic, CSDI),
                    CSDs0 = !.InitDeep ^ init_call_site_dynamics,
                    deep_insert(CSDs0, CSDI, CallSiteDynamic, CSDs),
                    !InitDeep ^ init_call_site_dynamics := CSDs,
                    read_nodes_2(InputStream, Depth, !.InitDeep,
                        MaybeInitDeep, !IO)
                ;
                    MaybeCSD = error2(Error),
                    MaybeInitDeep = error(Error)
                )
            ;
                NextItem = deep_item_proc_dynamic,
                read_proc_dynamic(InputStream, ProfileStats, MaybePD, !IO),
                (
                    MaybePD = ok2(ProcDynamic, PDI),
                    PDs0 = !.InitDeep ^ init_proc_dynamics,
                    deep_insert(PDs0, PDI, ProcDynamic, PDs),
                    !InitDeep ^ init_proc_dynamics := PDs,
                    read_nodes_2(InputStream, Depth, !.InitDeep,
                        MaybeInitDeep, !IO)
                ;
                    MaybePD = error2(Error),
                    MaybeInitDeep = error(Error)
                )
            ;
                NextItem = deep_item_call_site_static,
                read_call_site_static(InputStream, MaybeCSS, !IO),
                (
                    MaybeCSS = ok({CallSiteStatic, CSSI}),
                    CSSs0 = !.InitDeep ^ init_call_site_statics,
                    deep_insert(CSSs0, CSSI, CallSiteStatic, CSSs),
                    !InitDeep ^ init_call_site_statics := CSSs,
                    read_nodes_2(InputStream, Depth, !.InitDeep,
                        MaybeInitDeep, !IO)
                ;
                    MaybeCSS = error(Error),
                    MaybeInitDeep = error(Error)
                )
            ;
                NextItem = deep_item_proc_static,
                read_proc_static(InputStream, ProfileStats, MaybePS, !IO),
                (
                    MaybePS = ok2(ProcStatic, PSI),
                    PSs0 = !.InitDeep ^ init_proc_statics,
                    deep_insert(PSs0, PSI, ProcStatic, PSs),
                    !InitDeep ^ init_proc_statics := PSs,
                    read_nodes_2(InputStream, Depth, !.InitDeep,
                        MaybeInitDeep, !IO)
                ;
                    MaybePS = error2(Error),
                    MaybeInitDeep = error(Error)
                )
            ;
                NextItem = deep_item_end,
                MaybeInitDeep = init_deep_complete(!.InitDeep)
            )
        else
            string.format("unexpected token %d", [i(Byte)], Msg),
            MaybeInitDeep = error(Msg)
        )
    ;
        MaybeByte = eof,
        % XXX: Shouldn't this be an error since there's a deep_item_end token?
        MaybeInitDeep = init_deep_complete(!.InitDeep)
    ;
        MaybeByte = error(Error),
        io.error_message(Error, Msg),
        MaybeInitDeep = error(Msg)
    ).

:- pred read_call_site_static(io.binary_input_stream::in,
    maybe_error({call_site_static, int})::out, io::di, io::uo) is det.

read_call_site_static(InputStream, MaybeCSS, !IO) :-
    trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
        io.output_stream(OutputStream, !TIO),
        io.write_string(OutputStream, "reading call_site_static.\n", !TIO)
    ),
    io_combinator.maybe_error_sequence_4(
        read_ptr(InputStream, css),
        read_call_site_kind_and_callee(InputStream),
        read_num(InputStream),
        read_string(InputStream),
        ( pred(CSSI0::in, Kind::in, LineNumber::in, GoalPathStr::in, CSS::out)
                is det :-
            DummyPSPtr = make_dummy_psptr,
            DummySlotNum = -1,
            rev_goal_path_from_string_det(GoalPathStr, RevGoalPath0),
            rev_goal_path_remove_type_info(RevGoalPath0, RevGoalPath),
            CallSiteStatic0 = call_site_static(DummyPSPtr,
                DummySlotNum, Kind, LineNumber, RevGoalPath),
            CSS = ok({CallSiteStatic0, CSSI0})
        ),
        MaybeCSS, !IO),
    (
        MaybeCSS = ok({CallSiteStatic, CSSI}),
        trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
            io.output_stream(OutputStream, !TIO),
            io.format(OutputStream,
                "read call_site_static %d:", [i(CSSI)], !TIO),
            io.write(OutputStream, CallSiteStatic, !TIO),
            io.write_string(OutputStream, "\n", !TIO)
        )
    ;
        MaybeCSS = error(_)
    ).

:- pred read_proc_static(io.binary_input_stream::in, profile_stats::in,
    maybe_error2(proc_static, int)::out, io::di, io::uo) is det.

read_proc_static(InputStream, ProfileStats, MaybePS, !IO) :-
    trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
        io.output_stream(OutputStream, !TIO),
        io.write_string(OutputStream, "reading proc_static.\n", !TIO)
    ),
    io_combinator.maybe_error_sequence_6(
        read_ptr(InputStream, ps),
        read_proc_id(InputStream),
        read_string(InputStream),
        read_num(InputStream),
        read_deep_byte(InputStream),
        read_num(InputStream),
        ( pred(PSI0::in, Id0::in, F0::in, L0::in, I0::in,
                NCS0::in, ProcId::out) is det :-
            ProcId = ok({PSI0, Id0, F0, L0, I0, NCS0})
        ),
        MaybeProcId, !IO),
    (
        MaybeProcId = ok({PSI, Id, FileName, LineNumber, Interface, NCS}),
        read_n_things(NCS, read_ptr(InputStream, css), MaybeCSSIs, !IO),
        (
            MaybeCSSIs = ok(CSSIs),
            maybe_read_ps_coverage_points(InputStream, ProfileStats,
                MaybeCoveragePoints, !IO),
            (
                MaybeCoveragePoints = ok(CPInfos - MaybeCPs),
                CSSPtrs = list.map(make_cssptr, CSSIs),
                DeclModule = decl_module(Id),
                create_refined_proc_ids(Id, UnQualRefinedStr, QualRefinedStr),
                RawStr = raw_proc_id_to_string(Id),
                ( if Interface = 0 then
                    IsInInterface = no
                else
                    IsInInterface = yes
                ),
                % The `not_zeroed' for whether the procedure's proc_static
                % is ever zeroed is the default. The startup phase will set it
                % to `zeroed' in the proc_statics which are ever zeroed.
                ProcStatic = proc_static(Id, DeclModule,
                    UnQualRefinedStr, QualRefinedStr, RawStr,
                    FileName, LineNumber, IsInInterface,
                    array(CSSPtrs), CPInfos, MaybeCPs, not_zeroed),
                MaybePS = ok2(ProcStatic, PSI),
                trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
                    io.output_stream(OutputStream, !TIO),
                    io.format(OutputStream,
                        "read proc_static %d:", [i(PSI)], !TIO),
                    io.write(OutputStream, ProcStatic, !TIO),
                    io.write_string(OutputStream, "\n", !TIO)
                )
            ;
                MaybeCoveragePoints = error(Error),
                MaybePS = error2(Error)
            )
        ;
            MaybeCSSIs = error(Error),
            MaybePS = error2(Error)
        )
    ;
        MaybeProcId = error(Error),
        MaybePS = error2(Error)
    ).

:- pred maybe_read_ps_coverage_points(io.binary_input_stream::in,
    profile_stats::in, maybe_error(pair(array(coverage_point_info),
    maybe(array(int))))::out, io::di, io::uo) is det.

maybe_read_ps_coverage_points(InputStream, ProfileStats, MaybeCoveragePoints,
        !IO) :-
    CoverageDataType = ProfileStats ^ prs_deep_flags ^ df_coverage_data_type,
    (
        CoverageDataType = no_coverage_data,
        MaybeCoveragePoints0 = ok([] - no)
    ;
        ( CoverageDataType = static_coverage_data
        ; CoverageDataType = dynamic_coverage_data
        ),
        read_num(InputStream, MaybeNCP, !IO),
        (
            MaybeNCP = ok(NCP),
            (
                CoverageDataType = static_coverage_data,
                read_n_things(NCP,
                    read_coverage_point_static_and_num(InputStream),
                    MaybeCPPairs, !IO),
                (
                    MaybeCPPairs = ok(CPPairs),
                    keys_and_values(CPPairs, CPInfos, CPs),
                    MaybeCoveragePoints0 = ok(CPInfos - yes(CPs))
                ;
                    MaybeCPPairs = error(Error0),
                    MaybeCoveragePoints0 = error(Error0)
                )
            ;
                CoverageDataType = dynamic_coverage_data,
                read_n_things(NCP, read_coverage_point_static(InputStream),
                    MaybeCPInfos, !IO),
                (
                    MaybeCPInfos = ok(CPInfos),
                    MaybeCoveragePoints0 = ok(CPInfos - no)
                ;
                    MaybeCPInfos = error(Error0),
                    MaybeCoveragePoints0 = error(Error0)
                )
            )
        ;
            MaybeNCP = error(Error0),
            MaybeCoveragePoints0 = error(Error0)
        )
    ),
    (
        MaybeCoveragePoints0 = ok(CPInfosList - MaybeCPsList),
        CPInfosArray = array(CPInfosList),
        MaybeCPsArray = map_maybe(array, MaybeCPsList),
        MaybeCoveragePoints = ok(CPInfosArray - MaybeCPsArray)
    ;
        MaybeCoveragePoints0 = error(Error),
        MaybeCoveragePoints = error(Error)
    ).

:- pred maybe_read_pd_coverage_points(io.binary_input_stream::in,
    profile_stats::in, maybe_error(maybe(array(int)))::out,
    io::di, io::uo) is det.

maybe_read_pd_coverage_points(InputStream, ProfileStats,
        MaybeCoveragePoints, !IO) :-
    CoverageDataType = ProfileStats ^ prs_deep_flags ^ df_coverage_data_type,
    (
        ( CoverageDataType = no_coverage_data
        ; CoverageDataType = static_coverage_data
        ),
        MaybeCoveragePoints = ok(no)
    ;
        CoverageDataType = dynamic_coverage_data,
        read_num(InputStream, ResN, !IO),
        (
            ResN = ok(N),
            read_n_things(N, read_num(InputStream), MaybeCPs, !IO),
            (
                MaybeCPs = ok(CPsList),
                MaybeCoveragePoints = ok(yes(array(CPsList)))
            ;
                MaybeCPs = error(Error),
                MaybeCoveragePoints = error(Error)
            )
        ;
            ResN = error(Error),
            MaybeCoveragePoints = error(Error)
        )
    ).

:- pred read_proc_id(io.binary_input_stream::in,
    maybe_error(string_proc_label)::out, io::di, io::uo) is det.

read_proc_id(InputStream, MaybeProcId, !IO) :-
    read_deep_byte(InputStream, MaybeByte, !IO),
    (
        MaybeByte = ok(Byte),
        ( if is_proclabel_kind(Byte, ProcLabelKind) then
            (
                ProcLabelKind = proclabel_special,
                read_proc_id_uci_pred(InputStream, MaybeProcId, !IO)
            ;
                ProcLabelKind = proclabel_user_predicate,
                read_proc_id_user_defined(InputStream, pf_predicate,
                    MaybeProcId, !IO)
            ;
                ProcLabelKind = proclabel_user_function,
                read_proc_id_user_defined(InputStream, pf_function,
                    MaybeProcId, !IO)
            )
        else
            string.format("unexpected proclabel_kind %d", [i(Byte)], Msg),
            MaybeProcId = error(Msg)
        )
    ;
        MaybeByte = error(Error),
        MaybeProcId = error(Error)
    ).

:- pred read_proc_id_uci_pred(io.binary_input_stream::in,
    maybe_error(string_proc_label)::out, io::di, io::uo) is det.

read_proc_id_uci_pred(InputStream, MaybeProcLabel, !IO) :-
    io_combinator.maybe_error_sequence_6(
        read_string(InputStream),
        read_string(InputStream),
        read_string(InputStream),
        read_string(InputStream),
        read_num(InputStream),
        read_num(InputStream),
        ( pred(TypeName::in, TypeModule::in, DefModule::in,
                PredName::in, Arity::in, Mode::in, ProcId::out) is det :-
            ProcId = ok(str_special_proc_label(TypeName, TypeModule,
                DefModule, PredName, Arity, Mode))
        ),
        MaybeProcLabel, !IO).

:- pred read_proc_id_user_defined(io.binary_input_stream::in, pred_or_func::in,
    maybe_error(string_proc_label)::out, io::di, io::uo) is det.

read_proc_id_user_defined(InputStream, PredOrFunc, MaybeProcLabel, !IO) :-
    io_combinator.maybe_error_sequence_5(
        read_string(InputStream),
        read_string(InputStream),
        read_string(InputStream),
        read_num(InputStream),
        read_num(InputStream),
        ( pred(DeclModule::in, DefModule::in, Name::in,
                Arity::in, Mode::in, ProcId::out) is det :-
            ProcId = ok(str_ordinary_proc_label(PredOrFunc, DeclModule,
                DefModule, Name, Arity, Mode))
        ),
        MaybeProcLabel, !IO).

    % Read the description of a coverage point, and its execution count.
    %
    % The description of a coverage point is stored in the proc static
    % regardless of whether we are using static or dynamic coverage profiling.
    % If we are using static coverage profiling, then this description will be
    % immediately followed in the profiling data file by the number of times
    % that the coverage point was executed.
    %
:- pred read_coverage_point_static_and_num(io.binary_input_stream::in,
    maybe_error(pair(coverage_point_info, int))::out, io::di, io::uo) is det.

read_coverage_point_static_and_num(InputStream, MaybeCP, !IO) :-
    io_combinator.maybe_error_sequence_2(
        read_coverage_point_static(InputStream),
        read_num(InputStream),
        ( pred(CPInfo::in, Count::in, ok(CPI)::out) is det :-
            CPI = CPInfo - Count
        ), MaybeCP, !IO).

    % Read the description of a coverage point.
    %
    % The description of a coverage point is stored in the proc static
    % regardless of whether we are using static or dynamic coverage profiling.
    %
:- pred read_coverage_point_static(io.binary_input_stream::in,
    maybe_error(coverage_point_info)::out, io::di, io::uo) is det.

read_coverage_point_static(InputStream, MaybeCP, !IO) :-
    io_combinator.maybe_error_sequence_2(
        read_string(InputStream),
        read_cp_type(InputStream),
        ( pred(GoalPathString::in, CPType::in, MaybeCPI::out) is det :-
            rev_goal_path_from_string_det(GoalPathString, RevGoalPath0),
            rev_goal_path_remove_type_info(RevGoalPath0, RevGoalPath),
            MaybeCPI = ok(coverage_point_info(RevGoalPath, CPType))
        ), MaybeCP, !IO).

:- func raw_proc_id_to_string(string_proc_label) = string.

raw_proc_id_to_string(str_special_proc_label(TypeName, TypeModule, _DefModule,
        PredName, Arity, Mode)) =
    string.append_list(
        [PredName, " for ", TypeModule, ".", TypeName,
        "/", string.int_to_string(Arity),
        " mode ", string.int_to_string(Mode)]).
raw_proc_id_to_string(str_ordinary_proc_label(PredOrFunc, DeclModule,
        _DefModule, Name, Arity, Mode)) =
    string.append_list([DeclModule, ".", Name,
        "/", string.int_to_string(Arity),
        add_plus_one_for_function(PredOrFunc),
        "-", string.int_to_string(Mode)]).

:- pred create_refined_proc_ids(string_proc_label::in,
    string::out, string::out) is det.

create_refined_proc_ids(ProcLabel, UnQualName, QualName) :-
    (
        ProcLabel = str_special_proc_label(TypeName, TypeModule,
            _DefModule, RawPredName, Arity, Mode),
        ( if RawPredName = "__Unify__" then
            PredName = "Unify"
        else if RawPredName = "__Compare__" then
            PredName = "Compare"
        else if RawPredName = "__CompareRep__" then
            PredName = "CompareRep"
        else if RawPredName = "__Index__" then
            PredName = "Index"
        else
            Msg = "unknown special predicate name " ++ RawPredName,
            error(Msg)
        ),
        Prefix = PredName ++ " for ",
        AritySuffix = "/" ++ string.int_to_string(Arity),
        UnQualName0 = Prefix ++ TypeName ++ AritySuffix,
        QualName0 = Prefix ++ TypeModule ++ "." ++ TypeName ++ AritySuffix,
        ( if Mode = 0 then
            UnQualName = UnQualName0,
            QualName = QualName0
        else
            ModeSuffix = " mode " ++ int_to_string(Mode),
            UnQualName = UnQualName0 ++ ModeSuffix,
            QualName = QualName0 ++ ModeSuffix
        )
    ;
        ProcLabel = str_ordinary_proc_label(PredOrFunc, DeclModule,
            _DefModule, ProcName, Arity, Mode),
        ( if
            string.append("TypeSpecOf__", ProcName1, ProcName),
            ( if string.append("pred__", ProcName2A, ProcName1) then
                ProcName2 = ProcName2A
            else if string.append("func__", ProcName2B, ProcName1) then
                ProcName2 = ProcName2B
            else if string.append("pred_or_func__", ProcName2C, ProcName1) then
                ProcName2 = ProcName2C
            else
                error("typespec: neither pred nor func")
            ),
            string.to_char_list(ProcName2, ProcName2Chars),
            fix_type_spec_suffix(ProcName2Chars, ProcNameChars, SpecInfo)
        then
            RefinedProcName = string.from_char_list(ProcNameChars),
            Suffix = "/" ++ string.int_to_string(Arity) ++
                add_plus_one_for_function(PredOrFunc) ++
                "-" ++ string.int_to_string(Mode) ++
                " [" ++ SpecInfo ++ "]",
            UnQualName = RefinedProcName ++ Suffix,
            QualName = DeclModule ++ "." ++ RefinedProcName ++ Suffix
        else if
            string.append("IntroducedFrom__", ProcName1, ProcName),
            ( if string.append("pred__", ProcName2A, ProcName1) then
                ProcName2 = ProcName2A
            else if string.append("func__", ProcName2B, ProcName1) then
                ProcName2 = ProcName2B
            else
                error("lambda: neither pred nor func")
            ),
            string.to_char_list(ProcName2, ProcName2Chars),
            split_lambda_name(ProcName2Chars, Segments),
            glue_lambda_name(Segments, ContainingNameChars,
                LineNumberChars)
        then
            string.from_char_list(ContainingNameChars, ContainingName),
            string.from_char_list(LineNumberChars, LineNumber),
            Suffix =
                " lambda line " ++ LineNumber ++
                "/" ++ string.int_to_string(Arity) ++
                add_plus_one_for_function(PredOrFunc),
            UnQualName = ContainingName ++ Suffix,
            QualName = DeclModule ++ "." ++ ContainingName ++ Suffix
        else
            Suffix =
                "/" ++ string.int_to_string(Arity) ++
                add_plus_one_for_function(PredOrFunc) ++
                "-" ++ string.int_to_string(Mode),
            UnQualName = ProcName ++ Suffix,
            QualName = DeclModule ++ "." ++ ProcName ++ Suffix
        )
    ).

:- func add_plus_one_for_function(pred_or_func) = string.

add_plus_one_for_function(pf_function) = "+1".
add_plus_one_for_function(pf_predicate) = "".

:- pred fix_type_spec_suffix(list(char)::in, list(char)::out, string::out)
    is semidet.

fix_type_spec_suffix(Chars0, Chars, SpecInfoStr) :-
    ( if Chars0 = ['_', '_', '[' | SpecInfo0 ] then
        Chars = [],
        list.take_while(non_right_bracket, SpecInfo0, SpecInfo),
        string.from_char_list(SpecInfo, SpecInfoStr)
    else if Chars0 = [Char | TailChars0] then
        fix_type_spec_suffix(TailChars0, TailChars, SpecInfoStr),
        Chars = [Char | TailChars]
    else
        fail
    ).

:- pred non_right_bracket(char::in) is semidet.

non_right_bracket(C) :-
    C \= ']'.

:- pred split_lambda_name(list(char)::in, list(list(char))::out) is det.

split_lambda_name([], []).
split_lambda_name([Char0 | Chars0], StringList) :-
    ( if Chars0 = ['_', '_' | Chars1 ] then
        split_lambda_name(Chars1, StringList0),
        StringList = [[Char0] | StringList0]
    else
        split_lambda_name(Chars0, StringList0),
        (
            StringList0 = [],
            StringList = [[Char0]]
        ;
            StringList0 = [String0 | StringList1],
            StringList = [[Char0 | String0] | StringList1]
        )
    ).

:- pred glue_lambda_name(list(list(char))::in, list(char)::out,
    list(char)::out) is semidet.

glue_lambda_name(Segments, PredName, LineNumber) :-
    ( if Segments = [LineNumberPrime, _] then
        PredName = [],
        LineNumber = LineNumberPrime
    else if Segments = [Segment | TailSegments] then
        glue_lambda_name(TailSegments, PredName1, LineNumber),
        (
            PredName1 = [],
            PredName = Segment
        ;
            PredName1 = [_ | _],
            list.append(Segment, ['_', '_' | PredName1], PredName)
        )
    else
        fail
    ).

:- pred read_proc_dynamic(io.binary_input_stream::in, profile_stats::in,
    maybe_error2(proc_dynamic, int)::out, io::di, io::uo) is det.

read_proc_dynamic(InputStream, ProfileStats, MaybePD, !IO) :-
    trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
        io.output_stream(OutputStream, !TIO),
        io.write_string(OutputStream, "reading proc_dynamic.\n", !TIO)
    ),
    io_combinator.maybe_error_sequence_3(
        read_ptr(InputStream, pd),
        read_ptr(InputStream, ps),
        read_num(InputStream),
        ( pred(PDI0::in, PSI0::in, N0::in, Stuff0::out) is det :-
            Stuff0 = ok({PDI0, PSI0, N0})
        ),
        MaybePDHeader, !IO),
    (
        MaybePDHeader = ok({PDI, PSI, N}),
        io_combinator.maybe_error_sequence_2(
            maybe_read_pd_coverage_points(InputStream, ProfileStats),
            read_n_things(N, read_call_site_slot(InputStream)),
            ( pred(MaybeCPs0::in, Slots0::in, CPsAndSlots0::out) is det :-
                CPsAndSlots0 = ok({MaybeCPs0, Slots0})
            ),
            MaybeCPsAndSlots, !IO),
        (
            MaybeCPsAndSlots = ok({MaybeCPs, Refs}),
            PSPtr = make_psptr(PSI),
            ProcDynamic = proc_dynamic(PSPtr, array(Refs), MaybeCPs),
            MaybePD = ok2(ProcDynamic, PDI),
            trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
                io.output_stream(OutputStream, !TIO),
                io.format(OutputStream,
                    "read proc_dynamic %d:", [i(PDI)], !TIO),
                io.write(OutputStream, ProcDynamic, !TIO),
                io.write_string(OutputStream, "\n", !TIO)
            )
        ;
            MaybeCPsAndSlots = error(Error),
            MaybePD = error2(Error)
        )
    ;
        MaybePDHeader = error(Error),
        MaybePD = error2(Error)
    ).

:- pred read_call_site_dynamic(io.binary_input_stream::in,
    maybe_error2(call_site_dynamic, int)::out, io::di, io::uo) is det.

read_call_site_dynamic(InputStream, MaybeCSD, !IO) :-
    trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
        io.output_stream(OutputStream, !TIO),
        io.write_string(OutputStream, "reading call_site_dynamic.\n", !TIO)
    ),
    read_ptr(InputStream, csd, MaybeCSDI, !IO),
    (
        MaybeCSDI = ok(CSDI),
        read_ptr(InputStream, pd, MaybePDI, !IO),
        (
            MaybePDI = ok(PDI),
            read_profile(InputStream, MaybeProfile, !IO),
            (
                MaybeProfile = ok(Profile),
                PDPtr = make_pdptr(PDI),
                CallerPDPtr = make_dummy_pdptr,
                CallSiteDynamic = call_site_dynamic(CallerPDPtr, PDPtr,
                    Profile),
                MaybeCSD = ok2(CallSiteDynamic, CSDI),
                trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
                    io.output_stream(OutputStream, !TIO),
                    io.format(OutputStream,
                        "read call_site_dynamic %d: ", [i(CSDI)], !TIO),
                    io.write(OutputStream, CallSiteDynamic, !TIO),
                    io.write_string(OutputStream, "\n", !TIO)
                )
            ;
                MaybeProfile = error(Error),
                MaybeCSD = error2(Error)
            )
        ;
            MaybePDI = error(Error),
            MaybeCSD = error2(Error)
        )
    ;
        MaybeCSDI = error(Error),
        MaybeCSD = error2(Error)
    ).

:- pred read_profile(io.binary_input_stream::in,
    maybe_error(own_prof_info)::out, io::di, io::uo) is det.

read_profile(InputStream, MaybeProfile, !IO) :-
    read_num(InputStream, MaybeMask, !IO),
    (
        MaybeMask = ok(Mask),

        % The masks here must correspond exactly with the masks in
        % MR_write_out_call_site_dynamic in mercury_deep_profiling.c
        % in the runtime.
        some [!MaybeError] (
            !:MaybeError = no,
            % We normally assume that the configuration macro
            % MR_DEEP_PROFILING_EXPLICIT_CALL_COUNTS is not
            % defined, and thus mercury_deep_profiling.m never
            % writes out call counts (instead, call counts are
            % computed from other port counts in measurements.m).
            % maybe_read_num_handle_error(Mask, 0x0001, Calls,
            %   !MaybeError, !IO),
            maybe_read_num_handle_error(InputStream, Mask, 0x0002, Exits,
                !MaybeError, !IO),
            maybe_read_num_handle_error(InputStream, Mask, 0x0004, Fails,
                !MaybeError, !IO),
            maybe_read_num_handle_error(InputStream, Mask, 0x0040, Redos,
                !MaybeError, !IO),
            maybe_read_num_handle_error(InputStream, Mask, 0x0080, Excps,
                !MaybeError, !IO),
            maybe_read_num_handle_error(InputStream, Mask, 0x0100, Quanta,
                !MaybeError, !IO),
            maybe_read_num_handle_error(InputStream, Mask, 0x0008, CallSeqs,
                !MaybeError, !IO),
            maybe_read_num_handle_error(InputStream, Mask, 0x0010, Allocs,
                !MaybeError, !IO),
            maybe_read_num_handle_error(InputStream, Mask, 0x0020, Words,
                !MaybeError, !IO),
            LastMaybeError = !.MaybeError
        ),
        (
            LastMaybeError = yes(Error),
            MaybeProfile = error(Error)
        ;
            LastMaybeError = no,
            MaybeProfile = ok(compress_profile(Exits, Fails, Redos, Excps,
                Quanta, CallSeqs, Allocs, Words))
        )
    ;
        MaybeMask = error(Error),
        MaybeProfile = error(Error)
    ).

:- pred maybe_read_num_handle_error(io.binary_input_stream::in,
    int::in, int::in, int::out, maybe(string)::in, maybe(string)::out,
    io::di, io::uo) is det.

maybe_read_num_handle_error(InputStream, MaskWord, MaskValue, Num,
        !MaybeError, !IO) :-
    ( if MaskWord /\ MaskValue \= 0 then
        read_num(InputStream, MaybeNum, !IO),
        (
            MaybeNum = ok(Num)
        ;
            MaybeNum = error(Error),
            Num = 0,
            !:MaybeError = yes(Error)
        )
    else
        Num = 0
    ).

:- pred read_call_site_slot(io.binary_input_stream::in,
    maybe_error(call_site_array_slot)::out, io::di, io::uo) is det.

read_call_site_slot(InputStream, MaybeSlot, !IO) :-
    trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
        io.output_stream(OutputStream, !TIO),
        io.write_string(OutputStream, "reading call_site_slot.\n", !TIO)
    ),
    read_call_site_kind(InputStream, MaybeKind, !IO),
    (
        MaybeKind = ok(Kind),
        (
            Kind = normal_call,
            read_ptr(InputStream, csd, MaybeCSDI, !IO),
            (
                MaybeCSDI = ok(CSDI),
                CSDPtr = make_csdptr(CSDI),
                MaybeSlot = ok(slot_normal(CSDPtr)),
                trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
                    io.output_stream(OutputStream, !TIO),
                    io.write_string(OutputStream,
                        "normal call_site slot ", !TIO),
                    io.write_int(OutputStream, CSDI, !TIO),
                    io.write_string(OutputStream, "\n", !TIO)
                )
            ;
                MaybeCSDI = error(Error),
                MaybeSlot = error(Error)
            )
        ;
            (
                Kind = higher_order_call,
                Zeroed = zeroed
            ;
                Kind = method_call,
                Zeroed = zeroed
            ;
                Kind = special_call,
                Zeroed = not_zeroed
            ;
                Kind = callback,
                Zeroed = not_zeroed
            ),
            read_multi_call_site_csdis(InputStream, MaybeCSDIs, !IO),
            (
                MaybeCSDIs = ok(CSDIs),
                CSDPtrs = list.map(make_csdptr, CSDIs),
                MaybeSlot = ok(slot_multi(Zeroed, array(CSDPtrs))),
                trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
                    io.output_stream(OutputStream, !TIO),
                    io.write_string(OutputStream,
                        "multi call_site slots ", !TIO),
                    io.write(OutputStream, CSDIs, !TIO),
                    io.write_string(OutputStream, "\n", !TIO)
                )
            ;
                MaybeCSDIs = error(Error),
                MaybeSlot = error(Error)
            )
        )
    ;
        MaybeKind = error(Error),
        MaybeSlot = error(Error)
    ).

:- pred read_multi_call_site_csdis(io.binary_input_stream::in,
    maybe_error(list(int))::out, io::di, io::uo) is det.

read_multi_call_site_csdis(InputStream, MaybeCSDIs, !IO) :-
    read_multi_call_site_csdis_2(InputStream, [], MaybeCSDIs, !IO).

    % We keep reading CSD node numbers until we find a zero byte.
    % The reason why a zero byte works as a sentinel is that a CSD node
    % number in the list of CSD node numbers at a multi call site cannot be
    % zero, and our encoding scheme ensures that non-zero node numbers
    % cannot start with a zero byte.
    %
    % We return the list of CSD node numbers in the reversed order, but
    % this is OK because our caller does not pay attention to the order
    % anyway.

:- pred read_multi_call_site_csdis_2(io.binary_input_stream::in, list(int)::in,
    maybe_error(list(int))::out, io::di, io::uo) is det.

read_multi_call_site_csdis_2(InputStream, CSDIs0, MaybeCSDIs, !IO) :-
    trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
        io.output_stream(OutputStream, !TIO),
        io.format(OutputStream, "reading multi_call_site_csdi.\n", [], !TIO)
    ),
    read_deep_byte(InputStream, MaybeByte, !IO),
    (
        MaybeByte = ok(Byte),
        ( if Byte = 0 then
            MaybeCSDIs = ok(CSDIs0)
        else
            putback_byte(InputStream, Byte, !IO),
            read_ptr(InputStream, csd, MaybeCSDI, !IO),
            (
                MaybeCSDI = ok(CSDI),
                read_multi_call_site_csdis_2(InputStream,
                    [CSDI | CSDIs0], MaybeCSDIs, !IO)
            ;
                MaybeCSDI = error(Error),
                MaybeCSDIs = error(Error)
            )
        )
    ;
        MaybeByte = error(Error),
        MaybeCSDIs = error(Error)
    ).

:- pred read_call_site_kind(io.binary_input_stream::in,
    maybe_error(call_site_kind)::out, io::di, io::uo) is det.

read_call_site_kind(InputStream, MaybeKind, !IO) :-
    read_deep_byte(InputStream, MaybeByte, !IO),
    (
        MaybeByte = ok(Byte),
        ( if is_call_site_kind(Byte, CallSiteKind) then
            MaybeKind = ok(CallSiteKind)
        else
            string.format("unexpected call_site_kind %d", [i(Byte)], Msg),
            MaybeKind = error(Msg)
        ),
        trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
            io.output_stream(OutputStream, !TIO),
            io.write_string(OutputStream, "call_site_kind ", !TIO),
            io.write(OutputStream, MaybeKind, !TIO),
            io.write_string(OutputStream, "\n", !TIO)
        )
    ;
        MaybeByte = error(Error),
        MaybeKind = error(Error)
    ).

:- pred read_call_site_kind_and_callee(io.binary_input_stream::in,
    maybe_error(call_site_kind_and_callee)::out,
    io::di, io::uo) is det.

read_call_site_kind_and_callee(InputStream, MaybeKindAndCallee, !IO) :-
    read_deep_byte(InputStream, MaybeByte, !IO),
    (
        MaybeByte = ok(Byte),
        ( if is_call_site_kind(Byte, CallSiteKind) then
            (
                CallSiteKind = normal_call,
                read_num(InputStream, MaybeCSS, !IO),
                (
                    MaybeCSS = ok(CalleeProcStatic),
                    read_string(InputStream, MaybeTypeSubst, !IO),
                    (
                        MaybeTypeSubst = ok(TypeSubst),
                        MaybeKindAndCallee = ok(normal_call_and_callee(
                            proc_static_ptr(CalleeProcStatic), TypeSubst))
                    ;
                        MaybeTypeSubst = error(Error),
                        MaybeKindAndCallee = error(Error)
                    )
                ;
                    MaybeCSS = error(Error),
                    MaybeKindAndCallee = error(Error)
                )
            ;
                CallSiteKind = special_call,
                MaybeKindAndCallee = ok(special_call_and_no_callee)
            ;
                CallSiteKind = higher_order_call,
                MaybeKindAndCallee = ok(higher_order_call_and_no_callee)
            ;
                CallSiteKind = method_call,
                MaybeKindAndCallee = ok(method_call_and_no_callee)
            ;
                CallSiteKind = callback,
                MaybeKindAndCallee = ok(callback_and_no_callee)
            )
        else
            string.format("unexpected call_site_kind %d", [i(Byte)], Msg),
            MaybeKindAndCallee = error(Msg)
        ),
        trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
            io.output_stream(OutputStream, !TIO),
            io.write_string(OutputStream, "call_site_kind_and_callee ", !TIO),
            io.write(OutputStream, MaybeKindAndCallee, !TIO),
            io.write_string(OutputStream, "\n", !TIO)
        )
    ;
        MaybeByte = error(Error),
        MaybeKindAndCallee = error(Error)
    ).

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

:- pred read_n_things(int::in,
    pred(maybe_error(T), io, io)::in(pred(out, di, uo) is det),
    maybe_error(list(T))::out, io::di, io::uo) is det.

read_n_things(N, ItemReader, MaybeItems, !IO) :-
    read_n_things_loop(N, ItemReader, [], MaybeRevItems, !IO),
    (
        MaybeRevItems = ok(RevItems),
        list.reverse(RevItems, Items),
        MaybeItems = ok(Items)
    ;
        MaybeRevItems = error(Error),
        MaybeItems = error(Error)
    ).

:- pred read_n_things_loop(int::in,
    pred(maybe_error(T), io, io)::in(pred(out, di, uo) is det),
    list(T)::in, maybe_error(list(T))::out, io::di, io::uo) is det.

read_n_things_loop(N, ItemReader, RevItems0, MaybeItems, !IO) :-
    ( if N =< 0 then
        MaybeItems = ok(RevItems0)
    else
        call(ItemReader, MaybeItem, !IO),
        (
            MaybeItem = ok(Item),
            read_n_things_loop(N - 1, ItemReader,
                [Item | RevItems0], MaybeItems, !IO)
        ;
            MaybeItem = error(Error),
            MaybeItems = error(Error)
        )
    ).

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

:- pred read_line(io.binary_input_stream::in, int::in,
    maybe_error(string)::out, io::di, io::uo) is det.

read_line(InputStream, Limit, MaybeLine, !IO) :-
    read_line_acc(InputStream, Limit, [], MaybeLine, !IO).

:- pred read_line_acc(io.binary_input_stream::in, int::in, list(char)::in,
    maybe_error(string)::out, io::di, io::uo) is det.

read_line_acc(InputStream, Limit, !.RevChars, MaybeLine, !IO) :-
    ( if Limit > 0 then
        read_byte(InputStream, MaybeByte, !IO),
        (
            MaybeByte = ok(Byte),
            ( if char.to_int(Char, Byte) then
                % Include the newline in the string.
                !:RevChars = [Char | !.RevChars],
                ( if Char = '\n' then
                    list.reverse(!.RevChars, Chars),
                    string.from_char_list(Chars, Str),
                    MaybeLine = ok(Str)
                else
                    read_line_acc(InputStream, Limit - 1, !.RevChars,
                        MaybeLine, !IO)
                )
            else
                MaybeLine = error("unexpected end of file")
            )
        ;
            MaybeByte = eof,
            MaybeLine = error("unexpected end of file")
        ;
            MaybeByte = error(Error),
            io.error_message(Error, Msg),
            MaybeLine = error(Msg)
        )
    else
        list.reverse(!.RevChars, Chars),
        string.from_char_list(Chars, Str),
        MaybeLine = ok(Str)
    ).

:- pred read_string(io.binary_input_stream::in, maybe_error(string)::out,
    io::di, io::uo) is det.

read_string(InputStream, MaybeStr, !IO) :-
    read_num(InputStream, MaybeNum, !IO),
    (
        MaybeNum = ok(Length),
        ( if Length = 0 then
            MaybeStr = ok("")
        else
            read_n_byte_string(InputStream, Length, MaybeStr, !IO)
        )
    ;
        MaybeNum = error(Error),
        MaybeStr = error(Error)
    ).

:- pred read_n_byte_string(io.binary_input_stream::in, int::in,
    maybe_error(string)::out, io::di, io::uo) is det.

read_n_byte_string(InputStream, Length, MaybeStr, !IO) :-
    read_n_bytes(InputStream, Length, MaybeNBytes, !IO),
    (
        MaybeNBytes = ok(Bytes),
        ( if
            list.map((pred(I::in, C::out) is semidet :- char.to_int(C, I)),
                Bytes, Chars)
        then
            string.from_char_list(Chars, Str),
            MaybeStr = ok(Str)
        else
            MaybeStr = error("string contained bad char")
        )
    ;
        MaybeNBytes = error(Error),
        MaybeStr = error(Error)
    ),
    trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
        io.output_stream(OutputStream, !TIO),
        io.write_string(OutputStream, "string ", !TIO),
        io.write(OutputStream, MaybeStr, !TIO),
        io.write_string(OutputStream, "\n", !TIO)
    ).

:- pred read_ptr(io.binary_input_stream::in, ptr_kind::in,
    maybe_error(int)::out, io::di, io::uo) is det.

read_ptr(InputStream, _Kind, MaybePtr, !IO) :-
    read_num(InputStream, MaybePtr, !IO),
    trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
        io.output_stream(OutputStream, !TIO),
        io.write_string(OutputStream, "ptr ", !TIO),
        io.write(OutputStream, MaybePtr, !TIO),
        io.write_string(OutputStream, "\n", !TIO)
    ).

:- pred read_cp_type(io.binary_input_stream::in, maybe_error(cp_type)::out,
    io::di, io::uo) is det.

read_cp_type(InputStream, MaybeCPType, !IO) :-
    read_num(InputStream, MaybeNum, !IO),
    (
        MaybeNum = ok(Num),
        num_to_cp_type(Num, CPType),
        MaybeCPType = ok(CPType)
    ;
        MaybeNum = error(Msg),
        MaybeCPType = error(Msg)
    ).

:- pred num_to_cp_type(int::in, cp_type::out) is det.

:- pragma foreign_proc("C",
    num_to_cp_type(Int::in, CPType::out),
    [will_not_call_mercury, thread_safe, promise_pure],
"
    CPType = Int;
").

:- pred read_num(io.binary_input_stream::in, maybe_error(int)::out,
    io::di, io::uo) is det.

read_num(InputStream, MaybeNum, !IO) :-
    read_num_acc(InputStream, 0, MaybeNum, !IO),
    trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
        io.output_stream(OutputStream, !TIO),
        io.write_string(OutputStream, "num ", !TIO),
        io.write(OutputStream, MaybeNum, !TIO),
        io.write_string(OutputStream, "\n", !TIO)
    ).

:- pred read_num_acc(io.binary_input_stream::in, int::in,
    maybe_error(int)::out, io::di, io::uo) is det.

read_num_acc(InputStream, Num0, MaybeNum, !IO) :-
    read_byte(InputStream, MaybeByte, !IO),
    (
        MaybeByte = ok(Byte),
        Num1 = (Num0 << 7) \/ (Byte /\ 0x7F),
        ( if Byte /\ 0x80 \= 0 then
            read_num_acc(InputStream, Num1, MaybeNum, !IO)
        else
            MaybeNum = ok(Num1)
        )
    ;
        MaybeByte = eof,
        MaybeNum = error("unexpected end of file")
    ;
        MaybeByte = error(Error),
        io.error_message(Error, Msg),
        MaybeNum = error(Msg)
    ).

:- func fixed_size_int_bytes = int.

% Must correspond to MR_FIXED_SIZE_INT_BYTES
% in runtime/mercury_deep_profiling.c.
fixed_size_int_bytes = 8.

:- pred read_fixed_size_int(io.binary_input_stream::in, maybe_error(int)::out,
    io::di, io::uo) is det.

read_fixed_size_int(InputStream, MaybeInt, !IO) :-
    read_fixed_size_int_acc(InputStream, fixed_size_int_bytes, 0, 0,
        MaybeInt, !IO),
    trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
        io.output_stream(OutputStream, !TIO),
        io.format(OutputStream, "fixed size int %s\n",
            [s(string(MaybeInt))], !TIO)
    ).

:- pred read_fixed_size_int_acc(io.binary_input_stream::in, int::in, int::in,
    int::in, maybe_error(int)::out, io::di, io::uo) is det.

read_fixed_size_int_acc(InputStream, BytesLeft, Num0, ShiftBy, MaybeInt,
        !IO) :-
    ( if BytesLeft =< 0 then
        MaybeInt = ok(Num0)
    else
        read_deep_byte(InputStream, MaybeByte, !IO),
        (
            MaybeByte = ok(Byte),
            Num1 = Num0 \/ ( Byte << ShiftBy),
            read_fixed_size_int_acc(InputStream, BytesLeft - 1, Num1,
                ShiftBy + 8, MaybeInt, !IO)
        ;
            MaybeByte = error(Error),
            MaybeInt = error(Error)
        )
    ).

:- pred read_n_bytes(io.binary_input_stream::in, int::in,
    maybe_error(list(int))::out, io::di, io::uo) is det.

read_n_bytes(InputStream, N, MaybeNBytes, !IO) :-
    read_n_bytes_acc(InputStream, N, [], MaybeRevNBytes, !IO),
    (
        MaybeRevNBytes = ok(RevBytes),
        list.reverse(RevBytes, Bytes),
        MaybeNBytes = ok(Bytes)
    ;
        MaybeRevNBytes = error(Error),
        MaybeNBytes = error(Error)
    ).

:- pred read_n_bytes_acc(io.binary_input_stream::in, int::in, list(int)::in,
    maybe_error(list(int))::out, io::di, io::uo) is det.

read_n_bytes_acc(InputStream, N, RevBytes0, MaybeNBytes, !IO) :-
    ( if N =< 0 then
        MaybeNBytes = ok(RevBytes0)
    else
        read_deep_byte(InputStream, MaybeByte, !IO),
        (
            MaybeByte = ok(Byte),
            read_n_bytes_acc(InputStream, N - 1,
                [Byte | RevBytes0], MaybeNBytes, !IO)
        ;
            MaybeByte = error(Error),
            MaybeNBytes = error(Error)
        )
    ).

:- pred read_deep_byte(io.binary_input_stream::in, maybe_error(int)::out,
    io::di, io::uo) is det.

read_deep_byte(InputStream, MaybeByte, !IO) :-
    read_byte(InputStream, MaybeRawByte, !IO),
    (
        MaybeRawByte = ok(Byte),
        MaybeByte = ok(Byte)
    ;
        MaybeRawByte = eof,
        MaybeByte = error("unexpected end of file")
    ;
        MaybeRawByte = error(Error),
        io.error_message(Error, Msg),
        MaybeByte = error(Msg)
    ),
    trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
        io.output_stream(OutputStream, !TIO),
        io.write_string(OutputStream, "byte ", !TIO),
        io.write(OutputStream, MaybeByte, !TIO),
        io.write_string(OutputStream, "\n", !TIO)
    ).

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

:- pred deep_insert(array(T)::in, int::in, T::in, array(T)::out) is det.

deep_insert(A0, Ind, Item, A) :-
    array.max(A0, Max),
    ( if Ind > Max then
        error("deep_insert: array bounds violation")
        % array.lookup(A0, 0, X),
        % array.resize(u(A0), 2 * (Max + 1), X, A1),
        % deep_insert(A1, Ind, Item, A)
    else
        set(Ind, Item, u(A0), A)
    ).

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

:- func make_csdptr(int) = call_site_dynamic_ptr.
:- func make_cssptr(int) = call_site_static_ptr.
:- func make_pdptr(int) = proc_dynamic_ptr.
:- func make_psptr(int) = proc_static_ptr.

make_csdptr(CSDI) = call_site_dynamic_ptr(CSDI).
make_cssptr(CSSI) = call_site_static_ptr(CSSI).
make_pdptr(PDI) = proc_dynamic_ptr(PDI).
make_psptr(PSI) = proc_static_ptr(PSI).

:- func make_dummy_pdptr = proc_dynamic_ptr.
:- func make_dummy_psptr = proc_static_ptr.

make_dummy_pdptr = proc_dynamic_ptr(-1).
make_dummy_psptr = proc_static_ptr(-1).

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

:- pragma foreign_decl("C", "#include ""mercury_deep_profiling.h""").

:- type next_deep_item
    --->    deep_item_end
    ;       deep_item_call_site_static
    ;       deep_item_call_site_dynamic
    ;       deep_item_proc_static
    ;       deep_item_proc_dynamic.

:- pragma foreign_enum("C", next_deep_item/0, [
    deep_item_end                - "MR_deep_item_end",
    deep_item_call_site_static   - "MR_deep_item_call_site_static",
    deep_item_call_site_dynamic  - "MR_deep_item_call_site_dynamic",
    deep_item_proc_static        - "MR_deep_item_proc_static",
    deep_item_proc_dynamic       - "MR_deep_item_proc_dynamic"
]).

:- pred is_next_item_token(int::in, next_deep_item::out) is semidet.

:- pragma foreign_proc("C",
    is_next_item_token(Int::in, NextItem::out),
    [promise_pure, will_not_call_mercury, thread_safe],
"
    NextItem = (MR_DeepProfNextItem) Int;

    switch (NextItem) {
        case MR_deep_item_end:
        case MR_deep_item_call_site_static:
        case MR_deep_item_call_site_dynamic:
        case MR_deep_item_proc_static:
        case MR_deep_item_proc_dynamic:
            SUCCESS_INDICATOR = MR_TRUE;
            break;

        default:
            SUCCESS_INDICATOR = MR_FALSE;
            break;
    }
").

%---------------------------------------------------------------------------%
:- end_module read_profile.
%---------------------------------------------------------------------------%
