1456 lines
42 KiB
Prolog
1456 lines
42 KiB
Prolog
/* $Id$
|
|
|
|
Part of SWI-Prolog
|
|
|
|
Author: Jan Wielemaker
|
|
E-mail: wielemak@science.uva.nl
|
|
WWW: http://www.swi.psy.uva.nl/projects/xpce/
|
|
Copyright (C): 1985-2006, University of Amsterdam
|
|
|
|
This program is free software; you can redistribute it and/or
|
|
modify it under the terms of the GNU General Public License
|
|
as published by the Free Software Foundation; either version 2
|
|
of the License, or (at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU Lesser General Public
|
|
License along with this library; if not, write to the Free Software
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
As a special exception, if you link this library with other files,
|
|
compiled with a Free Software compiler, to produce an executable, this
|
|
library does not by itself cause the resulting executable to be covered
|
|
by the GNU General Public License. This exception does not however
|
|
invalidate any other reasons why the executable file might be covered by
|
|
the GNU General Public License.
|
|
*/
|
|
|
|
:- module(prolog_xref,
|
|
[ xref_source/1, % +Source
|
|
xref_called/3, % ?Source, ?Callable, ?By
|
|
xref_defined/3, % ?Source. ?Callable, -How
|
|
xref_definition_line/2, % +How, -Line
|
|
xref_exported/2, % ?Source, ?Callable
|
|
xref_module/2, % ?Source, ?Module
|
|
xref_op/2, % ?Source, ?Op
|
|
xref_clean/1, % +Source
|
|
xref_current_source/1, % ?Source
|
|
xref_done/2, % +Source, -Time
|
|
xref_built_in/1, % ?Callable
|
|
xref_expand/2, % +Term, -Expanded
|
|
xref_source_file/3, % +Spec, -Path, +Source
|
|
xref_source_file/4, % +Spec, -Path, +Source, +Options
|
|
xref_public_list/4, % +Path, -Export, +Src
|
|
xref_meta/2, % +Goal, -Called
|
|
xref_hook/1, % ?Callable
|
|
% XPCE class references
|
|
xref_used_class/2, % ?Source, ?ClassName
|
|
xref_defined_class/3 % ?Source, ?ClassName, -How
|
|
]).
|
|
:- use_module(library(debug), [debug/3, debugging/1]).
|
|
:- use_module(library(lists), [append/3, member/2]).
|
|
:- use_module(library(operators),
|
|
[pop_operators/0, push_op/3, push_operators/1]).
|
|
:- if(current_prolog_flag(dialect, swi)).
|
|
:- use_module(library(shlib), [current_foreign_library/2]).
|
|
:- endif.
|
|
:- use_module(library(prolog_source)).
|
|
:- use_module(library(option)).
|
|
:- use_module(library(error)).
|
|
|
|
:- dynamic
|
|
called/3, % Head, Src, From
|
|
(dynamic)/3, % Head, Src, Line
|
|
(thread_local)/3, % Head, Src, Line
|
|
(multifile)/3, % Head, Src, Line
|
|
defined/3, % Head, Src, Line
|
|
foreign/3, % Head, Src, Line
|
|
constraint/3, % Head, Src, Line
|
|
imported/3, % Head, Src, From
|
|
exported/2, % Head, Src
|
|
xmodule/2, % Module, Src
|
|
xop/2, % Src, Op
|
|
source/2, % Src, Time
|
|
used_class/2, % Name, Src
|
|
defined_class/5, % Name, Super, Summary, Src, Line
|
|
(mode)/2. % Mode, Src
|
|
|
|
:- create_prolog_flag(xref, false, [type(boolean)]).
|
|
|
|
/*******************************
|
|
* HOOKS *
|
|
*******************************/
|
|
|
|
% prolog:called_by(+Goal, -ListOfCalled)
|
|
%
|
|
% If this succeeds, the cross-referencer assumes Goal may call any
|
|
% of the goals in ListOfCalled. If this call fails, default
|
|
% meta-goal analysis is used to determine additional called goals.
|
|
|
|
% prolog:meta_goal(+Goal, -Pattern)
|
|
%
|
|
% Define meta-predicates. See the examples in this file for details.
|
|
|
|
:- multifile
|
|
prolog:called_by/2, % +Goal, -Called
|
|
prolog:meta_goal/2, % +Goal, -Pattern
|
|
prolog:hook/1. % +Callable
|
|
|
|
:- dynamic
|
|
meta_goal/2.
|
|
|
|
called_by(Goal, Called) :-
|
|
prolog:called_by(Goal, Called), !.
|
|
called_by(on_signal(_,_,New), [New+1]) :-
|
|
( new == throw
|
|
; new == default
|
|
), !, fail.
|
|
|
|
|
|
/*******************************
|
|
* BUILT-INS *
|
|
*******************************/
|
|
|
|
%% built_in_predicate(+Callable)
|
|
%
|
|
% True if Callable is a built-in
|
|
|
|
:- expects_dialect(swi).
|
|
|
|
:- if(current_prolog_flag(dialect, swi)).
|
|
system_predicate(Goal) :-
|
|
functor(Goal, Name, Arity),
|
|
current_predicate(system:Name/Arity), % avoid autoloading
|
|
predicate_property(system:Goal, built_in), !.
|
|
:-endif.
|
|
|
|
/********************************
|
|
* TOPLEVEL *
|
|
********************************/
|
|
|
|
verbose :-
|
|
debugging(xref).
|
|
|
|
%% xref_source(+Source) is det.
|
|
%
|
|
% Generate the cross-reference data for Source if not already
|
|
% done and the source is not modified. Checking for modifications
|
|
% is only done for files.
|
|
%
|
|
% @param Source File specification or XPCE buffer
|
|
|
|
xref_source(Source) :-
|
|
prolog_canonical_source(Source, Src),
|
|
( atom(Src)
|
|
-> time_file(Src, Modified),
|
|
source(Src, Modified)
|
|
), !.
|
|
xref_source(Source) :-
|
|
prolog_canonical_source(Source, Src),
|
|
xref_clean(Src),
|
|
( atom(Src)
|
|
-> time_file(Src, Modified)
|
|
; get_time(Modified) % Actually should be `generation'
|
|
),
|
|
assert(source(Src, Modified)),
|
|
xref_setup(Src, In, State),
|
|
call_cleanup(collect(Src, In), xref_cleanup(State)).
|
|
|
|
:- thread_local
|
|
xref_stream/1. % input stream
|
|
|
|
xref_setup(Src, In, state(In, Xref, [SRef|HRefs])) :-
|
|
prolog_open_source(Src, In),
|
|
asserta(xref_stream(In), SRef),
|
|
( current_prolog_flag(xref, Xref)
|
|
-> true
|
|
; Xref = false
|
|
),
|
|
set_prolog_flag(xref, true),
|
|
( verbose
|
|
-> HRefs = []
|
|
; asserta(user:message_hook(_,_,_), Ref),
|
|
HRefs = [Ref]
|
|
).
|
|
|
|
xref_cleanup(state(In, Xref, Refs)) :-
|
|
prolog_close_source(In),
|
|
set_prolog_flag(xref, Xref),
|
|
maplist(erase, Refs).
|
|
|
|
%% xref_input_stream(-Stream) is det.
|
|
%
|
|
% Current input stream for cross-referencer.
|
|
|
|
xref_input_stream(Stream) :-
|
|
xref_stream(Var), !,
|
|
Stream = Var.
|
|
|
|
%% xref_push_op(Source, +Prec, +Type, :Name)
|
|
%
|
|
% Define operators into the default source module and register
|
|
% them to be undone by pop_operators/0.
|
|
|
|
xref_push_op(Src, P, T, N0) :- !,
|
|
( N0 = _:_
|
|
-> N = N0
|
|
; '$set_source_module'(M, M),
|
|
N = M:N0
|
|
),
|
|
push_op(P, T, N),
|
|
assert_op(Src, op(P,T,N)),
|
|
debug(xref, ':- ~w.', [op(P,T,N)]).
|
|
|
|
|
|
%% xref_clean(+Source) is det.
|
|
%
|
|
% Reset the database for the given source.
|
|
|
|
xref_clean(Source) :-
|
|
prolog_canonical_source(Source, Src),
|
|
retractall(called(_, Src, _Origin)),
|
|
retractall(dynamic(_, Src, Line)),
|
|
retractall(multifile(_, Src, Line)),
|
|
retractall(defined(_, Src, Line)),
|
|
retractall(foreign(_, Src, Line)),
|
|
retractall(constraint(_, Src, Line)),
|
|
retractall(imported(_, Src, _From)),
|
|
retractall(exported(_, Src)),
|
|
retractall(xmodule(_, Src)),
|
|
retractall(xop(Src, _)),
|
|
retractall(source(Src, _)),
|
|
retractall(used_class(_, Src)),
|
|
retractall(defined_class(_, _, _, Src, _)),
|
|
retractall(mode(_, Src)).
|
|
|
|
|
|
/*******************************
|
|
* READ RESULTS *
|
|
*******************************/
|
|
|
|
%% xref_current_source(?Source)
|
|
%
|
|
% Check what sources have been analysed.
|
|
|
|
xref_current_source(Source) :-
|
|
source(Source, _Time).
|
|
|
|
|
|
%% xref_done(+Source, -Time) is det.
|
|
%
|
|
% Cross-reference executed at Time
|
|
|
|
xref_done(Source, Time) :-
|
|
prolog_canonical_source(Source, Src),
|
|
source(Src, Time).
|
|
|
|
|
|
%% xref_called(+Source, ?Called, ?By) is nondet.
|
|
%
|
|
% Enumerate the predicate-call relations. Predicate called by
|
|
% directives have a By '<directive>'.
|
|
|
|
xref_called(Source, Called, By) :-
|
|
prolog_canonical_source(Source, Src),
|
|
called(Called, Src, By).
|
|
|
|
|
|
%% xref_defined(+Source, +Goal, ?How) is semidet.
|
|
%
|
|
% Test if Goal is accessible in Source. If this is the case, How
|
|
% specifies the reason why the predicate is accessible. Note that
|
|
% this predicate does not deal with built-in or global predicates,
|
|
% just locally defined and imported ones.
|
|
|
|
xref_defined(Source, Called, How) :-
|
|
prolog_canonical_source(Source, Src),
|
|
xref_defined2(How, Src, Called).
|
|
|
|
xref_defined2(dynamic(Line), Src, Called) :-
|
|
dynamic(Called, Src, Line).
|
|
xref_defined2(thread_local(Line), Src, Called) :-
|
|
thread_local(Called, Src, Line).
|
|
xref_defined2(multifile(Line), Src, Called) :-
|
|
multifile(Called, Src, Line).
|
|
xref_defined2(local(Line), Src, Called) :-
|
|
defined(Called, Src, Line).
|
|
xref_defined2(foreign(Line), Src, Called) :-
|
|
foreign(Called, Src, Line).
|
|
xref_defined2(constraint(Line), Src, Called) :-
|
|
constraint(Called, Src, Line).
|
|
xref_defined2(imported(From), Src, Called) :-
|
|
imported(Called, Src, From).
|
|
|
|
|
|
%% xref_definition_line(+How, -Line)
|
|
%
|
|
% If the 3th argument of xref_defined contains line info, return
|
|
% this in Line.
|
|
|
|
xref_definition_line(local(Line), Line).
|
|
xref_definition_line(dynamic(Line), Line).
|
|
xref_definition_line(thread_local(Line), Line).
|
|
xref_definition_line(multifile(Line), Line).
|
|
xref_definition_line(constraint(Line), Line).
|
|
xref_definition_line(foreign(Line), Line).
|
|
|
|
|
|
xref_exported(Source, Called) :-
|
|
prolog_canonical_source(Source, Src),
|
|
exported(Called, Src).
|
|
|
|
%% xref_module(?Source, ?Module) is nondet.
|
|
%
|
|
% True if Module is defined in Source.
|
|
|
|
xref_module(Source, Module) :-
|
|
prolog_canonical_source(Source, Src),
|
|
xmodule(Module, Src).
|
|
|
|
%% xref_op(?Source, Op) is nondet.
|
|
%
|
|
% Give the operators active inside the module. This is intended to
|
|
% setup the environment for incremental parsing of a term from the
|
|
% source-file.
|
|
%
|
|
% @param Op Term of the form op(Priority, Type, Name)
|
|
|
|
xref_op(Source, Op) :-
|
|
prolog_canonical_source(Source, Src),
|
|
xop(Src, Op).
|
|
|
|
xref_built_in(Head) :-
|
|
system_predicate(Head).
|
|
|
|
xref_used_class(Source, Class) :-
|
|
prolog_canonical_source(Source, Src),
|
|
used_class(Class, Src).
|
|
|
|
xref_defined_class(Source, Class, local(Line, Super, Summary)) :-
|
|
prolog_canonical_source(Source, Src),
|
|
defined_class(Class, Super, Summary, Src, Line),
|
|
integer(Line), !.
|
|
xref_defined_class(Source, Class, file(File)) :-
|
|
prolog_canonical_source(Source, Src),
|
|
defined_class(Class, _, _, Src, file(File)).
|
|
|
|
collect(Src, In) :-
|
|
repeat,
|
|
catch(read_source_term(Src, In, Term, TermPos),
|
|
E, report_syntax_error(E)),
|
|
xref_expand(Term, T),
|
|
( T == end_of_file
|
|
-> !
|
|
; stream_position_data(line_count, TermPos, Line),
|
|
flag(xref_src_line, _, Line),
|
|
catch(process(T, Src), E, print_message(error, E)),
|
|
fail
|
|
).
|
|
|
|
%% read_source_term(+Src, +In:stream, -Term, -TermPos) is det.
|
|
%
|
|
% Read next term from In. The cross-referencer supports the
|
|
% comment_hook as also implemented by the compiler for the
|
|
% documentation processor.
|
|
|
|
:- multifile
|
|
prolog:comment_hook/3.
|
|
|
|
read_source_term(Src, In, Term, TermPos) :-
|
|
atom(Src),
|
|
\+ source_file(Src), % normally loaded; no need to update
|
|
'$get_predicate_attribute'(prolog:comment_hook(_,_,_),
|
|
number_of_clauses, N),
|
|
N > 0, !,
|
|
'$set_source_module'(SM, SM),
|
|
read_term(In, Term,
|
|
[ term_position(TermPos),
|
|
comments(Comments),
|
|
module(SM)
|
|
]),
|
|
( catch(prolog:comment_hook(Comments, TermPos, Term), E,
|
|
print_message(error, E))
|
|
-> true
|
|
; true
|
|
).
|
|
read_source_term(_, In, Term, TermPos) :-
|
|
'$set_source_module'(SM, SM),
|
|
read_term(In, Term,
|
|
[ term_position(TermPos),
|
|
module(SM)
|
|
]).
|
|
|
|
|
|
report_syntax_error(E) :-
|
|
( verbose
|
|
-> print_message(error, E)
|
|
; true
|
|
),
|
|
fail.
|
|
|
|
|
|
/*******************************
|
|
* EXPANSION *
|
|
*******************************/
|
|
|
|
%% xref_expand(+Term, -Expanded)
|
|
%
|
|
% Do the term-expansion. We have to pass require as we need it for
|
|
% validation. Otherwise we do term-expansion, handling all of the
|
|
% XPCE class compiler as normal Prolog afterwards. CHR programs
|
|
% are processed using process_chr/2 directly from the source,
|
|
% which is why we inhibit expansion here.
|
|
|
|
xref_expand((:- if(Cond)), (:- if(Cond))).
|
|
xref_expand((:- elif(Cond)), (:- elif(Cond))).
|
|
xref_expand((:- else), (:- else)).
|
|
xref_expand((:- endif), (:- endif)).
|
|
xref_expand((:- require(X)),
|
|
(:- require(X))) :- !.
|
|
xref_expand(Term, _) :-
|
|
requires_library(Term, Lib),
|
|
ensure_loaded(user:Lib),
|
|
fail.
|
|
xref_expand(Term, Term) :-
|
|
chr_expandable(Term), !.
|
|
xref_expand('$:-'(X), '$:-'(X)) :- !, % boot module
|
|
style_check(+dollar).
|
|
xref_expand(Term, T) :-
|
|
catch(expand_term(Term, Expanded), _, Expanded=Term),
|
|
( is_list(Expanded)
|
|
-> member(T, Expanded)
|
|
; T = Expanded
|
|
).
|
|
|
|
|
|
%% requires_library(+Term, -Library)
|
|
%
|
|
% known expansion hooks. Should be more dynamic!
|
|
|
|
requires_library((:- emacs_begin_mode(_,_,_,_,_)), library(emacs_extend)).
|
|
requires_library((:- draw_begin_shape(_,_,_,_)), library(pcedraw)).
|
|
|
|
|
|
/*******************************
|
|
* PROCESS *
|
|
*******************************/
|
|
|
|
process(Var, _) :-
|
|
var(Var), !. % Warn?
|
|
process((:- Directive), Src) :- !,
|
|
process_directive(Directive, Src), !.
|
|
process((?- Directive), Src) :- !,
|
|
process_directive(Directive, Src), !.
|
|
process((Head :- Body), Src) :- !,
|
|
assert_defined(Src, Head),
|
|
process_body(Body, Head, Src).
|
|
process('$source_location'(_File, _Line):Clause, Src) :- !,
|
|
process(Clause, Src).
|
|
process(Term, Src) :-
|
|
chr_expandable(Term), !,
|
|
process_chr(Term, Src).
|
|
process(M:(Head :- Body), Src) :- !,
|
|
process((M:Head :- M:Body), Src).
|
|
process(Head, Src) :-
|
|
assert_defined(Src, Head).
|
|
|
|
/********************************
|
|
* DIRECTIVES *
|
|
********************************/
|
|
|
|
process_directive(Var, _) :-
|
|
var(Var), !. % error, but that isn't our business
|
|
process_directive((A,B), Src) :- !, % TBD: whta about other control
|
|
process_directive(A, Src), % structures?
|
|
process_directive(B, Src).
|
|
process_directive(List, Src) :-
|
|
is_list(List), !,
|
|
process_directive(consult(List), Src).
|
|
process_directive(use_module(Spec, Import), Src) :-
|
|
xref_public_list(Spec, Path, Public, Src),
|
|
assert_import(Src, Import, Public, Path, false).
|
|
process_directive(reexport(Spec, Import), Src) :-
|
|
xref_public_list(Spec, Path, Public, Src),
|
|
assert_import(Src, Import, Public, Path, true).
|
|
process_directive(reexport(Modules), Src) :-
|
|
process_use_module(Modules, Src, true).
|
|
process_directive(use_module(Modules), Src) :-
|
|
process_use_module(Modules, Src, false).
|
|
process_directive(consult(Modules), Src) :-
|
|
process_use_module(Modules, Src, false).
|
|
process_directive(ensure_loaded(Modules), Src) :-
|
|
process_use_module(Modules, Src, false).
|
|
process_directive(load_files(Files, _Options), Src) :-
|
|
process_use_module(Files, Src, false).
|
|
process_directive(include(Files), Src) :-
|
|
process_include(Files, Src).
|
|
process_directive(dynamic(Dynamic), Src) :-
|
|
assert_dynamic(Src, Dynamic).
|
|
process_directive(thread_local(Dynamic), Src) :-
|
|
assert_thread_local(Src, Dynamic).
|
|
process_directive(multifile(Dynamic), Src) :-
|
|
assert_multifile(Src, Dynamic).
|
|
process_directive(module(Module, Export), Src) :-
|
|
assert_module(Src, Module),
|
|
assert_export(Src, Export).
|
|
process_directive(system_mode(on), _Src) :- !,
|
|
style_check(+dollar).
|
|
process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :-
|
|
assert_defined_class(Src, Name, Meta, Super, Doc).
|
|
process_directive(pce_autoload(Name, From), Src) :-
|
|
assert_defined_class(Src, Name, imported_from(From)).
|
|
|
|
process_directive(op(P, A, N), Src) :-
|
|
xref_push_op(Src, P, A, N).
|
|
process_directive(style_check(X), _) :-
|
|
style_check(X).
|
|
process_directive(encoding(Enc), _) :-
|
|
( xref_input_stream(Stream)
|
|
-> catch(set_stream(Stream, encoding(Enc)), _, true)
|
|
; true % can this happen?
|
|
).
|
|
process_directive(system_module, _) :-
|
|
style_check(+dollar).
|
|
process_directive(set_prolog_flag(character_escapes, Esc), _) :-
|
|
set_prolog_flag(character_escapes, Esc).
|
|
process_directive(pce_expansion:push_compile_operators, _) :-
|
|
'$set_source_module'(SM, SM),
|
|
call(pce_expansion:push_compile_operators(SM)). % call to avoid xref
|
|
process_directive(pce_expansion:pop_compile_operators, _) :-
|
|
call(pce_expansion:pop_compile_operators).
|
|
process_directive(meta_predicate(Meta), _) :-
|
|
process_meta_predicate(Meta).
|
|
process_directive(arithmetic_function(FSpec), Src) :-
|
|
arith_callable(FSpec, Goal), !,
|
|
flag(xref_src_line, Line, Line),
|
|
assert_called(Src, '<directive>'(Line), Goal).
|
|
process_directive(format_predicate(_, Goal), Src) :- !,
|
|
flag(xref_src_line, Line, Line),
|
|
assert_called(Src, '<directive>'(Line), Goal).
|
|
process_directive(if(Cond), Src) :- !,
|
|
flag(xref_src_line, Line, Line),
|
|
assert_called(Src, '<directive>'(Line), Cond).
|
|
process_directive(elif(Cond), Src) :- !,
|
|
flag(xref_src_line, Line, Line),
|
|
assert_called(Src, '<directive>'(Line), Cond).
|
|
process_directive(else, _) :- !.
|
|
process_directive(endif, _) :- !.
|
|
process_directive(Goal, Src) :-
|
|
flag(xref_src_line, Line, Line),
|
|
process_body(Goal, '<directive>'(Line), Src).
|
|
|
|
%% process_meta_predicate(+Decl)
|
|
%
|
|
% Create prolog:meta_goal/2 declaration from the meta-goal
|
|
% declaration.
|
|
|
|
process_meta_predicate((A,B)) :- !,
|
|
process_meta_predicate(A),
|
|
process_meta_predicate(B).
|
|
process_meta_predicate(Decl) :-
|
|
functor(Decl, Name, Arity),
|
|
functor(Head, Name, Arity),
|
|
meta_args(1, Arity, Decl, Head, Meta),
|
|
( ( prolog:meta_goal(Head, _)
|
|
; called_by(Head, _)
|
|
; meta_goal(Head, _)
|
|
)
|
|
-> true
|
|
; assert(meta_goal(Head, Meta))
|
|
).
|
|
|
|
meta_args(I, Arity, _, _, []) :-
|
|
I > Arity, !.
|
|
meta_args(I, Arity, Decl, Head, [H|T]) :- % 0
|
|
arg(I, Decl, 0), !,
|
|
arg(I, Head, H),
|
|
I2 is I + 1,
|
|
meta_args(I2, Arity, Decl, Head, T).
|
|
meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I
|
|
arg(I, Decl, A),
|
|
integer(A), A > 0, !,
|
|
arg(I, Head, H),
|
|
I2 is I + 1,
|
|
meta_args(I2, Arity, Decl, Head, T).
|
|
meta_args(I, Arity, Decl, Head, Meta) :-
|
|
I2 is I + 1,
|
|
meta_args(I2, Arity, Decl, Head, Meta).
|
|
|
|
|
|
/********************************
|
|
* BODY *
|
|
********************************/
|
|
|
|
xref_meta((A, B), [A, B]).
|
|
xref_meta((A; B), [A, B]).
|
|
xref_meta((A| B), [A, B]).
|
|
xref_meta((A -> B), [A, B]).
|
|
xref_meta((A *-> B), [A, B]).
|
|
xref_meta(findall(_V,G,_L), [G]).
|
|
xref_meta(findall(_V,G,_L,_T), [G]).
|
|
xref_meta(setof(_V, G, _L), [G]).
|
|
xref_meta(bagof(_V, G, _L), [G]).
|
|
xref_meta(forall(A, B), [A, B]).
|
|
xref_meta(maplist(G,_), [G+1]).
|
|
xref_meta(maplist(G,_,_), [G+2]).
|
|
xref_meta(maplist(G,_,_,_), [G+3]).
|
|
xref_meta(maplist(G,_,_,_,_), [G+4]).
|
|
xref_meta(map_list_to_pairs(G,_,_), [G+2]).
|
|
xref_meta(map_assoc(G, _), [G+1]).
|
|
xref_meta(map_assoc(G, _, _), [G+2]).
|
|
xref_meta(checklist(G, _L), [G+1]).
|
|
xref_meta(sublist(G, _, _), [G+1]).
|
|
xref_meta(include(G, _, _), [G+1]).
|
|
xref_meta(exclude(G, _, _), [G+1]).
|
|
xref_meta(partition(G, _, _, _, _), [G+2]).
|
|
xref_meta(partition(G, _, _, _),[G+1]).
|
|
xref_meta(call(G), [G]).
|
|
xref_meta(call(G, _), [G+1]).
|
|
xref_meta(call(G, _, _), [G+2]).
|
|
xref_meta(call(G, _, _, _), [G+3]).
|
|
xref_meta(call(G, _, _, _, _), [G+4]).
|
|
xref_meta(not(G), [G]).
|
|
xref_meta(notrace(G), [G]).
|
|
xref_meta(\+(G), [G]).
|
|
xref_meta(ignore(G), [G]).
|
|
xref_meta(once(G), [G]).
|
|
xref_meta(initialization(G), [G]).
|
|
xref_meta(initialization(G,_), [G]).
|
|
xref_meta(retract(Rule), [G]) :- head_of(Rule, G).
|
|
xref_meta(clause(G, _), [G]).
|
|
xref_meta(clause(G, _, _), [G]).
|
|
xref_meta(phrase(G, _A), [G+2]).
|
|
xref_meta(phrase(G, _A, _R), [G+2]).
|
|
xref_meta(phrase_from_file(G,_),[G+2]).
|
|
xref_meta(catch(A, _, B), [A, B]).
|
|
xref_meta(thread_create(A,_,_), [A]).
|
|
xref_meta(thread_signal(_,A), [A]).
|
|
xref_meta(thread_at_exit(A), [A]).
|
|
xref_meta(thread_initialization(A), [A]).
|
|
xref_meta(predsort(A,_,_), [A+3]).
|
|
xref_meta(call_cleanup(A, B), [A, B]).
|
|
xref_meta(call_cleanup(A, _, B),[A, B]).
|
|
xref_meta(setup_call_cleanup(A, B, C),[A, B, C]).
|
|
xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]).
|
|
xref_meta(with_mutex(_,A), [A]).
|
|
xref_meta(assume(G), [G]). % library(debug)
|
|
xref_meta(assertion(G), [G]). % library(debug)
|
|
xref_meta(freeze(_, G), [G]).
|
|
xref_meta(when(C, A), [C, A]).
|
|
xref_meta(clause(G, _), [G]).
|
|
xref_meta(clause(G, _, _), [G]).
|
|
xref_meta(time(G), [G]). % development system
|
|
xref_meta(profile(G), [G]).
|
|
xref_meta(at_halt(G), [G]).
|
|
xref_meta(call_with_time_limit(_, G), [G]).
|
|
xref_meta(call_with_depth_limit(G, _, _), [G]).
|
|
xref_meta(alarm(_, G, _), [G]).
|
|
xref_meta(alarm(_, G, _, _), [G]).
|
|
xref_meta('$add_directive_wic'(G), [G]).
|
|
xref_meta(with_output_to(_, G), [G]).
|
|
xref_meta(if(G), [G]).
|
|
xref_meta(elif(G), [G]).
|
|
xref_meta(meta_options(G,_,_), [G+1]).
|
|
|
|
% XPCE meta-predicates
|
|
xref_meta(pce_global(_, new(_)), _) :- !, fail.
|
|
xref_meta(pce_global(_, B), [B+1]).
|
|
xref_meta(ifmaintainer(G), [G]). % used in manual
|
|
xref_meta(listen(_, G), [G]). % library(broadcast)
|
|
xref_meta(listen(_, _, G), [G]).
|
|
xref_meta(in_pce_thread(G), [G]).
|
|
|
|
xref_meta(G, Meta) :- % call user extensions
|
|
prolog:meta_goal(G, Meta).
|
|
xref_meta(G, Meta) :- % Generated from :- meta_predicate
|
|
meta_goal(G, Meta).
|
|
|
|
|
|
%% head_of(+Rule, -Head)
|
|
%
|
|
% Get the head for a retract call.
|
|
|
|
head_of(Var, _) :-
|
|
var(Var), !, fail.
|
|
head_of((Head :- _), Head).
|
|
head_of(Head, Head).
|
|
|
|
%% xref_hook(?Callable)
|
|
%
|
|
% Definition of known hooks. Hooks that can be called in any
|
|
% module are unqualified. Other hooks are qualified with the
|
|
% module where they are called.
|
|
|
|
xref_hook(Hook) :-
|
|
prolog:hook(Hook).
|
|
xref_hook(Hook) :-
|
|
hook(Hook).
|
|
|
|
|
|
hook(attr_portray_hook(_,_)).
|
|
hook(attr_unify_hook(_,_)).
|
|
hook(goal_expansion(_,_)).
|
|
hook(term_expansion(_,_)).
|
|
hook(resource(_,_,_)).
|
|
|
|
hook(emacs_prolog_colours:goal_classification(_,_)).
|
|
hook(emacs_prolog_colours:term_colours(_,_)).
|
|
hook(emacs_prolog_colours:goal_colours(_,_)).
|
|
hook(emacs_prolog_colours:style(_,_)).
|
|
hook(emacs_prolog_colours:identify(_,_)).
|
|
hook(pce_principal:pce_class(_,_,_,_,_,_)).
|
|
hook(pce_principal:send_implementation(_,_,_)).
|
|
hook(pce_principal:get_implementation(_,_,_,_)).
|
|
hook(pce_principal:pce_lazy_get_method(_,_,_)).
|
|
hook(pce_principal:pce_lazy_send_method(_,_,_)).
|
|
hook(pce_principal:pce_uses_template(_,_)).
|
|
hook(prolog:locate_clauses(_,_)).
|
|
hook(prolog:message(_,_,_)).
|
|
hook(prolog:message_context(_,_,_)).
|
|
hook(prolog:debug_control_hook(_)).
|
|
hook(prolog:help_hook(_)).
|
|
hook(prolog:show_profile_hook(_,_)).
|
|
hook(prolog:general_exception(_,_)).
|
|
hook(prolog_edit:load).
|
|
hook(prolog_edit:locate(_,_,_)).
|
|
hook(shlib:unload_all_foreign_libraries).
|
|
hook(system:'$foreign_registered'(_, _)).
|
|
hook(user:exception(_,_,_)).
|
|
hook(user:file_search_path(_,_)).
|
|
hook(user:library_directory(_)).
|
|
hook(user:message_hook(_,_,_)).
|
|
hook(user:portray(_)).
|
|
hook(user:prolog_clause_name(_,_)).
|
|
hook(user:prolog_list_goal(_)).
|
|
hook(user:prolog_predicate_name(_,_)).
|
|
hook(user:prolog_trace_interception(_,_,_,_)).
|
|
hook(user:prolog_event_hook(_)).
|
|
hook(user:prolog_exception_hook(_,_,_,_)).
|
|
|
|
|
|
%% arith_callable(+Spec, -Callable)
|
|
%
|
|
% Translate argument of arithmetic_function/1 into a callable term
|
|
|
|
arith_callable(Var, _) :-
|
|
var(Var), !, fail.
|
|
arith_callable(Module:Spec, Module:Goal) :- !,
|
|
arith_callable(Spec, Goal).
|
|
arith_callable(Name/Arity, Goal) :-
|
|
PredArity is Arity + 1,
|
|
functor(Goal, Name, PredArity).
|
|
|
|
|
|
%% process_body(+Body, +Origin, +Src)
|
|
%
|
|
% Process a callable body (body of a clause or directive). Origin
|
|
% describes the origin of the call.
|
|
|
|
process_body(Var, _, _) :-
|
|
var(Var), !.
|
|
process_body(Goal, Origin, Src) :-
|
|
called_by(Goal, Called), !,
|
|
must_be(list, Called),
|
|
assert_called(Src, Origin, Goal),
|
|
process_called_list(Called, Origin, Src).
|
|
process_body(Goal, Origin, Src) :-
|
|
process_xpce_goal(Goal, Origin, Src), !.
|
|
process_body(load_foreign_library(File), _Origin, Src) :-
|
|
process_foreign(File, Src).
|
|
process_body(load_foreign_library(File, _Init), _Origin, Src) :-
|
|
process_foreign(File, Src).
|
|
process_body(Goal, Origin, Src) :-
|
|
xref_meta(Goal, Metas), !,
|
|
assert_called(Src, Origin, Goal),
|
|
process_called_list(Metas, Origin, Src).
|
|
process_body(Goal, Origin, Src) :-
|
|
asserting_goal(Goal, Rule), !,
|
|
assert_called(Src, Origin, Goal),
|
|
process_assert(Rule, Origin, Src).
|
|
process_body(Goal, Origin, Src) :-
|
|
assert_called(Src, Origin, Goal).
|
|
|
|
process_called_list([], _, _).
|
|
process_called_list([H|T], Origin, Src) :-
|
|
process_meta(H, Origin, Src),
|
|
process_called_list(T, Origin, Src).
|
|
|
|
process_meta(A+N, Origin, Src) :- !,
|
|
( extend(A, N, AX)
|
|
-> process_body(AX, Origin, Src)
|
|
; true
|
|
).
|
|
process_meta(G, Origin, Src) :-
|
|
process_body(G, Origin, Src).
|
|
|
|
extend(Var, _, _) :-
|
|
var(Var), !, fail.
|
|
extend(M:G, N, M:GX) :- !,
|
|
callable(G),
|
|
extend(G, N, GX).
|
|
extend(G, N, GX) :-
|
|
callable(G),
|
|
G =.. List,
|
|
length(Rest, N),
|
|
append(List, Rest, NList),
|
|
GX =.. NList.
|
|
|
|
asserting_goal(assert(Rule), Rule).
|
|
asserting_goal(asserta(Rule), Rule).
|
|
asserting_goal(assertz(Rule), Rule).
|
|
asserting_goal(assert(Rule,_), Rule).
|
|
asserting_goal(asserta(Rule,_), Rule).
|
|
asserting_goal(assertz(Rule,_), Rule).
|
|
|
|
process_assert(0, _, _) :- !. % catch variables
|
|
process_assert((_:-Body), Origin, Src) :- !,
|
|
process_body(Body, Origin, Src).
|
|
process_assert(_, _, _).
|
|
|
|
|
|
/*******************************
|
|
* XPCE STUFF *
|
|
*******************************/
|
|
|
|
pce_goal(new(_,_), new(-, new)).
|
|
pce_goal(send(_,_), send(arg, msg)).
|
|
pce_goal(send_class(_,_,_), send_class(arg, arg, msg)).
|
|
pce_goal(get(_,_,_), get(arg, msg, -)).
|
|
pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)).
|
|
pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)).
|
|
pce_goal(get_object(_,_,_), get_object(arg, msg, -)).
|
|
|
|
process_xpce_goal(G, Origin, Src) :-
|
|
pce_goal(G, Process), !,
|
|
assert_called(Src, Origin, G),
|
|
( arg(I, Process, How),
|
|
arg(I, G, Term),
|
|
process_xpce_arg(How, Term, Origin, Src),
|
|
fail
|
|
; true
|
|
).
|
|
|
|
process_xpce_arg(new, Term, Origin, Src) :-
|
|
callable(Term),
|
|
process_new(Term, Origin, Src).
|
|
process_xpce_arg(arg, Term, Origin, Src) :-
|
|
compound(Term),
|
|
process_new(Term, Origin, Src).
|
|
process_xpce_arg(msg, Term, Origin, Src) :-
|
|
compound(Term),
|
|
( arg(_, Term, Arg),
|
|
process_xpce_arg(arg, Arg, Origin, Src),
|
|
fail
|
|
; true
|
|
).
|
|
|
|
process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules!
|
|
process_new(Term, Origin, Src) :-
|
|
assert_new(Src, Origin, Term),
|
|
( arg(_, Term, Arg),
|
|
process_xpce_arg(arg, Arg, Origin, Src),
|
|
fail
|
|
; true
|
|
).
|
|
|
|
assert_new(_, _, Term) :-
|
|
\+ callable(Term), !.
|
|
assert_new(Src, Origin, Control) :-
|
|
functor(Control, Class, _),
|
|
pce_control_class(Class), !,
|
|
forall(arg(_, Control, Arg),
|
|
assert_new(Src, Origin, Arg)).
|
|
assert_new(Src, Origin, Term) :-
|
|
compound(Term),
|
|
arg(1, Term, Prolog),
|
|
Prolog == @(prolog),
|
|
( Term =.. [message, _, Selector | T],
|
|
atom(Selector)
|
|
-> Called =.. [Selector|T],
|
|
process_body(Called, Origin, Src)
|
|
; Term =.. [?, _, Selector | T],
|
|
atom(Selector)
|
|
-> append(T, [_R], T2),
|
|
Called =.. [Selector|T2],
|
|
process_body(Called, Origin, Src)
|
|
),
|
|
fail.
|
|
assert_new(_, _, @(_)) :- !.
|
|
assert_new(Src, _, Term) :-
|
|
functor(Term, Name, _),
|
|
assert_used_class(Src, Name).
|
|
|
|
|
|
pce_control_class(and).
|
|
pce_control_class(or).
|
|
pce_control_class(if).
|
|
pce_control_class(not).
|
|
|
|
|
|
/********************************
|
|
* INCLUDED MODULES *
|
|
********************************/
|
|
|
|
%% process_use_module(+Modules, +Src, +Rexport) is det.
|
|
|
|
process_use_module(_Module:_Files, _, _) :- !. % loaded in another module
|
|
process_use_module([], _, _) :- !.
|
|
process_use_module([H|T], Src, Reexport) :- !,
|
|
process_use_module(H, Src, Reexport),
|
|
process_use_module(T, Src, Reexport).
|
|
process_use_module(library(pce), Src, Reexport) :- !, % bit special
|
|
xref_public_list(library(pce), Path, Public, Src),
|
|
forall(member(Import, Public),
|
|
process_pce_import(Import, Src, Path, Reexport)).
|
|
process_use_module(File, Src, Reexport) :-
|
|
( catch(xref_public_list(File, Path, Public, Src), _, fail)
|
|
-> assert_import(Src, Public, _, Path, Reexport),
|
|
( File = library(chr) % hacky
|
|
-> assert(mode(chr, Src))
|
|
; true
|
|
)
|
|
; true
|
|
).
|
|
|
|
process_pce_import(Name/Arity, Src, Path, Reexport) :-
|
|
atom(Name),
|
|
integer(Arity), !,
|
|
functor(Term, Name, Arity),
|
|
( \+ system_predicate(Term),
|
|
\+ Term = pce_error(_) % hack!?
|
|
-> assert_import(Src, [Name/Arity], _, Path, Reexport)
|
|
; true
|
|
).
|
|
process_pce_import(op(P,T,N), Src, _, _) :-
|
|
xref_push_op(Src, P, T, N).
|
|
|
|
%% xref_public_list(+File, -Path, -Public, +Src)
|
|
%
|
|
% Find File as referenced from Src. Unify Path with the an
|
|
% absolute path to the referenced source and Public with the
|
|
% export list of that (module) file. Exports are produced by the
|
|
% :- module/2 directive and all subsequent :- reexport directives.
|
|
|
|
xref_public_list(File, Path, Public, Src) :-
|
|
xref_public_list(File, Path, Src, Public, []).
|
|
|
|
xref_public_list(File, Path, Src, Public, Rest) :-
|
|
xref_source_file(File, Path, Src),
|
|
prolog_open_source(Path, Fd), % skips possible #! line
|
|
call_cleanup(read_public(Fd, Src, Public, Rest),
|
|
prolog_close_source(Fd)).
|
|
|
|
read_public(In, File, Public, Rest) :-
|
|
read(In, (:- module(_, Export))),
|
|
append(Export, Reexport, Public),
|
|
read(In, ReexportDecl),
|
|
read_reexport(ReexportDecl, In, File, Reexport, Rest).
|
|
|
|
read_reexport((:- reexport(Spec)), In, File, Reexport, Rest) :- !,
|
|
reexport_files(Spec, File, Reexport, Rest0),
|
|
read(In, ReexportDecl),
|
|
read_reexport(ReexportDecl, In, File, Rest0, Rest).
|
|
read_reexport((:- reexport(Spec, Import)), In, File, Reexport, Rest) :- !,
|
|
public_from_import(Import, Spec, File, Reexport, Rest0),
|
|
read(In, ReexportDecl),
|
|
read_reexport(ReexportDecl, In, File, Rest0, Rest).
|
|
read_reexport(_, _, _, Rest, Rest).
|
|
|
|
|
|
reexport_files([], _, Public, Public) :- !.
|
|
reexport_files([H|T], Src, Public, Rest) :- !,
|
|
xref_public_list(H, _, Src, Public, Rest0),
|
|
reexport_files(T, Src, Rest0, Rest).
|
|
reexport_files(Spec, Src, Public, Rest) :-
|
|
xref_public_list(Spec, Src, Public, Rest).
|
|
|
|
public_from_import(except(Map), File, Src, Export, Rest) :- !,
|
|
xref_public_list(File, _, Public, Src),
|
|
except(Map, Public, Export, Rest).
|
|
public_from_import(Import, _, _, Export, Rest) :-
|
|
import_name_map(Import, Export, Rest).
|
|
|
|
|
|
except([], Public, Export, Rest) :-
|
|
append(Public, Rest, Export).
|
|
except([PI0 as NewName|Map], Public, Export, Rest) :- !,
|
|
canonical_pi(PI0, PI),
|
|
map_as(Public, PI, NewName, Public2),
|
|
except(Map, Public2, Export, Rest).
|
|
except([PI0|Map], Public, Export, Rest) :-
|
|
canonical_pi(PI0, PI),
|
|
select(PI2, Public, Public2),
|
|
same_pi(PI, PI2), !,
|
|
except(Map, Public2, Export, Rest).
|
|
|
|
|
|
map_as([PI|T], Repl, As, [PI2|T]) :-
|
|
same_pi(Repl, PI), !,
|
|
pi_as(PI, As, PI2).
|
|
map_as([H|T0], Repl, As, [H|T]) :-
|
|
map_as(T0, Repl, As, T).
|
|
|
|
pi_as(_/Arity, Name, Name/Arity).
|
|
pi_as(_//Arity, Name, Name//Arity).
|
|
|
|
import_name_map([], L, L).
|
|
import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- !,
|
|
import_name_map(T0, T, Tail).
|
|
import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- !,
|
|
import_name_map(T0, T, Tail).
|
|
import_name_map([H|T0], [H|T], Tail) :-
|
|
import_name_map(T0, T, Tail).
|
|
|
|
canonical_pi(Name//Arity0, PI) :-
|
|
integer(Arity0), !,
|
|
PI = Name/Arity,
|
|
Arity is Arity0 + 2.
|
|
canonical_pi(PI, PI).
|
|
|
|
same_pi(Canonical, PI2) :-
|
|
canonical_pi(PI2, Canonical).
|
|
|
|
|
|
/*******************************
|
|
* INCLUDE *
|
|
*******************************/
|
|
|
|
process_include([], _) :- !.
|
|
process_include([H|T], Src) :- !,
|
|
process_include(H, Src),
|
|
process_include(T, Src).
|
|
process_include(File, Src) :-
|
|
catch(read_src_to_terms(File, Src, Terms), _, fail), !,
|
|
process_terms(Terms, Src).
|
|
process_include(_, _).
|
|
|
|
process_terms([], _).
|
|
process_terms([H|T], Src) :-
|
|
process(H, Src),
|
|
process_terms(T, Src).
|
|
|
|
read_src_to_terms(File, Src, Terms) :-
|
|
xref_source_file(File, Path, Src),
|
|
prolog_open_source(Path, Fd),
|
|
call_cleanup(read_clauses(Fd, Terms),
|
|
prolog_close_source(Fd)).
|
|
|
|
read_clauses(In, Terms) :-
|
|
read_clause(In, C0),
|
|
read_clauses(C0, In, Terms).
|
|
|
|
read_clauses(end_of_file, _, []) :- !.
|
|
read_clauses(Term, In, [Term|T]) :-
|
|
read_clause(In, C),
|
|
read_clauses(C, In, T).
|
|
|
|
|
|
%% process_foreign(+Spec, +Src)
|
|
%
|
|
% Process a load_foreign_library/1 call.
|
|
|
|
process_foreign(Spec, Src) :-
|
|
current_foreign_library(Spec, Defined),
|
|
( xmodule(Module, Src)
|
|
-> true
|
|
; Module = user
|
|
),
|
|
process_foreign_defined(Defined, Module, Src).
|
|
|
|
process_foreign_defined([], _, _).
|
|
process_foreign_defined([H|T], M, Src) :-
|
|
( H = M:Head
|
|
-> assert_foreign(Src, Head)
|
|
; assert_foreign(Src, H)
|
|
),
|
|
process_foreign_defined(T, M, Src).
|
|
|
|
|
|
/*******************************
|
|
* CHR SUPPORT *
|
|
*******************************/
|
|
|
|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
This part of the file supports CHR. Our choice is between making special
|
|
hooks to make CHR expansion work and then handle the (complex) expanded
|
|
code or process the CHR source directly. The latter looks simpler,
|
|
though I don't like the idea of adding support for libraries to this
|
|
module. A file is supposed to be a CHR file if it uses a
|
|
use_module(library(chr) or contains a :- constraint/1 directive. As an
|
|
extra bonus we get the source-locations right :-)
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
|
|
|
chr_expandable((:- constraints(_))).
|
|
chr_expandable((constraints(_))).
|
|
chr_expandable((handler(_))) :-
|
|
is_chr_file.
|
|
chr_expandable((rules(_))) :-
|
|
is_chr_file.
|
|
chr_expandable(<=>(_, _)) :-
|
|
is_chr_file.
|
|
chr_expandable(@(_, _)) :-
|
|
is_chr_file.
|
|
chr_expandable(==>(_, _)) :-
|
|
is_chr_file.
|
|
chr_expandable(pragma(_, _)) :-
|
|
is_chr_file.
|
|
chr_expandable(option(_, _)) :-
|
|
is_chr_file.
|
|
|
|
is_chr_file :-
|
|
source(Src, _),
|
|
mode(chr, Src), !.
|
|
|
|
process_chr(@(_Name, Rule), Src) :-
|
|
process_chr(Rule, Src).
|
|
process_chr(pragma(Rule, _Pragma), Src) :-
|
|
process_chr(Rule, Src).
|
|
process_chr(<=>(Head, Body), Src) :-
|
|
chr_head(Head, Src, H),
|
|
chr_body(Body, H, Src).
|
|
process_chr(==>(Head, Body), Src) :-
|
|
chr_head(Head, H, Src),
|
|
chr_body(Body, H, Src).
|
|
process_chr((:- constraints(C)), Src) :-
|
|
process_chr(constraints(C), Src).
|
|
process_chr(constraints(_), Src) :-
|
|
( mode(chr, Src)
|
|
-> true
|
|
; assert(mode(chr, Src))
|
|
).
|
|
|
|
chr_head(X, _, _) :-
|
|
var(X), !. % Illegal. Warn?
|
|
chr_head(\(A,B), Src, H) :-
|
|
chr_head(A, Src, H),
|
|
process_body(B, H, Src).
|
|
chr_head((H0,B), Src, H) :-
|
|
chr_defined(H0, Src, H),
|
|
process_body(B, H, Src).
|
|
chr_head(H0, Src, H) :-
|
|
chr_defined(H0, Src, H).
|
|
|
|
chr_defined(X, _, _) :-
|
|
var(X), !.
|
|
chr_defined(#(C,_Id), Src, C) :- !,
|
|
assert_constraint(Src, C).
|
|
chr_defined(A, Src, A) :-
|
|
assert_constraint(Src, A).
|
|
|
|
chr_body(X, From, Src) :-
|
|
var(X), !,
|
|
process_body(X, From, Src).
|
|
chr_body('|'(Guard, Goals), H, Src) :- !,
|
|
chr_body(Guard, H, Src),
|
|
chr_body(Goals, H, Src).
|
|
chr_body(G, From, Src) :-
|
|
process_body(G, From, Src).
|
|
|
|
assert_constraint(_, Head) :-
|
|
var(Head), !.
|
|
assert_constraint(Src, Head) :-
|
|
constraint(Head, Src, _), !.
|
|
assert_constraint(Src, Head) :-
|
|
functor(Head, Name, Arity),
|
|
functor(Term, Name, Arity),
|
|
flag(xref_src_line, Line, Line),
|
|
assert(constraint(Term, Src, Line)).
|
|
|
|
|
|
/********************************
|
|
* PHASE 1 ASSERTIONS *
|
|
********************************/
|
|
|
|
%% assert_called(+Src, +From, +Head)
|
|
%
|
|
% Assert the fact that Head is called by From in Src. We do not
|
|
% assert called system predicates.
|
|
|
|
assert_called(_, _, Var) :-
|
|
var(Var), !.
|
|
assert_called(Src, From, Goal) :-
|
|
var(From), !,
|
|
assert_called(Src, '<unknown>', Goal).
|
|
assert_called(_, _, Goal) :-
|
|
hide_called(Goal), !.
|
|
assert_called(Src, Origin, M:G) :- !,
|
|
( atom(M),
|
|
callable(G)
|
|
-> ( xmodule(M, Src)
|
|
-> assert_called(Src, Origin, G)
|
|
; called(M:G, Src, Origin)
|
|
-> true
|
|
; generalise(Origin, OTerm),
|
|
generalise(G, GTerm),
|
|
assert(called(M:GTerm, Src, OTerm))
|
|
)
|
|
; true % call to variable module
|
|
).
|
|
assert_called(_, _, Goal) :-
|
|
system_predicate(Goal), !.
|
|
assert_called(Src, Origin, Goal) :-
|
|
called(Goal, Src, Origin), !.
|
|
assert_called(Src, Origin, Goal) :-
|
|
generalise(Origin, OTerm),
|
|
generalise(Goal, Term),
|
|
assert(called(Term, Src, OTerm)).
|
|
|
|
%% hide_called(:Callable)
|
|
%
|
|
% Goals that should not turn up as being called. Hack. Eventually
|
|
% we should deal with that using an XPCE plugin.
|
|
|
|
hide_called(pce_principal:send_implementation(_, _, _)).
|
|
hide_called(pce_principal:get_implementation(_, _, _, _)).
|
|
hide_called(pce_principal:pce_lazy_get_method(_,_,_)).
|
|
hide_called(pce_principal:pce_lazy_send_method(_,_,_)).
|
|
|
|
assert_defined(Src, Goal) :-
|
|
defined(Goal, Src, _), !.
|
|
assert_defined(Src, Goal) :-
|
|
generalise(Goal, Term),
|
|
flag(xref_src_line, Line, Line),
|
|
assert(defined(Term, Src, Line)).
|
|
|
|
assert_foreign(Src, Goal) :-
|
|
foreign(Goal, Src, _), !.
|
|
assert_foreign(Src, Goal) :-
|
|
generalise(Goal, Term),
|
|
flag(xref_src_line, Line, Line),
|
|
assert(foreign(Term, Src, Line)).
|
|
|
|
%% assert_import(+Src, +Import, +PublicList, +From, +Reexport) is det.
|
|
%
|
|
% Asserts imports into Src. Import is the import specification,
|
|
% PublicList is the list of known public predicates or unbound if
|
|
% this need not be checked and From is the file from which the
|
|
% public predicates come. If Reexport is =true=, re-export the
|
|
% imported predicates.
|
|
%
|
|
% @tbd Tighter type-checking on Import.
|
|
|
|
assert_import(_, [], _, _, _) :- !.
|
|
assert_import(Src, [H|T], Public, From, Reexport) :- !,
|
|
assert_import(Src, H, Public, From, Reexport),
|
|
assert_import(Src, T, Public, From, Reexport).
|
|
assert_import(Src, except(Except), Public, From, Reexport) :- !,
|
|
is_list(Public), !,
|
|
except(Except, Public, Import, []),
|
|
assert_import(Src, Import, _All, From, Reexport).
|
|
assert_import(Src, Import as Name, Public, From, Reexport) :- !,
|
|
pi_to_head(Import, Term0),
|
|
functor(Term0, _OldName, Arity),
|
|
functor(Term, Name, Arity),
|
|
( in_public_list(Term0, Public)
|
|
-> assert(imported(Term, Src, From)),
|
|
assert_reexport(Reexport, Src, Term)
|
|
; flag(xref_src_line, Line, Line),
|
|
assert_called(Src, '<directive>'(Line), Term0)
|
|
).
|
|
assert_import(Src, Import, Public, From, Reexport) :-
|
|
pi_to_head(Import, Term), !,
|
|
( in_public_list(Term, Public)
|
|
-> assert(imported(Term, Src, From)),
|
|
assert_reexport(Reexport, Src, Term)
|
|
; flag(xref_src_line, Line, Line),
|
|
assert_called(Src, '<directive>'(Line), Term)
|
|
).
|
|
assert_import(Src, op(P,T,N), _, _, _) :-
|
|
xref_push_op(Src, P,T,N).
|
|
|
|
in_public_list(_Head, Public) :-
|
|
var(Public), !.
|
|
in_public_list(Head, Public) :-
|
|
member(Export, Public),
|
|
pi_to_head(Export, Head).
|
|
|
|
assert_reexport(false, _, _) :- !.
|
|
assert_reexport(true, Src, Term) :-
|
|
assert(exported(Term, Src)).
|
|
|
|
|
|
%% assert_op(+Src, +Op) is det.
|
|
%
|
|
% @param Op Ground term op(Priority, Type, Name).
|
|
|
|
assert_op(Src, op(P,T,_:N)) :-
|
|
( xop(Src, op(P,T,N))
|
|
-> true
|
|
; assert(xop(Src, op(P,T,N)))
|
|
).
|
|
|
|
%% assert_module(+Src, +Module)
|
|
%
|
|
% Assert we are loading code into Module. This is also used to
|
|
% exploit local term-expansion and other rules.
|
|
|
|
assert_module(Src, Module) :-
|
|
xmodule(Module, Src), !.
|
|
assert_module(Src, Module) :-
|
|
'$set_source_module'(_, Module),
|
|
assert(xmodule(Module, Src)).
|
|
|
|
assert_export(_, []) :- !.
|
|
assert_export(Src, [H|T]) :- !,
|
|
assert_export(Src, H),
|
|
assert_export(Src, T).
|
|
assert_export(Src, PI) :-
|
|
pi_to_head(PI, Term), !,
|
|
assert(exported(Term, Src)).
|
|
assert_export(Src, op(P, A, N)) :-
|
|
xref_push_op(Src, P, A, N).
|
|
|
|
assert_dynamic(Src, (A, B)) :- !,
|
|
assert_dynamic(Src, A),
|
|
assert_dynamic(Src, B).
|
|
assert_dynamic(_, _M:_Name/_Arity) :- !. % not local
|
|
assert_dynamic(Src, PI) :-
|
|
pi_to_head(PI, Term),
|
|
( thread_local(Term, Src, _) % dynamic after thread_local has
|
|
-> true % no effect
|
|
; flag(xref_src_line, Line, Line),
|
|
assert(dynamic(Term, Src, Line))
|
|
).
|
|
|
|
assert_thread_local(Src, (A, B)) :- !,
|
|
assert_thread_local(Src, A),
|
|
assert_thread_local(Src, B).
|
|
assert_thread_local(_, _M:_Name/_Arity) :- !. % not local
|
|
assert_thread_local(Src, PI) :-
|
|
pi_to_head(PI, Term),
|
|
flag(xref_src_line, Line, Line),
|
|
assert(thread_local(Term, Src, Line)).
|
|
|
|
assert_multifile(Src, (A, B)) :- !,
|
|
assert_multifile(Src, A),
|
|
assert_multifile(Src, B).
|
|
assert_multifile(_, _M:_Name/_Arity) :- !. % not local
|
|
assert_multifile(Src, PI) :-
|
|
pi_to_head(PI, Term),
|
|
flag(xref_src_line, Line, Line),
|
|
assert(multifile(Term, Src, Line)).
|
|
|
|
%% pi_to_head(+PI, -Head) is semidet.
|
|
%
|
|
% Translate Name/Arity or Name//Arity to a callable term. Fails if
|
|
% PI is not a predicate indicator.
|
|
|
|
pi_to_head(Var, _) :-
|
|
var(Var), !, fail.
|
|
pi_to_head(Name/Arity, Term) :-
|
|
functor(Term, Name, Arity).
|
|
pi_to_head(Name//DCGArity, Term) :-
|
|
Arity is DCGArity+2,
|
|
functor(Term, Name, Arity).
|
|
|
|
|
|
assert_used_class(Src, Name) :-
|
|
used_class(Name, Src), !.
|
|
assert_used_class(Src, Name) :-
|
|
assert(used_class(Name, Src)).
|
|
|
|
assert_defined_class(Src, Name, _Meta, _Super, _) :-
|
|
defined_class(Name, _, _, Src, _), !.
|
|
assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class
|
|
assert_defined_class(Src, Name, Meta, Super, Summary) :-
|
|
flag(xref_src_line, Line, Line),
|
|
( Summary == @(default)
|
|
-> Atom = ''
|
|
; is_list(Summary)
|
|
-> atom_codes(Atom, Summary)
|
|
; string(Summary)
|
|
-> atom_concat(Summary, '', Atom)
|
|
),
|
|
assert(defined_class(Name, Super, Atom, Src, Line)),
|
|
( Meta = @(_)
|
|
-> true
|
|
; assert_used_class(Src, Meta)
|
|
),
|
|
assert_used_class(Src, Super).
|
|
|
|
assert_defined_class(Src, Name, imported_from(_File)) :-
|
|
defined_class(Name, _, _, Src, _), !.
|
|
assert_defined_class(Src, Name, imported_from(File)) :-
|
|
assert(defined_class(Name, _, '', Src, file(File))).
|
|
|
|
|
|
/********************************
|
|
* UTILITIES *
|
|
********************************/
|
|
|
|
%% generalise(+Callable, -General)
|
|
%
|
|
% Generalise a callable term.
|
|
|
|
generalise(Var, Var) :-
|
|
var(Var), !. % error?
|
|
generalise(pce_principal:send_implementation(Id, _, _),
|
|
pce_principal:send_implementation(Id, _, _)) :-
|
|
atom(Id), !.
|
|
generalise(pce_principal:get_implementation(Id, _, _, _),
|
|
pce_principal:get_implementation(Id, _, _, _)) :-
|
|
atom(Id), !.
|
|
generalise('<directive>'(Line), '<directive>'(Line)) :- !.
|
|
generalise(Module:Goal0, Module:Goal) :-
|
|
atom(Module), !,
|
|
generalise(Goal0, Goal).
|
|
generalise(Term0, Term) :-
|
|
callable(Term0),
|
|
functor(Term0, Name, Arity),
|
|
functor(Term, Name, Arity).
|
|
|
|
|
|
/*******************************
|
|
* SOURCE MANAGEMENT *
|
|
*******************************/
|
|
|
|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
This section of the file contains hookable predicates to reason about
|
|
sources. The built-in code here can only deal with files. The XPCE
|
|
library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we
|
|
can do cross-referencing on PceEmacs edit buffers. Other examples for
|
|
hooking can be databases, (HTTP) URIs, etc.
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
|
|
|
:- multifile
|
|
prolog:xref_source_directory/2. % +Source, -Dir
|
|
|
|
|
|
%% xref_source_file(+Spec, -File, +Src) is semidet.
|
|
%% xref_source_file(+Spec, -File, +Src, +Options) is semidet.
|
|
%
|
|
% Find named source file from Spec, relative to Src.
|
|
|
|
xref_source_file(Plain, File, Source) :-
|
|
xref_source_file(Plain, File, Source, []).
|
|
|
|
xref_source_file(Plain, File, Source, Options) :-
|
|
atom(Plain),
|
|
\+ is_absolute_file_name(Plain),
|
|
( prolog:xref_source_directory(Source, Dir)
|
|
-> true
|
|
; atom(Source),
|
|
file_directory_name(Source, Dir)
|
|
),
|
|
atomic_list_concat([Dir, /, Plain], Spec),
|
|
do_xref_source_file(Spec, File, Options), !.
|
|
xref_source_file(Spec, File, _, Options) :-
|
|
do_xref_source_file(Spec, File, Options), !.
|
|
xref_source_file(Spec, _, _, _) :-
|
|
verbose,
|
|
print_message(warning, error(existence_error(file, Spec), _)),
|
|
fail.
|
|
|
|
do_xref_source_file(Spec, File, Options) :-
|
|
option(file_type(Type), Options, prolog),
|
|
absolute_file_name(Spec,
|
|
[ file_type(Type),
|
|
access(read),
|
|
file_errors(fail)
|
|
], File), !.
|
|
|