Files
mercury/compiler/ml_unify_gen_test.m
Zoltan Somogyi ee9c7d3a84 Speed up bound vs ground inst checks.
The code that checks whether a bound inst wrapped around
a list of bound_functors matched the ground inst did several things
in a suboptimal fashion.

- It looked up the definition of the type constructor of the relevant type
  (the type of the variable the inst is for) more than once. (This was
  not easily visible because the lookups were in different predicates.)
  This diff factors these out, not for the immesurably small speedup,
  but to make possible the fixes for the next two issues.

- To simplify the "is there a bound_functor for each constructor in the type"
  check, it sorted the constructors of the type by name and arity. (Lists of
  bound_functors are always sorted by name and arity.) Given that most
  modules contain more than one bound inst for any given type constructor,
  any sorting after the first was unnecessarily repeated work. This diff
  therefore extends the representation of du types, which until now has
  include only a list of the data constructors in the type definition
  in definition order, with a list of those exact same data constructors
  in name/arity order.

- Even if a list of bound_functors lists all the constructors of a type,
  the bound inst containing them is not equivalent to ground if the inst
  of some argument of some bound_inst is not equivalent to ground.
  This means that we need to know the actual argument of each constructor.
  The du type definition lists argument types that refer to the type
  constructor's type parameters; we need the instances of these argument types
  that apply to type of the variable at hand, which usually binds concrete
  types to those type parameters.

  We used to apply the type-parameter-to-actual-type substitution to
  each argument of each data constructor in the type before we compared
  the resulting filled-in data constructor descriptions against the list of
  bound_functors. However, in cases where the comparison fails, the
  substitution applications to arguments beyond the point of failure
  are all wasted work. This diff therefore applies the substitution
  only when its result is about to be needed.

This diff leads to a speedup of about 3.5% on tools/speedtest,
and about 38% (yes, more than a third) when compiling options.m.

compiler/hlds_data.m:
    Add the new field to the representation of du types.

    Add a utility predicate that helps construct that field, since it is
    now needed by two modules (add_type.m and equiv_type_hlds.m).

    Delete two functions that were used only by det_check_switch.m,
    which this diff moves to that module (in modified form).

compiler/inst_match.m:
    Implement the first and third changes listed above, and take advantage
    of the second.

    The old call to all_du_ctor_arg_types, which this diff replaces,
    effectively lied about the list of constructors it returned,
    by simply not returning any constructors containing existentially
    quantified  types, on the grounds that they "were not handled yet".
    We now fail explicitly when we find any such constructors.

    Perform the check for one-to-one match between bound_functors and
    constructors with less argument passing.

compiler/det_check_switch.m:
    Move the code deleted from hlds_data.m here, and simplify it,
    taking advantage of the new field in du types.

compiler/Mercury.options:
    Specify --optimize-constructor-last-call for det_check_switch.m
    to optimize the updated moved code.

compiler/add_foreign_enum.m:
compiler/add_special_pred.m:
compiler/add_type.m:
compiler/check_typeclass.m:
compiler/code_info.m:
compiler/dead_proc_elim.m:
compiler/direct_arg_in_out.m:
compiler/du_type_layout.m:
compiler/equiv_type_hlds.m:
compiler/hlds_out_type_table.m:
compiler/inst_check.m:
compiler/intermod.m:
compiler/intermod_decide.m:
compiler/lookup_switch_util.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen_test.m:
compiler/ml_unify_gen_util.m:
compiler/mlds.m:
compiler/post_term_analysis.m:
compiler/recompilation.usage.m:
compiler/resolve_unify_functor.m:
compiler/simplify_goal_ite.m:
compiler/table_gen.m:
compiler/tag_switch_util.m:
compiler/term_norm.m:
compiler/type_ctor_info.m:
compiler/type_util.m:
compiler/typecheck_coerce.m:
compiler/unify_proc.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
    Conform to the changes above. This mostly means handling
    the new field in du types (usually by ignoring it).
2025-11-19 22:09:04 +11:00

