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

832 lines
22 KiB
Plaintext
Raw Normal View History

2015-11-11 08:45:03 +00:00
#!/usr/local/bin/yap -L -- $*
2014-12-24 15:32:29 +00:00
#.
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
2015-11-13 13:24:31 +00:00
:- use_module(library(analysis/graphs)).
:- use_module(library(analysis/load)).
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
2015-11-11 08:45:03 +00:00
:- dynamic
node/4,
edge/1,
2015-11-13 13:24:31 +00:00
public/2,
private/2,
module_on/3,
exported/1,
dir/2,
consulted/2,
op_export/3,
library/1,
undef/2,
c_dep/2,
do_comment/5,
module_file/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 :-
2015-11-11 08:45:03 +00:00
init,
2014-08-04 15:46:21 +01:00
fail.
2014-07-08 15:00:58 +01:00
main :-
2015-01-20 03:00:42 +00:00
unix(argv([D])),
2015-11-13 13:24:31 +00:00
Dirs = ['C'-prolog,
2015-01-20 03:00:42 +00:00
'os'-prolog,
'pl'-prolog,
'OPTYap'-prolog,
'library'-user,
2015-11-13 13:24:31 +00:00
% 'swi/console'-user
2015-01-20 03:00:42 +00:00
'packages'-user
2015-11-13 13:24:31 +00:00
],
% maplist(distribute(D), Dirs, Paths),
load( D, Dirs ),
maplist( pl_graphs, Dirs ),
2015-01-20 03:00:42 +00:00
fail.
2014-04-06 17:07:36 +01:00
main :-
2014-08-04 15:46:21 +01:00
%%% phase 4: construct graph
retractall( consulted(_,_) ),
undefs,
doubles,
% pl_exported(pl).
2014-08-23 20:47:40 +01:00
c_links,
mkdocs.
2014-08-04 15:46:21 +01:00
2015-11-13 13:24:31 +00:00
distribute( Root, File-Class, Path-Class) :-
sub_atom(Root,_,_,1,/),
!,
atom_concat(Root, File, Path ).
distribute( Root, File-Class, Path-Class) :-
atom_concat([Root, /, File], Path ).
2014-08-04 15:46:21 +01:00
init :-
2015-01-20 03:00:42 +00:00
retractall(dir(_)),
retractall(edge(_)),
retractall(private(_,_)),
retractall(public(_,_)),
retractall(undef(_,_)),
retractall(consulted(_,_)),
retractall(module_on(_,_,_)),
retractall(op_export(_,_,_)),
retractall(exported(_)),
retractall(do_comment(_,_,_,_,_)).
2014-08-21 16:32:23 +01:00
init :-
2015-01-20 03:00:42 +00:00
user_c_dep(A,B),
do_user_c_dep(A,B),
fail.
2014-08-23 20:47:40 +01:00
init :-
2015-01-20 03:00:42 +00:00
user_skip(A),
do_user_skip(A),
fail.
2014-08-23 20:47:40 +01:00
init :-
2015-01-20 03:00:42 +00:00
user_expand(N,A),
do_user_expand(N,A),
fail.
2014-12-24 15:32:29 +00:00
init :-
2015-01-20 03:00:42 +00:00
catch( make_directory(tmp), _, fail),
fail.
2014-08-21 16:32:23 +01:00
init.
2014-08-04 15:46:21 +01:00
init_loop( _Dirs ).
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 :-
2015-11-18 15:06:25 +00:00
trace,
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-12-24 15:32:29 +00:00
open('tmp/foreigns.yap', write, S),
2015-01-04 23:58:23 +00:00
clinks(S),
fail.
c_links :-
open('tmp/foreigns.c', write, S),
cclinks(S),
fail.
2014-09-08 23:16:49 +01:00
2014-09-13 00:50:04 +01:00
clinks(S) :-
2014-12-24 15:32:29 +00:00
module_file( F, NM ),
2015-01-04 23:58:23 +00:00
format( S, 'mod( ~q , ~q ).~n', [NM, F] ),
fail.
clinks(S) :-
2015-11-11 08:45:03 +00:00
system_predicate(C),
2015-01-04 23:58:23 +00:00
functor(C, N, A),
format( S, 'sys ~q/~d.~n', [N, A] ),
2014-12-24 15:32:29 +00:00
fail.
clinks(S) :-
exported( ( Fi0-M:F/A :- Fi1-M1:F1/A ) ),
( M \= M1 -> M \= prolog ; F \= F1 ),
2015-01-04 23:58:23 +00:00
% functor(S0, F, A),
% S0 =.. [F| Args],
% S1 =.. [F1| Args],
% numbervars(Args, 0, _),
format( S, '% ~q <- ~q.~n~q:~q imports ~q:~q. ~n', [Fi0, Fi1, M,F/A, M1,F1/A] ),
2015-11-11 08:45:03 +00:00
fail.
2014-08-23 20:47:40 +01:00
clinks(S) :-
2015-01-04 23:58:23 +00:00
close(S).
cclinks(S) :-
node( M, F/A, File-_Line, c(F)),
% functor( S0, F, A),
% S0 =.. [F| Args],
% S1 =.. [foreign, F| Args],
% numbervars(Args, 0, _),
format( S, '/// @file ~a~n', [File] ),
format( S, '/// @memberof ~a ~a:~a/~d~n', [F, M, F, A] ),
2014-07-08 15:00:58 +01:00
fail.
2015-01-04 23:58:23 +00:00
cclinks(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),
2015-01-04 23:58:23 +00:00
doc( Comment, N ),
2014-12-24 15:32:29 +00:00
format( "%s\n", [Comment] ),
2015-01-04 23:58:23 +00:00
!.
2014-08-04 15:46:21 +01:00
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 ),
2014-12-24 15:32:29 +00:00
( Header == "/**" -> true ; Header == "/*!" ), !, % */
2014-08-04 15:46:21 +01:00
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
%%%%%%%
2014-09-13 00:50:04 +01:00
%% declare a concept export1able
2014-08-04 15:46:21 +01:00
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 :-
2014-12-24 15:32:29 +00:00
open( 'tmp/pages', write, S1),
2014-09-10 06:39:38 +01:00
close( S1 ),
2014-12-24 15:32:29 +00:00
open( 'tmp/bads', write, S2),
2014-09-10 06:39:38 +01:00
close( S2 ),
2014-12-24 15:32:29 +00:00
open( 'tmp/groups', write, S3),
2014-09-10 06:39:38 +01:00
close( S3 ),
2015-01-20 03:00:42 +00:00
open( 'tmp/groups.yap', write, S4),
close( S4 ),
open( 'docs/yapdocs.yap', read, S),
2014-08-23 20:47:40 +01:00
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;
2014-12-24 15:32:29 +00:00
T1 \== T2, foldl( check, [0'/,0'*,0'*],T1, _) -> TF = T2, T = T1 ; % '
2014-09-08 23:16:49 +01:00
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, [] ) :-
2014-12-24 15:32:29 +00:00
append(_, L, T).
store_comment(Comment) :-
2014-09-08 23:16:49 +01:00
header( Pred, A, Comment, _ ),
atom_codes( P, Pred),
2014-09-10 06:39:38 +01:00
( node( Mod, P/A, File-Line, Type) ->
true
;
format('Missing definition for ~q.~n', [P/A] ),
2014-12-24 15:32:29 +00:00
node( Mod, P/Ar, File-Line, Type),
format(' ~w exists.~n',[Mod:P/Ar]),
fail
2014-09-10 06:39:38 +01:00
),
( node( M1, P/A, _, _), M1 \= Mod -> Dup = true ; Dup = false),
!,
string_codes( C, Comment ),
2014-09-10 06:39:38 +01:00
assert( do_comment( File, Line, C, Type, Dup ) ).
store_comment(Comment) :-
page( Comment, _ ), !,
2014-12-24 15:32:29 +00:00
open( 'tmp/pages', append, S),
2014-09-10 06:39:38 +01:00
format(S, '*******************************~n~n~s~n~n', [Comment]),
close(S).
store_comment(Comment) :-
defgroup( Comment, _ ), !,
2014-12-24 15:32:29 +00:00
open( 'tmp/groups', append, S),
2014-09-10 06:39:38 +01:00
format(S, '*******************************~n~n~s~n~n', [Comment]),
close(S).
store_comment(Comment) :-
2014-12-24 15:32:29 +00:00
open( 'tmp/bads', append, S),
2014-09-10 06:39:38 +01:00
format(S, '*******************************~n~n~s~n~n', [Comment]),
close(S).
defgroup -->
2014-12-24 15:32:29 +00:00
"/**", % */
2015-01-20 03:00:42 +00:00
blanks_or_stars,
"@defgroup".
defgroup -->
"%%", % */
blanks_or_percs,
2014-09-10 06:39:38 +01:00
"@defgroup".
page -->
2014-12-24 15:32:29 +00:00
"/**", % */
blanks,
2014-09-10 06:39:38 +01:00
"@page".
header(Pred, Arity) -->
2014-12-24 15:32:29 +00:00
"/**", % */
blanks,
"@pred",
2014-12-24 15:32:29 +00:00
blanks,
2014-09-10 06:39:38 +01:00
atom(_),
2014-12-24 15:32:29 +00:00
":",
2014-09-10 06:39:38 +01:00
!,
atom(Pred),
2014-09-08 23:16:49 +01:00
atom_pred(Arity).
2014-09-10 06:39:38 +01:00
header(Pred, Arity) -->
2014-12-24 15:32:29 +00:00
"/**", % */
blanks,
2014-09-10 06:39:38 +01:00
"@pred",
2014-12-24 15:32:29 +00:00
blanks,
2014-09-10 06:39:38 +01:00
atom(Pred),
2014-12-24 15:32:29 +00:00
atom_pred(Arity),
2014-09-10 06:39:38 +01:00
!.
header(Pred, 2, Comment, _) :-
split(Comment, [[0'/,0'*,0'*],[0'@,0'p,0'r,0'e,0'd],_,Pred,_,[0'i,0's]|_]), !.
2014-09-08 23:16:49 +01:00
atom_pred(Arity) -->
"/", !,
int( 0, Arity ).
atom_pred(N) -->
"(",
!,
2014-09-10 06:39:38 +01:00
decl(1,N).
atom_pred(0) -->
2014-09-15 09:13:50 +01:00
blanks, !.
2014-09-08 23:16:49 +01:00
int(I0, I) -->
[A],
{ A >= "0", A =< "9" },
!,
2014-09-10 06:39:38 +01:00
{ I1 is I0*10+(A-"0") },
int(I1, I).
2014-09-08 23:16:49 +01:00
int( I, I ) --> [].
2014-09-10 06:39:38 +01:00
decl(I, I) -->
")", !.
2014-09-08 23:16:49 +01:00
decl(I0, I) -->
",", !,
2014-09-10 06:39:38 +01:00
{ I1 is I0+1 },
decl(I1, I).
2014-09-08 23:16:49 +01:00
decl(I0, I) -->
[_],
decl( I0, I).
2015-01-20 03:00:42 +00:00
skip_early_comment(C) -->
[C], !,
skip_early_comment(C).
2015-11-11 08:45:03 +00:00
skip_early_comment(C) -->
2015-01-20 03:00:42 +00:00
( " " ; "\t" ; "\n" ), !,
skip_early_comment(C).
skip_early_comment(C) -->
2015-11-11 08:45:03 +00:00
"@", ( "{" ; "}" ), !,
2015-01-20 03:00:42 +00:00
skip_early_comment(C).
skip_early_comment(_) --> [].
blanks --> " ", !, blanks.
blanks --> "\t", !, blanks.
blanks --> [].
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 :-
2014-12-24 15:32:29 +00:00
open('tmp/comments.yap', write, S),
2014-09-15 09:13:50 +01:00
findall(File, do_comment( File, Line, C, Type, Dup), Fs0 ),
2014-09-10 06:39:38 +01:00
(
2014-09-11 20:06:57 +01:00
sort(Fs0, Fs),
2014-09-10 06:39:38 +01:00
member( File, Fs ),
setof(Line-C-Type-Dup, do_comment( File, Line, C, Type, Dup) , Lines0 ),
reverse( Lines0, Lines),
member(Line-Comment-Type-Dup, Lines),
2014-12-24 15:32:29 +00:00
check_comment( Comment, CN, Line, File ),
2014-09-11 20:06:57 +01:00
Line1 is Line-1,
2014-12-24 15:32:29 +00:00
format(S, '#~a~ncat << "EOF" > tmp~n~sEOF~nsed -e "~dr tmp" ~a > x~n\
mv x ~a~n~n',[Dup,CN, Line1, File, File])
2014-09-10 06:39:38 +01:00
;
close(S)
),
fail.
add_comments :-
listing( open_comment ).
2015-01-04 23:58:23 +00:00
check_comment( Comment, CN, _Line, _qFile ) :-
2014-12-24 15:32:29 +00:00
string_codes( Comment, [_,_,_|C]),
2015-01-04 23:58:23 +00:00
check_groups(0,_C,[]),
2014-09-11 20:06:57 +01:00
check_quotes(0,C,[]),
2014-12-24 15:32:29 +00:00
(
append(C0,[0'@,0'},0' ,0'*,0'/,10], C) -> %'
append(C0,[0'*,0'/,10], CN)
2014-09-11 20:06:57 +01:00
;
CN = C
),
!.
check_comment( Comment, Comment, Line, File ) :-
format(user_error,'*** bad comment ~a ~d~n~n~s~n~', [File,Line,Comment]).
2015-01-04 23:58:23 +00:00
check_groups(0) --> [].
2014-12-24 15:32:29 +00:00
2014-09-11 20:06:57 +01:00
check_quotes( 0 ) --> [].
2014-12-24 15:32:29 +00:00
check_quotes( 0 ) -->
2014-09-11 20:06:57 +01:00
"`", !,
check_quotes( 1 ).
2014-12-24 15:32:29 +00:00
check_quotes( 1 ) -->
2014-09-11 20:06:57 +01:00
"`", !,
check_quotes( 0 ).
2014-12-24 15:32:29 +00:00
check_quotes( 1 ) -->
2014-09-11 20:06:57 +01:00
"\"", !, { fail }.
2014-12-24 15:32:29 +00:00
check_quotes( 1 ) -->
"'", !, { fail }. %'
check_quotes( N ) -->
2014-09-11 20:06:57 +01:00
[_],
check_quotes( N ).
%%%
% 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' ).
2015-11-13 13:24:31 +00:00
doskip( D):- sub_atom( D, _, _, 0, '~' ).
doskip( D):- sub_atom( D, _, _, 0, '/.' ).
doskip( D):- sub_atom( D, _, _, 0, '/..' ).
doskip( D):- sub_atom( D, _, _, 0, '/.git' ).
doskip( D):- sub_atom( D, _, _, _, '/.#' ).
doskip( D):- sub_atom( D, _, _, 0, '#' ).
doskip( D):- user_skip( D ).
2014-08-23 20:47:40 +01:00
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' ).