[m-rev.] for review: Enable the require_tail_recursion pragma in the MLDS backends.
Paul Bone
paul at bone.id.au
Fri Nov 27 18:08:06 AEDT 2015
For review by Zoltan, he and I were discussing this on the mailing list.
---
Enable the require_tail_recursion pragma in the MLDS backends.
None of the MLDS backends support mutual recursion. Therefore the compiler
will still give a warning when mutual recursion is used even when it is
allowed by the pragma, because it still wasn't optimised.
compiler/mlds.m:
Add require_tailrec_info to MLDS functions.
compiler/ml_proc_gen.m:
Copy the require_tailrec_info information from the HLDS to the MLDS.
compiler/ml_tailcall.m:
Generate errors and warnings with respect to the require_tail_recursion
pragma.
compiler/mercury_compile.m:
compiler/mercury_compile_mlds_back_end.m:
Return errors from the MLDS tailcall optimisation pass.
compiler/compiler_util.m:
Add warning_or_error_serverity conversion predicate.
compiler/ml_code_util.m:
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_type_gen.m:
compiler/ml_util.m:
compiler/mlds_to_c.m:
compiler/mlds_to_cs.m:
compiler/mlds_to_java.m:
Conform to changes in mlds.m.
---
compiler/compiler_util.m | 6 +
compiler/mercury_compile.m | 19 +--
compiler/mercury_compile_mlds_back_end.m | 14 +-
compiler/ml_code_util.m | 4 +-
compiler/ml_elim_nested.m | 22 +--
compiler/ml_optimize.m | 10 +-
compiler/ml_proc_gen.m | 4 +-
compiler/ml_tailcall.m | 233 +++++++++++++++++++++----------
compiler/ml_type_gen.m | 4 +-
compiler/ml_util.m | 6 +-
compiler/mlds.m | 17 ++-
compiler/mlds_to_c.m | 14 +-
compiler/mlds_to_cs.m | 36 ++---
compiler/mlds_to_java.m | 44 +++---
14 files changed, 272 insertions(+), 161 deletions(-)
diff --git a/compiler/compiler_util.m b/compiler/compiler_util.m
index 16df7a1..731a86b 100644
--- a/compiler/compiler_util.m
+++ b/compiler/compiler_util.m
@@ -41,6 +41,9 @@
:- mode warning_or_error_string(in, out) is det.
:- mode warning_or_error_string(out, in) is semidet.
+:- pred warning_or_error_severity(warning_or_error::in, error_severity::out)
+ is det.
+
%-----------------------------------------------------------------------------%
:- pred add_error(error_phase::in, list(format_component)::in,
@@ -82,6 +85,9 @@
warning_or_error_string(we_warning, "warn").
warning_or_error_string(we_error, "error").
+warning_or_error_severity(we_warning, severity_warning).
+warning_or_error_severity(we_error, severity_error).
+
%-----------------------------------------------------------------------------%
add_error(Phase, Pieces, !Specs) :-
diff --git a/compiler/mercury_compile.m b/compiler/mercury_compile.m
index 472fc6c..c5eb03f 100644
--- a/compiler/mercury_compile.m
+++ b/compiler/mercury_compile.m
@@ -1580,7 +1580,7 @@ process_augmented_module(Globals, OpModeAugment, ModuleAndImports,
HLDS21, HLDS22, !IO),
after_front_end_passes(Globals, OpModeCodeGen, NestedSubModules,
FindTimestampFiles, MaybeTimestampMap, HLDS22,
- !.Specs, ExtraObjFiles, !DumpInfo, !IO)
+ ExtraObjFiles, !Specs, !DumpInfo, !IO)
)
else
% If the number of errors is > 0, make sure that the compiler
@@ -2103,12 +2103,12 @@ prepare_for_intermodule_analysis(Globals, Verbose, Stats, !HLDS, !IO) :-
set(module_name)::in,
find_timestamp_file_names::in(find_timestamp_file_names),
maybe(module_timestamp_map)::in, module_info::in,
- list(error_spec)::in, list(string)::out, dump_info::in, dump_info::out,
- io::di, io::uo) is det.
+ list(string)::out, list(error_spec)::in, list(error_spec)::out,
+ dump_info::in, dump_info::out, io::di, io::uo) is det.
after_front_end_passes(Globals, OpModeCodeGen, NestedSubModules,
FindTimestampFiles, MaybeTimestampMap, !.HLDS,
- Specs, ExtraObjFiles, !DumpInfo, !IO) :-
+ ExtraObjFiles, !Specs, !DumpInfo, !IO) :-
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
maybe_output_prof_call_graph(Verbose, Stats, !HLDS, !IO),
@@ -2126,7 +2126,7 @@ after_front_end_passes(Globals, OpModeCodeGen, NestedSubModules,
do_not_create_dirs, UsageFileName, !IO),
io.remove_file(UsageFileName, _, !IO),
- FrontEndErrors = contains_errors(Globals, Specs),
+ FrontEndErrors = contains_errors(Globals, !.Specs),
module_info_get_num_errors(!.HLDS, NumErrors),
( if
FrontEndErrors = no,
@@ -2134,13 +2134,15 @@ after_front_end_passes(Globals, OpModeCodeGen, NestedSubModules,
then
(
Target = target_csharp,
- mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
+ mlds_backend(!.HLDS, _, MLDS, NewSpecs, !DumpInfo, !IO),
+ !:Specs = NewSpecs ++ !.Specs,
% mlds_to_csharp never goes beyond generating C# code.
mlds_to_csharp(!.HLDS, MLDS, Succeeded, !IO),
ExtraObjFiles = []
;
Target = target_java,
- mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
+ mlds_backend(!.HLDS, _, MLDS, NewSpecs, !DumpInfo, !IO),
+ !:Specs = NewSpecs ++ !.Specs,
mlds_to_java(!.HLDS, MLDS, TargetCodeSucceeded, !IO),
(
OpModeCodeGen = opmcg_target_code_only,
@@ -2172,7 +2174,8 @@ after_front_end_passes(Globals, OpModeCodeGen, NestedSubModules,
export.produce_header_file(!.HLDS, ExportDecls, ModuleName, !IO),
(
HighLevelCode = yes,
- mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
+ mlds_backend(!.HLDS, _, MLDS, NewSpecs, !DumpInfo, !IO),
+ !:Specs = NewSpecs ++ !.Specs,
mlds_to_high_level_c(Globals, MLDS, TargetCodeSucceeded, !IO),
(
OpModeCodeGen = opmcg_target_code_only,
diff --git a/compiler/mercury_compile_mlds_back_end.m b/compiler/mercury_compile_mlds_back_end.m
index 275370c..3d622b9 100644
--- a/compiler/mercury_compile_mlds_back_end.m
+++ b/compiler/mercury_compile_mlds_back_end.m
@@ -24,17 +24,20 @@
:- import_module ml_backend.
:- import_module ml_backend.mlds.
:- import_module parse_tree.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module bool.
:- import_module io.
+:- import_module list.
% Return `yes' iff this module defines the main/2 entry point.
%
:- func mlds_has_main(mlds) = has_main.
:- pred mlds_backend(module_info::in, module_info::out, mlds::out,
- dump_info::in, dump_info::out, io::di, io::uo) is det.
+ list(error_spec)::out, dump_info::in, dump_info::out, io::di, io::uo)
+ is det.
:- pred maybe_mark_static_terms(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
@@ -71,13 +74,11 @@
:- import_module ml_backend.mlds_to_java. % MLDS -> Java
:- import_module ml_backend.mlds_to_cs. % MLDS -> C#
:- import_module ml_backend.ml_util. % MLDS utility predicates
-:- import_module parse_tree.error_util.
:- import_module parse_tree.file_names.
:- import_module top_level.mercury_compile_front_end.
:- import_module top_level.mercury_compile_llds_back_end.
:- import_module getopt_io.
-:- import_module list.
:- import_module pprint.
:- import_module require.
:- import_module string.
@@ -96,7 +97,7 @@ mlds_has_main(MLDS) =
%---------------------------------------------------------------------------%
-mlds_backend(!HLDS, !:MLDS, !DumpInfo, !IO) :-
+mlds_backend(!HLDS, !:MLDS, Specs, !DumpInfo, !IO) :-
module_info_get_globals(!.HLDS, Globals),
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
@@ -147,10 +148,11 @@ mlds_backend(!HLDS, !:MLDS, !DumpInfo, !IO) :-
(
OptimizeTailCalls = yes,
maybe_write_string(Verbose, "% Detecting tail calls...\n", !IO),
- ml_mark_tailcalls(Globals, !MLDS, !IO),
+ ml_mark_tailcalls(Globals, Specs, !MLDS),
maybe_write_string(Verbose, "% done.\n", !IO)
;
- OptimizeTailCalls = no
+ OptimizeTailCalls = no,
+ Specs = []
),
maybe_report_stats(Stats, !IO),
maybe_dump_mlds(Globals, !.MLDS, 20, "tailcalls", !IO),
diff --git a/compiler/ml_code_util.m b/compiler/ml_code_util.m
index 8de807b..15bdc3c 100644
--- a/compiler/ml_code_util.m
+++ b/compiler/ml_code_util.m
@@ -744,7 +744,7 @@ ml_gen_label_func(Info, FuncLabel, FuncParams, Context, Statement, Func) :-
Attributes = [],
EnvVarNames = set.init,
FuncDefn = mlds_function(MaybePredProcId, FuncParams,
- body_defined_here(Statement), Attributes, EnvVarNames),
+ body_defined_here(Statement), Attributes, EnvVarNames, no),
Func = mlds_defn(FuncName, mlds_make_context(Context), DeclFlags,
FuncDefn).
@@ -1971,7 +1971,7 @@ ml_gen_call_current_success_cont_indirectly(Context, Statement, !Info) :-
( if
Defn = mlds_defn(EntityName, _, _, EntityDefn),
EntityName = entity_function(PredLabel, ProcId, yes(SeqNum), _),
- EntityDefn = mlds_function(_, _, body_defined_here(_), _, _)
+ EntityDefn = mlds_function(_, _, body_defined_here(_), _, _, _)
then
% We call the proxy function.
ProcLabel = mlds_proc_label(PredLabel, ProcId),
diff --git a/compiler/ml_elim_nested.m b/compiler/ml_elim_nested.m
index 55e4a6a..bcc89fe 100644
--- a/compiler/ml_elim_nested.m
+++ b/compiler/ml_elim_nested.m
@@ -521,7 +521,8 @@ ml_elim_nested_defns(Action, ModuleName, Globals, OuterVars, Defn0, Defns) :-
Defn0 = mlds_defn(Name, Context, Flags, DefnBody0),
( if
DefnBody0 = mlds_function(PredProcId, Params0,
- body_defined_here(FuncBody0), Attributes, EnvVarNames),
+ body_defined_here(FuncBody0), Attributes, EnvVarNames,
+ MaybeRequiretailrecInfo),
% Don't add GC tracing code to the gc_trace/1 primitive!
% (Doing so would just slow things down unnecessarily.)
not (
@@ -658,7 +659,8 @@ ml_elim_nested_defns(Action, ModuleName, Globals, OuterVars, Defn0, Defns) :-
),
Params = mlds_func_params(Arguments, RetValues),
DefnBody = mlds_function(PredProcId, Params,
- body_defined_here(FuncBody), Attributes, EnvVarNames),
+ body_defined_here(FuncBody), Attributes, EnvVarNames,
+ MaybeRequiretailrecInfo),
Defn = mlds_defn(Name, Context, Flags, DefnBody),
Defns = list.append(HoistedDefns, [Defn])
else
@@ -1043,7 +1045,7 @@ gen_gc_trace_func(FuncName, PredModule, FramePointerDecl, GCTraceStatements,
Attributes = [],
EnvVarNames = set.init,
FuncDefn = mlds_function(MaybePredProcId, FuncParams,
- body_defined_here(Statement), Attributes, EnvVarNames),
+ body_defined_here(Statement), Attributes, EnvVarNames, no),
GCTraceFuncDefn = mlds_defn(GCTraceFuncName, Context, DeclFlags,
FuncDefn).
@@ -1142,7 +1144,8 @@ ml_insert_init_env(Action, TypeName, ModuleName, Globals, Defn0, Defn,
Defn0 = mlds_defn(Name, Context, Flags, DefnBody0),
( if
DefnBody0 = mlds_function(PredProcId, Params,
- body_defined_here(FuncBody0), Attributes, EnvVarNames),
+ body_defined_here(FuncBody0), Attributes, EnvVarNames,
+ MaybeRequiretailrecInfo),
statement_contains_var(FuncBody0, qual(ModuleName, module_qual,
mlds_data_var(mlds_var_name("env_ptr", no)))) = yes
then
@@ -1160,7 +1163,8 @@ ml_insert_init_env(Action, TypeName, ModuleName, Globals, Defn0, Defn,
FuncBody = statement(ml_stmt_block([EnvPtrDecl],
[InitEnvPtr, FuncBody0]), Context),
DefnBody = mlds_function(PredProcId, Params,
- body_defined_here(FuncBody), Attributes, EnvVarNames),
+ body_defined_here(FuncBody), Attributes, EnvVarNames,
+ MaybeRequiretailrecInfo),
Defn = mlds_defn(Name, Context, Flags, DefnBody),
Init = yes
else
@@ -1619,7 +1623,7 @@ flatten_nested_defn(Action, Defn0, FollowingDefns, FollowingStatements,
Defn0 = mlds_defn(Name, Context, Flags0, DefnBody0),
(
DefnBody0 = mlds_function(PredProcId, Params, FuncBody0, Attributes,
- EnvVarNames),
+ EnvVarNames, MaybeRequiretailrecInfo),
% Recursively flatten the nested function.
flatten_function_body(Action, FuncBody0, FuncBody, !Info),
@@ -1635,7 +1639,7 @@ flatten_nested_defn(Action, Defn0, FollowingDefns, FollowingStatements,
Flags = Flags0
),
DefnBody = mlds_function(PredProcId, Params, FuncBody, Attributes,
- EnvVarNames),
+ EnvVarNames, MaybeRequiretailrecInfo),
Defn = mlds_defn(Name, Context, Flags, DefnBody),
(
Action = hoist_nested_funcs,
@@ -1758,7 +1762,7 @@ ml_need_to_hoist(ModuleName, DataName, FollowingDefns, FollowingStatements) :-
mlds_defn::in) is semidet.
ml_need_to_hoist_defn(QualDataName, FollowingDefn) :-
- FollowingDefn = mlds_defn(_, _, _, mlds_function(_, _, _, _, _)),
+ FollowingDefn = mlds_defn(_, _, _, mlds_function(_, _, _, _, _, _)),
defn_contains_var(FollowingDefn, QualDataName) = yes.
%-----------------------------------------------------------------------------%
@@ -2333,7 +2337,7 @@ defn_contains_matching_defn(Filter, Defn) :-
Defn = mlds_defn(_Name, _Context, _Flags, DefnBody),
(
DefnBody = mlds_function(_PredProcId, _Params, FunctionBody,
- _Attrs, _EnvVarNames),
+ _Attrs, _EnvVarNames, _MaybeRequiretailrecInfo),
FunctionBody = body_defined_here(Statement),
statement_contains_matching_defn(Filter, Statement)
;
diff --git a/compiler/ml_optimize.m b/compiler/ml_optimize.m
index 617c3bc..624f5a2 100644
--- a/compiler/ml_optimize.m
+++ b/compiler/ml_optimize.m
@@ -92,14 +92,14 @@ optimize_in_defn(ModuleName, Globals, Defn0, Defn) :-
Defn0 = mlds_defn(Name, Context, Flags, DefnBody0),
(
DefnBody0 = mlds_function(PredProcId, Params, FuncBody0, Attributes,
- EnvVarNames),
+ EnvVarNames, MaybeRequireTailrecInfo),
OptInfo = opt_info(Globals, ModuleName, Name, Params, Context),
optimize_func(OptInfo, FuncBody0, FuncBody1),
optimize_in_function_body(OptInfo, FuncBody1, FuncBody),
DefnBody = mlds_function(PredProcId, Params, FuncBody, Attributes,
- EnvVarNames),
+ EnvVarNames, MaybeRequireTailrecInfo),
Defn = mlds_defn(Name, Context, Flags, DefnBody)
;
DefnBody0 = mlds_data(_, _, _),
@@ -1208,9 +1208,11 @@ eliminate_var_in_defn(Defn0, Defn, !VarElimInfo) :-
% in the containing scope.
DefnBody = DefnBody0
;
- DefnBody0 = mlds_function(Id, Params, Body0, Attributes, EnvVarNames),
+ DefnBody0 = mlds_function(Id, Params, Body0, Attributes,
+ EnvVarNames, MaybeRequireTailrecInfo),
eliminate_var_in_function_body(Body0, Body, !VarElimInfo),
- DefnBody = mlds_function(Id, Params, Body, Attributes, EnvVarNames)
+ DefnBody = mlds_function(Id, Params, Body, Attributes,
+ EnvVarNames, MaybeRequireTailrecInfo)
),
Defn = mlds_defn(Name, Context, Flags, DefnBody).
diff --git a/compiler/ml_proc_gen.m b/compiler/ml_proc_gen.m
index 82508cc..e5a7ad5 100644
--- a/compiler/ml_proc_gen.m
+++ b/compiler/ml_proc_gen.m
@@ -472,12 +472,14 @@ ml_gen_proc(!ModuleInfo, ConstStructMap, PredId, ProcId,
MLDS_ProcContext = mlds_make_context(ProcContext),
DeclFlags = ml_gen_proc_decl_flags(!.ModuleInfo, PredId, ProcId),
MaybePredProcId = yes(proc(PredId, ProcId)),
+ proc_info_get_maybe_require_tailrec_info(ProcInfo0,
+ MaybeRequireTailrecInfo),
pred_info_get_attributes(PredInfo, Attributes),
attributes_to_attribute_list(Attributes, AttributeList),
MLDS_Attributes =
attributes_to_mlds_attributes(!.ModuleInfo, AttributeList),
EntityBody = mlds_function(MaybePredProcId, MLDS_Params,
- FunctionBody, MLDS_Attributes, EnvVarNames),
+ FunctionBody, MLDS_Attributes, EnvVarNames, MaybeRequireTailrecInfo),
ProcDefn = mlds_defn(EntityName, MLDS_ProcContext, DeclFlags, EntityBody),
!:Defns = ExtraDefns ++ [ProcDefn | !.Defns].
diff --git a/compiler/ml_tailcall.m b/compiler/ml_tailcall.m
index 2345530..26b1ea1 100644
--- a/compiler/ml_tailcall.m
+++ b/compiler/ml_tailcall.m
@@ -54,10 +54,12 @@
:- interface.
:- import_module ml_backend.mlds.
+:- import_module parse_tree.
+:- import_module parse_tree.error_util.
:- import_module libs.
:- import_module libs.globals.
-:- import_module io.
+:- import_module list.
%-----------------------------------------------------------------------------%
@@ -65,8 +67,8 @@
%
% If enabled, warn for calls that "look like" tail calls, but aren't.
%
-:- pred ml_mark_tailcalls(globals::in, mlds::in, mlds::out,
- io::di, io::uo) is det.
+:- pred ml_mark_tailcalls(globals::in, list(error_spec)::out,
+ mlds::in, mlds::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -75,36 +77,36 @@
:- import_module hlds.
:- import_module hlds.hlds_pred.
+:- import_module libs.compiler_util.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module ml_backend.ml_util.
-:- import_module parse_tree.
-:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module bool.
:- import_module int.
-:- import_module list.
:- import_module maybe.
-
+:- import_module require.
:- import_module string.
%-----------------------------------------------------------------------------%
-ml_mark_tailcalls(Globals, !MLDS, !IO) :-
+ml_mark_tailcalls(Globals, Specs, !MLDS) :-
Defns0 = !.MLDS ^ mlds_defns,
ModuleName = mercury_module_name_to_mlds(!.MLDS ^ mlds_name),
- mark_tailcalls_in_defns(ModuleName, Warnings, Defns0, Defns),
- !MLDS ^ mlds_defns := Defns,
globals.lookup_bool_option(Globals, warn_non_tail_recursion,
- WarnTailCalls),
+ WarnTailCallsBool),
(
- WarnTailCalls = yes,
- list.foldl(report_nontailcall_warning(Globals), Warnings, !IO)
+ WarnTailCallsBool = yes,
+ WarnTailCalls = warn_tail_calls
;
- WarnTailCalls = no
- ).
+ WarnTailCallsBool = no,
+ WarnTailCalls = do_not_warn_tail_calls
+ ),
+ mark_tailcalls_in_defns(ModuleName, WarnTailCalls, Specs,
+ Defns0, Defns),
+ !MLDS ^ mlds_defns := Defns.
%-----------------------------------------------------------------------------%
@@ -151,9 +153,15 @@ not_at_tail(not_at_tail_have_not_seen_reccall,
---> tailcall_info(
tci_module_name :: mlds_module_name,
tci_function_name :: mlds_entity_name,
- tci_locals :: locals
+ tci_locals :: locals,
+ tci_warn_tail_calls :: warn_tail_calls,
+ tci_maybe_require_tailrec :: maybe(require_tailrec_info)
).
+:- type warn_tail_calls
+ ---> warn_tail_calls
+ ; do_not_warn_tail_calls.
+
%-----------------------------------------------------------------------------%
% mark_tailcalls_in_defns:
@@ -177,20 +185,22 @@ not_at_tail(not_at_tail_have_not_seen_reccall,
% at the current point.
:- pred mark_tailcalls_in_defns(mlds_module_name::in,
- list(tailcall_warning)::out, list(mlds_defn)::in, list(mlds_defn)::out)
- is det.
+ warn_tail_calls::in, list(error_spec)::out,
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
-mark_tailcalls_in_defns(ModuleName, condense(Warnings), Defns0, Defns) :-
- list.map2(mark_tailcalls_in_defn(ModuleName), Defns0, Defns, Warnings).
+mark_tailcalls_in_defns(ModuleName, WarnTailCalls, condense(Warnings),
+ Defns0, Defns) :-
+ list.map2(mark_tailcalls_in_defn(ModuleName, WarnTailCalls),
+ Defns0, Defns, Warnings).
-:- pred mark_tailcalls_in_defn(mlds_module_name::in,
- mlds_defn::in, mlds_defn::out, list(tailcall_warning)::out) is det.
+:- pred mark_tailcalls_in_defn(mlds_module_name::in, warn_tail_calls::in,
+ mlds_defn::in, mlds_defn::out, list(error_spec)::out) is det.
-mark_tailcalls_in_defn(ModuleName, Defn0, Defn, Warnings) :-
+mark_tailcalls_in_defn(ModuleName, WarnTailCalls, Defn0, Defn, Warnings) :-
Defn0 = mlds_defn(Name, Context, Flags, DefnBody0),
(
DefnBody0 = mlds_function(PredProcId, Params, FuncBody0, Attributes,
- EnvVarNames),
+ EnvVarNames, MaybeRequireTailrecInfo),
% Compute the initial values of the `Locals' and `AtTail' arguments.
Params = mlds_func_params(Args, RetTypes),
Locals = [local_params(Args)],
@@ -201,11 +211,12 @@ mark_tailcalls_in_defn(ModuleName, Defn0, Defn, Warnings) :-
RetTypes = [_ | _],
AtTail = not_at_tail_have_not_seen_reccall
),
- TCallInfo = tailcall_info(ModuleName, Name, Locals),
+ TCallInfo = tailcall_info(ModuleName, Name, Locals,
+ WarnTailCalls, MaybeRequireTailrecInfo),
mark_tailcalls_in_function_body(TCallInfo, AtTail, Warnings,
FuncBody0, FuncBody),
DefnBody = mlds_function(PredProcId, Params, FuncBody, Attributes,
- EnvVarNames),
+ EnvVarNames, MaybeRequireTailrecInfo),
Defn = mlds_defn(Name, Context, Flags, DefnBody)
;
DefnBody0 = mlds_data(_, _, _),
@@ -215,9 +226,9 @@ mark_tailcalls_in_defn(ModuleName, Defn0, Defn, Warnings) :-
DefnBody0 = mlds_class(ClassDefn0),
ClassDefn0 = mlds_class_defn(Kind, Imports, BaseClasses, Implements,
TypeParams, CtorDefns0, MemberDefns0),
- mark_tailcalls_in_defns(ModuleName, CtorWarnings,
+ mark_tailcalls_in_defns(ModuleName, WarnTailCalls, CtorWarnings,
CtorDefns0, CtorDefns),
- mark_tailcalls_in_defns(ModuleName, MemberWarnings,
+ mark_tailcalls_in_defns(ModuleName, WarnTailCalls, MemberWarnings,
MemberDefns0, MemberDefns),
Warnings = CtorWarnings ++ MemberWarnings,
ClassDefn = mlds_class_defn(Kind, Imports, BaseClasses, Implements,
@@ -227,7 +238,7 @@ mark_tailcalls_in_defn(ModuleName, Defn0, Defn, Warnings) :-
).
:- pred mark_tailcalls_in_function_body(tailcall_info::in, at_tail::in,
- list(tailcall_warning)::out,
+ list(error_spec)::out,
mlds_function_body::in, mlds_function_body::out) is det.
mark_tailcalls_in_function_body(TCallInfo, AtTail, Warnings, Body0, Body) :-
@@ -243,7 +254,7 @@ mark_tailcalls_in_function_body(TCallInfo, AtTail, Warnings, Body0, Body) :-
).
:- pred mark_tailcalls_in_maybe_statement(tailcall_info::in,
- list(tailcall_warning)::out, at_tail::in, at_tail::out,
+ list(error_spec)::out, at_tail::in, at_tail::out,
maybe(statement)::in, maybe(statement)::out) is det.
mark_tailcalls_in_maybe_statement(_, [], !AtTail, no, no).
@@ -253,7 +264,7 @@ mark_tailcalls_in_maybe_statement(TCallInfo, Warnings, !AtTail,
!AtTail, Statement0, Statement).
:- pred mark_tailcalls_in_statements(tailcall_info::in,
- list(tailcall_warning)::out, at_tail::in, at_tail::out,
+ list(error_spec)::out, at_tail::in, at_tail::out,
list(statement)::in, list(statement)::out) is det.
mark_tailcalls_in_statements(_, [], !AtTail, [], []).
@@ -265,7 +276,7 @@ mark_tailcalls_in_statements(TCallInfo, FirstWarnings ++ RestWarnings,
First0, First).
:- pred mark_tailcalls_in_statement(tailcall_info::in,
- list(tailcall_warning)::out,
+ list(error_spec)::out,
at_tail::in, at_tail::out, statement::in, statement::out) is det.
mark_tailcalls_in_statement(TCallInfo, Warnings, !AtTail, !Statement) :-
@@ -274,7 +285,7 @@ mark_tailcalls_in_statement(TCallInfo, Warnings, !AtTail, !Statement) :-
!:Statement = statement(Stmt, Context).
:- pred mark_tailcalls_in_stmt(tailcall_info::in, mlds_context::in,
- list(tailcall_warning)::out, at_tail::in, at_tail::out,
+ list(error_spec)::out, at_tail::in, at_tail::out,
mlds_stmt::in, mlds_stmt::out) is det.
mark_tailcalls_in_stmt(TCallInfo, Context, Warnings,
@@ -288,7 +299,8 @@ mark_tailcalls_in_stmt(TCallInfo, Context, Warnings,
% statements in that block. The statement list will be in a tail
% position iff the block is in a tail position.
ModuleName = TCallInfo ^ tci_module_name,
- mark_tailcalls_in_defns(ModuleName, DefnsWarnings, Defns0, Defns),
+ mark_tailcalls_in_defns(ModuleName, TCallInfo ^ tci_warn_tail_calls,
+ DefnsWarnings, Defns0, Defns),
Locals = TCallInfo ^ tci_locals,
NewTCallInfo = TCallInfo ^ tci_locals := [local_defns(Defns) | Locals],
mark_tailcalls_in_statements(NewTCallInfo, StatementsWarnings,
@@ -389,7 +401,7 @@ mark_tailcalls_in_stmt(TCallInfo, Context, Warnings,
---> ml_stmt_call(ground, ground, ground, ground, ground, ground).
:- pred mark_tailcalls_in_stmt_call(tailcall_info::in, mlds_context::in,
- list(tailcall_warning)::out, at_tail::in, at_tail::out,
+ list(error_spec)::out, at_tail::in, at_tail::out,
mlds_stmt::in(ml_stmt_call), mlds_stmt::out) is det.
mark_tailcalls_in_stmt_call(TCallInfo, Context, Warnings,
@@ -439,14 +451,7 @@ mark_tailcalls_in_stmt_call(TCallInfo, Context, Warnings,
% If so, a warning may be useful.
AtTailAfter = at_tail(_)
),
- (
- CodeAddr = code_addr_proc(QualProcLabel, _Sig)
- ;
- CodeAddr = code_addr_internal(QualProcLabel, _SeqNum, _Sig)
- ),
- QualProcLabel = qual(_, _, ProcLabel),
- ProcLabel = mlds_proc_label(PredLabel, ProcId),
- Warnings = [tailcall_warning(PredLabel, ProcId, Context)]
+ maybe_warn_tailcalls(TCallInfo, CodeAddr, Context, Warnings)
),
Stmt = Stmt0,
AtTailBefore = not_at_tail_seen_reccall
@@ -458,7 +463,7 @@ mark_tailcalls_in_stmt_call(TCallInfo, Context, Warnings,
not_at_tail(AtTailAfter, AtTailBefore)
).
-:- pred mark_tailcalls_in_cases(tailcall_info::in, list(tailcall_warning)::out,
+:- pred mark_tailcalls_in_cases(tailcall_info::in, list(error_spec)::out,
at_tail::in, list(at_tail)::out,
list(mlds_switch_case)::in, list(mlds_switch_case)::out) is det.
@@ -471,7 +476,7 @@ mark_tailcalls_in_cases(TCallInfo, CaseWarnings ++ CasesWarnings,
mark_tailcalls_in_cases(TCallInfo, CasesWarnings,
AtTailAfter, AtTailBefores, Cases0, Cases).
-:- pred mark_tailcalls_in_case(tailcall_info::in, list(tailcall_warning)::out,
+:- pred mark_tailcalls_in_case(tailcall_info::in, list(error_spec)::out,
at_tail::in, at_tail::out, mlds_switch_case::in, mlds_switch_case::out)
is det.
@@ -483,7 +488,7 @@ mark_tailcalls_in_case(TCallInfo, Warnings, AtTailAfter, AtTailBefore,
Case = mlds_switch_case(FirstCond, LaterConds, Statement).
:- pred mark_tailcalls_in_default(tailcall_info::in,
- list(tailcall_warning)::out, at_tail::in, at_tail::out,
+ list(error_spec)::out, at_tail::in, at_tail::out,
mlds_switch_default::in, mlds_switch_default::out) is det.
mark_tailcalls_in_default(TCallInfo, Warnings, AtTailAfter, AtTailBefore,
@@ -504,6 +509,112 @@ mark_tailcalls_in_default(TCallInfo, Warnings, AtTailAfter, AtTailBefore,
%-----------------------------------------------------------------------------%
+:- pred maybe_warn_tailcalls(tailcall_info::in, mlds_code_addr::in,
+ mlds_context::in, list(error_spec)::out) is det.
+
+maybe_warn_tailcalls(TCallInfo, CodeAddr, Context, Specs) :-
+ WarnTailCalls = TCallInfo ^ tci_warn_tail_calls,
+ MaybeRequireTailrecInfo = TCallInfo ^ tci_maybe_require_tailrec,
+ ( if
+ % Trivially reject the common case
+ WarnTailCalls = do_not_warn_tail_calls,
+ MaybeRequireTailrecInfo = no
+ then
+ Specs = []
+ else if
+ require_complete_switch [WarnTailCalls]
+ (
+ WarnTailCalls = do_not_warn_tail_calls,
+
+ % We always warn/error if the pragma says so.
+ MaybeRequireTailrecInfo = yes(RequireTailrecInfo),
+ RequireTailrecInfo = enable_tailrec_warnings(WarnOrError,
+ TailrecType)
+ ;
+ WarnTailCalls = warn_tail_calls,
+
+ % if warnings are enabled then we check the pragma. We check
+ % that it doesn't disable warnings and also determine whether
+ % this should be a warning or error.
+ require_complete_switch [MaybeRequireTailrecInfo]
+ (
+ MaybeRequireTailrecInfo = no,
+ % Choose some defaults.
+ WarnOrError = we_warning,
+ TailrecType = require_any_tail_recursion
+ ;
+ MaybeRequireTailrecInfo = yes(RequireTailrecInfo),
+ require_complete_switch [RequireTailrecInfo]
+ (
+ RequireTailrecInfo =
+ enable_tailrec_warnings(WarnOrError, TailrecType)
+ ;
+ RequireTailrecInfo = suppress_tailrec_warnings,
+ false
+ )
+ )
+ ),
+ require_complete_switch [TailrecType]
+ (
+ TailrecType = require_any_tail_recursion
+ ;
+ TailrecType = require_direct_tail_recursion
+ % XXX: Currently this has no effect since all tailcalls on MLDS
+ % are direct tail calls.
+ )
+ then
+ (
+ CodeAddr = code_addr_proc(QualProcLabel, _Sig)
+ ;
+ CodeAddr = code_addr_internal(QualProcLabel,
+ _SeqNum, _Sig)
+ ),
+ QualProcLabel = qual(_, _, ProcLabel),
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
+ ( if PredLabel = mlds_special_pred_label(_, _, _, _) then
+ % Don't warn about special preds.
+ Specs = []
+ else
+ report_nontailcall(WarnOrError, PredLabel, ProcId, Context, Specs)
+ )
+ else
+ Specs = []
+ ).
+
+:- pred report_nontailcall(warning_or_error::in, mlds_pred_label::in,
+ proc_id::in, mlds_context::in, list(error_spec)::out) is det.
+
+report_nontailcall(WarnOrError, PredLabel, ProcId, Context, Specs) :-
+ (
+ PredLabel = mlds_user_pred_label(PredOrFunc, _MaybeModule, Name, Arity,
+ _CodeModel, _NonOutputFunc),
+ SimpleCallId = simple_call_id(PredOrFunc, unqualified(Name), Arity),
+ proc_id_to_int(ProcId, ProcNumber0),
+ ProcNumber = ProcNumber0 + 1,
+ (
+ WarnOrError = we_warning,
+ WarnOrErrorWords = words("warning:")
+ ;
+ WarnOrError = we_error,
+ WarnOrErrorWords = words("error:")
+ ),
+ Pieces =
+ [words("In mode number"), int_fixed(ProcNumber),
+ words("of"), simple_call(SimpleCallId), suffix(":"), nl,
+ WarnOrErrorWords,
+ words("recursive call is not tail recursive."), nl],
+ Msg = simple_msg(mlds_get_prog_context(Context), [always(Pieces)]),
+ warning_or_error_severity(WarnOrError, Severity),
+ Specs = [error_spec(Severity, phase_code_gen, [Msg])]
+ ;
+ PredLabel = mlds_special_pred_label(_, _, _, _),
+ % This case is tested for when deciding weather to create an error
+ % or warning.
+ unexpected($file, $pred, "mlds_special_pred_label")
+ ).
+
+%-----------------------------------------------------------------------------%
+
% match_return_vals(Rvals, Lvals):
% match_return_val(Rval, Lval):
% Check that the Lval(s) returned by a call match
@@ -749,36 +860,6 @@ locals_member(Name, LocalsList) :-
%-----------------------------------------------------------------------------%
-:- type tailcall_warning
- ---> tailcall_warning(
- mlds_pred_label,
- proc_id,
- mlds_context
- ).
-
-:- pred report_nontailcall_warning(globals::in, tailcall_warning::in,
- io::di, io::uo) is det.
-
-report_nontailcall_warning(Globals, Warning, !IO) :-
- Warning = tailcall_warning(PredLabel, ProcId, Context),
- (
- PredLabel = mlds_user_pred_label(PredOrFunc, _MaybeModule, Name, Arity,
- _CodeModel, _NonOutputFunc),
- SimpleCallId = simple_call_id(PredOrFunc, unqualified(Name), Arity),
- proc_id_to_int(ProcId, ProcNumber0),
- ProcNumber = ProcNumber0 + 1,
- Pieces =
- [words("In mode number"), int_fixed(ProcNumber),
- words("of"), simple_call(SimpleCallId), suffix(":"), nl,
- words("warning: recursive call is not tail recursive."), nl],
- Msg = simple_msg(mlds_get_prog_context(Context), [always(Pieces)]),
- Spec = error_spec(severity_warning, phase_code_gen, [Msg]),
- write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors, !IO)
- ;
- PredLabel = mlds_special_pred_label(_, _, _, _)
- % Don't warn about these.
- ).
-
%-----------------------------------------------------------------------------%
:- end_module ml_backend.ml_tailcall.
%-----------------------------------------------------------------------------%
diff --git a/compiler/ml_type_gen.m b/compiler/ml_type_gen.m
index c1854ea..f7a89e2 100644
--- a/compiler/ml_type_gen.m
+++ b/compiler/ml_type_gen.m
@@ -931,7 +931,7 @@ ml_gen_constructor_function(Target, BaseClassId, ClassType, ClassQualifier,
Attributes = [],
EnvVarNames = set.init,
Ctor = mlds_function(no, mlds_func_params(Args, ReturnValues),
- body_defined_here(Stmt), Attributes, EnvVarNames),
+ body_defined_here(Stmt), Attributes, EnvVarNames, no),
CtorFlags = init_decl_flags(acc_public, per_instance, non_virtual,
overridable, modifiable, concrete),
@@ -964,7 +964,7 @@ gen_init_field(Target, BaseClassId, ClassType, ClassQualifier, Member) =
Defn = mlds_data(Type0, _Init, _GCStatement),
Type = Type0
;
- ( Defn = mlds_function(_, _, _, _, _)
+ ( Defn = mlds_function(_, _, _, _, _, _)
; Defn = mlds_class(_)
),
unexpected($module, $pred, "non-data member")
diff --git a/compiler/ml_util.m b/compiler/ml_util.m
index 847e637..b6ce9fe 100644
--- a/compiler/ml_util.m
+++ b/compiler/ml_util.m
@@ -676,7 +676,7 @@ has_foreign_languages(Statement, Langs) :-
defn_contains_foreign_code(NativeTargetLang, Defn) :-
Defn = mlds_defn(_Name, _Context, _Flags, Body),
- Body = mlds_function(_, _, body_defined_here(FunctionBody), _, _),
+ Body = mlds_function(_, _, body_defined_here(FunctionBody), _, _, _),
statement_contains_statement(FunctionBody, Statement),
Statement = statement(Stmt, _),
(
@@ -688,7 +688,7 @@ defn_contains_foreign_code(NativeTargetLang, Defn) :-
defn_contains_outline_foreign_proc(ForeignLang, Defn) :-
Defn = mlds_defn(_Name, _Context, _Flags, Body),
- Body = mlds_function(_, _, body_defined_here(FunctionBody), _, _),
+ Body = mlds_function(_, _, body_defined_here(FunctionBody), _, _, _),
statement_contains_statement(FunctionBody, Statement),
Statement = statement(Stmt, _),
Stmt = ml_stmt_atomic(outline_foreign_proc(ForeignLang, _, _, _)).
@@ -751,7 +751,7 @@ defn_body_contains_var(DefnBody, DataName) = ContainsVar :-
ContainsVar = initializer_contains_var(Initializer, DataName)
;
DefnBody = mlds_function(_PredProcId, _Params, FunctionBody,
- _Attrs, _EnvVarNames),
+ _Attrs, _EnvVarNames, _MaybeRequireTailrecInfo),
ContainsVar = function_body_contains_var(FunctionBody, DataName)
;
DefnBody = mlds_class(ClassDefn),
diff --git a/compiler/mlds.m b/compiler/mlds.m
index 7c2ec71..e244519 100644
--- a/compiler/mlds.m
+++ b/compiler/mlds.m
@@ -582,13 +582,16 @@
; mlds_function(
% Represents functions.
- maybe(pred_proc_id), % Identifies the original
- % Mercury procedure, if any.
- mlds_func_params, % The arguments & return types.
- mlds_function_body, % The function body.
- list(mlds_attribute), % Attributes.
- set(string) % The set of environment variables
- % referred to by the function body.
+ maybe(pred_proc_id), % Identifies the original
+ % Mercury procedure, if any.
+ mlds_func_params, % The arguments & return types.
+ mlds_function_body, % The function body.
+ list(mlds_attribute), % Attributes.
+ set(string), % The set of environment
+ % variables referred to by the
+ % function body.
+ maybe(require_tailrec_info) % Information used to generate
+ % tail recursion errors.
)
; mlds_class(
% Represents packages, classes, interfaces, structs, enums.
diff --git a/compiler/mlds_to_c.m b/compiler/mlds_to_c.m
index 7d666e3..8d38094 100644
--- a/compiler/mlds_to_c.m
+++ b/compiler/mlds_to_c.m
@@ -463,7 +463,7 @@ mlds_get_env_var_names(Defns) = EnvVarNameSet :-
is semidet.
mlds_get_env_var_names_from_defn(Defn, EnvVarNameSet) :-
- Defn = mlds_defn(_, _, _, mlds_function(_, _, _, _, EnvVarNameSet)).
+ Defn = mlds_defn(_, _, _, mlds_function(_, _, _, _, EnvVarNameSet, _)).
:- pred mlds_output_env_var_decl(string::in, io::di, io::uo) is det.
@@ -1519,7 +1519,7 @@ mlds_output_decl(Opts, Indent, ModuleName, Defn, !IO) :-
HighLevelData = Opts ^ m2co_highlevel_data,
( if
HighLevelData = yes,
- DefnBody = mlds_function(_, Params, _, _, _)
+ DefnBody = mlds_function(_, Params, _, _, _, _)
then
Params = mlds_func_params(Arguments, _RetTypes),
ParamTypes = mlds_get_arg_types(Arguments),
@@ -1866,7 +1866,7 @@ mlds_output_type_forward_decl(Opts, Indent, Type, !IO) :-
mlds_output_defn(Opts, Indent, Separate, ModuleName, Defn, !IO) :-
Defn = mlds_defn(Name, Context, Flags, DefnBody),
(
- ( DefnBody = mlds_function(_, _, _, _, _)
+ ( DefnBody = mlds_function(_, _, _, _, _, _)
; DefnBody = mlds_class(_)
),
io.nl(!IO)
@@ -1896,7 +1896,7 @@ mlds_output_decl_body(Opts, Indent, Name, Context, DefnBody, !IO) :-
get_initializer_array_size(Initializer), !IO)
;
DefnBody = mlds_function(MaybePredProcId, Signature,
- _MaybeBody, _Attrs, _EnvVarNames),
+ _MaybeBody, _Attrs, _EnvVarNames, _MaybeRequireTailrecInfo),
mlds_output_maybe(MaybePredProcId, mlds_output_pred_proc_id(Opts),
!IO),
mlds_output_func_decl(Opts, Indent, Name, Context, Signature, !IO)
@@ -1917,7 +1917,7 @@ mlds_output_defn_body(Opts, Indent, Name, Context, DefnBody, !IO) :-
mlds_output_gc_statement(Opts, Indent, Name, GCStatement, "", !IO)
;
DefnBody = mlds_function(MaybePredProcId, Signature,
- MaybeBody, _Attributes, _EnvVarNames),
+ MaybeBody, _Attributes, _EnvVarNames, _MaybeRequireTailrecInfo),
mlds_output_maybe(MaybePredProcId, mlds_output_pred_proc_id(Opts),
!IO),
mlds_output_func(Opts, Indent, Name, Context, Signature, MaybeBody,
@@ -2133,7 +2133,7 @@ mlds_output_enum_constant(Opts, Indent, EnumModuleName, Defn, !IO) :-
qual(EnumModuleName, type_qual, Name), !IO),
mlds_output_initializer(Opts, Type, Initializer, !IO)
;
- ( DefnBody = mlds_function(_, _, _, _, _)
+ ( DefnBody = mlds_function(_, _, _, _, _, _)
; DefnBody = mlds_class(_)
),
unexpected($module, $pred, "constant is not data")
@@ -3138,7 +3138,7 @@ mlds_output_extern_or_static(Access, PerInstance, DeclOrDefn, Name, DefnBody,
Name \= entity_type(_, _),
% Don't output "static" for functions that don't have a body.
% This can happen for Mercury procedures declared `:- external'
- DefnBody \= mlds_function(_, _, body_external, _, _)
+ DefnBody \= mlds_function(_, _, body_external, _, _, _)
then
io.write_string("static ", !IO)
else if
diff --git a/compiler/mlds_to_cs.m b/compiler/mlds_to_cs.m
index b0b37ee..2d12261 100644
--- a/compiler/mlds_to_cs.m
+++ b/compiler/mlds_to_cs.m
@@ -469,21 +469,25 @@ find_pointer_addressed_methods_in_scalars(Cord, !CodeAddrs) :-
:- pred method_ptrs_in_entity_defn(mlds_entity_defn::in,
code_addr_map::in, code_addr_map::out) is det.
-method_ptrs_in_entity_defn(mlds_function(_MaybeID, _Params, Body,
- _Attributes, _EnvVars), !CodeAddrs) :-
+method_ptrs_in_entity_defn(Defn, !CodeAddrs) :-
(
- Body = body_defined_here(Statement),
- method_ptrs_in_statement(Statement, !CodeAddrs)
+ Defn = mlds_function(_MaybeID, _Params, Body, _Attributes, _EnvVars,
+ _MaybeRequireTailrecInfo),
+ (
+ Body = body_defined_here(Statement),
+ method_ptrs_in_statement(Statement, !CodeAddrs)
+ ;
+ Body = body_external
+ )
;
- Body = body_external
+ Defn = mlds_data(_Type, Initializer, _GCStatement),
+ method_ptrs_in_initializer(Initializer, !CodeAddrs)
+ ;
+ Defn = mlds_class(ClassDefn),
+ ClassDefn = mlds_class_defn(_, _, _, _, _, Ctors, Members),
+ method_ptrs_in_defns(Ctors, !CodeAddrs),
+ method_ptrs_in_defns(Members, !CodeAddrs)
).
-method_ptrs_in_entity_defn(mlds_data(_Type, Initializer, _GCStatement),
- !CodeAddrs) :-
- method_ptrs_in_initializer(Initializer, !CodeAddrs).
-method_ptrs_in_entity_defn(mlds_class(ClassDefn), !CodeAddrs) :-
- ClassDefn = mlds_class_defn(_, _, _, _, _, Ctors, Members),
- method_ptrs_in_defns(Ctors, !CodeAddrs),
- method_ptrs_in_defns(Members, !CodeAddrs).
:- pred method_ptrs_in_statements(list(statement)::in,
code_addr_map::in, code_addr_map::out) is det.
@@ -738,7 +742,7 @@ collect_env_var_names(Defn, !EnvVarNames) :-
(
EntityDefn = mlds_data(_, _, _)
;
- EntityDefn = mlds_function(_, _, _, _, EnvVarNames),
+ EntityDefn = mlds_function(_, _, _, _, EnvVarNames, _),
set.union(EnvVarNames, !EnvVarNames)
;
EntityDefn = mlds_class(_)
@@ -929,7 +933,7 @@ output_defns(Info, Indent, OutputAux, Defns, !IO) :-
output_defn(Info, Indent, OutputAux, Defn, !IO) :-
Defn = mlds_defn(Name, Context, Flags, DefnBody),
indent_line(Indent, !IO),
- ( DefnBody = mlds_function(_, _, body_external, _, _) ->
+ ( DefnBody = mlds_function(_, _, body_external, _, _, _) ->
% This is just a function declaration, with no body.
% C# doesn't support separate declarations and definitions,
% so just output the declaration as a comment.
@@ -982,7 +986,7 @@ output_defn_body(Info, Indent, UnqualName, OutputAux, Context, Entity, !IO) :-
!IO)
;
Entity = mlds_function(MaybePredProcId, Signature, MaybeBody,
- _Attributes, _EnvVarNames),
+ _Attributes, _EnvVarNames, _MaybeRequireTailrecInfo),
output_maybe(MaybePredProcId, output_pred_proc_id(Info), !IO),
output_func(Info, Indent, UnqualName, OutputAux, Context,
Signature, MaybeBody, !IO)
@@ -1737,7 +1741,7 @@ output_rtti_defn_assignments(Info, Indent, Defn, !IO) :-
DefnBody = mlds_data(_Type, Initializer, _),
output_rtti_defn_assignments_2(Info, Indent, Name, Initializer, !IO)
;
- ( DefnBody = mlds_function(_, _, _, _, _)
+ ( DefnBody = mlds_function(_, _, _, _, _, _)
; DefnBody = mlds_class(_)
),
unexpected($module, $pred, "expected mlds_data")
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index 5444109..5382154 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -778,21 +778,25 @@ find_pointer_addressed_methods_in_scalars(Cord, !CodeAddrs) :-
:- pred method_ptrs_in_entity_defn(mlds_entity_defn::in,
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
-method_ptrs_in_entity_defn(mlds_function(_MaybeID, _Params, Body,
- _Attributes, _EnvVars), !CodeAddrs) :-
+method_ptrs_in_entity_defn(Defn, !CodeAddrs) :-
(
- Body = body_defined_here(Statement),
- method_ptrs_in_statement(Statement, !CodeAddrs)
+ Defn = mlds_function(_MaybeID, _Params, Body, _Attributes, _EnvVars,
+ _MaybeRequireTailrecInfo),
+ (
+ Body = body_defined_here(Statement),
+ method_ptrs_in_statement(Statement, !CodeAddrs)
+ ;
+ Body = body_external
+ )
;
- Body = body_external
+ Defn = mlds_data(_Type, Initializer, _GCStatement),
+ method_ptrs_in_initializer(Initializer, !CodeAddrs)
+ ;
+ Defn = mlds_class(ClassDefn),
+ ClassDefn = mlds_class_defn(_, _, _, _, _, Ctors, Members),
+ method_ptrs_in_defns(Ctors, !CodeAddrs),
+ method_ptrs_in_defns(Members, !CodeAddrs)
).
-method_ptrs_in_entity_defn(mlds_data(_Type, Initializer, _GCStatement),
- !CodeAddrs) :-
- method_ptrs_in_initializer(Initializer, !CodeAddrs).
-method_ptrs_in_entity_defn(mlds_class(ClassDefn), !CodeAddrs) :-
- ClassDefn = mlds_class_defn(_, _, _, _, _, Ctors, Members),
- method_ptrs_in_defns(Ctors, !CodeAddrs),
- method_ptrs_in_defns(Members, !CodeAddrs).
:- pred method_ptrs_in_statements(list(statement)::in,
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
@@ -1085,7 +1089,7 @@ generate_addr_wrapper_class(MLDS_ModuleName, Arity - CodeAddrs, ClassDefn,
Attributes = [],
EnvVarNames = set.init,
Ctor = mlds_function(no, mlds_func_params(CtorArgs, CtorReturnValues),
- body_defined_here(CtorStatement), Attributes, EnvVarNames),
+ body_defined_here(CtorStatement), Attributes, EnvVarNames, no),
CtorFlags = init_decl_flags(acc_public, per_instance, non_virtual,
overridable, modifiable, concrete),
CtorDefn = mlds_defn(entity_export("<constructor>"), Context,
@@ -1202,7 +1206,7 @@ generate_call_method(MLDS_ModuleName, Arity, CodeAddrs, MethodDefn) :-
MethodAttribs = [],
MethodEnvVarNames = set.init,
MethodBody = mlds_function(MethodMaybeID, MethodParams,
- body_defined_here(Statement), MethodAttribs, MethodEnvVarNames),
+ body_defined_here(Statement), MethodAttribs, MethodEnvVarNames, no),
MethodFlags = ml_gen_member_decl_flags,
MethodDefn = mlds_defn(MethodName, Context, MethodFlags, MethodBody).
@@ -1459,7 +1463,7 @@ rename_class_names_defn(Renaming, !Defn) :-
EntityDefn = mlds_data(Type, Initializer, GCStatement)
;
EntityDefn0 = mlds_function(MaybePPId, FuncParams0, FuncBody0,
- Attributes, EnvVarNames),
+ Attributes, EnvVarNames, MaybeRequireTailrecInfo),
rename_class_names_func_params(Renaming, FuncParams0, FuncParams),
(
FuncBody0 = body_defined_here(Statement0),
@@ -1470,7 +1474,7 @@ rename_class_names_defn(Renaming, !Defn) :-
FuncBody = body_external
),
EntityDefn = mlds_function(MaybePPId, FuncParams, FuncBody,
- Attributes, EnvVarNames)
+ Attributes, EnvVarNames, MaybeRequireTailrecInfo)
;
EntityDefn0 = mlds_class(mlds_class_defn(ClassKind, Imports, Inherits,
Implements, TypeParams, Ctors0, Members0)),
@@ -2000,7 +2004,7 @@ collect_env_var_names(Defn, !EnvVarNames) :-
(
EntityDefn = mlds_data(_, _, _)
;
- EntityDefn = mlds_function(_, _, _, _, EnvVarNames),
+ EntityDefn = mlds_function(_, _, _, _, EnvVarNames, _),
set.union(EnvVarNames, !EnvVarNames)
;
EntityDefn = mlds_class(_)
@@ -2177,7 +2181,7 @@ output_defns(Info, Indent, OutputAux, Defns, !IO) :-
output_defn(Info, Indent, OutputAux, Defn, !IO) :-
Defn = mlds_defn(Name, Context, Flags, DefnBody),
indent_line(Info, marker_comment, Context, Indent, !IO),
- ( if DefnBody = mlds_function(_, _, body_external, _, _) then
+ ( if DefnBody = mlds_function(_, _, body_external, _, _, _) then
% This is just a function declaration, with no body.
% Java doesn't support separate declarations and definitions,
% so just output the declaration as a comment.
@@ -2205,7 +2209,7 @@ output_defn_body(Info, Indent, UnqualName, OutputAux, Context, Entity, !IO) :-
!IO)
;
Entity = mlds_function(MaybePredProcId, Signature, MaybeBody,
- _Attributes, _EnvVarNames),
+ _Attributes, _EnvVarNames, _MaybeRequireTailrecInfo),
output_maybe(MaybePredProcId, output_pred_proc_id(Info), !IO),
output_func(Info, Indent, UnqualName, OutputAux, Context,
Signature, MaybeBody, !IO)
@@ -3011,7 +3015,7 @@ output_rtti_defn_assignments(Info, Indent, Defn, !IO) :-
DefnBody = mlds_data(_Type, Initializer, _),
output_rtti_defn_assignments_2(Info, Indent, Name, Initializer, !IO)
;
- ( DefnBody = mlds_function(_, _, _, _, _)
+ ( DefnBody = mlds_function(_, _, _, _, _, _)
; DefnBody = mlds_class(_)
),
unexpected($module, $pred, "expected mlds_data")
--
2.6.2
More information about the reviews
mailing list