View source with raw comments or as raw
   1/*  Part of SWI-Prolog
   2
   3    Author:        Jan Wielemaker
   4    E-mail:        J.Wielemaker@vu.nl
   5    WWW:           http://www.swi-prolog.org
   6    Copyright (c)  1985-2012, University of Amsterdam
   7                              VU University Amsterdam
   8    All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module(check,
  37        [ check/0,                      % run all checks
  38          list_undefined/0,             % list undefined predicates
  39          list_undefined/1,             % +Options
  40          list_autoload/0,              % list predicates that need autoloading
  41          list_redefined/0,             % list redefinitions
  42          list_void_declarations/0,     % list declarations with no clauses
  43          list_trivial_fails/0,         % list goals that trivially fail
  44          list_trivial_fails/1,         % +Options
  45          list_strings/0,               % list string objects in clauses
  46          list_strings/1                % +Options
  47        ]).
  48:- use_module(library(lists)).
  49:- use_module(library(pairs)).
  50:- use_module(library(option)).
  51:- use_module(library(apply)).
  52:- use_module(library(prolog_codewalk)).
  53:- use_module(library(occurs)).
  54
  55:- set_prolog_flag(generate_debug_info, false).
  56
  57:- multifile
  58       trivial_fail_goal/1,
  59       string_predicate/1,
  60       valid_string_goal/1,
  61       checker/2.
  62
  63:- dynamic checker/2.
  64
  65
  66/** <module> Consistency checking
  67
  68This library provides some consistency  checks   for  the  loaded Prolog
  69program. The predicate make/0 runs   list_undefined/0  to find undefined
  70predicates in `user' modules.
  71
  72@see    gxref/0 provides a graphical cross referencer
  73@see    PceEmacs performs real time consistency checks while you edit
  74@see    library(prolog_xref) implements `offline' cross-referencing
  75@see    library(prolog_codewalk) implements `online' analysis
  76*/
  77
  78:- predicate_options(list_undefined/1, 1,
  79                     [ module_class(list(oneof([user,library])))
  80                     ]).
  81
  82%!  check is det.
  83%
  84%   Run all consistency checks defined by checker/2. Checks enabled by
  85%   default are:
  86%
  87%     * list_undefined/0 reports undefined predicates
  88%     * list_trivial_fails/0 reports calls for which there is no
  89%       matching clause.
  90%     * list_redefined/0 reports predicates that have a local
  91%       definition and a global definition.  Note that these are
  92%       *not* errors.
  93%     * list_autoload/0 lists predicates that will be defined at
  94%       runtime using the autoloader.
  95
  96check :-
  97    checker(Checker, Message),
  98    print_message(informational,check(pass(Message))),
  99    catch(Checker,E,print_message(error,E)),
 100    fail.
 101check.
 102
 103%!  list_undefined is det.
 104%!  list_undefined(+Options) is det.
 105%
 106%   Report undefined predicates.  This   predicate  finds  undefined
 107%   predciates by decompiling and analyzing the body of all clauses.
 108%   Options:
 109%
 110%       * module_class(+Classes)
 111%       Process modules of the given Classes.  The default for
 112%       classes is =|[user]|=. For example, to include the
 113%       libraries into the examination, use =|[user,library]|=.
 114%
 115%   @see gxref/0 provides a graphical cross-referencer.
 116%   @see make/0 calls list_undefined/0
 117
 118:- thread_local
 119    undef/2.
 120
 121list_undefined :-
 122    list_undefined([]).
 123
 124list_undefined(Options) :-
 125    merge_options(Options,
 126                  [ module_class([user])
 127                  ],
 128                  WalkOptions),
 129    prolog_walk_code([ undefined(trace),
 130                       on_trace(found_undef)
 131                     | WalkOptions
 132                     ]),
 133    findall(PI-From, retract(undef(PI, From)), Pairs),
 134    (   Pairs == []
 135    ->  true
 136    ;   print_message(warning, check(undefined_predicates)),
 137        keysort(Pairs, Sorted),
 138        group_pairs_by_key(Sorted, Grouped),
 139        maplist(report_undefined, Grouped)
 140    ).
 141
 142:- public found_undef/3.
 143
 144found_undef(To, _Caller, From) :-
 145    goal_pi(To, PI),
 146    (   undef(PI, From)
 147    ->  true
 148    ;   compiled(PI)
 149    ->  true
 150    ;   assertz(undef(PI,From))
 151    ).
 152
 153compiled(system:'$call_cleanup'/0).     % compiled to VM instructions
 154compiled(system:'$catch'/0).
 155compiled(system:'$cut'/0).
 156
 157goal_pi(M:Head, M:Name/Arity) :-
 158    functor(Head, Name, Arity).
 159
 160report_undefined(PI-FromList) :-
 161    print_message(warning, check(undefined(PI, FromList))).
 162
 163
 164%!  list_autoload is det.
 165%
 166%   Report predicates that may be  auto-loaded. These are predicates
 167%   that  are  not  defined,  but  will   be  loaded  on  demand  if
 168%   referenced.
 169%
 170%   @tbd    This predicate uses an older mechanism for finding
 171%           undefined predicates.  Should be synchronized with
 172%           list undefined.
 173%   @see    autoload/0
 174
 175list_autoload :-
 176    setup_call_cleanup(
 177        ( current_prolog_flag(access_level, OldLevel),
 178          current_prolog_flag(autoload, OldAutoLoad),
 179          set_prolog_flag(access_level, system),
 180          set_prolog_flag(autoload, false)
 181        ),
 182        list_autoload_(OldLevel),
 183        ( set_prolog_flag(access_level, OldLevel),
 184          set_prolog_flag(autoload, OldAutoLoad)
 185        )).
 186
 187list_autoload_(SystemMode) :-
 188    (   setof(Lib-Pred,
 189              autoload_predicate(Module, Lib, Pred, SystemMode),
 190              Pairs),
 191        print_message(informational,
 192                      check(autoload(Module, Pairs))),
 193        fail
 194    ;   true
 195    ).
 196
 197autoload_predicate(Module, Library, Name/Arity, SystemMode) :-
 198    predicate_property(Module:Head, undefined),
 199    check_module_enabled(Module, SystemMode),
 200    (   \+ predicate_property(Module:Head, imported_from(_)),
 201        functor(Head, Name, Arity),
 202        '$find_library'(Module, Name, Arity, _LoadModule, Library),
 203        referenced(Module:Head, Module, _)
 204    ->  true
 205    ).
 206
 207check_module_enabled(_, system) :- !.
 208check_module_enabled(Module, _) :-
 209    \+ import_module(Module, system).
 210
 211%!  referenced(+Predicate, ?Module, -ClauseRef) is nondet.
 212%
 213%   True if clause ClauseRef references Predicate.
 214
 215referenced(Term, Module, Ref) :-
 216    Goal = Module:_Head,
 217    current_predicate(_, Goal),
 218    '$get_predicate_attribute'(Goal, system, 0),
 219    \+ '$get_predicate_attribute'(Goal, imported, _),
 220    nth_clause(Goal, _, Ref),
 221    '$xr_member'(Ref, Term).
 222
 223%!  list_redefined
 224%
 225%   Lists predicates that are defined in the global module =user= as
 226%   well as in a normal module; that   is,  predicates for which the
 227%   local definition overrules the global default definition.
 228
 229list_redefined :-
 230    setup_call_cleanup(
 231        ( current_prolog_flag(access_level, OldLevel),
 232          set_prolog_flag(access_level, system)
 233        ),
 234        list_redefined_,
 235        set_prolog_flag(access_level, OldLevel)).
 236
 237list_redefined_ :-
 238    current_module(Module),
 239    Module \== system,
 240    current_predicate(_, Module:Head),
 241    \+ predicate_property(Module:Head, imported_from(_)),
 242    (   global_module(Super),
 243        Super \== Module,
 244        '$c_current_predicate'(_, Super:Head),
 245        \+ redefined_ok(Head),
 246        '$syspreds':'$defined_predicate'(Super:Head),
 247        \+ predicate_property(Super:Head, (dynamic)),
 248        \+ predicate_property(Super:Head, imported_from(Module)),
 249        functor(Head, Name, Arity)
 250    ->  print_message(informational,
 251                      check(redefined(Module, Super, Name/Arity)))
 252    ),
 253    fail.
 254list_redefined_.
 255
 256redefined_ok('$mode'(_,_)).
 257redefined_ok('$pldoc'(_,_,_,_)).
 258redefined_ok('$pred_option'(_,_,_,_)).
 259
 260global_module(user).
 261global_module(system).
 262
 263%!  list_void_declarations is det.
 264%
 265%   List predicates that have declared attributes, but no clauses.
 266
 267list_void_declarations :-
 268    P = _:_,
 269    (   predicate_property(P, undefined),
 270        (   '$get_predicate_attribute'(P, meta_predicate, Pattern),
 271            print_message(warning,
 272                          check(void_declaration(P, meta_predicate(Pattern))))
 273        ;   void_attribute(Attr),
 274            '$get_predicate_attribute'(P, Attr, 1),
 275            print_message(warning,
 276                          check(void_declaration(P, Attr)))
 277        ),
 278        fail
 279    ;   true
 280    ).
 281
 282void_attribute(public).
 283void_attribute(volatile).
 284
 285%!  list_trivial_fails is det.
 286%!  list_trivial_fails(+Options) is det.
 287%
 288%   List goals that trivially fail  because   there  is  no matching
 289%   clause.  Options:
 290%
 291%     * module_class(+Classes)
 292%       Process modules of the given Classes.  The default for
 293%       classes is =|[user]|=. For example, to include the
 294%       libraries into the examination, use =|[user,library]|=.
 295
 296:- thread_local
 297    trivial_fail/2.
 298
 299list_trivial_fails :-
 300    list_trivial_fails([]).
 301
 302list_trivial_fails(Options) :-
 303    merge_options(Options,
 304                  [ module_class([user]),
 305                    infer_meta_predicates(false),
 306                    autoload(false),
 307                    evaluate(false),
 308                    trace_reference(_),
 309                    on_trace(check_trivial_fail)
 310                  ],
 311                  WalkOptions),
 312
 313    prolog_walk_code([ source(false)
 314                     | WalkOptions
 315                     ]),
 316    findall(CRef, retract(trivial_fail(clause(CRef), _)), Clauses),
 317    (   Clauses == []
 318    ->  true
 319    ;   print_message(warning, check(trivial_failures)),
 320        prolog_walk_code([ clauses(Clauses)
 321                         | WalkOptions
 322                         ]),
 323        findall(Goal-From, retract(trivial_fail(From, Goal)), Pairs),
 324        keysort(Pairs, Sorted),
 325        group_pairs_by_key(Sorted, Grouped),
 326        maplist(report_trivial_fail, Grouped)
 327    ).
 328
 329%!  trivial_fail_goal(:Goal)
 330%
 331%   Multifile hook that tells list_trivial_fails/0 to accept Goal as
 332%   valid.
 333
 334trivial_fail_goal(pce_expansion:pce_class(_, _, template, _, _, _)).
 335trivial_fail_goal(pce_host:property(system_source_prefix(_))).
 336
 337:- public
 338    check_trivial_fail/3.
 339
 340check_trivial_fail(MGoal0, _Caller, From) :-
 341    (   MGoal0 = M:Goal,
 342        atom(M),
 343        callable(Goal),
 344        predicate_property(MGoal0, interpreted),
 345        \+ predicate_property(MGoal0, dynamic),
 346        \+ predicate_property(MGoal0, multifile),
 347        \+ trivial_fail_goal(MGoal0)
 348    ->  (   predicate_property(MGoal0, meta_predicate(Meta))
 349        ->  qualify_meta_goal(MGoal0, Meta, MGoal)
 350        ;   MGoal = MGoal0
 351        ),
 352        (   clause(MGoal, _)
 353        ->  true
 354        ;   assertz(trivial_fail(From, MGoal))
 355        )
 356    ;   true
 357    ).
 358
 359report_trivial_fail(Goal-FromList) :-
 360    print_message(warning, check(trivial_failure(Goal, FromList))).
 361
 362%!  qualify_meta_goal(+Module, +MetaSpec, +Goal, -QualifiedGoal)
 363%
 364%   Qualify a goal if the goal calls a meta predicate
 365
 366qualify_meta_goal(M:Goal0, Meta, M:Goal) :-
 367    functor(Goal0, F, N),
 368    functor(Goal, F, N),
 369    qualify_meta_goal(1, M, Meta, Goal0, Goal).
 370
 371qualify_meta_goal(N, M, Meta, Goal0, Goal) :-
 372    arg(N, Meta,  ArgM),
 373    !,
 374    arg(N, Goal0, Arg0),
 375    arg(N, Goal,  Arg),
 376    N1 is N + 1,
 377    (   module_qualified(ArgM)
 378    ->  add_module(Arg0, M, Arg)
 379    ;   Arg = Arg0
 380    ),
 381    meta_goal(N1, Meta, Goal0, Goal).
 382meta_goal(_, _, _, _).
 383
 384add_module(Arg, M, M:Arg) :-
 385    var(Arg),
 386    !.
 387add_module(M:Arg, _, MArg) :-
 388    !,
 389    add_module(Arg, M, MArg).
 390add_module(Arg, M, M:Arg).
 391
 392module_qualified(N) :- integer(N), !.
 393module_qualified(:).
 394module_qualified(^).
 395
 396
 397%!  list_strings is det.
 398%!  list_strings(+Options) is det.
 399%
 400%   List strings that appear in clauses.   This predicate is used to
 401%   find  portability  issues  for   changing    the   Prolog   flag
 402%   =double_quotes= from =codes= to =string=, creating packed string
 403%   objects.  Warnings  may  be  suppressed    using  the  following
 404%   multifile hooks:
 405%
 406%     - string_predicate/1 to stop checking certain predicates
 407%     - valid_string_goal/1 to tell the checker that a goal is
 408%       safe.
 409%
 410%   @see Prolog flag =double_quotes=.
 411
 412list_strings :-
 413    list_strings([module_class([user])]).
 414
 415list_strings(Options) :-
 416    (   prolog_program_clause(ClauseRef, Options),
 417        clause(Head, Body, ClauseRef),
 418        \+ ( predicate_indicator(Head, PI),
 419             string_predicate(PI)
 420           ),
 421        make_clause(Head, Body, Clause),
 422        findall(T,
 423                (   sub_term(T, Head),
 424                    string(T)
 425                ;   Head = M:_,
 426                    goal_in_body(Goal, M, Body),
 427                    (   valid_string_goal(Goal)
 428                    ->  fail
 429                    ;   sub_term(T, Goal),
 430                        string(T)
 431                    )
 432                ), Ts0),
 433        sort(Ts0, Ts),
 434        member(T, Ts),
 435        message_context(ClauseRef, T, Clause, Context),
 436        print_message(warning,
 437                      check(string_in_clause(T, Context))),
 438        fail
 439    ;   true
 440    ).
 441
 442make_clause(Head, true, Head) :- !.
 443make_clause(Head, Body, (Head:-Body)).
 444
 445%!  goal_in_body(-G, +M, +Body) is nondet.
 446%
 447%   True when G is a goal called from Body.
 448
 449goal_in_body(M:G, M, G) :-
 450    var(G),
 451    !.
 452goal_in_body(G, _, M:G0) :-
 453    atom(M),
 454    !,
 455    goal_in_body(G, M, G0).
 456goal_in_body(G, M, Control) :-
 457    nonvar(Control),
 458    control(Control, Subs),
 459    !,
 460    member(Sub, Subs),
 461    goal_in_body(G, M, Sub).
 462goal_in_body(G, M, G0) :-
 463    callable(G0),
 464    (   atom(M)
 465    ->  TM = M
 466    ;   TM = system
 467    ),
 468    predicate_property(TM:G0, meta_predicate(Spec)),
 469    !,
 470    (   strip_goals(G0, Spec, G1),
 471        simple_goal_in_body(G, M, G1)
 472    ;   arg(I, Spec, Meta),
 473        arg(I, G0, G1),
 474        extend(Meta, G1, G2),
 475        goal_in_body(G, M, G2)
 476    ).
 477goal_in_body(G, M, G0) :-
 478    simple_goal_in_body(G, M, G0).
 479
 480simple_goal_in_body(G, M, G0) :-
 481    (   atom(M),
 482        callable(G0),
 483        predicate_property(M:G0, imported_from(M2))
 484    ->  G = M2:G0
 485    ;   G = M:G0
 486    ).
 487
 488control((A,B), [A,B]).
 489control((A;B), [A,B]).
 490control((A->B), [A,B]).
 491control((A*->B), [A,B]).
 492control((\+A), [A]).
 493
 494strip_goals(G0, Spec, G) :-
 495    functor(G0, Name, Arity),
 496    functor(G,  Name, Arity),
 497    strip_goal_args(1, G0, Spec, G).
 498
 499strip_goal_args(I, G0, Spec, G) :-
 500    arg(I, G0, A0),
 501    !,
 502    arg(I, Spec, M),
 503    (   extend(M, A0, _)
 504    ->  arg(I, G, '<meta-goal>')
 505    ;   arg(I, G, A0)
 506    ),
 507    I2 is I + 1,
 508    strip_goal_args(I2, G0, Spec, G).
 509strip_goal_args(_, _, _, _).
 510
 511extend(I, G0, G) :-
 512    callable(G0),
 513    integer(I), I>0,
 514    !,
 515    length(L, I),
 516    extend_list(G0, L, G).
 517extend(0, G, G).
 518extend(^, G, G).
 519
 520extend_list(M:G0, L, M:G) :-
 521    !,
 522    callable(G0),
 523    extend_list(G0, L, G).
 524extend_list(G0, L, G) :-
 525    G0 =.. List,
 526    append(List, L, All),
 527    G =.. All.
 528
 529
 530message_context(ClauseRef, String, Clause, file_term_position(File, StringPos)) :-
 531    clause_info(ClauseRef, File, TermPos, _Vars),
 532    prolog_codewalk:subterm_pos(String, Clause, ==, TermPos, StringPos),
 533    !.
 534message_context(ClauseRef, _String, _Clause, file(File, Line, -1, _)) :-
 535    clause_property(ClauseRef, file(File)),
 536    clause_property(ClauseRef, line_count(Line)),
 537    !.
 538message_context(ClauseRef, _String, _Clause, clause(ClauseRef)).
 539
 540
 541:- meta_predicate
 542    predicate_indicator(:, -).
 543
 544predicate_indicator(Module:Head, Module:Name/Arity) :-
 545    functor(Head, Name, Arity).
 546predicate_indicator(Module:Head, Module:Name//DCGArity) :-
 547    functor(Head, Name, Arity),
 548    DCGArity is Arity-2.
 549
 550%!  string_predicate(:PredicateIndicator)
 551%
 552%   Multifile hook to disable list_strings/0 on the given predicate.
 553%   This is typically used for facts that store strings.
 554
 555string_predicate(_:'$pldoc'/4).
 556string_predicate(pce_principal:send_implementation/3).
 557string_predicate(pce_principal:pce_lazy_get_method/3).
 558string_predicate(pce_principal:pce_lazy_send_method/3).
 559string_predicate(pce_principal:pce_class/6).
 560string_predicate(prolog_xref:pred_comment/4).
 561string_predicate(prolog_xref:module_comment/3).
 562string_predicate(pldoc_process:structured_comment//2).
 563string_predicate(pldoc_process:structured_command_start/3).
 564string_predicate(pldoc_process:separator_line//0).
 565string_predicate(pldoc_register:mydoc/3).
 566string_predicate(http_header:separators/1).
 567
 568%!  valid_string_goal(+Goal) is semidet.
 569%
 570%   Multifile hook that qualifies Goal  as valid for list_strings/0.
 571%   For example, format("Hello world~n") is considered proper use of
 572%   string constants.
 573
 574% system predicates
 575valid_string_goal(system:format(S)) :- string(S).
 576valid_string_goal(system:format(S,_)) :- string(S).
 577valid_string_goal(system:format(_,S,_)) :- string(S).
 578valid_string_goal(system:string_codes(S,_)) :- string(S).
 579valid_string_goal(system:string_code(_,S,_)) :- string(S).
 580valid_string_goal(system:throw(msg(S,_))) :- string(S).
 581valid_string_goal('$dcg':phrase(S,_,_)) :- string(S).
 582valid_string_goal('$dcg':phrase(S,_)) :- string(S).
 583valid_string_goal(system: is(_,_)).     % arithmetic allows for "x"
 584valid_string_goal(system: =:=(_,_)).
 585valid_string_goal(system: >(_,_)).
 586valid_string_goal(system: <(_,_)).
 587valid_string_goal(system: >=(_,_)).
 588valid_string_goal(system: =<(_,_)).
 589% library stuff
 590valid_string_goal(dcg_basics:string_without(S,_,_,_)) :- string(S).
 591valid_string_goal(git:read_url(S,_,_)) :- string(S).
 592valid_string_goal(tipc:tipc_subscribe(_,_,_,_,S)) :- string(S).
 593valid_string_goal(charsio:format_to_chars(Format,_,_)) :- string(Format).
 594valid_string_goal(charsio:format_to_chars(Format,_,_,_)) :- string(Format).
 595valid_string_goal(codesio:format_to_codes(Format,_,_)) :- string(Format).
 596valid_string_goal(codesio:format_to_codes(Format,_,_,_)) :- string(Format).
 597
 598
 599                 /*******************************
 600                 *        EXTENSION HOOKS       *
 601                 *******************************/
 602
 603%!  checker(:Goal, +Message:text)
 604%
 605%   Register code validation routines. Each   clause  defines a Goal
 606%   which performs a consistency check  executed by check/0. Message
 607%   is a short description of the   check. For example, assuming the
 608%   `my_checks` module defines a predicate list_format_mistakes/0:
 609%
 610%      ==
 611%      :- multifile check:checker/2.
 612%      check:checker(my_checks:list_format_mistakes,
 613%                    "errors with format/2 arguments").
 614%      ==
 615%
 616%   The predicate is dynamic, so you can disable checks with retract/1.
 617%   For example, to stop reporting redefined predicates:
 618%
 619%      ==
 620%      retract(check:checker(list_redefined,_)).
 621%      ==
 622
 623checker(list_undefined,         'undefined predicates').
 624checker(list_trivial_fails,     'trivial failures').
 625checker(list_redefined,         'redefined system and global predicates').
 626checker(list_void_declarations, 'predicates with declarations but without clauses').
 627checker(list_autoload,          'predicates that need autoloading').
 628
 629
 630                 /*******************************
 631                 *            MESSAGES          *
 632                 *******************************/
 633
 634:- multifile
 635    prolog:message/3.
 636
 637prolog:message(check(pass(Comment))) -->
 638    [ 'Checking ~w ...'-[Comment] ].
 639prolog:message(check(find_references(Preds))) -->
 640    { length(Preds, N)
 641    },
 642    [ 'Scanning for references to ~D possibly undefined predicates'-[N] ].
 643prolog:message(check(undefined_predicates)) -->
 644    [ 'The predicates below are not defined. If these are defined', nl,
 645      'at runtime using assert/1, use :- dynamic Name/Arity.', nl, nl
 646    ].
 647prolog:message(check(undefined(Pred, Refs))) -->
 648    { map_list_to_pairs(sort_reference_key, Refs, Keyed),
 649      keysort(Keyed, KeySorted),
 650      pairs_values(KeySorted, SortedRefs)
 651    },
 652    predicate(Pred),
 653    [ ', which is referenced by', nl ],
 654    referenced_by(SortedRefs).
 655prolog:message(check(undefined_unreferenced_predicates)) -->
 656    [ 'The predicates below are not defined, and are not', nl,
 657      'referenced.', nl, nl
 658    ].
 659prolog:message(check(undefined_unreferenced(Pred))) -->
 660    predicate(Pred).
 661prolog:message(check(autoload(Module, Pairs))) -->
 662    { module_property(Module, file(Path))
 663    },
 664    !,
 665    [ 'Into module ~w ('-[Module] ],
 666    short_filename(Path),
 667    [ ')', nl ],
 668    autoload(Pairs).
 669prolog:message(check(autoload(Module, Pairs))) -->
 670    [ 'Into module ~w'-[Module], nl ],
 671    autoload(Pairs).
 672prolog:message(check(redefined(In, From, Pred))) -->
 673    predicate(In:Pred),
 674    redefined(In, From).
 675prolog:message(check(trivial_failures)) -->
 676    [ 'The following goals fail because there are no matching clauses.' ].
 677prolog:message(check(trivial_failure(Goal, Refs))) -->
 678    { map_list_to_pairs(sort_reference_key, Refs, Keyed),
 679      keysort(Keyed, KeySorted),
 680      pairs_values(KeySorted, SortedRefs)
 681    },
 682    goal(Goal),
 683    [ ', which is called from'-[], nl ],
 684    referenced_by(SortedRefs).
 685prolog:message(check(string_in_clause(String, Context))) -->
 686    prolog:message_location(Context),
 687    [ 'String ~q'-[String] ].
 688prolog:message(check(void_declaration(P, Decl))) -->
 689    predicate(P),
 690    [ ' is declared as ~p, but has no clauses'-[Decl] ].
 691
 692
 693redefined(user, system) -->
 694    [ '~t~30| System predicate redefined globally' ].
 695redefined(_, system) -->
 696    [ '~t~30| Redefined system predicate' ].
 697redefined(_, user) -->
 698    [ '~t~30| Redefined global predicate' ].
 699
 700goal(user:Goal) -->
 701    !,
 702    [ '~p'-[Goal] ].
 703goal(Goal) -->
 704    !,
 705    [ '~p'-[Goal] ].
 706
 707predicate(Module:Name/Arity) -->
 708    { atom(Module),
 709      atom(Name),
 710      integer(Arity),
 711      functor(Head, Name, Arity),
 712      predicate_name(Module:Head, PName)
 713    },
 714    !,
 715    [ '~w'-[PName] ].
 716predicate(Module:Head) -->
 717    { atom(Module),
 718      callable(Head),
 719      predicate_name(Module:Head, PName)
 720    },
 721    !,
 722    [ '~w'-[PName] ].
 723predicate(Name/Arity) -->
 724    { atom(Name),
 725      integer(Arity)
 726    },
 727    !,
 728    predicate(user:Name/Arity).
 729
 730autoload([]) -->
 731    [].
 732autoload([Lib-Pred|T]) -->
 733    [ '    ' ],
 734    predicate(Pred),
 735    [ '~t~24| from ' ],
 736    short_filename(Lib),
 737    [ nl ],
 738    autoload(T).
 739
 740%!  sort_reference_key(+Reference, -Key) is det.
 741%
 742%   Create a stable key for sorting references to predicates.
 743
 744sort_reference_key(Term, key(M:Name/Arity, N, ClausePos)) :-
 745    clause_ref(Term, ClauseRef, ClausePos),
 746    !,
 747    nth_clause(Pred, N, ClauseRef),
 748    strip_module(Pred, M, Head),
 749    functor(Head, Name, Arity).
 750sort_reference_key(Term, Term).
 751
 752clause_ref(clause_term_position(ClauseRef, TermPos), ClauseRef, ClausePos) :-
 753    arg(1, TermPos, ClausePos).
 754clause_ref(clause(ClauseRef), ClauseRef, 0).
 755
 756
 757referenced_by([]) -->
 758    [].
 759referenced_by([Ref|T]) -->
 760    ['\t'], prolog:message_location(Ref),
 761            predicate_indicator(Ref),
 762    [ nl ],
 763    referenced_by(T).
 764
 765predicate_indicator(clause_term_position(ClauseRef, _)) -->
 766    { nonvar(ClauseRef) },
 767    !,
 768    predicate_indicator(clause(ClauseRef)).
 769predicate_indicator(clause(ClauseRef)) -->
 770    { clause_name(ClauseRef, Name) },
 771    [ '~w'-[Name] ].
 772predicate_indicator(file_term_position(_,_)) -->
 773    [ '(initialization)' ].
 774predicate_indicator(file(_,_,_,_)) -->
 775    [ '(initialization)' ].
 776
 777
 778short_filename(Path) -->
 779    { short_filename(Path, Spec)
 780    },
 781    [ '~q'-[Spec] ].
 782
 783short_filename(Path, Spec) :-
 784    absolute_file_name('', Here),
 785    atom_concat(Here, Local0, Path),
 786    !,
 787    remove_leading_slash(Local0, Spec).
 788short_filename(Path, Spec) :-
 789    findall(LenAlias, aliased_path(Path, LenAlias), Keyed),
 790    keysort(Keyed, [_-Spec|_]).
 791short_filename(Path, Path).
 792
 793aliased_path(Path, Len-Spec) :-
 794    setof(Alias, Spec^(user:file_search_path(Alias, Spec)), Aliases),
 795    member(Alias, Aliases),
 796    Term =.. [Alias, '.'],
 797    absolute_file_name(Term,
 798                       [ file_type(directory),
 799                         file_errors(fail),
 800                         solutions(all)
 801                       ], Prefix),
 802    atom_concat(Prefix, Local0, Path),
 803    remove_leading_slash(Local0, Local),
 804    atom_length(Local, Len),
 805    Spec =.. [Alias, Local].
 806
 807remove_leading_slash(Path, Local) :-
 808    atom_concat(/, Local, Path),
 809    !.
 810remove_leading_slash(Path, Path).