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-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)).

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)).

*/

   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
 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.
  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).
 walk_clauses(+Clauses, +OTerm) is det
Walk the given clauses.
  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           )).
 scan_module(+Module, +OTerm) is semidet
True if we must scan Module according to OTerm.
  254scan_module(M, OTerm) :-
  255    walk_option_module_class(OTerm, Classes),
  256    module_property(M, class(Class)),
  257    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.
  266walk_from_initialization(OTerm) :-
  267    walk_option_caller(OTerm, '<initialization>'),
  268    forall(init_goal_in_scope(Goal, SourceLocation, OTerm),
  269           ( walk_option_initialization(OTerm, SourceLocation),
  270             walk_from_initialization(Goal, OTerm))).
  271
  272init_goal_in_scope(Goal, SourceLocation, OTerm) :-
  273    '$init_goal'(File, Goal, SourceLocation),
  274    (   walk_option_module(OTerm, M),
  275        nonvar(M)
  276    ->  module_property(M, file(File))
  277    ;   walk_option_module_class(OTerm, Classes),
  278        source_file_property(File, module(MF))
  279    ->  module_property(MF, class(Class)),
  280        memberchk(Class, Classes)
  281    ;   true
  282    ).
  283
  284walk_from_initialization(M:Goal, OTerm) :-
  285    scan_module(M, OTerm),
  286    !,
  287    walk_called_by_body(Goal, M, OTerm).
  288walk_from_initialization(_, _).
 find_walk_from_module(+Module, +OTerm) is det
Find undefined calls from the bodies of all clauses that belong to Module.
  296find_walk_from_module(M, OTerm) :-
  297    debug(autoload, 'Analysing module ~q', [M]),
  298    forall(predicate_in_module(M, PI),
  299           walk_called_by_pred(M:PI, OTerm)).
  300
  301walk_called_by_pred(Module:Name/Arity, _) :-
  302    multifile_predicate(Name, Arity, Module),
  303    !.
  304walk_called_by_pred(Module:Name/Arity, _) :-
  305    functor(Head, Name, Arity),
  306    predicate_property(Module:Head, multifile),
  307    !,
  308    assertz(multifile_predicate(Name, Arity, Module)).
  309walk_called_by_pred(Module:Name/Arity, OTerm) :-
  310    functor(Head, Name, Arity),
  311    (   no_walk_property(Property),
  312        predicate_property(Module:Head, Property)
  313    ->  true
  314    ;   walk_option_caller(OTerm, Module:Head),
  315        walk_option_clause(OTerm, ClauseRef),
  316        forall(catch(clause(Module:Head, Body, ClauseRef), _, fail),
  317               walk_called_by_body(Body, Module, OTerm))
  318    ).
  319
  320no_walk_property(number_of_rules(0)).   % no point walking only facts
  321no_walk_property(foreign).              % cannot walk foreign code
 walk_from_multifile(+OTerm)
