mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 09:23:44 +00:00
337877a67b
compiler/table_gen.m:
Find the maximum value used by an enum type to determine the size of
a trie node required for its step. Previously the code counted the
number of alternatives in the enum type, which does not work for
subtypes.
compiler/hlds_pred.m:
Update comment.
runtime/mercury_ml_expand_body.h:
runtime/mercury_deconstruct_macros.h:
Move some macros from mercury_ml_expand_body.h to
mercury_deconstruct_macros.h, and add MR_ prefixes.
runtime/mercury_construct.c:
Update comment.
runtime/mercury_table_type_body.h:
Use macros to search the ptag layout array or secondary tag array
if it is not possible to directly index them (which is the case for
subtypes).
tests/tabling/Mmakefile:
tests/tabling/table_subtype_du.m:
tests/tabling/table_subtype_du.exp:
tests/tabling/table_subtype_enum.m:
tests/tabling/table_subtype_enum.exp:
Add test cases.
403 lines
24 KiB
C
403 lines
24 KiB
C
// vim: ts=4 sw=4 expandtab ft=c
|
|
|
|
// Copyright (C) 2002-2004, 2007, 2011 The University of Melbourne.
|
|
// Copyright (C) 2016, 2018, 2021 The Mercury team.
|
|
// This file is distributed under the terms specified in COPYING.LIB.
|
|
|
|
// mercury_deconstruct_macros.h
|
|
//
|
|
// This file defines macros for performing tasks that are useful when
|
|
// deconstructing terms,
|
|
|
|
#ifndef MERCURY_DECONSTRUCT_MACROS_H
|
|
#define MERCURY_DECONSTRUCT_MACROS_H
|
|
|
|
///////////////////
|
|
|
|
// XXX SUBTYPE
|
|
// We maintain compatibility with RTTI structures generated by older versions
|
|
// of the Mercury compiler by not reading from fields that were introduced in
|
|
// newer versions of the RTTI structures. These version checks can be deleted
|
|
// after some time.
|
|
#define MR_tci_version_no_subtypes(tci) \
|
|
((tci)->MR_type_ctor_version < MR_RTTI_VERSION__SUBTYPES)
|
|
|
|
// This performs a linear search for subtype enums. If a subtype has a
|
|
// large number of functors, it may be worth performing a binary search.
|
|
// If you update this, you will need to update MR_get_enum_functor_ordinal.
|
|
#define MR_index_or_search_enum_functor(data, functor_name, functor_ordinal)\
|
|
do { \
|
|
MR_TypeLayout type_layout; \
|
|
MR_EnumTypeLayout enum_layout; \
|
|
\
|
|
type_layout = MR_type_ctor_layout(type_ctor_info); \
|
|
enum_layout = type_layout.MR_layout_enum; \
|
|
\
|
|
if (MR_tci_version_no_subtypes(type_ctor_info) || \
|
|
MR_type_ctor_is_layout_indexable(type_ctor_info)) { \
|
|
functor_name = enum_layout[data]->MR_enum_functor_name; \
|
|
functor_ordinal = data; \
|
|
} else { \
|
|
int num_functors; \
|
|
int idx; \
|
|
\
|
|
num_functors = MR_type_ctor_num_functors(type_ctor_info); \
|
|
for (idx = 0; idx < num_functors; idx++) { \
|
|
if (enum_layout[idx]->MR_enum_functor_value == data) { \
|
|
functor_name = enum_layout[idx]->MR_enum_functor_name; \
|
|
functor_ordinal = idx; \
|
|
break; \
|
|
} \
|
|
} \
|
|
MR_assert(idx < num_functors); \
|
|
} \
|
|
} while (0) \
|
|
|
|
#define MR_index_or_search_ptag_layout(ptag, ptag_layout) \
|
|
do { \
|
|
MR_TypeLayout type_layout; \
|
|
MR_DuTypeLayout du_type_layout; \
|
|
\
|
|
type_layout = MR_type_ctor_layout(type_ctor_info); \
|
|
du_type_layout = type_layout.MR_layout_du; \
|
|
\
|
|
if (MR_tci_version_no_subtypes(type_ctor_info) || \
|
|
MR_type_ctor_is_layout_indexable(type_ctor_info)) { \
|
|
ptag_layout = &du_type_layout[ptag]; \
|
|
} else { \
|
|
int num_ptags; \
|
|
int idx; \
|
|
\
|
|
num_ptags = MR_type_ctor_num_ptags(type_ctor_info); \
|
|
for (idx = 0; idx < num_ptags; idx++) { \
|
|
ptag_layout = &du_type_layout[idx]; \
|
|
if (ptag_layout->MR_du_ptag == ptag) { \
|
|
break; \
|
|
} \
|
|
} \
|
|
\
|
|
MR_assert(idx < num_ptags); \
|
|
} \
|
|
} while (0)
|
|
|
|
#define MR_index_or_search_sectag_functor(ptag_layout, sectag, functor_desc)\
|
|
do { \
|
|
if (MR_tci_version_no_subtypes(type_ctor_info) || \
|
|
(ptag_layout->MR_du_ptag_flags \
|
|
& MR_DU_PTAG_FLAG_SECTAG_ALTERNATIVES_INDEXABLE)) { \
|
|
functor_desc = ptag_layout->MR_sectag_alternatives[sectag]; \
|
|
} else { \
|
|
int num_sharers; \
|
|
int idx; \
|
|
\
|
|
num_sharers = ptag_layout->MR_sectag_sharers; \
|
|
for (idx = 0; idx < num_sharers; idx++) { \
|
|
functor_desc = ptag_layout->MR_sectag_alternatives[idx]; \
|
|
if (functor_desc->MR_du_functor_secondary == sectag) { \
|
|
break; \
|
|
} \
|
|
} \
|
|
MR_assert(idx < num_sharers); \
|
|
} \
|
|
} while (0) \
|
|
|
|
#define MR_search_foreign_enum_functor(data, functor_name, functor_ordinal) \
|
|
do { \
|
|
int idx; \
|
|
int num_functors; \
|
|
MR_TypeLayout type_layout; \
|
|
MR_ForeignEnumTypeLayout fe_layout; \
|
|
\
|
|
num_functors = MR_type_ctor_num_functors(type_ctor_info); \
|
|
type_layout = MR_type_ctor_layout(type_ctor_info); \
|
|
fe_layout = type_layout.MR_layout_foreign_enum; \
|
|
\
|
|
for (idx = 0; idx < num_functors; idx++) { \
|
|
if (fe_layout[idx]->MR_foreign_enum_functor_value == data) { \
|
|
functor_name = \
|
|
fe_layout[idx]->MR_foreign_enum_functor_name; \
|
|
functor_ordinal = \
|
|
fe_layout[idx]->MR_foreign_enum_functor_ordinal; \
|
|
break; \
|
|
} \
|
|
} \
|
|
MR_assert(idx < num_functors); \
|
|
} while (0)
|
|
|
|
///////////////////
|
|
|
|
// Check for attempts to deconstruct a non-canonical type.
|
|
// Such deconstructions must be cc_multi, which is why we treat
|
|
// violations of this as runtime errors in det deconstruction predicates.
|
|
// (There ought to be cc_multi versions of those predicates.)
|
|
|
|
#define MR_abort_if_type_is_noncanonical(ei, msg) \
|
|
do { \
|
|
if ((ei).non_canonical_type) { \
|
|
MR_fatal_error(msg); \
|
|
} \
|
|
} while (0)
|
|
|
|
#define MR_noncanon_msg(predname) \
|
|
"called " predname " for non-canonical type"
|
|
|
|
///////////////////
|
|
|
|
// Extract fields of some of the expand_info structures.
|
|
|
|
#define MR_deconstruct_get_functor(ei, functor_field, var) \
|
|
do { \
|
|
MR_make_aligned_string(var, (ei).functor_field); \
|
|
} while (0)
|
|
|
|
#define MR_deconstruct_get_functor_number(ei, var) \
|
|
do { \
|
|
var = (ei).functor_number; \
|
|
} while (0)
|
|
|
|
#define MR_deconstruct_get_arity(ei, var) \
|
|
do { \
|
|
var = (ei).arity; \
|
|
} while (0)
|
|
|
|
#define MR_deconstruct_get_arg_univs_list(ei, var) \
|
|
do { \
|
|
var = (ei).arg_univs_list; \
|
|
} while (0)
|
|
|
|
///////////////////
|
|
|
|
// Given the type_info for the type of a whole term, the functor
|
|
// descriptor of its top function symbol, the argument vector of its
|
|
// arguments, and the number of an argument, return the type_info
|
|
// of that argument.
|
|
|
|
#define MR_get_arg_type_info(ti, fdesc, argvec, argnum) \
|
|
( MR_arg_type_may_contain_var(functor_desc, argnum) ? \
|
|
MR_create_type_info_maybe_existq( \
|
|
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(ti), \
|
|
fdesc->MR_du_functor_arg_types[argnum], argvec, fdesc) \
|
|
: \
|
|
MR_pseudo_type_info_is_ground( \
|
|
fdesc->MR_du_functor_arg_types[argnum]) \
|
|
)
|
|
|
|
#define MR_get_arg_type_info_alloc(ti, fdesc, argvec, argnum, alloc) \
|
|
( MR_arg_type_may_contain_var(functor_desc, argnum) ? \
|
|
MR_make_type_info_maybe_existq( \
|
|
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(ti), \
|
|
fdesc->MR_du_functor_arg_types[argnum], argvec, fdesc, \
|
|
&alloc) \
|
|
: \
|
|
MR_pseudo_type_info_is_ground( \
|
|
fdesc->MR_du_functor_arg_types[argnum]) \
|
|
)
|
|
|
|
///////////////////
|
|
|
|
// Convert a 64-bit argument to a word, boxing it on 32-bit architectures,
|
|
// and aborting if the address of that 64-bit argument does not exist.
|
|
// The latter would happen if an arg_locn mistakenly said that such a 64-bit
|
|
// argument occurred inside a tagword, which should never happen.
|
|
|
|
#ifdef MR_HIGHLEVEL_CODE
|
|
#define MR_float_to_value(f, v) v = (MR_Word) MR_box_float(f)
|
|
#define MR_int64_to_value(i, v) v = (MR_Word) MR_box_int64(i)
|
|
#define MR_uint64_to_value(u, v) v = (MR_Word) MR_box_uint64(u)
|
|
#else
|
|
#define MR_float_to_value(f, v) v = MR_float_to_word(f)
|
|
#define MR_int64_to_value(i, v) v = MR_int64_to_word(i)
|
|
#define MR_uint64_to_value(u, v) v = MR_uint64_to_word(u)
|
|
#endif
|
|
|
|
#ifdef MR_BOXED_FLOAT
|
|
#define MR_word_pair_to_float_value(have_addr, addr, val) \
|
|
do { \
|
|
MR_Float flt; \
|
|
\
|
|
if (have_addr) { \
|
|
flt = MR_float_from_dword(addr[0], addr[1]); \
|
|
MR_float_to_value(flt, val); \
|
|
} else { \
|
|
MR_fatal_error("double-word float in tagword"); \
|
|
} \
|
|
} while (0)
|
|
#else
|
|
#define MR_word_pair_to_float_value(have_addr, addr, val) \
|
|
do { \
|
|
MR_fatal_error("double-word floats " \
|
|
"should not exist in this grade"); \
|
|
} while (0)
|
|
#endif
|
|
|
|
#ifdef MR_BOXED_INT64S
|
|
#define MR_word_pair_to_int64_value(have_addr, addr, val) \
|
|
do { \
|
|
MR_Float flt; \
|
|
\
|
|
if (have_addr) { \
|
|
flt = MR_int64_from_dword(addr[0], addr[1]); \
|
|
MR_int64_to_value(flt, val); \
|
|
} else { \
|
|
MR_fatal_error("double-word int64 in tagword"); \
|
|
} \
|
|
} while (0)
|
|
#define MR_word_pair_to_uint64_value(have_addr, addr, val) \
|
|
do { \
|
|
MR_Float flt; \
|
|
\
|
|
if (have_addr) { \
|
|
flt = MR_uint64_from_dword(addr[0], addr[1]); \
|
|
MR_uint64_to_value(flt, val); \
|
|
} else { \
|
|
MR_fatal_error("double-word uint64 in tagword"); \
|
|
} \
|
|
} while (0)
|
|
#else
|
|
#define MR_word_pair_to_int64_value(have_addr, addr, val) \
|
|
do { \
|
|
MR_fatal_error("double-word int64s " \
|
|
"should not exist in this grade"); \
|
|
} while (0)
|
|
#define MR_word_pair_to_uint64_value(have_addr, addr, val) \
|
|
do { \
|
|
MR_fatal_error("double-word uint64s " \
|
|
"should not exist in this grade"); \
|
|
} while (0)
|
|
#endif
|
|
|
|
///////////////////
|
|
|
|
// Given the arg_locn of an argument, and either the address at which
|
|
// it can be found (if have_addr is true) or the value of the tagword
|
|
// containing it (if have_addr is false), return its value. If the argument's
|
|
// size is exactly one word, then set wsa_ptr (word-sized-argument) to
|
|
// its address; if its size is anything else, then set wsa_ptr to NULL.
|
|
// This is used by tabling and by store.m to reserve unique word addresses
|
|
// for (copies of) the arguments that do not naturally have them.
|
|
//
|
|
// This macro should be used only by MR_get_non_tagword_arg_value and
|
|
// MR_get_tagword_arg_value.
|
|
|
|
#define MR_get_arg_value(arg_locn, have_addr, word_addr, word, value, wsa_ptr) \
|
|
switch ((arg_locn).MR_arg_bits) { \
|
|
\
|
|
case -1: \
|
|
/* MR_arg_bits == -1: arg is a double stored in two words. */ \
|
|
MR_word_pair_to_float_value(have_addr, word_addr, value); \
|
|
wsa_ptr = NULL; \
|
|
break; \
|
|
\
|
|
case -2: \
|
|
/* MR_arg_bits == -2: arg is an int64 stored in two words. */ \
|
|
MR_word_pair_to_int64_value(have_addr, word_addr, value); \
|
|
wsa_ptr = NULL; \
|
|
break; \
|
|
\
|
|
case -3: \
|
|
/* MR_arg_bits == -3: arg is a uint64 stored in two words. */ \
|
|
MR_word_pair_to_uint64_value(have_addr, word_addr, value); \
|
|
wsa_ptr = NULL; \
|
|
break; \
|
|
\
|
|
case -4: \
|
|
/* MR_arg_bits == -4: arg is an int8 subword arg. */ \
|
|
value = (MR_Word) (int8_t) \
|
|
(word >> (arg_locn).MR_arg_shift) & ((MR_Word) 0xff); \
|
|
wsa_ptr = NULL; \
|
|
break; \
|
|
\
|
|
case -5: \
|
|
/* MR_arg_bits == -5: arg is a uint8 subword arg. */ \
|
|
value = (MR_Word) (uint8_t) \
|
|
(word >> (arg_locn).MR_arg_shift) & ((MR_Word) 0xff); \
|
|
wsa_ptr = NULL; \
|
|
break; \
|
|
\
|
|
case -6: \
|
|
/* MR_arg_bits == -6: arg is an int16 subword arg. */ \
|
|
value = (MR_Word) (int16_t) \
|
|
(word >> (arg_locn).MR_arg_shift) & ((MR_Word) 0xffff); \
|
|
wsa_ptr = NULL; \
|
|
break; \
|
|
\
|
|
case -7: \
|
|
/* MR_arg_bits == -7: arg is a uint16 subword arg. */ \
|
|
value = (MR_Word) (uint16_t) \
|
|
(word >> (arg_locn).MR_arg_shift) & ((MR_Word) 0xffff); \
|
|
wsa_ptr = NULL; \
|
|
break; \
|
|
\
|
|
case -8: \
|
|
/* MR_arg_bits == -8: arg is an int32 subword arg. */ \
|
|
value = (MR_Word) (int32_t) \
|
|
(word >> (arg_locn).MR_arg_shift) & ((MR_Word) 0xffffffff); \
|
|
wsa_ptr = NULL; \
|
|
break; \
|
|
\
|
|
case -9: \
|
|
/* MR_arg_bits == -9: arg is a uint32 subword arg. */ \
|
|
value = (MR_Word) (uint32_t) \
|
|
(word >> (arg_locn).MR_arg_shift) & ((MR_Word) 0xffffffff); \
|
|
wsa_ptr = NULL; \
|
|
break; \
|
|
\
|
|
case -10: \
|
|
/* MR_arg_bits == -10: arg is a value of a dummy type. */ \
|
|
value = 0; \
|
|
wsa_ptr = NULL; \
|
|
break; \
|
|
\
|
|
default: \
|
|
if (arg_locn.MR_arg_bits == 0) { \
|
|
/* The arg is a full word value. */ \
|
|
value = word; \
|
|
wsa_ptr = word_addr; \
|
|
} else { \
|
|
if (arg_locn.MR_arg_bits > 0) { \
|
|
/* The arg is a packed enumeration value. */ \
|
|
value = (word >> (arg_locn).MR_arg_shift) \
|
|
& ((MR_Word) (1 << (arg_locn).MR_arg_bits) - 1); \
|
|
wsa_ptr = NULL; \
|
|
} else { \
|
|
/* The only negative values of MR_arg_bits that make */ \
|
|
/* sense are the ones we have cases for above. */ \
|
|
MR_fatal_error("unexpected negative value of MR_arg_bits"); \
|
|
} \
|
|
} \
|
|
break; \
|
|
}
|
|
|
|
///////////////////
|
|
|
|
// Given the arg_locn of an argument and the starting address of
|
|
// the non-extra, non-tagword arguments of its memory cell,
|
|
// return the value of the argument. Also return wsa_ptr, whose meaning
|
|
// and purpose is described above.
|
|
//
|
|
// The offset of the argument is taken from the arg_locn. This offset
|
|
// will be -1 for arguments stored in the tagword of a remote secondary tag.
|
|
// This works because we do such packing only for function symbols that
|
|
// have no type_infos or typeclass_infos between the tagword and the
|
|
// argument values themselves.
|
|
|
|
#define MR_get_non_tagword_arg_value(arg_locn, av, value, wsa_ptr) \
|
|
do { \
|
|
MR_int_least16_t off = (arg_locn).MR_arg_offset; \
|
|
MR_Word *word_addr = &((MR_Word *) av)[off]; \
|
|
MR_get_arg_value(arg_locn, MR_TRUE, word_addr, (*word_addr), \
|
|
value, wsa_ptr); \
|
|
} while (0)
|
|
|
|
// Given the arg_locn of an argument and the tagword it occurs in,
|
|
// return the value of the argument. Such arguments cannot be word sized.
|
|
|
|
#define MR_get_tagword_arg_value(arg_locn, tagword, value) \
|
|
do { \
|
|
MR_Word *wsa_ptr; /* ignored */ \
|
|
MR_get_arg_value(arg_locn, MR_FALSE, ((MR_Word *) NULL), tagword, \
|
|
value, wsa_ptr); \
|
|
} while (0)
|
|
|
|
#endif // MERCURY_DECONSTRUCT_MACROS_H
|