812 lines
		
	
	
		
			22 KiB
		
	
	
	
		
			Plaintext
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			812 lines
		
	
	
		
			22 KiB
		
	
	
	
		
			Plaintext
		
	
	
		
			Executable File
		
	
	
	
	
x#!/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)).
 | 
						|
 | 
						|
:- initialization(main).
 | 
						|
 | 
						|
:- style_check(all).
 | 
						|
 | 
						|
:- yap_flag( double_quotes, string ).
 | 
						|
%:- yap_flag( dollar_as_lower_case, on ).
 | 
						|
 | 
						|
:- dynamic edge/1,
 | 
						|
   public/2,
 | 
						|
   private/2,
 | 
						|
   module_on/3,
 | 
						|
   exported/1,
 | 
						|
   dir/2,
 | 
						|
   consulted/2,
 | 
						|
   op_export/3,
 | 
						|
   library/1,
 | 
						|
   undef/2,
 | 
						|
   c_dep/2,
 | 
						|
   do_comment/5,
 | 
						|
   module_file/2.
 | 
						|
 | 
						|
% @short node(?Module:module, ?Predicate:pred_indicator, ?File:file, ?Generator:atom) is nondet
 | 
						|
%
 | 
						|
 | 
						|
 | 
						|
inline( !/0 ).
 | 
						|
inline( (\+)/1 ).
 | 
						|
inline( (fail)/0 ).
 | 
						|
inline( (false)/0 ).
 | 
						|
inline( (repeat)/0 ).
 | 
						|
inline( (true)/0 ).
 | 
						|
inline( []/0 ).
 | 
						|
 | 
						|
% @short edge(+SourceModule:module, +SourcePredicate:pred_indicator, +TargetPredicate:pred_indicator, +InFile:file) is nondet
 | 
						|
%
 | 
						|
 | 
						|
main :-
 | 
						|
     init,
 | 
						|
    fail.
 | 
						|
main :-
 | 
						|
	unix(argv([D])),
 | 
						|
	load(  D/['C'-prolog,
 | 
						|
		   'os'-prolog,
 | 
						|
		   'pl'-prolog,
 | 
						|
		   'OPTYap'-prolog,
 | 
						|
		   'library'-user,
 | 
						|
		   'swi/console'-prolog,
 | 
						|
		   'swi/library'-user,
 | 
						|
		   'packages'-user
 | 
						|
		 ]),
 | 
						|
	fail.
 | 
						|
main :-
 | 
						|
    %%% phase 4: construct graph
 | 
						|
    retractall( consulted(_,_) ),
 | 
						|
%    maplist( pl_graphs, Dirs ),
 | 
						|
    undefs,
 | 
						|
    doubles,
 | 
						|
    %     pl_exported(pl).
 | 
						|
    c_links,
 | 
						|
    mkdocs.
 | 
						|
 | 
						|
 | 
						|
init :-
 | 
						|
        retractall(dir(_)),
 | 
						|
        retractall(edge(_)),
 | 
						|
        retractall(private(_,_)),
 | 
						|
        retractall(public(_,_)),
 | 
						|
        retractall(undef(_,_)),
 | 
						|
        retractall(consulted(_,_)),
 | 
						|
        retractall(module_on(_,_,_)),
 | 
						|
        retractall(op_export(_,_,_)),
 | 
						|
        retractall(exported(_)),
 | 
						|
        retractall(do_comment(_,_,_,_,_)).
 | 
						|
init :-
 | 
						|
        user_c_dep(A,B),
 | 
						|
        do_user_c_dep(A,B),
 | 
						|
        fail.
 | 
						|
init :-
 | 
						|
        user_skip(A),
 | 
						|
        do_user_skip(A),
 | 
						|
        fail.
 | 
						|
init :-
 | 
						|
        user_expand(N,A),
 | 
						|
        do_user_expand(N,A),
 | 
						|
        fail.
 | 
						|
init :-
 | 
						|
        catch( make_directory(tmp), _, fail),
 | 
						|
        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.
 | 
						|
 | 
						|
