[m-rev.] for review: Enable non-tail-call warnings for mutually-recursive code
Paul Bone
paul at bone.id.au
Tue Mar 28 14:28:53 AEDT 2017
For review by Zoltan.
---
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 | 29 +++-
compiler/handle_options.m | 18 +-
compiler/mark_tail_calls.m | 288 ++++++++++++++++++++-----------
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, 829 insertions(+), 150 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 da4ec51..9a25231 100644
--- a/compiler/dependency_graph.m
+++ b/compiler/dependency_graph.m
@@ -80,18 +80,27 @@
:- 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_arcs :: dependency_arcs(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, Arcs) = DepInfo :-
@@ -99,7 +108,18 @@ make_dependency_info(Graph, Arcs) = DepInfo :-
% of their children. This is a top down order.
digraph.atsort(Graph, TopDownOrdering),
list.reverse(TopDownOrdering, BottomUpOrdering),
- DepInfo = dependency_info(Graph, Arcs, BottomUpOrdering).
+ LazySCCMap = delay(((func) = SCCMap :-
+ foldl(make_scc_map, BottomUpOrdering, init, SCCMap)
+ )),
+ DepInfo = dependency_info(Graph, Arcs, BottomUpOrdering, LazySCCMap).
+
+:- 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).
%-----------------------------------------------------------------------%
@@ -113,4 +133,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 36d025f..e1c1669 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.
%---------------------------------------------------------------------------%
@@ -106,6 +107,17 @@
prog_context::in, warning_or_error::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):
%
@@ -127,6 +139,7 @@
:- import_module check_hlds.type_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.vartypes.
+:- import_module libs.dependency_graph.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.
@@ -179,7 +192,12 @@ mark_tail_rec_calls_in_scc(AddGoalFeature, WarnNonTailRecOpt, SCC,
pred_info_get_proc_table(PredInfo0, ProcTable0),
map.lookup(ProcTable0, ProcId, ProcInfo0),
- do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRecOpt,
+ proc_info_get_maybe_require_tailrec_info(ProcInfo0,
+ MaybeRequireTailRec),
+ WarnNonTailRec = maybe_warn_non_tail_rec_call(MaybeRequireTailRec,
+ WarnNonTailRecOpt),
+
+ do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRec,
!.ModuleInfo, SCC, PredId, ProcId, PredInfo0, ProcInfo0, ProcInfo,
_WasProcChanged, [], _Specs),
@@ -208,16 +226,46 @@ mark_tail_rec_call_options_for_llds_code_gen(Globals, AddGoalFeature,
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),
+ WarnNonTailRecSelfAndMutBool),
(
- WarnNonTailRecBool = yes,
- WarnNonTailRecOpt = warn_non_tail_rec_calls_opt
+ WarnNonTailRecSelfAndMutBool = yes,
+ WarnNonTailRecOpt = warn_non_tail_rec_calls_self_and_mut_opt
;
- WarnNonTailRecBool = no,
- WarnNonTailRecOpt = do_not_warn_non_tail_rec_calls_opt
+ WarnNonTailRecSelfAndMutBool = no,
+ (
+ WarnNonTailRecSelfBool = yes,
+ WarnNonTailRecOpt = warn_non_tail_rec_calls_self_opt
+ ;
+ WarnNonTailRecSelfBool = no,
+ WarnNonTailRecOpt = do_not_warn_non_tail_rec_calls_opt
+ )
).
+ % maybe_warn_non_tail_rec_call(MaybeRequireTailrecPragma,
+ % WarnNonTailRecOpt) = 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),
+ warn_non_tail_rec_calls_opt) = maybe_warn_non_tail_rec_call.
+
+maybe_warn_non_tail_rec_call(no, do_not_warn_non_tail_rec_calls_opt) =
+ do_not_warn_non_tail_rec_calls.
+maybe_warn_non_tail_rec_call(no, warn_non_tail_rec_calls_self_opt) =
+ warn_non_tail_rec_calls(we_warning, only_self_recursion_must_be_tail).
+maybe_warn_non_tail_rec_call(no, warn_non_tail_rec_calls_self_and_mut_opt) =
+ 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).
+
%---------------------------------------------------------------------------%
mark_tail_rec_calls_in_pred_for_llds_code_gen(PredId, !ModuleInfo,
@@ -245,11 +293,18 @@ mark_tail_rec_calls_in_procs_for_llds_code_gen(AddGoalFeature,
WarnNonTailRecOpt, ModuleInfo, PredId, [ProcId | ProcIds],
!PredInfo, !Specs) :-
pred_info_proc_info(!.PredInfo, ProcId, ProcInfo0),
- % For LLDS code generation, we don't need information about mutual
- % recursive calls, so what we pass as the SCC of each procedure
- % does not matter.
- set.init(SCC),
- do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRecOpt,
+ module_info_get_maybe_dependency_info(ModuleInfo, MaybeDepInfo),
+ (
+ MaybeDepInfo = yes(DepInfo),
+ SCC = dependency_info_get_this_scc(DepInfo, proc(PredId, ProcId))
+ ;
+ MaybeDepInfo = no,
+ unexpected($file, $pred, "Expected dependency information")
+ ),
+ proc_info_get_maybe_require_tailrec_info(ProcInfo0, MaybeRequireTailRec),
+ WarnNonTailRec = maybe_warn_non_tail_rec_call(MaybeRequireTailRec,
+ WarnNonTailRecOpt),
+ do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRec,
ModuleInfo, SCC, PredId, ProcId, !.PredInfo, ProcInfo0, ProcInfo,
WasProcChanged, !Specs),
(
@@ -268,14 +323,22 @@ mark_tail_rec_calls_in_proc_for_llds_code_gen(ModuleInfo, PredId, ProcId,
module_info_get_globals(ModuleInfo, Globals),
mark_tail_rec_call_options_for_llds_code_gen(Globals, AddGoalFeature,
WarnNonTailRecOpt),
- % For LLDS code generation, we don't need information about mutual
- % recursive calls, so what we pass as the SCC of each procedure
- % does not matter.
- set.init(SCC),
+ module_info_get_maybe_dependency_info(ModuleInfo, MaybeDepInfo),
+ (
+ MaybeDepInfo = yes(DepInfo),
+ SCC = dependency_info_get_this_scc(DepInfo, proc(PredId, ProcId))
+ ;
+ MaybeDepInfo = no,
+ unexpected($file, $pred, "Expected dependency information")
+ ),
+ proc_info_get_maybe_require_tailrec_info(!.ProcInfo,
+ MaybeRequireTailRec),
+ WarnNonTailRec = maybe_warn_non_tail_rec_call(MaybeRequireTailRec,
+ WarnNonTailRecOpt),
% mark_tail_rec_call_options_for_llds_code_gen is called only when we are
% doing proc-by-proc, as opposed to phase-by-phase, code generation.
% For this, we don't need to put the new proc_info back into its pred_info.
- do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRecOpt,
+ do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRec,
ModuleInfo, SCC, PredId, ProcId, PredInfo, !ProcInfo,
_WasProcChanged, !Specs).
@@ -289,18 +352,19 @@ mark_tail_rec_calls_in_proc_for_llds_code_gen(ModuleInfo, PredId, ProcId,
:- type warn_non_tail_rec_calls_opt
---> do_not_warn_non_tail_rec_calls_opt
- ; warn_non_tail_rec_calls_opt.
+ ; warn_non_tail_rec_calls_self_opt
+ ; warn_non_tail_rec_calls_self_and_mut_opt.
:- type was_proc_changed
---> proc_was_not_changed
; proc_may_have_been_changed.
:- pred do_mark_tail_rec_calls_in_proc(add_goal_feature::in,
- warn_non_tail_rec_calls_opt::in, module_info::in, set(pred_proc_id)::in,
+ maybe_warn_non_tail_rec_call::in, module_info::in, set(pred_proc_id)::in,
pred_id::in, proc_id::in, pred_info::in, proc_info::in, proc_info::out,
was_proc_changed::out, list(error_spec)::in, list(error_spec)::out) is det.
-do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRecOpt, ModuleInfo,
+do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRec, ModuleInfo,
SCC, PredId, ProcId, PredInfo, !ProcInfo, WasProcChanged, !Specs) :-
proc_info_interface_determinism(!.ProcInfo, Detism),
determinism_components(Detism, _CanFail, SolnCount),
@@ -319,22 +383,11 @@ do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRecOpt, ModuleInfo,
; SolnCount = at_most_many_cc
),
- proc_info_get_maybe_require_tailrec_info(!.ProcInfo,
- MaybeRequireTailRec),
-
% 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
WasProcChanged = proc_was_not_changed
else
@@ -346,35 +399,6 @@ do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRecOpt, ModuleInfo,
find_maybe_output_args(ModuleInfo, Types, Modes, HeadVars,
Outputs),
- (
- 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)
- )
- ;
- MaybeRequireTailRec = yes(RequireTailRecInfo),
- (
- RequireTailRecInfo = enable_tailrec_warnings(WarnOrError,
- RecType, RequireTailRecContext),
- WarnNonTailRec = warn_non_tail_rec_calls(WarnOrError,
- RecType)
- ;
- RequireTailRecInfo = suppress_tailrec_warnings(
- RequireTailRecContext),
- WarnNonTailRec = do_not_warn_non_tail_rec_calls
- ),
- MaybeRequireTailRecContext = yes(RequireTailRecContext)
- ),
-
Info0 = mark_tail_rec_calls_info(AddGoalFeature, ModuleInfo,
PredInfo, proc(PredId, ProcId), SCC, VarTypes, WarnNonTailRec,
not_found_any_rec_calls, not_found_self_tail_rec_calls, []),
@@ -386,10 +410,18 @@ do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRecOpt, ModuleInfo,
proc_info_set_goal(Goal, !ProcInfo),
(
FoundAnyRecCalls = not_found_any_rec_calls,
+ proc_info_get_maybe_require_tailrec_info(!.ProcInfo,
+ MaybeRequireTailRec),
(
- MaybeRequireTailRecContext = no
+ MaybeRequireTailRec = no
;
- MaybeRequireTailRecContext = yes(Context),
+ MaybeRequireTailRec = yes(RequireTailRecInfo),
+ (
+ RequireTailRecInfo = enable_tailrec_warnings(_, _,
+ Context)
+ ;
+ RequireTailRecInfo = 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),
@@ -506,6 +538,10 @@ find_maybe_output_args_2(ModuleInfo, [Type | Types], [Mode | Modes],
---> not_found_any_rec_calls
; found_any_rec_calls.
+:- type call_is_self_or_mutual_rec
+ ---> call_is_self_rec
+ ; call_is_mutual_rec.
+
:- type mark_tail_rec_calls_info
---> mark_tail_rec_calls_info(
mtc_add_feature :: add_goal_feature,
@@ -579,6 +615,8 @@ mark_tail_rec_calls_in_goal(Goal0, Goal, AtTail0, AtTail, !Info) :-
(
( GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
; GoalExpr0 = generic_call(_, _, _, _, _)
+ % Note: we don't give tailcall warnings for negated goals, maybe we
+ % should?
; GoalExpr0 = negation(_)
),
Goal = Goal0,
@@ -659,15 +697,23 @@ mark_tail_rec_calls_in_goal(Goal0, Goal, AtTail0, AtTail, !Info) :-
)
;
GoalExpr0 = plain_call(CalleePredId, CalleeProcId, Args, Builtin,
- _UnifyContext, SymName),
+ _UnifyContext, _SymName),
CalleePredProcId = proc(CalleePredId, CalleeProcId),
CurPredProcId = !.Info ^ mtc_cur_proc,
CurSCCPredProcIds = !.Info ^ mtc_cur_scc,
( if
- ( CalleePredProcId = CurPredProcId
- ; set.member(CalleePredProcId, CurSCCPredProcIds)
- ),
- Builtin = not_builtin
+ Builtin = not_builtin,
+ ( if
+ CalleePredProcId = CurPredProcId
+ then
+ SelfRecursion = call_is_self_rec
+ else if
+ set.member(CalleePredProcId, CurSCCPredProcIds)
+ then
+ SelfRecursion = call_is_mutual_rec
+ else
+ false
+ )
then
!Info ^ mtc_any_rec_calls := found_any_rec_calls,
( if
@@ -680,13 +726,15 @@ mark_tail_rec_calls_in_goal(Goal0, Goal, AtTail0, AtTail, !Info) :-
Goal = Goal0
;
AddFeature = add_goal_feature_self_for_debug,
- ( if CalleePredProcId = CurPredProcId then
+ (
+ SelfRecursion = call_is_self_rec,
!Info ^ mtc_self_tail_rec_calls :=
found_self_tail_rec_calls,
goal_info_add_feature(feature_debug_self_tail_rec_call,
GoalInfo0, GoalInfo),
Goal = hlds_goal(GoalExpr0, GoalInfo)
- else
+ ;
+ SelfRecursion = call_is_mutual_rec,
Goal = Goal0
)
;
@@ -697,10 +745,10 @@ mark_tail_rec_calls_in_goal(Goal0, Goal, AtTail0, AtTail, !Info) :-
)
else
Goal = Goal0,
- Arity = length(Args),
Context = goal_info_get_context(GoalInfo0),
- maybe_report_nontail_recursive_call(SymName, Arity,
- CalleeProcId, Context, AtTail0, !Info)
+ CurPredProcId = proc(_, CurProcId),
+ maybe_report_nontail_recursive_call(CurProcId, CalleePredId,
+ SelfRecursion, Context, AtTail0, !Info)
),
AtTail = not_at_tail(have_seen_later_rec_call)
else
@@ -868,12 +916,12 @@ not_at_tail(Before, After) :-
%---------------------------------------------------------------------------%
-:- pred maybe_report_nontail_recursive_call(sym_name::in, arity::in,
- proc_id::in, prog_context::in, at_tail::in,
+:- pred maybe_report_nontail_recursive_call(proc_id::in, pred_id::in,
+ call_is_self_or_mutual_rec::in, prog_context::in, at_tail::in,
mark_tail_rec_calls_info::in, mark_tail_rec_calls_info::out) is det.
-maybe_report_nontail_recursive_call(SymName, Arity, ProcId, Context, AtTail,
- !Info) :-
+maybe_report_nontail_recursive_call(CallerProcId, CalleePredId,
+ SelfOrMutRec, Context, AtTail, !Info) :-
(
( AtTail = at_tail(_)
; AtTail = not_at_tail(have_not_seen_later_rec_call)
@@ -883,11 +931,21 @@ maybe_report_nontail_recursive_call(SymName, Arity, ProcId, Context, AtTail,
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(SymName, Arity, ProcId, Context,
- WarnOrError, !Info)
+ 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(CallerProcId, CalleePredId,
+ SelfOrMutRec, WarnOrError, Context, !Info)
+ else
+ true
+ )
)
;
AtTail = not_at_tail(have_seen_later_rec_call)
@@ -898,43 +956,71 @@ maybe_report_nontail_recursive_call(SymName, Arity, ProcId, Context, AtTail,
% to add support for it with another option in the near future.
).
-:- pred report_nontail_recursive_call(sym_name::in, arity::in, proc_id::in,
- prog_context::in, warning_or_error::in,
+:- pred report_nontail_recursive_call(proc_id::in, pred_id::in,
+ call_is_self_or_mutual_rec::in, warning_or_error::in, prog_context::in,
mark_tail_rec_calls_info::in, mark_tail_rec_calls_info::out) is det.
-report_nontail_recursive_call(SymName, Arity, ProcId, Context, WarnOrError,
- !Info) :-
- PredInfo = !.Info ^ mtc_pred_info,
- PredOrFunc = pred_info_is_pred_or_func(PredInfo),
- UnqualName = unqualified(unqualify_name(SymName)),
- SimpleCallId = simple_call_id(PredOrFunc, UnqualName, Arity),
+report_nontail_recursive_call(CallerProcId,
+ CalleePredId, SelfOrMutRec, WarnOrError, Context, !Info) :-
+ CallerPredInfo = !.Info ^ mtc_pred_info,
+ 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),
Specs0 = !.Info ^ mtc_error_specs,
- add_message_for_nontail_recursive_call(SimpleCallId, ProcId, Context,
- WarnOrError, Specs0, Specs),
+ (
+ SelfOrMutRec = call_is_self_rec,
+ add_message_for_nontail_recursive_call(CallerId, CallerProcId,
+ Context, WarnOrError, Specs0, 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, Specs0, Specs)
+ ),
!Info ^ mtc_error_specs := Specs.
%---------------------------------------------------------------------------%
add_message_for_nontail_recursive_call(SimpleCallId, ProcId, Context,
WarnOrError, !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 36c4942..6ec6f1e 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 b305e8d..932c4d4 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 b8c0343..f730998 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
@@ -1162,6 +1164,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),
@@ -2053,6 +2056,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).
@@ -3149,6 +3154,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),
@@ -3180,6 +3186,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),
@@ -3761,6 +3768,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 8db0a0b..f8831ee 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