#!/usr/local/bin/yap -L -- $* :- style_check(all). :- yap_flag( write_strings, on). :- yap_flag( gc_trace, verbose ). :- use_module(library(readutil)). :- use_module(library(lineutils)). :- use_module(library(lists)). :- use_module(library(maplist)). :- use_module(library(system)). :- use_module(library(hacks)). :- use_module(library(analysis/graphs)). :- use_module(library(analysis/load)). :- use_module(library(analysis/undefs)). :- initialization(main). :- style_check(all). %:- yap_flag( double_quotes, string ). %:- yap_flag( dollar_as_lower_case, on ). :- dynamic node/4, edge/1, (public)/2, private/2, module_on/3, exported/1, dir/1, sub_dir/2, consulted/2, op_export/3, library/1, undef/2, c_dep/2, do_comment/5, module_file/2, file/2. %% @pred node(?Module:module, ?Predicate:pred_indicator, ?File:file, ?Generator:atom) is nondet, dynamic. % % graph nodes 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 :- unix(argv([D])), assert(root(D)), init, fail. main :- Dirs = ['C'-prolog, 'OPTYap'-prolog, 'os'-prolog, 'pl'-prolog, 'library'-user, 'swi/library'-user, % 'swi/console'-user 'packages'-user ], root(D), % maplist(distribute(D), Dirs, Paths), load( D, Dirs ), fail. main :- %%% phase 4: construct graph retractall( consulted(_,_) ), find_undefs, doubles, % pl_exported(pl). c_links, mkdocs. 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 ). init :- retractall(dir(_)), retractall(file(_,_)), retractall(s8Sadir(_)), retractall(edge(_)), retractall(private(_,_)), retractall(public(_,_)), retractall(undef(_,_)), retractall(consulted(_,_)), retractall(module_on(_,_,_)), retractall(op_export(_,_,_)), retractall(exported(_)), retractall(do_comment(_,_,_,_,_)), fail. init :- current_op(_, _, D), assert(system_op(D)), fail. init :- user_c_dep(A,B), do_user_c_dep(A,B), fail. init :- root(M), user_skip(D), absolute_file_name( D, FD, [relative_to(M)]), assert_static(fullskip(FD)), fail. init :- user_expand(N,A), do_user_expand(N,A), fail. init :- catch( make_directory(tmp), _, fail), fail. init :- source_module(SM), nb_setval(current_module, SM), fail. init. init_loop( _Dirs ). 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. 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) :- fully_strip_module(V, M, V1). c_links :- open('tmp/foreigns.yap', write, S), clinks(S), fail. c_links :- open('tmp/foreigns.c', write, S), cclinks(S), fail. clinks(S) :- module_file( F, NM ), format( S, 'mod( ~q , ~q ).~n', [NM, F] ), fail. clinks(S) :- system_predicate(C), functor(C, N, A), format( S, 'sys ~q/~d.~n', [N, A] ), fail. clinks(S) :- exported( ( Fi0-M:F/A :- Fi1-M1:F1/A ) ), ( M \= M1 -> M \= prolog ; F \= F1 ), % 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] ), fail. clinks(S) :- 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] ), fail. cclinks(S) :- close(S). 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, +FileType, -File ) % % % Directories into atoms :- dynamic library/1. library('..'). :- multifile user:prolog_file_type/2. :- dynamic user:prolog_file_type/2. %prolog_file_type(chr, prolog). prolog_file_type(c, c). prolog_file_type(h, c). prolog_file_type('h.cmake', c). prolog_file_type('i', c). % % handle some special cases. % search_file( S , LocF, Type, FN ) :- functor(S, _, N), N> 0, !, arg(N, S, A), search_file( A , LocF, Type, FN ). %try to use your base search_file( F0, LocF, Type, FO ) :- file_directory_name(LocF, D), file_base_name(F0, B), findall(F, fsuffix(Type, B, F), Fs), Fs = [_|_], !, absolute_file_name(F0, [ relative_to(D), file_type(Type),file_errors(fail), access(none) ], FN ), maplist(quantf(FN), Fs, DFs), keysort(DFs, O), O = [_D-FO|_]. search_file( Loc , F, Type, _FN ) :- format('~n~n~n###############~n~n FAILED TO FIND ~w.~a when at ~a~n~n###############~n~n~n', [Loc, Type, F ]), fail. fsuffix(Type,F0, F) :- ( user:prolog_file_type(Suffix, Type), (atom_concat('.', _, Suffix) -> Suffix = DSuffix ; atom_concat('.', Suffix, DSuffix) ) ; DSuffix = '' ), atom_concat(F0, DSuffix, F1), file_base_name(F1, B), file(F, B), atom_concat(_, F1, F). quantf(F, F1, I-F1) :- atom_length(F1,M), between(0,M,I), sub_atom(F1, I, J, 0, End), sub_atom(F, _I, J, 0, End), !. % files must be called .yap or .pl % if it is .yap... new_op( M, M, X, Y, Z ) :- !, myop( X, Y, M:Z). new_op( M1, M2, X,Y,Z ) :- myop( X, Y, M1:Z), myop( X, Y, M2:Z). myop(_X, _Y, _M:P) :- system_op(P), !. myop(X, Y, M:P) :- op(X, Y, M:P). error(_F, Error) :- print_message( error, Error ), fail. 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). %%%%%%% %% declare a concept exportable public( _F, M, op(X,Y,Z) ) :- !, new_op(M,M,X,Y,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 ) ), \+ node( M, N/Ar, F-_, _ ), nb_getval( line, L ), assert( node( M, N/Ar, F-L, prolog ) ), !. public( F, M, _N/Ar as NN ) :- assert_new( public( F, M:NN/Ar ) ), \+ node( M, NN/Ar, F-_, _ ), nb_getval( line, L ), assert( node( M, NN/Ar, F-L, prolog ) ), !. public( _F, _M, _/_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 ) ), \+ node( M, N/Ar2, F-_, _ ), nb_getval( line, L ), assert( node( M, N/Ar2, F-L, prolog ) ), !. public( _F, _M, _//_Ar ). private( _F, M, op(X,Y,Z) ) :- !, new_op(M,M,X, Y, Z ). private( F, M, N/Ar ) :- assert_new( private( F, M:N/Ar ) ), \+ node( M, N/Ar, F-_, _ ), nb_getval( line, L ), assert( node( M, N/Ar, F-L, prolog ) ), !. private( _F, _M, _N/_Ar ). private( F, M, N//Ar ) :- Ar2 is Ar+2, assert_new( private( F, M:N/Ar2 ) ), \+ node( M, N/Ar2, F-_, _ ), nb_getval( line, L ), assert_new( node( M, N/Ar2, F-L, prolog ) ), !. 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_e( A , MG , B, MG1 ) :- always_strip_module(MG, M, P), always_strip_module(MG1, M1, P1), assert_new(edge((A-M:P :- B-M1:P1 ) )). assert_new( G ) :- G, !. assert_new( G ) :- assert( G ). error( Error ) :- throw(Error ). %% mkdocs inserts a file with a sequence of comments into a sequence of Prolog/C files. % % mkdocs :- open( 'tmp/pages', write, S1), close( S1 ), open( 'tmp/bads', write, S2), close( S2 ), open( 'tmp/groups', write, S3), close( S3 ), open( 'tmp/groups.yap', write, S4), close( S4 ), open( 'docs/yapdocs.yap', read, S), repeat, ( blanks(S, Comment, Rest) -> get_comment(S, Rest), store_comment( Comment ), fail ; close(S), !, add_comments ). 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), ( 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. diff_end( L, T, [] ) :- append(_, L, T). store_comment(Comment) :- header( Pred, A, Comment, _ ), atom_codes( P, Pred), ( node( Mod, P/A, File-Line, Type) -> true ; format('Missing definition for ~q.~n', [P/A] ), node( Mod, P/Ar, File-Line, Type), format(' ~w exists.~n',[Mod:P/Ar]), fail ), ( node( M1, P/A, _, _), M1 \= Mod -> Dup = true ; Dup = false), !, string_codes( C, Comment ), assert( do_comment( File, Line, C, Type, Dup ) ). store_comment(Comment) :- page( Comment, _ ), !, open( 'tmp/pages', append, S), format(S, '*******************************~n~n~s~n~n', [Comment]), close(S). store_comment(Comment) :- defgroup( Comment, _ ), !, open( 'tmp/groups', append, S), format(S, '*******************************~n~n~s~n~n', [Comment]), close(S). store_comment(Comment) :- open( 'tmp/bads', append, S), format(S, '*******************************~n~n~s~n~n', [Comment]), close(S). defgroup --> "/**", % */ blanks_or_stars, "@defgroup". defgroup --> "%%", % */ blanks_or_percs, "@defgroup". page --> "/**", % */ blanks, "@page". header(Pred, Arity) --> "/**", % */ blanks, "@pred", blanks, atom(_), ":", !, atom(Pred), atom_pred(Arity). header(Pred, Arity) --> "/**", % */ blanks, "@pred", blanks, atom(Pred), atom_pred(Arity), !. header(Pred, 2, Comment, _) :- split(Comment, [[0'/,0'*,0'*],[0'@,0'p,0'r,0'e,0'd],_,Pred,_,[0'i,0's]|_]), !. atom_pred(Arity) --> "/", !, int( 0, Arity ). atom_pred(N) --> "(", !, decl(1,N). atom_pred(0) --> blanks, !. int(I0, I) --> [A], { A >= "0", A =< "9" }, !, { I1 is I0*10+(A-"0") }, int(I1, I). int( I, I ) --> []. decl(I, I) --> ")", !. decl(I0, I) --> ",", !, { I1 is I0+1 }, decl(I1, I). decl(I0, I) --> [_], decl( I0, I). skip_early_comment(C) --> [C], !, skip_early_comment(C). skip_early_comment(C) --> ( " " ; "\t" ; "\n" ), !, skip_early_comment(C). skip_early_comment(C) --> "@", ( "{" ; "}" ), !, 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 =:= "_" }, !, atom2( As ). atom2([]) --> []. add_comments :- open('tmp/comments.yap', write, S), findall(File, do_comment( File, Line, C, Type, Dup), Fs0 ), ( sort(Fs0, Fs), 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), check_comment( Comment, CN, Line, File ), Line1 is Line-1, format(S, '#~a~ncat << "EOF" > tmp~n~sEOF~nsed -e "~dr tmp" ~a > x~n\c mv x ~a~n~n',[Dup,CN, Line1, File, File]) ; close(S) ), fail. add_comments :- listing( open_comment ). check_comment( Comment, CN, _Line, _qFile ) :- string_codes( Comment, [_,_,_|C]), check_groups(0,_C,[]), check_quotes(0,C,[]), ( append(C0,[0'@,0'},0' ,0'*,0'/,10], C) -> %' append(C0,[0'*,0'/,10], CN) ; CN = C ), !. check_comment( Comment, Comment, Line, File ) :- format(user_error,'*** bad comment ~a ~d~n~n~s~n~', [File,Line,Comment]). check_groups(0) --> []. check_quotes( 0 ) --> []. check_quotes( 0 ) --> "`", !, check_quotes( 1 ). check_quotes( 1 ) --> "`", !, check_quotes( 0 ). check_quotes( 1 ) --> "\"", !, { fail }. check_quotes( 1 ) --> "'", !, { fail }. %' check_quotes( N ) --> [_], check_quotes( N ). ops_restore :- current_op(_,Y,Op), \+ system_op(Op), op(0,Y,Op), fail. ops_restore. do_user_c_dep(F1, F2) :- absolute_file_name(F1, A1), absolute_file_name(F2, A2), assert(c_dep(A1, A2)). do_user_skip(F1) :- absolute_file_name(F1, A1), assert(doskip(A1)). do_user_expand(F, F1) :- absolute_file_name(F1, A1), assert(doexpand(F, A1)). 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' ). 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' ). user_c_dep( 'packages/swi-minisat2/minisat.pl', 'packages/swi-minisat2/C/pl-minisat.C' ). 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' ). 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, '#' ). 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'). user_skip( 'packages/prism'). user_expand( library(clpfd), 'library/clp/clpfd.pl' ). loop_error(_, Msg) :- writeln(Msg), fail.