1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * Author: Andreas Becker
    5 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    6 * Mail: pdt@lists.iai.uni-bonn.de
    7 * Copyright (C): 2012, CS Dept. III, University of Bonn
    8 * 
    9 * All rights reserved. This program is  made available under the terms
   10 * of the Eclipse Public License v1.0 which accompanies this distribution,
   11 * and is available at http://www.eclipse.org/legal/epl-v10.html
   12 * 
   13 ****************************************************************************/
   14
   15/* NOTE: This file contains third-party code!
   16
   17   Most of this file was borrowed from the swi-prolog library 
   18   prolog_codewalk. Many thanks to the original authors for making their 
   19   work available to the public. 
   20   
   21   The copyright header of the original file 
   22   follows.
   23*/
   24
   25/*  Part of SWI-Prolog
   26
   27    Author:        Jan Wielemaker
   28    E-mail:        J.Wielemaker@cs.vu.nl
   29    WWW:           http://www.swi-prolog.org
   30    Copyright (C): 2012, VU University Amsterdam
   31
   32    This program is free software; you can redistribute it and/or
   33    modify it under the terms of the GNU General Public License
   34    as published by the Free Software Foundation; either version 2
   35    of the License, or (at your option) any later version.
   36
   37    This program is distributed in the hope that it will be useful,
   38    but WITHOUT ANY WARRANTY; without even the implied warranty of
   39    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   40    GNU General Public License for more details.
   41
   42    You should have received a copy of the GNU General Public
   43    License along with this library; if not, write to the Free Software
   44    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   45
   46    As a special exception, if you link this library with other files,
   47    compiled with a Free Software compiler, to produce an executable, this
   48    library does not by itself cause the resulting executable to be covered
   49    by the GNU General Public License. This exception does not however
   50    invalidate any other reasons why the executable file might be covered by
   51    the GNU General Public License.
   52*/
   53
   54:- module(pdt_prolog_codewalk,
   55	  [ pdt_prolog_walk_code/1		% +Options
   56	  ]).   57:- use_module(library(option)).   58:- use_module(library(record)).   59:- use_module(library(debug)).   60:- use_module(library(apply)).   61:- use_module(library(error)).   62:- use_module(library(lists)).   63:- use_module(library(prolog_clause)).   64:- use_module(pdt_common_pl('metainference/pdt_prolog_metainference')).   65:- use_module(pdt_common_pl('metainference/pdt_meta_specification')).

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

   99:- meta_predicate
  100	prolog_walk_code(:).  101
  102:- predicate_options(pdt_prolog_walk_code/1, 1,
  103		     [ undefined(oneof([ignore,error,trace])),
  104		       autoload(boolean),
  105		       clauses(list),
  106		       module(atom),
  107		       module_class(oneof([default,user,system,
  108					   library,test,development])),
  109		       source(boolean),
  110		       trace_reference(any),
  111		       on_trace(callable),
  112		       infer_meta_predicates(oneof([false,true,all])),
  113		       reiterate(boolean),
  114		       predicates(list)
  115		     ]).  116
  117:- record
  118	walk_option(undefined:oneof([ignore,error,trace])=ignore,
  119		    autoload:boolean=true,
  120		    source:boolean=true,
  121		    module:atom,		% Only analyse given module
  122		    module_class:oneof([default,user,system,
  123					library,test,development])=default,
  124		    infer_meta_predicates:oneof([false,true,all])=true,
  125		    clauses:list,           % Walk only these clauses
  126		    trace_reference:any=(-),
  127		    on_trace:callable,		% Call-back on trace hits
  128		    new_meta_specs:callable,
  129		    reiterate:boolean=true,
  130		    predicates:list,
  131						% private stuff
  132		    clause,			% Processed clause
  133		    caller,			% Head of the caller
  134		    initialization,		% Initialization source
  135		    undecided,			% Error to throw error
  136		    evaluate:boolean, 		% Do partial evaluation
  137		    call_kind,
  138		    is_transparent_meta_call:boolean=false).
  139
  140:- thread_local
  141	multifile_predicate/3.		% Name, Arity, Module

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

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.

module(+Module)

Only process the given module

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_class(+ModuleClass)

Limit processing to modules of this class. 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.

