
prolog_codewalk.pl -- Prolog code walkerThis 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)).
prolog_walk_code(+Options) is detOptions processed:
ignore or
error (default is ignore).source(false) and then process only interesting
clauses with source information.user and library.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 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, _)Caller is the qualified head of the calling clause or the atom '<initialization>'.
false (default true), to not try to obtain detailed
source information for printed messages.true (default false), report derived meta-predicates
and iterations.
@compat OnTrace was called using Caller-Location in older versions.
prolog_program_clause(-ClauseRef, +Options) is nondetmodule_class(+list(Classes))