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