Process registered multifile predicates.
  327walk_from_multifile(OTerm) :-
  328    forall(retract(multifile_predicate(Name, Arity, Module)),
  329           walk_called_by_multifile(Module:Name/Arity, OTerm)).
  330
  331walk_called_by_multifile(Module:Name/Arity, OTerm) :-
  332    functor(Head, Name, Arity),
  333    forall(catch(clause_not_from_development(
  334                     Module:Head, Body, ClauseRef, OTerm),
  335                 _, fail),
  336           ( walk_option_clause(OTerm, ClauseRef),
  337             walk_option_caller(OTerm, Module:Head),
  338             walk_called_by_body(Body, Module, OTerm)
  339           )).
 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.
  347clause_not_from_development(Module:Head, Body, Ref, OTerm) :-
  348    clause(Module:Head, Body, Ref),
  349    \+ ( clause_property(Ref, file(File)),
  350         module_property(LoadModule, file(File)),
  351         \+ scan_module(LoadModule, OTerm)
  352       ).
 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
  362walk_called_by_body(True, _, _) :-
  363    True == true,
  364    !.                % quickly deal with facts
  365walk_called_by_body(Body, Module, OTerm) :-
  366    set_undecided_of_walk_option(error, OTerm, OTerm1),
  367    set_evaluate_of_walk_option(false, OTerm1, OTerm2),
  368    catch(walk_called(Body, Module, _TermPos, OTerm2),
  369          missing(Missing),
  370          walk_called_by_body(Missing, Body, Module, OTerm)),
  371    !.
  372walk_called_by_body(Body, Module, OTerm) :-
  373    format(user_error, 'Failed to analyse:~n', []),
  374    portray_clause(('<head>' :- Body)),
  375    debug_walk(Body, Module, OTerm).
  376
  377% recompile this library after `debug(codewalk(trace))` and re-try
  378% for debugging failures.
  379:- if(debugging(codewalk(trace))).  380debug_walk(Body, Module, OTerm) :-
  381    gtrace,
  382    walk_called_by_body(Body, Module, OTerm).
  383:- else.  384debug_walk(_,_,_).
  385:- endif.
 walk_called_by_body(+Missing, +Body, +Module, +OTerm)
