[m-rev.] for review: implement --warn-suspicious-recursion

[Peter Wang]

On Wed, 01 May 2019 12:13:49 +1000 (AEST), "Zoltan Somogyi" <zoltan.somogyi at runbox.com> wrote:
> Implement warnings for suspicious recursion.
> 

> diff --git a/compiler/simplify_goal_call.m b/compiler/simplify_goal_call.m
> index 85aade0..cd44674 100644
> --- a/compiler/simplify_goal_call.m
> +++ b/compiler/simplify_goal_call.m
...
> +input_args_are_suspicious(_, _, _, _, [], [], _,
> +        !AllInputsEqv, !AllInputsEqvOrSvar, !HeadBaseNames, !ArgBaseNames).
> +input_args_are_suspicious(ModuleInfo, CommonInfo, VarSet, VarNameRemap,
> +        [HeadVar | HeadVars], [ArgVar | ArgVars], [Mode | Modes],
> +        !AllInputsEqv, !AllInputsEqvOrSvar, !HeadBaseNames, !ArgBaseNames) :-
> +    InitialInst = mode_get_initial_inst(ModuleInfo, Mode),
> +    ( if inst_is_bound(ModuleInfo, InitialInst) then
> +        % This is an input argument.
> +
> +        % Fail (and thus don't generate a warning) if an input argument's
> +        % initial inst is not ground, which means it may contain `any' insts.
> +        % This is because the argument might have become more constrained
> +        % before the recursive call, in which case the recursion might
> +        % eventually terminate.
>          %
> -:- pred input_args_are_equiv(module_info::in, common_info::in,
> -    list(prog_var)::in, list(prog_var)::in, list(mer_mode)::in) is semidet.
> +        % XXX This check will only allow warnings if the inputs are all fully
> +        % ground; i.e. we won't warn in the case of partially instantiated
> +        % insts such as list_skel(free). Still, it is better to miss warnings
> +        % in that rare and unsupported case rather than to issue spurious
> +        % warnings in cases involving `any' insts.
> +        inst_is_ground(ModuleInfo, InitialInst),
>  
> -input_args_are_equiv(_, _, [], [], _).
> -input_args_are_equiv(ModuleInfo, CommonInfo,
> -        [ArgVar | ArgVars], [HeadVar | HeadVars], [Mode | Modes]) :-
> -    ( if mode_is_input(ModuleInfo, Mode) then
> +        ( if
>              common_vars_are_equivalent(CommonInfo, ArgVar, HeadVar)
> +        then
> +            true
> +        else
> +            % If the input argument is not the same in the call as in
> +            % the clause head (which it won't if we get here), then fail

it won't be

> +            % (and thus don't generate a warning) if the input argument
> +            % is unique. This is because in that case, the recursion may be
> +            % terminated by changes in the state *outside* the view
> +            % of the compiler.
> +            inst_is_not_partly_unique(ModuleInfo, InitialInst),
> +
> +            !:AllInputsEqv = not_all_inputs_eqv,
> +            % If either the argument or the head variable is unnamed, then
> +            % we have reason to believe the recursive call is suspicious,
> +            % so we fail.

no reason?

> +            head_var_name(VarSet, VarNameRemap, HeadVar, HeadName),
> +            varset.search_name(VarSet, ArgVar, ArgName),
> +            delete_any_numeric_suffix(HeadName, HeadBaseName),
> +            delete_any_numeric_suffix(ArgName, ArgBaseName),
> +            ( if HeadBaseName = ArgBaseName then
> +                ( if string.prefix(HeadBaseName, "STATE_VARIABLE") then
> +                    true
> +                else
> +                    !:AllInputsEqvOrSvar = not_all_inputs_eqv_or_svar
> +                )
>              else
> +                !:AllInputsEqvOrSvar = not_all_inputs_eqv_or_svar,
> +                set.insert(HeadBaseName, !HeadBaseNames),
> +                set.insert(ArgBaseName, !ArgBaseNames)
> +            )
> +        )
> +    else
> +        % This is not an input argument.
>          true
>      ),
> -    input_args_are_equiv(ModuleInfo, CommonInfo, ArgVars, HeadVars, Modes).
> +    input_args_are_suspicious(ModuleInfo, CommonInfo, VarSet, VarNameRemap,
> +        HeadVars, ArgVars, Modes,
> +        !AllInputsEqv, !AllInputsEqvOrSvar, !HeadBaseNames, !ArgBaseNames).
> +

> +:- pred delete_any_numeric_suffix(string::in, string::out) is det.
> +
> +delete_any_numeric_suffix(Str, StrNoSuffix) :-
> +    ( if has_numeric_suffix(Str, StrNoSuffixPrime) then
> +        StrNoSuffix = StrNoSuffixPrime
> +    else
> +        StrNoSuffix = Str
> +    ).

It would be straightforward to avoid converting the string to a list and
back. I can do that later if you wish.

> diff --git a/library/string.m b/library/string.m
> index 251dfed..ad6bbf7 100644
> --- a/library/string.m
> +++ b/library/string.m
> @@ -115,6 +115,7 @@
>  
>      % Convert the string to a list of characters (code points).
>      % Throws an exception if the list of characters contains a null character.
> +    % XXX I (zs) see no code that would throw this exception.
>      %
>      % NOTE: In the future we may also throw an exception if the list contains
>      % a surrogate code point.

That happens in the reverse mode of to_char_list, i.e. from_char_list.

> @@ -143,6 +144,18 @@
>      %
>  :- pred semidet_from_char_list(list(char)::in, string::uo) is semidet.
>  
> +    % Convert the string to a list of characters (code points) in reverse order.
> +    % Throws an exception if the list of characters contains a null character.
> +    % XXX I (zs) see no code that would throw this exception.

It would be thrown by from_rev_char_list.

> +    %
> +    % NOTE: In the future we may also throw an exception if the list contains
> +    % a surrogate code point.
> +    %
> +:- func to_rev_char_list(string) = list(char).
> +:- pred to_rev_char_list(string, list(char)).
> +:- mode to_rev_char_list(in, out) is det.
> +:- mode to_rev_char_list(uo, in) is det.
> +
>      % Same as from_char_list, except that it reverses the order
>      % of the characters.
>      % Throws an exception if the list of characters contains a null character.

>  %---------------------%
>  
> +to_rev_char_list(S) = Cs :-
> +    to_rev_char_list(S, Cs).
> +
> +:- pragma promise_equivalent_clauses(to_rev_char_list/2).
> +
> +to_rev_char_list(Str::in, CharList::out) :-
> +    do_to_rev_char_list(Str, CharList).
> +to_rev_char_list(Str::uo, CharList::in) :-
> +    from_rev_char_list(CharList, Str).
> +
> +:- pred do_to_rev_char_list(string::in, list(char)::out) is det.
> +
> +:- pragma foreign_proc("C",
> +    do_to_rev_char_list(Str::in, CharList::out),
> +    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
> +        does_not_affect_liveness, no_sharing],
> +"{
> +    MR_Integer len = strlen(Str);

Delete len.

> +    MR_Integer pos;
> +    int c;
> +
> +    CharList = MR_list_empty_msg(MR_ALLOC_ID);
> +    pos = 0;
> +    for (;;) {
> +        c = MR_utf8_get_next(Str, &pos);
> +        if (c <= 0) {
> +            break;
> +        }
> +        CharList = MR_char_list_cons_msg((MR_UnsignedChar) c, CharList,
> +            MR_ALLOC_ID);
> +    }
> +}").
> +
> +do_to_rev_char_list(Str, RevCharList) :-
> +    do_to_char_list(Str, CharList),
> +    list.reverse(CharList, RevCharList).

do_to_char_list can be written efficiently in Mercury using unsafe_index_next.
I can do that later if you wish.

> diff --git a/tests/warnings/suspicious_recursion.m b/tests/warnings/suspicious_recursion.m
> index e69de29..e0bd09d 100644
> --- a/tests/warnings/suspicious_recursion.m
> +++ b/tests/warnings/suspicious_recursion.m
> @@ -0,0 +1,42 @@
> +%---------------------------------------------------------------------------%
> +% vim: ts=4 sw=4 et ft=mercury
> +%---------------------------------------------------------------------------%
> +%
> +% Test the warningsfor suspicious recursion.

Missing space.

The rest looks fine.

Peter