This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/misc/sysgraph

1508 lines
42 KiB
Plaintext
Raw Normal View History

2014-04-06 17:07:36 +01:00
:- style_check(all).
2014-09-08 23:16:49 +01:00
:- yap_flag( write_strings, on).
:- yap_flag( gc_trace, verbose ).
2014-04-06 17:07:36 +01:00
:- use_module(library(readutil)).
:- use_module(library(lineutils)).
:- use_module(library(lists)).
:- use_module(library(maplist)).
2014-08-04 15:46:21 +01:00
:- use_module(library(system)).
2014-04-06 17:07:36 +01:00
:- initialization(main).
2014-09-08 23:16:49 +01:00
:- style_check(all).
2014-04-06 17:07:36 +01:00
:- yap_flag( double_quotes, string ).
2014-08-05 03:30:41 +01:00
%:- yap_flag( dollar_as_lower_case, on ).
2014-04-06 17:07:36 +01:00
2014-08-04 15:46:21 +01:00
:- dynamic edge/1,
public/2,
private/2,
module_on/3,
exported/1,
2014-08-04 15:46:21 +01:00
dir/2,
consulted/2,
2014-08-08 02:36:55 +01:00
op_export/3,
library/1,
2014-08-21 16:32:23 +01:00
undef/2,
c_dep/2.
2014-04-06 17:07:36 +01:00
2014-04-09 12:39:52 +01:00
% @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
%
2014-04-06 17:07:36 +01:00
2014-08-04 15:46:21 +01:00
main :-
init,
fail.
2014-07-08 15:00:58 +01:00
main :-
unix(argv([D])),
working_directory(_, D),
fail.
2014-04-06 17:07:36 +01:00
main :-
% from libraries outside the current directories
assert( node( attributes, woken_att_do/4, 'library/atts.yap', prolog ) ),
fail.
main :-
2014-08-04 15:46:21 +01:00
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 ),
2014-08-06 16:25:30 +01:00
nb_setval( file_entry, user:user ),
2014-08-04 15:46:21 +01:00
init_loop( Dirs ),
maplist( pl_interfs, Dirs ),
2014-08-08 02:36:55 +01:00
%%% phase 2: find C-code predicates
maplist( c_preds, Dirs ),
2014-08-04 15:46:21 +01:00
%%% phase 4: construct graph
retractall( consulted(_,_) ),
2014-08-06 16:25:30 +01:00
% maplist( pl_graphs, Dirs ),
2014-09-08 23:16:49 +01:00
trace,
2014-08-04 15:46:21 +01:00
undefs,
doubles,
% pl_exported(pl).
2014-08-23 20:47:40 +01:00
c_links,
mkdocs.
2014-08-04 15:46:21 +01:00
dirs( Roots ) :-
member( Root-_, Roots ),
2014-08-23 20:47:40 +01:00
absolute_file_name( Root, FRoot ),
rdir( FRoot ),
2014-04-06 17:07:36 +01:00
fail.
2014-08-23 20:47:40 +01:00
dirs( _Roots ).
2014-08-04 15:46:21 +01:00
2014-08-23 20:47:40 +01:00
rdir( FRoot ) :-
directory_files( FRoot , Files),
2014-08-04 15:46:21 +01:00
member( File, Files ),
2014-08-23 20:47:40 +01:00
atom_concat( [FRoot,'/',File], New0 ),
absolute_file_name( New0, New ),
\+ doskip( New ),
2014-08-04 15:46:21 +01:00
(
2014-08-23 20:47:40 +01:00
file_property( New, type(directory) )
->
2014-08-04 15:46:21 +01:00
File \= '.',
File \= '..',
File \= '.git',
2014-08-23 20:47:40 +01:00
rdir( New )
2014-08-04 15:46:21 +01:00
;
2014-08-23 20:47:40 +01:00
assert_new( dir( FRoot, File ))
2014-08-04 15:46:21 +01:00
),
fail.
2014-08-23 20:47:40 +01:00
rdir(_).
2014-08-04 15:46:21 +01:00
init :-
retractall(dir(_)),
retractall(edge(_)),
retractall(private(_,_)),
retractall(public(_,_)),
2014-08-08 02:36:55 +01:00
retractall(undef(_,_)),
2014-08-04 15:46:21 +01:00
retractall(consulted(_,_)),
retractall(module_on(_,_,_)),
retractall(op_export(_,_,_)),
retractall(exported(_)).
2014-08-21 16:32:23 +01:00
init :-
user_c_dep(A,B),
do_user_c_dep(A,B),
fail.
2014-08-23 20:47:40 +01:00
init :-
user_skip(A),
do_user_skip(A),
fail.
init :-
user_expand(N,A),
do_user_expand(N,A),
fail.
2014-08-21 16:32:23 +01:00
init.
2014-08-04 15:46:21 +01:00
init_loop( _Dirs ).
c_preds(Dir - Mod) :-
2014-04-06 17:07:36 +01:00
atom( Dir ),
2014-08-04 15:46:21 +01:00
atom_concat([Dir,'/*'], Pattern),
2014-04-06 17:07:36 +01:00
expand_file_name( Pattern, Files ),
2014-08-23 20:47:40 +01:00
member( File0, Files ),
absolute_file_name( File0, File ),
( ( sub_atom(File,_,_,0,'.c')
2014-08-08 02:36:55 +01:00
;
sub_atom(File,_,_,0,'.i')
;
2014-08-21 16:32:23 +01:00
sub_atom(File,_,_,0,'.C')
;
2014-08-08 02:36:55 +01:00
sub_atom(File,_,_,0,'.cpp')
;
sub_atom(File,_,_,0,'.icc')
2014-08-21 16:32:23 +01:00
;
sub_atom(File,_,_,0,'.h')
2014-08-08 02:36:55 +01:00
) ->
2014-08-23 20:47:40 +01:00
\+ doskip( File ),
2014-08-04 15:46:21 +01:00
c_file( File , Mod )
;
exists_directory( File ),
2014-08-23 20:47:40 +01:00
\+ atom_concat(_, '/.', File),
2014-08-04 15:46:21 +01:00
\+ atom_concat(_, '/..', File),
2014-08-23 20:47:40 +01:00
\+ doskip( File ),
2014-08-04 15:46:21 +01:00
c_preds( File - Mod )
),
2014-04-06 17:07:36 +01:00
fail.
c_preds(_).
2014-08-04 15:46:21 +01:00
2014-08-21 16:32:23 +01:00
c_file(F, _Mod) :-
consulted( F, _ ),
2014-08-08 02:36:55 +01:00
!.
2014-04-06 17:07:36 +01:00
c_file(F, Mod) :-
2014-08-20 15:58:06 +01:00
% writeln(F),
assert( consulted( F, Mod ) ),
2014-04-06 17:07:36 +01:00
nb_setval( current_module, Mod ),
2014-08-04 15:46:21 +01:00
open(F, read, S, [alias(c_file)]),
2014-04-06 17:07:36 +01:00
repeat,
read_line_to_string( S, String ),
( String == end_of_file
->
!,
close(S)
;
2014-08-21 16:32:23 +01:00
sub_string(String, _, _, _, "PL_extension"),
%writeln(Fields),
c_ext(S, Mod, F),
fail
;
2014-04-06 17:07:36 +01:00
split_string(String, ",; ()\t\"\'", Fields),
%writeln(Fields),
line_count(S, Lines),
c_line(Fields , Mod, F:Lines),
fail
).
2014-08-21 16:32:23 +01:00
c_line(["}"], Mod, _) :- !,
2014-04-06 17:07:36 +01:00
nb_setval( current_module, Mod ).
c_line(Line, _Mod, _) :-
2014-04-06 17:07:36 +01:00
append( _, [ "CurrentModule", "=", M|_], Line),
2014-08-23 20:47:40 +01:00
system_mod(M, _Mod, Mod, _),
2014-04-06 17:07:36 +01:00
nb_setval( current_module, Mod ).
c_line(Line, Mod, F: LineP) :-
2014-08-04 15:46:21 +01:00
break_line( Line, N/A, Fu),
2014-08-21 16:32:23 +01:00
assert( node( Mod, N/A, F-LineP, Fu ) ),
handle_pred( Mod, N, A, F ).
c_ext( S, Mod, F ) :-
repeat,
read_line_to_string( S, String ),
(
sub_string( String, _, _, _, "NULL" ),
!
;
split_string(String, ",; (){}\t\"\'", ["FRG", NS,AS,FS|_]),
atom_string(N,NS),
atom_string(Fu,FS),
number_string(A, AS),
stream_property( S, position( Pos ) ),
stream_position_data( line_count, Pos, Line ),
assert( node( Mod , N/A, F-Line, Fu ) ),
handle_pred( Mod, N, A, F )
;
split_string(String, ",; (){}\t\"\'", [NS,AS,FS|_]),
atom_string(N,NS),
atom_string(Fu,FS),
number_string(A, AS),
stream_property( S, position( Pos ) ),
stream_position_data( line_count, Pos, Line ),
assert( node( Mod, N/A, F-Line, Fu ) ),
handle_pred( Mod, N, A, F )
).
2014-08-04 15:46:21 +01:00
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).
2014-08-04 15:46:21 +01:00
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), !.
2014-08-20 15:58:06 +01:00
take_line( Line, NS, AS, FS ) :-
append( _, [ "PL_register_foreign", NS, AS, FS|_], Line), !.
2014-08-04 15:46:21 +01:00
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), !.
2014-08-21 16:32:23 +01:00
% from odbc
take_line( Line, NS, AS, FS ) :-
append( _, [ "NDET", NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ "DET", NS, AS, FS|_], Line), !.
2014-08-04 15:46:21 +01:00
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), !.
2014-08-23 20:47:40 +01:00
system_mod("ATTRIBUTES_MODULE", _, attributes, user ).
system_mod("HACKS_MODULE", _, '$hacks' , sys ).
system_mod("USER_MODULE", _, user, user ).
system_mod("DBLOAD_MODULE", _, '$db_load', sys ).
system_mod("GLOBALS_MODULE", _, globals, sys ).
system_mod("ARG_MODULE", _, arg, sys ).
system_mod("PROLOG_MODULE", _ , prolog, sys ).
system_mod("RANGE_MODULE", _, range, user ).
system_mod("SWI_MODULE", _, swi, sys ).
system_mod("OPERATING_SYSTEM_MODULE", _, operating_system_support , sys ).
system_mod("TERMS_MODULE", _, terms , sys).
system_mod("SYSTEM_MODULE", _, system, sys ).
system_mod("IDB_MODULE", _, idb, user ).
system_mod("CHARSIO_MODULE", _, charsio, sys ).
system_mod("cm", M, M, user ).
2014-08-04 15:46:21 +01:00
2014-08-08 02:36:55 +01:00
call_c_files( File, Mod, _Fun, [CFile] ) :-
search_file( CFile, File, c, F ),
c_file(F, Mod).
2014-08-20 15:58:06 +01:00
call_c_files( File, Mod, _Fun, CFile ) :-
CFile \= [_|_],
search_file( CFile, File, c, F ),
c_file(F, Mod).
2014-08-08 02:36:55 +01:00
2014-08-04 15:46:21 +01:00
pl_interfs(Dir - Mod) :-
2014-08-23 20:47:40 +01:00
\+ doskip( Dir ),
2014-08-21 16:32:23 +01:00
format('% ************* ~a\n', [Dir]),
2014-08-05 03:30:41 +01:00
nb_setval( current_module, Mod ),
2014-04-09 12:39:52 +01:00
atom( Dir ),
2014-08-04 15:46:21 +01:00
directory_files( Dir , Files),
2014-04-09 12:39:52 +01:00
member( File, Files ),
2014-08-04 15:46:21 +01:00
atom_concat([Dir,'/',File], Path),
2014-08-23 20:47:40 +01:00
( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ; sub_atom(File,_,_,0,'.ypp') ) ->
2014-08-04 15:46:21 +01:00
ops_restore,
2014-08-17 21:33:57 +01:00
absolute_file_name( Path, APath ),
pl_interf( APath , Mod )
2014-08-04 15:46:21 +01:00
;
2014-08-05 03:30:41 +01:00
exists_directory( Path ),
\+ atom_concat(_, '/.', Path),
\+ atom_concat(_, '/..', Path),
\+ atom_concat(_, '/.git', Path),
2014-08-05 15:07:05 +01:00
absolute_file_name( Path, APath ),
2014-08-23 20:47:40 +01:00
\+ doskip( APath ),
2014-08-05 15:07:05 +01:00
pl_interfs( APath - Mod )
2014-08-04 15:46:21 +01:00
),
2014-04-09 12:39:52 +01:00
fail.
2014-08-04 15:46:21 +01:00
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 )
2014-08-04 15:46:21 +01:00
%
pl_interf(F, _Mod) :-
2014-08-05 15:07:05 +01:00
module_on( F , _M, _Is),
!.
pl_interf(F, Mod) :-
consulted(F, Mod ),
2014-08-04 15:46:21 +01:00
!.
pl_interf(F, Mod) :-
% ( sub_atom(F,_,_,_,'matrix.yap') -> spy get_interf ; true ),
2014-08-23 20:47:40 +01:00
 ( sub_atom( F, _, _, 0, 'gecode.yap' ) -> spy user_deps; true ),
