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)  2012-2016, VU University Amsterdam
   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(prolog_codewalk,
  36          [ prolog_walk_code/1,         % +Options
  37            prolog_program_clause/2     % -ClauseRef, +Options
  38          ]).
  39:- use_module(library(option)).
  40:- use_module(library(record)).
  41:- use_module(library(debug)).
  42:- use_module(library(apply)).
  43:- use_module(library(lists)).
  44:- use_module(library(prolog_metainference)).
  45
  46/** <module> Prolog code walker
  47
  48This module walks over  the  loaded   program,  searching  for  callable
  49predicates. It started as part of  library(prolog_autoload) and has been
  50turned into a seperate module to  facilitate operations that require the
  51same reachability analysis, such as finding   references to a predicate,
  52finding unreachable code, etc.
  53
  54For example, the following  determins  the   call  graph  of  the loaded
  55program. By using source(true), The exact location   of  the call in the
  56source file is passed into _Where.
  57
  58  ==
  59  :- dynamic
  60          calls/2.
  61
  62  assert_call_graph :-
  63          retractall(calls(_, _)),
  64          prolog_walk_code([ trace_reference(_),
  65                             on_trace(assert_edge),
  66                             source(false)
  67                           ]),
  68          predicate_property(calls(_,_), number_of_clauses(N)),
  69          format('Got ~D edges~n', [N]).
  70
  71  assert_edge(Callee, Caller, _Where) :-
  72          calls(Caller, Callee), !.
  73  assert_edge(Callee, Caller, _Where) :-
  74          assertz(calls(Caller, Callee)).
  75  ==
  76*/
  77
  78:- meta_predicate
  79    prolog_walk_code(:).
  80
  81:- multifile
  82    prolog:called_by/4,
  83    prolog:called_by/2.
  84
  85:- predicate_options(prolog_walk_code/1, 1,
  86                     [ undefined(oneof([ignore,error,trace])),
  87                       autoload(boolean),
  88                       clauses(list),
  89                       module(atom),
  90                       module_class(list(oneof([user,system,library,
  91                                                test,development]))),
  92                       source(boolean),
  93                       trace_reference(any),
  94                       on_trace(callable),
  95                       infer_meta_predicates(oneof([false,true,all])),
  96                       evaluate(boolean)
  97                     ]).
  98
  99:- record
 100    walk_option(undefined:oneof([ignore,error,trace])=ignore,
 101                autoload:boolean=true,
 102                source:boolean=true,
 103                module:atom,                % Only analyse given module
 104                module_class:list(oneof([user,system,library,
 105                                         test,development]))=[user,library],
 106                infer_meta_predicates:oneof([false,true,all])=true,
 107                clauses:list,               % Walk only these clauses
 108                trace_reference:any=(-),
 109                on_trace:callable,          % Call-back on trace hits
 110                                            % private stuff
 111                clause,                     % Processed clause
 112                caller,                     % Head of the caller
 113                initialization,             % Initialization source
 114                undecided,                  % Error to throw error
 115                evaluate:boolean).          % Do partial evaluation
 116
 117:- thread_local
 118    multifile_predicate/3.          % Name, Arity, Module
 119
 120%!  prolog_walk_code(+Options) is det.
 121%
 122%   Walk over all loaded (user) Prolog code. The following code is
 123%   processed:
 124%
 125%     1. The bodies of all clauses in all user and library modules.
 126%        This steps collects, but does not scan multifile predicates
 127%        to avoid duplicate work.
 128%     2. All multi-file predicates collected.
 129%     3. All goals registered with initialization/1
 130%
 131%   Options processed:
 132%
 133%     * undefined(+Action)
 134%     Action defines what happens if the analysis finds a
 135%     definitely undefined predicate.  One of =ignore= or
 136%     =error=.
 137%
 138%     * autoload(+Boolean)
 139%     Try to autoload code while walking. This is enabled by default
 140%     to obtain as much as possible information about goals and find
 141%     references from autoloaded libraries.
 142%
 143%     * clauses(+ListOfClauseReferences)
 144%     Only process the given clauses.  Can be used to find clauses
 145%     quickly using source(false) and then process only interesting
 146%     clauses with source information.
 147%
 148%     * module(+Module)
 149%     Only process the given module
 150%
 151%     * module_class(+ModuleClass)
 152%     Limit processing to modules of this class. See
 153%     module_property/2 for details on module classes.  Default
 154%     is to scan the classes =user= and =library=.
 155%
 156%     * infer_meta_predicates(+BooleanOrAll)
 157%     Use infer_meta_predicate/2 on predicates with clauses that
 158%     call known meta-predicates.  The analysis is restarted until
 159%     a fixed point is reached.  If =true= (default), analysis is
 160%     only restarted if the inferred meta-predicate contains a
 161%     callable argument.  If =all=, it will be restarted until no
 162%     more new meta-predicates can be found.
 163%
 164%     * trace_reference(Callable)
 165%     Print all calls to goals that subsume Callable. Goals are
 166%     represented as Module:Callable (i.e., they are always
 167%     qualified).  See also subsumes_term/2.
 168%
 169%     * on_trace(:OnTrace)
 170%     If a reference to =trace_reference= is found, call
 171%     call(OnTrace, Callee, Caller, Location), where Location is one
 172%     of these:
 173%
 174%       - clause_term_position(+ClauseRef, +TermPos)
 175%       - clause(+ClauseRef)
 176%       - file_term_position(+Path, +TermPos)
 177%       - file(+File, +Line, -1, _)
 178%       - a variable (unknown)
 179%
 180%     Caller is the qualified head of the calling clause or the
 181%     atom '<initialization>'.
 182%
 183%     * source(+Boolean)
 184%     If =false= (default =true=), to not try to obtain detailed
 185%     source information for printed messages.
 186%
 187%     @compat OnTrace was called using Caller-Location in older
 188%             versions.
 189
 190prolog_walk_code(Options) :-
 191    meta_options(is_meta, Options, QOptions),
 192    prolog_walk_code(1, QOptions).
 193
 194prolog_walk_code(Iteration, Options) :-
 195    statistics(cputime, CPU0),
 196    make_walk_option(Options, OTerm, _),
 197    (   walk_option_clauses(OTerm, Clauses),
 198        nonvar(Clauses)
 199    ->  walk_clauses(Clauses, OTerm)
 200    ;   forall(( walk_option_module(OTerm, M),
 201                 current_module(M),
 202                 scan_module(M, OTerm)
 203               ),
 204               find_walk_from_module(M, OTerm))
 205    ),
 206    walk_from_multifile(OTerm),
 207    walk_from_initialization(OTerm),
 208    infer_new_meta_predicates(New, OTerm),
 209    statistics(cputime, CPU1),
 210    (   New \== []
 211    ->  CPU is CPU1-CPU0,
 212        print_message(informational,
 213                      codewalk(reiterate(New, Iteration, CPU))),
 214        succ(Iteration, Iteration2),
 215        prolog_walk_code(Iteration2, Options)
 216    ;   true
 217    ).
 218
 219is_meta(on_trace).
 220
 221
 222%!  walk_clauses(Clauses, +OTerm) is det.
 223%
 224%   Walk the given clauses.
 225
 226walk_clauses(Clauses, OTerm) :-
 227    must_be(list, Clauses),
 228    forall(member(ClauseRef, Clauses),
 229           ( user:clause(CHead, Body, ClauseRef),
 230             (   CHead = Module:Head
 231             ->  true
 232             ;   Module = user,
 233                 Head = CHead
 234             ),
 235             walk_option_clause(OTerm, ClauseRef),
 236             walk_option_caller(OTerm, Module:Head),
 237             walk_called_by_body(Body, Module, OTerm)
 238           )).
 239
 240%!  scan_module(+Module, +OTerm) is semidet.
 241%
 242%   True if we must scan Module according to OTerm.
 243
 244scan_module(M, OTerm) :-
 245    walk_option_module_class(OTerm, Classes),
 246    module_property(M, class(Class)),
 247    memberchk(Class, Classes).
 248
 249%!  walk_from_initialization(+OTerm)
 250%
 251%   Find initialization/1,2 directives and  process   what  they are
 252%   calling.  Skip
 253%
 254%   @bug    Relies on private '$init_goal'/3 database.
 255
 256walk_from_initialization(OTerm) :-
 257    walk_option_caller(OTerm, '<initialization>'),
 258    forall('$init_goal'(_File, Goal, SourceLocation),
 259           ( walk_option_initialization(OTerm, SourceLocation),
 260             walk_from_initialization(Goal, OTerm))).
 261
 262walk_from_initialization(M:Goal, OTerm) :-
 263    scan_module(M, OTerm),
 264    !,
 265    walk_called_by_body(Goal, M, OTerm).
 266walk_from_initialization(_, _).
 267
 268
 269%!  find_walk_from_module(+Module, +OTerm) is det.
 270%
 271%   Find undefined calls from the bodies  of all clauses that belong
 272%   to Module.
 273
 274find_walk_from_module(M, OTerm) :-
 275    debug(autoload, 'Analysing module ~q', [M]),
 276    forall(predicate_in_module(M, PI),
 277           walk_called_by_pred(M:PI, OTerm)).
 278
 279walk_called_by_pred(Module:Name/Arity, _) :-
 280    multifile_predicate(Name, Arity, Module),
 281    !.
 282walk_called_by_pred(Module:Name/Arity, _) :-
 283    functor(Head, Name, Arity),
 284    predicate_property(Module:Head, multifile),
 285    !,
 286    assertz(multifile_predicate(Name, Arity, Module)).
 287walk_called_by_pred(Module:Name/Arity, OTerm) :-
 288    functor(Head, Name, Arity),
 289    (   no_walk_property(Property),
 290        predicate_property(Module:Head, Property)
 291    ->  true
 292    ;   walk_option_caller(OTerm, Module:Head),
 293        walk_option_clause(OTerm, ClauseRef),
 294        forall(catch(clause(Module:Head, Body, ClauseRef), _, fail),
 295               walk_called_by_body(Body, Module, OTerm))
 296    ).
 297
 298no_walk_property(number_of_rules(0)).   % no point walking only facts
 299no_walk_property(foreign).              % cannot walk foreign code
 300
 301%!  walk_from_multifile(+OTerm)
 302%
 303%   Process registered multifile predicates.
 304
 305walk_from_multifile(OTerm) :-
 306    forall(retract(multifile_predicate(Name, Arity, Module)),
 307           walk_called_by_multifile(Module:Name/Arity, OTerm)).
 308
 309walk_called_by_multifile(Module:Name/Arity, OTerm) :-
 310    functor(Head, Name, Arity),
 311    forall(catch(clause_not_from_development(
 312                     Module:Head, Body, ClauseRef, OTerm),
 313                 _, fail),
 314           ( walk_option_clause(OTerm, ClauseRef),
 315             walk_option_caller(OTerm, Module:Head),
 316             walk_called_by_body(Body, Module, OTerm)
 317           )).
 318
 319
 320%!  clause_not_from_development(:Head, -Body, ?Ref, +Options) is nondet.
 321%
 322%   Enumerate clauses for a multifile predicate, but omit those from
 323%   a module that is specifically meant to support development.
 324
 325clause_not_from_development(Module:Head, Body, Ref, OTerm) :-
 326    clause(Module:Head, Body, Ref),
 327    \+ ( clause_property(Ref, file(File)),
 328         module_property(LoadModule, file(File)),
 329         \+ scan_module(LoadModule, OTerm)
 330       ).
 331
 332%!  walk_called_by_body(+Body, +Module, +OTerm) is det.
 333%
 334%   Check the Body term when  executed   in  the  context of Module.
 335%   Options:
 336%
 337%     - undefined(+Action)
 338%     One of =ignore=, =error=
 339
 340walk_called_by_body(True, _, _) :-
 341    True == true,
 342    !.                % quickly deal with facts
 343walk_called_by_body(Body, Module, OTerm) :-
 344    set_undecided_of_walk_option(error, OTerm, OTerm1),
 345    set_evaluate_of_walk_option(false, OTerm1, OTerm2),
 346    catch(walk_called(Body, Module, _TermPos, OTerm2),
 347          missing(Missing),
 348          walk_called_by_body(Missing, Body, Module, OTerm)),
 349    !.
 350walk_called_by_body(Body, Module, OTerm) :-
 351    format(user_error, 'Failed to analyse:~n', []),
 352    portray_clause(('<head>' :- Body)),
 353    (   debugging(codewalk(trace))
 354    ->  gtrace,
 355        walk_called_by_body(Body, Module, OTerm)
 356    ;   true
 357    ).
 358
 359%!  walk_called_by_body(+Missing, +Body, +Module, +OTerm)
 360%
 361%   Restart the analysis because  the   previous  analysis  provided
 362%   insufficient information.
 363
 364walk_called_by_body(Missing, Body, _, OTerm) :-
 365    debugging(codewalk),
 366    format(user_error, 'Retrying due to ~w (~p)~n', [Missing, OTerm]),
 367    portray_clause(('<head>' :- Body)), fail.
 368walk_called_by_body(undecided_call, Body, Module, OTerm) :-
 369    catch(forall(walk_called(Body, Module, _TermPos, OTerm),
 370                 true),
 371          missing(Missing),
 372          walk_called_by_body(Missing, Body, Module, OTerm)).
 373walk_called_by_body(subterm_positions, Body, Module, OTerm) :-
 374    (   (   walk_option_clause(OTerm, ClauseRef), nonvar(ClauseRef),
 375            clause_info(ClauseRef, _, TermPos, _NameOffset),
 376            TermPos = term_position(_,_,_,_,[_,BodyPos])
 377        ->  WBody = Body
 378        ;   walk_option_initialization(OTerm, SrcLoc),
 379            ground(SrcLoc), SrcLoc = _File:_Line,
 380            initialization_layout(SrcLoc, Module:Body, WBody, BodyPos)
 381        )
 382    ->  catch(forall(walk_called(WBody, Module, BodyPos, OTerm),
 383                     true),
 384              missing(subterm_positions),
 385              walk_called_by_body(no_positions, Body, Module, OTerm))
 386    ;   set_source_of_walk_option(false, OTerm, OTerm2),
 387        forall(walk_called(Body, Module, _BodyPos, OTerm2),
 388               true)
 389    ).
 390walk_called_by_body(no_positions, Body, Module, OTerm) :-
 391    set_source_of_walk_option(false, OTerm, OTerm2),
 392    forall(walk_called(Body, Module, _NoPos, OTerm2),
 393           true).
 394
 395
 396%!  walk_called(+Goal, +Module, +TermPos, +OTerm) is multi.
 397%
 398%   Perform abstract interpretation of Goal,  touching all sub-goals
 399%   that  are  directly  called  or  immediately  reachable  through
 400%   meta-calls.  The  actual  auto-loading  is    performed  by  the
 401%   predicate_property/2 call for meta-predicates.
 402%
 403%   If  Goal  is  disjunctive,  walk_called   succeeds  with  a
 404%   choice-point.  Backtracking  analyses  the  alternative  control
 405%   path(s).
 406%
 407%   Options:
 408%
 409%     * undecided(+Action)
 410%     How to deal with insifficiently instantiated terms in the
 411%     call-tree.  Values are:
 412%
 413%       - ignore
 414%       Silently ignore such goals
 415%       - error
 416%       Throw =undecided_call=
 417%
 418%     * evaluate(+Boolean)
 419%     If =true= (default), evaluate some goals.  Notably =/2.
 420%
 421%   @tbd    Analyse e.g. assert((Head:-Body))?
 422
 423walk_called(Var, _, TermPos, OTerm) :-
 424    var(Var),                              % Incomplete analysis
 425    !,
 426    undecided(Var, TermPos, OTerm).
 427walk_called(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :-
 428    !,
 429    (   nonvar(M)
 430    ->  walk_called(G, M, Pos, OTerm)
 431    ;   undecided(M, MPos, OTerm)
 432    ).
 433walk_called((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
 434    !,
 435    walk_called(A, M, PA, OTerm),
 436    walk_called(B, M, PB, OTerm).
 437walk_called((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
 438    !,
 439    (   walk_option_evaluate(OTerm, Eval), Eval == true
 440    ->  Goal = (A;B),
 441        setof(Goal,
 442              (   walk_called(A, M, PA, OTerm)
 443              ;   walk_called(B, M, PB, OTerm)
 444              ),
 445              Alts0),
 446        variants(Alts0, Alts),
 447        member(Goal, Alts)
 448    ;   walk_called(A, M, PA, OTerm),
 449        walk_called(B, M, PB, OTerm)
 450    ).
 451walk_called(Goal, Module, TermPos, OTerm) :-
 452    walk_option_trace_reference(OTerm, To), To \== (-),
 453    (   subsumes_term(To, Module:Goal)
 454    ->  M2 = Module
 455    ;   predicate_property(Module:Goal, imported_from(M2)),
 456        subsumes_term(To, M2:Goal)
 457    ),
 458    print_reference(M2:Goal, TermPos, trace, OTerm),
 459    fail.                                   % Continue search
 460walk_called(Goal, Module, _, OTerm) :-
 461    evaluate(Goal, Module, OTerm),
 462    !.
 463walk_called(Goal, M, TermPos, OTerm) :-
 464    (   (   predicate_property(M:Goal, imported_from(IM))
 465        ->  true
 466        ;   IM = M
 467        ),
 468        prolog:called_by(Goal, IM, M, Called)
 469    ;   prolog:called_by(Goal, Called)
 470    ),
 471    Called \== [],
 472    !,
 473    walk_called_by(Called, M, Goal, TermPos, OTerm).
 474walk_called(Meta, M, term_position(_,E,_,_,ArgPosList), OTerm) :-
 475    (   walk_option_autoload(OTerm, false)
 476    ->  nonvar(M),
 477        '$get_predicate_attribute'(M:Meta, defined, 1)
 478    ;   true
 479    ),
 480    (   predicate_property(M:Meta, meta_predicate(Head))
 481    ;   inferred_meta_predicate(M:Meta, Head)
 482    ),
 483    !,
 484    walk_option_clause(OTerm, ClauseRef),
 485    register_possible_meta_clause(ClauseRef),
 486    walk_meta_call(1, Head, Meta, M, ArgPosList, E-E, OTerm).
 487walk_called(Goal, Module, _, _) :-
 488    nonvar(Module),
 489    '$get_predicate_attribute'(Module:Goal, defined, 1),
 490    !.
 491walk_called(Goal, Module, TermPos, OTerm) :-
 492    callable(Goal),
 493    !,
 494    undefined(Module:Goal, TermPos, OTerm).
 495walk_called(Goal, _Module, TermPos, OTerm) :-
 496    not_callable(Goal, TermPos, OTerm).
 497
 498%!  undecided(+Variable, +TermPos, +OTerm)
 499
 500undecided(Var, TermPos, OTerm) :-
 501    walk_option_undecided(OTerm, Undecided),
 502    (   var(Undecided)
 503    ->  Action = ignore
 504    ;   Action = Undecided
 505    ),
 506    undecided(Action, Var, TermPos, OTerm).
 507
 508undecided(ignore, _, _, _) :- !.
 509undecided(error,  _, _, _) :-
 510    throw(missing(undecided_call)).
 511
 512%!  evaluate(Goal, Module, OTerm) is nondet.
 513
 514evaluate(Goal, Module, OTerm) :-
 515    walk_option_evaluate(OTerm, Evaluate),
 516    Evaluate \== false,
 517    evaluate(Goal, Module).
 518
 519evaluate(A=B, _) :-
 520    unify_with_occurs_check(A, B).
 521
 522%!  undefined(:Goal, +TermPos, +OTerm)
 523%
 524%   The analysis trapped a definitely undefined predicate.
 525
 526undefined(_, _, OTerm) :-
 527    walk_option_undefined(OTerm, ignore),
 528    !.
 529undefined(Goal, _, _) :-
 530    predicate_property(Goal, autoload(_)),
 531    !.
 532undefined(Goal, TermPos, OTerm) :-
 533    (   walk_option_undefined(OTerm, trace)
 534    ->  Why = trace
 535    ;   Why = undefined
 536    ),
 537    print_reference(Goal, TermPos, Why, OTerm).
 538
 539%!  not_callable(+Goal, +TermPos, +OTerm)
 540%
 541%   We found a reference to a non-callable term
 542
 543not_callable(Goal, TermPos, OTerm) :-
 544    print_reference(Goal, TermPos, not_callable, OTerm).
 545
 546
 547%!  print_reference(+Goal, +TermPos, +Why, +OTerm)
 548%
 549%   Print a reference to Goal, found at TermPos.
 550%
 551%   @param Why is one of =trace= or =undefined=
 552
 553print_reference(Goal, TermPos, Why, OTerm) :-
 554    walk_option_clause(OTerm, Clause), nonvar(Clause),
 555    !,
 556    (   compound(TermPos),
 557        arg(1, TermPos, CharCount),
 558        integer(CharCount)          % test it is valid
 559    ->  From = clause_term_position(Clause, TermPos)
 560    ;   walk_option_source(OTerm, false)
 561    ->  From = clause(Clause)
 562    ;   From = _,
 563        throw(missing(subterm_positions))
 564    ),
 565    print_reference2(Goal, From, Why, OTerm).
 566print_reference(Goal, TermPos, Why, OTerm) :-
 567    walk_option_initialization(OTerm, Init), nonvar(Init),
 568    Init = File:Line,
 569    !,
 570    (   compound(TermPos),
 571        arg(1, TermPos, CharCount),
 572        integer(CharCount)          % test it is valid
 573    ->  From = file_term_position(File, TermPos)
 574    ;   walk_option_source(OTerm, false)
 575    ->  From = file(File, Line, -1, _)
 576    ;   From = _,
 577        throw(missing(subterm_positions))
 578    ),
 579    print_reference2(Goal, From, Why, OTerm).
 580print_reference(Goal, _, Why, OTerm) :-
 581    print_reference2(Goal, _, Why, OTerm).
 582
 583print_reference2(Goal, From, trace, OTerm) :-
 584    walk_option_on_trace(OTerm, Closure),
 585    walk_option_caller(OTerm, Caller),
 586    nonvar(Closure),
 587    call(Closure, Goal, Caller, From),
 588    !.
 589print_reference2(Goal, From, Why, _OTerm) :-
 590    make_message(Why, Goal, From, Message, Level),
 591    print_message(Level, Message).
 592
 593
 594make_message(undefined, Goal, Context,
 595             error(existence_error(procedure, PI), Context), error) :-
 596    goal_pi(Goal, PI).
 597make_message(not_callable, Goal, Context,
 598             error(type_error(callable, Goal), Context), error).
 599make_message(trace, Goal, Context,
 600             trace_call_to(PI, Context), informational) :-
 601    goal_pi(Goal, PI).
 602
 603
 604goal_pi(Goal, M:Name/Arity) :-
 605    strip_module(Goal, M, Head),
 606    callable(Head),
 607    !,
 608    functor(Head, Name, Arity).
 609goal_pi(Goal, Goal).
 610
 611:- dynamic
 612    possible_meta_predicate/2.
 613
 614%!  register_possible_meta_clause(+ClauseRef) is det.
 615%
 616%   ClausesRef contains as call  to   a  meta-predicate. Remember to
 617%   analyse this predicate. We only analyse   the predicate if it is
 618%   loaded from a user module. I.e.,  system and library modules are
 619%   trusted.
 620
 621register_possible_meta_clause(ClausesRef) :-
 622    nonvar(ClausesRef),
 623    clause_property(ClausesRef, predicate(PI)),
 624    pi_head(PI, Head, Module),
 625    module_property(Module, class(user)),
 626    \+ predicate_property(Module:Head, meta_predicate(_)),
 627    \+ inferred_meta_predicate(Module:Head, _),
 628    \+ possible_meta_predicate(Head, Module),
 629    !,
 630    assertz(possible_meta_predicate(Head, Module)).
 631register_possible_meta_clause(_).
 632
 633pi_head(Module:Name/Arity, Head, Module)  :-
 634    !,
 635    functor(Head, Name, Arity).
 636pi_head(_, _, _) :-
 637    assertion(fail).
 638
 639%!  infer_new_meta_predicates(-MetaSpecs, +OTerm) is det.
 640
 641infer_new_meta_predicates([], OTerm) :-
 642    walk_option_infer_meta_predicates(OTerm, false),
 643    !.
 644infer_new_meta_predicates(MetaSpecs, OTerm) :-
 645    findall(Module:MetaSpec,
 646            ( retract(possible_meta_predicate(Head, Module)),
 647              infer_meta_predicate(Module:Head, MetaSpec),
 648              (   walk_option_infer_meta_predicates(OTerm, all)
 649              ->  true
 650              ;   calling_metaspec(MetaSpec)
 651              )
 652            ),
 653            MetaSpecs).
 654
 655%!  calling_metaspec(+Head) is semidet.
 656%
 657%   True if this is a meta-specification  that makes a difference to
 658%   the code walker.
 659
 660calling_metaspec(Head) :-
 661    arg(_, Head, Arg),
 662    calling_metaarg(Arg),
 663    !.
 664
 665calling_metaarg(I) :- integer(I), !.
 666calling_metaarg(^).
 667calling_metaarg(//).
 668
 669
 670%!  walk_meta_call(+Index, +GoalHead, +MetaHead, +Module,
 671%!                 +ArgPosList, +EndPos, +OTerm)
 672%
 673%   Walk a call to a meta-predicate.   This walks all meta-arguments
 674%   labeled with an integer, ^ or //.
 675%
 676%   @arg    EndPos reflects the end of the term.  This is used if the
 677%           number of arguments in the compiled form exceeds the
 678%           number of arguments in the term read.
 679
 680walk_meta_call(I, Head, Meta, M, ArgPosList, EPos, OTerm) :-
 681    arg(I, Head, AS),
 682    !,
 683    (   ArgPosList = [ArgPos|ArgPosTail]
 684    ->  true
 685    ;   ArgPos = EPos,
 686        ArgPosTail = []
 687    ),
 688    (   integer(AS)
 689    ->  arg(I, Meta, MA),
 690        extend(MA, AS, Goal, ArgPos, ArgPosEx, OTerm),
 691        walk_called(Goal, M, ArgPosEx, OTerm)
 692    ;   AS == (^)
 693    ->  arg(I, Meta, MA),
 694        remove_quantifier(MA, Goal, ArgPos, ArgPosEx, M, MG, OTerm),
 695        walk_called(Goal, MG, ArgPosEx, OTerm)
 696    ;   AS == (//)
 697    ->  arg(I, Meta, DCG),
 698        walk_dcg_body(DCG, M, ArgPos, OTerm)
 699    ;   true
 700    ),
 701    succ(I, I2),
 702    walk_meta_call(I2, Head, Meta, M, ArgPosTail, EPos, OTerm).
 703walk_meta_call(_, _, _, _, _, _, _).
 704
 705remove_quantifier(Goal, _, TermPos, TermPos, M, M, OTerm) :-
 706    var(Goal),
 707    !,
 708    undecided(Goal, TermPos, OTerm).
 709remove_quantifier(_^Goal0, Goal,
 710                  term_position(_,_,_,_,[_,GPos]),
 711                  TermPos, M0, M, OTerm) :-
 712    !,
 713    remove_quantifier(Goal0, Goal, GPos, TermPos, M0, M, OTerm).
 714remove_quantifier(M1:Goal0, Goal,
 715                  term_position(_,_,_,_,[_,GPos]),
 716                  TermPos, _, M, OTerm) :-
 717    !,
 718    remove_quantifier(Goal0, Goal, GPos, TermPos, M1, M, OTerm).
 719remove_quantifier(Goal, Goal, TermPos, TermPos, M, M, _).
 720
 721
 722%!  walk_called_by(+Called:list, +Module, +Goal, +TermPos, +OTerm)
 723%
 724%   Walk code explicitly mentioned to  be   called  through the hook
 725%   prolog:called_by/2.
 726
 727walk_called_by([], _, _, _, _).
 728walk_called_by([H|T], M, Goal, TermPos, OTerm) :-
 729    (   H = G0+N
 730    ->  subterm_pos(G0, M, Goal, TermPos, G, GPos),
 731        (   extend(G, N, G2, GPos, GPosEx, OTerm)
 732        ->  walk_called(G2, M, GPosEx, OTerm)
 733        ;   true
 734        )
 735    ;   subterm_pos(H, M, Goal, TermPos, G, GPos),
 736        walk_called(G, M, GPos, OTerm)
 737    ),
 738    walk_called_by(T, M, Goal, TermPos, OTerm).
 739
 740subterm_pos(Sub, _, Term, TermPos, Sub, SubTermPos) :-
 741    subterm_pos(Sub, Term, TermPos, SubTermPos),
 742    !.
 743subterm_pos(Sub, M, Term, TermPos, G, SubTermPos) :-
 744    nonvar(Sub),
 745    Sub = M:H,
 746    !,
 747    subterm_pos(H, M, Term, TermPos, G, SubTermPos).
 748subterm_pos(Sub, _, _, _, Sub, _).
 749
 750subterm_pos(Sub, Term, TermPos, SubTermPos) :-
 751    subterm_pos(Sub, Term, same_term, TermPos, SubTermPos),
 752    !.
 753subterm_pos(Sub, Term, TermPos, SubTermPos) :-
 754    subterm_pos(Sub, Term, ==, TermPos, SubTermPos),
 755    !.
 756subterm_pos(Sub, Term, TermPos, SubTermPos) :-
 757    subterm_pos(Sub, Term, =@=, TermPos, SubTermPos),
 758    !.
 759subterm_pos(Sub, Term, TermPos, SubTermPos) :-
 760    subterm_pos(Sub, Term, subsumes_term, TermPos, SubTermPos),
 761    !.
 762
 763%!  walk_dcg_body(+Body, +Module, +TermPos, +OTerm)
 764%
 765%   Walk a DCG body that is meta-called.
 766
 767walk_dcg_body(Var, _Module, TermPos, OTerm) :-
 768    var(Var),
 769    !,
 770    undecided(Var, TermPos, OTerm).
 771walk_dcg_body([], _Module, _, _) :- !.
 772walk_dcg_body([_|_], _Module, _, _) :- !.
 773walk_dcg_body(String, _Module, _, _) :-
 774    string(String),
 775    !.
 776walk_dcg_body(!, _Module, _, _) :- !.
 777walk_dcg_body(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :-
 778    !,
 779    (   nonvar(M)
 780    ->  walk_dcg_body(G, M, Pos, OTerm)
 781    ;   undecided(M, MPos, OTerm)
 782    ).
 783walk_dcg_body((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
 784    !,
 785    walk_dcg_body(A, M, PA, OTerm),
 786    walk_dcg_body(B, M, PB, OTerm).
 787walk_dcg_body((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
 788    !,
 789    walk_dcg_body(A, M, PA, OTerm),
 790    walk_dcg_body(B, M, PB, OTerm).
 791walk_dcg_body((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
 792    !,
 793    walk_dcg_body(A, M, PA, OTerm),
 794    walk_dcg_body(B, M, PB, OTerm).
 795walk_dcg_body((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
 796    !,
 797    (   walk_dcg_body(A, M, PA, OTerm)
 798    ;   walk_dcg_body(B, M, PB, OTerm)
 799    ).
 800walk_dcg_body((A|B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
 801    !,
 802    (   walk_dcg_body(A, M, PA, OTerm)
 803    ;   walk_dcg_body(B, M, PB, OTerm)
 804    ).
 805walk_dcg_body({G}, M, brace_term_position(_,_,PG), OTerm) :-
 806    !,
 807    walk_called(G, M, PG, OTerm).
 808walk_dcg_body(G, M, TermPos, OTerm) :-
 809    extend(G, 2, G2, TermPos, TermPosEx, OTerm),
 810    walk_called(G2, M, TermPosEx, OTerm).
 811
 812
 813%!  subterm_pos(+SubTerm, +Term, :Cmp,
 814%!              +TermPosition, -SubTermPos) is nondet.
 815%
 816%   True when SubTerm is a sub  term   of  Term, compared using Cmp,
 817%   TermPosition describes the term layout   of  Term and SubTermPos
 818%   describes the term layout of SubTerm.   Cmp  is typically one of
 819%   =same_term=, =|==|=, =|=@=|= or =|subsumes_term|=
 820
 821:- meta_predicate
 822    subterm_pos(+, +, 2, +, -),
 823    sublist_pos(+, +, +, +, 2, -).
 824
 825subterm_pos(_, _, _, Pos, _) :-
 826    var(Pos), !, fail.
 827subterm_pos(Sub, Term, Cmp, Pos, Pos) :-
 828    call(Cmp, Sub, Term),
 829    !.
 830subterm_pos(Sub, Term, Cmp, term_position(_,_,_,_,ArgPosList), Pos) :-
 831    is_list(ArgPosList),
 832    compound(Term),
 833    nth1(I, ArgPosList, ArgPos),
 834    arg(I, Term, Arg),
 835    subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
 836subterm_pos(Sub, Term, Cmp, list_position(_,_,ElemPosList,TailPos), Pos) :-
 837    sublist_pos(ElemPosList, TailPos, Sub, Term, Cmp, Pos).
 838subterm_pos(Sub, {Arg}, Cmp, brace_term_position(_,_,ArgPos), Pos) :-
 839    subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
 840
 841sublist_pos([EP|TP], TailPos, Sub, [H|T], Cmp, Pos) :-
 842    (   subterm_pos(Sub, H, Cmp, EP, Pos)
 843    ;   sublist_pos(TP, TailPos, Sub, T, Cmp, Pos)
 844    ).
 845sublist_pos([], TailPos, Sub, Tail, Cmp, Pos) :-
 846    TailPos \== none,
 847    subterm_pos(Sub, Tail, Cmp, TailPos, Pos).
 848
 849%!  extend(+Goal, +ExtraArgs, +TermPosIn, -TermPosOut, +OTerm)
 850%
 851%   @bug:
 852
 853extend(Goal, 0, Goal, TermPos, TermPos, _) :- !.
 854extend(Goal, _, _, TermPos, TermPos, OTerm) :-
 855    var(Goal),
 856    !,
 857    undecided(Goal, TermPos, OTerm).
 858extend(M:Goal, N, M:GoalEx,
 859       term_position(F,T,FT,TT,[MPos,GPosIn]),
 860       term_position(F,T,FT,TT,[MPos,GPosOut]), OTerm) :-
 861    !,
 862    (   var(M)
 863    ->  undecided(N, MPos, OTerm)
 864    ;   true
 865    ),
 866    extend(Goal, N, GoalEx, GPosIn, GPosOut, OTerm).
 867extend(Goal, N, GoalEx, TermPosIn, TermPosOut, _) :-
 868    callable(Goal),
 869    !,
 870    Goal =.. List,
 871    length(Extra, N),
 872    extend_term_pos(TermPosIn, N, TermPosOut),
 873    append(List, Extra, ListEx),
 874    GoalEx =.. ListEx.
 875extend(Goal, _, _, TermPos, _, OTerm) :-
 876    print_reference(Goal, TermPos, not_callable, OTerm).
 877
 878extend_term_pos(Var, _, _) :-
 879    var(Var),
 880    !.
 881extend_term_pos(term_position(F,T,FT,TT,ArgPosIn),
 882                N,
 883                term_position(F,T,FT,TT,ArgPosOut)) :-
 884    !,
 885    length(Extra, N),
 886    maplist(=(0-0), Extra),
 887    append(ArgPosIn, Extra, ArgPosOut).
 888extend_term_pos(F-T, N, term_position(F,T,F,T,Extra)) :-
 889    length(Extra, N),
 890    maplist(=(0-0), Extra).
 891
 892
 893%!  variants(+SortedList, -Variants) is det.
 894
 895variants([], []).
 896variants([H|T], List) :-
 897    variants(T, H, List).
 898
 899variants([], H, [H]).
 900variants([H|T], V, List) :-
 901    (   H =@= V
 902    ->  variants(T, V, List)
 903    ;   List = [V|List2],
 904        variants(T, H, List2)
 905    ).
 906
 907%!  predicate_in_module(+Module, ?PI) is nondet.
 908%
 909%   True if PI is a predicate locally defined in Module.
 910
 911predicate_in_module(Module, PI) :-
 912    current_predicate(Module:PI),
 913    PI = Name/Arity,
 914    functor(Head, Name, Arity),
 915    \+ predicate_property(Module:Head, imported_from(_)).
 916
 917
 918                 /*******************************
 919                 *      ENUMERATE CLAUSES       *
 920                 *******************************/
 921
 922%!  prolog_program_clause(-ClauseRef, +Options) is nondet.
 923%
 924%   True when ClauseRef is a reference   for  clause in the program.
 925%   Options   is   a   subset   of    the   options   processed   by
 926%   prolog_walk_code/1. The logic for deciding   on which clauses to
 927%   enumerate is shared with prolog_walk_code/1.
 928%
 929%     * module(?Module)
 930%     * module_class(+list(Classes))
 931
 932prolog_program_clause(ClauseRef, Options) :-
 933    make_walk_option(Options, OTerm, _),
 934    setup_call_cleanup(
 935        true,
 936        (   current_module(Module),
 937            scan_module(Module, OTerm),
 938            module_clause(Module, ClauseRef, OTerm)
 939        ;   retract(multifile_predicate(Name, Arity, MM)),
 940            multifile_clause(ClauseRef, MM:Name/Arity, OTerm)
 941        ;   initialization_clause(ClauseRef, OTerm)
 942        ),
 943        retractall(multifile_predicate(_,_,_))).
 944
 945
 946module_clause(Module, ClauseRef, _OTerm) :-
 947    predicate_in_module(Module, Name/Arity),
 948    \+ multifile_predicate(Name, Arity, Module),
 949    functor(Head, Name, Arity),
 950    (   predicate_property(Module:Head, multifile)
 951    ->  assertz(multifile_predicate(Name, Arity, Module)),
 952        fail
 953    ;   predicate_property(Module:Head, Property),
 954        no_enum_property(Property)
 955    ->  fail
 956    ;   catch(nth_clause(Module:Head, _, ClauseRef), _, fail)
 957    ).
 958
 959no_enum_property(foreign).
 960
 961multifile_clause(ClauseRef, M:Name/Arity, OTerm) :-
 962    functor(Head, Name, Arity),
 963    catch(clauseref_not_from_development(M:Head, ClauseRef, OTerm),
 964          _, fail).
 965
 966clauseref_not_from_development(Module:Head, Ref, OTerm) :-
 967    nth_clause(Module:Head, _N, Ref),
 968    \+ ( clause_property(Ref, file(File)),
 969         module_property(LoadModule, file(File)),
 970         \+ scan_module(LoadModule, OTerm)
 971       ).
 972
 973initialization_clause(ClauseRef, OTerm) :-
 974    catch(clause(system:'$init_goal'(_File, M:_Goal, SourceLocation),
 975                 true, ClauseRef),
 976          _, fail),
 977    walk_option_initialization(OTerm, SourceLocation),
 978    scan_module(M, OTerm).
 979
 980
 981                 /*******************************
 982                 *            MESSAGES          *
 983                 *******************************/
 984
 985:- multifile
 986    prolog:message//1,
 987    prolog:message_location//1.
 988
 989prolog:message(trace_call_to(PI, Context)) -->
 990    [ 'Call to ~q at '-[PI] ],
 991    prolog:message_location(Context).
 992
 993prolog:message_location(clause_term_position(ClauseRef, TermPos)) -->
 994    { clause_property(ClauseRef, file(File)) },
 995    message_location_file_term_position(File, TermPos).
 996prolog:message_location(clause(ClauseRef)) -->
 997    { clause_property(ClauseRef, file(File)),
 998      clause_property(ClauseRef, line_count(Line))
 999    },
1000    !,
1001    [ '~w:~d: '-[File, Line] ].
1002prolog:message_location(clause(ClauseRef)) -->
1003    { clause_name(ClauseRef, Name) },
1004    [ '~w: '-[Name] ].
1005prolog:message_location(file_term_position(Path, TermPos)) -->
1006    message_location_file_term_position(Path, TermPos).
1007prolog:message(codewalk(reiterate(New, Iteration, CPU))) -->
1008    [ 'Found new meta-predicates in iteration ~w (~3f sec)'-
1009      [Iteration, CPU], nl ],
1010    meta_decls(New),
1011    [ 'Restarting analysis ...'-[], nl ].
1012
1013meta_decls([]) --> [].
1014meta_decls([H|T]) -->
1015    [ ':- meta_predicate ~q.'-[H], nl ],
1016    meta_decls(T).
1017
1018message_location_file_term_position(File, TermPos) -->
1019    { arg(1, TermPos, CharCount),
1020      filepos_line(File, CharCount, Line, LinePos)
1021    },
1022    [ '~w:~d:~d: '-[File, Line, LinePos] ].
1023
1024%!  filepos_line(+File, +CharPos, -Line, -Column) is det.
1025%
1026%   @param CharPos is 0-based character offset in the file.
1027%   @param Column is the current column, counting tabs as 8 spaces.
1028
1029filepos_line(File, CharPos, Line, LinePos) :-
1030    setup_call_cleanup(
1031        ( open(File, read, In),
1032          open_null_stream(Out)
1033        ),
1034        ( copy_stream_data(In, Out, CharPos),
1035          stream_property(In, position(Pos)),
1036          stream_position_data(line_count, Pos, Line),
1037          stream_position_data(line_position, Pos, LinePos)
1038        ),
1039        ( close(Out),
1040          close(In)
1041        )).