@compat OnTrace was called using Caller-Location in older versions.

  212pdt_prolog_walk_code(Options) :-
  213	meta_options(is_meta, Options, QOptions),
  214	pdt_prolog_walk_code(1, QOptions).
  215
  216pdt_prolog_walk_code(Iteration, Options) :-
  217	statistics(cputime, CPU0),
  218	make_walk_option(Options, OTerm, _),
  219	walk_option_call_kind(OTerm, call),
  220	(	walk_option_clauses(OTerm, Clauses),
  221		nonvar(Clauses)
  222	->	walk_clauses(Clauses, OTerm)
  223	;	walk_option_predicates(OTerm, Predicates),
  224		nonvar(Predicates)
  225	->	forall((
  226			member(Module:Name/Arity, Predicates),
  227			functor(Head, Name, Arity),
  228			\+ predicate_property(Module:Head, imported_from(_))
  229		), (
  230			walk_called_by_pred(Module:Name/Arity, OTerm)
  231		))
  232	;	forall(( walk_option_module(OTerm, M),
  233		         current_module(M),
  234		         scan_module(M, OTerm)
  235		       ),
  236		       find_walk_from_module(M, OTerm))
  237	),
  238	walk_from_multifile(OTerm),
  239	walk_from_initialization(OTerm),
  240	infer_new_meta_predicates(New, OTerm),
  241	statistics(cputime, CPU1),
  242	(   New \== []
  243	->  walk_option_new_meta_specs(OTerm, Closure),
  244	    (	callable(Closure)
  245	    ->	call(Closure, New)
  246	    ;	true
  247	    ),
  248	    CPU is CPU1-CPU0,
  249	    print_message(informational,
  250			  codewalk(reiterate(New, Iteration, CPU))),
  251		walk_option_reiterate(OTerm, Reiterate),
  252	    (	Reiterate == true
  253	    ->	succ(Iteration, Iteration2),
  254	    	pdt_prolog_walk_code(Iteration2, Options)
  255	    ;	true
  256	    )
  257	;   true
  258	).
  259
  260is_meta(on_trace).

 walk_clauses(Clauses, +OTerm) is det

Walk the given clauses.

  266walk_clauses(Clauses, OTerm) :-
  267	must_be(list, Clauses),
  268	forall(member(ClauseRef, Clauses),
  269	       ( user:clause(CHead, Body, ClauseRef),
  270		 (   CHead = Module:Head
  271		 ->  true
  272		 ;   Module = user,
  273		     Head = CHead
  274		 ),
  275		 walk_option_clause(OTerm, ClauseRef),
  276		 walk_option_caller(OTerm, Module:Head),
  277		 walk_called_by_body(Body, Module, OTerm)
  278	       )).
  279
  280scan_module(M, OTerm) :-
  281	walk_option_module_class(OTerm, Class),
  282	Class \== default, !,
  283	module_property(M, class(Class)).
  284scan_module(M, _) :-
  285	module_property(M, class(Class)),
  286	scan_module_class(Class).
  287
  288scan_module_class(user).
  289scan_module_class(library).

 walk_from_initialization(+OTerm)

Find initialization/1,2 directives and process what they are calling. Skip

bug

- Relies on private '$init_goal'/3 database.

  299:- if(current_prolog_flag(dialect, swi)).  300walk_from_initialization(OTerm) :-
  301	walk_option_predicates(OTerm, Predicates),
  302	var(Predicates),
  303	walk_option_clauses(OTerm, Clauses),
  304	var(Clauses),
  305	!,
  306	walk_option_caller(OTerm, '<initialization>'),
  307	forall('$init_goal'(_File, Goal, SourceLocation),
  308	       ( walk_option_initialization(OTerm, SourceLocation),
  309		 walk_from_initialization(Goal, OTerm))).
  310
  311walk_from_initialization(_OTerm).
  312
  313walk_from_initialization(M:Goal, OTerm) :-
  314	scan_module(M, OTerm), !,
  315	walk_called_by_body(Goal, M, OTerm).
  316walk_from_initialization(_, _).
  317
  318:- else.  319walk_from_initialization(_OTerm).
  320:- endif.

 find_walk_from_module(+Module, +OTerm) is det

Find undefined calls from the bodies of all clauses that belong to Module.

  327find_walk_from_module(M, OTerm) :-
  328	debug(autoload, 'Analysing module ~q', [M]),
  329	forall(predicate_in_module(M, PI),
  330	       walk_called_by_pred(M:PI, OTerm)).
  331
  332walk_called_by_pred(Module:Name/Arity, _) :-
  333	multifile_predicate(Name, Arity, Module), !.
  334walk_called_by_pred(Module:Name/Arity, _) :-
  335	functor(Head, Name, Arity),
  336	predicate_property(Module:Head, multifile), !,
  337	assertz(multifile_predicate(Name, Arity, Module)).
  338walk_called_by_pred(Module:Name/Arity, OTerm) :-
  339	functor(Head, Name, Arity),
  340	(   no_walk_property(Property),
  341	    predicate_property(Module:Head, Property)
  342	->  true
  343	;   walk_option_caller(OTerm, Module:Head),
  344	    walk_option_clause(OTerm, ClauseRef),
  345	    forall(catch(clause(Module:Head, Body, ClauseRef), _, fail),
  346		   walk_called_by_body(Body, Module, OTerm))
  347	).
  348
  349no_walk_property(number_of_rules(0)).	% no point walking only facts
  350no_walk_property(foreign).		% cannot walk foreign code

 walk_from_multifile(+OTerm)

