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