writeln( +F:Mod ),
assert_new(consulted(F, Mod ) ),
2014-08-04 15:46:21 +01:00
nb_getval( private, Default ),
nb_setval( private, false ),
2014-08-06 16:25:30 +01:00
nb_getval( file_entry, OF:OMod ),
nb_setval( file_entry, F:Mod ),
2014-08-23 20:47:40 +01:00
preprocess_file( F, PF ),
catch( open(PF, read, S, [scripting(true)]) , _, fail ),
2014-08-04 15:46:21 +01:00
repeat,
nb_getval( current_module, MR ),
%( sub_atom(F,_,_,_,'e.yap') -> spy get_interf ; nospyall ),
2014-08-23 20:47:40 +01:00
catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (ypp(F,Throw), fail)),
(
2014-08-04 15:46:21 +01:00
T == end_of_file
->
!,
2014-08-06 16:25:30 +01:00
close(S),
2014-08-23 20:47:40 +01:00
(
c_dep( F, Fc),
c_file( Fc, MR ),
fail
;
build_graph( F, MR ),
fail
% cleanup
;
module_on( F , _M, _Is)
->
% also, close ops defined in the module M, if M \= Mod
nb_setval( current_module, Mod ),
nb_setval( private, Default ),
nb_setval( file_entry, OF:OMod )
;
true
)
2014-08-04 15:46:21 +01:00
;
nb_getval( current_module, MC0 ),
2014-08-20 15:58:06 +01:00
stream_position_data( line_count, Pos, Line ),
nb_setval( line, Line ),
2014-08-04 15:46:21 +01:00
( Mod == prolog -> MC = prolog ; MC = MC0 ),
get_interf( T, F, MC ),
fail
2014-08-23 20:47:40 +01:00
).
2014-08-04 15:46:21 +01:00
get_interf( T, _F, _M0 ) :-
var(T),
!.
2014-08-04 15:46:21 +01:00
get_interf( T, _F, _M0 ) :-
% ( T = (:- op(_,_,_)) -> trace ; true ),
var(T),
!.
2014-08-04 15:46:21 +01:00
get_interf( M:T, F, _M0 ) :- !,
get_interf( T, F, M ).
get_interf( goal_expansion(G, M, _) , F, _M0 ) :-
2014-08-23 20:47:40 +01:00
nonvar( G ),
2014-08-20 15:58:06 +01:00
!,
( var( M ) -> M1 = prolog ; M = M1 ),
functor( G, N, A ),
handle_pred( M1, N, A, F ).
get_interf( goal_expansion(G, _) , F, _M0 ) :-
2014-08-23 20:47:40 +01:00
nonvar( G ),
2014-08-20 15:58:06 +01:00
!,
functor( G, N, A ),
handle_pred( prolog, N, A, F ).
get_interf( ( M:H :- _B), F, _M ) :-
2014-08-04 15:46:21 +01:00
!,
get_interf( H, F, M ).
get_interf( ( goal_expansion(G, M, _) :- _) , F, _M0 ) :-
2014-08-23 20:47:40 +01:00
nonvar( G ),
2014-08-20 15:58:06 +01:00
!,
( var( M ) -> M1 = prolog ; M = M1 ),
functor( G, N, A ),
handle_pred( M1, N, A, F ).
get_interf( ( goal_expansion(G, _) :- _) , F, _M0 ) :-
2014-08-23 20:47:40 +01:00
nonvar( G ),
2014-08-20 15:58:06 +01:00
!,
functor( G, N, A ),
handle_pred( prolog, N, A, F ).
get_interf( ( M:H --> _B), F, _ ) :-
2014-08-04 15:46:21 +01:00
!,
get_interf( ( H --> _B), F, M ).
get_interf( ( A, _ --> _B), F, M ) :-
2014-08-04 15:46:21 +01:00
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 ) :-
2014-08-04 15:46:21 +01:00
!,
% find the file
2014-08-08 02:36:55 +01:00
search_file( Loc, F, pl, NF ),
2014-08-06 16:25:30 +01:00
include_files( F, M, Is, NF ),
% extend the interface.rg
retract( module_on( F , M, Is0) ),
append( Is0, Is, NIs ),
assert( module_on( F , M, NIs) ),
maplist( public(F, M), NIs ).
2014-08-04 15:46:21 +01:00
get_interf( (:- use_module( Loc, Is ) ), F, M ) :- !,
!,
2014-08-06 16:25:30 +01:00
include_files( F, M, Is, Loc ).
2014-08-04 15:46:21 +01:00
get_interf( (:- use_module( Loc ) ), F, M ) :- !,
!,
2014-08-06 16:25:30 +01:00
include_files( F, M, Loc ).
2014-08-05 03:30:41 +01:00
% nb_getval(current_module,MM), writeln(NM:MM:M).
2014-08-04 15:46:21 +01:00
get_interf( (:- use_module( Loc, Is, _ ) ), F, M ) :- !,
!,
2014-08-06 16:25:30 +01:00
include_files( F, M, Is, Loc ).
get_interf( (:- consult( Files ) ), F, M ) :-
2014-08-04 15:46:21 +01:00
!,
include_files( F, M, Files ).
get_interf( (:- reconsult( Files ) ), F, M ) :-
2014-08-04 15:46:21 +01:00
!,
include_files( F, M, Files ).
get_interf( (:- ensure_loaded( Files ) ), F, M ) :-
2014-08-04 15:46:21 +01:00
!,
include_files( F, M, Files ).
get_interf( (:- include( Files ) ), F, M ) :-
2014-08-04 15:46:21 +01:00
!,
2014-08-23 20:47:40 +01:00
source_files( F, M, Files ).
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
2014-08-04 15:46:21 +01:00
!,
include_files( F, M, Files ).
get_interf( ( :- ( G -> _ ; _ ) ) , F, M) :-
2014-08-20 15:58:06 +01:00
!,
get_interf( (:- G ) , F, M).
get_interf( (:- catch( G , _, _ ) ) , F, M) :-
2014-08-20 15:58:06 +01:00
!,
get_interf( (:- G ) , F, M).
get_interf( (:- initialization( G , now ) ) , F, M) :-
2014-08-20 15:58:06 +01:00
!,
get_interf( (:- G ) , F, M).
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
2014-08-20 15:58:06 +01:00
!,
include_files( F, M, Files ).
get_interf( (:- [F1|Fs] ), F, M ) :-
2014-08-04 15:46:21 +01:00
!,
include_files( F, M, [F1|Fs] ).
% don't actually use this one.
get_interf( (:- load_foreign_files(Fs, _, Fun) ), F, M ) :-
2014-08-08 02:36:55 +01:00
!,
call_c_files( F, M, Fun, Fs ).
get_interf( (:- load_foreign_library(F) ), F0, M ) :-
2014-08-08 02:36:55 +01:00
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, '', F1 ).
get_interf( (:- load_foreign_library(F,Fun) ), F0, M ) :-
2014-08-08 02:36:55 +01:00
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, Fun, F1 ).
get_interf( (:- use_foreign_library(F) ), F0, M ) :-
2014-08-20 15:58:06 +01:00
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, '', F1 ).
get_interf( (:- system_module( _NM, _Publics, _Hiddens) ), _F, _M ) :-
!.
get_interf( (:- style_checker( _ ) ), _F, _M ) :-
2014-08-04 15:46:21 +01:00
!.
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 ).
2014-08-20 15:58:06 +01:00
get_interf( (:- thread_local T), F, M ) :-
!,
declare_functors( T, F, M ).
get_interf( (:- op( X, Y, Z) ), F, M ) :-
2014-08-04 15:46:21 +01:00
!,
always_strip_module(M:Z, M1, Z1),
handle_op( F, M1, op( X, Y, Z1) ).
get_interf( (:- record( Records ) ), F, M ) :-
2014-08-21 16:32:23 +01:00
!,
handle_record( Records, F, M).
get_interf( (:- set_prolog_flag(dollar_as_lower_case,On) ), _F, _M ) :-
2014-08-23 20:47:40 +01:00
!,
set_prolog_flag(dollar_as_lower_case,On).
2014-08-04 15:46:21 +01:00
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 ),
!.
2014-08-21 16:32:23 +01:00
% support SWI package record
handle_record( (Records1, Records2), F, M ) :-
!,
handle_record( Records1, F, M ),
handle_record( Records2, F, M ).
handle_record( Record, F, M ) :-
Record =.. [Constructor|Fields],
atom_concat(Constructor, '_data', Data),
handle_pred( M, Data, 3, F),
atom_concat(default_, Constructor, New),
handle_pred( M, New, 1, F),
atom_concat(is_, Constructor, Is),
handle_pred( M, Is, 1, F),
atom_concat(make_, Constructor, Make),
handle_pred( M, Make, 2, F),
handle_pred( M, Make, 3, F),
atom_concat([set_, Constructor,'_fields'], Sets),
handle_pred( M, Sets, 3, F),
handle_pred( M, Sets, 4, F),
atom_concat([set_, Constructor,'_field'], Set),
handle_pred( M, Set, 3, F),
maplist( handle_record_field( Constructor, F, M) , Fields ).
handle_record_field( Constructor, F, M, Name:_=_ ) :-
!,
handle_record_field_name( Constructor, F, M, Name).
handle_record_field( Constructor, F, M, Name:_ ) :-
!,
handle_record_field_name( Constructor, F, M, Name).
handle_record_field( Constructor, F, M, Name=_ ) :-
!,
handle_record_field_name( Constructor, F, M, Name).
handle_record_field( Constructor, F, M, Name ) :-
handle_record_field_name( Constructor, F, M, Name).
handle_record_field_name( Constructor, F, M, Name) :-
atom_concat([ Constructor,'_', Name], Val),
handle_pred( M, Val, 2, F),
atom_concat([ set_, Name, '_of_', Constructor ], Set),
handle_pred( M, Set, 3, F),
handle_pred( M, Set, 2, F),
atom_concat([ nb_set_, Name, '_of_', Constructor ], Set),
handle_pred( M, Set, 3, F),
handle_pred( M, Set, 2, F).
2014-08-04 15:46:21 +01:00
handle_pred( M, N, A, F ) :-
(
2014-08-23 20:47:40 +01:00
system_mod( _, _, M, sys )
2014-08-04 15:46:21 +01:00
->
(
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)) :-
2014-08-04 15:46:21 +01:00
!,
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) ),
2014-04-09 12:39:52 +01:00
fail.
2014-08-04 15:46:21 +01:00
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 ) :-
2014-08-06 16:25:30 +01:00
include_files( F, M, _Is, Files ).
include_files( F, M, Is, Files ) :-
maplist( include_files( F, M, Is ), Files ),
2014-08-04 15:46:21 +01:00
!.
2014-08-06 16:25:30 +01:00
include_files( F, M, Is, -Files ) :-
2014-08-04 15:46:21 +01:00
!,
2014-08-06 16:25:30 +01:00
include_files( F, M, Is, Files).
include_files( F, M, Is, Files ) :-
2014-08-04 15:46:21 +01:00
!,
always_strip_module(M:Files, M1, NFiles),
2014-08-06 16:25:30 +01:00
include_file( F, M1, Is, NFiles ).
include_files( F, M, Is, Loc ) :-
2014-08-06 16:25:30 +01:00
include_file( F, M, Is, Loc ).
2014-08-04 15:46:21 +01:00
2014-08-06 16:25:30 +01:00
include_file( F, M, Is, Loc ) :-
2014-08-04 15:46:21 +01:00
is_list( Loc ), !,
2014-08-06 16:25:30 +01:00
maplist( include_file( F, M, Is), Loc ).
include_file( F, M, Is0, Loc ) :-
2014-08-04 15:46:21 +01:00
nb_getval( private, Private ),
% find the file
2014-08-08 02:36:55 +01:00
once( search_file( Loc, F, pl, NF ) ),
2014-08-04 15:46:21 +01:00
% depth visit
pl_interf(NF, M), % should verify Is in _Is
% link b
( module_on(NF, NM, Is)
->
2014-08-06 16:25:30 +01:00
( var(Is0) -> Is = Is0 ; true ),
2014-08-20 15:58:06 +01:00
maplist( exported( NF, F, NM, M) , Is0 )
2014-08-04 15:46:21 +01:00
;
all_imported( NF, F, NM, M)
),
nb_setval( private, Private ).
2014-08-23 20:47:40 +01:00
source_files( F, M, Files ) :-
maplist( source_files( F, M ), Files ),
!.
source_files( F, M, Loc ) :-
2014-08-23 20:47:40 +01:00
source_file( F, M, Loc ).
source_file( F, M, Loc ) :-
once( search_file( Loc, F, pl, NF ) ),
% depth visit
pl_source(NF, F, M). % should verify Is in _Is
pl_source(F, F0, Mod) :-
% writeln( -F ),
preprocess_file( F, PF ),
catch( open(PF, read, S, []) , _, fail ),
repeat,
nb_getval( current_module, MR ),
%( sub_atom(F,_,_,_,'examples/matrix.yap') -> spy get_interf ; nospyall ),
2014-08-23 20:47:40 +01:00
catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (writeln(F:MR:Throw), break, fail)),
(
2014-08-23 20:47:40 +01:00
T == end_of_file
->
!,
close(S)
;
nb_getval( current_module, MC0 ),
stream_position_data( line_count, Pos, Line ),
nb_setval( line, Line ),
( Mod == prolog -> MC = prolog ; MC = MC0 ),
get_interf( T, F0, MC ),
fail
).
2014-08-04 15:46:21 +01:00
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) :-
2014-08-04 15:46:21 +01:00
maplist( declare_functor( F, M1), Ts ), !.
declare_functors( T, F, M1) :-
2014-08-04 15:46:21 +01:00
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) :-
2014-08-04 15:46:21 +01:00
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) :-
2014-08-04 15:46:21 +01:00
maplist( declare_term( F, M1), Ts ), !.
declare_terms( T, F, M1) :-
2014-08-04 15:46:21 +01:00
declare_term( F, M1, T).
declare_term(F, M, S) :-
functor(S, N, A),
handle_pred( M, N, A, F ).
pl_graphs(Dir - Mod) :-
format(' ************* GRAPH: ~a ***********************~n', [Dir]),
2014-04-06 17:07:36 +01:00
atom( Dir ),
2014-08-04 15:46:21 +01:00
atom_concat([Dir,'/*'], Pattern),
2014-04-06 17:07:36 +01:00
expand_file_name( Pattern, Files ),
member( File, Files ),
2014-08-04 15:46:21 +01:00
( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ) ->
2014-08-23 20:47:40 +01:00
build_graph( File , Mod )
2014-08-04 15:46:21 +01:00
;
exists_directory( File ),
\+ atom_concat(_, '/.', File),
\+ atom_concat(_, '/..', File),
2014-08-05 03:30:41 +01:00
\+ atom_concat(_, '/.git', File),
2014-08-04 15:46:21 +01:00
pl_graphs( File - Mod )
),
2014-04-06 17:07:36 +01:00
fail.
2014-08-04 15:46:21 +01:00
pl_graphs(_).
2014-04-06 17:07:36 +01:00
2014-08-04 15:46:21 +01:00
%%
% 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 )
2014-08-04 15:46:21 +01:00
%
2014-08-06 16:25:30 +01:00
build_graph(F, Mod) :-
2014-04-06 17:07:36 +01:00
% writeln(F),
2014-08-23 20:47:40 +01:00
preprocess_file( F, PF ),
catch( open(PF, read, S, [scripting(true)]), _, fail ),
2014-04-06 17:07:36 +01:00
repeat,
2014-08-05 03:30:41 +01:00
nb_getval( current_module, MR ),
2014-08-23 20:47:40 +01:00
catch(read_term( S, T, [term_position(Pos),module(MR),comments(Cs)] ), Throw, (writeln(Throw))),
(
2014-08-04 15:46:21 +01:00
T == end_of_file
->
!,
% also, clo ops defined in the module M, if M \= Mod
% ( sub_atom(F,_,_,_,'/matrix.yap') -> start_low_level_trace ; nospyall ),
2014-08-04 15:46:21 +01:00
close(S)
;
2014-08-20 15:58:06 +01:00
stream_position_data( line_count, Pos, Line ),
maplist( comment, Cs ),
nb_setval( line, Line ),
2014-08-04 15:46:21 +01:00
nb_getval( current_module, MC0 ),
( Mod == prolog -> MC = prolog ; MC = MC0 ),
get_graph( T, F, Pos, MC ),
fail
2014-04-06 17:07:36 +01:00
).
2014-04-09 12:39:52 +01:00
2014-08-04 15:46:21 +01:00
get_graph( V , _F, _Pos, _M ) :-
var( V ),
!,
error( instantiation_error ).
get_graph( T, _F, _Pos, _M0 ) :-
var(T),
!.
2014-08-04 15:46:21 +01:00
get_graph( M:T, F, _Pos, _M0 ) :- !,
get_graph( T, F, _Pos, M ).
get_graph( ( M:H :- B), F, _Pos, M0 ) :-
2014-08-04 15:46:21 +01:00
!,
get_graph( (H :- M0:B), F, _Pos, M ).
get_graph( ( M:H --> B), F, _Pos, M0 ) :-
2014-08-04 15:46:21 +01:00
!,
get_graph( ( H --> M0:B), F, _Pos, M ).
get_graph( ( A, _ --> B), F, _Pos, M ) :-
2014-08-04 15:46:21 +01:00
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
2014-08-23 20:47:40 +01:00
get_graph( (:-include( Fs ) ), F, _Pos, M ) :-
!,
source_graphs( M, F, Fs ).
2014-08-04 15:46:21 +01:00
get_graph( (?- _ ), _F, _Pos, _M ) :- !.
2014-08-23 20:47:40 +01:00
get_graph( (:- _ ), _F, _Pos, _M ) :- !.
source_graphs( M, F, Fs ) :-
maplist( source_graph( M, F ), Fs ), !.
source_graphs( M, F, Fs ) :-
search_file( Fs, F, pl, NF ),
build_graph( NF , M ), !.
2014-04-09 12:39:52 +01:00
add_deps(V, _M, _P, _F, _Pos, _) :-
2014-08-04 15:46:21 +01:00
var(V), !.
add_deps(M1:G, _M, _P, _F, _Pos,L) :-
2014-08-04 15:46:21 +01:00
!,
always_strip_module(M1:G, M2, G2),
add_deps(G2, M2, _P, _F, _Pos, L).
add_deps((A,B), M, P, F, _Pos, L) :-
2014-08-04 15:46:21 +01:00
!,
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) :-
2014-08-04 15:46:21 +01:00
!,
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) :- !.
2014-08-06 16:25:30 +01:00
add_deps(A, M, P, F, Pos, L) :-
2014-08-04 15:46:21 +01:00
% 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 ), Pos ) :-
2014-08-04 15:46:21 +01:00
exported( ( F0-M:Goal :- F1-M1:N/Ar ) ), !,
%follow ancestor chain
2014-08-07 02:03:13 +01:00
ancestor( ( F1-M1:N/Ar :- FA-MA:NA/Ar ) ),
2014-08-08 02:36:55 +01:00
put_dep( ( Target :- FA-MA:NA/Ar ), Pos ).
2014-08-04 15:46:21 +01:00
% the base case, copying from the same module ( but maybe not same file 0.
put_dep( ( Target :- _F-M:N/Ar ) , _ ) :-
2014-08-04 15:46:21 +01:00
m_exists(M:N/Ar, F0),
!,
assert_new( edge( ( Target :- F0-M:N/Ar ) ) ).
2014-08-20 15:58:06 +01:00
% prolog is visible ( but maybe not same file ).
put_dep( ( Target :- _F-_prolog:N/Ar ), _ ) :-
2014-08-04 15:46:21 +01:00
m_exists(prolog:N/Ar, F0),
!,
assert_new( edge( ( Target :- F0-prolog:N/Ar ) ) ).
2014-08-08 02:36:55 +01:00
put_dep( ( _Target :- _F-Mod:_N/_Ar ), _Pos) :-
var( Mod ), !.
2014-08-07 02:03:13 +01:00
put_dep( ( Target :- F-Mod:N/Ar ), Pos) :-
2014-08-08 02:36:55 +01:00
atom( Mod ),
2014-08-04 15:46:21 +01:00
stream_position_data( line_count, Pos, Line ),
2014-08-08 02:36:55 +01:00
assert_new( undef( (Target :- F-Mod:N/Ar ), Line) ).
2014-04-09 12:39:52 +01:00
ancestor( ( Younger :- Older) ) :-
2014-08-04 15:46:21 +01:00
exported( ( Mid :- Older ) ), !,
ancestor( ( Younger :- Mid) ).
ancestor( (Older :- Older) ).
2014-04-06 17:07:36 +01:00
2014-08-04 15:46:21 +01:00
m_exists(P, F) :- private( F, P ), !.
m_exists(P, F) :- public( F, P ).
2014-04-06 17:07:36 +01:00
doubles :-
2014-08-20 15:58:06 +01:00
node(M, P, F-_, _),
node(M1, P, F1-_, _),
2014-04-06 17:07:36 +01:00
M @< M1,
2014-08-20 15:58:06 +01:00
is_public( P, M, F),
is_public( P, M1, F1),
2014-04-06 17:07:36 +01:00
format('~w vs ~w~n', [M:P,M1:P]),
fail.
doubles.
undefs :-
2014-08-08 02:36:55 +01:00
format('UNDEFINED procedure calls:~n',[]),
setof(M, Target^F^Line^NA^undef( ( Target :- F-M:NA ), Line ), Ms ),
member( Mod, Ms ),
format(' module ~a:~n',[Mod]),
setof(NA, Target^F^Line^undef( ( Target :- F-Mod:NA ), Line ), Ns ),
member( NA, Ns ),
2014-08-21 16:32:23 +01:00
\+ node( Mod , NA , _File1, _ ),
\+ node( prolog , NA , _File2, _ ),
2014-08-08 02:36:55 +01:00
format(' predicate ~w:~n',[NA]),
(
2014-08-21 16:32:23 +01:00
setof(F-Line, Target^undef( ( Target :- F-Mod:NA ), Line ), FLs ),
member(F-L, FLs ),
format(' line ~w, file ~a~n',[L,F]),
fail
;
setof(F-M,Type^node( M, NA, F, Type ) , FMs ),
format(' same name at:~n',[]),
member((F-L)-M, FMs ),
format(' module ~a, file ~a, line ~d~n',[M,F,L]),
fail
).
2014-04-06 17:07:36 +01:00
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 ) :-
2014-04-06 17:07:36 +01:00
format(',~n ~q',[El]).
pub(M, P) :-
node(M, P, _, _),
P = N/_A,
\+ sub_atom(N,0,1,_,'$').
2014-04-09 12:39:52 +01:00
has_edge(M1, P1, M, F) :-
2014-08-04 15:46:21 +01:00
edge(M1:P1, _P, F:_),
2014-04-09 12:39:52 +01:00
node(M1, P1, _, _),
M1 \= prolog,
M1 \= M,
2014-08-04 15:46:21 +01:00
\+ is_public(P1, M1, _).
2014-04-09 12:39:52 +01:00
mod_priv(M, P) :-
2014-04-06 17:07:36 +01:00
node(M, P, _, _),
2014-04-09 12:39:52 +01:00
node(M, P, _, _),
2014-08-04 15:46:21 +01:00
\+ is_public(P, M, _),
edge(M1:P, _P0, _), M1 \= M.
2014-04-06 17:07:36 +01:00
2014-04-09 12:39:52 +01:00
priv(M, P) :-
node(M, P, F:_, _),
2014-08-04 15:46:21 +01:00
\+ is_public(P, M, _),
edge(_:P, _P1, F1:_), F1 \= F.
2014-04-09 12:39:52 +01:00
2014-04-06 17:07:36 +01:00
% utilities
2014-04-06 17:07:36 +01:00
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).
2014-04-09 12:39:52 +01:00
remove_escapes([0'\\ ,A|Cs], [A|NCs]) :- !, %'
2014-04-06 17:07:36 +01:00
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).
2014-07-08 15:00:58 +01:00
c_links :-
2014-08-23 20:47:40 +01:00
open('foreigns.yap', write, S),
clinks(S).
2014-09-08 23:16:49 +01:00
2014-08-23 20:47:40 +01:00
clinks(S) :-
2014-07-08 15:00:58 +01:00
node( M, P, _, c(F)),
2014-08-23 20:47:40 +01:00
format( S, ':- foreign_predicate( ~q , ~q ).~n', [M:P, F] ),
2014-07-08 15:00:58 +01:00
fail.
2014-09-08 23:16:49 +01:00
clinks(S) :-
2014-08-23 20:47:40 +01:00
close(S).
2014-08-04 15:46:21 +01:00
warn_singletons(_Vars, _Pos).
%%
% comment( +Comment )
%
% Handle documentation comments
%
comment( _Pos - Comment) :-
2014-08-04 15:46:21 +01:00
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 ).
%%
2014-08-08 02:36:55 +01:00
% search_file( +Target, +Location, +FileType, -File )
2014-08-04 15:46:21 +01:00
%
%
% Directories into atoms
2014-08-08 02:36:55 +01:00
search_file( Loc , F, Type, FN ) :-
search_file0( Loc , F, Type, FN ),
2014-08-05 03:30:41 +01:00
!.
2014-08-04 15:46:21 +01:00
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.
2014-08-05 03:30:41 +01:00
%
% handle some special cases.
%
2014-08-23 20:47:40 +01:00
search_file0( F, _, _Type, FN ) :-
doexpand(F, FN), !.
2014-08-08 02:36:55 +01:00
search_file0( A/B, F, Type, FN ) :- !,
2014-08-04 15:46:21 +01:00
term_to_atom(A/B, AB),
2014-08-08 02:36:55 +01:00
search_file0( AB, F, Type, FN ).
2014-08-04 15:46:21 +01:00
% libraries can be anywhere in the source.
2014-08-08 02:36:55 +01:00
search_file0( LibLoc, F, Type, FN ) :-
LibLoc =.. [Dir,File],
2014-08-05 03:30:41 +01:00
!,
( term_to_atom( Dir/File, Full ) ; Full = File ),
2014-08-08 02:36:55 +01:00
search_file0( Full, F, Type, FN ).
2014-08-04 15:46:21 +01:00
%try to use your base
2014-08-08 02:36:55 +01:00
search_file0( Loc , F, c, FN ) :-
atom_concat( D, '.yap', F),
atom_concat( [ D, '/', Loc], F1),
2014-08-08 02:36:55 +01:00
check_suffix( F1 , c, NLoc ),
absolute_file_name( NLoc, FN),
file_base_name( FN, LocNam),
file_directory_name( FN, D),
dir( D, LocNam ).
search_file0( Loc , F, Type, FN ) :-
2014-08-05 03:30:41 +01:00
file_directory_name( F, FD),
2014-08-08 02:36:55 +01:00
check_suffix( Loc , Type, LocS ),
2014-08-05 03:30:41 +01:00
atom_concat( [ FD, '/', LocS], NLoc),
absolute_file_name( NLoc, FN),
file_base_name( FN, LocNam),
file_directory_name( FN, D),
dir( D, LocNam).
2014-08-08 02:36:55 +01:00
search_file0( Loc , _F, Type, FN ) :-
2014-08-04 15:46:21 +01:00
file_base_name( Loc, Loc0),
file_directory_name( Loc, LocD),
2014-08-08 02:36:55 +01:00
check_suffix( Loc0 , Type, LocS ),
2014-08-05 03:30:41 +01:00
dir( D, LocS),
sub_dir( D, DD),
atom_concat( [ DD, '/', LocD], NLoc),
absolute_file_name( NLoc, D),
atom_concat( [D,'/', LocS], FN).
2014-08-08 02:36:55 +01:00
search_file0( Loc , _F, Type, FN ) :-
file_base_name( Loc, Loc0),
check_suffix( Loc0 , Type, LocS ),
dir( D, LocS),
atom_concat( [D,'/', LocS], FN).
2014-08-04 15:46:21 +01:00
% you try using the parent
2014-08-05 03:30:41 +01:00
sub_dir( D, D ).
sub_dir( D, DD) :-
D \= '/',
atom_concat( D, '/..', DD0),
absolute_file_name( DD0, DDA),
sub_dir( DDA, DD).
2014-08-04 15:46:21 +01:00
% files must be called .yap or .pl
% if it is .yap...
check_suffix( Loc , pl, Loc ) :-
2014-08-04 15:46:21 +01:00
atom_concat( _, '.yap', Loc ), !.
%, otherwise, .pl
check_suffix( Loc , pl, Loc ) :-
2014-08-04 15:46:21 +01:00
atom_concat( _, '.pl', Loc ), !.
%, otherwise, .prolog
check_suffix( Loc , pl, Loc ) :-
2014-08-04 15:46:21 +01:00
atom_concat( _, '.prolog', Loc ), !.
%, otherwise, .P
% try adding suffix
check_suffix( Loc0 , pl, Loc ) :-
member( Suf , ['.yap', '.ypp', '.pl' , '.prolog']),
2014-08-04 15:46:21 +01:00
atom_concat( Loc0, Suf, Loc ).
check_suffix( Loc , c, Loc ) :-
2014-08-08 02:36:55 +01:00
atom_concat( _, '.c', Loc ), !.
%, otherwise, .pl
check_suffix( Loc , c, Loc ) :-
2014-08-08 02:36:55 +01:00
atom_concat( _, '.icc', Loc ), !.
%, otherwise, .prolog
check_suffix( Loc , c, Loc ) :-
2014-08-08 02:36:55 +01:00
atom_concat( _, '.cpp', Loc ), !.
%, otherwise, .P
% try adding suffix
check_suffix( Loc0 , c, Loc ) :-
member( Suf , ['.c', '.icc' , '.cpp']),
2014-08-08 02:36:55 +01:00
atom_concat( Loc0, Suf, Loc ).
2014-08-04 15:46:21 +01:00
match_file( LocD, Loc0, Type, FN ) :-
2014-08-05 03:30:41 +01:00
var(LocD), !,
2014-08-04 15:46:21 +01:00
dir( LocD, Loc0 ),
2014-08-05 03:30:41 +01:00
atom_concat( [LocD, '/', Loc0], F ),
2014-08-08 02:36:55 +01:00
absolute_file_name( F, Type, FN ),
2014-08-05 03:30:41 +01:00
exists( FN ).
match_file( SufLocD, Loc0, Type, FN ) :-
2014-08-04 15:46:21 +01:00
dir( LocD, Loc0 ),
atom_concat(_, SufLocD, LocD ),
2014-08-08 02:36:55 +01:00
atom_concat( [LocD, '/', Loc0], Type, FN ).
2014-08-04 15:46:21 +01:00
2014-08-04 15:46:21 +01:00
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) ).
2014-08-23 20:47:40 +01:00
ypp(F, error(syntax_error(syntax_error),[syntax_error(read(_228515),between(K,L,M),_,_L,_)-_]) ) :-
format('SYNTAX ERROR at file ~a, line ~d (~d - ~d).~n', [F,L,K,M] ),
break.
preprocess_file(F,NF) :-
atom_concat(_, '.ypp', F ), !,
atom_concat( [ 'cpp -CC -w -DMYDDAS_MYSQL -DMYDDAS_ODBC -DMYDDAS_STATS -DMYDDAS_TOP_LEVEL -P ',F], OF ),
NF = pipe( OF ).
preprocess_file(F,F).
2014-08-23 20:47:40 +01:00
2014-08-04 15:46:21 +01:00
%%%%%%%
%% 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) ) ),
(
2014-08-04 15:46:21 +01:00
( 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.
2014-08-23 20:47:40 +01:00
public( F, M, N/Ar ) :-
2014-08-20 15:58:06 +01:00
assert_new( public( F, M:N/Ar ) ),
2014-08-21 16:32:23 +01:00
\+ node( M, N/Ar, F-_, _ ),
2014-08-20 15:58:06 +01:00
nb_getval( line, L ),
2014-08-23 20:47:40 +01:00
assert( node( M, N/Ar, F-L, prolog ) ), !.
public( _F, _M, _/_Ar ).
2014-08-05 03:30:41 +01:00
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,
2014-08-20 15:58:06 +01:00
assert_new( public( F, M:N/Ar2 ) ),
2014-08-21 16:32:23 +01:00
\+ node( M, N/Ar2, F-_, _ ),
2014-08-20 15:58:06 +01:00
nb_getval( line, L ),
2014-08-23 20:47:40 +01:00
assert( node( M, N/Ar2, F-L, prolog ) ), !.
public( _F, _M, _//_Ar ).
2014-08-04 15:46:21 +01:00
private( F, M, op(X,Y,Z) ) :-
2014-08-04 15:46:21 +01:00
assert_new( private( F, M:op(X,Y,Z) ) ),
(
2014-08-04 15:46:21 +01:00
( M == user ; M == prolog )
->
op( X, Y, prolog:Z )
;
op( X, Y, M:Z )
2014-08-23 20:47:40 +01:00
), !.
private( _F, _M, op(_X,_Y,_Z) ).
2014-08-04 15:46:21 +01:00
private( F, M, N/Ar ) :-
2014-08-20 15:58:06 +01:00
assert_new( private( F, M:N/Ar ) ),
\+ node( M, N/Ar, F-_, _ ),
2014-08-20 15:58:06 +01:00
nb_getval( line, L ),
2014-08-23 20:47:40 +01:00
assert( node( M, N/Ar, F-L, prolog ) ), !.
private( _F, _M, _N/_Ar ).
2014-08-20 15:58:06 +01:00
private( F, M, N//Ar ) :-
Ar2 is Ar+2,
assert_new( private( F, M:N/Ar2 ) ),
2014-08-21 16:32:23 +01:00
\+ node( M, N/Ar2, F-_, _ ),
2014-08-20 15:58:06 +01:00
nb_getval( line, L ),
2014-08-23 20:47:40 +01:00
assert_new( node( M, N/Ar2, F-L, prolog ) ), !.
private( _F, _M, _N//_Ar ).
2014-08-04 15:46:21 +01:00
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 ).
2014-08-23 20:47:40 +01:00
%% mkdocs inserts a file with a sequence of comments into a sequence of Prolog/C files.
%
%
mkdocs :-
open( 'docs/yapdocs.yap', read, S),
repeat,
(
2014-09-08 23:16:49 +01:00
blanks(S, Comment, Rest)
2014-08-23 20:47:40 +01:00
->
get_comment(S, Rest),
store_comment( Comment ),
2014-08-23 20:47:40 +01:00
fail
;
close(S),
2014-09-08 23:16:49 +01:00
!,
2014-08-23 20:47:40 +01:00
add_comments
).
2014-09-08 23:16:49 +01:00
blanks( S , T, TF) :-
read_line_to_codes(S, T1, T2),
( T1 == end_of_file -> fail;
T2 == [] -> fail;
T1 \== T2, foldl( check, [0'/,0'*,0'*],T1, _) -> TF = T2, T = T1 ;
blanks( S , T, TF) ).
get_comment( S , T) :-
read_line_to_codes(S, T, T0),
2014-09-08 23:16:49 +01:00
( T == end_of_file -> T = [];
T0 == [] -> T=[];
diff_end( [0'*,0'/,10],T, T0 ) -> true ;
get_comment( S , T0) ).
check(C, [C0|L], L) :-
C == C0.
2014-09-08 23:16:49 +01:00
diff_end( L, T, [] ) :-
append(_, L, T).
store_comment(Comment) :-
2014-09-08 23:16:49 +01:00
header( Pred, A, Comment, _ ),
atom_codes( P, Pred),
node( Mod, P/A, File-Line, Type),
\+ ( node( M1, P/A, _, _), M1 \= Mod ), !,
string_codes( C, Comment ),
assert( do_comment( File, Line, C, Type) ).
store_comment(Comment) :-
assert(open_comment(Comment)).
header(Pred, Arity) -->
"/**",
blank,
"@pred",
blank,
atom(Pred),
2014-09-08 23:16:49 +01:00
atom_pred(Arity).
atom_pred(Arity) -->
"/", !,
int( 0, Arity ).
atom_pred(0) -->
blank, !.
atom_pred(N) -->
"(",
!,
decl(0,N).
int(I0, I) -->
[A],
{ A >= "0", A =< "9" },
!,
{ I1 is I0*10+(A-"0") }.
int( I, I ) --> [].
decl(I0, I) -->
")", !,
{ I is I0+1 }.
decl(I0, I) -->
",", !,
{ I is I0+1 }.
decl(I0, I) -->
[_],
decl( I0, I).
blank --> " ", !, blank.
blank --> "\t", !, blank.
blank --> [].
atom([A|As]) -->
[A],
{ A >= "a", A =< "z" },
atom2( As ).
atom2([A|As]) -->
[A],
{ A >= "a", A =< "z" -> true ;
A >= "A", A =< "Z" -> true ;
A >= "0", A =< "9" -> true ;
A =:= "_"
},
2014-09-08 23:16:49 +01:00
!,
atom2( As ).
2014-09-08 23:16:49 +01:00
atom2([]) --> [].
add_comments :-
findall(File, do_comment( File, Line, C, Type), Fs ),
member( F, Fs ),
format('File ~a', [F]),
setof(Line-C-Type, do_comment( File, Line, C, Type) , Lines ),
member(Line-Comment-Type, Lines),
format('% line ~d ~w~n~s~n', [Line, Type, Comment]),
fail.
add_comments :-
listing( open_comment ).
%%%
% ops_default sets operators back to YAP default.
%
2014-08-04 15:46:21 +01:00
ops_default :-
2014-08-05 03:30:41 +01:00
abolish( default_ops/1 ),
2014-08-04 15:46:21 +01:00
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) ).
2014-08-05 03:30:41 +01:00
:- initialization(ops_default, now).
2014-08-04 15:46:21 +01:00
ops_restore :-
A = (_,_), functor(A,Comma,2),
current_op(_X,Y,prolog:Z),
2014-08-04 15:46:21 +01:00
Z\= Comma,
op(0,Y,prolog:Z),
fail.
ops_restore :-
default_ops(L),
maplist( call, L ).
2014-08-21 16:32:23 +01:00
do_user_c_dep(F1, F2) :-
absolute_file_name(F1, A1),
2014-08-21 16:32:23 +01:00
absolute_file_name(F2, A2),
assert(c_dep(A1, A2)).
2014-08-23 20:47:40 +01:00
do_user_skip(F1) :-
absolute_file_name(F1, A1),
2014-08-23 20:47:40 +01:00
assert(doskip(A1)).
do_user_expand(F, F1) :-
absolute_file_name(F1, A1),
2014-08-23 20:47:40 +01:00
assert(doexpand(F, A1)).
2014-08-21 16:32:23 +01:00
user_deps( F, M ) :-
c_dep(F, A2),
c_file(A2 , M),
fail.
user_deps( _F, _M ).
user_c_dep( 'packages/jpl/jpl.pl', 'packages/jpl/src/c/jpl.c' ).
user_c_dep( 'packages/real/real.pl', 'packages/real/real.c' ).
user_c_dep( 'packages/odbc/odbc.pl', 'packages/odbc/odbc.c' ).
2014-08-23 20:47:40 +01:00
user_c_dep( 'packages/clib/unix.pl', 'packages/clib/unix.c' ).
user_c_dep( 'packages/clib/cgi.pl', 'packages/clib/cgi.c' ).
user_c_dep( 'packages/clib/crypt.pl', 'packages/clib/crypt.c' ).
user_c_dep( 'packages/clib/filesex.pl', 'packages/clib/files.c' ).
user_c_dep( 'packages/clib/mime.pl', 'packages/clib/mime.c' ).
user_c_dep( 'packages/clib/socket.pl', 'packages/clib/socket.c' ).
user_c_dep( 'packages/clib/socket.pl', 'packages/clib/winpipe.c' ).
user_c_dep( 'packages/http/http_stream.pl', 'packages/http/cgi_stream.c' ).
user_c_dep( 'packages/http/http_stream.pl', 'packages/http/stream_range.c' ).
user_c_dep( 'packages/http/http_stream.pl', 'packages/http/http_chunked.c' ).
user_c_dep( 'packages/http/http_stream.pl', 'packages/http/http_error.c' ).
2014-08-21 16:32:23 +01:00
user_c_dep( 'packages/swi-minisat2/minisat.pl', 'packages/swi-minisat2/C/pl-minisat.C' ).
2014-08-23 20:47:40 +01:00
user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/gecode4_yap.cc' ).
user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/4.2.1/gecode_yap_cc_forward_auto_generated.icc' ).
user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/4.2.1/gecode_yap_cc_init_auto_generated.icc' ).
user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/4.2.1/gecode_yap_cc_impl_auto_generated.icc' ).
user_c_dep( 'packages/semweb/rdf_db.pl', 'packages/semweb/atom_map.c' ).
user_c_dep( 'packages/semweb/rdf_db.pl', 'packages/semweb/resource.c' ).
user_c_dep( 'packages/sgml/sgml.pl', 'packages/sgml/quote.c' ).
user_c_dep( 'swi/library/readutil.pl', 'packages/clib/readutil.c' ).
user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_shared.c' ).
user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_odbc.c' ).
user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_mysql.c' ).
user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_top_level.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/bpx.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/error.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/fputil.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/gamma.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/glue.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/idtable.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/idtable_preds.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/random.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/termpool.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/vector.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/xmalloc.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_aux.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_aux_ml.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_aux_vb.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_ml.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_preds.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/flags.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/graph.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/graph_aux.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/hindsight.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/util.c' ).
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/viterbi.c' ).
user_skip( 'packages/gecode/3.6.0').
user_skip( 'packages/gecode/3.7.0').
user_skip( 'packages/gecode/3.7.1').
user_skip( 'packages/gecode/3.7.2').
user_skip( 'packages/gecode/3.7.3').
user_skip( 'packages/gecode/4.0.0').
user_skip( 'packages/gecode/4.2.0').
user_skip( 'packages/gecode/4.2.1').
user_skip( 'packages/gecode/gecode3.yap' ).
user_skip( 'packages/gecode/gecode3_yap.cc' ).
user_skip( 'packages/gecode/gecode3_yap_hand_written.yap').
user_skip( 'packages/gecode/gecode3.yap-common.icc').
user_skip( 'packages/prism/src/prolog/core').
user_skip( 'packages/prism/src/prolog/up').
user_skip( 'packages/prism/src/prolog/mp').
user_skip( 'packages/prism/src/prolog/trans').
user_skip( 'packages/prism/src/prolog/bp').
user_skip( 'packages/prism/src/c').
user_expand( library(clpfd), 'library/clp/clpfd.pl' ).