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)  2012-2020, VU University Amsterdam
    7                              CWI, 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(prolog_codewalk,
   37          [ prolog_walk_code/1,         % +Options
   38            prolog_program_clause/2     % -ClauseRef, +Options
   39          ]).   40:- use_module(library(record),[(record)/1, op(_,_,record)]).   41
   42:- autoload(library(apply),[maplist/2]).   43:- autoload(library(debug),[debug/3,debugging/1,assertion/1]).   44:- autoload(library(error),[must_be/2]).   45:- autoload(library(listing),[portray_clause/1]).   46:- autoload(library(lists),[member/2,nth1/3,append/3]).   47:- autoload(library(option),[meta_options/3]).   48:- autoload(library(prolog_clause),
   49	    [clause_info/4,initialization_layout/4,clause_name/2]).   50:- autoload(library(prolog_metainference),
   51	    [inferred_meta_predicate/2,infer_meta_predicate/2]).

Prolog code walker

This module walks over the loaded program, searching for callable predicates. It started as part of library(prolog_autoload) and has been turned into a seperate module to facilitate operations that require the same reachability analysis, such as finding references to a predicate, finding unreachable code, etc.

For example, the following determins the call graph of the loaded program. By using source(true), The exact location of the call in the source file is passed into _Where.

:- dynamic
        calls/2.

assert_call_graph :-
        retractall(calls(_, _)),
        prolog_walk_code([ trace_reference(_),
                           on_trace(assert_edge),
                           source(false)
                         ]),
        predicate_property(calls(_,_), number_of_clauses(N)),
        format('Got ~D edges~n', [N]).

assert_edge(Callee, Caller, _Where) :-
        calls(Caller, Callee), !.
assert_edge(Callee, Caller, _Where) :-
        assertz(calls(Caller, Callee)).

*/

   86:- meta_predicate
   87    prolog_walk_code(:).   88
   89:- multifile
   90    prolog:called_by/4,
   91    prolog:called_by/2.   92
   93:- predicate_options(prolog_walk_code/1, 1,
   94                     [ undefined(oneof([ignore,error,trace])),
   95                       autoload(boolean),
   96                       clauses(list),
   97                       module(atom),
   98                       module_class(list(oneof([user,system,library,
   99                                                test,development]))),
  100                       source(boolean),
  101                       trace_reference(any),
  102                       on_trace(callable),
  103                       infer_meta_predicates(oneof([false,true,all])),
  104                       evaluate(boolean),
  105                       verbose(boolean)
  106                     ]).  107
  108:- record
  109    walk_option(undefined:oneof([ignore,error,trace])=ignore,
  110                autoload:boolean=true,
  111                source:boolean=true,
  112                module:atom,                % Only analyse given module
  113                module_class:list(oneof([user,system,library,
  114                                         test,development]))=[user,library],
  115                infer_meta_predicates:oneof([false,true,all])=true,
  116                clauses:list,               % Walk only these clauses
  117                trace_reference:any=(-),
  118                on_trace:callable,          % Call-back on trace hits
  119                                            % private stuff
  120                clause,                     % Processed clause
  121                caller,                     % Head of the caller
  122                initialization,             % Initialization source
  123                undecided,                  % Error to throw error
  124                evaluate:boolean,           % Do partial evaluation
  125                verbose:boolean=false).     % Report progress
  126
  127:- thread_local
  128    multifile_predicate/3.          % Name, Arity, Module
 prolog_walk_code(+Options) is det
Walk over all loaded (user) Prolog code. The following code is processed:
  1. The bodies of all clauses in all user and library modules. This steps collects, but does not scan multifile predicates to avoid duplicate work.
  2. All multi-file predicates collected.
  3. All goals registered with initialization/1

Options processed:

undefined(+Action)
Action defines what happens if the analysis finds a definitely undefined predicate. One of ignore or error (default is ignore).
autoload(+Boolean)
Try to autoload code while walking. This is enabled by default to obtain as much as possible information about goals and find references from autoloaded libraries.
clauses(+ListOfClauseReferences)
Only process the given clauses. Can be used to find clauses quickly using source(false) and then process only interesting clauses with source information.
module(+Module)
Only process the given module
module_class(+ModuleClassList)
Limit processing to modules of the given classes. See module_property/2 for details on module classes. Default is to scan the classes user and library.
infer_meta_predicates(+BooleanOrAll)
Use infer_meta_predicate/2 on predicates with clauses that call known meta-predicates. The analysis is restarted until a fixed point is reached. If true (default), analysis is only restarted if the inferred meta-predicate contains a callable argument. If all, it will be restarted until no more new meta-predicates can be found.
trace_reference(Callable)
Print all calls to goals that subsume Callable. Goals are represented as Module:Callable (i.e., they are always qualified). See also subsumes_term/2.
on_trace(:OnTrace)
If a reference to trace_reference is found, call call(OnTrace, Callee, Caller, Location), where Location is one of these:
  • clause_term_position(+ClauseRef, +TermPos)
  • clause(+ClauseRef)
  • file_term_position(+Path, +TermPos)
  • file(+File, +Line, -1, _)
  • a variable (unknown)

Caller is the qualified head of the calling clause or the atom '<initialization>'.

