mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
390 lines
16 KiB
Mathematica
390 lines
16 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1999-2012, 2014 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.
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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(prog_var::in, cons_id::in,
|
|
mlds_rval::out, ml_gen_info::in, ml_gen_info::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(prog_var::in,
|
|
tagged_cons_id::in, list(tagged_cons_id)::in, mlds_rval::out,
|
|
ml_gen_info::in, ml_gen_info::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(Var, ConsId, TestRval, !Info) :-
|
|
% 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(Var,
|
|
MainTaggedConsId, OtherTaggedConsIds, TestRval, !Info) :-
|
|
% 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(eq(IntType), SubRvalA, SubRvalB)
|
|
then
|
|
TestRval = ml_binop(ne(IntType), 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_eq, VarRval, ml_const(mlconst_float(Float)))
|
|
;
|
|
ConsTag = string_tag(String),
|
|
TestRval = ml_binop(str_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(eq(int_type_int), 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(eq(int_type_int), 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(eq(int_type_int), 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(eq(int_type_int), 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(eq(int_type_int),
|
|
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(eq(int_type_int),
|
|
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(eq(int_type_uint),
|
|
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(eq(int_type_int),
|
|
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(eq(int_type_uint),
|
|
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(eq(EqType), 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.
|
|
%---------------------------------------------------------------------------%
|