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_dupcode, []).   36
   37:- use_module(library(apply)).   38:- use_module(library(lists)).   39:- use_module(library(pairs)).   40:- use_module(library(apply_macros), []).   41:- use_module(library(checkers/checker)).   42:- use_module(library(check), []).   43:- use_module(library(assertions)).   44:- use_module(library(clambda)).   45:- use_module(library(extend_args)).   46:- use_module(library(extra_location)).   47:- use_module(library(from_utils)).   48:- use_module(library(group_pairs_or_sort)).   49:- use_module(library(location_utils)).   50:- use_module(library(option_utils)).   51:- use_module(library(ungroup_keys_values)).   52
   53:- multifile
   54    prolog:message//1,
   55    ignore_dupcode/3.   56
   57% Note: the order of clauses is important, to allow remove redundant information,
   58% that is, 'predicate' implies 'clause' implies 'name' duplication.
   59%
   60% duptype(meta_predicate).
   61duptype(declaration).
   62duptype(predicate).
   63duptype(clause).
   64duptype(name).
   65
   66% Use the same group key to allow filtering of redundant messages.
   67%
   68element_group(declaration, _-MTE, G) :-
   69    ( MTE = meta_predicate(M:H)
   70    ->functor(H, F, A),
   71      G=meta_predicate(M:F/A)
   72    ; G = MTE
   73    ).
   74element_group(predicate,      _:F/A,   F/A).
   75element_group(clause,         _:F/A-_, F/A).
   76element_group(name,           _:F/A,   F/A).
   77
   78ignore_dupcode(H, _, _) :-
   79    functor(H, Name, _),
   80    member(Preffix, ['__aux_wrapper_', '__aux_neck_']),
   81    atom_concat(Preffix, _, Name).
   82ignore_dupcode(H, _, _) :-
   83    current_module(apply_macros),
   84    apply_macros:maplist_expansion(H).
   85ignore_dupcode(_,                             refactor, name).
   86ignore_dupcode(_,                        i18n_refactor, name).
   87ignore_dupcode(term_expansion(_, _),            _,      name).
   88ignore_dupcode(term_expansion(_, _, _, _),      _,      name).
   89ignore_dupcode(goal_expansion(_, _),            _,      name).
   90ignore_dupcode(goal_expansion(_, _, _, _),      _,      name).
   91ignore_dupcode('$exported_op'(_, _, _),         _,      _).
   92ignore_dupcode('$mode'(_, _),                   _,      _).
   93ignore_dupcode('$pred_option'(_, _, _, _),      system, _).
   94ignore_dupcode('$included'(_, _, _, _),         system, _).
   95ignore_dupcode('$load_context_module'(_, _, _), system, _).
   96ignore_dupcode(_,                               prolog, declaration(_)).
   97ignore_dupcode(_,                               user,   declaration(use_module)).
   98ignore_dupcode(_,                               user,   declaration(dynamic)).
   99ignore_dupcode(_,                               _,      declaration(dynamic(_, _, _))).
  100
  101checker:check(dupcode, Result, Options) :-
  102    option_module_files(Options, MFileD),
  103    check_dupcode(MFileD, Result).
  104
  105:- meta_predicate
  106    duptype_elem(+, 0, +, -, -).
 duptype_elem(+DupType, :Head, :FileChk, -DupId, -Elem) is multi