undefs :-
 | 
						|
    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 ),
 | 
						|
    \+ node( Mod , NA , _File1, _ ),
 | 
						|
    \+ node( prolog , NA , _File2, _ ),
 | 
						|
    format('      predicate ~w:~n',[NA]),
 | 
						|
    (
 | 
						|
        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
 | 
						|
    ).
 | 
						|
undefs.
 | 
						|
 | 
						|
out_list([]) :-
 | 
						|
    format('[]', []).
 | 
						|
out_list([El]) :-
 | 
						|
    format('[~q]', [El]).
 | 
						|
out_list([E1,E2|Es]) :-
 | 
						|
    format('[~q', [E1]),
 | 
						|
    maplist(out_el, [E2|Es]),
 | 
						|
    format(']', []).
 | 
						|
 | 
						|
out_el( El ) :-
 | 
						|
    format(',~n        ~q',[El]).
 | 
						|
 | 
						|
pub(M, P) :-
 | 
						|
    node(M, P, _, _),
 | 
						|
    P = N/_A,
 | 
						|
    \+ sub_atom(N,0,1,_,'$').
 | 
						|
 | 
						|
has_edge(M1, P1, M, F) :-
 | 
						|
	edge(M1:P1, _P, F:_),
 | 
						|
	node(M1, P1, _, _),
 | 
						|
	M1 \= prolog,
 | 
						|
	M1 \= M,
 | 
						|
	\+ is_public(P1, M1, _).
 | 
						|
 | 
						|
mod_priv(M, P) :-
 | 
						|
    node(M, P, _, _),
 | 
						|
    node(M, P, _, _),
 | 
						|
    \+ is_public(P, M, _),
 | 
						|
    edge(M1:P, _P0, _), M1 \= M.
 | 
						|
 | 
						|
priv(M, P) :-
 | 
						|
    node(M, P, F:_, _),
 | 
						|
    \+ is_public(P, M, _),
 | 
						|
    edge(_:P, _P1, F1:_), F1 \= F.
 | 
						|
 | 
						|
% utilities
 | 
						|
 | 
						|
split_string( S , Cs, N) :-
 | 
						|
    string_codes(S, S1),
 | 
						|
    string_codes(Cs, NCs),
 | 
						|
    split(S1, NCs, Ncs0),
 | 
						|
    maplist(remove_escapes, Ncs0, Ncs),
 | 
						|
    maplist(string_codes, N, Ncs).
 | 
						|
 | 
						|
