[m-rev.] for review: Fix bug with direct-arg ctors and intermodule optimisation.
Peter Wang
novalazy at gmail.com
Fri Jan 9 17:25:57 AEDT 2026
If the compiler decides that a du type should use the direct-arg
representation for some of its constructors, it must include information
about that into the .opt file of the module defining the type, in the
form of `where direct_arg is' clauses, which will be used by modules
opt-importing that module and that type. That information was not being
included for du types defined in the *interface* section of a module.
Also fix a related issue that was uncovered: a word_aligned_pointer
assertion on a foreign_type definition would have no effect if there is
a corresponding no-tag du type definition for the same type constructor.
compiler/intermod.m:
compler/intermod_decide.m:
Make should_opt_export_type_defn and some_type_needs_to_be_written
succeed for `status_exported' du type definitions with direct-arg
constructors. While `status_exported' suggests those type
definitions would be redundant in .opt files, the information about
the direct-arg constructors is not redundant.
compiler/hlds_data.m:
Add a helper predicate.
compiler/du_type_layout.m:
Add a is_word_aligned_ptr() value to the ComponentTypeMap if a
no-tag du type also has a foreign_type definition for the current
target language with a word_aligned_pointer assertion. Previously,
this was only being done for single ctor NON no-tag du types.
Add a XXX mentioning that we silently ignore word_aligned_pointer
assertions in other cases.
tests/hard_coded/Mercury.options:
tests/hard_coded/Mmakefile:
tests/hard_coded/direct_arg_opt_imported.m:
tests/hard_coded/direct_arg_opt_imported_helper_1.m:
tests/hard_coded/direct_arg_opt_imported_helper_1.sub.m:
Add a test case.
diff --git a/compiler/du_type_layout.m b/compiler/du_type_layout.m
index 4935103ed..0f0786ce6 100644
--- a/compiler/du_type_layout.m
+++ b/compiler/du_type_layout.m
@@ -2,7 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1993-2012 The University of Melbourne.
-% Copyright (C) 2015, 2017-2025 The Mercury team.
+% Copyright (C) 2015, 2017-2026 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.
%---------------------------------------------------------------------------%
@@ -1857,7 +1857,28 @@ decide_if_simple_du_type(ModuleInfo, Params, TypeCtorToForeignEnumMap,
decide_simple_type_non_sub_notag(ModuleInfo, Params,
TypeCtor, TypeDefn0, BodyDu0,
SingleCtorSymName, SingleArg, SingleCtorContext,
- TypeCtorTypeDefn, !NoTagTypeMap, !Specs)
+ TypeCtorTypeDefn, !NoTagTypeMap, !Specs),
+
+ % The du type may have a corresponding foreign type
+ % definition with a word_aligned_pointer assertion.
+ %
+ % XXX We will silently ignore a word_aligned_pointer
+ % assertion on a foreign type if there is a du type
+ % definition for the same type_ctor, and we don't end up in
+ % this single-ctor branch.
+ %
+ % Note that in the case of multiple ctors, there may be a
+ % competing packable() value in the ComponentTypeMap for
+ % the same type_ctor.
+ (
+ MaybeForeign = yes(Foreign),
+ ExpectForTarget = no,
+ add_foreign_if_word_aligned_ptr(ModuleInfo, Params,
+ TypeCtor, Foreign, ExpectForTarget,
+ !ComponentTypeMap, !Specs)
+ ;
+ MaybeForeign = no
+ )
else
add_du_if_single_ctor_is_word_aligned_ptr(Params, TypeCtor,
TypeDefn0, MaybeForeign, !ComponentTypeMap),
@@ -1879,8 +1900,9 @@ decide_if_simple_du_type(ModuleInfo, Params, TypeCtorToForeignEnumMap,
)
;
Body0 = hlds_foreign_type(ForeignType),
+ ExpectForTarget = yes,
add_foreign_if_word_aligned_ptr(ModuleInfo, Params, TypeCtor,
- ForeignType, !ComponentTypeMap, !Specs),
+ ForeignType, ExpectForTarget, !ComponentTypeMap, !Specs),
% There are no questions of representation to figure out.
cons(TypeCtorTypeDefn0, !NonSubTypeCtorTypeDefns)
@@ -2172,12 +2194,12 @@ add_du_if_single_ctor_is_word_aligned_ptr(Params, TypeCtor, TypeDefn,
%---------------------%
:- pred add_foreign_if_word_aligned_ptr(module_info::in, decide_du_params::in,
- type_ctor::in, foreign_type_body::in,
+ type_ctor::in, foreign_type_body::in, bool::in,
component_type_map::in, component_type_map::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_foreign_if_word_aligned_ptr(ModuleInfo, Params, TypeCtor,
- ForeignType, !ComponentTypeMap, !Specs) :-
+ ForeignType, ExpectForTarget, !ComponentTypeMap, !Specs) :-
DirectArgMap = Params ^ ddp_direct_arg_map,
( if map.search(DirectArgMap, TypeCtor, _DirectArgFunctors) then
DirectArgPieces = [words("Error:"), qual_type_ctor(TypeCtor),
@@ -2199,7 +2221,12 @@ add_foreign_if_word_aligned_ptr(ModuleInfo, Params, TypeCtor,
true
)
else
- unexpected($pred, "foreign type is not for this backend")
+ (
+ ExpectForTarget = yes,
+ unexpected($pred, "foreign type is not for this backend")
+ ;
+ ExpectForTarget = no
+ )
).
%---------------------%
diff --git a/compiler/hlds_data.m b/compiler/hlds_data.m
index 31a9e9367..975c69556 100644
--- a/compiler/hlds_data.m
+++ b/compiler/hlds_data.m
@@ -2,7 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1996-2012 The University of Melbourne.
-% Copyright (C) 2014-2021, 2024-2025 The Mercury team.
+% Copyright (C) 2014-2021, 2024-2026 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.
%---------------------------------------------------------------------------%
@@ -1036,6 +1036,8 @@ set_type_defn_prev_errors(X, !Defn) :-
:- func get_maybe_cheaper_tag_test(hlds_type_body) = maybe_cheaper_tag_test.
+:- pred is_du_type_with_direct_arg_ctors(hlds_type_body::in) is semidet.
+
% The ctor_name_to_repn_map type maps each constructor in a
% discriminated union type to the information that describes how
% terms with that constructor are represented. The representation
@@ -1080,6 +1082,14 @@ get_maybe_cheaper_tag_test(TypeBody) = CheaperTagTest :-
%---------------------%
+is_du_type_with_direct_arg_ctors(TypeBody) :-
+ TypeBody = hlds_du_type(TypeBodyDu),
+ TypeBodyDu ^ du_type_repn = yes(DuTypeRepn),
+ DuTypeRepn ^ dur_direct_arg_ctors = yes(DirectArgCtors),
+ DirectArgCtors = [_ | _].
+
+%---------------------%
+
insert_ctor_repn_into_map(CtorRepn, !CtorRepnMap) :-
SymName = CtorRepn ^ cr_name,
Name = unqualify_name(SymName),
diff --git a/compiler/intermod.m b/compiler/intermod.m
index a94c95a30..de9c9d81b 100644
--- a/compiler/intermod.m
+++ b/compiler/intermod.m
@@ -2,7 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1996-2012 The University of Melbourne.
-% Copyright (C) 2013-2025 The Mercury team.
+% Copyright (C) 2013-2026 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.
%---------------------------------------------------------------------------%
@@ -219,8 +219,16 @@ some_type_needs_to_be_written([], no).
some_type_needs_to_be_written([_ - TypeDefn | TypeCtorDefns], NeedWrite) :-
hlds_data.get_type_defn_status(TypeDefn, TypeStatus),
( if
- ( TypeStatus = type_status(status_abstract_exported)
- ; TypeStatus = type_status(status_exported_to_submodules)
+ (
+ TypeStatus = type_status(status_exported),
+ % A du type defined in the interface section (exported) will need
+ % to be written to the .opt file if it has any direct-arg ctors.
+ hlds_data.get_type_defn_body(TypeDefn, TypeBody),
+ is_du_type_with_direct_arg_ctors(TypeBody)
+ ;
+ TypeStatus = type_status(status_abstract_exported)
+ ;
+ TypeStatus = type_status(status_exported_to_submodules)
)
then
NeedWrite = yes
diff --git a/compiler/intermod_decide.m b/compiler/intermod_decide.m
index 44f9c1d03..3f1f2fbeb 100644
--- a/compiler/intermod_decide.m
+++ b/compiler/intermod_decide.m
@@ -1,7 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
-% Copyright (C) 2023-2025 The Mercury team.
+% Copyright (C) 2023-2026 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.
%---------------------------------------------------------------------------%
@@ -1227,7 +1227,15 @@ should_opt_export_type_defn(ModuleName, TypeCtor, TypeDefn) :-
hlds_data.get_type_defn_status(TypeDefn, TypeStatus),
TypeCtor = type_ctor(Name, _Arity),
Name = qualified(ModuleName, _),
- type_status_to_write(TypeStatus) = yes.
+ (
+ type_status_to_write(TypeStatus) = yes
+ ;
+ TypeStatus = type_status(status_exported),
+ % A du type defined in the interface section (exported) will need to
+ % be written to the .opt file if it has any direct-arg ctors.
+ hlds_data.get_type_defn_body(TypeDefn, TypeBody),
+ hlds_data.is_du_type_with_direct_arg_ctors(TypeBody)
+ ).
%---------------------------------------------------------------------------%
:- end_module transform_hlds.intermod_decide.
diff --git a/tests/hard_coded/Mercury.options b/tests/hard_coded/Mercury.options
index d1d939472..35bc19e03 100644
--- a/tests/hard_coded/Mercury.options
+++ b/tests/hard_coded/Mercury.options
@@ -39,6 +39,8 @@ MCFLAGS-deforest_cc_bug += --deforestation
MCFLAGS-delay_partial_test_1 += --delay-partial-instantiations
MCFLAGS-delay_partial_test_2 += --delay-partial-instantiations
MCFLAGS-delay_partial_test_2 += --no-warn-simple-code
+MCFLAGS-direct_arg_opt_imported += --intermodule-optimization
+MCFLAGS-direct_arg_opt_imported_helper_1 += --intermodule-optimization
MCFLAGS-ground_terms += --from-ground-term-threshold=2
MCFLAGS-impl_defn_literals += --no-warn-simple-code
MCFLAGS-lp += --intermodule-optimization -O3
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index a9b2683e1..45ec58d9b 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -111,6 +111,7 @@ ORDINARY_PROGS = \
det_in_semidet_cntxt \
digraph_tc \
dir_fold \
+ direct_arg_opt_imported \
direct_arg_partial_inst_1 \
direct_arg_partial_inst_2 \
direct_arg_tags_1 \
diff --git a/tests/hard_coded/direct_arg_opt_imported.m b/tests/hard_coded/direct_arg_opt_imported.m
new file mode 100644
index 000000000..7bd3d299e
--- /dev/null
+++ b/tests/hard_coded/direct_arg_opt_imported.m
@@ -0,0 +1,36 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+%
+% With intermodule optimisation enabled, the body of indirect_new_object is
+% inlined into main/2, including the construction:
+%
+% yes_object(Ob : object) : maybe_object
+%
+% When a type is opt-imported (but not imported) from a module, we depend on
+% information from the corresponding .opt file to tell us which of its
+% constructors use the direct-arg representation.
+%
+% The problem was that that additional information about the type was missing
+% from the .opt file because maybe_object is defined in the interface section
+% of its module, i.e. it was already exported.
+%
+
+:- module direct_arg_opt_imported.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module direct_arg_opt_imported_helper_1.
+% not imported: direct_arg_opt_imported_helper_1.sub.
+
+main(!IO) :-
+ indirect_new_object(Ob),
+ indirect_check_object(Ob, !IO).
diff --git a/tests/hard_coded/direct_arg_opt_imported_helper_1.m b/tests/hard_coded/direct_arg_opt_imported_helper_1.m
new file mode 100644
index 000000000..a532f4e53
--- /dev/null
+++ b/tests/hard_coded/direct_arg_opt_imported_helper_1.m
@@ -0,0 +1,33 @@
+:- module direct_arg_opt_imported_helper_1.
+:- interface.
+
+:- import_module io.
+
+:- include_module sub.
+
+:- type object.
+
+:- pred indirect_new_object(object::out) is det.
+
+:- pred indirect_check_object(object::in, io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module direct_arg_opt_imported_helper_1.sub.
+
+:- type object
+ ---> object(int).
+
+:- pragma foreign_type("C", object, "Object *", [word_aligned_pointer]).
+
+indirect_new_object(Ob) :-
+ new_object(Ob).
+
+% The test case requires this predicate to be opt-exported.
+:- pragma inline(pred(indirect_check_object/3)).
+
+indirect_check_object(Ob, !IO) :-
+ maybe_check_object(yes_object(Ob), !IO).
diff --git a/tests/hard_coded/direct_arg_opt_imported_helper_1.sub.m b/tests/hard_coded/direct_arg_opt_imported_helper_1.sub.m
new file mode 100644
index 000000000..69236d85d
--- /dev/null
+++ b/tests/hard_coded/direct_arg_opt_imported_helper_1.sub.m
@@ -0,0 +1,65 @@
+:- module direct_arg_opt_imported_helper_1.sub.
+:- interface.
+
+ % This test case tests an issue that arises from maybe_object being defined
+ % in a different module from 'object'. The location of the two
+ % predicates below is irrelevant.
+ %
+:- type maybe_object
+ ---> no_object
+ ; yes_object(object).
+
+:- pred new_object(object::out) is det.
+
+:- pred maybe_check_object(maybe_object::in, io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module list.
+:- import_module string.
+
+:- pragma foreign_decl("C", "
+typedef struct {
+ MR_Word magic;
+} Object;
+").
+
+new_object(object(-1)).
+
+:- pragma foreign_proc("C",
+ new_object(Ob::out),
+ [will_not_call_mercury, thread_safe, promise_pure, may_not_export_body],
+"
+ Ob = MR_GC_NEW(Object);
+ Ob->magic = 0xdeadbeef;
+").
+
+maybe_check_object(MaybeOb, !IO) :-
+ (
+ MaybeOb = yes_object(Ob),
+ get_magic(Ob, Magic),
+ ( if Magic = 0xdeadbeef then
+ io.write_string("ok\n", !IO)
+ else if Magic = -1 then
+ io.write_string("ok\n", !IO)
+ else
+ io.format("BUG: Magic = %#x\n", [i(Magic)], !IO)
+ )
+ ;
+ MaybeOb = no_object
+ ).
+
+:- pred get_magic(object::in, int::out) is det.
+
+get_magic(object(Magic), Magic).
+
+:- pragma foreign_proc(c,
+ get_magic(Ob::in, Magic::out),
+ [will_not_call_mercury, thread_safe, promise_pure, may_not_export_body],
+"
+ Magic = Ob->magic;
+ assert(Magic == 0xdeadbeef);
+").
--
2.51.0
More information about the reviews
mailing list