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(check_wrong_dynamic, []).   36
   37:- use_module(library(apply)).   38:- use_module(library(lists)).   39:- use_module(library(option)).   40:- use_module(library(checkers/checker)).   41:- use_module(library(check), []).   42:- use_module(library(clambda)).   43:- use_module(library(compact_pi_list)).   44:- use_module(library(normalize_head)).   45:- use_module(library(normalize_pi)).   46:- use_module(library(checkable_predicate)).   47:- use_module(library(current_defined_predicate)).   48:- use_module(library(database_fact)).   49:- use_module(library(codewalk)).   50:- use_module(library(location_utils)).   51:- use_module(library(predicate_from)).   52:- use_module(library(option_utils)).   53:- use_module(library(compact_goal)).   54:- use_module(library(from_utils)).   55
   56:- multifile
   57    prolog:message//1,
   58    hide_wrong_dynamic/2,
   59    hide_var_dynamic_hook/2.   60
   61hide_var_dynamic(Call1, M) :-
   62    ( \+ ( current_module(M:'$tabled'/1),
   63           M:'$tabled'(Call1)
   64         )
   65    ->Call = Call1
   66    ; Call1 =.. [F1|Args],
   67      atom_concat(F, ' tabled', F1),
   68      Call =.. [F|Args]
   69    ),
   70    hide_var_dynamic_hook(Call, M).
   71
   72hide_var_dynamic_hook(match_clause(_, _, _, _, _, _, _), ontrace).
   73hide_var_dynamic_hook(collect_non_mutually_exclusive(_, _, _, _), check_non_mutually_exclusive).
   74hide_var_dynamic_hook(ignore_import(_, _), check_imports).
   75hide_var_dynamic_hook(current_head_body(_, _, _, _), codewalk_clause).
   76hide_var_dynamic_hook(walk_from_assertion(_, _, _), codewalk_prolog).
   77hide_var_dynamic_hook(current_head_ctcheck(_, _), check_assertions).
   78hide_var_dynamic_hook(unfold_call(_, _, _, _, _), unfold_calls).
   79hide_var_dynamic_hook(no_backtrace_entry(_), filtered_backtrace).
   80hide_var_dynamic_hook(det_clause(_, _), check_useless_cuts).
   81hide_var_dynamic_hook(dyn_rtcheck_record(_, _), rtchecks).
   82hide_var_dynamic_hook(unrtcheck2(_, _), rtchecks).
   83hide_var_dynamic_hook(do_ac_head_prop_idx(_, _, _, _, _), assrt_comment).
   84hide_var_dynamic_hook(bind_interface(_, _), interface).
   85
   86:- dynamic
   87    wrong_dynamic_db/4,
   88    var_dynamic_db/2.   89
   90hide_wrong_dynamic(prolog_trace_interception(_, _, _, _), user).
   91hide_wrong_dynamic(Call, _) :-
   92    functor(Call, Name, _),
   93    member(Prefix, ['__wrap$',
   94                    '$wrap$']),
   95    atom_concat(Prefix, _, Name).
   96
   97cleanup_dynamic_db :-
   98    retractall(wrong_dynamic_db(_, _, _, _)),
   99    retractall(var_dynamic_db(_, _)).
  100
  101checker:check(wrong_dynamic, Result, Options) :-
  102    check_wrong_dynamic(Options, Result).
  103
  104check_wrong_dynamic(Options1, Pairs) :-
  105    option(module(M), Options1, M),
  106    merge_options(Options1,
  107                  [infer_meta_predicates(false),
  108                   autoload(false),
  109                   evaluate(false),
  110                   trace_variables([meta_arg,
  111                                    non_fresh]),
  112                   module_class([user, system, library]),
  113                   on_trace(collect_wrong_dynamic(M))],
  114                  Options),
  115    option_module_files(Options, MFileD),
  116    walk_code([module_files(MFileD)|Options]),
  117    collect_result(MFileD, Pairs),
  118    cleanup_dynamic_db.
  119
  120collect_result(MFileD, Pairs) :-
  121    findall(Type-(modified_nondynamic(DType)-((Loc/PI)-(MLoc/MPI))),
  122            ( current_modified_nondynamic(Type, DType, Loc, PI, From, MPI),
  123              from_location(From, MLoc)), Pairs, Pairs1),
  124    findall(warning-(unmodified_dynamic-(Loc-PI)),
  125            current_unmodified_dynamic(MFileD, Loc, PI), Pairs1, Pairs2),
  126    findall(warning-(var_as_dynamic-(PI-(Loc/CI))),
  127            ( retract(var_dynamic_db(PI, From)),
  128              check:predicate_indicator(From, CI, []),
  129              from_location(From, Loc)), Pairs2, []).
  130
  131current_modified_nondynamic(Type, DType, Loc, PI, MFrom, MPI) :-
  132    wrong_dynamic_db(TypeDB, PI, MPI, MFrom),
  133    memberchk(TypeDB, [def, dec, retract]),
  134    PI = M:F/A,
  135    functor(H, F, A),
  136    \+ hide_wrong_dynamic(H, M),
  137    Ref = M:H,
  138    \+ predicate_property(Ref, dynamic),
  139    \+ predicate_property(Ref, volatile),
  140    ( predicate_property(Ref, number_of_clauses(N)),
  141      N > 0 ->
  142      Type = error,
  143      DType = static,
  144      predicate_location(Ref, Loc)
  145    ; Type = warning,
  146      DType  = unknown,
  147      once(property_location(PI, _, Loc))
  148    ).
  149
  150current_unmodified_dynamic(MFileD, Loc, PI) :-
  151    Ref = M:H,
  152    PI = M:F/A,
  153    get_dict(M, MFileD, FileD),
  154    current_defined_predicate(Ref),
  155    \+ hide_wrong_dynamic(H, M),
  156    checkable_predicate(Ref),
  157    predicate_property(Ref, dynamic),
  158    functor(H, F, A),
  159    once(( property_from(PI, dynamic, From)
  160         ; predicate_from(Ref, From)
  161         )),
  162    from_to_file(From, File),
  163    get_dict(File, FileD, _),
  165    \+ predicate_property(Ref, multifile),
  166    % \+ predicate_property(Ref, exported),
  167    \+ predicate_property(Ref, public),
  168    \+ ( wrong_dynamic_db(Type, PI, _, _),
  169         memberchk(Type, [def, dec, retract])
  170       ),
  171    from_location(From, Loc)
  171.
  172
  173prolog:message(acheck(wrong_dynamic, Type-List)) -->
  174    wrong_dynamic_message(Type, List).
  175
  176modified_nondynamic(DType, Loc/PI-MLocPIs) -->
  177    ['\t'|Loc], ['~w ~q modified by'-[DType, PI], nl],
  178    foldl(show_locpi, MLocPIs).
  179
  180show_locpi(Loc/PI) --> ['\t\t'|Loc], check:predicate(PI), [nl].
  181
  182show_locci(Loc/CI) --> ['\t\t'|Loc], CI, [nl].
  183
  184unmodified_dynamic(Loc-PIs) -->
  185    {compact_pi_list(PIs, CPIs)},
  186    ['\t'|Loc], ['predicates ~w'-[CPIs], nl].
  187
  188wrong_dynamic_message(modified_nondynamic(DType), LocPIs) -->
  189    ['Predicates are ~w, but never declared dynamic and modified:'-DType, nl],
  190    foldl(modified_nondynamic(DType), LocPIs).
  191wrong_dynamic_message(unmodified_dynamic, LocPIs) -->
  192    ['Predicates declared dynamic, but never modified:', nl],
  193    foldl(unmodified_dynamic, LocPIs).
  194wrong_dynamic_message(var_as_dynamic, PILocCIs) -->
  195    ['Predicates called with a variable in a module-sensitive argument:', nl],
  196    foldl(var_as_dynamic, PILocCIs).
  197
  198var_as_dynamic(PI-LocCIs) -->
  199    ['\t~w called with a variable in'-[PI], nl],
  200    foldl(show_locci, LocCIs).
  201
  202prolog:message(acheck(wrong_dynamic)) -->
  203    ['Wrong Dynamic Declarations', nl,
  204     '--------------------------', nl,
  205     'The predicates present inconsistencies between its', nl,
  206     'usage and the dynamic declarations. Could be that they are', nl,
  207     'being used as dynamic without a proper declaration, being', nl,
  208     'declared as dynamic but never asserted, retracted, or using', nl,
  209     'a variable argument in a database predicate, making it', nl,
  210     'difficult to analyze.', nl, nl].
  211
  212:- public collect_wrong_dynamic/4.  213:- meta_predicate collect_wrong_dynamic(?,0,+,+).  214collect_wrong_dynamic(M, MGoal, Caller, From) :-
  215    ignore(record_location_meta(MGoal, M, From, \T^G^MG^_^F^database_fact_ort(T,G,MG,F),
  216                                record_location_wd(Caller))).
  217
  218record_location_wd(Caller, Fact, CM, Type, MGoal, _, From) :-
  219    compact_goal(MGoal, Comp),
  220    normalize_pi(Comp, MPI),
  221    ( callable(Fact),
  222      atom(CM)
  223    ->functor(Fact, F, A),
  224      predicate_property(CM:Fact, implementation_module(M)),
  225      record_location_goal(Fact, M, Type, CM, Comp, From),
  226      update_fact_from(wrong_dynamic_db(Type, M:F/A, MPI), From)
  227    ; \+ database_fact(Caller)
  228    ->normalize_head(Caller, CMHC),
  229      strip_module(CMHC, CM, HC),
  230      \+ hide_var_dynamic(HC, CM),
  231      \+ ( get_attr(Fact, meta_args, Spec),
  232           prolog_metainference:is_meta(Spec)
  233         ),
  234      update_fact_from(var_dynamic_db(MPI), From)
  235    ; true
  236    )