remove_escapes([0'\\ ,A|Cs], [A|NCs]) :- !, %'
 | 
						|
    remove_escapes(Cs, NCs).
 | 
						|
remove_escapes([A|Cs], [A|NCs]) :-
 | 
						|
    remove_escapes(Cs, NCs).
 | 
						|
remove_escapes( [], [] ).
 | 
						|
 | 
						|
always_strip_module(V, M, V1) :- var(V), !,
 | 
						|
		V = M:call(V1).
 | 
						|
always_strip_module(M0:A, M0, call(A)) :- var(A), !.
 | 
						|
always_strip_module(_:M0:A, M1, B) :- !,
 | 
						|
	always_strip_module(M0:A, M1, B).
 | 
						|
always_strip_module(M0:A, M0, call(A)) :- var(A),!.
 | 
						|
always_strip_module(M0:A, M0, A).
 | 
						|
 | 
						|
c_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
 | 
						|
search_file(  Loc , F, Type, FN ) :-
 | 
						|
    search_file0(  Loc , F, Type, FN ),
 | 
						|
    !.
 | 
						|
search_file(  Loc , F, _FN ) :-
 | 
						|
    format('~n~n~n###############~n~n FAILED TO FIND ~w when at  ~a~n~n###############~n~n~n', [Loc, F ]),
 | 
						|
     fail.
 | 
						|
 | 
						|
%
 | 
						|
% handle some special cases.
 | 
						|
%
 | 
						|
search_file0( F, _, _Type, FN ) :-
 | 
						|
    doexpand(F, FN), !.
 | 
						|
search_file0( A/B, F, Type, FN ) :- !,
 | 
						|
    term_to_atom(A/B, AB),
 | 
						|
    search_file0( AB, F, Type, FN ).
 | 
						|
% libraries can be anywhere in the source.
 | 
						|
search_file0( LibLoc, F, Type, FN ) :-
 | 
						|
    LibLoc =.. [Dir,File],
 | 
						|
	!,
 | 
						|
    ( term_to_atom( Dir/File, Full ) ; Full = File ),
 | 
						|
    search_file0( Full, F, Type, FN ).
 | 
						|
%try to use your base
 | 
						|
search_file0(  Loc , F, c, FN ) :-
 | 
						|
    atom_concat( D, '.yap', F),
 | 
						|
    atom_concat( [ D, '/', Loc], F1),
 | 
						|
    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 ) :-
 | 
						|
    file_directory_name( F, FD),
 | 
						|
    check_suffix(  Loc , Type, LocS ),
 | 
						|
    atom_concat( [ FD, '/', LocS], NLoc),
 | 
						|
    absolute_file_name( NLoc, FN),
 | 
						|
    file_base_name( FN, LocNam),
 | 
						|
    file_directory_name( FN, D),
 | 
						|
    dir( D, LocNam).
 | 
						|
search_file0(  Loc , _F, Type, FN ) :-
 | 
						|
    file_base_name( Loc, Loc0),
 | 
						|
    file_directory_name( Loc, LocD),
 | 
						|
    check_suffix(  Loc0 , Type, LocS ),
 | 
						|
    dir( D, LocS),
 | 
						|
    sub_dir( D, DD),
 | 
						|
    atom_concat( [ DD, '/', LocD], NLoc),
 | 
						|
    absolute_file_name( NLoc, D),
 | 
						|
    atom_concat( [D,'/', LocS], FN).
 | 
						|
search_file0(  Loc , _F, Type, FN ) :-
 | 
						|
    file_base_name( Loc, Loc0),
 | 
						|
    check_suffix(  Loc0 , Type, LocS ),
 | 
						|
    dir( D, LocS),
 | 
						|
    atom_concat( [D,'/', LocS], FN).
 | 
						|
% you try using the parent
 | 
						|
 | 
						|
sub_dir( D, D ).
 | 
						|
sub_dir( D, DD) :-
 | 
						|
	D \= '/',
 | 
						|
	atom_concat( D, '/..', DD0),
 | 
						|
	absolute_file_name( DD0, DDA),
 | 
						|
	sub_dir( DDA, DD).
 | 
						|
 | 
						|
% files must be called .yap or .pl
 | 
						|
% if it is .yap...
 | 
						|
check_suffix(  Loc , pl, Loc ) :-
 | 
						|
    atom_concat( _, '.yap', Loc ), !.
 | 
						|
%, otherwise, .pl
 | 
						|
check_suffix(  Loc , pl,  Loc ) :-
 | 
						|
    atom_concat( _, '.pl', Loc ), !.
 | 
						|
%, otherwise, .prolog
 | 
						|
check_suffix(  Loc , pl,  Loc ) :-
 | 
						|
    atom_concat( _, '.prolog', Loc ), !.
 | 
						|
%, otherwise, .P
 | 
						|
% try adding suffix
 | 
						|
check_suffix(  Loc0 , pl, Loc ) :-
 | 
						|
    member( Suf , ['.yap', '.ypp', '.pl' , '.prolog']),
 | 
						|
    atom_concat( Loc0, Suf, Loc ).
 | 
						|
check_suffix(  Loc , c, Loc ) :-
 | 
						|
    atom_concat( _, '.c', Loc ), !.
 | 
						|
%, otherwise, .pl
 | 
						|
check_suffix(  Loc , c,  Loc ) :-
 | 
						|
    atom_concat( _, '.icc', Loc ), !.
 | 
						|
%, otherwise, .prolog
 | 
						|
check_suffix(  Loc , c,  Loc ) :-
 | 
						|
    atom_concat( _, '.cpp', Loc ), !.
 | 
						|
%, otherwise, .P
 | 
						|
% try adding suffix
 | 
						|
check_suffix(  Loc0 , c, Loc ) :-
 | 
						|
    member( Suf , ['.c', '.icc' , '.cpp']),
 | 
						|
    atom_concat( Loc0, Suf, Loc ).
 | 
						|
 | 
						|
 | 
						|
 | 
						|
match_file( LocD, Loc0, Type, FN ) :-
 | 
						|
	var(LocD), !,
 | 
						|
	dir( LocD, Loc0 ),
 | 
						|
	atom_concat( [LocD, '/', Loc0], F ),
 | 
						|
	absolute_file_name( F, Type, FN ),
 | 
						|
	exists( FN ).
 | 
						|
match_file( SufLocD, Loc0, Type, FN ) :-
 | 
						|
	dir( LocD, Loc0 ),
 | 
						|
	atom_concat(_, SufLocD, LocD ),
 | 
						|
	atom_concat( [LocD, '/', Loc0], Type, FN ).
 | 
						|
 | 
						|
 | 
						|
new_op( F, M, op(X,Y,Z) ) :-
 | 
						|
    nb_getval( private, true ),
 | 
						|
    !,
 | 
						|
    private( F, M, op(X,Y,Z) ),
 | 
						|
    op( X, Y, Z).
 | 
						|
new_op( F, M, op( X, Y, Z) ) :-
 | 
						|
    public( F, M, op( X, Y, Z) ).
 | 
						|
 | 
						|
 | 
						|
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).
 | 
						|
 | 
						|
 | 
						|