Process registered multifile predicates.

  356walk_from_multifile(OTerm) :-
  357	forall(retract(multifile_predicate(Name, Arity, Module)),
  358	       walk_called_by_multifile(Module:Name/Arity, OTerm)).
  359
  360walk_called_by_multifile(Module:Name/Arity, OTerm) :-
  361	functor(Head, Name, Arity),
  362	forall(catch(clause_not_from_development(
  363			 Module:Head, Body, ClauseRef, OTerm),
  364		     _, fail),
  365	       ( walk_option_clause(OTerm, ClauseRef),
  366		 walk_option_caller(OTerm, Module:Head),
  367		 walk_called_by_body(Body, Module, OTerm)
  368	       )).

 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.

  376clause_not_from_development(Module:Head, Body, Ref, OTerm) :-
  377	clause(Module:Head, Body, Ref),
  378	\+ ( clause_property(Ref, file(File)),
  379	     module_property(LoadModule, file(File)),
  380	     \+ scan_module(LoadModule, OTerm)
  381	   ).

 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

  391walk_called_by_body(True, _, _) :-
  392	True == true, !.		% quickly deal with facts
  393walk_called_by_body(Body, Module, OTerm) :-
  394%	set_undecided_of_walk_option(error, OTerm, OTerm1),
  395	set_evaluate_of_walk_option(false, OTerm, OTerm2),
  396	catch(walk_called(Body, Module, _TermPos, OTerm2),
  397	      missing(Missing),
  398	      walk_called_by_body(Missing, Body, Module, OTerm)), !.
  399walk_called_by_body(Body, Module, OTerm) :-
  400	format(user_error, 'Failed to analyse:~n', []),
  401	portray_clause(('<head>' :- Body)),
  402	(   debugging(autoload(trace))
  403	->  trace, %gtrace,
  404	    walk_called_by_body(Body, Module, OTerm)
  405	;   true
  406	).

 walk_called_by_body(+Missing, +Body, +Module, +OTerm)

