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_unused, []).   36
   37/*
   38
   39  This analyzer is based on the Mark-and-Sweep Algorithm:
   40  http://www.brpreiss.com/books/opus5/html/page424.html
   41
   42*/
   43
   44:- use_module(library(apply)).   45:- use_module(library(lists)).   46:- use_module(library(option)).   47:- use_module(library(checkers/checker)).   48:- use_module(library(clambda)).   49:- use_module(library(commited_retract)).   50:- use_module(library(qualify_meta_goal)).   51:- use_module(library(checkable_predicate)).   52:- use_module(library(current_defined_predicate)).   53:- use_module(library(codewalk)).   54:- use_module(library(extra_location)).   55:- use_module(library(from_utils)).   56:- use_module(library(is_entry_point)).   57:- use_module(library(location_utils)).   58:- use_module(library(option_utils)).   59:- use_module(library(ungroup_keys_values)).   60:- use_module(library(compact_goal)).   61:- use_module(library(condconc)).   62
   63:- multifile
   64    prolog:message//1.   65
   66:- dynamic
   67    calls_to_initialization/2,
   68    calls_to_assertion/4,
   69    calls_to_declaration/2,
   70    calls_to_clause/3,
   71    calls_to_predid/4,
   72    marked_assertion/2,
   73    marked_predid/2,
   74    marked_clause/1,
   75    marked_initialization/0,
   76    marked_declaration/0,
   77    marked_exported/2,
   78    edge/5.   79
   80:- public collect_unused/4.   81collect_unused(M, MGoal, Caller, From) :-
   82    record_location_meta(MGoal, M, From, all_call_refs, cu_caller_hook(Caller)).
   83
   84checker:check(unused, Result, Options) :-
   85    check_unused(Options, Result).
   86
   87check_unused(Options1, Pairs) :-
   88    foldl(select_option_default,
   89          [method(Method1)-clause],
   90          Options1, Options2),
   91    ( \+ memberchk(Method1, [prolog, clause]) % only these methods are supported
   92    ->Method = clause,
   93      print_message(
   94          warning,
   95          format("Method `~w' not supported yet, using `~w' instead",
   96                 [Method1, Method]))
   97    ; Method = Method1
   98    ),
   99    ignore(option(module(M), Options1)),
  100    merge_options(Options2,
  101                  [source(false), % False, otherwise this will not work
  102                   method(Method),
  103                   on_trace(collect_unused(M))
  104                  ], Options),
  105    option_module_files(Options, MFileD),
  106    option_files([module_files(MFileD)], FileD),
  107    walk_code([module_files(MFileD)|Options]),
  108    option(concurrent(Concurrent), Options, true),
  109    mark(Concurrent),
  110    sweep(FileD, Pairs),
  111    cleanup_unused.
  112
  113cleanup_unused :-
  114    retractall(calls_to_initialization(_, _)),
  115    retractall(calls_to_assertion(_, _, _, _)),
  116    retractall(calls_to_declaration(_, _)),
  117    retractall(calls_to_clause(_, _, _)),
  118    retractall(calls_to_predid(_, _, _, _)),
  119    retractall(marked_clause(_)),
  120    retractall(marked_assertion(_, _)),
  121    retractall(marked_predid(_, _)),
  122    retractall(marked_initialization),
  123    retractall(marked_declaration),
  124    retractall(marked_exported(_, _)),
  125    retractall(edge(_, _, _, _, _)).
  126
  127marked('<assertion>'(M:H)) :- marked_assertion(H, M).
  128marked(M:H)                :- marked_predid(H, M).
  129marked(clause(Ref))        :- marked_clause(Ref).
  130marked('<initialization>') :- marked_initialization.
  131marked('<declaration>')    :- marked_declaration.
  132marked('<exported>'(M:H))  :- marked_exported(H, M).
  133
  134record_marked('<assertion>'(M:H)) :- assertz(marked_assertion(H, M)).
  135record_marked(M:H)                :- assertz(marked_predid(H, M)).
  136record_marked(clause(Ref))        :- assertz(marked_clause(Ref)).
  137record_marked('<initialization>') :- assertz(marked_initialization).
  138record_marked('<declaration>'   ) :- assertz(marked_declaration).
  139record_marked('<exported>'(M:H) ) :- assertz(marked_exported(H, M)).
  140
  141is_entry_caller('<assertion>'(M:H)) :- entry_caller(M, H).
  142is_entry_caller('<initialization>').
  143is_entry_caller('<declaration>'   ).
  144is_entry_caller(M:H) :- entry_caller(M, H).
  145is_entry_caller(clause(Ref)) :-
  146    match_head_clause(M:H, Ref), % Unify head
  147    entry_caller(M, H).
  148
  149entry_caller(M, H) :-
  150    ( is_entry_point(H, M) -> true
  151    ; loc_declaration(H, M, goal, _)
  152    ).
  153
  154entry_point(Caller) :-
  155    calls_to(Caller, _, _),
  156    is_entry_caller(Caller).
  157
  158mark(Concurrent) :-
  159    cond_forall(Concurrent, entry_point(Caller), put_mark(Caller)).
  160
  161resolve_meta_goal(H, M, G) :-
  162    ( ( predicate_property(M:H, meta_predicate(Meta))
  163                                % don`t use inferred_meta_predicate(M:H, Meta)
  164                                % since actually it is not being used by the
  165                                % compiler and would lead to incorrect results
  166      )
  167    ->qualify_meta_goal(M:H, Meta, G)
  168    ; G = H
  169    ).
  170
  171is_marked(CRef) :-
  172    copy_term(CRef, Term),
  173    marked(Term),
  174    subsumes_term(Term, CRef).
  175
  176put_mark(CRef) :-
  177    ( \+ is_marked(CRef)
  178    ->record_marked(CRef),
  179      forall(calls_to(CRef, CM, Callee),
  180             mark_rec(Callee, CM))
  181    ; true
  182    ).
  183
  184mark_rec(H, M) :-
  185    resolve_meta_goal(H, M, G),
  186    forall(gen_lit_marks(M:G, CRef), % Widening
  187           put_mark(CRef)).
 gen_lit_marks(:Goal, Ref)
Generalization step, we lose precision but avoid loops --EMM

The order of this clauses matters, because we record as marked from the most specific to the most generic one !!!

The logic is: a call to a predicate will potentially use:

(1) all the assertions (2) the clauses that match, and (3) the dynamic calls that match

  202gen_lit_marks(M:G, '<assertion>'(M:P)) :-
  203    functor(G, F, A),
  204    functor(P, F, A).          % Build a fresh head without undesirable bindings
  205gen_lit_marks(MG, clause(Clause)) :-
  206    match_head_clause(MG, Clause),
  207    clause_property(Clause, file(_)).    % Static clauses only
  208gen_lit_marks(G, P) :- copy_term(G, P). % copy term to avoid undesirable bindings
  209
  210gen_marks(Ref, Ref).
  211gen_marks('<assertion>'(M:H), clause(Clause)) :-
  212    match_head_clause(M:H, Clause),
  213    clause_property(Clause, file(_)).
  214
  215not_marked(Ref) :-
  216    \+ ( gen_marks(Ref, Mark),
  217         marked(Mark)
  218       ).
  219
  220not_marked(H, M) :-
  221    \+ ( gen_lit_marks(M:H, Mark),
  222         marked(Mark)
  223       ).
  224
  225:- meta_predicate match_head_clause(0, -).  226match_head_clause(MH, Clause) :-
  227    catch(clause(MH, _, Clause), _, fail).
  228
  229current_edge(X, Y) :-
  230    PI = M:F/A,
  231    ( X = PI
  232    ->functor(H, F, A),
  233      ( CRef = M:H
  234      ; match_head_clause(M:H, Clause),
  235        CRef = clause(Clause)
  236      ),
  237      freeze(PI2, PI2 \= PI)
  238    ; ( X = M:F/A-I,
  239        integer(I)
  240      ->functor(H, F, A),
  241        nth_clause(M:H, I, Clause),
  242        CRef = clause(Clause)
  243      ; X = M:F/A-asr
  244      ->functor(H, F, A),
  245        CRef = '<assertion>'(M:H)
  246      ; X = M:F/A-dyn
  247      ->functor(H, F, A),
  248        CRef = M:H
  249      )
  250    ),
  251    calls_to(CRef, M2, H2),
  252    functor(H2, F2, A2),
  253    PI2 = M2:F2/A2,
  254    ( Y = PI2
  255    ; ( match_head_clause(M2:H2, YRef),
  256        nth_clause(_, I2, YRef),
  257        Y = M2:F2/A2-I2
  258      ;
  259        Y = M2:F2/A2-dyn
  260      )
  260,
  261      Y \= X
  262    )
  262.
  263
  264% Note: although is not nice, we are using dynamic predicates to cache partial
  265% results for performance reasons (edge/2), otherwise the analysis will take 20
  266% times more --EMM
  267%
  268sweep(FileD, Pairs) :-
  269    findall(node(Node, D, From), unmarked(FileD, Node, D, From), UNodes),
  270    sort(UNodes, Nodes),
  271    maplist(get_adjl(Nodes), Nodes, AdjL),
  272    maplist(add_sort_by(AdjL), AdjL, AdjSG),
  273    ungroup_keys_values(AdjSG, AdjSL),
  274    ungroup_keys_values([warning-AdjSL], Pairs).
  275
  276get_adjl(Nodes, node(X, DX, FX), node(X, DX, LX)-YL) :-
  277    from_location(FX, LX),
  278    findall(Y,
  279            (   current_edge(X, Y),
  280                memberchk(node(Y, _, _), Nodes)
  281                *-> true
  282            ;   Y = []
  283            ), YU),
  284    sort(YU, YL).
  285
  286add_sort_by(AdjL, Node-CalleeL, sort_by(InclN, LoopN, CalleeN)/Node-CalleeL) :-
  287    Node = node(X, _, _),
  288    findall(Caller, ( member(Caller-XL, AdjL),
  289                      member(X, XL)
  290                    ), CallerL),
  291    ( partition(\=(Node), CallerL, InclL, LoopL),
  292      length(InclL, InclN),
  293      length(LoopL, LoopN)
  294    ),
  295    length(CalleeL, CalleeN).
  296
  297% Due to the nature of this algorithm, its 'declarative' equivalent is by far
  298% more difficult to understand, maintain and slower, instead it is implemented
  299% using dynamic facts.
  300checker:prepare_results(unused, Pairs, Results) :-
  301    maplist(\ (warning-Value)^Value^true, Pairs, Values),
  302    sort(Values, Sorted),
  303    maplist(assert_edge, Sorted),
  304    compact_results(Compact),
  305    maplist(\ Result^(warning-Result)^true, Compact, Results).
  306
  307assert_edge(SortBy/node(X, D, L)-Y) :-
  308    ( Y = node(NY, _, _)
  309    ->true
  310    ; NY = Y
  311    ),
  312    assert(edge(SortBy, X, D, L, NY)).
  313
  314compact_results(Results) :-
  315    findall(Result, compact_result(_, Result), Results).
  316
  317compact_result(X, node(SortBy, L, D, X)-ResultL) :-
  318    repeat,
  319      ( edge(SortBy, X, D, L, _)
  320      ->true
  321      ; !,
  322        fail
  323      ),
  324      findall(Result,
  325              ( commited_retract(edge(_, X, D, L, Y)),
  326                Y \= X, % loop
  327                compact_result(Y, Result)
  328              ), ResultU),
  329      sort(ResultU, ResultL).
  330
  331/*
  332sweep(Ref, Pairs) :-
  333    findall(warning-(Loc-(PI/D)), ( unmarked(Ref, PI),
  334                                    property_location(PI, D, Loc)), Pairs).
  335*/
  336
  337semantic_head(H, M, dyn, dynamic(Type, CM, Call), Caller, From) :-
  338    loc_dynamic(H, M, dynamic(Type, CM, Call), From),
  339    ( Type = def
  340    ->Caller = M:H
  341    ; Type = dec
  342    ->functor(H, F, A),
  343      functor(P, F, A),
  344      Caller = M:P
  345    ).
  346semantic_head(H, M, asr, assertion(S, T), '<assertion>'(M:H), From) :-
  347    assertions:asr_head_prop(_, CM, H, S, T, _, _, From),
  348    predicate_property(CM:H, implementation_module(M)).
  349semantic_head(H, M, exp, export, '<exported>'(M:H), From) :-
  350    loc_declaration(H, M, export, From).
  351
  352checkable_unused(Ref) :-
  353    Ref = M:H,
  354    checkable_predicate(Ref),
  355    once(( \+ entry_caller(M, H)
  356         ; predicate_property(Ref, exported),
  357           \+ predicate_property(Ref, public)
  358         )).
  359
  360unmarked(FileD, Node, D, From) :-
  361    Ref = M:H,
  362    MPI = M:F/A,
  363    ( current_defined_predicate(Ref),
  364      functor(H, F, A),
  365      checkable_unused(Ref),
  366      ( not_marked(H, M)
  367      ->Node = MPI,
  368        property_from(Ref, D, From),
  369        check_pred_file(Ref, FileD, From)
  370      ; ( match_head_clause(M:H, CRef),
  371          clause_property(CRef, file(_)), % Static clauses only
  372          From = clause(CRef),
  373          not_marked(From),
  374          check_pred_file(Ref, FileD, From),
  375          nth_clause(M:H, I, CRef),
  376          D = clause(I)
  377        ; semantic_head(H, M, I, D, Mark, From),
  378          not_marked(Mark),
  379          check_pred_file(Ref, FileD, From)
  380        ),
  381        Node = M:F/A-I
  382      )
  383    ; semantic_head(H, M, I, D, Mark, From),
  384      not_marked(Mark),
  385      functor(H, F, A),
  386      check_pred_file(Ref, FileD, From),
  387      \+ current_predicate(_, Ref),
  388      checkable_unused(Ref),
  389      Node = M:F/A-I
  390    ).
  391
  392check_pred_file(Ref, FileD, From) :-
  393    \+ hide_unused_from(Ref, From),
  394    from_to_file(From, File),
  395    get_dict(File, FileD, _),
  396    !.
  397
  398prolog:message(acheck(unused)) -->
  399    ['Unused Predicates',nl,
  400     '-----------------',nl,
  401     'The predicates has been implemented, however they are', nl,
  402     'never referenced in the code nor exported.  Probably are', nl,
  403     'dead-code, part of an incomplete implementation, or called', nl,
  404     'indirectly by some meta predicate without or with incorrect', nl,
  405     'meta_predicate declaration.  In any case this represents a', nl,
  406     'bad design and must be fixed, either completing the program',nl,
  407     'or removing the unreferenced predicates.', nl, nl].
  408prolog:message(acheck(unused, Node-EdgeLL)) -->
  409    message_unused_node(Node, ['*', ' ']),
  410    foldl(foldl(message_unused_rec([' ', ' ', ' ', ' '])), EdgeLL).
  411
  412message_unused_node(node(sort_by(N, L, _), F, D, PI), Level) -->
  413    { R is N + L,
  414      unused_type(R, T)
  415    },
  416    /* Uncomment to help debugging:
  417    ( { Level = ['*'|_],
  418        N \= 0
  419      }
  420    ->( {ARL \= []}
  421      ->['In ~w ~w, called from ~w: calls to unused ~w already reported'-[T, PI, L, ARL], nl]
  422      ; ['In ~w ~w: called from ~w'-[T, PI, L], nl]
  423      )
  424    ; []
  425    ),
  426    */
  427    message_unused(T, Level, PI, F/D).
  428
  429message_unused_rec(Level, Node-EdgeL) -->
  430    message_unused_node(Node, Level),
  431    foldl(message_unused_rec([' ', ' '|Level]), EdgeL).
  432
  433message_unused(T, Level, PI, Loc/D) -->
  434    Level,
  435    Loc,
  436    ['~w ~w: ~w'-[T, D, PI], nl].
  437
  438unused_type(0, 'unreferenced') :- !.
  439unused_type(_, 'unreachable' ).
  440
  441% Hook to hide unused messages:
  442:- multifile
  443    hide_unused/2,
  444    hide_unused_from/2.  445
  446hide_unused('$exported_op'(_, _, _), _).
  447hide_unused('$mode'(_, _), _).
  448hide_unused('$tabled'(_, _), _).
  449hide_unused('$table_mode'(_, _, _), _).
  450hide_unused('$table_update'(_, _, _, _), _).
  451hide_unused('$pldoc'(_, _, _, _), _).
  452hide_unused(attr_unify_hook(_, _), predopts_analysis).
  453hide_unused(location(_, _, _), http).
  454hide_unused(loading(_), shlib).
  455hide_unused('pce catcher'(_, _), pce_global).
  456hide_unused(attribute_goals(_, _, _), M) :- unused_mo_clpfd(M).
  457hide_unused(attr_unify_hook(_, _),    M) :- unused_mo_clpfd(M).
  458hide_unused(_, plunit).
  459hide_unused(_, ciao).
  460hide_unused(Call, _) :-
  461    functor(Call, Name, _),
  462    member(Prefix, ['__aux_wrapper_',
  463                    '__wrap$',
  464                    '$wrap$'
  465                   ]),
  466    atom_concat(Prefix, _, Name).
  467hide_unused(Call, _) :-
  468    current_predicate(apply_macros:maplist_expansion/1),
  469    apply_macros:maplist_expansion(Call).
  470hide_unused(Call, M) :-
  471    functor(Call, Func, Arity),
  472    member(Prefix, [assert_, asserta_, retract_, retractall_]),
  473    atom_concat(Prefix, Name, Func),
  474    functor(Generic, Name, Arity),
  475    persistency:persistent(M, Generic, _).
  476
  477hide_unused_from(M:H, _) :- hide_unused(H, M).
  478
  479unused_mo_clpfd(clpfd_original).
  480unused_mo_clpfd(clpfd_relation).
  481unused_mo_clpfd(clpfd_gcc_occurred).
  482unused_mo_clpfd(clpfd_gcc_num).
  483unused_mo_clpfd(clpfd_gcc_vs).
  484unused_mo_clpfd(clpfd_gcc_aux).
  485unused_mo_clpfd(clpfd_aux).
  486
  487caller_ptr('<initialization>', _, '<initialization>') :- !.
  488caller_ptr('<assertion>'(AH),  _, '<assertion>'(AH) ) :- !.
  489caller_ptr('<declaration>',    _, '<declaration>'   ) :- !.
  490caller_ptr(_,        clause(Ptr), clause(Ptr)       ) :- !.
  491caller_ptr(M:H,                _, M:H).
  492
  493cu_caller_hook(Caller, Head, CM, Type, Goal, _, From) :-
  494    callable(Head),
  495    nonvar(CM),
  496    predicate_property(CM:Head, implementation_module(M)),
  497    ( Type \= lit
  498    ->compact_goal(Goal, Comp),
  499      record_location_goal(Head, M, Type, CM, Comp, From)
  500    ; Caller = '<assertion>'(A:H),
  501      member(Goal, [foreign_props:fimport(_),
  502                    foreign_props:fimport(_, _),
  503                    foreign_props:tgen(_),
  504                    foreign_props:sgen(_)])
  505    ->( A \= CM
  506      ->put_mark('<exported>'(A:H))
  507      ; put_mark(A:H)
  508      )
  509    ; true
  510    ),
  511    record_calls_to(Type, Caller, Head, M, From),
  512    ( M \= CM
  513    ->put_mark('<exported>'(M:Head))
  514    ; true
  515    ).
  516
  517record_calls_to(Type, Caller, Head, M, From) :-
  518    ( memberchk(Type, [use, lit])
  519    ->caller_ptr(Caller, From, Ptr),
  520      record_calls_to(Ptr, M, Head)
  521    ; true
  522    ).
  523
  524calls_to('<initialization>',   M, Head) :- calls_to_initialization(   Head, M).
  525calls_to('<assertion>'(AM:AH), M, Head) :- calls_to_assertion(AH, AM, Head, M).
  526calls_to('<declaration>',      M, Head) :- calls_to_declaration(      Head, M).
  527calls_to(clause(Ref),          M, Head) :- calls_to_clause(Ref,       Head, M).
  528calls_to(CM:CH,                M, Head) :- calls_to_predid(CH, CM,    Head, M).
  529
  530record_calls_to('<initialization>',   M, Head) :- assertz(calls_to_initialization(   Head, M)).
  531record_calls_to('<assertion>'(AM:AH), M, Head) :- assertz(calls_to_assertion(AH, AM, Head, M)).
  532record_calls_to('<declaration>',      M, Head) :- assertz(calls_to_declaration(      Head, M)).
  533record_calls_to(clause(Ref),          M, Head) :- assertz(calls_to_clause(Ref,       Head, M)).
  534record_calls_to(CM:CH,                M, Head) :- assertz(calls_to_predid(CH, CM,    Head, M))