%%%%%%%
 | 
						|
%% declare a concept export1able
 | 
						|
public( F, M, op(X,Y,Z) ) :-
 | 
						|
    retract( private( F, M:op(X,Y,Z) ) ),
 | 
						|
    fail.
 | 
						|
public( F, M, op(X,Y,Z) ) :- !,
 | 
						|
    assert( op_export(F, _M, op(X,Y,Z) ) ),
 | 
						|
    assert_new( public( F, M:op(X,Y,Z) ) ),
 | 
						|
    (
 | 
						|
	( M == user ; M == prolog )
 | 
						|
      ->
 | 
						|
	  op( X, Y, prolog:Z )
 | 
						|
      ;
 | 
						|
	  op( X, Y, M:Z )
 | 
						|
    ).
 | 
						|
public( F, M, M:N/Ar ) :-
 | 
						|
    retract( private( F, M:N/Ar ) ),
 | 
						|
    fail.
 | 
						|
public( F, M, N/Ar ) :-
 | 
						|
    assert_new( public( F, M:N/Ar ) ),
 | 
						|
    \+ node( M, N/Ar, F-_, _ ),
 | 
						|
    nb_getval( line, L ),
 | 
						|
    assert( node( M, N/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) ) :-
 | 
						|
    assert_new( private( F, M:op(X,Y,Z) ) ),
 | 
						|
    (
 | 
						|
	( M == user ; M == prolog )
 | 
						|
      ->
 | 
						|
	  op( X, Y, prolog:Z )
 | 
						|
      ;
 | 
						|
	  op( X, Y, M:Z )
 | 
						|
    ), !.
 | 
						|
private( _F, _M, op(_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( 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\
 | 
						|
     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_default sets operators back to YAP default.
 | 
						|
%
 | 
						|
ops_default :-
 | 
						|
    abolish( default_ops/1 ),
 | 
						|
    A = (_,_), functor(A,Comma,2),
 | 
						|
    findall(op(X,Y,prolog:Z), ( current_op(X,Y,prolog:Z), Z\= Comma ), L),
 | 
						|
    assert_static( default_ops(L) ).
 | 
						|
 | 
						|
:- initialization(ops_default, now).
 | 
						|
 | 
						|
ops_restore :-
 | 
						|
    A = (_,_), functor(A,Comma,2),
 | 
						|
    current_op(_X,Y,prolog:Z),
 | 
						|
    Z\= Comma,
 | 
						|
    op(0,Y,prolog:Z),
 | 
						|
    fail.
 | 
						|
ops_restore :-
 | 
						|
    default_ops(L),
 | 
						|
    maplist( call, L ).
 | 
						|
 | 
						|
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' ).
 | 
						|
 | 
						|
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' ).
 |