[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