[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