source(+Boolean)
If false (default true), to not try to obtain detailed source information for printed messages.
verbose(+Boolean)
If true (default false), report derived meta-predicates and iterations.
@compat OnTrace was called using Caller-Location in older versions.
  204prolog_walk_code(Options) :-
  205    meta_options(is_meta, Options, QOptions),
  206    prolog_walk_code(1, QOptions).
  207
  208prolog_walk_code(Iteration, Options) :-
  209    statistics(cputime, CPU0),
  210    make_walk_option(Options, OTerm, _),
  211    (   walk_option_clauses(OTerm, Clauses),
  212        nonvar(Clauses)
  213    ->  walk_clauses(Clauses, OTerm)
  214    ;   forall(( walk_option_module(OTerm, M),
  215                 current_module(M),
  216                 scan_module(M, OTerm)
  217               ),
  218               find_walk_from_module(M, OTerm)),
  219        walk_from_multifile(OTerm),
  220        walk_from_initialization(OTerm)
  221    ),
  222    infer_new_meta_predicates(New, OTerm),
  223    statistics(cputime, CPU1),
  224    (   New \== []
  225    ->  CPU is CPU1-CPU0,
  226        (   walk_option_verbose(OTerm, true)
  227        ->  Level = informational
  228        ;   Level = silent
  229        ),
  230        print_message(Level,
  231                      codewalk(reiterate(New, Iteration, CPU))),
  232        succ(Iteration, Iteration2),
  233        prolog_walk_code(Iteration2, Options)
  234    ;   true
  235    ).
  236
  237is_meta(on_trace).
 walk_clauses(+Clauses, +OTerm) is det
Walk the given clauses.
  244walk_clauses(Clauses, OTerm) :-
  245    must_be(list, Clauses),
  246    forall(member(ClauseRef, Clauses),
  247           ( user:clause(CHead, Body, ClauseRef),
  248             (   CHead = Module:Head
  249             ->  true
  250             ;   Module = user,
  251                 Head = CHead
  252             ),
  253             walk_option_clause(OTerm, ClauseRef),
  254             walk_option_caller(OTerm, Module:Head),
  255             walk_called_by_body(Body, Module, OTerm)
  256           )).
 scan_module(+Module, +OTerm) is semidet
True if we must scan Module according to OTerm.
  262scan_module(M, OTerm) :-
  263    walk_option_module_class(OTerm, Classes),
  264    module_property(M, class(Class)),
  265    memberchk(Class, Classes).
 walk_from_initialization(+OTerm)
Find initialization/1,2 directives and process what they are calling. Skip
bug
- Relies on private '$init_goal'/3 database.
  274walk_from_initialization(OTerm) :-
  275    walk_option_caller(OTerm, '<initialization>'),
  276    forall(init_goal_in_scope(Goal, SourceLocation, OTerm),
  277           ( walk_option_initialization(OTerm, SourceLocation),
  278             walk_from_initialization(Goal, OTerm))).
  279
  280init_goal_in_scope(Goal, SourceLocation, OTerm) :-
  281    '$init_goal'(File, Goal, SourceLocation),
  282    (   walk_option_module(OTerm, M),
  283        nonvar(M)
  284    ->  module_property(M, file(File))
  285    ;   walk_option_module_class(OTerm, Classes),
  286        source_file_property(File, module(MF))
  287    ->  module_property(MF, class(Class)),
  288        memberchk(Class, Classes)
  289    ;   true
  290    ).
  291
  292walk_from_initialization(M:Goal, OTerm) :-
  293    scan_module(M, OTerm),
  294    !,
  295    walk_called_by_body(Goal, M, OTerm).
  296walk_from_initialization(_, _).
 find_walk_from_module(+Module, +OTerm) is det
Find undefined calls from the bodies of all clauses that belong to Module.
  304find_walk_from_module(M, OTerm) :-
  305    debug(autoload, 'Analysing module ~q', [M]),
  306    forall(predicate_in_module(M, PI),
  307           walk_called_by_pred(M:PI, OTerm)).
  308
  309walk_called_by_pred(Module:Name/Arity, _) :-
  310    multifile_predicate(Name, Arity, Module),
  311    !.
  312walk_called_by_pred(Module:Name/Arity, _) :-
  313    functor(Head, Name, Arity),
  314    predicate_property(Module:Head, multifile),
  315    !,
  316    assertz(multifile_predicate(Name, Arity, Module)).
  317walk_called_by_pred(Module:Name/Arity, OTerm) :-
  318    functor(Head, Name, Arity),
  319    (   no_walk_property(Property),
  320        predicate_property(Module:Head, Property)
  321    ->  true
  322    ;   walk_option_caller(OTerm, Module:Head),
  323        walk_option_clause(OTerm, ClauseRef),
  324        forall(catch(clause(Module:Head, Body, ClauseRef), _, fail),
  325               walk_called_by_body(Body, Module, OTerm))
  326    ).
  327
  328no_walk_property(number_of_rules(0)).   % no point walking only facts
  329no_walk_property(foreign).              % cannot walk foreign code
 walk_from_multifile(+OTerm)
Process registered multifile predicates.
  335walk_from_multifile(OTerm) :-
  336    forall(retract(multifile_predicate(Name, Arity, Module)),
  337           walk_called_by_multifile(Module:Name/Arity, OTerm)).
  338
  339walk_called_by_multifile(Module:Name/Arity, OTerm) :-
  340    functor(Head, Name, Arity),
  341    forall(catch(clause_not_from_development(
  342                     Module:Head, Body, ClauseRef, OTerm),
  343                 _, fail),
  344           ( walk_option_clause(OTerm, ClauseRef),
  345             walk_option_caller(OTerm, Module:Head),
  346             walk_called_by_body(Body, Module, OTerm)
  347           )).
 clause_not_from_development(:Head, -Body, ?Ref, +Options) is nondet