Restart the analysis because the previous analysis provided insufficient information.
  392walk_called_by_body(Missing, Body, _, OTerm) :-
  393    debugging(codewalk),
  394    format(user_error, 'Retrying due to ~w (~p)~n', [Missing, OTerm]),
  395    portray_clause(('<head>' :- Body)), fail.
  396walk_called_by_body(undecided_call, Body, Module, OTerm) :-
  397    catch(forall(walk_called(Body, Module, _TermPos, OTerm),
  398                 true),
  399          missing(Missing),
  400          walk_called_by_body(Missing, Body, Module, OTerm)).
  401walk_called_by_body(subterm_positions, Body, Module, OTerm) :-
  402    (   (   walk_option_clause(OTerm, ClauseRef), nonvar(ClauseRef),
  403            clause_info(ClauseRef, _, TermPos, _NameOffset),
  404            TermPos = term_position(_,_,_,_,[_,BodyPos])
  405        ->  WBody = Body
  406        ;   walk_option_initialization(OTerm, SrcLoc),
  407            ground(SrcLoc), SrcLoc = _File:_Line,
  408            initialization_layout(SrcLoc, Module:Body, WBody, BodyPos)
  409        )
  410    ->  catch(forall(walk_called(WBody, Module, BodyPos, OTerm),
  411                     true),
  412              missing(subterm_positions),
  413              walk_called_by_body(no_positions, Body, Module, OTerm))
  414    ;   set_source_of_walk_option(false, OTerm, OTerm2),
  415        forall(walk_called(Body, Module, _BodyPos, OTerm2),
  416               true)
  417    ).
  418walk_called_by_body(no_positions, Body, Module, OTerm) :-
  419    set_source_of_walk_option(false, OTerm, OTerm2),
  420    forall(walk_called(Body, Module, _NoPos, OTerm2),
  421           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))?
  451walk_called(Term, Module, parentheses_term_position(_,_,Pos), OTerm) :-
  452    nonvar(Pos),
  453    !,
  454    walk_called(Term, Module, Pos, OTerm).
  455walk_called(Var, _, TermPos, OTerm) :-
  456    var(Var),                              % Incomplete analysis
  457    !,
  458    undecided(Var, TermPos, OTerm).
  459walk_called(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :-
  460    !,
  461    (   nonvar(M)
  462    ->  walk_called(G, M, Pos, OTerm)
  463    ;   undecided(M, MPos, OTerm)
  464    ).
  465walk_called((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  466    !,
  467    walk_called(A, M, PA, OTerm),
  468    walk_called(B, M, PB, OTerm).
  469walk_called((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  470    !,
  471    walk_called(A, M, PA, OTerm),
  472    walk_called(B, M, PB, OTerm).
  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), M, term_position(_,_,_,_,[PA]), OTerm) :-
  478    !,
  479    \+ \+ walk_called(A, M, PA, OTerm).
  480walk_called((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  481    !,
  482    (   walk_option_evaluate(OTerm, Eval), Eval == true
  483    ->  Goal = (A;B),
  484        setof(Goal,
  485              (   walk_called(A, M, PA, OTerm)
  486              ;   walk_called(B, M, PB, OTerm)
  487              ),
  488              Alts0),
  489        variants(Alts0, Alts),
  490        member(Goal, Alts)
  491    ;   \+ \+ walk_called(A, M, PA, OTerm), % do not propagate bindings
  492        \+ \+ walk_called(B, M, PB, OTerm)
  493    ).
  494walk_called(Goal, Module, TermPos, OTerm) :-
  495    walk_option_trace_reference(OTerm, To), To \== (-),
  496    (   subsumes_term(To, Module:Goal)
  497    ->  M2 = Module
  498    ;   predicate_property(Module:Goal, imported_from(M2)),
  499        subsumes_term(To, M2:Goal)
  500    ),
  501    print_reference(M2:Goal, TermPos, trace, OTerm),
  502    fail.                                   % Continue search
  503walk_called(Goal, Module, _, OTerm) :-
  504    evaluate(Goal, Module, OTerm),
  505    !.
  506walk_called(Goal, M, TermPos, OTerm) :-
  507    (   (   predicate_property(M:Goal, imported_from(IM))
  508        ->  true
  509        ;   IM = M
  510        ),
  511        prolog:called_by(Goal, IM, M, Called)
  512    ;   prolog:called_by(Goal, Called)
  513    ),
  514    Called \== [],
  515    !,
  516    walk_called_by(Called, M, Goal, TermPos, OTerm).
  517walk_called(Meta, M, term_position(_,E,_,_,ArgPosList), OTerm) :-
  518    (   walk_option_autoload(OTerm, false)
  519    ->  nonvar(M),
  520        '$get_predicate_attribute'(M:Meta, defined, 1)
  521    ;   true
  522    ),
  523    (   predicate_property(M:Meta, meta_predicate(Head))
  524    ;   inferred_meta_predicate(M:Meta, Head)
  525    ),
  526    !,
  527    walk_option_clause(OTerm, ClauseRef),
  528    register_possible_meta_clause(ClauseRef),
  529    walk_meta_call(1, Head, Meta, M, ArgPosList, E-E, OTerm).
  530walk_called(Closure, _, _, _) :-
  531    blob(Closure, closure),
  532    !,
  533    '$closure_predicate'(Closure, Module:Name/Arity),
  534    functor(Head, Name, Arity),
  535    '$get_predicate_attribute'(Module:Head, defined, 1).
  536walk_called(ClosureCall, _, _, _) :-
  537    compound(ClosureCall),
  538    functor(ClosureCall, 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(Goal, Module, _, _) :-
  545    nonvar(Module),
  546    '$get_predicate_attribute'(Module:Goal, defined, 1),
  547    !.
  548walk_called(Goal, Module, TermPos, OTerm) :-
  549    callable(Goal),
  550    !,
  551    undefined(Module:Goal, TermPos, OTerm).
  552walk_called(Goal, _Module, TermPos, OTerm) :-
  553    not_callable(Goal, TermPos, OTerm).
 undecided(+Variable, +TermPos, +OTerm)
  557undecided(Var, TermPos, OTerm) :-
  558    walk_option_undecided(OTerm, Undecided),
  559    (   var(Undecided)
  560    ->  Action = ignore
  561    ;   Action = Undecided
  562    ),
  563    undecided(Action, Var, TermPos, OTerm).
  564
  565undecided(ignore, _, _, _) :- !.
  566undecided(error,  _, _, _) :-
  567    throw(missing(undecided_call)).
 evaluate(Goal, Module, OTerm) is nondet
  571evaluate(Goal, Module, OTerm) :-
  572    walk_option_evaluate(OTerm, Evaluate),
  573    Evaluate \== false,
  574    evaluate(Goal, Module).
  575
  576evaluate(A=B, _) :-
  577    unify_with_occurs_check(A, B).
 undefined(:Goal, +TermPos, +OTerm)
The analysis trapped a definitely undefined predicate.
  583undefined(_, _, OTerm) :-
  584    walk_option_undefined(OTerm, ignore),
  585    !.
  586undefined(Goal, _, _) :-
  587    predicate_property(Goal, autoload(_)),
  588    !.
  589undefined(Goal, TermPos, OTerm) :-
  590    (   walk_option_undefined(OTerm, trace)
  591    ->  Why = trace
  592    ;   Why = undefined
  593    ),
  594    print_reference(Goal, TermPos, Why, OTerm).
 not_callable(+Goal, +TermPos, +OTerm)
We found a reference to a non-callable term
  600not_callable(Goal, TermPos, OTerm) :-
  601    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
  610print_reference(Goal, TermPos, Why, OTerm) :-
  611    walk_option_clause(OTerm, Clause), nonvar(Clause),
  612    !,
  613    (   compound(TermPos),
  614        arg(1, TermPos, CharCount),
  615        integer(CharCount)          % test it is valid
  616    ->  From = clause_term_position(Clause, TermPos)
  617    ;   walk_option_source(OTerm, false)
  618    ->  From = clause(Clause)
  619    ;   From = _,
  620        throw(missing(subterm_positions))
  621    ),
  622    print_reference2(Goal, From, Why, OTerm).
  623print_reference(Goal, TermPos, Why, OTerm) :-
  624    walk_option_initialization(OTerm, Init), nonvar(Init),
  625    Init = File:Line,
  626    !,
  627    (   compound(TermPos),
  628        arg(1, TermPos, CharCount),
  629        integer(CharCount)          % test it is valid
  630    ->  From = file_term_position(File, TermPos)
  631    ;   walk_option_source(OTerm, false)
  632    ->  From = file(File, Line, -1, _)
  633    ;   From = _,
  634        throw(missing(subterm_positions))
  635    ),
  636    print_reference2(Goal, From, Why, OTerm).
  637print_reference(Goal, _, Why, OTerm) :-
  638    print_reference2(Goal, _, Why, OTerm).
  639
  640print_reference2(Goal, From, trace, OTerm) :-
  641    walk_option_on_trace(OTerm, Closure),
  642    walk_option_caller(OTerm, Caller),
  643    nonvar(Closure),
  644    call(Closure, Goal, Caller, From),
  645    !.
  646print_reference2(Goal, From, Why, _OTerm) :-
  647    make_message(Why, Goal, From, Message, Level),
  648    print_message(Level, Message).
  649
  650
  651make_message(undefined, Goal, Context,
  652             error(existence_error(procedure, PI), Context), error) :-
  653    goal_pi(Goal, PI).
  654make_message(not_callable, Goal, Context,
  655             error(type_error(callable, Goal), Context), error).
  656make_message(trace, Goal, Context,
  657             trace_call_to(PI, Context), informational) :-
  658    goal_pi(Goal, PI).
  659
  660
  661goal_pi(Goal, M:Name/Arity) :-
  662    strip_module(Goal, M, Head),
  663    callable(Head),
  664    !,
  665    functor(Head, Name, Arity).
  666goal_pi(Goal, Goal).
  667
  668:- dynamic
  669    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.
  678register_possible_meta_clause(ClausesRef) :-
  679    nonvar(ClausesRef),
  680    clause_property(ClausesRef, predicate(PI)),
  681    pi_head(PI, Head, Module),
  682    module_property(Module, class(user)),
  683    \+ predicate_property(Module:Head, meta_predicate(_)),
  684    \+ inferred_meta_predicate(Module:Head, _),
  685    \+ possible_meta_predicate(Head, Module),
  686    !,
  687    assertz(possible_meta_predicate(Head, Module)).
  688register_possible_meta_clause(_).
  689
  690pi_head(Module:Name/Arity, Head, Module)  :-
  691    !,
  692    functor(Head, Name, Arity).
  693pi_head(_, _, _) :-
  694    assertion(fail).
 infer_new_meta_predicates(-MetaSpecs, +OTerm) is det
  698infer_new_meta_predicates([], OTerm) :-
  699    walk_option_infer_meta_predicates(OTerm, false),
  700    !.
  701infer_new_meta_predicates(MetaSpecs, OTerm) :-
  702    findall(Module:MetaSpec,
  703            ( retract(possible_meta_predicate(Head, Module)),
  704              infer_meta_predicate(Module:Head, MetaSpec),
  705              (   walk_option_infer_meta_predicates(OTerm, all)
  706              ->  true
  707              ;   calling_metaspec(MetaSpec)
  708              )
  709            ),
  710            MetaSpecs).
 calling_metaspec(+Head) is semidet
True if this is a meta-specification that makes a difference to the code walker.
  717calling_metaspec(Head) :-
  718    arg(_, Head, Arg),
  719    calling_metaarg(Arg),
  720    !.
  721
  722calling_metaarg(I) :- integer(I), !.
  723calling_metaarg(^).
  724calling_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.
  737walk_meta_call(I, Head, Meta, M, ArgPosList, EPos, OTerm) :-
  738    arg(I, Head, AS),
  739    !,
  740    (   ArgPosList = [ArgPos|ArgPosTail]
  741    ->  true
  742    ;   ArgPos = EPos,
  743        ArgPosTail = []
  744    ),
  745    (   integer(AS)
  746    ->  arg(I, Meta, MA),
  747        extend(MA, AS, Goal, ArgPos, ArgPosEx, OTerm),
  748        walk_called(Goal, M, ArgPosEx, OTerm)
  749    ;   AS == (^)
  750    ->  arg(I, Meta, MA),
  751        remove_quantifier(MA, Goal, ArgPos, ArgPosEx, M, MG, OTerm),
  752        walk_called(Goal, MG, ArgPosEx, OTerm)
  753    ;   AS == (//)
  754    ->  arg(I, Meta, DCG),
  755        walk_dcg_body(DCG, M, ArgPos, OTerm)
  756    ;   true
  757    ),
  758    succ(I, I2),
  759    walk_meta_call(I2, Head, Meta, M, ArgPosTail, EPos, OTerm).
  760walk_meta_call(_, _, _, _, _, _, _).
  761
  762remove_quantifier(Goal, _, TermPos, TermPos, M, M, OTerm) :-
  763    var(Goal),
  764    !,
  765    undecided(Goal, TermPos, OTerm).
  766remove_quantifier(_^Goal0, Goal,
  767                  term_position(_,_,_,_,[_,GPos]),
  768                  TermPos, M0, M, OTerm) :-
  769    !,
  770    remove_quantifier(Goal0, Goal, GPos, TermPos, M0, M, OTerm).
  771remove_quantifier(M1:Goal0, Goal,
  772                  term_position(_,_,_,_,[_,GPos]),
  773                  TermPos, _, M, OTerm) :-
  774    !,
  775    remove_quantifier(Goal0, Goal, GPos, TermPos, M1, M, OTerm).
  776remove_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.
  784walk_called_by([], _, _, _, _).
  785walk_called_by([H|T], M, Goal, TermPos, OTerm) :-
  786    (   H = G0+N
  787    ->  subterm_pos(G0, M, Goal, TermPos, G, GPos),
  788        (   extend(G, N, G2, GPos, GPosEx, OTerm)
  789        ->  walk_called(G2, M, GPosEx, OTerm)
  790        ;   true
  791        )
  792    ;   subterm_pos(H, M, Goal, TermPos, G, GPos),
  793        walk_called(G, M, GPos, OTerm)
  794    ),
  795    walk_called_by(T, M, Goal, TermPos, OTerm).
  796
  797subterm_pos(Sub, _, Term, TermPos, Sub, SubTermPos) :-
  798    subterm_pos(Sub, Term, TermPos, SubTermPos),
  799    !.
  800subterm_pos(Sub, M, Term, TermPos, G, SubTermPos) :-
  801    nonvar(Sub),
  802    Sub = M:H,
  803    !,
  804    subterm_pos(H, M, Term, TermPos, G, SubTermPos).
  805subterm_pos(Sub, _, _, _, Sub, _).
  806
  807subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  808    subterm_pos(Sub, Term, same_term, TermPos, SubTermPos),
  809    !.
  810subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  811    subterm_pos(Sub, Term, ==, TermPos, SubTermPos),
  812    !.
  813subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  814    subterm_pos(Sub, Term, =@=, TermPos, SubTermPos),
  815    !.
  816subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  817    subterm_pos(Sub, Term, subsumes_term, TermPos, SubTermPos),
  818    !.
 walk_dcg_body(+Body, +Module, +TermPos, +OTerm)
Walk a DCG body that is meta-called.
  824walk_dcg_body(Var, _Module, TermPos, OTerm) :-
  825    var(Var),
  826    !,
  827    undecided(Var, TermPos, OTerm).
  828walk_dcg_body([], _Module, _, _) :- !.
  829walk_dcg_body([_|_], _Module, _, _) :- !.
  830walk_dcg_body(String, _Module, _, _) :-
  831    string(String),
  832    !.
  833walk_dcg_body(!, _Module, _, _) :- !.
  834walk_dcg_body(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :-
  835    !,
  836    (   nonvar(M)
  837    ->  walk_dcg_body(G, M, Pos, OTerm)
  838    ;   undecided(M, MPos, OTerm)
  839    ).
  840walk_dcg_body((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  841    !,
  842    walk_dcg_body(A, M, PA, OTerm),
  843    walk_dcg_body(B, M, PB, OTerm).
  844walk_dcg_body((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  845    !,
  846    walk_dcg_body(A, M, PA, OTerm),
  847    walk_dcg_body(B, M, PB, OTerm).
  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)
  856    ).
  857walk_dcg_body((A|B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
  858    !,
  859    (   walk_dcg_body(A, M, PA, OTerm)
  860    ;   walk_dcg_body(B, M, PB, OTerm)
  861    ).
  862walk_dcg_body({G}, M, brace_term_position(_,_,PG), OTerm) :-
  863    !,
  864    walk_called(G, M, PG, OTerm).
  865walk_dcg_body(G, M, TermPos, OTerm) :-
  866    extend(G, 2, G2, TermPos, TermPosEx, OTerm),
  867    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
  878:- meta_predicate
  879    subterm_pos(+, +, 2, +, -),
  880    sublist_pos(+, +, +, +, 2, -).  881
  882subterm_pos(_, _, _, Pos, _) :-
  883    var(Pos), !, fail.
  884subterm_pos(Sub, Term, Cmp, Pos, Pos) :-
  885    call(Cmp, Sub, Term),
  886    !.
  887subterm_pos(Sub, Term, Cmp, term_position(_,_,_,_,ArgPosList), Pos) :-
  888    is_list(ArgPosList),
  889    compound(Term),
  890    nth1(I, ArgPosList, ArgPos),
  891    arg(I, Term, Arg),
  892    subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
  893subterm_pos(Sub, Term, Cmp, list_position(_,_,ElemPosList,TailPos), Pos) :-
  894    sublist_pos(ElemPosList, TailPos, Sub, Term, Cmp, Pos).
  895subterm_pos(Sub, {Arg}, Cmp, brace_term_position(_,_,ArgPos), Pos) :-
  896    subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
  897
  898sublist_pos([EP|TP], TailPos, Sub, [H|T], Cmp, Pos) :-
  899    (   subterm_pos(Sub, H, Cmp, EP, Pos)
  900    ;   sublist_pos(TP, TailPos, Sub, T, Cmp, Pos)
  901    ).
  902sublist_pos([], TailPos, Sub, Tail, Cmp, Pos) :-
  903    TailPos \== none,
  904    subterm_pos(Sub, Tail, Cmp, TailPos, Pos).
 extend(+Goal, +ExtraArgs, +TermPosIn, -TermPosOut, +OTerm)
bug
- :
  910extend(Goal, 0, Goal, TermPos, TermPos, _) :- !.
  911extend(Goal, _, _, TermPos, TermPos, OTerm) :-
  912    var(Goal),
  913    !,
  914    undecided(Goal, TermPos, OTerm).
  915extend(M:Goal, N, M:GoalEx,
  916       term_position(F,T,FT,TT,[MPos,GPosIn]),
  917       term_position(F,T,FT,TT,[MPos,GPosOut]), OTerm) :-
  918    !,
  919    (   var(M)
  920    ->  undecided(N, MPos, OTerm)
  921    ;   true
  922    ),
  923    extend(Goal, N, GoalEx, GPosIn, GPosOut, OTerm).
  924extend(Goal, N, GoalEx, TermPosIn, TermPosOut, _) :-
  925    callable(Goal),
  926    !,
  927    Goal =.. List,
  928    length(Extra, N),
  929    extend_term_pos(TermPosIn, N, TermPosOut),
  930    append(List, Extra, ListEx),
  931    GoalEx =.. ListEx.
  932extend(Closure, N, M:GoalEx, TermPosIn, TermPosOut, OTerm) :-
  933    blob(Closure, closure),             % call(Closure, A1, ...)
  934    !,
  935    '$closure_predicate'(Closure, M:Name/Arity),
  936    length(Extra, N),
  937    extend_term_pos(TermPosIn, N, TermPosOut),
  938    GoalEx =.. [Name|Extra],
  939    (   N =:= Arity
  940    ->  true
  941    ;   print_reference(Closure, TermPosIn, closure_arity_mismatch, OTerm)
  942    ).
  943extend(Goal, _, _, TermPos, _, OTerm) :-
  944    print_reference(Goal, TermPos, not_callable, OTerm).
  945
  946extend_term_pos(Var, _, _) :-
  947    var(Var),
  948    !.
  949extend_term_pos(term_position(F,T,FT,TT,ArgPosIn),
  950                N,
  951                term_position(F,T,FT,TT,ArgPosOut)) :-
  952    !,
  953    length(Extra, N),
  954    maplist(=(0-0), Extra),
  955    append(ArgPosIn, Extra, ArgPosOut).
  956extend_term_pos(F-T, N, term_position(F,T,F,T,Extra)) :-
  957    length(Extra, N),
  958    maplist(=(0-0), Extra).
 variants(+SortedList, -Variants) is det
  963variants([], []).
  964variants([H|T], List) :-
  965    variants(T, H, List).
  966
  967variants([], H, [H]).
  968variants([H|T], V, List) :-
  969    (   H =@= V
  970    ->  variants(T, V, List)
  971    ;   List = [V|List2],
  972        variants(T, H, List2)
  973    ).
 predicate_in_module(+Module, ?PI) is nondet
True if PI is a predicate locally defined in Module.
  979predicate_in_module(Module, PI) :-
  980    current_predicate(Module:PI),
  981    PI = Name/Arity,
  982    functor(Head, Name, Arity),
  983    \+ predicate_property(Module:Head, imported_from(_)).
  984
  985
  986                 /*******************************
  987                 *      ENUMERATE CLAUSES       *
  988                 *******************************/
 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.
 1000prolog_program_clause(ClauseRef, Options) :-
 1001    make_walk_option(Options, OTerm, _),
 1002    setup_call_cleanup(
 1003        true,
 1004        (   current_module(Module),
 1005            scan_module(Module, OTerm),
 1006            module_clause(Module, ClauseRef, OTerm)
 1007        ;   retract(multifile_predicate(Name, Arity, MM)),
 1008            multifile_clause(ClauseRef, MM:Name/Arity, OTerm)
 1009        ;   initialization_clause(ClauseRef, OTerm)
 1010        ),
 1011        retractall(multifile_predicate(_,_,_))).
 1012
 1013
 1014module_clause(Module, ClauseRef, _OTerm) :-
 1015    predicate_in_module(Module, Name/Arity),
 1016    \+ multifile_predicate(Name, Arity, Module),
 1017    functor(Head, Name, Arity),
 1018    (   predicate_property(Module:Head, multifile)
 1019    ->  assertz(multifile_predicate(Name, Arity, Module)),
 1020        fail
 1021    ;   predicate_property(Module:Head, Property),
 1022        no_enum_property(Property)
 1023    ->  fail
 1024    ;   catch(nth_clause(Module:Head, _, ClauseRef), _, fail)
 1025    ).
 1026
 1027no_enum_property(foreign).
 1028
 1029multifile_clause(ClauseRef, M:Name/Arity, OTerm) :-
 1030    functor(Head, Name, Arity),
 1031    catch(clauseref_not_from_development(M:Head, ClauseRef, OTerm),
 1032          _, fail).
 1033
 1034clauseref_not_from_development(Module:Head, Ref, OTerm) :-
 1035    nth_clause(Module:Head, _N, Ref),
 1036    \+ ( clause_property(Ref, file(File)),
 1037         module_property(LoadModule, file(File)),
 1038         \+ scan_module(LoadModule, OTerm)
 1039       ).
 1040
 1041initialization_clause(ClauseRef, OTerm) :-
 1042    catch(clause(system:'$init_goal'(_File, M:_Goal, SourceLocation),
 1043                 true, ClauseRef),
 1044          _, fail),
 1045    walk_option_initialization(OTerm, SourceLocation),
 1046    scan_module(M, OTerm).
 1047
 1048
 1049                 /*******************************
 1050                 *            MESSAGES          *
 1051                 *******************************/
 1052
 1053:- multifile
 1054    prolog:message//1,
 1055    prolog:message_location//1. 1056
 1057prolog:message(trace_call_to(PI, Context)) -->
 1058    [ 'Call to ~q at '-[PI] ],
 1059    prolog:message_location(Context).
 1060
 1061prolog:message_location(clause_term_position(ClauseRef, TermPos)) -->
 1062    { clause_property(ClauseRef, file(File)) },
 1063    message_location_file_term_position(File, TermPos).
 1064prolog:message_location(clause(ClauseRef)) -->
 1065    { clause_property(ClauseRef, file(File)),
 1066      clause_property(ClauseRef, line_count(Line))
 1067    },
 1068    !,
 1069    [ '~w:~d: '-[File, Line] ].
 1070prolog:message_location(clause(ClauseRef)) -->
 1071    { clause_name(ClauseRef, Name) },
 1072    [ '~w: '-[Name] ].
 1073prolog:message_location(file_term_position(Path, TermPos)) -->
 1074    message_location_file_term_position(Path, TermPos).
 1075prolog:message(codewalk(reiterate(New, Iteration, CPU))) -->
 1076    [ 'Found new meta-predicates in iteration ~w (~3f sec)'-
 1077      [Iteration, CPU], nl ],
 1078    meta_decls(New),
 1079    [ 'Restarting analysis ...'-[], nl ].
 1080
 1081meta_decls([]) --> [].
 1082meta_decls([H|T]) -->
 1083    [ ':- meta_predicate ~q.'-[H], nl ],
 1084    meta_decls(T).
 1085
 1086message_location_file_term_position(File, TermPos) -->
 1087    { arg(1, TermPos, CharCount),
 1088      filepos_line(File, CharCount, Line, LinePos)
 1089    },
 1090    [ '~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.
 1097filepos_line(File, CharPos, Line, LinePos) :-
 1098    setup_call_cleanup(
 1099        ( open(File, read, In),
 1100          open_null_stream(Out)
 1101        ),
 1102        ( copy_stream_data(In, Out, CharPos),
 1103          stream_property(In, position(Pos)),
 1104          stream_position_data(line_count, Pos, Line),
 1105          stream_position_data(line_position, Pos, LinePos)
 1106        ),
 1107        ( close(Out),
 1108          close(In)
 1109        ))