1/*  Part of Extended Tools for SWI-Prolog
    2
    3    Author:        Edison Mera Menendez
    4    E-mail:        efmera@gmail.com
    5    WWW:           https://github.com/edisonm/xtools
    6    Copyright (C): 2015, Process Design Center, Breda, The Netherlands.
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(checker,
   36          [check_wrapper/1, showcheck/1, showcheck/2, checkallc/1, checkeach/2,
   37           checkall/0, checkall/1, body_report/1, body_report/2, full_report/1,
   38           check/3, check_results/2, check_results/3, available_checker/1,
   39           head_report/1
   40          ]).   41
   42:- use_module(library(lists)).   43:- use_module(library(atomics_atom)).   44:- use_module(library(thread)).   45:- use_module(library(group_pairs_or_sort)).   46:- use_module(library(infer_meta)).   47:- use_module(library(dynamic_locations)).   48% This provides extra information to prolog_codewalk but will not be required if
   49% you use source_codewalk instead:
   50:- use_module(library(ai_extra_clauses), []).   51
   52user:file_search_path(checkers, library(checkers)).
   53
   54:- multifile
   55    prepare_results/3,  % Custom preparation method
   56    check/3.            % Hook to define new analyses
   57
   58:- public
   59    prepare_results/3,
   60    check/3.   61
   62:- meta_predicate
   63    with_prolog_flag(+, +, 0 ).   64
   65prolog:called_by(Goal, _, M, [M:Macro]) :-
   66    functor(Goal, F, A),
   67    \+ blob(F, closure),
   68    once(atomics_atom(['__aux_', Name, '/', AN, '_', CF, '+', EN], F)),
   69    atom_number(AN, N),
   70    atom_number(EN, E),
   71    A =:= E + N - 1,
   72    length(EL, E),
   73    Goal =.. [F|AL],
   74    append(TL, EL, AL),
   75    trim_args(Name, N, C, CF, EL, [C|TL], TT),
   76    Macro =.. [Name|TT].
   77
   78% This is a kludge to bypass the fact that maplist/N, N>5 does not exist:
   79trim_args(maplist, N, C, CF, EL, AL, AT) :-
   80    N > 5, !,
   81    length(AT, 5),
   82    append(AT, AR, AL),
   83    length(AR, RN),
   84    length(ER, RN),
   85    append(ER, EL, CL),
   86    C =.. [CF|CL].
   87trim_args(_, _, C, CF, EL, AL, AL) :-
   88    C =.. [CF|EL].
   89
   90/*
   91user:prolog_clause_name(Ref, Name) :-
   92    nth_clause(M:H, N, Ref), !,
   93    functor(H, F, A),
   94    Name = M:F/A-N.
   95user:prolog_clause_name(Ref, Name) :-
   96    clause_property(Ref, erased), !,
   97    clause_property(Ref, predicate(M:PI)),
   98    Name = erased(M:PI).
   99user:prolog_clause_name(_, '<meta-call>').
  100*/
  101
  102showcheck(Checker) :-
  103    showcheck(Checker, []).
  104
  105available_checker(Checker) :-
  106    clause(check(Checker, _, _), _).
  107
  108showcheck(Checker, Options) :-
  109    check_results(Checker, Results, Options),
  110    full_report(Checker-Results).
  111
  112with_prolog_flag(Flag, Value, Goal) :-
  113    current_prolog_flag(Flag, Old),
  114    setup_call_cleanup(
  115        set_prolog_flag(Flag, Value),
  116        Goal,
  117        set_prolog_flag(Flag, Old)).
  118
  119head_report(Checker-Pairs) :-
  120    ( Pairs \= []
  121    ->print_message(warning, acheck(Checker))
  122    ; true
  123    ).
  124
  125full_report(CheckerPairs) :-
  126    head_report(CheckerPairs),
  127    body_report(CheckerPairs).
  128
  129body_report(CheckerPairs) :-
  130    body_report(CheckerPairs, report_record_message).
  131
  132:- meta_predicate body_report(+, 3).  133
  134body_report(Checker-Pairs, Printer) :-
  135    ( prepare_results(Checker, Pairs, Prepared)
  136    ->true
  137    ; Prepared = Pairs
  138    ),
  139    group_pairs_or_sort(Prepared, Results),
  140    maplist(report_analysis_results(Checker, Printer), Results).
  141    
  142report_analysis_results(Checker, Printer, Type-ResultL) :-
  143    maplist(call(Printer, Checker, Type), ResultL).
  144
  145report_record_message(Checker, Type, Result) :-
  146    \+ ( copy_term_nat(acheck(Checker, Result), Term),
  147         numbervars(Term, 0, _,
  148                    [ singletons(true)
  149                    ]),
  150         print_message(Type, Term),
  151         fail
  152       ).
  153
  154check_results(Checker, Result) :-
  155    check_results(Checker, Result, []).
  156
  157checkall :-
  158    checkall([]).
  159
  160infocheck(Checker, T) :-
  161    get_time(T),
  162    print_message(information, format('Running Checker ~w', [Checker])).
  163
  164donecheck(Checker, T) :-
  165    get_time(T2),
  166    DT is T2-T,
  167    print_message(information, format('Done ~w (~3f s)', [Checker, DT])).
  168
  169checkall(Options) :- checkall(maplist, Options).
  170
  171checkallc(Options) :- checkall(concurrent_maplist, Options).
  172
  173:- meta_predicate checkall(2, +).  174checkall(Mapper, Options) :-
  175    findall(C, available_checker(C), CL),
  176    check_wrapper(call(Mapper, checkeach(Options), CL)).
  177
  178:- meta_predicate check_wrapper(0 ).  179
  180check_wrapper(Goal) :-
  181    with_prolog_flag(
  182        check_database_preds, true,
  183        with_prolog_flag(
  184            verbose, silent,
  185            setup_call_cleanup(
  186                infer_meta_if_required,
  187                Goal,
  188                cleanup_dynl_db))).
  189
  190checkeach(Options, Checker) :-
  191    infocheck(Checker, T),
  192    check(Checker, Results, Options),
  193    full_report(Checker-Results),
  194    donecheck(Checker, T).
  195
  196check_results(Checker, Results, Options) :-
  197    check_wrapper(check(Checker, Results, Options))