396 lines
16 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1999-2012 The University of Melbourne.
% Copyright (C) 2014, 2018, 2021-2022, 2024-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.
%---------------------------------------------------------------------------%
:- module ml_backend.ml_unify_gen_test.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_data.
:- import_module ml_backend.ml_gen_info.
:- import_module ml_backend.mlds.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module list.
%---------------------------------------------------------------------------%
% ml_generate_test_var_has_cons_id(Var, ConsId, TestRval, !Info):
%
% We generate the boolean rval TestRval, which will evaluate to true
% iff Var has the functor specified by ConsId.
%
:- pred ml_generate_test_var_has_cons_id(ml_gen_info::in, prog_var::in,
cons_id::in, mlds_rval::out) is det.
%---------------------------------------------------------------------------%
% ml_generate_test_var_has_tagged_cons_id(Var,
% MainTaggedConsId, OtherTaggedConsIds, TestRval, !Info):
%
% We generate the boolean rval TestRval, which will evaluate to true
% iff Var's functor is one of those specified by MainTaggedConsId
% or OtherTaggedConsIds.
%
% Exported for use by ml_switch_gen.m.
%
:- pred ml_generate_test_var_has_one_tagged_cons_id(ml_gen_info::in,
prog_var::in, tagged_cons_id::in, list(tagged_cons_id)::in,
mlds_rval::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module backend_libs.
:- import_module backend_libs.builtin_ops.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module libs.
:- import_module libs.globals.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module ml_backend.ml_code_util.
:- import_module ml_backend.ml_unify_gen_util.
:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.var_table.
:- import_module maybe.
:- import_module require.
:- import_module term.
:- import_module uint.
:- import_module uint8.
%---------------------------------------------------------------------------%
ml_generate_test_var_has_cons_id(Info, Var, ConsId, TestRval) :-
% NOTE: Keep in sync with ml_generate_test_var_has_one_tagged_cons_id
% below.
ml_gen_info_get_var_table(Info, VarTable),
lookup_var_entry(VarTable, Var, VarEntry),
VarType = VarEntry ^ vte_type,
ml_gen_var(Info, Var, VarEntry, VarLval),
VarRval = ml_lval(VarLval),
ml_cons_id_to_tag(Info, ConsId, ConsTag),
ml_get_maybe_cheaper_tag_test(Info, VarType, CheaperTagTest),
ml_generate_test_rval_has_cons_tag(Info, VarRval, VarType,
CheaperTagTest, ConsTag, TestRval).
%---------------------------------------------------------------------------%
ml_generate_test_var_has_one_tagged_cons_id(Info, Var,
MainTaggedConsId, OtherTaggedConsIds, TestRval) :-
% NOTE: Keep in sync with ml_generate_test_var_has_cons_id above.
ml_gen_info_get_var_table(Info, VarTable),
lookup_var_entry(VarTable, Var, VarEntry),
VarType = VarEntry ^ vte_type,
ml_gen_var(Info, Var, VarEntry, VarLval),
VarRval = ml_lval(VarLval),
ml_get_maybe_cheaper_tag_test(Info, VarType, CheaperTagTest),
ml_generate_test_rval_has_tagged_cons_id(Info, VarRval, VarType,
CheaperTagTest, MainTaggedConsId, MainTestRval),
list.map(
ml_generate_test_rval_has_tagged_cons_id(Info, VarRval, VarType,
CheaperTagTest),
OtherTaggedConsIds, OtherTestRvals),
ml_logical_or_rvals(MainTestRval, OtherTestRvals, TestRval).
% logical_or_rvals(FirstRval, LaterRvals, Rval):
%
% Rval is true iff any one of FirstRval and LaterRvals is true.
%
:- pred ml_logical_or_rvals(mlds_rval::in, list(mlds_rval)::in, mlds_rval::out)
is det.
ml_logical_or_rvals(FirstRval, LaterRvals, Rval) :-
(
LaterRvals = [],
Rval = FirstRval
;
LaterRvals = [SecondRval | OtherRvals],
FirstSecondRval = ml_binop(logical_or, FirstRval, SecondRval),
ml_logical_or_rvals(FirstSecondRval, OtherRvals, Rval)
).
%---------------------------------------------------------------------------%
:- pred ml_generate_test_rval_has_tagged_cons_id(ml_gen_info::in,
mlds_rval::in, mer_type::in, maybe_cheaper_tag_test::in,
tagged_cons_id::in, mlds_rval::out) is det.
ml_generate_test_rval_has_tagged_cons_id(Info, Rval, Type, CheaperTagTest,
TaggedConsId, TestRval) :-
TaggedConsId = tagged_cons_id(_ConsId, ConsTag),
ml_generate_test_rval_has_cons_tag(Info, Rval, Type, CheaperTagTest,
ConsTag, TestRval).
% ml_generate_test_rval_has_cons_tag(Info, VarRval, VarType, ConsTag,
% TestRval):
%
% TestRval is an rval of type bool which evaluates to true if VarRval,
% which has type VarType, has the specified ConsTag, and false otherwise.
%
:- pred ml_generate_test_rval_has_cons_tag(ml_gen_info::in,
mlds_rval::in, mer_type::in, maybe_cheaper_tag_test::in, cons_tag::in,
mlds_rval::out) is det.
ml_generate_test_rval_has_cons_tag(Info, VarRval, VarType, CheaperTagTest,
ConsTag, TestRval) :-
( if
CheaperTagTest = cheaper_tag_test(_ExpensiveConsId, ExpensiveConsTag,
_CheapConsId, CheapConsTag),
ConsTag = ExpensiveConsTag
then
ml_generate_test_rval_has_cons_tag_direct(Info, VarRval, VarType,
CheapConsTag, CheapConsTagTestRval),
( if
CheapConsTagTestRval =
ml_binop(int_cmp(IntType, eq), SubRvalA, SubRvalB)
then
TestRval = ml_binop(int_cmp(IntType, ne), SubRvalA, SubRvalB)
else
TestRval = ml_unop(logical_not, CheapConsTagTestRval)
)
else
ml_generate_test_rval_has_cons_tag_direct(Info, VarRval, VarType,
ConsTag, TestRval)
).
:- pred ml_generate_test_rval_has_cons_tag_direct(ml_gen_info::in,
mlds_rval::in, mer_type::in, cons_tag::in, mlds_rval::out) is det.
ml_generate_test_rval_has_cons_tag_direct(Info, VarRval, Type,
ConsTag, TestRval) :-
(
ConsTag = int_tag(IntTag),
ml_gen_info_get_module_info(Info, ModuleInfo),
ml_generate_test_rval_is_int_tag(ModuleInfo, VarRval, Type, IntTag,
TestRval)
;
ConsTag = float_tag(Float),
TestRval = ml_binop(float_cmp(eq),
VarRval, ml_const(mlconst_float(Float)))
;
ConsTag = string_tag(String),
TestRval = ml_binop(str_cmp(eq),
VarRval, ml_const(mlconst_string(String)))
;
ConsTag = foreign_tag(ForeignLang, ForeignVal),
ml_gen_info_get_module_info(Info, ModuleInfo),
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
TestRval = ml_binop(int_cmp(int_type_int, eq), VarRval,
ml_const(mlconst_foreign(ForeignLang, ForeignVal, MLDS_Type)))
;
( ConsTag = dummy_tag
; ConsTag = no_tag
),
% In a type with only one cons_id, all vars have that one cons_id.
TestRval = ml_const(mlconst_true)
;
ConsTag = direct_arg_tag(Ptag),
VarPtag = ml_unop(tag, VarRval),
Ptag = ptag(PtagUint8),
% XXX ARG_PACK We should get the tag unop to return an unsigned int,
% to make using an unsigned comparison here simpler.
PtagConstRval = ml_const(mlconst_int(uint8.cast_to_int(PtagUint8))),
TestRval = ml_binop(int_cmp(int_type_int, eq), VarPtag, PtagConstRval)
;
ConsTag = remote_args_tag(RemoteArgsTagInfo),
(
RemoteArgsTagInfo = remote_args_only_functor,
% In a type with only one cons_id, all vars have that one cons_id.
TestRval = ml_const(mlconst_true)
;
RemoteArgsTagInfo = remote_args_unshared(Ptag),
VarPtag = ml_unop(tag, VarRval),
Ptag = ptag(PtagUint8),
PtagConstRval =
ml_const(mlconst_int(uint8.cast_to_int(PtagUint8))),
TestRval = ml_binop(int_cmp(int_type_int, eq),
VarPtag, PtagConstRval)
;
RemoteArgsTagInfo = remote_args_shared(Ptag, RemoteSectag),
VarPtag = ml_unop(tag, VarRval),
Ptag = ptag(PtagUint8),
ConstPtagRval =
ml_const(mlconst_int(uint8.cast_to_int(PtagUint8))),
PtagTestRval = ml_binop(int_cmp(int_type_int, eq),
VarPtag, ConstPtagRval),
ml_gen_secondary_tag_rval(Info, Type, VarRval, Ptag,
VarSectagWordRval),
RemoteSectag = remote_sectag(SectagUint, SectagSize),
(
SectagSize = rsectag_word,
VarSectagRval = VarSectagWordRval
;
SectagSize = rsectag_subword(SectagBits),
SectagBits = sectag_bits(_NumSectagBits, SectagMask),
VarSectagRval = ml_binop(bitwise_and(int_type_uint),
VarSectagWordRval, ml_const(mlconst_uint(SectagMask)))
),
ConstSectagRval =
ml_const(mlconst_int(uint.cast_to_int(SectagUint))),
SectagTestRval = ml_binop(int_cmp(int_type_int, eq),
VarSectagRval, ConstSectagRval),
TestRval = ml_binop(logical_and, PtagTestRval, SectagTestRval)
;
RemoteArgsTagInfo = remote_args_ctor(Data),
Ptag = ptag(0u8),
ml_gen_secondary_tag_rval(Info, Type, VarRval, Ptag,
VarSectagRval),
ConstSectagRval = ml_const(mlconst_int(uint.cast_to_int(Data))),
TestRval = ml_binop(int_cmp(int_type_int, eq),
VarSectagRval, ConstSectagRval)
)
;
ConsTag = local_args_tag(LocalArgsTagInfo),
(
LocalArgsTagInfo = local_args_only_functor,
% In a type with only one cons_id, all vars have that one cons_id.
TestRval = ml_const(mlconst_true)
;
LocalArgsTagInfo = local_args_not_only_functor(_Ptag, LocalSectag),
% We generate the same test as for shared_local_tag_no_args
% with lsectag_must_be_masked.
LocalSectag = local_sectag(_Sectag, PrimSec, SectagBits),
ConstPrimSecRval = ml_const(mlconst_uint(PrimSec)),
ml_gen_info_get_num_ptag_bits(Info, NumPtagBits),
SectagBits = sectag_bits(NumSectagBits, _SectagMask),
NumPtagSectagBits = uint8.cast_to_int(NumPtagBits + NumSectagBits),
PrimSecMask = (1u << NumPtagSectagBits) - 1u,
MaskedVarRval = ml_binop(bitwise_and(int_type_uint),
VarRval, ml_const(mlconst_uint(PrimSecMask))),
% There is no need for a cast, since the Java backend
% does not support local secondary tags that must be masked.
TestRval = ml_binop(int_cmp(int_type_uint, eq),
MaskedVarRval, ConstPrimSecRval)
)
;
ConsTag = shared_local_tag_no_args(_Ptag, LocalSectag, MustMask),
LocalSectag = local_sectag(_Sectag, PrimSec, SectagBits),
ConstPrimSecRval = ml_const(mlconst_uint(PrimSec)),
(
MustMask = lsectag_always_rest_of_word,
ml_gen_info_get_module_info(Info, ModuleInfo),
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
% The cast is needed only by the Java backend.
TestRval = ml_binop(int_cmp(int_type_int, eq),
VarRval, ml_cast(MLDS_Type, ConstPrimSecRval))
;
MustMask = lsectag_must_be_masked,
% We generate the same test as for shared_local_tag_with_args.
ml_gen_info_get_num_ptag_bits(Info, NumPtagBits),
SectagBits = sectag_bits(NumSectagBits, _SectagMask),
NumPtagSectagBits = uint8.cast_to_int(NumPtagBits + NumSectagBits),
PrimSecMask = (1u << NumPtagSectagBits) - 1u,
MaskedVarRval = ml_binop(bitwise_and(int_type_uint),
VarRval, ml_const(mlconst_uint(PrimSecMask))),
% There is no need for a cast, since the Java backend
% does not support local secondary tags that must be masked.
TestRval = ml_binop(int_cmp(int_type_uint, eq),
MaskedVarRval, ConstPrimSecRval)
)
;
( ConsTag = closure_tag(_, _)
; ConsTag = type_ctor_info_tag(_, _, _)
; ConsTag = base_typeclass_info_tag(_, _, _)
; ConsTag = type_info_const_tag(_)
; ConsTag = typeclass_info_const_tag(_)
; ConsTag = ground_term_const_tag(_, _)
; ConsTag = tabling_info_tag(_, _)
; ConsTag = deep_profiling_proc_layout_tag(_, _)
; ConsTag = table_io_entry_tag(_, _)
),
unexpected($pred, "unexpacted ConsTag")
).
:- pred ml_generate_test_rval_is_int_tag(module_info::in, mlds_rval::in,
mer_type::in, int_tag::in, mlds_rval::out) is det.
ml_generate_test_rval_is_int_tag(ModuleInfo, Rval, Type, IntTag, TestRval) :-
% Keep this code in sync with ml_int_tag_to_rval_const in ml_code_util.m.
(
IntTag = int_tag_int(Int),
( if Type = int_type then
Const = mlconst_int(Int)
else if Type = char_type then
Const = mlconst_char(Int)
else
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
Const = mlconst_enum(Int, MLDS_Type)
),
EqType = int_type_int
;
IntTag = int_tag_uint(UInt),
EqType = int_type_uint,
Const = mlconst_uint(UInt)
;
IntTag = int_tag_int8(Int8),
EqType = int_type_int8,
Const = mlconst_int8(Int8)
;
IntTag = int_tag_uint8(UInt8),
EqType = int_type_uint8,
Const = mlconst_uint8(UInt8)
;
IntTag = int_tag_int16(Int16),
EqType = int_type_int16,
Const = mlconst_int16(Int16)
;
IntTag = int_tag_uint16(UInt16),
EqType = int_type_uint16,
Const = mlconst_uint16(UInt16)
;
IntTag = int_tag_int32(Int32),
EqType = int_type_int32,
Const = mlconst_int32(Int32)
;
IntTag = int_tag_uint32(UInt32),
EqType = int_type_uint32,
Const = mlconst_uint32(UInt32)
;
IntTag = int_tag_int64(Int64),
EqType = int_type_int64,
Const = mlconst_int64(Int64)
;
IntTag = int_tag_uint64(UInt64),
EqType = int_type_uint64,
Const = mlconst_uint64(UInt64)
),
TestRval = ml_binop(int_cmp(EqType, eq), Rval, ml_const(Const)).
%---------------------------------------------------------------------------%
:- pred ml_get_maybe_cheaper_tag_test(ml_gen_info::in, mer_type::in,
maybe_cheaper_tag_test::out) is det.
ml_get_maybe_cheaper_tag_test(Info, Type, CheaperTagTest) :-
ml_gen_info_get_module_info(Info, ModuleInfo),
type_to_ctor_det(Type, TypeCtor),
module_info_get_type_table(ModuleInfo, TypeTable),
( if
search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
get_type_defn_body(TypeDefn, TypeBody),
TypeBody = hlds_du_type(type_body_du(_, _, _, _, MaybeRepn, _)),
MaybeRepn = yes(Repn)
then
CheaperTagTest = Repn ^ dur_cheaper_tag_test
else
CheaperTagTest = no_cheaper_tag_test
).
%---------------------------------------------------------------------------%
:- end_module ml_backend.ml_unify_gen_test.
%---------------------------------------------------------------------------%