For a given Element of the language, returns a duplication key and an associated value
  113duptype_elem(name, M:H, FileD, F/A, M:F/A) :-
  114    predicate_property(M:H, file(File)),
  115    get_dict(File, FileD, _),
  116    functor(H, F, A).
  117% Note: we wrap the DupId with hash/1 to allow easy identification in saved
  118% analysis outputs:
  119duptype_elem(clause, MH, FileD, hash(DupId), M:F/A-Idx) :-
  120    strip_module(MH, M, H),
  121    \+ has_dupclauses(H, M),
  122    nth_clause(MH, Idx, Ref),
  123    clause(MH, MBody, Ref),
  124    from_to_file(clause(Ref), File),
  125    get_dict(File, FileD, _),
  126    functor(H, F, A),
  127    strip_module(MBody, _C, Body),
  128    copy_term_nat((H :- Body), Term),
  129    variant_sha1(Term, DupId).
  130duptype_elem(predicate, MH, FileD, hash(DupId), M:F/A) :-
  131    predicate_property(MH, file(File)),
  132    get_dict(File, FileD, _),
  133    strip_module(MH, M, H),
  134    findall((H :- B),
  135            ( clause(MH, MB),
  136              strip_module(MB, _, B)
  137            ), ClauseL),
  138    copy_term_nat(ClauseL, Term),
  139    variant_sha1(Term, DupId),
  140    functor(H, F, A).
  141
  142duptype_elem_declaration(MFileD, DupId, From-MTE) :-
  143    loc_declaration(H, M, T, From),
  144    \+ ignore_dupcode(H, M, declaration(T)),
  145    get_dict(M, MFileD, FileD),
  146    from_to_file(From, File),
  147    get_dict(File, FileD, _),
  148    \+ memberchk(T, [goal, assertion(_,_)]),
  149    once(dtype_dupid_elem(T, T, From, H, M, DupId, Elem)),
  150    extend_args(M:T, [Elem], MTE).
  151
  152dup_if_same_file(use_module).
  153dup_if_same_file(consult).
  154dup_if_same_file(multifile).
  155dup_if_same_file(discontiguous).
  156
  157dtype_dupid_elem(meta_predicate, T, _, H, M, T-M:F/A, H) :- functor(H, F, A).
  158dtype_dupid_elem(T, T, F, H, M, T-File:M:H, H) :-
  159    dup_if_same_file(T),  % Ignore duplicates from different files
  160    from_to_file(F, File).
  161% dtype_dupid_elem(use_module_2,   T, H, M, T-M:H,  T-M:H).
  162dtype_dupid_elem(T,              T, _, H, M, T-M:PI, G) :-
  163    ( H =.. [_|Vars1],
  164      term_variables(H, Vars2),
  165      Vars1==Vars2
  166    ->functor(H, F, A),
  167      PI=F/A,
  168      G =F/A
  169    ; PI=H,
  170      G =H
  171    ).
  172
  173ignore_dupgroup((DupType-_)-ElemL) :-
  174    \+ consider_dupgroup(DupType, ElemL).
  175
  176consider_dupgroup(DupType, CIL) :-
  177    append(_, [CI|PIL2], CIL),
  178    element_head(DupType, CI, MH1),
  179    consider_dupgroup_1(DupType, MH1),
  180    member(CI2, PIL2),
  181    element_head(DupType, CI2, MH2),
  182    consider_dupgroup_2(DupType, MH1, MH2).
  183
  184consider_dupgroup_1(predicate, MH) :- \+ predicate_property(MH, public).
  185consider_dupgroup_1(clause,     _).
  186
  187consider_dupgroup_2(predicate, _, _).
  188consider_dupgroup_2(clause, M:_, M:_).
  189
  190has_dupclauses(H, M) :-
  191    prop_asr(head, M:H, _, Asr),
  192    prop_asr(glob, plprops:dupclauses(_), _, Asr).
  193
  194element_head(predicate, M:F/A,   M:H) :- functor(H, F, A).
  195element_head(clause,    M:F/A-_, M:H) :- functor(H, F, A).
  196
  197curr_duptype_elem(MFileD, DupType, DupId, Elem) :-
  198    get_dict(M, MFileD, FileD),
  199    current_predicate(M:F/A),
  200    functor(H, F, A),
  201    \+ predicate_property(M:H, imported_from(_)),
  202    duptype(DupType),
  203    \+ ignore_dupcode(H, M, DupType),
  204    duptype_elem(DupType, M:H, FileD, DupId, Elem).
  205curr_duptype_elem(MFileD, declaration, DupId, Elem) :-
  206    duptype_elem_declaration(MFileD, DupId, Elem).
  207
  208check_dupcode(MFileD, Result) :-
  209    findall((DupType-DupId)-Elem,
  210            curr_duptype_elem(MFileD, DupType, DupId, Elem), PU),
  211    sort(PU, PL),
  212    group_pairs_by_key(PL, GL),
  213    partition(\ (_-[_])^true, GL, _, GD), % Consider duplicates
  214    findall(G, ( member(G, GD),
  215                 \+ ignore_dupgroup(G)
  216               ), Groups),
  217    ungroup_keys_values(Groups, Pairs),
  218    clean_redundants(Pairs, CPairs),
  219    maplist(add_location, CPairs, Result).
  220
  221pair_group(Pair, GKey-(DupType-(DupId/Elem))) :-
  222    Pair = (DupType-DupId)-Elem,
  223    element_group(DupType, Elem, GKey).
  224
  225clean_redundants(Pairs, CPairs) :-
  226    maplist(pair_group, Pairs, GPairs),
  227    sort(GPairs, GSorted),
  228    group_pairs_or_sort(GSorted, Groups),
  229    maplist(clean_redundant_group, Groups, CGroups),
  230    ungroup_keys_values(CGroups, CPairs).
  231
  232clean_redundant_group(GKey-Group, (DupType/GKey)-List) :-
  233    duptype(DupType),
  234    memberchk(DupType-List, Group), !.
  235
  236elem_property(name,           PI,        PI,        T, T).
  237elem_property(clause,         M:F/A-Idx, (M:H)/Idx, T, T) :- functor(H, F, A).
  238elem_property(predicate,      M:F/A,     M:H,       T, T) :- functor(H, F, A).
  239
  240elem_location(declaration, From-_, declaration, Loc) :- !,
  241    from_location(From, Loc).
  242elem_location(DupType, Elem, D, Loc) :-
  243    elem_property(DupType, Elem, Prop, T, D),
  244    property_location(Prop, T, Loc).
  245
  246add_location(DupType/GKey-DupId/Elem,
  247             warning-(DupType/GKey-(DupId-(LocDL/Elem)))) :-
  248    findall(Loc/D, (elem_location(DupType, Elem, D, Loc), D \= goal), LocDU),
  249    sort(LocDU, LocDL).
  250
  251prolog:message(acheck(dupcode)) -->
  252    ['Duplicated Code',nl,
  253     '---------------',nl,
  254     'The elements below would has been implemented in different modules,', nl,
  255     'but are duplicates.  Would be a symptom of duplicated functionality.', nl,
  256     'In the case of predicate names, at least one has been exported,', nl,
  257     'making difficult to import it in other modules without clash risk.', nl,
  258     'This can be fixed by merging the duplicated code, or by refactoring', nl,
  259     'one of the duplicated to avoid this warning. Note that predicates', nl,
  260     'declared as public are ignored by this analysis.', nl, nl].
  261prolog:message(acheck(dupcode, (DupType/GKey)-LocDL)) -->
  262    ['~w ~w is duplicated:'-[DupType, GKey], nl],
  263    foldl(message_duplicated, LocDL).
  264
  265message_duplicated(_-[LocD|LocDL]) -->
  266    message_duplicated('* ', LocD),
  267    foldl(message_duplicated('  '), LocDL).
  268
  269message_duplicated(Pre, LocDL/Elem) -->
  270    foldl(message_duplicated(Pre, Elem), LocDL).
  271
  272message_duplicated(Pre, Elem, Loc/D) -->
  273    [Pre], Loc, ['duplicated '],
  274    message_elem(D, Elem),
  275    [nl].
  276
  277message_elem(declaration, _-Elem) --> !, [':- ~w.'-[Elem]].
  278message_elem(Type, Elem) --> ['~w ~w'-[Type, Elem]]