[m-rev.] for review: Fix tabling of subtypes.
Peter Wang
novalazy at gmail.com
Wed Apr 7 16:27:44 AEST 2021
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.
---
compiler/hlds_pred.m | 4 +-
compiler/table_gen.m | 60 +++++++++---
runtime/mercury_construct.c | 4 +-
runtime/mercury_deconstruct_macros.h | 114 +++++++++++++++++++++-
runtime/mercury_ml_expand_body.h | 137 +++------------------------
runtime/mercury_table_type_body.h | 25 +++--
tests/tabling/Mmakefile | 2 +
tests/tabling/table_subtype_du.exp | 2 +
tests/tabling/table_subtype_du.m | 76 +++++++++++++++
tests/tabling/table_subtype_enum.exp | 2 +
tests/tabling/table_subtype_enum.m | 75 +++++++++++++++
11 files changed, 347 insertions(+), 154 deletions(-)
create mode 100644 tests/tabling/table_subtype_du.exp
create mode 100644 tests/tabling/table_subtype_du.m
create mode 100644 tests/tabling/table_subtype_enum.exp
create mode 100644 tests/tabling/table_subtype_enum.m
diff --git a/compiler/hlds_pred.m b/compiler/hlds_pred.m
index 99c2bebef..d8866f2d1 100644
--- a/compiler/hlds_pred.m
+++ b/compiler/hlds_pred.m
@@ -2070,8 +2070,10 @@ marker_list_to_markers(Markers, MarkerSet) :-
; table_trie_step_string
; table_trie_step_float
; table_trie_step_enum(
- % The int gives the number of alternatives in the enum type,
+ % The int gives the maximum enum value in the enum type + 1,
% and thus the size of the corresponding trie node.
+ % If the enum type is not a subtype, then the value is equal to
+ % the number of alternatives in the type.
int
)
; table_trie_step_foreign_enum
diff --git a/compiler/table_gen.m b/compiler/table_gen.m
index 2dfc500b4..d09c86c6e 100644
--- a/compiler/table_gen.m
+++ b/compiler/table_gen.m
@@ -2,7 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1997-2012 The University of Melbourne.
-% Copyright (C) 2015 The Mercury team.
+% Copyright (C) 2015-2021 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.
%-----------------------------------------------------------------------------%
@@ -2506,20 +2506,8 @@ gen_lookup_call_for_type(ArgTablingMethod0, CtorCat, Type, ArgVar, VarSeqNum,
CtorCat = ctor_cat_enum(cat_enum_mercury),
type_to_ctor_det(Type, TypeCtor),
module_info_get_type_table(ModuleInfo, TypeTable),
- lookup_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
- hlds_data.get_type_defn_body(TypeDefn, TypeBody),
- ( if
- TypeBody = hlds_du_type(Ctors, _MaybeSuperType, MaybeCanonical,
- MaybeRepn, _MaybeForeign),
- % XXX SUBTYPE Anything to do?
- MaybeCanonical = canon,
- MaybeRepn = yes(Repn),
- Repn ^ dur_kind = du_type_kind_mercury_enum
- then
- list.length(one_or_more_to_list(Ctors), EnumRange)
- else
- unexpected($pred, "enum type is not du_type?")
- ),
+ get_enum_max_int_tag(TypeTable, TypeCtor, MaxIntTag),
+ EnumRange = MaxIntTag + 1,
LookupMacroName = "MR_tbl_lookup_insert_enum",
Step = table_trie_step_enum(EnumRange),
PrefixGoals = [],
@@ -3717,6 +3705,48 @@ type_save_category(CtorCat, Name) :-
%-----------------------------------------------------------------------------%
+:- pred get_enum_max_int_tag(type_table::in, type_ctor::in, int::out) is det.
+
+get_enum_max_int_tag(TypeTable, TypeCtor, MaxIntTag) :-
+ lookup_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
+ hlds_data.get_type_defn_body(TypeDefn, TypeBody),
+ ( if
+ TypeBody = hlds_du_type(_Ctors, MaybeSuperType, MaybeCanonical,
+ MaybeRepn, _MaybeForeign),
+ MaybeCanonical = canon,
+ MaybeRepn = yes(Repn),
+ Repn ^ dur_kind = du_type_kind_mercury_enum
+ then
+ CtorRepns = Repn ^ dur_ctor_repns,
+ (
+ MaybeSuperType = no,
+ list.det_last(CtorRepns, LastCtorRepn),
+ max_enum_int_tag(LastCtorRepn, 0, MaxIntTag)
+ ;
+ MaybeSuperType = yes(_),
+ % Subtype enums do not necessary use all values from 0 to
+ % MaxIntTag, so this will create a trie node that may be larger
+ % than necessary. We could subtract the lowest possible enum value
+ % to reduce the range, or switch to a different step type if the
+ % range of values is sparsely populated.
+ list.foldl(max_enum_int_tag, CtorRepns, 0, MaxIntTag)
+ )
+ else
+ unexpected($pred, "enum type is not du_type?")
+ ).
+
+:- pred max_enum_int_tag(constructor_repn::in, int::in, int::out) is det.
+
+max_enum_int_tag(CtorRepn, !MaxIntTag) :-
+ ConsTag = CtorRepn ^ cr_tag,
+ ( if ConsTag = int_tag(int_tag_int(IntTagVal)) then
+ !:MaxIntTag = int.max(!.MaxIntTag, IntTagVal)
+ else
+ unexpected($pred, "enum has non-int tag")
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- func get_debug_arg_string(table_info) = string.
get_debug_arg_string(TableInfo) = DebugArgStr :-
diff --git a/runtime/mercury_construct.c b/runtime/mercury_construct.c
index 30723f92a..bc486ce5f 100644
--- a/runtime/mercury_construct.c
+++ b/runtime/mercury_construct.c
@@ -22,8 +22,8 @@
//
// Return the functor ordinal number for an enum functor.
//
-// If you update this you will need to update index_or_search_enum_functor in
-// mercury_ml_expand_body.h.
+// If you update this you will need to update MR_index_or_search_enum_functor
+// in mercury_deconstruct_macros.h.
static MR_Integer
MR_get_enum_functor_ordinal(MR_TypeCtorInfo type_ctor_info,
diff --git a/runtime/mercury_deconstruct_macros.h b/runtime/mercury_deconstruct_macros.h
index f850ca3bd..e2e130e34 100644
--- a/runtime/mercury_deconstruct_macros.h
+++ b/runtime/mercury_deconstruct_macros.h
@@ -1,7 +1,7 @@
// vim: ts=4 sw=4 expandtab ft=c
// Copyright (C) 2002-2004, 2007, 2011 The University of Melbourne.
-// Copyright (C) 2016, 2018 The Mercury team.
+// Copyright (C) 2016, 2018, 2021 The Mercury team.
// This file is distributed under the terms specified in COPYING.LIB.
// mercury_deconstruct_macros.h
@@ -14,6 +14,118 @@
///////////////////
+// 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_ALTERATIVES_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.
diff --git a/runtime/mercury_ml_expand_body.h b/runtime/mercury_ml_expand_body.h
index a5b0710ae..c766319b1 100644
--- a/runtime/mercury_ml_expand_body.h
+++ b/runtime/mercury_ml_expand_body.h
@@ -312,117 +312,6 @@
///////////////////
-// 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 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 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 (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 i; \
- \
- num_functors = MR_type_ctor_num_functors(type_ctor_info); \
- for (i = 0; i < num_functors; i++) { \
- if (enum_layout[i]->MR_enum_functor_value == data) { \
- functor_name = enum_layout[i]->MR_enum_functor_name; \
- functor_ordinal = i; \
- break; \
- } \
- } \
- MR_assert(i < num_functors); \
- } \
- } while (0) \
-
-#define 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 (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 i; \
- \
- num_ptags = MR_type_ctor_num_ptags(type_ctor_info); \
- for (i = 0; i < num_ptags; i++) { \
- ptag_layout = &du_type_layout[i]; \
- if (ptag_layout->MR_du_ptag == ptag) { \
- break; \
- } \
- } \
- \
- MR_assert(i < num_ptags); \
- } \
- } while (0)
-
-#define index_or_search_sectag_functor(ptag_layout, sectag, functor_desc) \
- do { \
- if (tci_version_no_subtypes(type_ctor_info) || \
- (ptag_layout->MR_du_ptag_flags \
- & MR_DU_PTAG_FLAG_SECTAG_ALTERATIVES_INDEXABLE)) { \
- functor_desc = ptag_layout->MR_sectag_alternatives[sectag]; \
- } else { \
- int num_sharers; \
- int i; \
- \
- num_sharers = ptag_layout->MR_sectag_sharers; \
- for (i = 0; i < num_sharers; i++) { \
- functor_desc = ptag_layout->MR_sectag_alternatives[i]; \
- if (functor_desc->MR_du_functor_secondary == sectag) { \
- break; \
- } \
- } \
- MR_assert(i < num_sharers); \
- } \
- } while (0) \
-
-#define search_foreign_enum_functor(data, functor_name, functor_ordinal) \
- do { \
- int i; \
- 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 (i = 0; i < num_functors; i++) { \
- if (fe_layout[i]->MR_foreign_enum_functor_value == data) { \
- functor_name = fe_layout[i]->MR_foreign_enum_functor_name; \
- functor_ordinal = \
- fe_layout[i]->MR_foreign_enum_functor_ordinal; \
- break; \
- } \
- } \
- MR_assert(i < num_functors); \
- } while (0)
-
-///////////////////
-
// These macros set up the results for terms of notag types to requests
// either for all arguments, or for one selected argument.
@@ -658,7 +547,7 @@ EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
MR_int_least32_t functor_ordinal = -1;
data = *data_word_ptr;
- index_or_search_enum_functor(data, functor_name, functor_ordinal);
+ MR_index_or_search_enum_functor(data, functor_name, functor_ordinal);
handle_functor_name(functor_name);
handle_type_functor_number(type_ctor_info, functor_ordinal);
handle_zero_arity_args();
@@ -687,7 +576,7 @@ EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
// For foreign enumerations, we cannot use the value as an index
// into the type layout, so we just have to do a linear search.
data = *data_word_ptr;
- search_foreign_enum_functor(data, functor_name, functor_ordinal);
+ MR_search_foreign_enum_functor(data, functor_name, functor_ordinal);
MR_assert(functor_name != NULL);
MR_assert(functor_ordinal != -1);
@@ -705,7 +594,7 @@ EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
MR_ConstString functor_name = NULL;
MR_int_least32_t functor_ordinal = -1; /* unused */
- index_or_search_enum_functor(data, functor_name, functor_ordinal);
+ MR_index_or_search_enum_functor(data, functor_name, functor_ordinal);
handle_functor_name(functor_name);
handle_zero_arity_args();
handle_functor_number(data);
@@ -754,7 +643,7 @@ EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
data = *data_word_ptr;
ptag = MR_tag(data);
- index_or_search_ptag_layout(ptag, ptag_layout);
+ MR_index_or_search_ptag_layout(ptag, ptag_layout);
switch (ptag_layout->MR_sectag_locn) {
@@ -781,7 +670,8 @@ EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
case MR_SECTAG_LOCAL_REST_OF_WORD:
sectag = MR_unmkbody(data);
- index_or_search_sectag_functor(ptag_layout, sectag, functor_desc);
+ MR_index_or_search_sectag_functor(ptag_layout, sectag,
+ functor_desc);
handle_functor_name_number_arity(expand_info, type_ctor_info,
functor_desc);
assert_no_exist_info(functor_desc, "MR_SECTAG_LOCAL_REST_OF_WORD");
@@ -793,7 +683,8 @@ EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
// XXX ARG_PACK
// Consider storing this mask in the ptag_layout.
((1 << ptag_layout->MR_sectag_numbits) - 1);
- index_or_search_sectag_functor(ptag_layout, sectag, functor_desc);
+ MR_index_or_search_sectag_functor(ptag_layout, sectag,
+ functor_desc);
handle_functor_name_number_arity(expand_info, type_ctor_info,
functor_desc);
assert_no_exist_info(functor_desc, "MR_SECTAG_LOCAL_BITS");
@@ -855,7 +746,8 @@ EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
case MR_SECTAG_REMOTE_FULL_WORD:
sectag = MR_field(ptag, data, 0);
- index_or_search_sectag_functor(ptag_layout, sectag, functor_desc);
+ MR_index_or_search_sectag_functor(ptag_layout, sectag,
+ functor_desc);
handle_functor_name_number_arity(expand_info, type_ctor_info,
functor_desc);
set_exist_info_extra_args(functor_desc, exist_info,
@@ -869,7 +761,8 @@ EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
// XXX ARG_PACK
// Consider storing this mask in the ptag_layout.
((1 << ptag_layout->MR_sectag_numbits) - 1);
- index_or_search_sectag_functor(ptag_layout, sectag, functor_desc);
+ MR_index_or_search_sectag_functor(ptag_layout, sectag,
+ functor_desc);
handle_functor_name_number_arity(expand_info, type_ctor_info,
functor_desc);
assert_no_exist_info(functor_desc, "MR_SECTAG_LOCAL_BITS");
@@ -1930,12 +1823,6 @@ EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
#undef set_exist_info_extra_args
#undef assert_no_exist_info
-#undef tci_version_no_subtypes
-#undef index_or_search_enum_functor
-#undef index_or_search_ptag_layout
-#undef index_or_search_sectag_functor
-#undef search_foreign_enum_functor
-
#undef notag_arg_build_univ_list
#undef maybe_notag_arg_build_univ_list
#undef set_chosen_for_notag_arg_name
diff --git a/runtime/mercury_table_type_body.h b/runtime/mercury_table_type_body.h
index 67334e597..a5ed7db18 100644
--- a/runtime/mercury_table_type_body.h
+++ b/runtime/mercury_table_type_body.h
@@ -1,7 +1,7 @@
// vim: ts=4 sw=4 expandtab ft=c
// Copyright (C) 2006-2007, 2011 The University of Melbourne.
-// Copyright (C) 2016-2018 The Mercury team.
+// Copyright (C) 2016-2018, 2021 The Mercury team.
// This file is distributed under the terms specified in COPYING.LIB.
// This files defines the bodies of the various variants of the
@@ -11,7 +11,6 @@
// in the places listed in mercury_type_info.h.
MR_TypeCtorInfo type_ctor_info;
- MR_DuTypeLayout du_type_layout;
MR_TrieNode table_next;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
@@ -36,7 +35,7 @@
case MR_TYPECTOR_REP_FOREIGN_ENUM:
case MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ:
- MR_TABLE_FOREIGN_ENUM(STATS, DEBUG, BACK, table_next, table,
+ MR_TABLE_FOREIGN_ENUM(STATS, DEBUG, BACK, table_next, table,
data);
table = table_next;
return table;
@@ -78,13 +77,13 @@
int meta_args;
int i;
- du_type_layout = MR_type_ctor_layout(type_ctor_info).MR_layout_du;
ptag = MR_tag(data);
- ptag_layout = &du_type_layout[ptag];
+ MR_index_or_search_ptag_layout(ptag, ptag_layout);
switch (ptag_layout->MR_sectag_locn) {
case MR_SECTAG_NONE:
+ // We can index MR_sectag_alternatives for MR_SECTAG_NONE.
functor_desc = ptag_layout->MR_sectag_alternatives[0];
full_arity = functor_desc->MR_du_functor_orig_arity;
tagword_arity = 0;
@@ -92,6 +91,8 @@
break;
case MR_SECTAG_NONE_DIRECT_ARG:
+ // We can index MR_sectag_alternatives for
+ // MR_SECTAG_NONE_DIRECT_ARG.
functor_desc = ptag_layout->MR_sectag_alternatives[0];
full_arity = functor_desc->MR_du_functor_orig_arity;
tagword_arity = 0;
@@ -101,7 +102,8 @@
case MR_SECTAG_LOCAL_REST_OF_WORD:
sectag = MR_unmkbody(data);
- functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
+ MR_index_or_search_sectag_functor(ptag_layout, sectag,
+ functor_desc);
full_arity = functor_desc->MR_du_functor_orig_arity;
tagword_arity = 0;
tagword = data;
@@ -112,7 +114,8 @@
case MR_SECTAG_LOCAL_BITS:
sectag = MR_unmkbody(data) &
((1 << ptag_layout->MR_sectag_numbits) - 1);
- functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
+ MR_index_or_search_sectag_functor(ptag_layout, sectag,
+ functor_desc);
full_arity = functor_desc->MR_du_functor_orig_arity;
tagword_arity = full_arity;
tagword = data;
@@ -121,7 +124,8 @@
case MR_SECTAG_REMOTE_FULL_WORD:
sectag = MR_field(ptag, data, 0);
- functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
+ MR_index_or_search_sectag_functor(ptag_layout, sectag,
+ functor_desc);
full_arity = functor_desc->MR_du_functor_orig_arity;
tagword_arity = 0;
arg_vector = (MR_Word *) MR_body(data, ptag) + 1;
@@ -131,7 +135,8 @@
tagword = MR_field(ptag, data, 0);
sectag = tagword &
((1 << ptag_layout->MR_sectag_numbits) - 1);
- functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
+ MR_index_or_search_sectag_functor(ptag_layout, sectag,
+ functor_desc);
full_arity = functor_desc->MR_du_functor_orig_arity;
if (functor_desc->MR_du_functor_arg_locns == NULL) {
tagword_arity = 0;
@@ -401,7 +406,7 @@
}
case MR_TYPECTOR_REP_TUPLE:
- {
+ {
MR_Word *data_value;
MR_TypeInfo *arg_type_info_vector;
int arity;
diff --git a/tests/tabling/Mmakefile b/tests/tabling/Mmakefile
index 815d58c78..d36282435 100644
--- a/tests/tabling/Mmakefile
+++ b/tests/tabling/Mmakefile
@@ -41,6 +41,8 @@ SIMPLE_NONLOOP_PROGS = \
specified_hidden_arg \
table_foreign_enum \
table_foreign_output \
+ table_subtype_du \
+ table_subtype_enum \
test_enum \
test_packed \
unused_args
diff --git a/tests/tabling/table_subtype_du.exp b/tests/tabling/table_subtype_du.exp
new file mode 100644
index 000000000..f72545eb0
--- /dev/null
+++ b/tests/tabling/table_subtype_du.exp
@@ -0,0 +1,2 @@
+First result: bar(42, 123), 1001
+Second result: bar(42, 123), 1001
diff --git a/tests/tabling/table_subtype_du.m b/tests/tabling/table_subtype_du.m
new file mode 100644
index 000000000..4470b263e
--- /dev/null
+++ b/tests/tabling/table_subtype_du.m
@@ -0,0 +1,76 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+
+:- module table_subtype_du.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module string.
+
+:- pragma require_feature_set([memo]).
+
+main(!IO) :-
+ test_subtype_du(bar(42, 123), baz(456), Result),
+ io.write_string("First result: " ++ Result ++ "\n", !IO),
+ print_second_result(!IO).
+
+:- pragma no_inline(print_second_result/2).
+:- pred print_second_result(io::di, io::uo) is det.
+
+print_second_result(!IO) :-
+ test_subtype_du(bar(42, 123), baz(456), Result),
+ io.write_string("Second result: " ++ Result ++ "\n", !IO).
+
+:- pragma memo(test_subtype_du/3).
+:- pred test_subtype_du(foo::in, foo::in, string::out) is det.
+
+test_subtype_du(A, B, Out) :-
+ StrA = string.string(A),
+ Number = mystery(B),
+ Out = StrA ++ ", " ++ int_to_string(Number).
+
+:- pragma no_inline(mystery/1).
+:- func mystery(foo) = int.
+:- pragma foreign_proc("C",
+ mystery(_X::in) = (Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ static int called = 0;
+
+ if (called) {
+ fprintf(stdout, ""mystery has been called again\\n"");
+ fflush(stdout);
+ }
+
+ Y = 1001;
+ called = 1;
+").
+
+:- type base_foo
+ ---> foo_0
+ ; foo_1
+ ; foo_2
+ ; foo_3
+ ; bar(int, int)
+ ; foo_4
+ ; foo_5
+ ; foo_6
+ ; foo_7
+ ; foo_8
+ ; baz(int)
+ ; foo_10
+ ; foo_11
+ ; foo_12
+ ; foo_13
+ ; foo_14
+ ; foo_15.
+
+:- type foo =< base_foo
+ ---> baz(int)
+ ; bar(int, int). % deliberated reordered
diff --git a/tests/tabling/table_subtype_enum.exp b/tests/tabling/table_subtype_enum.exp
new file mode 100644
index 000000000..439bf3059
--- /dev/null
+++ b/tests/tabling/table_subtype_enum.exp
@@ -0,0 +1,2 @@
+First result: bar, 1011
+Second result: bar, 1011
diff --git a/tests/tabling/table_subtype_enum.m b/tests/tabling/table_subtype_enum.m
new file mode 100644
index 000000000..2b7b29511
--- /dev/null
+++ b/tests/tabling/table_subtype_enum.m
@@ -0,0 +1,75 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+
+:- module table_subtype_enum.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module string.
+
+:- pragma require_feature_set([memo]).
+
+main(!IO) :-
+ test_subtype_enum(bar, baz, Result),
+ io.write_string("First result: " ++ Result ++ "\n", !IO),
+ print_second_result(!IO).
+
+:- pragma no_inline(print_second_result/2).
+:- pred print_second_result(io::di, io::uo) is det.
+
+print_second_result(!IO) :-
+ test_subtype_enum(bar, baz, Result),
+ io.write_string("Second result: " ++ Result ++ "\n", !IO).
+
+:- pragma memo(test_subtype_enum/3).
+:- pred test_subtype_enum(foo::in, foo::in, string::out) is det.
+
+test_subtype_enum(A, B, Out) :-
+ StrA = string.string(A),
+ Number = mystery(B),
+ Out = StrA ++ ", " ++ int_to_string(Number).
+
+:- pragma no_inline(mystery/1).
+:- func mystery(foo) = int.
+:- pragma foreign_proc("C",
+ mystery(X::in) = (Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ static int called = 0;
+
+ if (called) {
+ fprintf(stdout, ""mystery has been called again\\n"");
+ fflush(stdout);
+ }
+
+ Y = X + 1001;
+ called = 1;
+").
+
+:- type base_foo
+ ---> foo_0
+ ; foo_1
+ ; foo_2
+ ; foo_3
+ ; bar % 4
+ ; foo_5
+ ; foo_6
+ ; foo_7
+ ; foo_8
+ ; foo_9
+ ; baz % 10
+ ; foo_11
+ ; foo_12
+ ; foo_13
+ ; foo_14
+ ; foo_15.
+
+:- type foo =< base_foo
+ ---> baz % 10
+ ; bar. % 4 (deliberated reordered)
--
2.30.0
More information about the reviews
mailing list