1022 lines
27 KiB
Plaintext
1022 lines
27 KiB
Plaintext
|
|
:- style_check(all).
|
|
|
|
:- use_module(library(readutil)).
|
|
:- use_module(library(lineutils)).
|
|
:- use_module(library(lists)).
|
|
:- use_module(library(maplist)).
|
|
:- use_module(library(system)).
|
|
|
|
:- initialization(main).
|
|
|
|
:- yap_flag( double_quotes, string ).
|
|
%:- yap_flag( dollar_as_lower_case, on ).
|
|
|
|
:- dynamic edge/1,
|
|
public/2,
|
|
private/2,
|
|
module_on/3,
|
|
exported/1,
|
|
dir/2,
|
|
consulted/2,
|
|
op_export/3.
|
|
library/1.
|
|
|
|
% @short node(?Module:module, ?Predicate:pred_indicator, ?File:file, ?Generator:atom) is nondet
|
|
%
|
|
|
|
|
|
inline( !/0 ).
|
|
inline( (\+)/1 ).
|
|
inline( (fail)/0 ).
|
|
inline( (false)/0 ).
|
|
inline( (repeat)/0 ).
|
|
inline( (true)/0 ).
|
|
inline( []/0 ).
|
|
|
|
% @short edge(+SourceModule:module, +SourcePredicate:pred_indicator, +TargetPredicate:pred_indicator, +InFile:file) is nondet
|
|
%
|
|
|
|
main :-
|
|
init,
|
|
fail.
|
|
main :-
|
|
unix(argv([D])),
|
|
working_directory(_, D),
|
|
fail.
|
|
main :-
|
|
% from libraries outside the current directories
|
|
assert( node( attributes, woken_att_do/4, 'library/atts.yap', prolog ) ),
|
|
fail.
|
|
main :-
|
|
Dirs = ['C'-prolog,
|
|
'os'-prolog,
|
|
'pl'-prolog,
|
|
'OPTYap'-prolog,
|
|
'library'-user,
|
|
'swi/console'-prolog,
|
|
'swi/library'-user,
|
|
'packages'-user],
|
|
dirs( Dirs ),
|
|
%%% phase 1: find modules
|
|
nb_setval( current_module, user ),
|
|
nb_setval( private, false ),
|
|
init_loop( Dirs ),
|
|
maplist( pl_interfs, Dirs ),
|
|
%%% phase 2: find C-code predicates
|
|
maplist( c_preds, Dirs ),
|
|
%%% phase 4: construct graph
|
|
retractall( consulted(_,_) ),
|
|
maplist( pl_graphs, Dirs ),
|
|
undefs,
|
|
doubles,
|
|
% pl_exported(pl).
|
|
c_links.
|
|
|
|
|
|
dirs( Roots ) :-
|
|
member( Root-_, Roots ),
|
|
directory_files( Root , Files),
|
|
member( File, Files ),
|
|
atom_concat( [Root,'/',File], New ),
|
|
(
|
|
file_property( New, type(directory) ),
|
|
File \= '.',
|
|
File \= '..',
|
|
File \= '.git',
|
|
subdir( New )
|
|
;
|
|
absolute_file_name( Root, FRoot ),
|
|
assert_new( dir( FRoot, File ))
|
|
),
|
|
fail.
|
|
dirs(_).
|
|
|
|
subdir( Root ) :-
|
|
directory_files( Root , Files),
|
|
member( File, Files ),
|
|
atom_concat( [Root,'/',File], New ),
|
|
(
|
|
file_property( New, type(directory) ),
|
|
File \= '.',
|
|
File \= '..',
|
|
File \= '.git',
|
|
subdir( New )
|
|
;
|
|
absolute_file_name( Root, ARoot),
|
|
assert_new( dir( ARoot, File ))
|
|
),
|
|
fail.
|
|
|
|
|
|
init :-
|
|
retractall(dir(_)),
|
|
retractall(edge(_)),
|
|
retractall(private(_,_)),
|
|
retractall(public(_,_)),
|
|
retractall(consulted(_,_)),
|
|
retractall(module_on(_,_,_)),
|
|
retractall(op_export(_,_,_)),
|
|
retractall(exported(_)).
|
|
|
|
init_loop( _Dirs ).
|
|
|
|
c_preds(Dir - Mod) :-
|
|
atom( Dir ),
|
|
atom_concat([Dir,'/*'], Pattern),
|
|
expand_file_name( Pattern, Files ),
|
|
member( File, Files ),
|
|
( ( sub_atom(File,_,_,0,'.c') ; sub_atom(File,_,_,0,'.cpp') ) ->
|
|
c_file( File , Mod )
|
|
;
|
|
exists_directory( File ),
|
|
\+ atom_concat(_, '/.', File),
|
|
\+ atom_concat(_, '/..', File),
|
|
c_preds( File - Mod )
|
|
),
|
|
fail.
|
|
c_preds(_).
|
|
|
|
|
|
c_file(F, Mod) :-
|
|
% wrixbteln(F),
|
|
nb_setval( current_module, Mod ),
|
|
open(F, read, S, [alias(c_file)]),
|
|
repeat,
|
|
read_line_to_string( S, String ),
|
|
( String == end_of_file
|
|
->
|
|
!,
|
|
close(S)
|
|
;
|
|
split_string(String, ",; ()\t\"\'", Fields),
|
|
%writeln(Fields),
|
|
line_count(S, Lines),
|
|
c_line(Fields , Mod, F:Lines),
|
|
fail
|
|
).
|
|
|
|
c_line(["}"], Mod, _) :- !,
|
|
nb_setval( current_module, Mod ).
|
|
c_line(Line, _Mod, _) :-
|
|
append( _, [ "CurrentModule", "=", M|_], Line),
|
|
system_mod(M, _Mod, Mod),
|
|
nb_setval( current_module, Mod ).
|
|
c_line(Line, Mod, F:_Line) :-
|
|
break_line( Line, N/A, Fu),
|
|
handle_pred( Mod, N, A, F ),
|
|
assert( foreign( Mod:N/A, Fu ) ).
|
|
|
|
break_line( Line, N/A, c(Fu)) :-
|
|
take_line( Line, NS, AS, FS ), !,
|
|
atom_string(N,NS),
|
|
atom_string(Fu,FS),
|
|
number_string(A, AS).
|
|
break_line( Line, N/A, swi(Fu)) :-
|
|
take_line( Line, NS, AS, FS ), !,
|
|
atom_string(N,NS),
|
|
number_string(A, AS),
|
|
atomic_concat(["pl_",FS,"_",A,"_va"], Fu).
|
|
break_line( Line, N/A, bp(Fu)) :-
|
|
take_line( Line, NS, AS, FS ), !,
|
|
atom_string(N,NS),
|
|
number_string(A, AS),
|
|
atomic_concat(["pc_",FS,"_",A], Fu).
|
|
break_line( Line, N/A, c(FuE, FuB)) :-
|
|
take_line( Line, NS, AS, FSE, FSB ), !,
|
|
atom_string(N,NS),
|
|
atom_string(FuE,FSE),
|
|
atom_string(FuB,FSB),
|
|
number_string(A, AS).
|
|
|
|
take_line( Line, NS, AS, FS ) :-
|
|
append( _, [ "Yap_InitCPred", NS, AS, FS|_], Line), !.
|
|
take_line( Line, NS, AS, FS ) :-
|
|
append( _, [ "Yap_InitAsmPred", NS, AS, _, FS|_], Line), !.
|
|
take_line( Line, NS, AS, FS ) :-
|
|
append( _, [ "Yap_InitCmpPred", NS, AS, FS|_], Line), !.
|
|
take_line( Line, NS, AS, FS ) :-
|
|
append( _, [ "Yap_InitCmpPred", NS, AS, FS|_], Line), !.
|
|
take_line( Line, NS, AS, FS ) :-
|
|
append( _, [ "YAP_UserCPredicate", NS, FS, AS|_], Line), !.
|
|
take_line( Line, NS, AS, FS ) :-
|
|
append( _, [ "PRED", NS, AS, FS|_], Line), !.
|
|
take_line( Line, NS, AS, FS ) :-
|
|
append( _, [ "PRED_IMPL", NS, AS, FS|_], Line), !.
|
|
take_line( Line, NS, AS, FS ) :-
|
|
append( _, [ "PRED_DEF", NS, AS, FS|_], Line), !.
|
|
take_line( Line, NS, AS, FS ) :-
|
|
append( _, [ "FRG", NS, AS, FS|_], Line), !.
|
|
|
|
|
|
take_line( Line, AS, FS ) :-
|
|
append( _, [ "REGISTER_CPRED", FS, AS], Line), !.
|
|
|
|
|
|
take_line( Line, NS, AS, FSE, FSB ) :-
|
|
append( _, [ "Yap_InitCPredBack", NS, AS, _, FSE, FSB|_], Line), !.
|
|
|
|
system_mod("ATTRIBUTES_MODULE", _, attributes ).
|
|
system_mod("HACKS_MODULE", _, '$hacks' ).
|
|
system_mod("USER_MODULE", _, user ).
|
|
system_mod("DBLOAD_MODULE", xs, '$db_load' ).
|
|
system_mod("GLOBALS_MODULE", _, globals ).
|
|
system_mod("ARG_MODULE", _, arg ).
|
|
system_mod("PROLOG_MODULE", _ , prolog ).
|
|
system_mod("RANGE_MODULE", _, range ).
|
|
system_mod("SWI_MODULE", _, swi ).
|
|
system_mod("OPERATING_SYSTEM_MODULE", _, operating_system_support ).
|
|
system_mod("TERMS_MODULE", _, terms ).
|
|
system_mod("SYSTEM_MODULE", _, system ).
|
|
system_mod("IDB_MODULE", _, idb ).
|
|
system_mod("CHARSIO_MODULE", _, charsio ).
|
|
system_mod("cm", M, M ).
|
|
|
|
|
|
pl_interfs(Dir - Mod) :-
|
|
format(' ************* MOD: ~a ***********************\n', [Dir]),
|
|
nb_setval( current_module, Mod ),
|
|
atom( Dir ),
|
|
directory_files( Dir , Files),
|
|
member( File, Files ),
|
|
atom_concat([Dir,'/',File], Path),
|
|
( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ) ->
|
|
ops_restore,
|
|
pl_interf( Path , Mod )
|
|
;
|
|
exists_directory( Path ),
|
|
\+ atom_concat(_, '/.', Path),
|
|
\+ atom_concat(_, '/..', Path),
|
|
\+ atom_concat(_, '/.git', Path),
|
|
pl_interfs( Path - Mod )
|
|
),
|
|
fail.
|
|
pl_interfs(_).
|
|
|
|
%%
|
|
% pl_interf( File, Mod)
|
|
% adds a node to the file graph and marks which files are modules
|
|
%
|
|
% main side-effect facts like edge( F0-Mod:File )
|
|
% exported( ( FMNATarget :- FMNASource ) ) ou exported(F-M, Op ),
|
|
% module_on ( M, File )
|
|
%
|
|
pl_interf(F, _Mod) :-
|
|
consulted(F, _M ),
|
|
!.
|
|
pl_interf(F, Mod) :-
|
|
writeln(F),
|
|
% ( sub_atom(F,_,_,_,'matrix.yap') -> spy get_interf ; true ),
|
|
assert_new(consulted(F, Mod ) ),
|
|
nb_getval( private, Default ),
|
|
nb_setval( private, false ),
|
|
catch( open(F, read, S, []) , _, fail ),
|
|
repeat,
|
|
nb_getval( current_module, MR ),
|
|
catch( read_term( S, T, [module( MR )] ), Throw, (writeln(F:MR:Throw), break, fail)),
|
|
% ( sub_atom(F,_,_,_,'matrix.yap') -> writeln(MR:T) ; true ),
|
|
(
|
|
T == end_of_file
|
|
->
|
|
!,
|
|
% also, clo ops defined in the module M, if M \= Mod
|
|
generate_interface( F, Mod ),
|
|
nb_setval( current_module, Mod ),
|
|
nb_setval( private, Default ),
|
|
close(S)
|
|
;
|
|
nb_getval( current_module, MC0 ),
|
|
( Mod == prolog -> MC = prolog ; MC = MC0 ),
|
|
get_interf( T, F, MC ),
|
|
fail
|
|
).
|
|
|
|
get_interf( T, _F, _M0 ) :-
|
|
var(T),
|
|
!.
|
|
get_interf( T, _F, _M0 ) :-
|
|
% ( T = (:- op(_,_,_)) -> trace ; true ),
|
|
var(T),
|
|
!.
|
|
get_interf( M:T, F, _M0 ) :- !,
|
|
get_interf( T, F, M ).
|
|
get_interf( ( M:H :- _B), F, _M ) :-
|
|
!,
|
|
get_interf( H, F, M ).
|
|
get_interf( ( M:H --> _B), F, _ ) :-
|
|
!,
|
|
get_interf( ( H --> _B), F, M ).
|
|
get_interf( ( A, _ --> _B), F, M ) :-
|
|
get_interf( ( A --> _B), F, M ).
|
|
get_interf( (H --> _B), F, M ) :-
|
|
!,
|
|
functor( H, N, Ar),
|
|
Ar2 is Ar+2,
|
|
functor( H2, N, Ar2),
|
|
get_interf( H2, F, M ).
|
|
get_interf( (H :- _B), F, M ) :-
|
|
!,
|
|
get_interf( H, F, M ).
|
|
%% switches to new file n
|
|
get_interf( (:- V ), _F, _M ) :-
|
|
var( V ),
|
|
!.
|
|
get_interf( (:- module( NM, Is ) ), F, _M ) :-
|
|
!,
|
|
nb_setval( current_module, NM ),
|
|
assert( module_on( F , NM, Is) ),
|
|
maplist( public(F, NM), Is ),
|
|
nb_setval( private, true ).
|
|
get_interf( (:- reexport( Loc, Is ) ), F, M ) :-
|
|
!,
|
|
% find the file
|
|
search_file( Loc, F, NF ),
|
|
% depth visit
|
|
pl_interf(NF, M), % should verify Is in _Is
|
|
% link bdd
|
|
module_on( NF, NM, _ ),
|
|
maplist( exported( NF, F, NM, M) , Is ),
|
|
maplist( public(F, M), Is ).
|
|
get_interf( (:- use_module( Loc, Is ) ), F, M ) :- !,
|
|
!,
|
|
% find the file
|
|
search_file( Loc, F, NF ),
|
|
% depth visit
|
|
pl_interf(NF, M), % should verify Is in _Is
|
|
% link b
|
|
module_on( NF, NM, _ ),
|
|
maplist( exported( NF, F, NM, M) , Is ).
|
|
get_interf( (:- use_module( Loc ) ), F, M ) :- !,
|
|
!,
|
|
% find the file
|
|
search_file( Loc, F, NF ),
|
|
% depth visit
|
|
pl_interf(NF, M), % should verify Is in _Is
|
|
% link b
|
|
module_on( NF, NM, Is ),
|
|
maplist( exported( NF, F, NM, M) , Is ).
|
|
% nb_getval(current_module,MM), writeln(NM:MM:M).
|
|
get_interf( (:- use_module( Loc, Is, _ ) ), F, M ) :- !,
|
|
!,
|
|
% find the file
|
|
search_file( Loc, F, NF ),
|
|
% depth visit
|
|
pl_interf(NF, M), % should verify Is in _Is
|
|
% link b
|
|
module_on( NF, NM, _ ),
|
|
maplist( exported( NF, F, NM, M) , Is ).
|
|
get_interf( (:- consult( Files ) ), F, M ) :-
|
|
!,
|
|
include_files( F, M, Files ).
|
|
get_interf( (:- reconsult( Files ) ), F, M ) :-
|
|
!,
|
|
include_files( F, M, Files ).
|
|
get_interf( (:- ensure_loaded( Files ) ), F, M ) :-
|
|
!,
|
|
include_files( F, M, Files ).
|
|
get_interf( (:- include( Files ) ), F, M ) :-
|
|
!,
|
|
include_files( F, M, Files ).
|
|
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
|
|
!,
|
|
include_files( F, M, Files ).
|
|
get_interf( (:- [F1|Fs] ), F, M ) :-
|
|
!,
|
|
include_files( F, M, [F1|Fs] ).
|
|
% don't actually use this one.
|
|
get_interf( (:- system_module( _NM, _Publics, _Hiddens) ), _F, _M ) :-
|
|
!.
|
|
get_interf( (:- style_checker( _ ) ), _F, _M ) :-
|
|
!.
|
|
get_interf( (:- dynamic T), F, M ) :-
|
|
!,
|
|
declare_functors( T, F, M ).
|
|
get_interf( (:- multifile T), F, M ) :- % public?
|
|
!,
|
|
declare_functors( T, F, M ).
|
|
get_interf( (:- meta_predicate T), F, M ) :-!,
|
|
declare_terms( T, F, M ), % public?
|
|
!.
|
|
get_interf( (:- '$install_meta_predicate'( H, M) ), F, __M ) :-
|
|
!,
|
|
declare_functors( H, F, M ).
|
|
get_interf( (:- thread_local _Bs), _F, _M ) :-
|
|
!.
|
|
get_interf( (:- op( X, Y, Z) ), F, M ) :-
|
|
!,
|
|
always_strip_module(M:Z, M1, Z1),
|
|
handle_op( F, M1, op( X, Y, Z1) ).
|
|
get_interf( (:- _ ), _F, _M ) :- !.
|
|
get_interf( (?- _ ), _F, _M ) :- !.
|
|
get_interf( V , _F, _M ) :-
|
|
var( V ),
|
|
!,
|
|
error( instantiation_error ).
|
|
get_interf( G , F, M ) :-
|
|
functor( G, N, A),
|
|
handle_pred( M, N, A, F ),
|
|
!.
|
|
|
|
|
|
handle_pred( M, N, A, F ) :-
|
|
(
|
|
system_mod( _, _, M )
|
|
->
|
|
(
|
|
atom_concat('$',_,N)
|
|
->
|
|
private( F, M, N/A )
|
|
;
|
|
public( F, M, N/A )
|
|
)
|
|
;
|
|
( nb_getval( private, false )
|
|
->
|
|
public( F, M, N/A )
|
|
;
|
|
private( F, M, N/A )
|
|
)
|
|
).
|
|
|
|
handle_op( F, M, Op ) :-
|
|
( nb_getval( private, false )
|
|
->
|
|
public( F, M, Op )
|
|
;
|
|
private( F, M, Op )
|
|
),
|
|
Op = op(X, Y, Z ),
|
|
( ( M == user ; M == prolog )
|
|
->
|
|
op( X, Y, prolog:Z )
|
|
;
|
|
op( X, Y, M:Z )
|
|
).
|
|
|
|
exported( NF, F, NM, M, op(X,Y,Z)) :-
|
|
!,
|
|
public( NF , NM:op(X,Y,Z) ),
|
|
handle_op( F, M , op(X,Y,Z) ).
|
|
exported( NF, F, NM, M, N/A) :- !,
|
|
assert_new( exported( (F-M:N/A :- NF-NM:N/A )) ).
|
|
exported( NF, F, NM, M, N/A as NN) :- !,
|
|
assert_new( exported( ( F-M:NN/A :- NF-NM:N/A ) ) ).
|
|
exported( NF, F, NM, M, N//A) :- !,
|
|
A2 is A+2,
|
|
assert_new( exported( (F-M:N/A2 :- NF-NM:N/A2) ) ).
|
|
exported( NF, F, NM, M, N//A as NN) :- !,
|
|
A2 is A+2,
|
|
assert_new( exported( ( F-M:NN/A2 :- NF-NM:N/A2 )) ).
|
|
|
|
import_publics( F, ProducerMod, ConsumerMod ) :-
|
|
public(F, ProducerMod:op(X,Y,Z) ),
|
|
handle_op( F, ConsumerMod, op(X,Y,Z) ),
|
|
fail.
|
|
import_publics( _F, _ProducerMod, _ConsumerMod ).
|
|
|
|
all_imported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod ) :-
|
|
public(ProducerFile, ProducerMod:op(X,Y,Z) ),
|
|
handle_op( ConsumerFile, ConsumerMod, op(X,Y,Z) ),
|
|
fail.
|
|
all_imported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod ) :-
|
|
public(ProducerFile, ProducerMod:N/A ),
|
|
exported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod, N/A ),
|
|
fail.
|
|
all_imported( _ProducerFile, _ConsumerFile, _ProducerMod, _ConsumerMod ).
|
|
|
|
|
|
include_files( F, M, Files ) :-
|
|
maplist( include_files( F, M ), Files ),
|
|
!.
|
|
include_files( F, M, -Files ) :-
|
|
!,
|
|
include_files( F, M, Files).
|
|
include_files( F, M, Files ) :-
|
|
!,
|
|
always_strip_module(M:Files, M1, NFiles),
|
|
include_file( F, M1, NFiles ).
|
|
include_files( F, M, Loc ) :-
|
|
include_file( F, M, Loc ).
|
|
|
|
include_file( F, M, Loc ) :-
|
|
is_list( Loc ), !,
|
|
maplist( include_file( F, M ), Loc ).
|
|
include_file( F, M, Loc ) :-
|
|
nb_getval( private, Private ),
|
|
% find the file
|
|
search_file( Loc, F, NF ),
|
|
% depth visit
|
|
pl_interf(NF, M), % should verify Is in _Is
|
|
% link b
|
|
( module_on(NF, NM, Is)
|
|
->
|
|
maplist( exported( NF, F, NM, M) , Is )
|
|
;
|
|
all_imported( NF, F, NM, M)
|
|
),
|
|
nb_setval( private, Private ).
|
|
|
|
declare_functors( T, _F, _M1) :- var(T), !,
|
|
error( unbound_variable ).
|
|
declare_functors( M:T, F, _M1) :- !,
|
|
declare_functors( T, F, M).
|
|
declare_functors( (T1,T2), F, M1) :- !,
|
|
declare_functors( T1, F, M1),
|
|
declare_functors( T2, F, M1).
|
|
declare_functors( Ts, F, M1) :-
|
|
maplist( declare_functor( F, M1), Ts ), !.
|
|
declare_functors( T, F, M1) :-
|
|
declare_functor( F, M1, T).
|
|
|
|
declare_functor(File, M, N/A) :-
|
|
handle_pred( M, N, A, File ).
|
|
|
|
declare_terms( T, _F, _M1) :- var(T), !,
|
|
error( unbound_variable ).
|
|
declare_terms( M:T, F, _M1) :- !,
|
|
declare_functors( T, F, M).
|
|
declare_terms( (N1,N2), F, M) :-
|
|
number(N1),
|
|
number(N2),
|
|
!,
|
|
declare_term( F, M, (N1,N2)).
|
|
declare_terms( (T1,T2), F, M1) :- !,
|
|
declare_terms( T1, F, M1),
|
|
declare_terms( T2, F, M1).
|
|
declare_terms( Ts, F, M1) :-
|
|
maplist( declare_term( F, M1), Ts ), !.
|
|
declare_terms( T, F, M1) :-
|
|
declare_term( F, M1, T).
|
|
|
|
declare_term(F, M, S) :-
|
|
functor(S, N, A),
|
|
handle_pred( M, N, A, F ).
|
|
|
|
% clean operators
|
|
generate_interface( _F, _M ) :-
|
|
fail,
|
|
public( _, prolog:op(_X,Y,Z) ),
|
|
op(0,Y,Z),
|
|
fail.
|
|
generate_interface( _F, _M ) :-
|
|
fail,
|
|
private( _, prolog:op(_X,Y,Z) ),
|
|
op(0,Y,Z),
|
|
fail.
|
|
generate_interface( _F, Mod ) :-
|
|
nb_setval( current_module, Mod ).
|
|
|
|
|
|
|
|
pl_graphs(Dir - Mod) :-
|
|
format(' ************* GRAPH: ~a ***********************~n', [Dir]),
|
|
atom( Dir ),
|
|
atom_concat([Dir,'/*'], Pattern),
|
|
expand_file_name( Pattern, Files ),
|
|
member( File, Files ),
|
|
( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ) ->
|
|
pl_graph( File , Mod )
|
|
;
|
|
exists_directory( File ),
|
|
\+ atom_concat(_, '/.', File),
|
|
\+ atom_concat(_, '/..', File),
|
|
\+ atom_concat(_, '/.git', File),
|
|
pl_graphs( File - Mod )
|
|
),
|
|
fail.
|
|
pl_graphs(_).
|
|
|
|
%%
|
|
% pl_graph( File, Mod)
|
|
% adds a node to the file graph and marks which files are modules
|
|
%
|
|
% main side-effect facts like edge( F0-Mod:File )
|
|
% exported( F-M , N/A ) ou exported(F- M. Op ),
|
|
% module_on ( M, File )
|
|
% pred ( M :N/A )
|
|
%
|
|
pl_graph(F, Mod) :-
|
|
consulted( F, Mod), !.
|
|
pl_graph(F, Mod) :-
|
|
% writeln(F),
|
|
assert( consulted( F, Mod )),
|
|
catch( open(F, read, S), _, fail ),
|
|
repeat,
|
|
nb_getval( current_module, MR ),
|
|
catch( read_term( S, T, [term_position(Pos),module(MR)] ), Throw, (writeln(Throw))),
|
|
(
|
|
T == end_of_file
|
|
->
|
|
!,
|
|
% also, clo ops defined in the module M, if M \= Mod
|
|
pl_graph( F, Mod ),
|
|
nb_setval( current_module, Mod ),
|
|
close(S)
|
|
;
|
|
nb_getval( current_module, MC0 ),
|
|
( Mod == prolog -> MC = prolog ; MC = MC0 ),
|
|
( system_mod(_,_,MC) -> nb_setval( private, true ) ; nb_setval( private, false ) ),
|
|
get_graph( T, F, Pos, MC ),
|
|
fail
|
|
).
|
|
|
|
|
|
get_graph( V , _F, _Pos, _M ) :-
|
|
var( V ),
|
|
!,
|
|
error( instantiation_error ).
|
|
get_graph( T, _F, _Pos, _M0 ) :-
|
|
var(T),
|
|
!.
|
|
get_graph( M:T, F, _Pos, _M0 ) :- !,
|
|
get_graph( T, F, _Pos, M ).
|
|
get_graph( ( M:H :- B), F, _Pos, M0 ) :-
|
|
!,
|
|
get_graph( (H :- M0:B), F, _Pos, M ).
|
|
get_graph( ( M:H --> B), F, _Pos, M0 ) :-
|
|
!,
|
|
get_graph( ( H --> M0:B), F, _Pos, M ).
|
|
get_graph( ( A, _ --> B), F, _Pos, M ) :-
|
|
get_graph( ( A --> B), F, _Pos, M ).
|
|
get_graph( (H --> B), F, _Pos, M ) :-
|
|
!,
|
|
functor( H, N, Ar),
|
|
Ar2 is Ar+2,
|
|
add_deps( B, M, M:N/Ar2, F, _Pos, 2 ).
|
|
get_graph( (H :- B), F, _Pos, M ) :-
|
|
!,
|
|
functor( H, N, Ar),
|
|
add_deps( B, M, M:N/Ar, F, _Pos, 0 ).
|
|
%% switches to new file n
|
|
get_graph( (:- module(M,_)), _F, _Pos, _M ) :-
|
|
!,
|
|
nb_setval( current_module, M ).
|
|
get_graph( (:- _ ), _F, _Pos, _M ) :-
|
|
!.
|
|
get_graph( (?- _ ), _F, _Pos, _M ) :- !.
|
|
|
|
|
|
add_deps(V, _M, _P, _F, _Pos, _) :-
|
|
var(V), !.
|
|
add_deps(M1:G, _M, _P, _F, _Pos,L) :-
|
|
!,
|
|
always_strip_module(M1:G, M2, G2),
|
|
add_deps(G2, M2, _P, _F, _Pos, L).
|
|
add_deps((A,B), M, P, F, _Pos, L) :-
|
|
!,
|
|
add_deps(A, M, P, F, _Pos, L),
|
|
add_deps(B, M, P, F, _Pos, L).
|
|
add_deps((A;B), M, P, F, _Pos, L) :- !,
|
|
add_deps(A, M, P, F, _Pos, L),
|
|
add_deps(B, M, P, F, _Pos, L).
|
|
add_deps((A|B), M, P, F, _Pos, L) :- !,
|
|
add_deps(A, M, P, F, _Pos, L),
|
|
add_deps(B, M, P, F, _Pos, L).
|
|
add_deps((A->B), M, P, F, _Pos, L) :- !,
|
|
add_deps(A, M, P, F, _Pos, L),
|
|
add_deps(B, M, P, F, _Pos, L).
|
|
add_deps((A*->B), M, P, F, _Pos, L) :- !,
|
|
add_deps(A, M, P, F, _Pos, L),
|
|
add_deps(B, M, P, F, _Pos, L).
|
|
add_deps(once(A), M, P, F, _Pos, L) :- !,
|
|
add_deps(A, M, P, F, _Pos, L).
|
|
add_deps({A}, M, P, F, _Pos, 2) :- !,
|
|
add_deps(A, M, P, F, _Pos, 0).
|
|
add_deps([_|_], M, P, F, Pos, 2) :-
|
|
!,
|
|
put_dep( (F-M:P :- prolog:'C'/3 ), Pos ).
|
|
add_deps(String, _M, _P, _F, _Pos, _) :- string(String), !.
|
|
add_deps([], _M, _P, _F, _Pos, 2) :- !.
|
|
add_deps(!, _M, _P, _F, _Pos, _) :- !.
|
|
add_deps(true, _M, _P, _F, _Pos, 0) :- !.
|
|
add_deps(false, _M, _P, _F, _Pos, 0) :- !.
|
|
add_deps(fail, _M, _P, _F, _Pos, 0) :- !.
|
|
add_deps(repeat, _M, _P, _F, _Pos, 0) :- !.
|
|
add_deps(A, M, P, F, Pos, L) :- !,
|
|
% we're home, M:N/Ar -> P=M1:N1/A1
|
|
functor(A, N, Ar0),
|
|
Ar is Ar0+L,
|
|
put_dep( ( F-M:P :- F-M:N/Ar ), Pos ).
|
|
|
|
put_dep( (Target :- F0-M:Goal ), _ ) :-
|
|
exported( ( F0-M:Goal :- F1-M1:N/Ar ) ), !,
|
|
%follow ancestor chain
|
|
ancestor( ( F1-M1:N/Ar :- F0-M0:N0/Ar ) ),
|
|
assert_new( edge( ( Target :- F0-M0:N0/Ar ) ) ).
|
|
% the base case, copying from the same module ( but maybe not same file 0.
|
|
put_dep( ( Target :- _F-M:N/Ar ) , _ ) :-
|
|
m_exists(M:N/Ar, F0),
|
|
!,
|
|
assert_new( edge( ( Target :- F0-M:N/Ar ) ) ).
|
|
% prolog is visi ( but maybe not same file 0.
|
|
put_dep( ( Target :- _F-_prolog:N/Ar ), _ ) :-
|
|
m_exists(prolog:N/Ar, F0),
|
|
!,
|
|
assert_new( edge( ( Target :- F0-prolog:N/Ar ) ) ).
|
|
put_dep( ( _ :- F-Mod:N/Ar ), Pos) :-
|
|
stream_position_data( line_count, Pos, Line ),
|
|
format( 'UNDEF in file ~w, line ~d :- ~w:~w~n',[ F, Line, Mod, N/Ar]) .
|
|
|
|
ancestor( ( Younger :- Older) ) :-
|
|
exported( ( Mid :- Older ) ), !,
|
|
ancestor( ( Younger :- Mid) ).
|
|
ancestor( (Older :- Older) ).
|
|
|
|
m_exists(P, F) :- private( F, P ), !.
|
|
m_exists(P, F) :- public( F, P ).
|
|
|
|
doubles :-
|
|
node(M, P, _F, _),
|
|
node(M1, P, _F1, _),
|
|
M @< M1,
|
|
is_public( P, M, _F),
|
|
is_public( P, M1, _F1),
|
|
format('~w vs ~w~n', [M:P,M1:P]),
|
|
fail.
|
|
doubles.
|
|
|
|
undefs :-
|
|
edge(_M:P,_,F),
|
|
\+ node(_, P, _, _),
|
|
format('UNDEFINED procedure call ~q at ~w~n',[P, F]),
|
|
fail.
|
|
undefs.
|
|
|
|
out_list([]) :-
|
|
format('[]', []).
|
|
out_list([El]) :-
|
|
format('[~q]', [El]).
|
|
out_list([E1,E2|Es]) :-
|
|
format('[~q', [E1]),
|
|
maplist(out_el, [E2|Es]),
|
|
format(']', []).
|
|
|
|
out_el( El ) :-
|
|
format(',~n ~q',[El]).
|
|
|
|
pub(M, P) :-
|
|
node(M, P, _, _),
|
|
P = N/_A,
|
|
\+ sub_atom(N,0,1,_,'$').
|
|
|
|
has_edge(M1, P1, M, F) :-
|
|
edge(M1:P1, _P, F:_),
|
|
node(M1, P1, _, _),
|
|
M1 \= prolog,
|
|
M1 \= M,
|
|
\+ is_public(P1, M1, _).
|
|
|
|
mod_priv(M, P) :-
|
|
node(M, P, _, _),
|
|
node(M, P, _, _),
|
|
\+ is_public(P, M, _),
|
|
edge(M1:P, _P0, _), M1 \= M.
|
|
|
|
priv(M, P) :-
|
|
node(M, P, F:_, _),
|
|
\+ is_public(P, M, _),
|
|
edge(_:P, _P1, F1:_), F1 \= F.
|
|
|
|
% utilities
|
|
|
|
split_string( S , Cs, N) :-
|
|
string_codes(S, S1),
|
|
string_codes(Cs, NCs),
|
|
split(S1, NCs, Ncs0),
|
|
maplist(remove_escapes, Ncs0, Ncs),
|
|
maplist(string_codes, N, Ncs).
|
|
|
|
remove_escapes([0'\\ ,A|Cs], [A|NCs]) :- !, %'
|
|
remove_escapes(Cs, NCs).
|
|
remove_escapes([A|Cs], [A|NCs]) :-
|
|
remove_escapes(Cs, NCs).
|
|
remove_escapes( [], [] ).
|
|
|
|
always_strip_module(V, M, V1) :- var(V), !,
|
|
V = M:call(V1).
|
|
always_strip_module(M0:A, M0, call(A)) :- var(A), !.
|
|
always_strip_module(_:M0:A, M1, B) :- !,
|
|
always_strip_module(M0:A, M1, B).
|
|
always_strip_module(M0:A, M0, call(A)) :- var(A),!.
|
|
always_strip_module(M0:A, M0, A).
|
|
|
|
c_location( matrix, 'library/matrix').
|
|
c_location( lammpi, 'library/lammpi').
|
|
c_location( matlab, 'library/matlab').
|
|
c_location( matlab, 'library/matlab').
|
|
c_location( matlab, 'library/random').
|
|
c_location( regex, 'library/regex').
|
|
c_location( rltree, 'library/rltree').
|
|
c_location( tries, 'library/tries').
|
|
c_location( operating_system_support, 'library/system').
|
|
|
|
c_links :-
|
|
node( M, P, _, c(F)),
|
|
format( ':- implements( ~q , ~q ).~n', [M:P, F] ),
|
|
fail.
|
|
c_links.
|
|
|
|
warn_singletons(_Vars, _Pos).
|
|
|
|
%%
|
|
% comment( +Comment )
|
|
%
|
|
% Handle documentation comments
|
|
%
|
|
comment( _Pos - Comment) :-
|
|
skip_blanks(1, Comment, N),
|
|
doc( Comment, N ), !,
|
|
format( "%s\n", [Comment] ).
|
|
comment( _Pos - _Comment).
|
|
|
|
skip_blanks(I, Comment, N) :-
|
|
get_string_code( I, Comment, Code ),
|
|
code_type( Code, space ),
|
|
I1 is I+1,
|
|
skip_blanks(I1, Comment, N).
|
|
skip_blanks(N, _Comment, N).
|
|
|
|
doc( Comment , N ) :-
|
|
N1 is N+1,
|
|
sub_string( Comment, N1, 3, _, Header ),
|
|
( Header == "/**" -> true ; Header == "/*!" ), !,
|
|
N4 is N+4,
|
|
get_string_code( N4, Comment, Code ),
|
|
code_type( Code, space ).
|
|
doc( Comment, N ) :-
|
|
N1 is N+1,
|
|
sub_string( Comment, N1, 2, _, Header ),
|
|
( Header == "%%" -> true ; Header == "%!" ),
|
|
N3 is N+3,
|
|
get_string_code( N3, Comment, Code ),
|
|
code_type( Code, space ).
|
|
|
|
|
|
%%
|
|
% search_file( +Target, +Location, -File )
|
|
%
|
|
%
|
|
% Directories into atoms
|
|
search_file( Loc , F, FN ) :-
|
|
search_file0( Loc , F, FN ),
|
|
!.
|
|
search_file( Loc , F, _FN ) :-
|
|
format('~n~n~n###############~n~n FAILED TO FIND ~w when at ~a~n~n###############~n~n~n', [Loc, F ]),
|
|
fail.
|
|
|
|
%
|
|
% handle some special cases.
|
|
%
|
|
search_file0( library(gecode), _, FN) :-
|
|
absolute_file_name( 'packages/gecode/gecode4_yap_hand_written.yap', FN ).
|
|
search_file0( 'clpbn/learning/em', _, FN) :-
|
|
absolute_file_name( 'packages/CLPBN/clpbn/learning/em.yap', FN ).
|
|
search_file0( 'cplint/slipcover', _, FN) :-
|
|
absolute_file_name( 'packages/cplint/slipcover/slipcover.pl', FN ).
|
|
search_file0( A/B, F, FN ) :- !,
|
|
term_to_atom(A/B, AB),
|
|
search_file0( AB, F, FN ).
|
|
% libraries can be anywhere in the source.
|
|
search_file0( LibLoc, F, FN ) :-
|
|
LibLoc =.. [Dir,File],
|
|
!,
|
|
( term_to_atom( Dir/File, Full ) ; Full = File ),
|
|
search_file0( Full, F, FN ).
|
|
%try to use your base
|
|
search_file0( Loc , F, FN ) :-
|
|
file_directory_name( F, FD),
|
|
check_suffix( Loc , LocS ),
|
|
atom_concat( [ FD, '/', LocS], NLoc),
|
|
absolute_file_name( NLoc, FN),
|
|
file_base_name( FN, LocNam),
|
|
file_directory_name( FN, D),
|
|
dir( D, LocNam).
|
|
search_file0( Loc , _F, FN ) :-
|
|
file_base_name( Loc, Loc0),
|
|
file_directory_name( Loc, LocD),
|
|
check_suffix( Loc0 , LocS ),
|
|
dir( D, LocS),
|
|
sub_dir( D, DD),
|
|
atom_concat( [ DD, '/', LocD], NLoc),
|
|
absolute_file_name( NLoc, D),
|
|
atom_concat( [D,'/', LocS], FN).
|
|
% you try using the parent
|
|
|
|
|
|
sub_dir( D, D ).
|
|
sub_dir( D, DD) :-
|
|
D \= '/',
|
|
atom_concat( D, '/..', DD0),
|
|
absolute_file_name( DD0, DDA),
|
|
sub_dir( DDA, DD).
|
|
|
|
% files must be called .yap or .pl
|
|
% if it is .yap...
|
|
check_suffix( Loc , Loc ) :-
|
|
atom_concat( _, '.yap', Loc ), !.
|
|
%, otherwise, .pl
|
|
check_suffix( Loc , Loc ) :-
|
|
atom_concat( _, '.pl', Loc ), !.
|
|
%, otherwise, .prolog
|
|
check_suffix( Loc , Loc ) :-
|
|
atom_concat( _, '.prolog', Loc ), !.
|
|
%, otherwise, .P
|
|
% try adding suffix
|
|
check_suffix( Loc0 , Loc ) :-
|
|
member( Suf , ['.yap', '.pl' , '.prolog']),
|
|
atom_concat( Loc0, Suf, Loc ).
|
|
|
|
|
|
|
|
match_file( LocD, Loc0, FN ) :-
|
|
var(LocD), !,
|
|
dir( LocD, Loc0 ),
|
|
atom_concat( [LocD, '/', Loc0], F ),
|
|
absolute_file_name( F, FN ),
|
|
exists( FN ).
|
|
match_file( SufLocD, Loc0, FN ) :-
|
|
dir( LocD, Loc0 ),
|
|
atom_concat(_, SufLocD, LocD ),
|
|
atom_concat( [LocD, '/', Loc0], FN ).
|
|
|
|
|
|
new_op( F, M, op(X,Y,Z) ) :-
|
|
nb_getval( private, true ),
|
|
!,
|
|
private( F, M, op(X,Y,Z) ),
|
|
op( X, Y, Z).
|
|
new_op( F, M, op( X, Y, Z) ) :-
|
|
public( F, M, op( X, Y, Z) ).
|
|
|
|
|
|
%%%%%%%
|
|
%% declare a concept exportable
|
|
public( F, M, op(X,Y,Z) ) :-
|
|
retract( private( F, M:op(X,Y,Z) ) ),
|
|
fail.
|
|
public( F, M, op(X,Y,Z) ) :- !,
|
|
assert( op_export(F, _M, op(X,Y,Z) ) ),
|
|
assert_new( public( F, M:op(X,Y,Z) ) ),
|
|
(
|
|
( M == user ; M == prolog )
|
|
->
|
|
op( X, Y, prolog:Z )
|
|
;
|
|
op( X, Y, M:Z )
|
|
).
|
|
public( F, M, M:N/Ar ) :-
|
|
retract( private( F, M:N/Ar ) ),
|
|
fail.
|
|
public( F, M, N/Ar ) :-
|
|
assert_new( public( F, M:N/Ar ) ).
|
|
public( F, M, M:N//Ar ) :-
|
|
Ar2 is Ar+2,
|
|
retract( private( F, M:N/Ar2 ) ),
|
|
fail.
|
|
public( F, M, N//Ar ) :-
|
|
Ar2 is Ar+2,
|
|
assert_new( public( F, M:N/Ar2 ) ).
|
|
|
|
private( F, M, op(X,Y,Z) ) :-
|
|
!,
|
|
assert_new( private( F, M:op(X,Y,Z) ) ),
|
|
(
|
|
( M == user ; M == prolog )
|
|
->
|
|
op( X, Y, prolog:Z )
|
|
;
|
|
op( X, Y, M:Z )
|
|
).
|
|
private( F, M, N/Ar ) :-
|
|
assert_new( private( F, M:N/Ar ) ).
|
|
|
|
is_public( F, M, OP ) :-
|
|
public( F, M:OP ).
|
|
|
|
is_private( F, M, OP ) :-
|
|
private( F, M :OP ).
|
|
|
|
assert_new( G ) :- G, !.
|
|
assert_new( G ) :- assert( G ).
|
|
|
|
error( Error ) :- throw(Error ).
|
|
|
|
ops_default :-
|
|
abolish( default_ops/1 ),
|
|
A = (_,_), functor(A,Comma,2),
|
|
findall(op(X,Y,prolog:Z), ( current_op(X,Y,prolog:Z), Z\= Comma ), L),
|
|
assert_static( default_ops(L) ).
|
|
|
|
:- initialization(ops_default, now).
|
|
|
|
ops_restore :-
|
|
A = (_,_), functor(A,Comma,2),
|
|
current_op(_X,Y,prolog:Z),
|
|
Z\= Comma,
|
|
op(0,Y,prolog:Z),
|
|
fail.
|
|
ops_restore :-
|
|
default_ops(L),
|
|
maplist( call, L ).
|
|
|