Restart the analysis because the previous analysis provided insufficient information.

  413walk_called_by_body(Missing, Body, _, OTerm) :-
  414	debugging(autoload),
  415	format(user_error, 'Retrying due to ~w (~p)~n', [Missing, OTerm]),
  416	portray_clause(('<head>' :- Body)), fail.
  417walk_called_by_body(undecided_call, Body, Module, OTerm) :-
  418	catch(forall(walk_called(Body, Module, _TermPos, OTerm),
  419		     true),
  420	      missing(Missing),
  421	      walk_called_by_body(Missing, Body, Module, OTerm)).
  422walk_called_by_body(subterm_positions, Body, Module, OTerm) :-
  423	(   (   walk_option_clause(OTerm, ClauseRef), nonvar(ClauseRef),
  424		clause_info(ClauseRef, _, TermPos, _NameOffset),
  425		TermPos = term_position(_,_,_,_,[_,BodyPos])
  426	    ->	WBody = Body
  427	    ;	walk_option_initialization(OTerm, SrcLoc),
  428		ground(SrcLoc), SrcLoc = _File:_Line,
  429		initialization_layout(SrcLoc, Module:Body, WBody, BodyPos)
  430	    )
  431	->  catch(forall(walk_called(WBody, Module, BodyPos, OTerm),
  432			 true),
  433		  missing(subterm_positions),
  434		  walk_called_by_body(no_positions, Body, Module, OTerm))
  435	;   set_source_of_walk_option(false, OTerm, OTerm2),
  436	    forall(walk_called(Body, Module, _BodyPos, OTerm2),
  437		   true)
  438	).
  439walk_called_by_body(no_positions, Body, Module, OTerm) :-
  440	set_source_of_walk_option(false, OTerm, OTerm2),
  441	forall(walk_called(Body, Module, _NoPos, OTerm2),
  442	       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))?

  472walk_called(Var, _, TermPos, OTerm) :-
  473	var(Var), !,				% Incomplete analysis
  474	undecided(Var, TermPos, OTerm).
  475walk_called(M:G, M0, term_position(_,_,_,_,[MPos,Pos]), OTerm) :- !,
  476	(   nonvar(M)
  477	->  walk_called(G, M, Pos, OTerm)
  478	;	(	nonvar(M0),
  479			get_attr(M, codewalk, V),
  480			V == is_context_module
  481		->	walk_called(G, M0, Pos, OTerm)
  482		;	undecided(M, MPos, OTerm)
  483		)
  484	).
  485walk_called(_G, M, TermPos, OTerm) :-
  486	var(M),
  487	!,
  488	undecided(M, TermPos, OTerm).
  489walk_called((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- !,
  490	walk_called(A, M, PA, OTerm),
  491	walk_called(B, M, PB, OTerm).
  492walk_called((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- !,
  493	(   walk_option_evaluate(OTerm, Eval), Eval == true
  494	->  Goal = (A;B),
  495	    setof(Goal,
  496		  (   walk_called(A, M, PA, OTerm)
  497		  ;   walk_called(B, M, PB, OTerm)
  498		  ),
  499		  Alts0),
  500	    variants(Alts0, Alts),
  501	    member(Goal, Alts)
  502	;   walk_called(A, M, PA, OTerm),
  503	    walk_called(B, M, PB, OTerm)
  504	).
  505walk_called(Goal, Module, TermPos, OTerm) :-
  506	walk_option_trace_reference(OTerm, To), To \== (-),
  507	(   subsumes_term(To, Module:Goal)
  508	->  M2 = Module
  509	;   predicate_property(Module:Goal, imported_from(M2)),
  510	    subsumes_term(To, M2:Goal)
  511	),
  512	print_reference(M2:Goal, TermPos, trace, OTerm),
  513	fail.					% Continue search
  514walk_called(Goal, Module, _, OTerm) :-
  515	evaluate(Goal, Module, OTerm), !.
  516:- if(current_prolog_flag(dialect, swi)).  517walk_called(Goal, Module, TermPos, OTerm) :-
  518	prolog:called_by(Goal, Called),
  519	Called \== [], !,
  520	walk_called_by(Called, Module, Goal, TermPos, OTerm).
  521:- endif.  522walk_called(Meta, Module, term_position(_,_,_,_,ArgPosList), OTerm) :-
  523	(   walk_option_autoload(OTerm, false)
  524	->  nonvar(Module),
  525	    is_defined(Module:Meta)
  526	;   true
  527	),
  528	% PDT Extension:
  529	(   extended_meta_predicate(Module:Meta, Head)
  530	;   inferred_meta(Module:Meta, Head)
  531	;   predicate_property(Module:Meta, meta_predicate(Head))
  532	), !,
  533	walk_option_clause(OTerm, ClauseRef),
  534	register_possible_meta_clause(ClauseRef),
  535	(	% PDT Extension:
  536	    walk_option_caller(OTerm, CallerModule:CallerGoal),
  537		predicate_property(CallerModule:CallerGoal, transparent),
  538		\+ predicate_property(CallerModule:CallerGoal, meta_predicate(_)),
  539		\+ walk_option_is_transparent_meta_call(OTerm, true)
  540	->	% PDT: Meta-call in module transparent predicates
  541	    set_is_transparent_meta_call_of_walk_option(true, OTerm, NewOTerm),
  542		(	predicate_property(ImportingModule:CallerGoal, imported_from(CallerModule)),
  543			walk_meta_call(1, Head, Meta, ImportingModule, ArgPosList, NewOTerm),
  544			fail
  545		;	walk_meta_call(1, Head, Meta, Module, ArgPosList, NewOTerm)
  546		)
  547	;	% Meta-call in non-transparent predicate or 
  548	    % nested meta-call in transparent predicate:
  549	    walk_meta_call(1, Head, Meta, Module, ArgPosList, OTerm)
  550	).
  551walk_called(context_module(M), _, _, OTerm) :-
  552	walk_option_caller(OTerm, Caller),
  553	predicate_property(Caller, transparent),
  554	\+ predicate_property(Caller, meta_predicate(_)),
  555	!,
  556	put_attr(M, codewalk, is_context_module).
  557walk_called(Goal, Module, _, _) :-
  558	nonvar(Module),
  559	is_defined(Module:Goal), !.
  560walk_called(Goal, Module, TermPos, OTerm) :-
  561	callable(Goal), !,
  562	undefined(Module:Goal, TermPos, OTerm).
  563walk_called(Goal, _Module, TermPos, OTerm) :-
  564	not_callable(Goal, TermPos, OTerm).
  565
  566:- if(current_prolog_flag(dialect, swi)).  567is_defined(Module:Goal) :-
  568	'$get_predicate_attribute'(Module:Goal, defined, 1).
  569:- else.  570is_defined(Module:Goal) :-
  571	functor(Goal,N,A),
  572	current_predicate(Module:N/A),
  573	!.
  574:- endif.

 undecided(+Variable, +TermPos, +OTerm)

  578undecided(Var, TermPos, OTerm) :-
  579	walk_option_undecided(OTerm, Undecided),
  580	(   var(Undecided)
  581	->  Action = ignore
  582	;   Action = Undecided
  583	),
  584	undecided(Action, Var, TermPos, OTerm).
  585
  586undecided(ignore, _, _, _) :- !.
  587undecided(error,  _, _, _) :-
  588	throw(missing(undecided_call)).

 evaluate(Goal, Module, OTerm) is nondet

  592evaluate(Goal, Module, OTerm) :-
  593	walk_option_evaluate(OTerm, Evaluate),
  594	Evaluate \== false,
  595	evaluate(Goal, Module).
  596
  597evaluate(A=B, _) :-
  598	unify_with_occurs_check(A, B).

 undefined(:Goal, +TermPos, +OTerm)

The analysis trapped a definitely undefined predicate.

  604undefined(_, _, OTerm) :-
  605	walk_option_undefined(OTerm, ignore),
  606	!.
  607%undefined(_, _, OTerm) :-
  608%	walk_option_is_transparent_meta_call(OTerm, true),
  609%	!.
  610undefined(Goal, _, _) :-
  611	predicate_property(Goal, autoload(_)), !.
  612undefined(Goal, TermPos, OTerm) :-
  613	(   walk_option_undefined(OTerm, trace)
  614	->  Why = trace
  615	;   Why = undefined
  616	),
  617	walk_option_call_kind(OTerm, CallKind),
  618	set_call_kind_of_walk_option(undefined(CallKind), OTerm, NewOTerm),
  619	print_reference(Goal, TermPos, Why, NewOTerm).

 not_callable(+Goal, +TermPos, +OTerm)

We found a reference to a non-callable term

  625not_callable(Goal, TermPos, OTerm) :-
  626	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

  635print_reference(Goal, TermPos, Why, OTerm) :-
  636	walk_option_clause(OTerm, Clause), nonvar(Clause), !,
  637	(   compound(TermPos),
  638	    arg(1, TermPos, CharCount),
  639	    integer(CharCount)		% test it is valid
  640	->  From = clause_term_position(Clause, TermPos)
  641	;   walk_option_source(OTerm, false)
  642	->  From = clause(Clause)
  643	;   throw(missing(subterm_positions))
  644	),
  645	print_reference2(Goal, From, Why, OTerm).
  646print_reference(Goal, TermPos, Why, OTerm) :-
  647	walk_option_initialization(OTerm, Init), nonvar(Init),
  648	Init = File:Line, !,
  649	(   compound(TermPos),
  650	    arg(1, TermPos, CharCount),
  651	    integer(CharCount)		% test it is valid
  652	->  From = file_term_position(File, TermPos)
  653	;   walk_option_source(OTerm, false)
  654	->  From = file(File, Line, -1, _)
  655	;   throw(missing(subterm_positions))
  656	),
  657	print_reference2(Goal, From, Why, OTerm).
  658print_reference(Goal, _, Why, OTerm) :-
  659	print_reference2(Goal, _, Why, OTerm).
  660
  661print_reference2(Goal, From, trace, OTerm) :-
  662	walk_option_on_trace(OTerm, Closure),
  663	walk_option_caller(OTerm, Caller),
  664	walk_option_call_kind(OTerm, CallKind),
  665	nonvar(Closure),
  666	call(Closure, Goal, Caller, From, CallKind), !.
  667print_reference2(Goal, From, Why, _OTerm) :-
  668	make_message(Why, Goal, From, Message, Level),
  669	print_message(Level, Message).
  670
  671
  672make_message(undefined, Goal, Context,
  673	     error(existence_error(procedure, PI), Context), error) :-
  674	goal_pi(Goal, PI).
  675make_message(not_callable, Goal, Context,
  676	     error(type_error(callable, Goal), Context), error).
  677make_message(trace, Goal, Context,
  678	     trace_call_to(PI, Context), informational) :-
  679	goal_pi(Goal, PI).
  680
  681
  682goal_pi(Goal, M:Name/Arity) :-
  683	strip_module(Goal, M, Head),
  684	callable(Head), !,
  685	functor(Head, Name, Arity).
  686goal_pi(Goal, Goal).
  687
  688:- dynamic
  689	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.

  698register_possible_meta_clause(ClausesRef) :-
  699	nonvar(ClausesRef),
  700	clause_property(ClausesRef, predicate(PI)),
  701	pi_head(PI, Head, Module),
  702	module_property(Module, class(user)),
  703	\+ predicate_property(Module:Head, meta_predicate(_)),
  704%	\+ inferred_meta(Module:Head, _),
  705	\+ possible_meta_predicate(Head, Module), !,
  706	assertz(possible_meta_predicate(Head, Module)).
  707register_possible_meta_clause(_).
  708
  709pi_head(Module:Name/Arity, Head, Module)  :- !,
  710	functor(Head, Name, Arity).
  711pi_head(_, _, _) :-
  712	assertion(fail).

 infer_new_meta_predicates(-MetaSpecs, +OTerm) is det

  716infer_new_meta_predicates([], OTerm) :-
  717	walk_option_infer_meta_predicates(OTerm, false), !.
  718infer_new_meta_predicates(MetaSpecs, _OTerm) :-
  719	findall(Module:MetaSpec,
  720		( retract(possible_meta_predicate(Head, Module)),
  721		  infer_meta(Module:Head, MetaSpec, NewOrUpdated),
  722		  NewOrUpdated == true
  723		),
  724		MetaSpecs).

 calling_metaspec(+Head) is semidet

True if this is a meta-specification that makes a difference to the code walker.

  731calling_metaspec(Head) :-
  732	arg(_, Head, Arg),
  733	calling_metaarg(Arg), !.
  734
  735calling_metaarg(I) :- integer(I), !.
  736calling_metaarg(^).
  737calling_metaarg(//).
  738calling_metaarg(database).

 walk_meta_call(+Index, +GoalHead, +MetaHead, +Module, +ArgPosList, +OTerm)

Walk a call to a meta-predicate. This walks all meta-arguments labeled with an integer, ^ or //.

  747walk_meta_call(I, assert(_), Meta, M, [ArgPos|_], OTerm) :-
  748	!,
  749	walk_database_arg(I, Meta, M, ArgPos, OTerm).
  750walk_meta_call(I, asserta(_), Meta, M, [ArgPos|_], OTerm) :-
  751	!,
  752	walk_database_arg(I, Meta, M, ArgPos, OTerm).
  753walk_meta_call(I, assertz(_), Meta, M, [ArgPos|_], OTerm) :-
  754	!,
  755	walk_database_arg(I, Meta, M, ArgPos, OTerm).
  756walk_meta_call(I, retract(_), Meta, M, [ArgPos|_], OTerm) :-
  757	!,
  758	walk_database_arg(I, Meta, M, ArgPos, OTerm).
  759walk_meta_call(I, retractall(_), Meta, M, [ArgPos|_], OTerm) :-
  760	!,
  761	walk_database_arg(I, Meta, M, ArgPos, OTerm).
  762walk_meta_call(I, Head, Meta, M, [ArgPos|ArgPosList], OTerm) :-
  763	arg(I, Head, AS), !,
  764	walk_meta_call_arg(AS, I, Meta, M, ArgPos, OTerm),
  765	succ(I, I2),
  766	walk_meta_call(I2, Head, Meta, M, ArgPosList, OTerm).
  767walk_meta_call(_, _, _, _, _, _).
  768
  769walk_database_arg(I, Meta, _M, _ArgPos, _OTerm) :-
  770	arg(I, Meta, Arg),
  771	nonvar(Arg),
  772	Arg = (_ :- _),
  773	!.
  774walk_database_arg(I, Meta, M, ArgPos, OTerm) :-
  775	walk_meta_call_arg(database, I, Meta, M, ArgPos, OTerm).
  776walk_meta_call_arg([], _I, _Meta, _M, _ArgPos, _OTerm) :-
  777	!.
  778walk_meta_call_arg([ArgSpec|ArgSpecs], I, Meta, M, ArgPos, OTerm) :-
  779	!,
  780	walk_meta_call_arg(ArgSpec, I, Meta, M, ArgPos, OTerm),
  781	walk_meta_call_arg(ArgSpecs, I, Meta, M, ArgPos, OTerm).
  782walk_meta_call_arg(AS, I, Meta, M, ArgPos, OTerm) :-
  783	(   integer(AS)
  784	->  arg(I, Meta, MA),
  785	    extend(MA, AS, Goal, ArgPos, ArgPosEx, OTerm),
  786    	set_call_kind_of_walk_option(metacall(Meta, I), OTerm, NewOTerm),
  787    	walk_called(Goal, M, ArgPosEx, NewOTerm)
  788	;   AS == (^)
  789	->  arg(I, Meta, MA),
  790	    remove_quantifier(MA, Goal, ArgPos, ArgPosEx, M, MG, OTerm),
  791    	set_call_kind_of_walk_option(metacall(Meta, I), OTerm, NewOTerm),
  792    	walk_called(Goal, MG, ArgPosEx, NewOTerm)
  793	;   AS == (//)
  794	->  arg(I, Meta, DCG),
  795    	set_call_kind_of_walk_option(metacall(Meta, I), OTerm, NewOTerm),
  796	    walk_dcg_body(DCG, M, ArgPos, NewOTerm)
  797	;   AS == database
  798	->	arg(I, Meta, MA),
  799    	set_call_kind_of_walk_option(database(Meta, I), OTerm, NewOTerm),
  800		walk_called(MA, M, ArgPos, NewOTerm)
  801	;	arg(I, Meta, Arg),
  802		atomic(Arg),
  803		(   AS = has_arity(_,_)
  804		;   AS = add_prefix(_,_)
  805		;   AS = add_suffix(_,_)
  806		)
  807	->	(	functor_arity_for(AS, Arg, Functor, Arity)
  808		->	extend(Functor, Arity, Goal, ArgPos, ArgPosEx, OTerm),
  809	    	set_call_kind_of_walk_option(metacall(Meta, I, AS), OTerm, NewOTerm),
  810			walk_called(Goal, M, ArgPosEx, NewOTerm)
  811		;	true
  812		)
  813	;	true
  814	).
  815
  816functor_arity_for(I, _, _, I) :-
  817	integer(I),
  818	!.
  819functor_arity_for(^, _, _, 0).
  820functor_arity_for(database, _, _, 0).
  821functor_arity_for(has_arity(N, Spec), Arg, Arg, Arity) :-
  822	functor_arity_for(Spec, _, _, Arity0),
  823	Arity is N + Arity0.
  824functor_arity_for(add_prefix(Prefix, Spec), Arg, Functor, Arity) :-
  825	functor_arity_for(Spec, _, _, Arity),
  826	atom_concat(Prefix, Arg, Functor).
  827functor_arity_for(add_suffix(Suffix, Spec), Arg, Functor, Arity) :-
  828	functor_arity_for(Spec, _, _, Arity),
  829	atom_concat(Arg, Suffix, Functor). 
  830
  831remove_quantifier(Goal, _, TermPos, TermPos, M, M, OTerm) :-
  832	var(Goal), !,
  833	undecided(Goal, TermPos, OTerm).
  834remove_quantifier(_^Goal0, Goal,
  835		  term_position(_,_,_,_,[_,GPos]),
  836		  TermPos, M0, M, OTerm) :- !,
  837	remove_quantifier(Goal0, Goal, GPos, TermPos, M0, M, OTerm).
  838remove_quantifier(M1:Goal0, Goal,
  839		  term_position(_,_,_,_,[_,GPos]),
  840		  TermPos, _, M, OTerm) :- !,
  841	remove_quantifier(Goal0, Goal, GPos, TermPos, M1, M, OTerm).
  842remove_quantifier(Goal, Goal, TermPos, TermPos, M, M, _).
  843
  844:- if(current_prolog_flag(dialect, swi)).

 walk_called_by(+Called:list, +Module, +Goal, +TermPos, +OTerm)

Walk code explicitly mentioned to be called through the hook prolog:called_by/2.

  850walk_called_by([], _, _, _, _).
  851walk_called_by([H|T], M, Goal, TermPos, OTerm) :-
  852	(   H = G+N
  853	->  subterm_pos(G, Goal, TermPos, GPos),
  854	    (   extend(G, N, G2, GPos, GPosEx, OTerm)
  855	    ->	walk_called(G2, M, GPosEx, OTerm)
  856	    ;	true
  857	    )
  858	;   subterm_pos(H, Goal, TermPos, GPos),
  859	    walk_called(H, M, GPos, OTerm)
  860	),
  861	walk_called_by(T, M, Goal, TermPos, OTerm).
  862:- endif.  863
  864:- if(current_prolog_flag(dialect, swi)).  865subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  866	subterm_pos(Sub, Term, same_term, TermPos, SubTermPos), !.
  867:- endif.  868subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  869	subterm_pos(Sub, Term, ==, TermPos, SubTermPos), !.
  870subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  871	subterm_pos(Sub, Term, =@=, TermPos, SubTermPos), !.
  872subterm_pos(Sub, Term, TermPos, SubTermPos) :-
  873	subterm_pos(Sub, Term, =, TermPos, SubTermPos), !.
  874subterm_pos(_, _, _, _).

 walk_dcg_body(+Body, +Module, +TermPos, +OTerm)

Walk a DCG body that is meta-called.

  881walk_dcg_body(Var, _Module, TermPos, OTerm) :-
  882	var(Var), !,
  883	undecided(Var, TermPos, OTerm).
  884walk_dcg_body([], _Module, _, _) :- !.
  885walk_dcg_body([_|_], _Module, _, _) :- !.
  886walk_dcg_body(!, _Module, _, _) :- !.
  887walk_dcg_body(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :- !,
  888	(   nonvar(M)
  889	->  walk_dcg_body(G, M, Pos, OTerm)
  890	;   undecided(M, MPos, OTerm)
  891	).
  892walk_dcg_body((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- !,
  893	walk_dcg_body(A, M, PA, OTerm),
  894	walk_dcg_body(B, M, PB, OTerm).
  895walk_dcg_body((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- !,
  896	walk_dcg_body(A, M, PA, OTerm),
  897	walk_dcg_body(B, M, PB, OTerm).
  898walk_dcg_body((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- !,
  899	walk_dcg_body(A, M, PA, OTerm),
  900	walk_dcg_body(B, M, PB, OTerm).
  901walk_dcg_body((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :- !,
  902	(   walk_dcg_body(A, M, PA, OTerm)
  903	;   walk_dcg_body(B, M, PB, OTerm)
  904	).
  905walk_dcg_body(G, M, TermPos, OTerm) :-
  906	extend(G, 2, G2, TermPos, TermPosEx, OTerm),
  907	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 =

  918:- meta_predicate
  919	subterm_pos(+, +, 2, +, -),
  920	sublist_pos(+, +, +, +, 2, -).  921
  922subterm_pos(_, _, _, Pos, _) :-
  923	var(Pos), !, fail.
  924subterm_pos(Sub, Term, Cmp, Pos, Pos) :-
  925	call(Cmp, Sub, Term), !.
  926subterm_pos(Sub, Term, Cmp, term_position(_,_,_,_,ArgPosList), Pos) :-
  927	nth1(I, ArgPosList, ArgPos),
  928	arg(I, Term, Arg),
  929	subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
  930subterm_pos(Sub, Term, Cmp, list_position(_,_,ElemPosList,TailPos), Pos) :-
  931	sublist_pos(ElemPosList, TailPos, Sub, Term, Cmp, Pos).
  932subterm_pos(Sub, {Arg}, Cmp, brace_term_position(_,_,ArgPos), Pos) :-
  933	subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
  934
  935sublist_pos([EP|TP], TailPos, Sub, [H|T], Cmp, Pos) :-
  936	(   subterm_pos(Sub, H, Cmp, EP, Pos)
  937	;   sublist_pos(TP, TailPos, Sub, T, Cmp, Pos)
  938	).
  939sublist_pos([], TailPos, Sub, Tail, Cmp, Pos) :-
  940	TailPos \== none,
  941	subterm_pos(Sub, Tail, Cmp, TailPos, Pos).

 extend(+Goal, +ExtraArgs, +TermPosIn, -TermPosOut, +OTerm)

bug

- :

  947extend(Goal, 0, Goal, TermPos, TermPos, _) :- !.
  948extend(Goal, _, _, TermPos, TermPos, OTerm) :-
  949	var(Goal), !,
  950	undecided(Goal, TermPos, OTerm).
  951extend(M:Goal, N, M:GoalEx,
  952       term_position(F,T,FT,TT,[MPos,GPosIn]),
  953       term_position(F,T,FT,TT,[MPos,GPosOut]), OTerm) :- !,
  954	(   var(M)
  955	->  undecided(N, MPos, OTerm)
  956	;   true
  957	),
  958	extend(Goal, N, GoalEx, GPosIn, GPosOut, OTerm).
  959extend(Goal, N, GoalEx, TermPosIn, TermPosOut, _) :-
  960	callable(Goal),
  961	Goal =.. List,
  962	length(Extra, N),
  963	extend_term_pos(TermPosIn, N, TermPosOut),
  964	append(List, Extra, ListEx),
  965	GoalEx =.. ListEx.
  966
  967extend_term_pos(Var, _, _) :-
  968	var(Var), !.
  969extend_term_pos(term_position(F,T,FT,TT,ArgPosIn),
  970		N,
  971		term_position(F,T,FT,TT,ArgPosOut)) :- !,
  972	length(Extra, N),
  973	maplist(=(0-0), Extra),
  974	append(ArgPosIn, Extra, ArgPosOut).
  975extend_term_pos(F-T, N, term_position(F,T,F,T,Extra)) :-
  976	length(Extra, N),
  977	maplist(=(0-0), Extra).

 variants(+SortedList, -Variants) is det

  982variants([], []).
  983variants([H|T], List) :-
  984	variants(T, H, List).
  985
  986variants([], H, [H]).
  987variants([H|T], V, List) :-
  988	(   H =@= V
  989	->  variants(T, V, List)
  990	;   List = [V|List2],
  991	    variants(T, H, List2)
  992	).

 predicate_in_module(+Module, ?PI) is nondet

True if PI is a predicate locally defined in Module.

  998predicate_in_module(Module, PI) :-
  999	current_predicate(Module:PI),
 1000	PI = Name/Arity,
 1001	functor(Head, Name, Arity),
 1002	\+ predicate_property(Module:Head, imported_from(_)).
 1003
 1004
 1005		 /*******************************
 1006		 *	      MESSAGES		*
 1007		 *******************************/
 1008
 1009:- multifile
 1010	prolog:message//1,
 1011	prolog:message_location//1. 1012
 1013prolog:message(trace_call_to(PI, Context)) -->
 1014	[ 'Call to ~q at '-[PI] ],
 1015	prolog:message_location(Context).
 1016
 1017prolog:message_location(clause_term_position(ClauseRef, TermPos)) -->
 1018	{ clause_property(ClauseRef, file(File)) },
 1019	message_location_file_term_position(File, TermPos).
 1020prolog:message_location(clause(ClauseRef)) -->
 1021	{ clause_property(ClauseRef, file(File)),
 1022	  clause_property(ClauseRef, line_count(Line))
 1023	}, !,
 1024	[ '~w:~d: '-[File, Line] ].
 1025prolog:message_location(clause(ClauseRef)) -->
 1026	{ clause_name(ClauseRef, Name) },
 1027	[ '~w: '-[Name] ].
 1028prolog:message_location(file_term_position(Path, TermPos)) -->
 1029	message_location_file_term_position(Path, TermPos).
 1030prolog:message_location(file(Path, Line, _, _)) -->
 1031	[ '~w:~d: '-[Path, Line] ].
 1032prolog:message(codewalk(reiterate(New, Iteration, CPU))) -->
 1033	[ 'Found new meta-predicates in iteration ~w (~3f sec)'-
 1034	  [Iteration, CPU], nl ],
 1035	meta_decls(New),
 1036	[ 'Restarting analysis ...'-[], nl ].
 1037
 1038meta_decls([]) --> [].
 1039meta_decls([H|T]) -->
 1040	[ ':- meta_predicate ~q.'-[H], nl ],
 1041	meta_decls(T).
 1042
 1043message_location_file_term_position(File, TermPos) -->
 1044	{ arg(1, TermPos, CharCount),
 1045	  filepos_line(File, CharCount, Line, LinePos)
 1046	},
 1047	[ '~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.

 1054filepos_line(File, CharPos, Line, LinePos) :-
 1055	setup_call_cleanup(
 1056	    ( open(File, read, In),
 1057	      open_null_stream(Out)
 1058	    ),
 1059	    ( copy_stream_data(In, Out, CharPos),
 1060	      stream_property(In, position(Pos)),
 1061	      stream_position_data(line_count, Pos, Line),
 1062	      stream_position_data(line_position, Pos, LinePos)
 1063	    ),
 1064	    ( close(Out),
 1065	      close(In)
 1066	    ))