[m-rev.] for review: Improve warnings generated by --warn-non-tail-recursive

[Paul Bone]

For review by anyone.

This the the same patch as I posted a moment ago, but with a much better log
message.  Please disregard my earlier change.

---

Do not warn about non tail recursive calls that are obviously not tail
recursive.  For example:

    qsort([], []).
    qsort([Pivot | T], Left ++ [Pivot | Right]) :-
        partition(Pivot, T, [], Left0, [], Right0),
        qsort(Left0, Left),
        qsort(Right0, Right).

Warn only about the second call to qsort, the first is obviously not tail
recursive.  The second call is not tail recursive because of the call to ++ in
the clause head.

compiler/ml_tailcall.m:
    As we traverse the MLDS backwards, if we encounter a recursive call
    (whether it's a tailcall or not) don't create a warning for subsequent
    tailcalls.
---
 compiler/ml_tailcall.m | 77 +++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 58 insertions(+), 19 deletions(-)

diff --git a/compiler/ml_tailcall.m b/compiler/ml_tailcall.m
index 6dc1606..16caa37 100644
--- a/compiler/ml_tailcall.m
+++ b/compiler/ml_tailcall.m
@@ -105,11 +105,36 @@ ml_mark_tailcalls(Globals, !MLDS, !IO) :-
 
 %-----------------------------------------------------------------------------%
 
+    % The algorithm works by walking backwards through each function in the
+    % MLDS.  It tracks (via at_tail) whether the current position in the
+    % function's body is a tail position.
+
     % The `at_tail' type indicates whether or not a subgoal is at a tail
     % position, i.e. is followed by a return statement or the end of the
     % function, and if so, specifies the return values (if any) in the return
     % statement.
-:- type at_tail == maybe(list(mlds_rval)).
+:- type at_tail
+    --->        yes(list(mlds_rval))
+    ;           no(seen_reccall).
+
+    % seen_retcall is used to track whether a recursive call has been seen.
+    % If it has we don't create warnings for further recursive calls.  We
+    % continue to walk through the function incase we encounter a return
+    % statement and therefore find more tailcalls.
+    %
+:- type seen_reccall
+    --->        seen_reccall
+    ;           have_not_seen_reccall.
+
+:- pred seen_reccall(at_tail::in, seen_reccall::out) is det.
+
+seen_reccall(yes(_), have_not_seen_reccall).
+seen_reccall(no(SeenReccall), SeenReccall).
+
+:- pred not_at_tail(at_tail::in, at_tail::out) is det.
+
+not_at_tail(yes(_), no(have_not_seen_reccall)).
+not_at_tail(no(SeenReccall), no(SeenReccall)).
 
     % The `locals' type contains a list of local definitions
     % which are in scope.
@@ -170,7 +195,7 @@ mark_tailcalls_in_defn(ModuleName, Defn0, Defn, Warnings) :-
             AtTail = yes([])
         ;
             RetTypes = [_ | _],
-            AtTail = no
+            AtTail = no(have_not_seen_reccall)
         ),
         TCallInfo = tailcall_info(ModuleName, Name, Locals),
         mark_tailcalls_in_function_body(TCallInfo, AtTail, Warnings,
@@ -269,10 +294,11 @@ mark_tailcalls_in_stmt(TCallInfo, Context, Warnings, AtTailAfter,
         % The statement in the body of a while loop is never in a tail
         % position.
         Stmt0 = ml_stmt_while(Kind, Rval, Statement0),
-        mark_tailcalls_in_statement(TCallInfo, Warnings, no, _,
-            Statement0, Statement),
+        seen_reccall(AtTailAfter, SeenReccallAfter),
+        mark_tailcalls_in_statement(TCallInfo, Warnings,
+            no(SeenReccallAfter), AtTailBefore0, Statement0, Statement),
         % Neither is any statement before the loop.
-        AtTailBefore = no,
+        not_at_tail(AtTailBefore0, AtTailBefore),
         Stmt = ml_stmt_while(Kind, Rval, Statement)
     ;
         % Both the `then' and the `else' parts of an if-then-else are in a
@@ -283,7 +309,9 @@ mark_tailcalls_in_stmt(TCallInfo, Context, Warnings, AtTailAfter,
         mark_tailcalls_in_maybe_statement(TCallInfo, ElseWarnings,
             AtTailAfter, _, MaybeElse0, MaybeElse),
         Warnings = ThenWarnings ++ ElseWarnings,
-        AtTailBefore = no,
+        % This is conservative, if improved it may remove some false
+        % positive tailcall warnings.
+        AtTailBefore = no(have_not_seen_reccall),
         Stmt = ml_stmt_if_then_else(Cond, Then, MaybeElse)
     ;
         % All of the cases of a switch (including the default) are in a
@@ -294,7 +322,9 @@ mark_tailcalls_in_stmt(TCallInfo, Context, Warnings, AtTailAfter,
         mark_tailcalls_in_default(TCallInfo, AtTailAfter, DefaultWarnings,
             Default0, Default),
         Warnings = CasesWarnings ++ DefaultWarnings,
-        AtTailBefore = no,
+        % This is conservative, if improved it may remove some false
+        % positive tailcall warnings.
+        AtTailBefore = no(have_not_seen_reccall),
         Stmt = ml_stmt_switch(Type, Val, Range, Cases, Default)
     ;
         Stmt0 = ml_stmt_call(_, _, _, _, _, _),
@@ -310,7 +340,7 @@ mark_tailcalls_in_stmt(TCallInfo, Context, Warnings, AtTailAfter,
         mark_tailcalls_in_statement(TCallInfo, HandlerWarnings, AtTailAfter, _,
             Handler0, Handler),
         Warnings = TryWarnings ++ HandlerWarnings,
-        AtTailBefore = no,
+        AtTailBefore = no(have_not_seen_reccall),
         Stmt = ml_stmt_try_commit(Ref, Statement, Handler)
     ;
         % XXX: Maybe not true for some of these.
@@ -321,7 +351,7 @@ mark_tailcalls_in_stmt(TCallInfo, Context, Warnings, AtTailAfter,
         ; Stmt0 = ml_stmt_atomic(_)
         ),
         Warnings = [],
-        AtTailBefore = no,
+        not_at_tail(AtTailAfter, AtTailBefore),
         Stmt = Stmt0
     ;
         Stmt0 = ml_stmt_return(ReturnVals),
@@ -371,24 +401,33 @@ mark_tailcalls_in_stmt_call(TCallInfo, Context, Warnings,
             % Mark this call as a tail call.
             Stmt = ml_stmt_call(Sig, Func, Obj, Args, ReturnLvals,
                 tail_call),
-            Warnings = []
+            Warnings = [],
+            AtTailBefore = no(seen_reccall)
         else
-            Stmt = Stmt0,
+            seen_reccall(AtTailAfter, SeenReccall),
             (
-                CodeAddr = code_addr_proc(QualProcLabel, _Sig)
+                SeenReccall = seen_reccall,
+                Warnings = []
             ;
-                CodeAddr = code_addr_internal(QualProcLabel, _SeqNum, _Sig)
+                SeenReccall = have_not_seen_reccall,
+                (
+                    CodeAddr = code_addr_proc(QualProcLabel, _Sig)
+                ;
+                    CodeAddr = code_addr_internal(QualProcLabel, _SeqNum, _Sig)
+                ),
+                QualProcLabel = qual(_, _, ProcLabel),
+                ProcLabel = mlds_proc_label(PredLabel, ProcId),
+                Warnings = [tailcall_warning(PredLabel, ProcId, Context)]
             ),
-            QualProcLabel = qual(_, _, ProcLabel),
-            ProcLabel = mlds_proc_label(PredLabel, ProcId),
-            Warnings = [tailcall_warning(PredLabel, ProcId, Context)]
+            Stmt = Stmt0,
+            AtTailBefore = no(seen_reccall)
         )
     else
         % Leave this call unchanged.
         Stmt = Stmt0,
-        Warnings = []
-    ),
-    AtTailBefore = no.
+        Warnings = [],
+        not_at_tail(AtTailAfter, AtTailBefore)
+    ).
 
 :- pred mark_tailcalls_in_cases(tailcall_info::in, at_tail::in,
     list(tailcall_warning)::out,
-- 
2.6.1