[m-rev.] for review: Add foreign_proc attributes may_export_body/may_not_export_body.
Peter Wang
novalazy at gmail.com
Thu Apr 15 11:36:23 AEST 2021
may_not_export seemed too general and may_not_opt_export seemed too
implementation-specific, so I ended up with may_not_export_body.
Other suggestions?
----
Add an attribute may_not_export_body to prevent a foreign_proc from
being opt-exported. Also add may_export_body for completeness.
compiler/prog_data_foreign.m:
Add type to represent those attributes.
Add a field for that attribute to pragma_foreign_proc_attributes,
plus getters and setters.
compiler/parse_pragma_foreign.m:
Parse may_export_body and may_not_export_body attributes on
foreign_proc declarations.
Detect conflicting attributes.
compiler/parse_tree_out_pragma.m:
Write out may_export_body and may_not_export_body attributes.
compiler/intermod.m:
Do not write a foreign_proc with may_not_export_body to .opt files.
compiler/simplify_proc.m:
Report an error if a foreign_proc with may_export_body is
also marked with pragma no_inline.
compiler/add_mutable_aux_preds.m:
Mark auxiliary predicates for mutables with may_not_export_body
instead of may_not_duplicate. This allows calls to those predicates
to be inlined.
doc/reference_manual.texi:
Document the new attributes.
tests/hard_coded/Mercury.options:
tests/hard_coded/Mmakefile:
tests/hard_coded/intermod_may_export_body.exp:
tests/hard_coded/intermod_may_export_body.m:
tests/hard_coded/intermod_may_export_body2.m:
tests/invalid/Mmakefile:
tests/invalid/test_may_export_body.err_exp:
tests/invalid/test_may_export_body.m:
Add test cases.
vim/syntax/mercury.vim:
Update vim syntax file.
NEWS:
Announce addition.
diff --git a/NEWS b/NEWS
index 791b1d221..0d2a312c8 100644
--- a/NEWS
+++ b/NEWS
@@ -414,6 +414,15 @@ Changes to the Mercury language
:- pragma memo(predname/arity, [disable_warning_if_ignored])]).
+* A `pragma foreign_proc` declaration can now include an attribute
+ `may_not_export_body` that prevents its body (i.e. the foreign code)
+ from being duplicated outside of the target file for that module
+ by intermodule optimization. This is useful when the foreign code
+ refers to types, functions, etc. that should be kept local to the
+ target file of that module. Unlike the `may_not_duplicate` attribute,
+ `may_not_export_body` does not prevent inlining of the foreign procedure
+ into other procedures in the same module.
+
Changes to the Mercury compiler
-------------------------------
diff --git a/compiler/add_mutable_aux_preds.m b/compiler/add_mutable_aux_preds.m
index cd2182b0b..592a6f7fb 100644
--- a/compiler/add_mutable_aux_preds.m
+++ b/compiler/add_mutable_aux_preds.m
@@ -1,7 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
-% 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.
%---------------------------------------------------------------------------%
@@ -1028,7 +1028,8 @@ define_aux_preds_for_mutable(TargetParams, ItemMutable, TargetMutableName,
% it must not be exported to `.opt' files. We could add the
% qualification but it would be better to move the mutable code
% generation into the backends first.
- set_may_duplicate(yes(proc_may_not_duplicate), Attrs0, Attrs)
+ % (Would we really want to opt-export mutable variables anyway?)
+ set_may_export_body(yes(proc_may_not_export_body), Attrs0, Attrs)
),
% The logic of this code should match the logic of
diff --git a/compiler/intermod.m b/compiler/intermod.m
index b5d1746f0..e54c9ef01 100644
--- a/compiler/intermod.m
+++ b/compiler/intermod.m
@@ -645,17 +645,14 @@ gather_entities_to_opt_export_in_goal_expr(GoalExpr, DoWrite,
% Inlineable exported pragma_foreign_code goals cannot use any
% non-exported types, so we just write out the clauses.
MaybeMayDuplicate = get_may_duplicate(Attrs),
- (
- MaybeMayDuplicate = yes(MayDuplicate),
- (
- MayDuplicate = proc_may_duplicate,
- DoWrite = yes
- ;
- MayDuplicate = proc_may_not_duplicate,
- DoWrite = no
+ MaybeMayExportBody = get_may_export_body(Attrs),
+ ( if
+ ( MaybeMayDuplicate = yes(proc_may_not_duplicate)
+ ; MaybeMayExportBody = yes(proc_may_not_export_body)
)
- ;
- MaybeMayDuplicate = no,
+ then
+ DoWrite = no
+ else
DoWrite = yes
)
;
diff --git a/compiler/parse_pragma_foreign.m b/compiler/parse_pragma_foreign.m
index 5d33bcaaf..8ae0ce47d 100644
--- a/compiler/parse_pragma_foreign.m
+++ b/compiler/parse_pragma_foreign.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 expandtab
%---------------------------------------------------------------------------%
% Copyright (C) 1996-2011 The University of Melbourne.
+% Copyright (C) 2020-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.
%---------------------------------------------------------------------------%
@@ -253,7 +254,7 @@ parse_foreign_language_type(ContextPieces, InputTerm, VarSet, MaybeLanguage,
MaybeForeignLangType = ok1(ForeignLangType)
)
;
- % NOTE: if we get here then MaybeFooreignLang will be an error and
+ % NOTE: if we get here then MaybeForeignLang will be an error and
% will give the user the required error message.
MaybeLanguage = error1(_),
MaybeForeignLangType = error1([]) % Dummy value.
@@ -680,7 +681,8 @@ parse_pragma_foreign_proc_varlist(VarSet, ContextPieces,
; coll_affects_liveness(proc_affects_liveness)
; coll_allocates_memory(proc_allocates_memory)
; coll_registers_roots(proc_registers_roots)
- ; coll_may_duplicate(proc_may_duplicate).
+ ; coll_may_duplicate(proc_may_duplicate)
+ ; coll_may_export_body(proc_may_export_body).
:- pred parse_and_check_pragma_foreign_proc_attributes_term(
foreign_language::in, varset::in, term::in, cord(format_component)::in,
@@ -736,7 +738,11 @@ parse_and_check_pragma_foreign_proc_attributes_term(ForeignLanguage, VarSet,
coll_registers_roots(proc_registers_roots) -
coll_registers_roots(proc_does_not_have_roots),
coll_may_duplicate(proc_may_duplicate) -
- coll_may_duplicate(proc_may_not_duplicate)
+ coll_may_duplicate(proc_may_not_duplicate),
+ coll_may_export_body(proc_may_export_body) -
+ coll_may_export_body(proc_may_not_export_body),
+ coll_may_duplicate(proc_may_not_duplicate) -
+ coll_may_export_body(proc_may_export_body)
],
parse_pragma_foreign_proc_attributes_term(ContextPieces, VarSet, Term,
MaybeAttrList),
@@ -870,6 +876,8 @@ parse_single_pragma_foreign_proc_attribute(VarSet, Term, Flag) :-
Flag = coll_registers_roots(RegistersRoots)
else if parse_may_duplicate(Term, MayDuplicate) then
Flag = coll_may_duplicate(MayDuplicate)
+ else if parse_may_export_body(Term, MayExport) then
+ Flag = coll_may_export_body(MayExport)
else
fail
).
@@ -982,6 +990,18 @@ parse_may_duplicate(Term, RegistersRoots) :-
RegistersRoots = proc_may_not_duplicate
).
+:- pred parse_may_export_body(term::in, proc_may_export_body::out) is semidet.
+
+parse_may_export_body(Term, RegistersRoots) :-
+ Term = term.functor(term.atom(Functor), [], _),
+ (
+ Functor = "may_export_body",
+ RegistersRoots = proc_may_export_body
+ ;
+ Functor = "may_not_export_body",
+ RegistersRoots = proc_may_not_export_body
+ ).
+
:- pred parse_tabled_for_io(term::in, proc_tabled_for_io::out) is semidet.
parse_tabled_for_io(term.functor(term.atom(Str), [], _), TabledForIo) :-
@@ -1083,6 +1103,8 @@ process_attribute(coll_registers_roots(RegistersRoots), !Attrs) :-
set_registers_roots(RegistersRoots, !Attrs).
process_attribute(coll_may_duplicate(MayDuplicate), !Attrs) :-
set_may_duplicate(yes(MayDuplicate), !Attrs).
+process_attribute(coll_may_export_body(MayExport), !Attrs) :-
+ set_may_export_body(yes(MayExport), !Attrs).
%---------------------%
diff --git a/compiler/parse_tree_out_pragma.m b/compiler/parse_tree_out_pragma.m
index 5549f5b56..572b2b55e 100644
--- a/compiler/parse_tree_out_pragma.m
+++ b/compiler/parse_tree_out_pragma.m
@@ -595,6 +595,7 @@ foreign_proc_attributes_to_strings(Attrs, VarSet) = StringList :-
AllocatesMemory = get_allocates_memory(Attrs),
RegistersRoots = get_registers_roots(Attrs),
MaybeMayDuplicate = get_may_duplicate(Attrs),
+ MaybeMayExportBody = get_may_export_body(Attrs),
ExtraAttributes = get_extra_attributes(Attrs),
(
MayCallMercury = proc_may_call_mercury,
@@ -741,13 +742,26 @@ foreign_proc_attributes_to_strings(Attrs, VarSet) = StringList :-
MaybeMayDuplicate = no,
MayDuplicateStrList = []
),
+ (
+ MaybeMayExportBody = yes(MayExportBody),
+ (
+ MayExportBody = proc_may_export_body,
+ MayExportBodyStrList = ["may_export_body"]
+ ;
+ MayExportBody = proc_may_not_export_body,
+ MayExportBodyStrList = ["may_not_export_body"]
+ )
+ ;
+ MaybeMayExportBody = no,
+ MayExportBodyStrList = []
+ ),
StringList = [MayCallMercuryStr, ThreadSafeStr, TabledForIOStr |
PurityStrList] ++ TerminatesStrList ++ UserSharingStrList ++
ExceptionsStrList ++
OrdinaryDespiteDetismStrList ++ MayModifyTrailStrList ++
MayCallMM_TabledStrList ++ BoxPolicyStrList ++
AffectsLivenessStrList ++ AllocatesMemoryStrList ++
- RegistersRootsStrList ++ MayDuplicateStrList ++
+ RegistersRootsStrList ++ MayDuplicateStrList ++ MayExportBodyStrList ++
list.map(extra_attribute_to_string, ExtraAttributes).
:- func user_annotated_sharing_to_string(prog_varset, structure_sharing_domain,
diff --git a/compiler/prog_data_foreign.m b/compiler/prog_data_foreign.m
index e190f9dff..edf1efeca 100644
--- a/compiler/prog_data_foreign.m
+++ b/compiler/prog_data_foreign.m
@@ -271,6 +271,8 @@ default_export_enum_attributes =
proc_registers_roots.
:- func get_may_duplicate(pragma_foreign_proc_attributes) =
maybe(proc_may_duplicate).
+:- func get_may_export_body(pragma_foreign_proc_attributes) =
+ maybe(proc_may_export_body).
:- func get_extra_attributes(pragma_foreign_proc_attributes)
= pragma_foreign_proc_extra_attributes.
@@ -322,6 +324,9 @@ default_export_enum_attributes =
:- pred set_may_duplicate(maybe(proc_may_duplicate)::in,
pragma_foreign_proc_attributes::in,
pragma_foreign_proc_attributes::out) is det.
+:- pred set_may_export_body(maybe(proc_may_export_body)::in,
+ pragma_foreign_proc_attributes::in,
+ pragma_foreign_proc_attributes::out) is det.
:- pred add_extra_attribute(pragma_foreign_proc_extra_attribute::in,
pragma_foreign_proc_attributes::in,
pragma_foreign_proc_attributes::out) is det.
@@ -427,6 +432,10 @@ default_export_enum_attributes =
---> proc_may_duplicate
; proc_may_not_duplicate.
+:- type proc_may_export_body
+ ---> proc_may_export_body
+ ; proc_may_not_export_body.
+
% This type specifies the termination property of a procedure
% defined using pragma foreign_proc.
%
@@ -497,6 +506,7 @@ default_export_enum_attributes =
attr_allocates_memory :: proc_allocates_memory,
attr_registers_roots :: proc_registers_roots,
attr_may_duplicate :: maybe(proc_may_duplicate),
+ attr_may_export_body :: maybe(proc_may_export_body),
attr_extra_attributes ::
list(pragma_foreign_proc_extra_attribute)
).
@@ -508,7 +518,7 @@ default_attributes(Language) =
no, proc_may_modify_trail, proc_default_calls_mm_tabled,
bp_native_if_possible, proc_default_affects_liveness,
proc_default_allocates_memory, proc_default_registers_roots,
- no, []).
+ no, no, []).
get_foreign_language(Attrs) = Attrs ^ attr_foreign_language.
get_may_call_mercury(Attrs) = Attrs ^ attr_may_call_mercury.
@@ -526,6 +536,7 @@ get_affects_liveness(Attrs) = Attrs ^ attr_affects_liveness.
get_allocates_memory(Attrs) = Attrs ^ attr_allocates_memory.
get_registers_roots(Attrs) = Attrs ^ attr_registers_roots.
get_may_duplicate(Attrs) = Attrs ^ attr_may_duplicate.
+get_may_export_body(Attrs) = Attrs ^ attr_may_export_body.
get_extra_attributes(Attrs) = Attrs ^ attr_extra_attributes.
set_may_call_mercury(MayCallMercury, !Attrs) :-
@@ -560,6 +571,8 @@ set_registers_roots(RegistersRoots, !Attrs) :-
!Attrs ^ attr_registers_roots := RegistersRoots.
set_may_duplicate(MayDuplicate, !Attrs) :-
!Attrs ^ attr_may_duplicate := MayDuplicate.
+set_may_export_body(MayExport, !Attrs) :-
+ !Attrs ^ attr_may_export_body := MayExport.
add_extra_attribute(NewAttribute, !Attrs) :-
!Attrs ^ attr_extra_attributes :=
diff --git a/compiler/simplify_proc.m b/compiler/simplify_proc.m
index c5b7d4a78..8bc3083ff 100644
--- a/compiler/simplify_proc.m
+++ b/compiler/simplify_proc.m
@@ -316,7 +316,7 @@ simplify_proc_return_msgs(SimplifyTasks0, PredId, ProcId, !ModuleInfo,
simplify_info_get_error_specs(Info, !:Specs),
!:Specs = FormatSpecs ++ !.Specs,
- simplify_proc_maybe_warn_about_duplicates(!.ModuleInfo, PredId,
+ simplify_proc_maybe_warn_attribute_conflict(!.ModuleInfo, PredId,
!.ProcInfo, !Specs),
pred_info_get_status(PredInfo0, Status),
@@ -469,10 +469,11 @@ simplify_proc_analyze_and_format_calls(!ModuleInfo, ImplicitStreamWarnings,
%-----------------------------------------------------------------------------%
-:- pred simplify_proc_maybe_warn_about_duplicates(module_info::in, pred_id::in,
- proc_info::in, list(error_spec)::in, list(error_spec)::out) is det.
+:- pred simplify_proc_maybe_warn_attribute_conflict(module_info::in,
+ pred_id::in, proc_info::in, list(error_spec)::in, list(error_spec)::out)
+ is det.
-simplify_proc_maybe_warn_about_duplicates(ModuleInfo, PredId, ProcInfo,
+simplify_proc_maybe_warn_attribute_conflict(ModuleInfo, PredId, ProcInfo,
!Specs) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_markers(PredInfo, Markers),
@@ -480,42 +481,83 @@ simplify_proc_maybe_warn_about_duplicates(ModuleInfo, PredId, ProcInfo,
% The alternate goal by definition cannot be a call_foreign_proc.
proc_info_get_goal(ProcInfo, Goal),
Goal = hlds_goal(GoalExpr, GoalInfo),
- ( if
- GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _),
+ ( if GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _) then
+ Context = goal_info_get_context(GoalInfo),
MaybeMayDuplicate = get_may_duplicate(Attributes),
- MaybeMayDuplicate = yes(MayDuplicate)
- then
(
- MayDuplicate = proc_may_duplicate,
- ( if check_marker(Markers, marker_user_marked_no_inline) then
- Context = goal_info_get_context(GoalInfo),
- Pieces = [words("Error: the"), quote("may_duplicate"),
- words("attribute on the foreign_proc contradicts the"),
- quote("no_inline"), words("pragma on the predicate.")],
- Spec = simplest_spec($pred, severity_error,
- phase_simplify(report_in_any_mode), Context, Pieces),
- !:Specs = [Spec | !.Specs]
- else
- true
- )
+ MaybeMayDuplicate = yes(MayDuplicate),
+ maybe_warn_about_may_duplicate_attributes(MayDuplicate, Markers,
+ Context, !Specs)
;
- MayDuplicate = proc_may_not_duplicate,
- ( if check_marker(Markers, marker_user_marked_inline) then
- Context = goal_info_get_context(GoalInfo),
- Pieces = [words("Error: the"), quote("may_not_duplicate"),
- words("attribute on the foreign_proc contradicts the"),
- quote("inline"), words("pragma on the predicate.")],
- Spec = simplest_spec($pred, severity_error,
- phase_simplify(report_in_any_mode), Context, Pieces),
- !:Specs = [Spec | !.Specs]
- else
- true
- )
+ MaybeMayDuplicate = no
+ ),
+ MaybeMayExportBody = get_may_export_body(Attributes),
+ (
+ MaybeMayExportBody = yes(MayExportBody),
+ maybe_warn_about_may_export_body_attribute(MayExportBody, Markers,
+ Context, !Specs)
+ ;
+ MaybeMayExportBody = no
)
else
true
).
+:- pred maybe_warn_about_may_duplicate_attributes(proc_may_duplicate::in,
+ pred_markers::in, prog_context::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+maybe_warn_about_may_duplicate_attributes(MayDuplicate, Markers, Context,
+ !Specs) :-
+ (
+ MayDuplicate = proc_may_duplicate,
+ ( if check_marker(Markers, marker_user_marked_no_inline) then
+ Pieces = [words("Error: the"), quote("may_duplicate"),
+ words("attribute on the foreign_proc contradicts the"),
+ quote("no_inline"), words("pragma on the predicate.")],
+ Spec = simplest_spec($pred, severity_error,
+ phase_simplify(report_in_any_mode), Context, Pieces),
+ !:Specs = [Spec | !.Specs]
+ else
+ true
+ )
+ ;
+ MayDuplicate = proc_may_not_duplicate,
+ ( if check_marker(Markers, marker_user_marked_inline) then
+ Pieces = [words("Error: the"), quote("may_not_duplicate"),
+ words("attribute on the foreign_proc contradicts the"),
+ quote("inline"), words("pragma on the predicate.")],
+ Spec = simplest_spec($pred, severity_error,
+ phase_simplify(report_in_any_mode), Context, Pieces),
+ !:Specs = [Spec | !.Specs]
+ else
+ true
+ )
+ ).
+
+:- pred maybe_warn_about_may_export_body_attribute(proc_may_export_body::in,
+ pred_markers::in, prog_context::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+maybe_warn_about_may_export_body_attribute(MayExportBody, Markers, Context,
+ !Specs) :-
+ (
+ MayExportBody = proc_may_export_body,
+ ( if check_marker(Markers, marker_user_marked_no_inline) then
+ Pieces = [words("Error: the"), quote("may_export_body"),
+ words("attribute on the foreign_proc contradicts the"),
+ quote("no_inline"), words("pragma on the predicate.")],
+ Spec = simplest_spec($pred, severity_error,
+ phase_simplify(report_in_any_mode), Context, Pieces),
+ !:Specs = [Spec | !.Specs]
+ else
+ true
+ )
+ ;
+ MayExportBody = proc_may_not_export_body
+ % Inlining is allowed within the same target file.
+ ).
+
%-----------------------------------------------------------------------------%
:- pred simplify_top_level_goal(hlds_goal::in, hlds_goal::out,
diff --git a/doc/reference_manual.texi b/doc/reference_manual.texi
index 41b0e10ed..e777b30ff 100644
--- a/doc/reference_manual.texi
+++ b/doc/reference_manual.texi
@@ -7931,11 +7931,20 @@ This attribute tells the compiler
whether it is allowed to duplicate the foreign code fragment
through optimizations such as inlining.
The @samp{may_duplicate} attribute says that it may;
-The @samp{may_not_duplicate} attribute says that it may not.
+the @samp{may_not_duplicate} attribute says that it may not.
In the absence of either attribute,
the compiler is allowed make its own judgement in the matter,
based on factors such as the size of the code fragment.
+ at item @samp{may_export_body/may_not_export_body}
+This attribute tells the compiler
+whether it is allowed to duplicate the foreign code fragment
+outside of the target file for the module that
+defines the foreign procedure.
+The @samp{may_export_body} attribute says that it may;
+the @samp{may_not_export_body} attribute says that it may not.
+The default is @samp{may_export_body}.
+
@c @item
@c @samp{does_not_allocate_memory/allocates_bounded_memory/allocates_unbounded_memory}
@c This attribute declares whether a foreign procedure
diff --git a/tests/hard_coded/Mercury.options b/tests/hard_coded/Mercury.options
index ce0924c9d..f13cca3d5 100644
--- a/tests/hard_coded/Mercury.options
+++ b/tests/hard_coded/Mercury.options
@@ -44,6 +44,10 @@ MCFLAGS-intermod_c_code = --intermodule-optimization
MCFLAGS-intermod_c_code2 = --intermodule-optimization
MCFLAGS-intermod_foreign_type = --intermodule-optimization
MCFLAGS-intermod_foreign_type2 = --intermodule-optimization
+MCFLAGS-intermod_may_export_body = --intermodule-optimization
+MCFLAGS-intermod_may_export_body2 = --intermodule-optimization
+MCFLAGS-intermod_multimode = --intermodule-optimization
+MCFLAGS-intermod_multimode_main = --intermodule-optimization
MCFLAGS-intermod_poly_mode = --intermodule-optimization
MCFLAGS-intermod_poly_mode_2 = --intermodule-optimization
MCFLAGS-intermod_pragma_clause = --intermodule-optimization
@@ -52,8 +56,6 @@ MCFLAGS-intermod_try_goal = --intermodule-optimization
MCFLAGS-intermod_try_goal2 = --intermodule-optimization
MCFLAGS-intermod_type_qual = --intermodule-optimization
MCFLAGS-intermod_type_qual2 = --intermodule-optimization
-MCFLAGS-intermod_multimode = --intermodule-optimization
-MCFLAGS-intermod_multimode_main = --intermodule-optimization
MCFLAGS-lco_double = --optimize-constructor-last-call
MCFLAGS-lco_mday_bug_1 = --optimize-constructor-last-call
MCFLAGS-lco_mday_bug_2 = --optimize-constructor-last-call
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 2eabcc120..a5b0e998d 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -215,6 +215,7 @@ ORDINARY_PROGS = \
integer_uint_conv \
intermod_c_code \
intermod_foreign_type \
+ intermod_may_export_body \
intermod_multimode_main \
intermod_poly_mode \
intermod_pragma_clause \
diff --git a/tests/hard_coded/intermod_may_export_body.exp b/tests/hard_coded/intermod_may_export_body.exp
new file mode 100644
index 000000000..5d57ce06b
--- /dev/null
+++ b/tests/hard_coded/intermod_may_export_body.exp
@@ -0,0 +1,2 @@
+3
+9
diff --git a/tests/hard_coded/intermod_may_export_body.m b/tests/hard_coded/intermod_may_export_body.m
new file mode 100644
index 000000000..26c07905b
--- /dev/null
+++ b/tests/hard_coded/intermod_may_export_body.m
@@ -0,0 +1,21 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+
+:- module intermod_may_export_body.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module intermod_may_export_body2.
+
+main(!IO) :-
+ plus(1, 2, A),
+ cannot_export_plus(4, 5, B),
+ io.print_line(A, !IO),
+ io.print_line(B, !IO).
diff --git a/tests/hard_coded/intermod_may_export_body2.m b/tests/hard_coded/intermod_may_export_body2.m
new file mode 100644
index 000000000..e4b6dc6ad
--- /dev/null
+++ b/tests/hard_coded/intermod_may_export_body2.m
@@ -0,0 +1,59 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+
+:- module intermod_may_export_body2.
+
+:- interface.
+
+:- pred plus(int::in, int::in, int::out) is det.
+
+:- pred cannot_export_plus(int::in, int::in, int::out) is det.
+
+:- implementation.
+
+plus(X, Y, Z) :-
+ % This call should be inlined.
+ cannot_export_plus(X, Y, Z).
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C", local, "
+ typedef MR_Integer MyInt;
+").
+:- pragma foreign_decl("C#", local, "
+ using System.Collections; // for ArrayList
+").
+:- pragma foreign_decl("Java", local, "
+ import java.util.ArrayList;
+").
+
+:- pragma inline(cannot_export_plus/3).
+
+:- pragma foreign_proc("C",
+ cannot_export_plus(X::in, Y::in, Z::out),
+ [will_not_call_mercury, promise_pure, may_not_export_body],
+"
+ // Refers to local type MyInt.
+ Z = (MyInt) (X + Y);
+").
+
+:- pragma foreign_proc("C#",
+ cannot_export_plus(X::in, Y::in, Z::out),
+ [will_not_call_mercury, promise_pure, may_not_export_body],
+"
+ // Uses ArrayList without namespace prefix.
+ ArrayList arr = new ArrayList();
+ arr.Add(X + Y);
+ Z = (int) arr[0];
+").
+
+:- pragma foreign_proc("Java",
+ cannot_export_plus(X::in, Y::in, Z::out),
+ [will_not_call_mercury, promise_pure, may_not_export_body],
+"
+ // Uses ArrayList without package prefix.
+ ArrayList<Integer> arr = new ArrayList();
+ arr.add(X + Y);
+ Z = arr.get(0);
+").
diff --git a/tests/invalid/Mmakefile b/tests/invalid/Mmakefile
index 88348406b..71e1e898d 100644
--- a/tests/invalid/Mmakefile
+++ b/tests/invalid/Mmakefile
@@ -319,6 +319,7 @@ SINGLEMODULE= \
tc_err2 \
test_feature_set \
test_may_duplicate \
+ test_may_export_body \
tricky_assert1 \
try_bad_params \
try_detism \
diff --git a/tests/invalid/test_may_export_body.err_exp b/tests/invalid/test_may_export_body.err_exp
new file mode 100644
index 000000000..5be639225
--- /dev/null
+++ b/tests/invalid/test_may_export_body.err_exp
@@ -0,0 +1,3 @@
+test_may_export_body.m:023: Error: the `may_export_body' attribute on the
+test_may_export_body.m:023: foreign_proc contradicts the `no_inline' pragma
+test_may_export_body.m:023: on the predicate.
diff --git a/tests/invalid/test_may_export_body.m b/tests/invalid/test_may_export_body.m
new file mode 100644
index 000000000..8a0aec7f0
--- /dev/null
+++ b/tests/invalid/test_may_export_body.m
@@ -0,0 +1,38 @@
+% vim:ts=4 sw=4 expandtab ft=mercury
+
+:- module test_may_export_body.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+main(!IO) :-
+ A0 = 0,
+ p1(A0, A1),
+ p2(A1, A),
+ io.write_int(A, !IO),
+ io.nl(!IO).
+
+:- pred p1(int::in, int::out) is det.
+:- pragma no_inline(p1/2).
+
+:- pragma foreign_proc("C",
+ p1(N::in, M::out),
+ [will_not_call_mercury, promise_pure, may_export_body],
+"
+ M = N + 1;
+").
+
+:- pred p2(int::in, int::out) is det.
+:- pragma inline(p2/2).
+
+:- pragma foreign_proc("C",
+ p2(N::in, M::out),
+ [will_not_call_mercury, promise_pure, may_not_export_body],
+"
+ M = N + 10;
+").
diff --git a/vim/syntax/mercury.vim b/vim/syntax/mercury.vim
index e15d7789a..469fdca0b 100644
--- a/vim/syntax/mercury.vim
+++ b/vim/syntax/mercury.vim
@@ -2,7 +2,7 @@
" Language: Mercury
" Maintainer: Sebastian Godelet <sebastian.godelet at outlook.com>
" Extensions: *.m *.moo
-" Last Change: 2020-10-30
+" Last Change: 2021-04-15
" for documentation, please use :help mercury-syntax
@@ -116,6 +116,7 @@ syn keyword mercuryForeignMod attach_to_io_state
syn keyword mercuryForeignMod can_pass_as_mercury_type word_aligned_pointer stable
syn keyword mercuryForeignMod may_call_mercury will_not_call_mercury
syn keyword mercuryForeignMod may_duplicate may_not_duplicate
+syn keyword mercuryForeignMod may_export_body may_not_export_body
syn keyword mercuryForeignMod may_modify_trail will_not_modify_trail
syn keyword mercuryForeignMod no_sharing unknown_sharing sharing
syn keyword mercuryForeignMod promise_pure promise_semipure
--
2.30.0
More information about the reviews
mailing list