
prolog_codewalk.pl -- 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 separate 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 det- Walk over all loaded (user) Prolog code. The following code is
processed:
- The bodies of all clauses in all user and library modules.
This steps collects, but does not scan multifile predicates
to avoid duplicate work.
- All multi-file predicates collected.
- 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.
- walk_meta_predicates(Boolean)
- When
false
(default true
), do not analyse the arguments
of meta predicates. Standard Prolog control structures are
always analysed.
- 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.
- trace_condition(:Cond)
- Additional filter condition applied after
trace_reference
.
Called as call(Cond, Callee, Context)
, where Context is a
dict containing the following keys:
- caller:Context
- Qualified term representing the caller or the atom
'<initialization>'.
- module:Context
- Module being processed
- clause:Context
- If we are processing a normal clause, the clause reference
to this clause.
- initialization:Context
- If we are processing an initialization/1 directive, a term
File:Line
representing the location of the declaration.
- on_edge(:OnEdge)
- If a reference to
trace_reference
is found, call
call(OnEdge, Callee, Caller, Location)
, where Location is a
dict containing a subset of the keys clause
, file
,
character_count
, line_count
and line_position
. If
full position information is available all keys are present.
If the clause layout is unknown the only the clause
, file
and line_count
are available and the line is the start line
of the clause. For a dynamic clause, only the clause
is
present. If the position is associated to a directive,
the clause
is missing. If nothing is known the Location
is an empty dict.
- on_trace(:OnTrace)
- As
on_edge
, but location is not translated and 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.
walk_clauses(+Clauses, +OTerm) is det[private]- Walk the given clauses.
scan_module(+Module, +OTerm) is semidet[private]- True if we must scan Module according to OTerm.
walk_from_initialization(+OTerm)[private]- Find initialization/1,2 directives and process what they are
calling. Skip
- bug
- - Relies on private '$init_goal'/3 database.
find_walk_from_module(+Module, +OTerm) is det[private]- Find undefined calls from the bodies of all clauses that belong
to Module.
walk_from_multifile(+OTerm)[private]- Process registered multifile predicates.
clause_not_from_development(:Head, -Body, ?Ref, +Options) is nondet[private]- Enumerate clauses for a multifile predicate, but omit those from
a module that is specifically meant to support development.
walk_called_by_body(+Body, +Module, +OTerm) is det[private]- Check the Body term when executed in the context of Module.
Options:
- undefined(+Action)
- One of
ignore
, error
Re-exported predicates
The following predicates are exported from this file while their implementation is defined in imported modules or non-module files loaded by this module.
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.
- module(?Module)
module_class(+list(Classes))