[m-rev.] for review: Enable non-tail-call warnings for mutually-recursive code
Paul Bone
paul at bone.id.au
Tue Mar 21 16:31:36 AEDT 2017
For review by anyone
---
Enable non-tail-call warnings for mutually-recursive code
This change enables warnings for mutual recursion for the low level C
backend.
--warn-non-tail-recursion currently only works for direct recursion. This
change renames it to --warn-non-tail-recursion-self and adds
--warn-non-tail-recursion which is intended to produce warnings for self
and mutual recursion.
compiler/options.m:
Add new option.
compiler/handle_options.m:
Make --warn-non-tail-recursion imply --warn-non-tail-recursion-self.
compiler/ml_tailcall.m:
Conform to changes in options.m.
compiler/mark_tail_calls.m:
Simplify the code that interprets tail recursion warning options, this
avoids the need for the warn_non_tail_rec_calls_opt which was only used
here in an unnecessary step. This logic has also been moved to a
separate predicate.
Add a warning for mutually recursive calls that are not tail recursive.
Update these warning/error messages to say if the call is self or
mutually recursive. Also in the case of mutually recursive calls, name
the callee.
compiler/mercury_compile_llds_back_end.m:
Compute the dependency information before running the pre-LLDS passes.
This makes sure that we do this once for the whole module, and
independently of --trad-passes.
compiler/dependency_graph.m:
Add a method for getting the SCC of a given node from a dependency_info
structure. The SCC is retrieved from a lazily built map.
doc/user_guide.texi:
Document the changes.
tests/invalid/Mmakefile:
tests/invalid/require_tailrec_1.err_exp:
tests/invalid/require_tailrec_1.m:
tests/invalid/require_tailrec_2.err_exp:
tests/invalid/require_tailrec_2.m:
tests/invalid/require_tailrec_3.err_exp:
tests/invalid/require_tailrec_3.m:
tests/valid/Mmakefile:
tests/valid/require_tailrec_1.m:
tests/valid/require_tailrec_2.m:
tests/valid/require_tailrec_3.m:
Test the tail recursion warnings a lot more extensively, some of these
are new test programs, others just have many more test cases within
them.
tests/invalid/Mercury.options:
tests/valid/Mercury.options:
Add new test files.
Disable most optimisations as these could optimise away the mutual tail
recursions.
tests/EXPECT_FAIL_TESTS.hlc.gc:
New test case failures.
---
compiler/dependency_graph.m | 32 +++-
compiler/handle_options.m | 18 ++-
compiler/mark_tail_calls.m | 248 +++++++++++++++++++------------
compiler/mercury_compile_llds_back_end.m | 4 +
compiler/ml_tailcall.m | 3 +-
compiler/options.m | 10 ++
doc/user_guide.texi | 6 +
tests/EXPECT_FAIL_TESTS.hlc.gc | 3 +
tests/invalid/Mercury.options | 5 +-
tests/invalid/Mmakefile | 3 +-
tests/invalid/require_tailrec_1.err_exp | 35 +++--
tests/invalid/require_tailrec_1.m | 48 ++++++
tests/invalid/require_tailrec_2.err_exp | 39 +++--
tests/invalid/require_tailrec_2.m | 49 +++++-
tests/invalid/require_tailrec_3.err_exp | 9 ++
tests/invalid/require_tailrec_3.m | 66 ++++++++
tests/valid/Mercury.options | 5 +-
tests/valid/Mmakefile | 1 +
tests/valid/require_tailrec_1.m | 85 ++++++++++-
tests/valid/require_tailrec_2.m | 168 +++++++++++++++++++++
tests/valid/require_tailrec_3.m | 105 +++++++++++++
21 files changed, 799 insertions(+), 143 deletions(-)
create mode 100644 tests/EXPECT_FAIL_TESTS.hlc.gc
create mode 100644 tests/invalid/require_tailrec_3.err_exp
create mode 100644 tests/invalid/require_tailrec_3.m
create mode 100644 tests/valid/require_tailrec_3.m
diff --git a/compiler/dependency_graph.m b/compiler/dependency_graph.m
index 5cf80b3..f822b69 100644
--- a/compiler/dependency_graph.m
+++ b/compiler/dependency_graph.m
@@ -69,24 +69,45 @@
:- func dependency_info_get_condensed_bottom_up_sccs(dependency_info(T))
= list(T).
+ % Get the SCC containing this node.
+ %
+:- func dependency_info_get_this_scc(dependency_info(T), T) = set(T).
+
%-----------------------------------------------------------------------%
%-----------------------------------------------------------------------%
:- implementation.
+:- import_module lazy.
+:- import_module map.
+
%-----------------------------------------------------------------------%
:- type dependency_info(T)
---> dependency_info(
dep_graph :: dependency_graph(T),
- dep_bottom_up_sccs :: bottom_up_dependency_sccs(T)
+ dep_bottom_up_sccs :: bottom_up_dependency_sccs(T),
+ % This is seldom used so it is lazy.
+ dep_scc_map :: lazy(map(T, set(T)))
).
-make_dependency_info(Graph) = dependency_info(Graph, BottomUpOrdering) :-
+make_dependency_info(Graph) =
+ dependency_info(Graph, BottomUpOrdering, LazySCCMap) :-
% digraph.atsort puts the cliques of parents before the cliques
% of their children. This is a top down order.
digraph.atsort(Graph, TopDownOrdering),
- list.reverse(TopDownOrdering, BottomUpOrdering).
+ list.reverse(TopDownOrdering, BottomUpOrdering),
+ LazySCCMap = delay(((func) = SCCMap :-
+ foldl(make_scc_map, BottomUpOrdering, init, SCCMap)
+ )).
+
+:- pred make_scc_map(set(T)::in, map(T, set(T))::in, map(T, set(T))::out)
+ is det.
+
+make_scc_map(SCC, !Map) :-
+ fold((pred(Node::in, Map0::in, Map::out) is det :-
+ map.det_insert(Node, SCC, Map0, Map)
+ ), SCC, !Map).
%-----------------------------------------------------------------------%
@@ -99,4 +120,9 @@ dependency_info_get_condensed_bottom_up_sccs(DepInfo) = CondensedOrder :-
list.condense(ListOfLists, CondensedOrder).
%-----------------------------------------------------------------------%
+
+dependency_info_get_this_scc(DepInfo, Node) =
+ map.lookup(force(DepInfo ^ dep_scc_map), Node).
+
+%-----------------------------------------------------------------------%
%-----------------------------------------------------------------------%
diff --git a/compiler/handle_options.m b/compiler/handle_options.m
index 7aa0451..e3ce940 100644
--- a/compiler/handle_options.m
+++ b/compiler/handle_options.m
@@ -1,7 +1,8 @@
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
-% Copyright (C) 1994-2014 The University of Melbourne.
+% Copyright (C) 1994-2012 The University of Melbourne.
+% Copyright (C) 2013-2014, 2017 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.
%---------------------------------------------------------------------------%
@@ -2184,12 +2185,13 @@ convert_options_to_globals(OptionTable0, OpMode, Target,
% --warn-non-tail-recursion requires tail call optimization to be enabled.
% It also doesn't work if you use --errorcheck-only.
- globals.lookup_bool_option(!.Globals, warn_non_tail_recursion,
- WarnNonTailRec),
- (
- WarnNonTailRec = no
- ;
- WarnNonTailRec = yes,
+ option_implies(warn_non_tail_recursion, warn_non_tail_recursion_self,
+ bool(yes), !Globals),
+ globals.lookup_bool_option(!.Globals, warn_non_tail_recursion_self,
+ WarnNonTailRecSelf),
+ ( if
+ WarnNonTailRecSelf = yes
+ then
globals.lookup_bool_option(!.Globals, pessimize_tailcalls,
PessimizeTailCalls),
globals.lookup_bool_option(!.Globals, optimize_tailcalls,
@@ -2217,6 +2219,8 @@ convert_options_to_globals(OptionTable0, OpMode, Target,
else
true
)
+ else
+ true
),
% The backend foreign languages depend on the target.
diff --git a/compiler/mark_tail_calls.m b/compiler/mark_tail_calls.m
index 40ba7cc..ff03cc5 100644
--- a/compiler/mark_tail_calls.m
+++ b/compiler/mark_tail_calls.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2008, 2010-2012 The University of Melbourne.
+% Copyright (C) 2017 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.
%-----------------------------------------------------------------------------%
@@ -87,6 +88,17 @@
warning_or_error::in, prog_context::in,
list(error_spec)::in, list(error_spec)::out) is det.
+ % add_message_for_nontail_mutual_recursive_call(SimpleCallId, ProcId,
+ % WarnOrError, Context, !Specs):
+ %
+ % Add an error_spec to !Specs reporting that the mutually recursive call
+ % inside the procedure described by SimpleCallId and ProcId at Context
+ % is not *tail* recursive. Set its severity based on WarnOrError.
+ %
+:- pred add_message_for_nontail_mutual_recursive_call(simple_call_id::in,
+ proc_id::in, simple_call_id::in, warning_or_error::in, prog_context::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
% add_message_for_no_tail_or_nontail_recursive_calls(SimpleCallId, Context,
% !Specs):
%
@@ -109,6 +121,7 @@
:- import_module hlds.hlds_goal.
:- import_module hlds.vartypes.
:- import_module libs.
+:- import_module libs.dependency_graph.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.
@@ -119,6 +132,7 @@
:- import_module int.
:- import_module maybe.
:- import_module require.
+:- import_module set.
%-----------------------------------------------------------------------------%
@@ -126,10 +140,6 @@
---> add_goal_feature
; do_not_add_goal_feature.
-:- type warn_non_tail_rec_calls_opt
- ---> do_not_warn_non_tail_rec_calls_opt
- ; warn_non_tail_rec_calls_opt.
-
:- type maybe_warn_non_tail_rec_call
---> do_not_warn_non_tail_rec_calls
; warn_non_tail_rec_calls(
@@ -144,6 +154,7 @@
mtc_pred_info :: pred_info,
mtc_pred_id :: pred_id,
mtc_proc_id :: proc_id,
+ mtc_scc :: set(pred_proc_id),
mtc_vartypes :: vartypes,
mtc_warn_non_tail_rec_calls :: maybe_warn_non_tail_rec_call
).
@@ -214,48 +225,59 @@ mark_tail_calls_in_proc(ModuleInfo, PredId, ProcId, PredInfo, !ProcInfo,
ExecTraceTailRec = no,
AddGoalFeature = do_not_add_goal_feature
),
+ globals.lookup_bool_option(Globals, warn_non_tail_recursion_self,
+ WarnNonTailRecSelfBool),
globals.lookup_bool_option(Globals, warn_non_tail_recursion,
- WarnNonTailRecBool),
- (
- WarnNonTailRecBool = yes,
- WarnNonTailRecOpt = warn_non_tail_rec_calls_opt
- ;
- WarnNonTailRecBool = no,
- WarnNonTailRecOpt = do_not_warn_non_tail_rec_calls_opt
- ),
+ WarnNonTailRecSelfAndMutBool),
proc_info_get_maybe_require_tailrec_info(!.ProcInfo,
MaybeRequireTailRec),
+ WarnNonTailRec = maybe_warn_non_tail_rec_call(MaybeRequireTailRec,
+ WarnNonTailRecSelfBool, WarnNonTailRecSelfAndMutBool),
% It is reasonably common that we don't need to check for tail calls
% at all.
( if
AddGoalFeature = do_not_add_goal_feature,
- (
- WarnNonTailRecOpt = do_not_warn_non_tail_rec_calls_opt,
- ( MaybeRequireTailRec = no
- ; MaybeRequireTailRec = yes(suppress_tailrec_warnings(_))
- )
- ;
- WarnNonTailRecOpt = warn_non_tail_rec_calls_opt,
- MaybeRequireTailRec = yes(suppress_tailrec_warnings(_))
- )
+ WarnNonTailRec = do_not_warn_non_tail_rec_calls
then
MaybeChanged = not_changed
else
do_mark_tail_calls_in_proc(AddGoalFeature,
- WarnNonTailRecOpt, MaybeRequireTailRec,
+ WarnNonTailRec, MaybeRequireTailRec,
ModuleInfo, PredId, ProcId, PredInfo, !ProcInfo, !Specs),
MaybeChanged = maybe_changed
)
).
+ % maybe_warn_non_tail_rec_call(MaybeRequireTailrecPragma, WarnSelf,
+ % WarnSelfAndMututal) = MaybeRequireTailrec.
+ %
+ % Combine the require tail recursion pragma and the command line options
+ % to determine if we should generate tail recursion warnings.
+ %
+:- func maybe_warn_non_tail_rec_call(maybe(require_tail_recursion),
+ bool, bool) = maybe_warn_non_tail_rec_call.
+
+maybe_warn_non_tail_rec_call(no, no, no) =
+ do_not_warn_non_tail_rec_calls.
+maybe_warn_non_tail_rec_call(no, yes, no) =
+ warn_non_tail_rec_calls(we_warning, only_self_recursion_must_be_tail).
+maybe_warn_non_tail_rec_call(no, _, yes) =
+ warn_non_tail_rec_calls(we_warning,
+ both_self_and_mutual_recursion_must_be_tail).
+maybe_warn_non_tail_rec_call(yes(suppress_tailrec_warnings(_Context)), _, _) =
+ do_not_warn_non_tail_rec_calls.
+maybe_warn_non_tail_rec_call(
+ yes(enable_tailrec_warnings(WoE, Type, _Context)), _, _) =
+ warn_non_tail_rec_calls(WoE, Type).
+
:- pred do_mark_tail_calls_in_proc(add_goal_feature::in,
- warn_non_tail_rec_calls_opt::in, maybe(require_tail_recursion)::in,
+ maybe_warn_non_tail_rec_call::in, maybe(require_tail_recursion)::in,
module_info::in, pred_id::in, proc_id::in,
pred_info::in, proc_info::in, proc_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-do_mark_tail_calls_in_proc(AddGoalFeature, WarnNonTailRecOpt,
+do_mark_tail_calls_in_proc(AddGoalFeature, WarnNonTailRec,
MaybeRequireTailRec, ModuleInfo, PredId, ProcId,
PredInfo, !ProcInfo, !Specs) :-
pred_info_get_arg_types(PredInfo, Types),
@@ -264,37 +286,16 @@ do_mark_tail_calls_in_proc(AddGoalFeature, WarnNonTailRecOpt,
proc_info_get_headvars(!.ProcInfo, HeadVars),
proc_info_get_vartypes(!.ProcInfo, VarTypes),
find_maybe_output_args(ModuleInfo, Types, Modes, HeadVars, Outputs),
-
+ module_info_get_maybe_dependency_info(ModuleInfo, MaybeDepInfo),
(
- MaybeRequireTailRec = no,
- MaybeRequireTailRecContext = no,
- (
- WarnNonTailRecOpt = do_not_warn_non_tail_rec_calls_opt,
- WarnNonTailRec = do_not_warn_non_tail_rec_calls
- ;
- WarnNonTailRecOpt = warn_non_tail_rec_calls_opt,
- % The MLDS backend doesn't (yet) support making
- % mutually-recursive calls *tail*-recursive,
- % but the LLDS backend does.
- WarnNonTailRec = warn_non_tail_rec_calls(we_warning,
- both_self_and_mutual_recursion_must_be_tail)
- )
+ MaybeDepInfo = yes(DepInfo),
+ SCC = dependency_info_get_this_scc(DepInfo, proc(PredId, ProcId))
;
- MaybeRequireTailRec = yes(RequireTailrecInfo0),
- (
- RequireTailrecInfo0 = enable_tailrec_warnings(WarnOrError,
- RecType, RequireTailRecContext),
- WarnNonTailRec = warn_non_tail_rec_calls(WarnOrError, RecType)
- ;
- RequireTailrecInfo0 = suppress_tailrec_warnings(
- RequireTailRecContext),
- WarnNonTailRec = do_not_warn_non_tail_rec_calls
- ),
- MaybeRequireTailRecContext = yes(RequireTailRecContext)
+ MaybeDepInfo = no,
+ unexpected($file, $pred, "Expected up-to-date HLDS dependency info")
),
-
Info = mark_tail_calls_info(AddGoalFeature, ModuleInfo, PredInfo,
- PredId, ProcId, VarTypes, WarnNonTailRec),
+ PredId, ProcId, SCC, VarTypes, WarnNonTailRec),
mark_tail_calls_in_goal(Info, FoundTailCalls, !Specs, Goal0, Goal,
at_tail(Outputs), _),
proc_info_set_goal(Goal, !ProcInfo),
@@ -305,16 +306,21 @@ do_mark_tail_calls_in_proc(AddGoalFeature, WarnNonTailRecOpt,
FoundTailCalls = not_found_tail_calls,
TailCallEvents = has_no_tail_call_event,
(
- MaybeRequireTailRecContext = no
+ MaybeRequireTailRec = no
;
- MaybeRequireTailRecContext = yes(Context),
+ MaybeRequireTailRec = yes(RequireTailrec),
+ (
+ RequireTailrec = enable_tailrec_warnings(_, _, Context)
+ ;
+ RequireTailrec = suppress_tailrec_warnings(Context)
+ ),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
pred_info_get_name(PredInfo, Name),
pred_info_get_orig_arity(PredInfo, Arity),
SimpleCallId = simple_call_id(PredOrFunc, unqualified(Name),
Arity),
- add_message_for_no_tail_or_nontail_recursive_calls(SimpleCallId,
- Context, !Specs)
+ add_message_for_no_tail_or_nontail_recursive_calls(
+ SimpleCallId, Context, !Specs)
)
),
proc_info_set_has_tail_call_event(TailCallEvents, !ProcInfo).
@@ -360,6 +366,10 @@ find_maybe_output_args_2(ModuleInfo, [Type | Types], [Mode | Modes],
%-----------------------------------------------------------------------------%
+:- type call_is_self_or_mutual_rec
+ ---> call_is_self_rec
+ ; call_is_mutual_rec.
+
% mark_tail_calls_in_goal(Info, Outputs0, MaybeOutputs, !Specs,
% Goal0, Goal, !FoundTailCalls):
%
@@ -386,6 +396,7 @@ mark_tail_calls_in_goal(Info, FoundTailCalls, !Specs, Goal0, Goal,
(
( GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
; GoalExpr0 = generic_call(_, _, _, _, _)
+ % Note: we don't give tailcall warnings for negated goals.
; GoalExpr0 = negation(_)
),
Goal = Goal0,
@@ -465,33 +476,44 @@ mark_tail_calls_in_goal(Info, FoundTailCalls, !Specs, Goal0, Goal,
FoundTailCalls = not_found_tail_calls
;
GoalExpr0 = plain_call(CallPredId, CallProcId, Args, Builtin,
- _UnifyContext, SymName),
+ _UnifyContext, _SymName),
PredId = Info ^ mtc_pred_id,
ProcId = Info ^ mtc_proc_id,
+ SCC = Info ^ mtc_scc,
( if
- CallPredId = PredId,
- CallProcId = ProcId,
- Builtin = not_builtin
+ Builtin = not_builtin,
+ ( if
+ CallPredId = PredId,
+ CallProcId = ProcId
+ then
+ SelfRecursion = call_is_self_rec
+ else if
+ member(proc(CallPredId, CallProcId), SCC)
+ then
+ SelfRecursion = call_is_mutual_rec
+ else
+ false
+ )
then
( if
AtTail0 = at_tail(Outputs0),
match_output_args(Outputs0, Args)
then
AddFeature = Info ^ mtc_add_feature,
- (
+ ( if
AddFeature = add_goal_feature,
+ SelfRecursion = call_is_self_rec
+ then
goal_info_add_feature(feature_debug_tail_rec_call,
GoalInfo0, GoalInfo),
Goal = hlds_goal(GoalExpr0, GoalInfo)
- ;
- AddFeature = do_not_add_goal_feature,
+ else
Goal = Goal0
)
else
Goal = Goal0,
- Arity = length(Args),
maybe_report_nontail_recursive_call(AtTail0, Info,
- SymName, Arity, CallProcId,
+ SelfRecursion, ProcId, CallPredId,
goal_info_get_context(GoalInfo0), !Specs)
),
AtTail = not_at_tail_seen_reccall,
@@ -679,26 +701,38 @@ at_tail_branch(A, B) = R :-
%-----------------------------------------------------------------------------%
:- pred maybe_report_nontail_recursive_call(at_tail::in,
- mark_tail_calls_info::in, sym_name::in, arity::in, proc_id::in,
- prog_context::in, list(error_spec)::in, list(error_spec)::out) is det.
+ mark_tail_calls_info::in, call_is_self_or_mutual_rec::in, proc_id::in,
+ pred_id::in, prog_context::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
-maybe_report_nontail_recursive_call(AtTail, Info, SymName, Arity, ProcId,
- Context, !Specs) :-
+maybe_report_nontail_recursive_call(AtTail, Info, SelfOrMutRec,
+ CallerProcId, CalleePredId, Context, !Specs) :-
(
( AtTail = at_tail(_)
; AtTail = not_at_tail_have_not_seen_reccall
),
- PredInfo = Info ^ mtc_pred_info,
+ CallerPredInfo = Info ^ mtc_pred_info,
WarnNonTailRecCalls = Info ^ mtc_warn_non_tail_rec_calls,
(
WarnNonTailRecCalls = do_not_warn_non_tail_rec_calls
;
WarnNonTailRecCalls = warn_non_tail_rec_calls(WarnOrError,
- _RecType),
- % TODO: Check recursion type to implement support for
- % mutual vs self recursion checking.
- report_nontail_recursive_call(PredInfo, SymName, Arity, ProcId,
- WarnOrError, Context, !Specs)
+ RecType),
+ ( if
+ require_complete_switch [RecType]
+ (
+ RecType = only_self_recursion_must_be_tail,
+ SelfOrMutRec = call_is_self_rec
+ ;
+ RecType = both_self_and_mutual_recursion_must_be_tail
+ )
+ then
+ report_nontail_recursive_call(Info, CallerPredInfo,
+ CallerProcId, CalleePredId, SelfOrMutRec, WarnOrError,
+ Context, !Specs)
+ else
+ true
+ )
)
;
% Never report calls that are followed by recursive calls.
@@ -709,40 +743,68 @@ maybe_report_nontail_recursive_call(AtTail, Info, SymName, Arity, ProcId,
AtTail = not_at_tail_seen_reccall
).
-:- pred report_nontail_recursive_call(pred_info::in, sym_name::in, arity::in,
- proc_id::in, warning_or_error::in, prog_context::in,
+:- pred report_nontail_recursive_call(mark_tail_calls_info::in,
+ pred_info::in, proc_id::in, pred_id::in, call_is_self_or_mutual_rec::in,
+ warning_or_error::in, prog_context::in,
list(error_spec)::in, list(error_spec)::out) is det.
-report_nontail_recursive_call(PredInfo, SymName, Arity, ProcId,
- WarnOrError, Context, !Specs) :-
- PredOrFunc = pred_info_is_pred_or_func(PredInfo),
- Name = unqualify_name(SymName),
- SimpleCallId = simple_call_id(PredOrFunc, unqualified(Name), Arity),
- add_message_for_nontail_recursive_call(SimpleCallId, ProcId,
- WarnOrError, Context, !Specs).
+report_nontail_recursive_call(Info, CallerPredInfo, CallerProcId,
+ CalleePredId, SelfOrMutRec, WarnOrError, Context, !Specs) :-
+ CallerPredOrFunc = pred_info_is_pred_or_func(CallerPredInfo),
+ CallerName = unqualified(pred_info_name(CallerPredInfo)),
+ CallerArity = pred_info_orig_arity(CallerPredInfo),
+ CallerId = simple_call_id(CallerPredOrFunc,
+ unqualified(unqualify_name(CallerName)), CallerArity),
+ (
+ SelfOrMutRec = call_is_self_rec,
+ add_message_for_nontail_recursive_call(CallerId, CallerProcId,
+ WarnOrError, Context, !Specs)
+ ;
+ SelfOrMutRec = call_is_mutual_rec,
+ module_info_pred_info(Info ^ mtc_module, CalleePredId, CalleePredInfo),
+ CalleePredOrFunc = pred_info_is_pred_or_func(CalleePredInfo),
+ CalleeName = qualified(pred_info_module(CalleePredInfo),
+ pred_info_name(CalleePredInfo)),
+ CalleeArity = pred_info_orig_arity(CalleePredInfo),
+ CalleeId = simple_call_id(CalleePredOrFunc, CalleeName, CalleeArity),
+ add_message_for_nontail_mutual_recursive_call(CallerId,
+ CallerProcId, CalleeId, WarnOrError, Context, !Specs)
+ ).
%-----------------------------------------------------------------------------%
add_message_for_nontail_recursive_call(SimpleCallId, ProcId,
WarnOrError, Context, !Specs) :-
- (
- WarnOrError = we_warning,
- Severity = severity_warning,
- WarnOrErrorWord = words("warning:")
- ;
- WarnOrError = we_error,
- Severity = severity_error,
- WarnOrErrorWord = words("error:")
- ),
+ woe_to_severity_and_string(WarnOrError, Severity, WarnOrErrorWord),
proc_id_to_int(ProcId, ProcNumber0),
ProcNumber = ProcNumber0 + 1,
Pieces = [words("In mode number"), int_fixed(ProcNumber),
words("of"), simple_call(SimpleCallId), suffix(":"), nl,
- WarnOrErrorWord, words("recursive call is not tail recursive."), nl],
+ WarnOrErrorWord,
+ words("self-recursive call is not tail recursive."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(Severity, phase_code_gen, [Msg]),
!:Specs = [Spec | !.Specs].
+add_message_for_nontail_mutual_recursive_call(CallerId, CallerProcId,
+ CalleeId, WarnOrError, Context, !Specs) :-
+ woe_to_severity_and_string(WarnOrError, Severity, WarnOrErrorWord),
+ proc_id_to_int(CallerProcId, ProcNumber0),
+ ProcNumber = ProcNumber0 + 1,
+ Pieces = [words("In mode number"), int_fixed(ProcNumber),
+ words("of"), simple_call(CallerId), suffix(":"), nl,
+ WarnOrErrorWord, words("mutually recursive call to"),
+ simple_call(CalleeId), words("is not tail recursive."), nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(Severity, phase_code_gen, [Msg]),
+ !:Specs = [Spec | !.Specs].
+
+:- pred woe_to_severity_and_string(warning_or_error::in,
+ error_severity::out, format_component::out) is det.
+
+woe_to_severity_and_string(we_warning, severity_warning, words("warning:")).
+woe_to_severity_and_string(we_error, severity_error, words("error:")).
+
add_message_for_no_tail_or_nontail_recursive_calls(SimpleCallId, Context,
!Specs) :-
SimpleCallId = simple_call_id(PredOrFunc, _, _),
diff --git a/compiler/mercury_compile_llds_back_end.m b/compiler/mercury_compile_llds_back_end.m
index e430f77..2c85eb5 100644
--- a/compiler/mercury_compile_llds_back_end.m
+++ b/compiler/mercury_compile_llds_back_end.m
@@ -134,6 +134,10 @@ llds_backend_pass(!HLDS, !:GlobalData, LLDS, !DumpInfo, !IO) :-
map_args_to_regs(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 305, "args_to_regs", !DumpInfo, !IO),
+ % The mark_tail_calls pass requires dependency information. Generate
+ % that now.
+ module_info_rebuild_dependency_info(!HLDS, _),
+
globals.lookup_bool_option(Globals, trad_passes, TradPasses),
add_all_tabling_info_structs(!.HLDS, !GlobalData),
(
diff --git a/compiler/ml_tailcall.m b/compiler/ml_tailcall.m
index 03feba2..8e60259 100644
--- a/compiler/ml_tailcall.m
+++ b/compiler/ml_tailcall.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1999-2009 The University of Melbourne.
+% Copyright (C) 2017 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.
%-----------------------------------------------------------------------------%
@@ -105,7 +106,7 @@
ml_mark_tailcalls(Globals, ModuleInfo, Specs, !MLDS) :-
Defns0 = !.MLDS ^ mlds_defns,
ModuleName = mercury_module_name_to_mlds(!.MLDS ^ mlds_name),
- globals.lookup_bool_option(Globals, warn_non_tail_recursion,
+ globals.lookup_bool_option(Globals, warn_non_tail_recursion_self,
WarnTailCallsBool),
(
WarnTailCallsBool = yes,
diff --git a/compiler/options.m b/compiler/options.m
index 6a09644..2dedcbb 100644
--- a/compiler/options.m
+++ b/compiler/options.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1994-2012 The University of Melbourne.
+% Copyright (C) 2017 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.
%---------------------------------------------------------------------------%
@@ -170,6 +171,7 @@
; warn_smart_recompilation
; warn_undefined_options_variables
; warn_non_tail_recursion
+ ; warn_non_tail_recursion_self
; warn_target_code
; warn_up_to_date
; warn_stubs
@@ -1160,6 +1162,7 @@ option_defaults_2(warning_option, [
warn_smart_recompilation - bool(yes),
warn_undefined_options_variables - bool(yes),
warn_non_tail_recursion - bool(no),
+ warn_non_tail_recursion_self - bool(no),
warn_target_code - bool(yes),
warn_up_to_date - bool(yes),
warn_stubs - bool(yes),
@@ -2049,6 +2052,8 @@ long_option("warn-undefined-options-variables",
long_option("warn-undefined-options-vars",
warn_undefined_options_variables).
long_option("warn-non-tail-recursion", warn_non_tail_recursion).
+long_option("warn-non-tail-recursion-self",
+ warn_non_tail_recursion_self).
long_option("warn-target-code", warn_target_code).
long_option("warn-up-to-date", warn_up_to_date).
long_option("warn-stubs", warn_stubs).
@@ -3142,6 +3147,7 @@ special_handler(Option, SpecialData, !.OptionTable, Result) :-
warn_smart_recompilation - bool(Enable),
warn_undefined_options_variables - bool(Enable),
warn_non_tail_recursion - bool(Enable),
+ warn_non_tail_recursion_self - bool(Enable),
warn_target_code - bool(Enable),
warn_up_to_date - bool(Enable),
warn_stubs - bool(Enable),
@@ -3173,6 +3179,7 @@ special_handler(Option, SpecialData, !.OptionTable, Result) :-
warn_duplicate_calls - bool(Enable),
warn_implicit_stream_calls - bool(Enable),
warn_non_tail_recursion - bool(Enable),
+ warn_non_tail_recursion_self - bool(Enable),
warn_dead_procs - bool(Enable),
warn_dead_preds - bool(Enable),
warn_known_bad_format_calls - bool(Enable),
@@ -3754,6 +3761,9 @@ options_help_warning -->
"\tDo not warn about references to undefined variables in",
"\toptions files with `--make'.",
"--warn-non-tail-recursion",
+ "\tWarn about any recursive calls that are not tail calls,",
+ "\tboth direct and mutual.",
+ "--warn-non-tail-recursion-self",
"\tWarn about any directly recursive calls that are not tail calls.",
"--no-warn-up-to-date",
"\tDo not warn if targets specified on the command line",
diff --git a/doc/user_guide.texi b/doc/user_guide.texi
index bb94558..e3fa77a 100644
--- a/doc/user_guide.texi
+++ b/doc/user_guide.texi
@@ -6616,6 +6616,12 @@ options files with @samp{--make}.
@sp 1
@item --warn-non-tail-recursion
@findex --warn-non-tail-recursion
+Warn about any recursive calls that are not tail recursive.
+Implies the next two options.
+
+ at sp 1
+ at item --warn-non-tail-recursion-self
+ at findex --warn-non-tail-recursion-self
Warn about any directly recursive calls that are not tail recursive.
@sp 1
diff --git a/tests/EXPECT_FAIL_TESTS.hlc.gc b/tests/EXPECT_FAIL_TESTS.hlc.gc
new file mode 100644
index 0000000..1f68024
--- /dev/null
+++ b/tests/EXPECT_FAIL_TESTS.hlc.gc
@@ -0,0 +1,3 @@
+invalid/require_tailrec_1-nodepend
+invalid/require_tailrec_2-nodepend
+invalid/require_tailrec_3-nodepend
diff --git a/tests/invalid/Mercury.options b/tests/invalid/Mercury.options
index b35142e..b42cad9 100644
--- a/tests/invalid/Mercury.options
+++ b/tests/invalid/Mercury.options
@@ -120,8 +120,9 @@ MCFLAGS-polymorphic_unification = --verbose-error-messages
MCFLAGS-predmode = --verbose-error-messages
MCFLAGS-prog_io_erroneous = --verbose-error-messages
-MCFLAGS-require_tailrec_1 = --no-warn-non-tail-recursion
-MCFLAGS-require_tailrec_2 = --warn-non-tail-recursion
+MCFLAGS-require_tailrec_1 = -O0 --optimise-tailcalls --no-warn-non-tail-recursion
+MCFLAGS-require_tailrec_2 = -O0 --optimise-tailcalls --warn-non-tail-recursion-self
+MCFLAGS-require_tailrec_3 = -O0 --optimise-tailcalls --warn-non-tail-recursion
MCFLAGS-require_tailrec_invalid = --allow-stubs --no-warn-stubs
# We compile test_feature_set in hl.gc because that grade is incompatible
diff --git a/tests/invalid/Mmakefile b/tests/invalid/Mmakefile
index 9f4acb8..5ac7735 100644
--- a/tests/invalid/Mmakefile
+++ b/tests/invalid/Mmakefile
@@ -249,6 +249,7 @@ SINGLEMODULE= \
require_switch_arms_detism \
require_tailrec_1 \
require_tailrec_2 \
+ require_tailrec_3 \
require_tailrec_invalid \
reserved \
some \
@@ -522,7 +523,7 @@ illtyped_compare.err: illtyped_compare.m
# For these tests the error is only caught when generating target code.
.PHONY: missing_file
-require_tailrec_1.err require_tailrec_2.err foreign_include_file_missing.err: %.err : %.m
+require_tailrec_1.err require_tailrec_2.err require_tailrec_3.err foreign_include_file_missing.err: %.err : %.m
if $(MC) --target-code-only $(ALL_GRADEFLAGS) $(ALL_MCFLAGS) \
$* > $*.err 2>&1; \
then false; \
diff --git a/tests/invalid/require_tailrec_1.err_exp b/tests/invalid/require_tailrec_1.err_exp
index 78da22f..c0d661a 100644
--- a/tests/invalid/require_tailrec_1.err_exp
+++ b/tests/invalid/require_tailrec_1.err_exp
@@ -1,14 +1,21 @@
-require_tailrec_1.m:027: In mode number 1 of predicate `qsortapp_1'/2:
-require_tailrec_1.m:027: warning: recursive call is not tail recursive.
-require_tailrec_1.m:045: In mode number 1 of predicate `qsortapp_3'/2:
-require_tailrec_1.m:045: warning: recursive call is not tail recursive.
-require_tailrec_1.m:054: In mode number 1 of predicate `qsortapp_4'/2:
-require_tailrec_1.m:054: error: recursive call is not tail recursive.
-require_tailrec_1.m:063: In mode number 1 of predicate `qsortapp_5'/2:
-require_tailrec_1.m:063: warning: recursive call is not tail recursive.
-require_tailrec_1.m:072: In mode number 1 of predicate `qsortapp_6'/2:
-require_tailrec_1.m:072: warning: recursive call is not tail recursive.
-require_tailrec_1.m:079: In `:- pragma require_tail_recursion' for function
-require_tailrec_1.m:079: `cons'/2:
-require_tailrec_1.m:079: warning: the code defining this function contains no
-require_tailrec_1.m:079: recursive calls at all, tail-recursive or otherwise.
+require_tailrec_1.m:040: In mode number 1 of predicate `map1'/3:
+require_tailrec_1.m:040: warning: self-recursive call is not tail recursive.
+require_tailrec_1.m:047: In mode number 1 of predicate `map2'/3:
+require_tailrec_1.m:047: warning: self-recursive call is not tail recursive.
+require_tailrec_1.m:055: In mode number 1 of function `even1'/1:
+require_tailrec_1.m:055: warning: mutually recursive call to function
+require_tailrec_1.m:055: `require_tailrec_1.odd1'/1 is not tail recursive.
+require_tailrec_1.m:075: In mode number 1 of predicate `qsortapp_1'/2:
+require_tailrec_1.m:075: warning: self-recursive call is not tail recursive.
+require_tailrec_1.m:093: In mode number 1 of predicate `qsortapp_3'/2:
+require_tailrec_1.m:093: warning: self-recursive call is not tail recursive.
+require_tailrec_1.m:102: In mode number 1 of predicate `qsortapp_4'/2:
+require_tailrec_1.m:102: error: self-recursive call is not tail recursive.
+require_tailrec_1.m:111: In mode number 1 of predicate `qsortapp_5'/2:
+require_tailrec_1.m:111: warning: self-recursive call is not tail recursive.
+require_tailrec_1.m:120: In mode number 1 of predicate `qsortapp_6'/2:
+require_tailrec_1.m:120: warning: self-recursive call is not tail recursive.
+require_tailrec_1.m:127: In `:- pragma require_tail_recursion' for function
+require_tailrec_1.m:127: `cons'/2:
+require_tailrec_1.m:127: warning: the code defining this function contains no
+require_tailrec_1.m:127: recursive calls at all, tail-recursive or otherwise.
diff --git a/tests/invalid/require_tailrec_1.m b/tests/invalid/require_tailrec_1.m
index 6024210..e22dc4b 100644
--- a/tests/invalid/require_tailrec_1.m
+++ b/tests/invalid/require_tailrec_1.m
@@ -4,9 +4,21 @@
:- interface.
+:- import_module bool.
:- import_module int.
:- import_module list.
+:- pred map1(pred(X, Y), list(X), list(Y)).
+:- mode map1(pred(in, out) is det, in, out) is det.
+
+:- pred map2(pred(X, Y), list(X), list(Y)).
+:- mode map2(pred(in, out) is det, in, out) is det.
+
+:- func even1(int) = bool.
+:- func odd1(int) = bool.
+
+%-----------------------------------------------------------------------%
+
:- pred qsortapp_1(list(int)::in, list(int)::out) is det.
:- pred qsortapp_2(list(int)::in, list(int)::out) is det.
:- pred qsortapp_3(list(int)::in, list(int)::out) is det.
@@ -16,8 +28,44 @@
:- func cons(X, list(X)) = list(X).
+%-----------------------------------------------------------------------%
+%-----------------------------------------------------------------------%
:- implementation.
+% self non-tail recursion with self pragma
+:- pragma require_tail_recursion(map1/3, [self_recursion_only]).
+map1(_, [], []).
+map1(P, [X | Xs], [Y | Ys]) :-
+ P(X, Y),
+ map1(P, Xs, Ys).
+
+% self non-tail recursion with mutual pragma
+:- pragma require_tail_recursion(map2/3, [self_or_mutual_recursion]).
+map2(_, [], []).
+map2(P, [X | Xs], [Y | Ys]) :-
+ P(X, Y),
+ map2(P, Xs, Ys).
+
+% mutual non-tail recursion with mutual pragma
+:- pragma require_tail_recursion(even1/1, [self_or_mutual_recursion]).
+even1(N) =
+ ( if N = 0 then
+ yes
+ else
+ bool.not(odd1(N))
+ ).
+
+% mutual tail recursion with mutual pragma, this does not raise an error.
+:- pragma require_tail_recursion(odd1/1, [self_or_mutual_recursion]).
+odd1(N) =
+ ( if N = 0 then
+ no
+ else
+ even1(N - 1)
+ ).
+
+%-----------------------------------------------------------------------%
+
:- pragma require_tail_recursion(qsortapp_1/2).
qsortapp_1([], []).
diff --git a/tests/invalid/require_tailrec_2.err_exp b/tests/invalid/require_tailrec_2.err_exp
index 8cf3bb6..2c51acd 100644
--- a/tests/invalid/require_tailrec_2.err_exp
+++ b/tests/invalid/require_tailrec_2.err_exp
@@ -1,16 +1,23 @@
-require_tailrec_2.m:027: In mode number 1 of predicate `qsortapp_1'/2:
-require_tailrec_2.m:027: warning: recursive call is not tail recursive.
-require_tailrec_2.m:036: In mode number 1 of predicate `qsortapp_2'/2:
-require_tailrec_2.m:036: warning: recursive call is not tail recursive.
-require_tailrec_2.m:045: In mode number 1 of predicate `qsortapp_3'/2:
-require_tailrec_2.m:045: warning: recursive call is not tail recursive.
-require_tailrec_2.m:054: In mode number 1 of predicate `qsortapp_4'/2:
-require_tailrec_2.m:054: error: recursive call is not tail recursive.
-require_tailrec_2.m:063: In mode number 1 of predicate `qsortapp_5'/2:
-require_tailrec_2.m:063: warning: recursive call is not tail recursive.
-require_tailrec_2.m:072: In mode number 1 of predicate `qsortapp_6'/2:
-require_tailrec_2.m:072: warning: recursive call is not tail recursive.
-require_tailrec_2.m:079: In `:- pragma require_tail_recursion' for function
-require_tailrec_2.m:079: `cons'/2:
-require_tailrec_2.m:079: warning: the code defining this function contains no
-require_tailrec_2.m:079: recursive calls at all, tail-recursive or otherwise.
+require_tailrec_2.m:039: In mode number 1 of predicate `map1'/3:
+require_tailrec_2.m:039: warning: self-recursive call is not tail recursive.
+require_tailrec_2.m:046: In mode number 1 of predicate `map2'/3:
+require_tailrec_2.m:046: warning: self-recursive call is not tail recursive.
+require_tailrec_2.m:054: In mode number 1 of function `even1'/1:
+require_tailrec_2.m:054: warning: mutually recursive call to function
+require_tailrec_2.m:054: `require_tailrec_2.odd1'/1 is not tail recursive.
+require_tailrec_2.m:074: In mode number 1 of predicate `qsortapp_1'/2:
+require_tailrec_2.m:074: warning: self-recursive call is not tail recursive.
+require_tailrec_2.m:083: In mode number 1 of predicate `qsortapp_2'/2:
+require_tailrec_2.m:083: warning: self-recursive call is not tail recursive.
+require_tailrec_2.m:092: In mode number 1 of predicate `qsortapp_3'/2:
+require_tailrec_2.m:092: warning: self-recursive call is not tail recursive.
+require_tailrec_2.m:101: In mode number 1 of predicate `qsortapp_4'/2:
+require_tailrec_2.m:101: error: self-recursive call is not tail recursive.
+require_tailrec_2.m:110: In mode number 1 of predicate `qsortapp_5'/2:
+require_tailrec_2.m:110: warning: self-recursive call is not tail recursive.
+require_tailrec_2.m:119: In mode number 1 of predicate `qsortapp_6'/2:
+require_tailrec_2.m:119: warning: self-recursive call is not tail recursive.
+require_tailrec_2.m:126: In `:- pragma require_tail_recursion' for function
+require_tailrec_2.m:126: `cons'/2:
+require_tailrec_2.m:126: warning: the code defining this function contains no
+require_tailrec_2.m:126: recursive calls at all, tail-recursive or otherwise.
diff --git a/tests/invalid/require_tailrec_2.m b/tests/invalid/require_tailrec_2.m
index 06f4d11..352af4b 100644
--- a/tests/invalid/require_tailrec_2.m
+++ b/tests/invalid/require_tailrec_2.m
@@ -1,12 +1,24 @@
% vim: ft=mercury ts=4 sw=4 et
-% Require tail recursion pragma tests with --warn-non-tail-recursive
+% Require tail recursion pragma tests with --warn-non-tail-recursive-self
:- module require_tailrec_2.
:- interface.
+:- import_module bool.
:- import_module int.
:- import_module list.
+:- pred map1(pred(X, Y), list(X), list(Y)).
+:- mode map1(pred(in, out) is det, in, out) is det.
+
+:- pred map2(pred(X, Y), list(X), list(Y)).
+:- mode map2(pred(in, out) is det, in, out) is det.
+
+:- func even1(int) = bool.
+:- func odd1(int) = bool.
+
+%-----------------------------------------------------------------------%
+
:- pred qsortapp_1(list(int)::in, list(int)::out) is det.
:- pred qsortapp_2(list(int)::in, list(int)::out) is det.
:- pred qsortapp_3(list(int)::in, list(int)::out) is det.
@@ -16,8 +28,43 @@
:- func cons(X, list(X)) = list(X).
+%-----------------------------------------------------------------------%
+
:- implementation.
+% self non-tail recursion with no pragma
+map1(_, [], []).
+map1(P, [X | Xs], [Y | Ys]) :-
+ P(X, Y),
+ map1(P, Xs, Ys).
+
+% self non-tail recursion with self pragma
+:- pragma require_tail_recursion(map2/3, [self_or_mutual_recursion]).
+map2(_, [], []).
+map2(P, [X | Xs], [Y | Ys]) :-
+ P(X, Y),
+ map2(P, Xs, Ys).
+
+% mutual non-tail recursion with mutual pragma
+:- pragma require_tail_recursion(even1/1, [self_or_mutual_recursion]).
+even1(N) =
+ ( if N = 0 then
+ yes
+ else
+ bool.not(odd1(N))
+ ).
+
+% mutual tail recursion with mutual pragma, this does not raise an error.
+:- pragma require_tail_recursion(odd1/1, [self_or_mutual_recursion]).
+odd1(N) =
+ ( if N = 0 then
+ no
+ else
+ even1(N - 1)
+ ).
+
+%-----------------------------------------------------------------------%
+
:- pragma require_tail_recursion(qsortapp_1/2).
qsortapp_1([], []).
diff --git a/tests/invalid/require_tailrec_3.err_exp b/tests/invalid/require_tailrec_3.err_exp
new file mode 100644
index 0000000..712ed4c
--- /dev/null
+++ b/tests/invalid/require_tailrec_3.err_exp
@@ -0,0 +1,9 @@
+require_tailrec_3.m:028: In mode number 1 of function `even1'/1:
+require_tailrec_3.m:028: warning: mutually recursive call to function
+require_tailrec_3.m:028: `require_tailrec_3.odd1'/1 is not tail recursive.
+require_tailrec_3.m:043: In mode number 1 of function `even2'/1:
+require_tailrec_3.m:043: error: mutually recursive call to function
+require_tailrec_3.m:043: `require_tailrec_3.odd2'/1 is not tail recursive.
+require_tailrec_3.m:058: In mode number 1 of function `even3'/1:
+require_tailrec_3.m:058: warning: mutually recursive call to function
+require_tailrec_3.m:058: `require_tailrec_3.odd3'/1 is not tail recursive.
diff --git a/tests/invalid/require_tailrec_3.m b/tests/invalid/require_tailrec_3.m
new file mode 100644
index 0000000..193dc65
--- /dev/null
+++ b/tests/invalid/require_tailrec_3.m
@@ -0,0 +1,66 @@
+% vim: ft=mercury ts=4 sw=4 et
+% Require tail recursion pragma tests with --warn-non-tail-recursive
+:- module require_tailrec_3.
+
+:- interface.
+
+:- import_module bool.
+:- import_module int.
+
+:- func even1(int) = bool.
+:- func odd1(int) = bool.
+
+:- func even2(int) = bool.
+:- func odd2(int) = bool.
+
+:- func even3(int) = bool.
+:- func odd3(int) = bool.
+
+%-----------------------------------------------------------------------%
+
+:- implementation.
+
+% mutual non-tail recursion with no pragma
+even1(N) =
+ ( if N = 0 then
+ yes
+ else
+ bool.not(odd1(N))
+ ).
+odd1(N) =
+ ( if N = 0 then
+ no
+ else
+ even1(N - 1)
+ ).
+
+% mutual non-tail recursion with mutual pragma
+:- pragma require_tail_recursion(even2/1, [error, self_or_mutual_recursion]).
+even2(N) =
+ ( if N = 0 then
+ yes
+ else
+ bool.not(odd2(N))
+ ).
+odd2(N) =
+ ( if N = 0 then
+ no
+ else
+ even2(N - 1)
+ ).
+
+% mutual non-tail recursion with default pragma
+:- pragma require_tail_recursion(even3/1).
+even3(N) =
+ ( if N = 0 then
+ yes
+ else
+ bool.not(odd3(N))
+ ).
+odd3(N) =
+ ( if N = 0 then
+ no
+ else
+ even3(N - 1)
+ ).
+
diff --git a/tests/valid/Mercury.options b/tests/valid/Mercury.options
index acdc3bb..3320dc0 100644
--- a/tests/valid/Mercury.options
+++ b/tests/valid/Mercury.options
@@ -83,8 +83,9 @@ MCFLAGS-par_dupelim = --optimize-dups
MCFLAGS-par_saved_const = -O3 --optimize-saved-vars-const
MCFLAGS-pred_with_no_modes = --infer-all
MCFLAGS-quantifier_warning = --halt-at-warn
-MCFLAGS-require_tailrec_1 = --warn-non-tail-recursion
-MCFLAGS-require_tailrec_2 = --no-warn-non-tail-recursion
+MCFLAGS-require_tailrec_1 = -O0 --optimise-tailcalls --warn-non-tail-recursion-self
+MCFLAGS-require_tailrec_2 = -O0 --optimise-tailcalls --no-warn-non-tail-recursion
+MCFLAGS-require_tailrec_3 = -O0 --optimise-tailcalls --warn-non-tail-recursion
MCFLAGS-reuse_static = --ctgc --deforestation
MCFLAGS-reuse_static2 = --structure-reuse --loop-invariants
MCFLAGS-sharing_exist = --ctgc --structure-sharing-widening 1
diff --git a/tests/valid/Mmakefile b/tests/valid/Mmakefile
index a1f65a3..425f9d6 100644
--- a/tests/valid/Mmakefile
+++ b/tests/valid/Mmakefile
@@ -205,6 +205,7 @@ OTHER_PROGS = \
require_bug \
require_tailrec_1 \
require_tailrec_2 \
+ require_tailrec_3 \
required_var \
same_length_2 \
semidet_disj \
diff --git a/tests/valid/require_tailrec_1.m b/tests/valid/require_tailrec_1.m
index c698001..50b72ce 100644
--- a/tests/valid/require_tailrec_1.m
+++ b/tests/valid/require_tailrec_1.m
@@ -1,20 +1,99 @@
%
-% Test the require tail recursion pragma with the --warn-non-tail-recursion
-% option. These tests do not raise an error, the tests that do raise errors
-% are in invalid/
+% Test the require tail recursion pragma with the
+% --warn-non-tail-recursion-self option. These tests do not raise an error,
+% the tests that do raise errors are in invalid/
%
:- module require_tailrec_1.
:- interface.
+:- import_module bool.
:- import_module int.
:- import_module list.
+:- pred foldl1(pred(X, A, A), list(X), A, A).
+:- mode foldl1(pred(in, in, out) is det, in, in, out) is det.
+
+:- pred map1(pred(X, Y), list(X), list(Y)).
+:- mode map1(pred(in, out) is det, in, out) is det.
+
+:- func even1(int) = bool.
+:- func odd1(int) = bool.
+
+:- func even2(int) = bool.
+:- func odd2(int) = bool.
+
+:- func even3(int) = bool.
+:- func odd3(int) = bool.
+
+%-----------------------------------------------------------------------%
+
:- pred qsortapp(list(int)::in, list(int)::out) is det.
:- implementation.
+% self tail recursive code with no pragma.
+foldl1(_, [], !Acc).
+foldl1(P, [X | Xs], !Acc) :-
+ P(X, !Acc),
+ foldl1(P, Xs, !Acc).
+
+% self non-tail recursive code with none pragma.
+:- pragma require_tail_recursion(map1/3, [none]).
+map1(_, [], []).
+map1(P, [X | Xs], [Y | Ys]) :-
+ P(X, Y),
+ map1(P, Xs, Ys).
+
+% mutual non-tail recursion without pragma.
+even1(N) =
+ ( if N = 0 then
+ yes
+ else
+ odd1(N - 1)
+ ).
+
+odd1(N) =
+ ( if N = 0 then
+ no
+ else
+ bool.not(even1(N))
+ ).
+
+% mutual non-tail recursion with none pragma.
+:- pragma require_tail_recursion(odd2/1, [none]).
+even2(N) =
+ ( if N = 0 then
+ yes
+ else
+ odd2(N - 1)
+ ).
+
+:- pragma require_tail_recursion(odd3/1, [self_recursion_only]).
+odd2(N) =
+ ( if N = 0 then
+ no
+ else
+ bool.not(even2(N))
+ ).
+
+even3(N) =
+ ( if N = 0 then
+ yes
+ else
+ odd3(N - 1)
+ ).
+
+odd3(N) =
+ ( if N = 0 then
+ no
+ else
+ bool.not(even3(N))
+ ).
+
+%-----------------------------------------------------------------------%
+
:- pragma require_tail_recursion(qsortapp/2, [none]).
qsortapp([], []).
diff --git a/tests/valid/require_tailrec_2.m b/tests/valid/require_tailrec_2.m
index 31616af..bbb45fd 100644
--- a/tests/valid/require_tailrec_2.m
+++ b/tests/valid/require_tailrec_2.m
@@ -8,15 +8,183 @@
:- interface.
+:- import_module bool.
:- import_module int.
:- import_module list.
+:- pred foldl1(pred(X, A, A), list(X), A, A).
+:- mode foldl1(pred(in, in, out) is det, in, in, out) is det.
+
+:- pred foldl2(pred(X, A, A), list(X), A, A).
+:- mode foldl2(pred(in, in, out) is det, in, in, out) is det.
+
+:- pred foldl3(pred(X, A, A), list(X), A, A).
+:- mode foldl3(pred(in, in, out) is det, in, in, out) is det.
+
+:- pred foldl4(pred(X, A, A), list(X), A, A).
+:- mode foldl4(pred(in, in, out) is det, in, in, out) is det.
+
+:- pred map1(pred(X, Y), list(X), list(Y)).
+:- mode map1(pred(in, out) is det, in, out) is det.
+
+:- pred map2(pred(X, Y), list(X), list(Y)).
+:- mode map2(pred(in, out) is det, in, out) is det.
+
+:- func even1(int) = bool.
+:- func odd1(int) = bool.
+
+:- func even2(int) = bool.
+:- func odd2(int) = bool.
+
+:- func even3(int) = bool.
+:- func odd3(int) = bool.
+
+:- func even4(int) = bool.
+:- func odd4(int) = bool.
+
+:- func even5(int) = bool.
+:- func odd5(int) = bool.
+
+:- func even6(int) = bool.
+:- func odd6(int) = bool.
+
+%-----------------------------------------------------------------------%
+
:- pred qsortapp(list(int)::in, list(int)::out) is det.
:- pred qsortapp_2(list(int)::in, list(int)::out) is det.
:- implementation.
+% self tail recursive code with no pragma.
+foldl1(_, [], !Acc).
+foldl1(P, [X | Xs], !Acc) :-
+ P(X, !Acc),
+ foldl1(P, Xs, !Acc).
+
+% self tail recursive code with none pragma.
+:- pragma require_tail_recursion(foldl2/4, [none]).
+foldl2(_, [], !Acc).
+foldl2(P, [X | Xs], !Acc) :-
+ P(X, !Acc),
+ foldl2(P, Xs, !Acc).
+
+% self tail recursive code with self pragma.
+:- pragma require_tail_recursion(foldl3/4, [self_recursion_only]).
+foldl3(_, [], !Acc).
+foldl3(P, [X | Xs], !Acc) :-
+ P(X, !Acc),
+ foldl3(P, Xs, !Acc).
+
+% self tail recursive code with mutual pragma.
+:- pragma require_tail_recursion(foldl4/4, [self_or_mutual_recursion]).
+foldl4(_, [], !Acc).
+foldl4(P, [X | Xs], !Acc) :-
+ P(X, !Acc),
+ foldl4(P, Xs, !Acc).
+
+% Self non-tail recursive code with no pragma
+map1(_, [], []).
+map1(P, [X | Xs], [Y | Ys]) :-
+ P(X, Y),
+ map1(P, Xs, Ys).
+
+% Self non-tail recursive code with none pragma
+:- pragma require_tail_recursion(map2/3, [none]).
+map2(_, [], []).
+map2(P, [X | Xs], [Y | Ys]) :-
+ P(X, Y),
+ map2(P, Xs, Ys).
+
+% Mutual tail recursion with no pragma.
+even1(N) =
+ ( if N = 0 then
+ yes
+ else
+ odd1(N - 1)
+ ).
+odd1(N) =
+ ( if N = 0 then
+ no
+ else
+ even1(N - 1)
+ ).
+
+% Mutual tail recursion with none pragma.
+:- pragma require_tail_recursion(even2/1, [none]).
+even2(N) =
+ ( if N = 0 then
+ yes
+ else
+ odd2(N - 1)
+ ).
+:- pragma require_tail_recursion(odd2/1, [none]).
+odd2(N) =
+ ( if N = 0 then
+ no
+ else
+ even2(N - 1)
+ ).
+
+% Mutual tail recursion with none pragma.
+:- pragma require_tail_recursion(even3/1, [self_or_mutual_recursion]).
+even3(N) =
+ ( if N = 0 then
+ yes
+ else
+ odd3(N - 1)
+ ).
+odd3(N) =
+ ( if N = 0 then
+ no
+ else
+ even3(N - 1)
+ ).
+
+even4(N) =
+ ( if N = 0 then
+ yes
+ else
+ bool.not(odd4(N))
+ ).
+odd4(N) =
+ ( if N = 0 then
+ no
+ else
+ bool.not(even4(N))
+ ).
+
+:- pragma require_tail_recursion(even5/1, [none]).
+even5(N) =
+ ( if N = 0 then
+ yes
+ else
+ bool.not(odd5(N))
+ ).
+odd5(N) =
+ ( if N = 0 then
+ no
+ else
+ bool.not(even5(N))
+ ).
+
+:- pragma require_tail_recursion(even6/1, [self_recursion_only]).
+even6(N) =
+ ( if N = 0 then
+ yes
+ else
+ bool.not(odd6(N - 1))
+ ).
+:- pragma require_tail_recursion(odd6/1, [self_recursion_only]).
+odd6(N) =
+ ( if N = 0 then
+ no
+ else
+ bool.not(even6(N - 1))
+ ).
+
+%-----------------------------------------------------------------------%
+
:- pragma require_tail_recursion(qsortapp/2, [none]).
qsortapp([], []).
diff --git a/tests/valid/require_tailrec_3.m b/tests/valid/require_tailrec_3.m
new file mode 100644
index 0000000..10f7472
--- /dev/null
+++ b/tests/valid/require_tailrec_3.m
@@ -0,0 +1,105 @@
+%
+% Test the require tail recursion pragma with the
+% --warn-non-tail-recursion option. These tests do not raise an error,
+% the tests that do raise errors are in invalid/
+%
+
+:- module require_tailrec_3.
+
+:- interface.
+
+:- import_module bool.
+:- import_module int.
+:- import_module list.
+
+:- pred foldl1(pred(X, A, A), list(X), A, A).
+:- mode foldl1(pred(in, in, out) is det, in, in, out) is det.
+
+:- func even1(int) = bool.
+:- func odd1(int) = bool.
+
+:- func even2(int) = bool.
+:- func odd2(int) = bool.
+
+:- func even3(int) = bool.
+:- func odd3(int) = bool.
+
+:- func even4(int) = bool.
+:- func odd4(int) = bool.
+
+%-----------------------------------------------------------------------%
+
+:- implementation.
+
+% self tail recursive code with no pragma.
+foldl1(_, [], !Acc).
+foldl1(P, [X | Xs], !Acc) :-
+ P(X, !Acc),
+ foldl1(P, Xs, !Acc).
+
+% mutual tail recursion without pragma.
+even1(N) =
+ ( if N = 0 then
+ yes
+ else
+ odd1(N - 1)
+ ).
+
+odd1(N) =
+ ( if N = 0 then
+ no
+ else
+ even1(N)
+ ).
+
+% mutual tail recursion with none pragma.
+:- pragma require_tail_recursion(even2/1, [none]).
+even2(N) =
+ ( if N = 0 then
+ yes
+ else
+ odd2(N - 1)
+ ).
+
+:- pragma require_tail_recursion(odd2/1, [self_recursion_only]).
+odd2(N) =
+ ( if N = 0 then
+ no
+ else
+ even2(N)
+ ).
+
+% mutual tail recursion with mutual pragma.
+:- pragma require_tail_recursion(even3/1, [self_or_mutual_recursion]).
+even3(N) =
+ ( if N = 0 then
+ yes
+ else
+ odd3(N - 1)
+ ).
+
+% mutual non-tail recursion with none pragma.
+:- pragma require_tail_recursion(odd3/1, [none]).
+odd3(N) =
+ ( if N = 0 then
+ no
+ else
+ bool.not(even3(N))
+ ).
+
+% mutual non-tail recursion with self pragma
+even4(N) =
+ ( if N = 0 then
+ yes
+ else
+ odd4(N - 1)
+ ).
+
+:- pragma require_tail_recursion(odd4/1, [self_recursion_only]).
+odd4(N) =
+ ( if N = 0 then
+ no
+ else
+ bool.not(even4(N))
+ ).
+
--
2.7.4
More information about the reviews
mailing list