Warnings collection

src/lib/warnings.pl

@@ -0,0 +1,131 @@
+:- module(warnings, []).
+
+:- use_module(library(format)).
+:- use_module(library(pio)).
+:- use_module(library(lists)).
+
+warn(Format, Vars) :-
+    warn(user_error, Format, Vars).
+warn(Stream, Format, Vars) :-
+    prolog_load_context(file, File),
+    prolog_load_context(term_position, position_and_lines_read(_,Line)),
+    phrase_to_stream(
+        (
+            "% Warning: ", format_(Format,Vars), format_(" at line ~d of ~a~n",[Line,File])
+        ),
+        Stream
+    ).
+
+% FIXME: Replace with predicate_property(_, built_in) when #2600 will be ready
+builtin((_;_)).
+builtin((_,_)).
+builtin((_->_)).
+builtin(\+_).
+
+unsound_type_test(atom(_)).
+unsound_type_test(atomic(_)).
+unsound_type_test(integer(_)).
+
+:- meta_predicate maplistdif(3, ?, ?, ?).
+
+maplistdif(_, [], [], L-L).
+maplistdif(G__2, [H1|T1], [H2|T2], L0-LX) :-
+    call(G__2, H1, H2, L0-L1),
+    maplistdif(G__2, T1, T2, L1-LX).
+
+%% arithmetic_expansion(+Type, ?Term, -ExpandedTerm, -Unifier-Rest).
+%
+% `ExpandedTerm` is the minimal generalization of `Term` which makes a valid
+% arithmetic relation (`Type = rela`) or functional expression (`Type = func`).
+% That means if all unifications from `Unifier` hold then `ExpandedTerm == Term`.
+% `Unifier-Rest` form together a list difference. `Term` is traversed from left
+% to right, depth-first. Given an invalid arithmetic term, as seen in the
+% example below, `E` becomes valid arithmetic term, `L` - unifier:
+%
+% ```
+% ?- arithmetic_expansion(rela, X is sqrt([]+Y*foo(e/2)), E, L-[]).
+%    E = (X is sqrt(_A+Y*_B)), L = [[]=_A,foo(e/2)=_B].
+% ```
+%
+% NOTE: Order of clauses is important for correctness.
+arithmetic_expansion(func, T, T, L-L) :-
+    (var(T); number(T)), !.
+arithmetic_expansion(Set, T, R, LD) :-
+    functor(T, F, A),
+    arithmetic_term(Set, A, Fs),
+    member(F, Fs), !,
+    functor(R, F, A),
+    T =.. [F|Ts],
+    R =.. [F|Rs],
+    maplistdif(arithmetic_expansion(func), Ts, Rs, LD).
+arithmetic_expansion(func, T, R, [T=R|L]-L).
+
+arithmetic_term(func, 0, [e,pi,epsilon]).
+arithmetic_term(func, 1, [+,-,\,sqrt,exp,log,sin,cos,tan,asin,acos,atan,sign,abs,round,ceiling,floor,truncate,float,float_integer_part,float_fractional_part]).
+arithmetic_term(func, 2, [+,-,/,*,**,^,/\,\/,xor,div,//,rdiv,<<,>>,mod,rem,max,min,gcd,atan2]).
+arithmetic_term(rela, 2, [is,>,<,>=,=<,=:=,=\=]).
+
+% Warn about builtin predicates re-definition. It can happen by mistake for
+% example:
+%     x :- a. b, c.
+%
+term_warning(term, Term, "(~q) attempts to re-define ~w", [Term,F/A]) :-
+    builtin(Term),
+    functor(Term, F, A).
+
+% Warn about unsound type test predicates and suggest using library(si).
+% Observe that following queries yield different results:
+%
+%     ?- X=1, integer(X).
+%        true.
+%     ?- integer(X), X=1.
+%        false.
+%
+term_warning(goal, Term, "~q is a constant source of wrong results, use ~a_si/1 from library(si)", [F/1,F]) :-
+    unsound_type_test(Term),
+    functor(Term, F, 1).
+
+% Warn when more than 2 negations are nested. Double negation has legit
+% use-case, but I don't think that more nested negations are ever useful.
+%
+term_warning(goal, \+ \+ \+_, "Nested negations can be reduced", []).
+
+% Warn about invalid arithmetic relation and show all incorrect sub-expression
+term_warning(goal, Term, "Arithmetic expression ~w contains invalid terms ~q", [R, [H|T]]) :-
+    arithmetic_expansion(rela, Term, R, [H|T]-[]).
+
+%% expansion_hook(?Goal, +MetaVarSpecs).
+%
+% TLDR: Warn if currently expanded predicate calls one of its arguments, but it
+% isn't declared as a meta-predicate.
+%
+% This hook is invoked just before goal expansion. `Goal` is an unexpanded
+% goal, same as first argument of goal_expansion/2. `MetaVarSpecs` is a list of
+% pairs of callable variables together with their qualifiers extracted from
+% meta-predicate declaration of currently processed clause. In particular if it
+% is an empty list then current head doesn't have any such variables: it is
+% either not declared as a meta-predicate or its meta-predicate specification
+% doesn't specify any callable variables (like `p(?)`).
+%
+% TODO: Be smarter and detect wrong meta-predicate declarations.
+%
+expansion_hook(Goal, []) :-
+    % Detect if calling Goal leads to calling a free variable
+    (   var(Goal) ->
+        true
+    ;   % Goal is a meta-predicate that calls free variable
+        loader:module_expanded_head_variables(Goal, [_|_])
+    ),
+    warn("Meta-predicate detected, but no qualified variables found", []).
+
+expansion_warning(ExpansionKind, Term) :-
+    nonvar(Term),
+    once(term_warning(ExpansionKind, Term, Msg, Vars)),
+    warn(Msg, Vars),
+    false.
+
+user:term_expansion(Term, _) :-
+    expansion_warning(term, Term).
+
+user:goal_expansion(Term, _) :-
+    expansion_warning(goal, Term).

src/loader.pl

@@ -848,6 +848,10 @@
 :- non_counted_backtracking expand_goal/5.
 
 expand_goal(UnexpandedGoals, Module, ExpandedGoals, HeadVars, TGs) :-
+    (  catch(warnings:expansion_hook(UnexpandedGoals, HeadVars), _, true) ->
+       true
+    ;  true
+    ),
     (  var(UnexpandedGoals) ->
        expand_module_names(call(UnexpandedGoals), [0], Module, ExpandedGoals, HeadVars, TGs)
     ;  goal_expansion(UnexpandedGoals, Module, UnexpandedGoals1),

src/tests/warnings.pl

@@ -0,0 +1,23 @@
+% This file is only for test cases that don't break compilation
+
+:- use_module(library(lists)).
+:- use_module(library(warnings)).
+
+% Should warn regarding unsound type tests
+t :-
+    x; integer(_).
+
+% Should warn about deeply nested negations
+n :-
+    \+ \+ \+ foo(_).
+
+% Should trigger meta-predicate warning
+x(G) :- G.
+y(G) :- call(G, 1).
+z(G) :- maplist(G, "abc").
+
+% Shouldn't trigger meta-predicate warning
+a(L) :- maplist(=(_), L).
+
+% Shouldn't trigger invalid arithmetic expression warning
+l :- _ is 1+2.

src/tests/warnings1.pl

@@ -0,0 +1,6 @@
+:- use_module(library(warnings)).
+
+x :-
+    a.
+    b,
+    c.

src/tests/warnings2.pl

@@ -0,0 +1,6 @@
+:- use_module(library(warnings)).
+
+x :-
+    a,
+    b.
+    \+ c.

src/tests/warnings3.pl

@@ -0,0 +1,4 @@
+:- use_module(library(warnings)).
+
+j(X, B) :-
+    X is [1] + sqrt(-phi*B + max(3+5)).

tests/scryer/cli/src_tests/warnings_tests.stderr

@@ -0,0 +1,8 @@
+% Warning: integer/1 is a constant source of wrong results, use integer_si/1 from library(si) at line 8 of warnings.pl
+% Warning: Nested negations can be reduced at line 12 of warnings.pl
+% Warning: Meta-predicate detected, but no qualified variables found at line 15 of warnings.pl
+% Warning: Meta-predicate detected, but no qualified variables found at line 16 of warnings.pl
+% Warning: Meta-predicate detected, but no qualified variables found at line 17 of warnings.pl
+% Warning: (b,c) attempts to re-define (,)/2 at line 6 of warnings1.pl
+% Warning: (/+c) attempts to re-define (/+)/1 at line 6 of warnings2.pl
+% Warning: Arithmetic expression A is B+sqrt(-C*D+E) contains invalid terms [[1]=B,phi=C,max(3+5)=E] at line 4 of warnings3.pl

tests/scryer/cli/src_tests/warnings_tests.stdout

@@ -0,0 +1,3 @@
+   error(permission_error(modify,static_procedure,(',')/2),load/1).
+   error(permission_error(modify,static_procedure,(/+)/1),load/1).
+   error(type_error(evaluable,'.'/2),load/1).

tests/scryer/cli/src_tests/warnings_tests.toml

@@ -0,0 +1,9 @@
+args = [
+    "-f",
+    "--no-add-history",
+    "src/tests/warnings.pl",
+    "src/tests/warnings1.pl",
+    "src/tests/warnings2.pl",
+    "src/tests/warnings3.pl",
+    "-g", "halt"
+]