mercury/compiler/polymorphism_info.m

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1995-2012 The University of Melbourne.
% Copyright (C) 2014-2015, 2021-2022, 2025 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: polymorphism_info.m.
% Main authors: fjh and zs (when this code was in polymorphism.m).
%
% This module defines the poly_info structure used by polymorphism.m.
%
%---------------------------------------------------------------------------%

:- module check_hlds.polymorphism_info.
:- interface.

:- import_module hlds.
:- import_module hlds.const_struct.
:- import_module hlds.hlds_class.
:- import_module hlds.hlds_clauses.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_rtti.
:- import_module parse_tree.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.var_table.

:- import_module assoc_list.
:- import_module io.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.

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

:- type const_or_var_arg
    --->    cova_const(const_struct_arg)
    ;       cova_var(prog_var).

:- type type_info_var_map ==
    map(type_ctor,
        map(list(mer_type), pair(prog_var, maybe(const_struct_arg)))).

:- type typeclass_info_map_entry
    --->    typeclass_info_map_entry(
                % The cons_id representing the base_typeclass_info.
                cons_id,

                % Maps the arguments of the typeclass_info_cell_constructor
                % after the base_typeclass_info to the variable that holds the
                % typeclass_info for that cell.
                map(list(const_or_var_arg),
                    pair(prog_var, maybe(const_struct_arg)))
            ).

:- type typeclass_info_map ==
    map(class_name, map(list(mer_type), typeclass_info_map_entry)).

:- type int_const_map == map(int, prog_var).

    % If the value that can be a constant structure argument is currently
    % available in a variable, give the id of that variable.
    %
:- type const_struct_var_map == map(const_struct_arg, prog_var).

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

:- type poly_info.

    % Init_poly_info initializes a poly_info from a pred_info and clauses_info.
    % (See also create_poly_info.)
    %
:- pred init_poly_info(module_info::in, pred_info::in, clauses_info::in,
    poly_info::out) is det.

    % Extract some fields from a pred_info and proc_info and use them to
    % create a poly_info, for use by the polymorphism transformation.
    %
:- pred create_poly_info(module_info::in, pred_info::in,
    proc_info::in, poly_info::out) is det.

    % Update the fields in a pred_info and proc_info with
    % the values in a poly_info.
    %
:- pred poly_info_extract(poly_info::in, list(error_spec)::out,
    pred_info::in, pred_info::out, proc_info::in, proc_info::out,
    module_info::out) is det.

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

:- type maybe_must_requantify
    --->    no_must_requantify
    ;       must_requantify.

:- pred poly_info_get_module_info(poly_info::in,
    module_info::out) is det.
:- pred poly_info_get_var_table(poly_info::in,
    var_table::out) is det.
:- pred poly_info_get_rtti_varmaps(poly_info::in,
    rtti_varmaps::out) is det.
:- pred poly_info_get_typevarset(poly_info::in,
    tvarset::out) is det.
:- pred poly_info_get_tvar_kind_map(poly_info::in,
    tvar_kind_map::out) is det.
:- pred poly_info_get_proof_map(poly_info::in,
    constraint_proof_map::out) is det.
:- pred poly_info_get_constraint_map(poly_info::in,
    constraint_map::out) is det.
:- pred poly_info_get_type_info_var_map(poly_info::in,
    type_info_var_map::out) is det.
:- pred poly_info_get_typeclass_info_map(poly_info::in,
    typeclass_info_map::out) is det.
:- pred poly_info_get_int_const_map(poly_info::in,
    int_const_map::out) is det.
:- pred poly_info_get_const_struct_var_map(poly_info::in,
    const_struct_var_map::out) is det.
:- pred poly_info_get_num_reuses(poly_info::in,
    int::out) is det.
:- pred poly_info_get_const_struct_db(poly_info::in,
    const_struct_db::out) is det.
:- pred poly_info_get_defined_where(poly_info::in,
    defined_where::out) is det.
:- pred poly_info_get_must_requantify(poly_info::in,
    maybe_must_requantify::out) is det.
:- pred poly_info_get_errors(poly_info::in,
    list(error_spec)::out) is det.