Enumerate clauses for a multifile predicate, but omit those from a module that is specifically meant to support development.
  355clause_not_from_development(Module:Head, Body, Ref, OTerm) :-
  356    clause(Module:Head, Body, Ref),
  357    \+ ( clause_property(Ref, file(File)),
  358         module_property(LoadModule, file(File)),
  359         \+ scan_module(LoadModule, OTerm)
  360       ).
 walk_called_by_body(+Body, +Module, +OTerm) is det
Check the Body term when executed in the context of Module. Options:
undefined(+Action)
One of ignore, error
  370walk_called_by_body(True, _, _) :-
  371    True == true,
  372    !.                % quickly deal with facts
  373walk_called_by_body(Body, Module, OTerm) :-
  374    set_undecided_of_walk_option(error, OTerm, OTerm1),
  375    set_evaluate_of_walk_option(false, OTerm1, OTerm2),
  376    catch(walk_called(Body, Module, _TermPos, OTerm2),
  377          missing(Missing),
  378          walk_called_by_body(Missing, Body, Module, OTerm)),
  379    !.
  380walk_called_by_body(Body, Module, OTerm) :-
  381    format(user_error, 'Failed to analyse:~n', []),
  382    portray_clause(('<head>' :- Body)),
  383    debug_walk(Body, Module, OTerm).
  384
  385% recompile this library after `debug(codewalk(trace))` and re-try
  386% for debugging failures.
  387:- if(debugging(codewalk(trace))).  388debug_walk(Body, Module, OTerm) :-
  389    gtrace,
  390    walk_called_by_body(Body, Module, OTerm).
  391:- else.  392debug_walk(_,_,_).
  393:- endif.
 walk_called_by_body(+Missing, +Body, +Module, +OTerm)
Restart the analysis because the previous analysis provided insufficient information.
  400walk_called_by_body(Missing, Body, _, OTerm) :-
  401    debugging(codewalk),
  402    format(user_error, 'Retrying due to ~w (~p)~n', [Missing, OTerm]),
  403    portray_clause(('<head>' :- Body)), fail.
  404walk_called_by_body(undecided_call, Body, Module, OTerm) :-
  405    catch(forall(walk_called(Body, Module, _TermPos, OTerm),
  406                 true),
  407          missing(Missing),
  408          walk_called_by_body(Missing, Body, Module, OTerm)).
  409walk_called_by_body(subterm_positions, Body, Module, OTerm) :-
  410    (   (   walk_option_clause(OTerm, ClauseRef), nonvar(ClauseRef),
  411            clause_info(ClauseRef, _, TermPos, _NameOffset),
  412            TermPos = term_position(_,_,_,_,[_,BodyPos])
  413        ->  WBody = Body
  414        ;   walk_option_initialization(OTerm, SrcLoc),
  415            ground(SrcLoc), SrcLoc = _File:_Line,
  416            initialization_layout(SrcLoc, Module:Body, WBody, BodyPos)
  417        )
  418    ->  catch(forall(walk_called(WBody, Module, BodyPos, OTerm),
  419                     true),
  420              missing(subterm_positions),
  421              walk_called_by_body(no_positions, Body, Module, OTerm))
  422    ;   set_source_of_walk_option(false, OTerm, OTerm2),
  423        forall(walk_called(Body, Module, _BodyPos, OTerm2),
  424               true)
  425    ).
  426walk_called_by_body(no_positions, Body, Module, OTerm) :-
  427    set_source_of_walk_option(false, OTerm, OTerm2),
  428    forall(walk_called(Body, Module, _NoPos, OTerm2),
  429           true).
 walk_called(+Goal, +Module, +TermPos, +OTerm) is multi
Perform abstract interpretation of Goal, touching all sub-goals that are directly called or immediately reachable through meta-calls. The actual auto-loading is performed by the predicate_property/2 call for meta-predicates.

If Goal is disjunctive, walk_called succeeds with a choice-point. Backtracking analyses the alternative control path(s).

Options:

undecided(+Action)
How to deal with insifficiently instantiated terms in the call-tree. Values are:
ignore
Silently ignore such goals
error
Throw undecided_call
evaluate(+Boolean)
If true (default), evaluate some goals. Notably =/2.
To be done
- Analyse e.g. assert((Head:-Body))?
  459walk_called(Term, Module, parentheses_term_position(_,_,Pos), OTerm) :-
  460    nonvar(Pos),
  461    !,
  462    walk_called(Term, Module, Pos, OTerm).
  463walk_called(Var, _, TermPos, OTerm) :-
  464    var(Var),                              % Incomplete analysis
  465    !,
  466    undecided(Var, TermPos, OTerm).
  467walk_called(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :-
  468    !,
  469    (   nonvar(M)
  470    ->  walk_called(G, M, Pos, OTerm)
  471    ;   undecided(M, MPos, OTerm)
  472    ).
  473walk_called((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  474    !,
  475    walk_called(A, M, PA, OTerm),
  476    walk_called(B, M, PB, OTerm).
  477walk_called((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  478    !,
  479    walk_called(A, M, PA, OTerm),
  480    walk_called(B, M, PB, OTerm).
  481walk_called((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  482    !,
  483    walk_called(A, M, PA, OTerm),
  484    walk_called(B, M, PB, OTerm).
  485walk_called(\+(A), M, term_position(_,_,_,_,[PA]), OTerm) :-
  486    !,
  487    \+ \+ walk_called(A, M, PA, OTerm).
  488walk_called((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  489    !,
  490    (   walk_option_evaluate(OTerm, Eval), Eval == true
  491    ->  Goal = (A;B),
  492        setof(Goal,
  493              (   walk_called(A, M, PA, OTerm)
  494              ;   walk_called(B, M, PB, OTerm)
  495              ),
  496              Alts0),
  497        variants(Alts0, Alts),
  498        member(Goal, Alts)
  499    ;   \+ \+ walk_called(A, M, PA, OTerm), % do not propagate bindings
  500        \+ \+ walk_called(B, M, PB, OTerm)
  501    ).
  502walk_called(Goal, Module, TermPos, OTerm) :-
  503    walk_option_trace_reference(OTerm, To), To \== (-),
  504    (   subsumes_term(To, Module:Goal)
  505    ->  M2 = Module
  506    ;   predicate_property(Module:Goal, imported_from(M2)),
  507        subsumes_term(To, M2:Goal)
  508    ),
  509    print_reference(M2:Goal, TermPos, trace, OTerm),
  510    fail.                                   % Continue search
  511walk_called(Goal, Module, _, OTerm) :-
  512    evaluate(Goal, Module, OTerm),
  513    !.
  514walk_called(Goal, M, TermPos, OTerm) :-
  515    (   (   predicate_property(M:Goal, imported_from(IM))
  516        ->  true
  517        ;   IM = M
  518        ),
  519        prolog:called_by(Goal, IM, M, Called)
  520    ;   prolog:called_by(Goal, Called)
  521    ),
  522    Called \== [],
  523    !,
  524    walk_called_by(Called, M, Goal, TermPos, OTerm).
  525walk_called(Meta, M, term_position(_,E,_,_,ArgPosList), OTerm) :-
  526    (   walk_option_autoload(OTerm, false)
  527    ->  nonvar(M),
  528        '$get_predicate_attribute'(M:Meta, defined, 1)
  529    ;   true
  530    ),
  531    (   predicate_property(M:Meta, meta_predicate(Head))
  532    ;   inferred_meta_predicate(M:Meta, Head)
  533    ),
  534    !,
  535    walk_option_clause(OTerm, ClauseRef),
  536    register_possible_meta_clause(ClauseRef),
  537    walk_meta_call(1, Head, Meta, M, ArgPosList, E-E, OTerm).
  538walk_called(Closure, _, _, _) :-
  539    blob(Closure, closure),
  540    !,
  541    '$closure_predicate'(Closure, Module:Name/Arity),
  542    functor(Head, Name, Arity),
  543    '$get_predicate_attribute'(Module:Head, defined, 1).
  544walk_called(ClosureCall, _, _, _) :-
  545    compound(ClosureCall),
  546    functor(ClosureCall, Closure, _),
  547    blob(Closure, closure),
  548    !,
  549    '$closure_predicate'(Closure, Module:Name/Arity),
  550    functor(Head, Name, Arity),
  551    '$get_predicate_attribute'(Module:Head, defined, 1).
  552walk_called(Goal, Module, _, _) :-
  553    nonvar(Module),
  554    '$get_predicate_attribute'(Module:Goal, defined, 1),
  555    !.
  556walk_called(Goal, Module, TermPos, OTerm) :-
  557    callable(Goal),
  558    !,
  559    undefined(Module:Goal, TermPos, OTerm).
  560walk_called(Goal, _Module, TermPos, OTerm) :-
  561    not_callable(Goal, TermPos, OTerm).
 undecided(+Variable, +TermPos, +OTerm)
  565undecided(Var, TermPos, OTerm) :-
  566    walk_option_undecided(OTerm, Undecided),
  567    (   var(Undecided)
  568    ->  Action = ignore
  569    ;   Action = Undecided
  570    ),
  571    undecided(Action, Var, TermPos, OTerm).
  572
  573undecided(ignore, _, _, _) :- !.
  574undecided(error,  _, _, _) :-
  575    throw(missing(undecided_call)).
 evaluate(Goal, Module, OTerm) is nondet
  579evaluate(Goal, Module, OTerm) :-
  580    walk_option_evaluate(OTerm, Evaluate),
  581    Evaluate \== false,
  582    evaluate(Goal, Module).
  583
  584evaluate(A=B, _) :-
  585    unify_with_occurs_check(A, B).
 undefined(:Goal, +TermPos, +OTerm)
The analysis trapped a definitely undefined predicate.
  591undefined(_, _, OTerm) :-
  592    walk_option_undefined(OTerm, ignore),
  593    !.
  594undefined(Goal, _, _) :-
  595    predicate_property(Goal, autoload(_)),
  596    !.
  597undefined(Goal, TermPos, OTerm) :-
  598    (   walk_option_undefined(OTerm, trace)
  599    ->  Why = trace
  600    ;   Why = undefined
  601    ),
  602    print_reference(Goal, TermPos, Why, OTerm).
 not_callable(+Goal, +TermPos, +OTerm)
We found a reference to a non-callable term
  608not_callable(Goal, TermPos, OTerm) :-
  609    print_reference(Goal, TermPos, not_callable, OTerm).
 print_reference(+Goal, +TermPos, +Why, +OTerm)
Print a reference to Goal, found at TermPos.
Arguments:
Why- is one of trace or undefined
  618print_reference(Goal, TermPos, Why, OTerm) :-
  619    walk_option_clause(OTerm, Clause), nonvar(Clause),
  620    !,
  621    (   compound(TermPos),
  622        arg(1, TermPos, CharCount),
  623        integer(CharCount)          % test it is valid
  624    ->  From = clause_term_position(Clause, TermPos)
  625    ;   walk_option_source(OTerm, false)
  626    ->  From = clause(Clause)
  627    ;   From = _,
  628        throw(missing(subterm_positions))
  629    ),
  630    print_reference2(Goal, From, Why, OTerm).
  631print_reference(Goal, TermPos, Why, OTerm) :-
  632    walk_option_initialization(OTerm, Init), nonvar(Init),
  633    Init = File:Line,
  634    !,
  635    (   compound(TermPos),
  636        arg(1, TermPos, CharCount),
  637        integer(CharCount)          % test it is valid
  638    ->  From = file_term_position(File, TermPos)
  639    ;   walk_option_source(OTerm, false)
  640    ->  From = file(File, Line, -1, _)
  641    ;   From = _,
  642        throw(missing(subterm_positions))
  643    ),
  644    print_reference2(Goal, From, Why, OTerm).
  645print_reference(Goal, _, Why, OTerm) :-
  646    print_reference2(Goal, _, Why, OTerm).
  647
  648print_reference2(Goal, From, trace, OTerm) :-
  649    walk_option_on_trace(OTerm, Closure),
  650    walk_option_caller(OTerm, Caller),
  651    nonvar(Closure),
  652    call(Closure, Goal, Caller, From),
  653    !.
  654print_reference2(Goal, From, Why, _OTerm) :-
  655    make_message(Why, Goal, From, Message, Level),
  656    print_message(Level, Message).
  657
  658
  659make_message(undefined, Goal, Context,
  660             error(existence_error(procedure, PI), Context), error) :-
  661    goal_pi(Goal, PI).
  662make_message(not_callable, Goal, Context,
  663             error(type_error(callable, Goal), Context), error).
  664make_message(trace, Goal, Context,
  665             trace_call_to(PI, Context), informational) :-
  666    goal_pi(Goal, PI).
  667
  668
  669goal_pi(Goal, M:Name/Arity) :-
  670    strip_module(Goal, M, Head),
  671    callable(Head),
  672    !,
  673    functor(Head, Name, Arity).
  674goal_pi(Goal, Goal).
  675
  676:- dynamic
  677    possible_meta_predicate/2.
 register_possible_meta_clause(+ClauseRef) is det
ClausesRef contains as call to a meta-predicate. Remember to analyse this predicate. We only analyse the predicate if it is loaded from a user module. I.e., system and library modules are trusted.
  686register_possible_meta_clause(ClausesRef) :-
  687    nonvar(ClausesRef),
  688    clause_property(ClausesRef, predicate(PI)),
  689    pi_head(PI, Head, Module),
  690    module_property(Module, class(user)),
  691    \+ predicate_property(Module:Head, meta_predicate(_)),
  692    \+ inferred_meta_predicate(Module:Head, _),
  693    \+ possible_meta_predicate(Head, Module),
  694    !,
  695    assertz(possible_meta_predicate(Head, Module)).
  696register_possible_meta_clause(_).
  697
  698pi_head(Module:Name/Arity, Head, Module)  :-
  699    !,
  700    functor(Head, Name, Arity).
  701pi_head(_, _, _) :-
  702    assertion(fail).
 infer_new_meta_predicates(-MetaSpecs, +OTerm) is det
  706infer_new_meta_predicates([], OTerm) :-
  707    walk_option_infer_meta_predicates(OTerm, false),
  708    !.
  709infer_new_meta_predicates(MetaSpecs, OTerm) :-
  710    findall(Module:MetaSpec,
  711            ( retract(possible_meta_predicate(Head, Module)),
  712              infer_meta_predicate(Module:Head, MetaSpec),
  713              (   walk_option_infer_meta_predicates(OTerm, all)
  714              ->  true
  715              ;   calling_metaspec(MetaSpec)
  716              )
  717            ),
  718            MetaSpecs).
 calling_metaspec(+Head) is semidet
True if this is a meta-specification that makes a difference to the code walker.
  725calling_metaspec(Head) :-
  726    arg(_, Head, Arg),
  727    calling_metaarg(Arg),
  728    !.
  729
  730calling_metaarg(I) :- integer(I), !.
  731calling_metaarg(^).
  732calling_metaarg(//).
 walk_meta_call(+Index, +GoalHead, +MetaHead, +Module, +ArgPosList, +EndPos, +OTerm)
Walk a call to a meta-predicate. This walks all meta-arguments labeled with an integer, ^ or //.
Arguments:
EndPos- reflects the end of the term. This is used if the number of arguments in the compiled form exceeds the number of arguments in the term read.
  745walk_meta_call(I, Head, Meta, M, ArgPosList, EPos, OTerm) :-
  746    arg(I, Head, AS),
  747    !,
  748    (   ArgPosList = [ArgPos|ArgPosTail]
  749    ->  true
  750    ;   ArgPos = EPos,
  751        ArgPosTail = []
  752    ),
  753    (   integer(AS)
  754    ->  arg(I, Meta, MA),
  755        extend(MA, AS, Goal, ArgPos, ArgPosEx, OTerm),
  756        walk_called(Goal, M, ArgPosEx, OTerm)
  757    ;   AS == (^)
  758    ->  arg(I, Meta, MA),
  759        remove_quantifier(MA, Goal, ArgPos, ArgPosEx, M, MG, OTerm),
  760        walk_called(Goal, MG, ArgPosEx, OTerm)
  761    ;   AS == (//)
  762    ->  arg(I, Meta, DCG),
  763        walk_dcg_body(DCG, M, ArgPos, OTerm)
  764    ;   true
  765    ),
  766    succ(I, I2),
  767    walk_meta_call(I2, Head, Meta, M, ArgPosTail, EPos, OTerm).
  768walk_meta_call(_, _, _, _, _, _, _).
  769
  770remove_quantifier(Goal, _, TermPos, TermPos, M, M, OTerm) :-
  771    var(Goal),
  772    !,
  773    undecided(Goal, TermPos, OTerm).
  774remove_quantifier(_^Goal0, Goal,
  775                  term_position(_,_,_,_,[_,GPos]),
  776                  TermPos, M0, M, OTerm) :-
  777    !,
  778    remove_quantifier(Goal0, Goal, GPos, TermPos, M0, M, OTerm).
  779remove_quantifier(M1:Goal0, Goal,
  780                  term_position(_,_,_,_,[_,GPos]),
  781                  TermPos, _, M, OTerm) :-
  782    !,
  783    remove_quantifier(Goal0, Goal, GPos, TermPos, M1, M, OTerm).
  784remove_quantifier(Goal, Goal, TermPos, TermPos, M, M, _).
 walk_called_by(+Called:list, +Module, +Goal, +TermPos, +OTerm)
Walk code explicitly mentioned to be called through the hook prolog:called_by/2.
  792walk_called_by([], _, _, _, _).
  793walk_called_by([H|T], M, Goal, TermPos, OTerm) :-
  794    (   H = G0+N
  795    ->  subterm_pos(G0, M, Goal, TermPos, G, GPos),
  796        (   extend(G, N, G2, GPos, GPosEx, OTerm)
  797        ->  walk_called(G2, M, GPosEx, OTerm)
  798        ;   true
  799        )
  800    ;   subterm_pos(H, M, Goal, TermPos, G, GPos),
  801        walk_called(G, M, GPos, OTerm)
  802    ),
  803    walk_called_by(T, M, Goal, TermPos, OTerm).
  804
  805subterm_pos(Sub, _, Term, TermPos, Sub, SubTermPos) :-
  806    subterm_pos(Sub, Term, TermPos, SubTermPos),
  807    !.
  808subterm_pos(Sub, M, Term, TermPos, G, SubTermPos) :-
  809    nonvar(Sub),
  810    Sub = M:H,
  811    !,
  812    subterm_pos(H, M, Term, TermPos, G, SubTermPos).
  813subterm_pos(Sub, _, _, _, Sub, _).
  814
  815subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  816    subterm_pos(Sub, Term, same_term, TermPos, SubTermPos),
  817    !.
  818subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  819    subterm_pos(Sub, Term, ==, TermPos, SubTermPos),
  820    !.
  821subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  822    subterm_pos(Sub, Term, =@=, TermPos, SubTermPos),
  823    !.
  824subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  825    subterm_pos(Sub, Term, subsumes_term, TermPos, SubTermPos),
  826    !.
 walk_dcg_body(+Body, +Module, +TermPos, +OTerm)
Walk a DCG body that is meta-called.
  832walk_dcg_body(Var, _Module, TermPos, OTerm) :-
  833    var(Var),
  834    !,
  835    undecided(Var, TermPos, OTerm).
  836walk_dcg_body([], _Module, _, _) :- !.
  837walk_dcg_body([_|_], _Module, _, _) :- !.
  838walk_dcg_body(String, _Module, _, _) :-
  839    string(String),
  840    !.
  841walk_dcg_body(!, _Module, _, _) :- !.
  842walk_dcg_body(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :-
  843    !,
  844    (   nonvar(M)
  845    ->  walk_dcg_body(G, M, Pos, OTerm)
  846    ;   undecided(M, MPos, OTerm)
  847    ).
  848walk_dcg_body((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  849    !,
  850    walk_dcg_body(A, M, PA, OTerm),
  851    walk_dcg_body(B, M, PB, OTerm).
  852walk_dcg_body((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  853    !,
  854    walk_dcg_body(A, M, PA, OTerm),
  855    walk_dcg_body(B, M, PB, OTerm).
  856walk_dcg_body((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  857    !,
  858    walk_dcg_body(A, M, PA, OTerm),
  859    walk_dcg_body(B, M, PB, OTerm).
  860walk_dcg_body((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  861    !,
  862    (   walk_dcg_body(A, M, PA, OTerm)
  863    ;   walk_dcg_body(B, M, PB, OTerm)
  864    ).
  865walk_dcg_body((A|B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  866    !,
  867    (   walk_dcg_body(A, M, PA, OTerm)
  868    ;   walk_dcg_body(B, M, PB, OTerm)
  869    ).
  870walk_dcg_body({G}, M, brace_term_position(_,_,PG), OTerm) :-
  871    !,
  872    walk_called(G, M, PG, OTerm).
  873walk_dcg_body(G, M, TermPos, OTerm) :-
  874    extend(G, 2, G2, TermPos, TermPosEx, OTerm),
  875    walk_called(G2, M, TermPosEx, OTerm).
 subterm_pos(+SubTerm, +Term, :Cmp, +TermPosition, -SubTermPos) is nondet
True when SubTerm is a sub term of Term, compared using Cmp, TermPosition describes the term layout of Term and SubTermPos describes the term layout of SubTerm. Cmp is typically one of same_term, ==, =@= or subsumes_term
  886:- meta_predicate
  887    subterm_pos(+, +, 2, +, -),
  888    sublist_pos(+, +, +, +, 2, -).  889
  890subterm_pos(_, _, _, Pos, _) :-
  891    var(Pos), !, fail.
  892subterm_pos(Sub, Term, Cmp, Pos, Pos) :-
  893    call(Cmp, Sub, Term),
  894    !.
  895subterm_pos(Sub, Term, Cmp, term_position(_,_,_,_,ArgPosList), Pos) :-
  896    is_list(ArgPosList),
  897    compound(Term),
  898    nth1(I, ArgPosList, ArgPos),
  899    arg(I, Term, Arg),
  900    subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
  901subterm_pos(Sub, Term, Cmp, list_position(_,_,ElemPosList,TailPos), Pos) :-
  902    sublist_pos(ElemPosList, TailPos, Sub, Term, Cmp, Pos).
  903subterm_pos(Sub, {Arg}, Cmp, brace_term_position(_,_,ArgPos), Pos) :-
  904    subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
  905
  906sublist_pos([EP|TP], TailPos, Sub, [H|T], Cmp, Pos) :-
  907    (   subterm_pos(Sub, H, Cmp, EP, Pos)
  908    ;   sublist_pos(TP, TailPos, Sub, T, Cmp, Pos)
  909    ).
  910sublist_pos([], TailPos, Sub, Tail, Cmp, Pos) :-
  911    TailPos \== none,
  912    subterm_pos(Sub, Tail, Cmp, TailPos, Pos).
 extend(+Goal, +ExtraArgs, +TermPosIn, -TermPosOut, +OTerm)
bug
- :
  918extend(Goal, 0, Goal, TermPos, TermPos, _) :- !.
  919extend(Goal, _, _, TermPos, TermPos, OTerm) :-
  920    var(Goal),
  921    !,
  922    undecided(Goal, TermPos, OTerm).
  923extend(M:Goal, N, M:GoalEx,
  924       term_position(F,T,FT,TT,[MPos,GPosIn]),
  925       term_position(F,T,FT,TT,[MPos,GPosOut]), OTerm) :-
  926    !,
  927    (   var(M)
  928    ->  undecided(N, MPos, OTerm)
  929    ;   true
  930    ),
  931    extend(Goal, N, GoalEx, GPosIn, GPosOut, OTerm).
  932extend(Goal, N, GoalEx, TermPosIn, TermPosOut, _) :-
  933    callable(Goal),
  934    !,
  935    Goal =.. List,
  936    length(Extra, N),
  937    extend_term_pos(TermPosIn, N, TermPosOut),
  938    append(List, Extra, ListEx),
  939    GoalEx =.. ListEx.
  940extend(Closure, N, M:GoalEx, TermPosIn, TermPosOut, OTerm) :-
  941    blob(Closure, closure),             % call(Closure, A1, ...)
  942    !,
  943    '$closure_predicate'(Closure, M:Name/Arity),
  944    length(Extra, N),
  945    extend_term_pos(TermPosIn, N, TermPosOut),
  946    GoalEx =.. [Name|Extra],
  947    (   N =:= Arity
  948    ->  true
  949    ;   print_reference(Closure, TermPosIn, closure_arity_mismatch, OTerm)
  950    ).
  951extend(Goal, _, _, TermPos, _, OTerm) :-
  952    print_reference(Goal, TermPos, not_callable, OTerm).
  953
  954extend_term_pos(Var, _, _) :-
  955    var(Var),
  956    !.
  957extend_term_pos(term_position(F,T,FT,TT,ArgPosIn),
  958                N,
  959                term_position(F,T,FT,TT,ArgPosOut)) :-
  960    !,
  961    length(Extra, N),
  962    maplist(=(0-0), Extra),
  963    append(ArgPosIn, Extra, ArgPosOut).
  964extend_term_pos(F-T, N, term_position(F,T,F,T,Extra)) :-
  965    length(Extra, N),
  966    maplist(=(0-0), Extra).
 variants(+SortedList, -Variants) is det
  971variants([], []).
  972variants([H|T], List) :-
  973    variants(T, H, List).
  974
  975variants([], H, [H]).
  976variants([H|T], V, List) :-
  977    (   H =@= V
  978    ->  variants(T, V, List)
  979    ;   List = [V|List2],
  980        variants(T, H, List2)
  981    ).
 predicate_in_module(+Module, ?PI) is nondet
True if PI is a predicate locally defined in Module.
  987predicate_in_module(Module, PI) :-
  988    current_predicate(Module:PI),
  989    PI = Name/Arity,
  990    functor(Head, Name, Arity),
  991    \+ predicate_property(Module:Head, imported_from(_)).
  992
  993
  994                 /*******************************
  995                 *      ENUMERATE CLAUSES       *
  996                 *******************************/
 prolog_program_clause(-ClauseRef, +Options) is nondet
True when ClauseRef is a reference for clause in the program. Options is a subset of the options processed by prolog_walk_code/1. The logic for deciding on which clauses to enumerate is shared with prolog_walk_code/1.
 1008prolog_program_clause(ClauseRef, Options) :-
 1009    make_walk_option(Options, OTerm, _),
 1010    setup_call_cleanup(
 1011        true,
 1012        (   current_module(Module),
 1013            scan_module(Module, OTerm),
 1014            module_clause(Module, ClauseRef, OTerm)
 1015        ;   retract(multifile_predicate(Name, Arity, MM)),
 1016            multifile_clause(ClauseRef, MM:Name/Arity, OTerm)
 1017        ;   initialization_clause(ClauseRef, OTerm)
 1018        ),
 1019        retractall(multifile_predicate(_,_,_))).
 1020
 1021
 1022module_clause(Module, ClauseRef, _OTerm) :-
 1023    predicate_in_module(Module, Name/Arity),
 1024    \+ multifile_predicate(Name, Arity, Module),
 1025    functor(Head, Name, Arity),
 1026    (   predicate_property(Module:Head, multifile)
 1027    ->  assertz(multifile_predicate(Name, Arity, Module)),
 1028        fail
 1029    ;   predicate_property(Module:Head, Property),
 1030        no_enum_property(Property)
 1031    ->  fail
 1032    ;   catch(nth_clause(Module:Head, _, ClauseRef), _, fail)
 1033    ).
 1034
 1035no_enum_property(foreign).
 1036
 1037multifile_clause(ClauseRef, M:Name/Arity, OTerm) :-
 1038    functor(Head, Name, Arity),
 1039    catch(clauseref_not_from_development(M:Head, ClauseRef, OTerm),
 1040          _, fail).
 1041
 1042clauseref_not_from_development(Module:Head, Ref, OTerm) :-
 1043    nth_clause(Module:Head, _N, Ref),
 1044    \+ ( clause_property(Ref, file(File)),
 1045         module_property(LoadModule, file(File)),
 1046         \+ scan_module(LoadModule, OTerm)
 1047       ).
 1048
 1049initialization_clause(ClauseRef, OTerm) :-
 1050    catch(clause(system:'$init_goal'(_File, M:_Goal, SourceLocation),
 1051                 true, ClauseRef),
 1052          _, fail),
 1053    walk_option_initialization(OTerm, SourceLocation),
 1054    scan_module(M, OTerm).
 1055
 1056
 1057                 /*******************************
 1058                 *            MESSAGES          *
 1059                 *******************************/
 1060
 1061:- multifile
 1062    prolog:message//1,
 1063    prolog:message_location//1. 1064
 1065prolog:message(trace_call_to(PI, Context)) -->
 1066    [ 'Call to ~q at '-[PI] ],
 1067    prolog:message_location(Context).
 1068
 1069prolog:message_location(clause_term_position(ClauseRef, TermPos)) -->
 1070    { clause_property(ClauseRef, file(File)) },
 1071    message_location_file_term_position(File, TermPos).
 1072prolog:message_location(clause(ClauseRef)) -->
 1073    { clause_property(ClauseRef, file(File)),
 1074      clause_property(ClauseRef, line_count(Line))
 1075    },
 1076    !,
 1077    [ '~w:~d: '-[File, Line] ].
 1078prolog:message_location(clause(ClauseRef)) -->
 1079    { clause_name(ClauseRef, Name) },
 1080    [ '~w: '-[Name] ].
 1081prolog:message_location(file_term_position(Path, TermPos)) -->
 1082    message_location_file_term_position(Path, TermPos).
 1083prolog:message(codewalk(reiterate(New, Iteration, CPU))) -->
 1084    [ 'Found new meta-predicates in iteration ~w (~3f sec)'-
 1085      [Iteration, CPU], nl ],
 1086    meta_decls(New),
 1087    [ 'Restarting analysis ...'-[], nl ].
 1088
 1089meta_decls([]) --> [].
 1090meta_decls([H|T]) -->
 1091    [ ':- meta_predicate ~q.'-[H], nl ],
 1092    meta_decls(T).
 1093
 1094message_location_file_term_position(File, TermPos) -->
 1095    { arg(1, TermPos, CharCount),
 1096      filepos_line(File, CharCount, Line, LinePos)
 1097    },
 1098    [ '~w:~d:~d: '-[File, Line, LinePos] ].
 filepos_line(+File, +CharPos, -Line, -Column) is det
Arguments:
CharPos- is 0-based character offset in the file.
Column- is the current column, counting tabs as 8 spaces.
 1105filepos_line(File, CharPos, Line, LinePos) :-
 1106    setup_call_cleanup(
 1107        ( open(File, read, In),
 1108          open_null_stream(Out)
 1109        ),
 1110        ( copy_stream_data(In, Out, CharPos),
 1111          stream_property(In, position(Pos)),
 1112          stream_position_data(line_count, Pos, Line),
 1113          stream_position_data(line_position, Pos, LinePos)
 1114        ),
 1115        ( close(Out),
 1116          close(In)
 1117        ))