diff --git a/src/lib/warnings.pl b/src/lib/warnings.pl new file mode 100644 index 000000000..34afc1520 --- /dev/null +++ b/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). diff --git a/src/loader.pl b/src/loader.pl index 0de805cfc..8642d5a08 100644 --- a/src/loader.pl +++ b/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), diff --git a/src/tests/warnings.pl b/src/tests/warnings.pl new file mode 100644 index 000000000..edccbe288 --- /dev/null +++ b/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. diff --git a/src/tests/warnings1.pl b/src/tests/warnings1.pl new file mode 100644 index 000000000..bb9539f91 --- /dev/null +++ b/src/tests/warnings1.pl @@ -0,0 +1,6 @@ +:- use_module(library(warnings)). + +x :- + a. + b, + c. diff --git a/src/tests/warnings2.pl b/src/tests/warnings2.pl new file mode 100644 index 000000000..9a8bbaac1 --- /dev/null +++ b/src/tests/warnings2.pl @@ -0,0 +1,6 @@ +:- use_module(library(warnings)). + +x :- + a, + b. + \+ c. diff --git a/src/tests/warnings3.pl b/src/tests/warnings3.pl new file mode 100644 index 000000000..60118d680 --- /dev/null +++ b/src/tests/warnings3.pl @@ -0,0 +1,4 @@ +:- use_module(library(warnings)). + +j(X, B) :- + X is [1] + sqrt(-phi*B + max(3+5)). diff --git a/tests/scryer/cli/src_tests/warnings_tests.stderr b/tests/scryer/cli/src_tests/warnings_tests.stderr new file mode 100644 index 000000000..56c6ce6bc --- /dev/null +++ b/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 diff --git a/tests/scryer/cli/src_tests/warnings_tests.stdout b/tests/scryer/cli/src_tests/warnings_tests.stdout new file mode 100644 index 000000000..984424813 --- /dev/null +++ b/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). diff --git a/tests/scryer/cli/src_tests/warnings_tests.toml b/tests/scryer/cli/src_tests/warnings_tests.toml new file mode 100644 index 000000000..942fa1f0e --- /dev/null +++ b/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" +]