:- pred poly_info_set_var_table(var_table::in,
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_var_table_rtti(var_table::in, rtti_varmaps::in,
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_rtti_varmaps(rtti_varmaps::in,
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_typevarset(tvarset::in,
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_proof_map(constraint_proof_map::in,
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_type_info_var_map(type_info_var_map::in,
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_typeclass_info_map(typeclass_info_map::in,
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_int_const_map(int_const_map::in,
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_const_struct_var_map(const_struct_var_map::in,
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_num_reuses(int::in,
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_const_struct_db(const_struct_db::in,
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_must_requantify(
    poly_info::in, poly_info::out) is det.
:- pred poly_info_set_errors(list(error_spec)::in,
    poly_info::in, poly_info::out) is det.

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

:- type cache_maps
    --->    cache_maps(
                cm_snapshot_num             :: int,
                cm_type_info_var_map        :: type_info_var_map,
                cm_typeclass_info_map       :: typeclass_info_map,
                cm_int_const_map            :: int_const_map,
                cm_const_struct_var_map     :: const_struct_var_map
            ).

:- pred get_cache_maps_snapshot(string::in, cache_maps::out,
    poly_info::in, poly_info::out) is det.

:- pred set_cache_maps_snapshot(string::in, cache_maps::in,
    poly_info::in, poly_info::out) is det.

:- pred empty_cache_maps(poly_info::in, poly_info::out) is det.

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

:- type var_maps
    --->    var_maps(
                vm_snapshot_num             :: int,
                vm_var_table                :: var_table,
                vm_rtti_varmaps             :: rtti_varmaps,
                vm_cache_maps               :: cache_maps
            ).

:- pred get_var_maps_snapshot(string::in, var_maps::out,
    poly_info::in, poly_info::out) is det.

:- pred set_var_maps_snapshot(string::in, var_maps::in,
    poly_info::in, poly_info::out) is det.

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

:- pred get_poly_const(int::in, prog_var::out, list(hlds_goal)::out,
    poly_info::in, poly_info::out) is det.

:- pred all_are_const_struct_args(
    assoc_list(prog_var, maybe(const_struct_arg))::in,
    list(const_struct_arg)::out) is semidet.

:- pred get_inst_of_const_struct_arg(const_struct_db::in, const_struct_arg::in,
    mer_inst::out) is det.

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

:- type maybe_selected_pred
    --->    is_not_selected_pred
    ;       is_selected_pred.

:- pred poly_info_get_selected_pred(maybe_selected_pred::out,
    io::di, io::uo) is det.
:- pred poly_info_set_selected_pred(maybe_selected_pred::in,
    io::di, io::uo) is det.
:- pred poly_info_get_indent_level(int::out, io::di, io::uo) is det.
:- pred poly_info_set_indent_level(int::in, io::di, io::uo) is det.

:- pred poly_info_get_debug_stream(poly_info::in, io.text_output_stream::out,
    io::di, io::uo) is det.

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

:- implementation.

:- import_module hlds.make_goal.
:- import_module hlds.status.
:- import_module libs.
:- import_module libs.globals.

:- import_module bool.
:- import_module int.
:- import_module string.
:- import_module varset.

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

:- type poly_info
    --->    poly_info(
                poly_module_info            :: module_info,

                poly_var_table              :: var_table,
                poly_rtti_varmaps           :: rtti_varmaps,

                poly_typevarset             :: tvarset,
                poly_tvar_kind_map          :: tvar_kind_map,

                % Specifies why each constraint that was eliminated from the
                % pred was able to be eliminated (this allows us to efficiently
                % construct the dictionary).
                % Note that the rtti_varmaps is separate from the
                % constraint_proof_map, since the second is the information
                % calculated during typechecking, while the first is
                % the information calculated in the polymorphism pass.
                poly_proof_map              :: constraint_proof_map,

                % Specifies the constraints at each location in the goal.
                poly_constraint_map         :: constraint_map,

                % The next four maps hold information about what
                % type_ctor_infos, type_infos, base_typeclass_infos,
                % typeclass_infos and ints are guaranteed to be available
                % (i.e. created by previous code on all execution paths)
                % at the current point in the code, so they can be reused.
                % The fifth field counts the number of times that one of these
                % variables has in fact been reused.
                %
                % The type_infos and typeclass_infos are in the first two maps.
                % The type_ctor_infos and base_typeclass_infos are in the
                % fourth map. The integers are in the third map.
                % The fourth map also caches typeclass_infos for instance ids.
                poly_type_info_var_map      :: type_info_var_map,
                poly_typeclass_info_map     :: typeclass_info_map,
                poly_int_const_map          :: int_const_map,
                poly_const_struct_var_map   :: const_struct_var_map,
                poly_num_reuses             :: int,

                poly_snapshot_num           :: int,

                % The database of constant structures of the module.
                % If a type_info or typeclass_info we construct is a constant
                % term, we allocate it in this database.
                poly_const_struct_db        :: const_struct_db,

                poly_defined_where          :: defined_where,

                poly_must_requantify        :: maybe_must_requantify,

                % The list of errors we have discovered during the polymorphism
                % pass.
                poly_errors                 :: list(error_spec)
            ).

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

init_poly_info(ModuleInfo, PredInfo, ClausesInfo, PolyInfo) :-
    clauses_info_get_var_table(ClausesInfo, VarTable),
    pred_info_get_typevarset(PredInfo, TypeVarSet),
    pred_info_get_tvar_kind_map(PredInfo, TypeVarKinds),
    pred_info_get_constraint_proof_map(PredInfo, ProofMap),
    pred_info_get_constraint_map(PredInfo, ConstraintMap),
    rtti_varmaps_init(RttiVarMaps),
    map.init(TypeInfoVarMap),
    map.init(TypeClassInfoMap),
    map.init(IntConstMap),
    map.init(ConstStructVarMap),
    NumReuses = 0,
    SnapshotNum = 0,
    module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
    pred_info_get_status(PredInfo, PredStatus),
    pred_status_defined_in_this_module(PredStatus) = InThisModule,
    ( InThisModule = yes, DefinedWhere = defined_in_this_module
    ; InThisModule = no,  DefinedWhere = defined_in_other_module
    ),
    Requant = no_must_requantify,
    Specs = [],
    PolyInfo = poly_info(ModuleInfo, VarTable, RttiVarMaps,
        TypeVarSet, TypeVarKinds, ProofMap, ConstraintMap,
        TypeInfoVarMap, TypeClassInfoMap, IntConstMap, ConstStructVarMap,
        NumReuses, SnapshotNum, ConstStructDb, DefinedWhere, Requant, Specs).

create_poly_info(ModuleInfo, PredInfo, ProcInfo, PolyInfo) :-
    pred_info_get_typevarset(PredInfo, TypeVarSet),
    pred_info_get_tvar_kind_map(PredInfo, TypeVarKinds),
    pred_info_get_constraint_proof_map(PredInfo, ProofMap),
    pred_info_get_constraint_map(PredInfo, ConstraintMap),
    proc_info_get_var_table(ProcInfo, VarTable),
    proc_info_get_rtti_varmaps(ProcInfo, RttiVarMaps),
    map.init(TypeInfoVarMap),
    map.init(TypeClassInfoMap),
    map.init(IntConstMap),
    map.init(ConstStructVarMap),
    NumReuses = 0,
    SnapshotNum = 0,
    module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
    pred_info_get_status(PredInfo, PredStatus),
    pred_status_defined_in_this_module(PredStatus) = InThisModule,
    ( InThisModule = yes, DefinedWhere = defined_in_this_module
    ; InThisModule = no,  DefinedWhere = defined_in_other_module
    ),
    Requant = no_must_requantify,
    Specs = [],
    PolyInfo = poly_info(ModuleInfo, VarTable, RttiVarMaps,
        TypeVarSet, TypeVarKinds, ProofMap, ConstraintMap,
        TypeInfoVarMap, TypeClassInfoMap, IntConstMap, ConstStructVarMap,
        NumReuses, SnapshotNum, ConstStructDb, DefinedWhere, Requant, Specs).

poly_info_extract(Info, Specs, !PredInfo, !ProcInfo, !:ModuleInfo) :-
    Info = poly_info(!:ModuleInfo, VarTable, RttiVarMaps,
        TypeVarSet, TypeVarKinds, _ProofMap, _ConstraintMap,
        _TypeInfoVarMap, _TypeClassInfoMap, _IntConstMap, _ConstStructVarMap,
        _NumReuses, _SnapshotNum, ConstStructDb, _DefinedWhere,
        _Requant, Specs),

    module_info_set_const_struct_db(ConstStructDb, !ModuleInfo),

    % Set the new values of the fields in proc_info and pred_info.
    proc_info_set_var_table(VarTable, !ProcInfo),
    proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
    pred_info_set_typevarset(TypeVarSet, !PredInfo),
    pred_info_set_tvar_kind_map(TypeVarKinds, !PredInfo).

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

:- pragma inline(pred(poly_info_get_module_info/2)).
:- pragma inline(pred(poly_info_get_var_table/2)).
:- pragma inline(pred(poly_info_get_rtti_varmaps/2)).
:- pragma inline(pred(poly_info_get_typevarset/2)).
:- pragma inline(pred(poly_info_get_tvar_kind_map/2)).
:- pragma inline(pred(poly_info_get_proof_map/2)).
:- pragma inline(pred(poly_info_get_constraint_map/2)).
:- pragma inline(pred(poly_info_get_type_info_var_map/2)).
:- pragma inline(pred(poly_info_get_typeclass_info_map/2)).
:- pragma inline(pred(poly_info_get_const_struct_var_map/2)).
:- pragma inline(pred(poly_info_get_int_const_map/2)).
:- pragma inline(pred(poly_info_get_num_reuses/2)).
:- pragma inline(pred(poly_info_get_const_struct_db/2)).
:- pragma inline(pred(poly_info_get_errors/2)).

poly_info_get_module_info(PI, X) :-
    X = PI ^ poly_module_info.
poly_info_get_var_table(PI, X) :-
    X = PI ^ poly_var_table.
poly_info_get_rtti_varmaps(PI, X) :-
    X = PI ^ poly_rtti_varmaps.
poly_info_get_typevarset(PI, X) :-
    X = PI ^ poly_typevarset.
poly_info_get_tvar_kind_map(PI, X) :-
    X = PI ^ poly_tvar_kind_map.
poly_info_get_proof_map(PI, X) :-
    X = PI ^ poly_proof_map.
poly_info_get_constraint_map(PI, X) :-
    X = PI ^ poly_constraint_map.
poly_info_get_type_info_var_map(PI, X) :-
    X = PI ^ poly_type_info_var_map.
poly_info_get_typeclass_info_map(PI, X) :-
    X = PI ^ poly_typeclass_info_map.
poly_info_get_int_const_map(PI, X) :-
    X = PI ^ poly_int_const_map.
poly_info_get_const_struct_var_map(PI, X) :-
    X = PI ^ poly_const_struct_var_map.
poly_info_get_num_reuses(PI, X) :-
    X = PI ^ poly_num_reuses.
poly_info_get_const_struct_db(PI, X) :-
    X = PI ^ poly_const_struct_db.
poly_info_get_defined_where(PI, X) :-
    X = PI ^ poly_defined_where.
poly_info_get_must_requantify(PI, X) :-
    X = PI ^ poly_must_requantify.
poly_info_get_errors(PI, X) :-
    X = PI ^ poly_errors.

:- pragma inline(pred(poly_info_set_var_table/3)).
:- pragma inline(pred(poly_info_set_var_table_rtti/4)).
:- pragma inline(pred(poly_info_set_rtti_varmaps/3)).
:- pragma inline(pred(poly_info_set_typevarset/3)).
:- pragma inline(pred(poly_info_set_proof_map/3)).
:- pragma inline(pred(poly_info_set_type_info_var_map/3)).
:- pragma inline(pred(poly_info_set_typeclass_info_map/3)).
:- pragma inline(pred(poly_info_set_int_const_map/3)).
:- pragma inline(pred(poly_info_set_const_struct_var_map/3)).
:- pragma inline(pred(poly_info_set_num_reuses/3)).
:- pragma inline(pred(poly_info_set_const_struct_db/3)).
:- pragma inline(pred(poly_info_set_errors/3)).

poly_info_set_var_table(X, !PI) :-
    !PI ^ poly_var_table := X.
poly_info_set_var_table_rtti(X, Y, !PI) :-
    !:PI = ((!.PI
        ^ poly_var_table := X)
        ^ poly_rtti_varmaps := Y).
poly_info_set_rtti_varmaps(X, !PI) :-
    ( if private_builtin.pointer_equal(X, !.PI ^ poly_rtti_varmaps) then
        true
    else
        !PI ^ poly_rtti_varmaps := X
    ).
poly_info_set_typevarset(X, !PI) :-
    !PI ^ poly_typevarset := X.
poly_info_set_proof_map(X, !PI) :-
    ( if private_builtin.pointer_equal(X, !.PI ^ poly_proof_map) then
        true
    else
        !PI ^ poly_proof_map := X
    ).
poly_info_set_type_info_var_map(X, !PI) :-
    ( if private_builtin.pointer_equal(X, !.PI ^ poly_type_info_var_map) then
        true
    else
        !PI ^ poly_type_info_var_map := X
    ).
poly_info_set_typeclass_info_map(X, !PI) :-
    ( if private_builtin.pointer_equal(X, !.PI ^ poly_typeclass_info_map) then
        true
    else
        !PI ^ poly_typeclass_info_map := X
    ).
poly_info_set_int_const_map(X, !PI) :-
    ( if private_builtin.pointer_equal(X, !.PI ^ poly_int_const_map) then
        true
    else
        !PI ^ poly_int_const_map := X
    ).
poly_info_set_const_struct_var_map(X, !PI) :-
    ( if
        private_builtin.pointer_equal(X, !.PI ^ poly_const_struct_var_map)
    then
        true
    else
        !PI ^ poly_const_struct_var_map := X
    ).
poly_info_set_num_reuses(X, !PI) :-
    ( if X = !.PI ^ poly_num_reuses then
        true
    else
        !PI ^ poly_num_reuses := X
    ).
poly_info_set_const_struct_db(X, !PI) :-
    ( if private_builtin.pointer_equal(X, !.PI ^ poly_const_struct_db) then
        true
    else
        !PI ^ poly_const_struct_db := X
    ).
poly_info_set_must_requantify(!PI) :-
    !PI ^ poly_must_requantify := must_requantify.
poly_info_set_errors(X, !PI) :-
    !PI ^ poly_errors := X.

%  i      read      same      diff   same%
%  0   6245285         0   1560789   0.000% varset
%  1   6662703         0         0          vartypes
%  2         0      1110    129008   0.853% varset, vartypes
% 17         0    131468   1961967   6.280% varset, vartypes, rtti_varmaps
%  3   3052707         4    245972   0.002% typevarset
%  4   1578929         0         0          tvar_kind_map
%  5   8959328   2116731    988195  68.173% rtti_varmaps
%  6     14812      3980      4058  49.515% proof_map
%  7   3030093         0         0          constraint_map
%  8    811687    776589    288951  72.882% type_info_var_map
%  9    385071    863384      6104  99.298% typeclass_info_map
% 10    385706    863310      8464  99.029% int_const_map
% 11    253310    331092     41528  88.855% num_reuses
% 12   2559364     25821     15631  62.291% const_struct_db
% 13    583633    780835    286464  73.160% const_struct_var_map
% 14         0         0         0          pred_info
% 15   3933469         0         0          module_info
% 16         0    431065     87104  83.190% cache_maps_snapshot

% :- pragma foreign_decl("C", local,
% "
% #define MR_NUM_INFO_STATS    18
% unsigned long MR_stats_read[MR_NUM_INFO_STATS];
% unsigned long MR_stats_same[MR_NUM_INFO_STATS];
% unsigned long MR_stats_diff[MR_NUM_INFO_STATS];
% ").
%
% :- pred gather_poly_info_read_stats(int::in,
%     poly_info::in, poly_info::out) is det.
%
% :- pragma foreign_proc("C",
%     gather_poly_info_read_stats(N::in, PI0::in, PI::out),
%     [will_not_call_mercury, promise_pure],
% "
%     ++MR_stats_read[N];
%     PI = PI0;
% ").
%
% :- pred gather_poly_info_write_stats(int::in, T::in, T::in,
%     poly_info::in, poly_info::out) is det.
%
% :- pragma foreign_proc("C",
%     gather_poly_info_write_stats(N::in, Old::in, New::in,
%         PI0::in, PI::out),
%     [will_not_call_mercury, promise_pure],
% "
%     if (((MR_Unsigned) Old) == ((MR_Unsigned) New)) {
%         ++MR_stats_same[N];
%     } else {
%         ++MR_stats_diff[N];
%     }
%
%     PI = PI0;
% ").
%
% :- pred gather_poly_info_write_stats_2(int::in, T::in, T::in, U::in, U::in,
%     poly_info::in, poly_info::out) is det.
%
% :- pragma foreign_proc("C",
%     gather_poly_info_write_stats_2(N::in, OldA::in, NewA::in,
%         OldB::in, NewB::in, PI0::in, PI::out),
%     [will_not_call_mercury, promise_pure],
% "
%     if ((((MR_Unsigned) OldA) == ((MR_Unsigned) NewA)) &&
%         (((MR_Unsigned) OldB) == ((MR_Unsigned) NewB)))
%     {
%         ++MR_stats_same[N];
%     } else {
%         ++MR_stats_diff[N];
%     }
%
%     PI = PI0;
% ").
%
% :- pred gather_poly_info_write_stats_3(int::in, T::in, T::in, U::in, U::in,
%     V::in, V::in, poly_info::in, poly_info::out) is det.
%
% :- pragma foreign_proc("C",
%     gather_poly_info_write_stats_3(N::in, OldA::in, NewA::in,
%         OldB::in, NewB::in, OldC::in, NewC::in, PI0::in, PI::out),
%     [will_not_call_mercury, promise_pure],
% "
%     if ((((MR_Unsigned) OldA) == ((MR_Unsigned) NewA)) &&
%         (((MR_Unsigned) OldB) == ((MR_Unsigned) NewB)) &&
%         (((MR_Unsigned) OldC) == ((MR_Unsigned) NewC)))
%     {
%         ++MR_stats_same[N];
%     } else {
%         ++MR_stats_diff[N];
%     }
%
%     PI = PI0;
% ").
%
% :- interface.
% :- import_module io.
% :- pred write_poly_info_stats(io::di, io::uo) is det.
% :- implementation.
%
% :- pragma foreign_proc("C",
%     write_poly_info_stats(IO0::di, IO::uo),
%     [will_not_call_mercury, promise_pure],
% "
%     FILE *fp;
%
%     fp = fopen(""/tmp/POLY_INFO_STATS"", ""a"");
%     if (fp != NULL) {
%         int i;
%         for (i = 0; i < MR_NUM_INFO_STATS; i++) {
%             fprintf(fp, ""stat_rsd %d %lu %lu %lu\\n"",
%                 i, MR_stats_read[i], MR_stats_same[i], MR_stats_diff[i]);
%         }
%     }
%
%     IO = IO0;
% ").

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

get_cache_maps_snapshot(Name, CacheMaps, !Info) :-
    poly_info_get_type_info_var_map(!.Info, TypeInfoVarMap),
    poly_info_get_typeclass_info_map(!.Info, TypeClassInfoMap),
    poly_info_get_int_const_map(!.Info, IntConstMap),
    poly_info_get_const_struct_var_map(!.Info, ConstStructVarMap),

    SnapshotNum = !.Info ^ poly_snapshot_num,
    CacheMaps = cache_maps(SnapshotNum, TypeInfoVarMap, TypeClassInfoMap,
        IntConstMap, ConstStructVarMap),
    !Info ^ poly_snapshot_num := SnapshotNum + 1,

    trace [compiletime(flag("debug_poly_caches")), io(!IO)] (
        get_selected_pred(SelectedPred, !IO),
        get_indent_level(Level, !IO),
        ( if
            SelectedPred = is_selected_pred,
            Name \= ""
        then
            poly_info_get_debug_stream(!.Info, Stream, !IO),
            IndentStr = string.duplicate_char(' ', Level * 4),
            poly_info_get_var_table(!.Info, VarTable),
            var_table_count(VarTable, NumVars),
            io.format(Stream, "%sget_cache_maps_snapshot %d %s\n",
                [s(IndentStr), i(SnapshotNum), s(Name)], !IO),
            io.format(Stream, "%snum_allocated vars: %d\n\n",
                [s(IndentStr), i(NumVars)], !IO)
        else
            true
        )
    ).

set_cache_maps_snapshot(Name, CacheMaps, !Info) :-
    CacheMaps = cache_maps(SnapshotNum, TypeInfoVarMap, TypeClassInfoMap,
        IntConstMap, ConstStructVarMap),
    ( if
        private_builtin.pointer_equal(TypeInfoVarMap,
            !.Info ^ poly_type_info_var_map),
        private_builtin.pointer_equal(TypeClassInfoMap,
            !.Info ^ poly_typeclass_info_map),
        private_builtin.pointer_equal(IntConstMap,
            !.Info ^ poly_int_const_map),
        private_builtin.pointer_equal(ConstStructVarMap,
            !.Info ^ poly_const_struct_var_map)
    then
        true
    else
        !:Info = ((((!.Info
            ^ poly_type_info_var_map := TypeInfoVarMap)
            ^ poly_typeclass_info_map := TypeClassInfoMap)
            ^ poly_int_const_map := IntConstMap)
            ^ poly_const_struct_var_map := ConstStructVarMap)
    ),

    trace [compiletime(flag("debug_poly_caches")), io(!IO)] (
        get_selected_pred(SelectedPred, !IO),
        get_indent_level(Level, !IO),
        ( if
            SelectedPred = is_selected_pred,
            Name \= ""
        then
            poly_info_get_debug_stream(!.Info, Stream, !IO),
            IndentStr = string.duplicate_char(' ', Level * 4),
            poly_info_get_var_table(!.Info, VarTable),
            var_table_count(VarTable, NumVars),

            io.format(Stream, "%sset_cache_maps_snapshot %d %s\n",
                [s(IndentStr), i(SnapshotNum), s(Name)], !IO),
            io.format(Stream, "%snum_allocated vars: %d\n\n",
                [s(IndentStr), i(NumVars)], !IO),

            io.format(Stream, "%stype_info_var_map ", [s(IndentStr)], !IO),
            io.write_line(Stream, CacheMaps ^ cm_type_info_var_map, !IO),
            io.format(Stream, "%stypeclass_info_map ",
                [s(IndentStr)], !IO),
            io.write_line(Stream, CacheMaps ^ cm_typeclass_info_map, !IO),
            io.format(Stream, "%sstruct_var_map ", [s(IndentStr)], !IO),
            io.write_line(Stream,
                CacheMaps ^ cm_const_struct_var_map, !IO),
            io.nl(Stream, !IO)
        else
            true
        )
    ).

empty_cache_maps(!Info) :-
    poly_info_set_type_info_var_map(map.init, !Info),
    poly_info_set_typeclass_info_map(map.init, !Info),
    poly_info_set_int_const_map(map.init, !Info),
    poly_info_set_const_struct_var_map(map.init, !Info).

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

get_var_maps_snapshot(Name, VarMaps, !Info) :-
    SnapshotNum = !.Info ^ poly_snapshot_num,
    poly_info_get_var_table(!.Info, VarTable),
    poly_info_get_rtti_varmaps(!.Info, RttiVarMaps),

    trace [compiletime(flag("debug_poly_caches")), io(!IO)] (
        get_selected_pred(SelectedPred, !IO),
        get_indent_level(Level, !IO),
        (
            SelectedPred = is_not_selected_pred
        ;
            SelectedPred = is_selected_pred,
            poly_info_get_debug_stream(!.Info, Stream, !IO),
            IndentStr = string.duplicate_char(' ', Level * 4),
            var_table_count(VarTable, NumVars),
            io.format(Stream, "%sget_var_maps_snapshot %d %s\n",
                [s(IndentStr), i(SnapshotNum), s(Name)], !IO),
            io.format(Stream, "%snum_allocated vars: %d\n\n",
                [s(IndentStr), i(NumVars)], !IO)
        )
    ),

    get_cache_maps_snapshot("", CacheMaps, !Info),
    VarMaps = var_maps(SnapshotNum, VarTable, RttiVarMaps, CacheMaps).

set_var_maps_snapshot(Name, VarMaps, !Info) :-
    VarMaps = var_maps(SnapshotNum, VarTable, RttiVarMaps, CacheMaps),

    trace [compiletime(flag("debug_poly_caches")), io(!IO)] (
        get_selected_pred(SelectedPred, !IO),
        get_indent_level(Level, !IO),
        (
            SelectedPred = is_not_selected_pred
        ;
            SelectedPred = is_selected_pred,
            poly_info_get_debug_stream(!.Info, Stream, !IO),
            IndentStr = string.duplicate_char(' ', Level * 4),
            io.format(Stream, "%sset_var_maps_snapshot %d %s\n",
                [s(IndentStr), i(SnapshotNum), s(Name)], !IO),

            io.format(Stream, "%stype_info_var_map ",
                [s(IndentStr)], !IO),
            io.write_line(Stream, CacheMaps ^ cm_type_info_var_map, !IO),
            io.format(Stream, "%stypeclass_info_map ",
                [s(IndentStr)], !IO),
            io.write_line(Stream, CacheMaps ^ cm_typeclass_info_map, !IO),
            io.format(Stream, "%sstruct_var_map ", [s(IndentStr)], !IO),
            io.write_line(Stream,
                CacheMaps ^ cm_const_struct_var_map, !IO),
            io.nl(Stream, !IO)
        )
    ),

    poly_info_set_var_table_rtti(VarTable, RttiVarMaps, !Info),
    set_cache_maps_snapshot("", CacheMaps, !Info).

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

get_poly_const(IntConst, IntVar, Goals, !Info) :-
    poly_info_get_int_const_map(!.Info, IntConstMap0),
    ( if map.search(IntConstMap0, IntConst, IntVarPrime) then
        poly_info_get_num_reuses(!.Info, NumReuses),
        poly_info_set_num_reuses(NumReuses + 1, !Info),
        IntVar = IntVarPrime,
        Goals = []
    else
        Name = "PolyConst" ++ string.int_to_string(IntConst),
        poly_info_get_var_table(!.Info, VarTable0),
        make_int_const_construction_alloc(IntConst, Name, Goal, IntVar,
            VarTable0, VarTable),
        poly_info_set_var_table(VarTable, !Info),
        map.det_insert(IntConst, IntVar, IntConstMap0, IntConstMap),
        poly_info_set_int_const_map(IntConstMap, !Info),
        Goals = [Goal]
    ).

all_are_const_struct_args([], []).
all_are_const_struct_args([VarMCA | VarsMCAs], [ConstArg | ConstArgs]) :-
    VarMCA = _Var - MCA,
    MCA = yes(ConstArg),
    all_are_const_struct_args(VarsMCAs, ConstArgs).

get_inst_of_const_struct_arg(ConstStructDb, ConstArg, Inst) :-
    (
        ConstArg = csa_constant(ConsId, _),
        Inst = bound(shared, inst_test_results_fgtc,
            [bound_functor(ConsId, [])])
    ;
        ConstArg = csa_const_struct(StructNum),
        lookup_const_struct_num(ConstStructDb, StructNum, Struct),
        Struct = const_struct(_, _, _, Inst, _)
    ).

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

:- mutable(selected_pred, maybe_selected_pred, is_not_selected_pred, ground,
    [untrailed, attach_to_io_state]).
:- mutable(indent_level, int, 0, ground,
    [untrailed, attach_to_io_state]).

poly_info_get_selected_pred(Selected, !IO) :-
    get_selected_pred(Selected, !IO).

poly_info_set_selected_pred(Selected, !IO) :-
    set_selected_pred(Selected, !IO).

poly_info_get_indent_level(Level, !IO) :-
    get_indent_level(Level, !IO).

poly_info_set_indent_level(Level, !IO) :-
    set_indent_level(Level, !IO).

poly_info_get_debug_stream(PolyInfo, Stream, !IO) :-
    poly_info_get_module_info(PolyInfo, ModuleInfo),
    module_info_get_globals(ModuleInfo, Globals),
    module_info_get_name(ModuleInfo, ModuleName),
    get_debug_output_stream(Globals, ModuleName, Stream, !IO).

%---------------------------------------------------------------------------%
:- end_module check_hlds.polymorphism_info.
%---------------------------------------------------------------------------%