last
This commit is contained in:
Vítor Santos Costa
parent
784f9a2880
commit
f6a6c9deb6
@ -2024,9 +2024,13 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||
return l;
|
||||
|
||||
default:
|
||||
{
|
||||
char err[1024];
|
||||
snprintf( err, 1023, "\n++++ token: unrecognised char %c (%d), type %c\n", ch, ch, chtype(ch) );
|
||||
#if DEBUG
|
||||
fprintf(stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype(ch));
|
||||
fprintf(stderr, "%s", err);
|
||||
#endif
|
||||
}
|
||||
t->Tok = Ord(kind = eot_tok);
|
||||
}
|
||||
#if DEBUG
|
||||
|
||||
@ -1,161 +0,0 @@
|
||||
pl_graphs(Dir - Mod) :-
|
||||
atom( Dir ),
|
||||
format(' ************* GRAPH: ~a ***********************/~n', [Dir]),
|
||||
atom_concat([Dir,'/*'], Pattern), % */
|
||||
expand_file_name( Pattern, Files ),
|
||||
member( File, Files ),
|
||||
( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ) ->
|
||||
build_graph( File , Mod )
|
||||
;
|
||||
exists_directory( File ),
|
||||
\+ atom_concat(_, '/.', File),
|
||||
\+ atom_concat(_, '/..', File),
|
||||
\+ atom_concat(_, '/.git', File),
|
||||
pl_graphs( File - Mod )
|
||||
),
|
||||
fail.
|
||||
pl_graphs(_).
|
||||
|
||||
%%
|
||||
% pl_graph( File, Mod)
|
||||
% adds a node to the file graph and marks which files are modules
|
||||
%
|
||||
% main side-effect facts like edge( F0-Mod:File )
|
||||
% exported( F-M , N/A ) or exported(F- M. Op ),
|
||||
% module_on ( M, File )
|
||||
% pred ( M :N/A )
|
||||
%
|
||||
build_graph(F, Mod) :-
|
||||
% writeln(F),
|
||||
preprocess_file( F, PF ),
|
||||
catch( open(PF, read, S, [scripting(true)]), _, fail ),
|
||||
repeat,
|
||||
nb_getval( current_module, MR ),
|
||||
catch(read_term( S, T, [term_position(Pos),module(MR),comments(Cs)] ), Throw, (writeln(Throw))),
|
||||
(
|
||||
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 ),
|
||||
close(S)
|
||||
;
|
||||
stream_position_data( line_count, Pos, Line ),
|
||||
maplist( comment, Cs ),
|
||||
nb_setval( line, Line ),
|
||||
nb_getval( current_module, MC0 ),
|
||||
( Mod == prolog -> MC = prolog ; MC = MC0 ),
|
||||
get_graph( T, F, Pos, MC ),
|
||||
fail
|
||||
).
|
||||
|
||||
|
||||
get_graph( V , _F, _Pos, _M ) :-
|
||||
var( V ),
|
||||
!,
|
||||
error( instantiation_error ).
|
||||
get_graph( T, _F, _Pos, _M0 ) :-
|
||||
var(T),
|
||||
!.
|
||||
get_graph( M:T, F, _Pos, _M0 ) :- !,
|
||||
get_graph( T, F, _Pos, M ).
|
||||
get_graph( ( M:H :- B), F, _Pos, M0 ) :-
|
||||
!,
|
||||
get_graph( (H :- M0:B), F, _Pos, M ).
|
||||
get_graph( ( M:H --> B), F, _Pos, M0 ) :-
|
||||
!,
|
||||
get_graph( ( H --> M0:B), F, _Pos, M ).
|
||||
get_graph( ( A, _ --> B), F, _Pos, M ) :-
|
||||
get_graph( ( A --> B), F, _Pos, M ).
|
||||
get_graph( (H --> B), F, _Pos, M ) :-
|
||||
!,
|
||||
functor( H, N, Ar),
|
||||
Ar2 is Ar+2,
|
||||
add_deps( B, M, M:N/Ar2, F, _Pos, 2 ).
|
||||
get_graph( (H :- B), F, _Pos, M ) :-
|
||||
!,
|
||||
functor( H, N, Ar),
|
||||
add_deps( B, M, M:N/Ar, F, _Pos, 0 ).
|
||||
%% switches to new file n
|
||||
get_graph( (:-include( Fs ) ), F, _Pos, M ) :-
|
||||
!,
|
||||
source_graphs( M, F, Fs ).
|
||||
get_graph( (?- _ ), _F, _Pos, _M ) :- !.
|
||||
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 ), !.
|
||||
|
||||
add_deps(V, _M, _P, _F, _Pos, _) :-
|
||||
var(V), !.
|
||||
add_deps(M1:G, _M, _P, _F, _Pos,L) :-
|
||||
!,
|
||||
always_strip_module(M1:G, M2, G2),
|
||||
add_deps(G2, M2, _P, _F, _Pos, L).
|
||||
add_deps((A,B), M, P, F, _Pos, L) :-
|
||||
!,
|
||||
add_deps(A, M, P, F, _Pos, L),
|
||||
add_deps(B, M, P, F, _Pos, L).
|
||||
add_deps((A;B), M, P, F, _Pos, L) :- !,
|
||||
add_deps(A, M, P, F, _Pos, L),
|
||||
add_deps(B, M, P, F, _Pos, L).
|
||||
add_deps((A|B), M, P, F, _Pos, L) :- !,
|
||||
add_deps(A, M, P, F, _Pos, L),
|
||||
add_deps(B, M, P, F, _Pos, L).
|
||||
add_deps((A->B), M, P, F, _Pos, L) :- !,
|
||||
add_deps(A, M, P, F, _Pos, L),
|
||||
add_deps(B, M, P, F, _Pos, L).
|
||||
add_deps((A*->B), M, P, F, _Pos, L) :- !,
|
||||
add_deps(A, M, P, F, _Pos, L),
|
||||
add_deps(B, M, P, F, _Pos, L).
|
||||
add_deps(once(A), M, P, F, _Pos, L) :- !,
|
||||
add_deps(A, M, P, F, _Pos, L).
|
||||
add_deps({A}, M, P, F, _Pos, 2) :- !,
|
||||
add_deps(A, M, P, F, _Pos, 0).
|
||||
add_deps([_|_], M, P, F, Pos, 2) :-
|
||||
!,
|
||||
put_dep( (F-M:P :- prolog:'C'/3 ), Pos ).
|
||||
add_deps(String, _M, _P, _F, _Pos, _) :- string(String), !.
|
||||
add_deps([], _M, _P, _F, _Pos, 2) :- !.
|
||||
add_deps(!, _M, _P, _F, _Pos, _) :- !.
|
||||
add_deps(true, _M, _P, _F, _Pos, 0) :- !.
|
||||
add_deps(false, _M, _P, _F, _Pos, 0) :- !.
|
||||
add_deps(fail, _M, _P, _F, _Pos, 0) :- !.
|
||||
add_deps(repeat, _M, _P, _F, _Pos, 0) :- !.
|
||||
add_deps(A, M, P, F, Pos, L) :-
|
||||
% we're home, M:N/Ar -> P=M1:N1/A1
|
||||
functor(A, N, Ar0),
|
||||
Ar is Ar0+L,
|
||||
put_dep( ( F-M:P :- F-M:N/Ar ), Pos ).
|
||||
|
||||
put_dep( (Target :- F0-M:Goal ), Pos ) :-
|
||||
exported( ( F0-M:Goal :- F1-M1:N/Ar ) ), !,
|
||||
%follow ancestor chain
|
||||
ancestor( ( F1-M1:N/Ar :- FA-MA:NA/Ar ) ),
|
||||
put_dep( ( Target :- FA-MA:NA/Ar ), Pos ).
|
||||
% the base case, copying from the same module ( but maybe not same file 0.
|
||||
put_dep( ( Target :- _F-M:N/Ar ) , _ ) :-
|
||||
m_exists(M:N/Ar, F0),
|
||||
!,
|
||||
assert_new( edge( ( Target :- F0-M:N/Ar ) ) ).
|
||||
% prolog is visible ( but maybe not same file ).
|
||||
put_dep( ( Target :- _F-_prolog:N/Ar ), _ ) :-
|
||||
m_exists(prolog:N/Ar, F0),
|
||||
!,
|
||||
assert_new( edge( ( Target :- F0-prolog:N/Ar ) ) ).
|
||||
put_dep( ( _Target :- _F-Mod:_N/_Ar ), _Pos) :-
|
||||
var( Mod ), !.
|
||||
put_dep( ( Target :- F-Mod:N/Ar ), Pos) :-
|
||||
atom( Mod ),
|
||||
stream_position_data( line_count, Pos, Line ),
|
||||
assert_new( undef( (Target :- F-Mod:N/Ar ), Line) ).
|
||||
|
||||
ancestor( ( Younger :- Older) ) :-
|
||||
exported( ( Mid :- Older ) ), !,
|
||||
ancestor( ( Younger :- Mid) ).
|
||||
ancestor( (Older :- Older) ).
|
||||
|
||||
m_exists(P, F) :- private( F, P ), !.
|
||||
m_exists(P, F) :- public( F, P ).
|
||||
@ -1,694 +0,0 @@
|
||||
/***********************************************************
|
||||
|
||||
load a program into a graph, but do not actually consult it.
|
||||
|
||||
***********************************************************/
|
||||
|
||||
load( D, _OMAP ) :-
|
||||
working_directory(_, D),
|
||||
fail.
|
||||
load( _, _Map ) :-
|
||||
% from libraries outside the current directories
|
||||
assert( node( attributes, woken_att_do/4, 'library/atts.yap', prolog ) ),
|
||||
fail.
|
||||
load( _ , Dirs ) :-
|
||||
dirs( Dirs ),
|
||||
%%% phase 1: find modules
|
||||
nb_setval( current_module, user ),
|
||||
nb_setval( private, false ),
|
||||
nb_setval( file_entry, user:user ),
|
||||
init_loop( Dirs ),
|
||||
maplist( pl_interfs, Dirs ),
|
||||
%%% phase 2: find C-code predicates
|
||||
maplist( c_preds, Dirs ).
|
||||
|
||||
dirs( Roots ) :-
|
||||
member( Root-_, Roots ),
|
||||
% (Root = 'OPTYap' -> start_low_level_trace ; true ),
|
||||
absolute_file_name( Root, FRoot ),
|
||||
rdir( FRoot ),
|
||||
fail.
|
||||
dirs( _Roots ).
|
||||
|
||||
rdir( FRoot ) :-
|
||||
absolute_file_name( FRoot, [glob(*), solutions(all), file_errors(fail)], File ),
|
||||
\+ doskip( File ),
|
||||
(
|
||||
file_property( File, type(directory) )
|
||||
->
|
||||
rdir( File )
|
||||
;
|
||||
assert_new( dir( FRoot, File ))
|
||||
),
|
||||
fail.
|
||||
rdir(_).
|
||||
|
||||
c_preds(Dir - Mod) :-
|
||||
atom( Dir ),
|
||||
absolute_file_name( Dir, [glob(*), solutions(all), file_errors(fail)], File ),
|
||||
( ( sub_atom(File,_,_,0,'.c')
|
||||
;
|
||||
sub_atom(File,_,_,0,'.i')
|
||||
;
|
||||
sub_atom(File,_,_,0,'.C')
|
||||
;
|
||||
sub_atom(File,_,_,0,'.cpp')
|
||||
;
|
||||
sub_atom(File,_,_,0,'.icc')
|
||||
;
|
||||
sub_atom(File,_,_,0,'.h')
|
||||
) ->
|
||||
\+ doskip( File ),
|
||||
c_file( File , Mod )
|
||||
;
|
||||
exists_directory( File ),
|
||||
\+ doskip( File ),
|
||||
c_preds( File - Mod )
|
||||
),
|
||||
fail.
|
||||
c_preds(_).
|
||||
|
||||
|
||||
c_file(F, _Mod) :-
|
||||
consulted( F, _ ),
|
||||
!.
|
||||
c_file(F, Mod) :-
|
||||
% writeln(F),
|
||||
assert( consulted( F, Mod ) ),
|
||||
nb_setval( current_module, Mod ),
|
||||
open(F, read, S, [alias(c_file)]),
|
||||
repeat,
|
||||
read_line_to_string( S, String ),
|
||||
( String == end_of_file
|
||||
->
|
||||
!,
|
||||
close(S)
|
||||
;
|
||||
sub_string(String, _, _, _, `PL_extension`),
|
||||
%writeln(Fields),
|
||||
c_ext(S, Mod, F),
|
||||
fail
|
||||
;
|
||||
split_string(String, `,; ()\t\"\'`, Fields), %'
|
||||
%writeln(Fields),
|
||||
line_count(S, Lines),
|
||||
c_line(Fields , Mod, F:Lines),
|
||||
fail
|
||||
).
|
||||
|
||||
c_line([`}`], Mod, _) :- !,
|
||||
nb_setval( current_module, Mod ).
|
||||
c_line(Line, _Mod, _) :-
|
||||
append( _, [ `CurrentModule`, `=`, M|_], Line),
|
||||
system_mod(M, _Mod, Mod, _),
|
||||
nb_setval( current_module, Mod ).
|
||||
c_line(Line, Mod, F: LineP) :-
|
||||
break_line( Line, N/A, Fu),
|
||||
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 ),
|
||||
Line0 is Line-1,
|
||||
assert( node( Mod, N/A, F-Line0, Fu ) ),
|
||||
handle_pred( Mod, N, A, F )
|
||||
).
|
||||
|
||||
|
||||
break_line( Line, N/A, c(Fu)) :-
|
||||
take_line( Line, NS, AS, FS ), !,
|
||||
atom_string(N,NS),
|
||||
atom_string(Fu,FS),
|
||||
number_string(A, AS).
|
||||
break_line( Line, N/A, swi(Fu)) :-
|
||||
take_line( Line, NS, AS, FS ), !,
|
||||
atom_string(N,NS),
|
||||
number_string(A, AS),
|
||||
atomic_concat([`pl_`,FS,`_`,A,`_va`], Fu).
|
||||
break_line( Line, N/A, bp(Fu)) :-
|
||||
take_line( Line, NS, AS, FS ), !,
|
||||
atom_string(N,NS),
|
||||
number_string(A, AS),
|
||||
atomic_concat([`pc_`,FS,`_`,A], Fu).
|
||||
break_line( Line, N/A, c(FuE, FuB)) :-
|
||||
take_line( Line, NS, AS, FSE, FSB ), !,
|
||||
atom_string(N,NS),
|
||||
atom_string(FuE,FSE),
|
||||
atom_string(FuB,FSB),
|
||||
number_string(A, AS).
|
||||
|
||||
take_line( Line, NS, AS, FS ) :-
|
||||
append( _, [ `Yap_InitCPred`, NS, AS, FS|_], Line), !.
|
||||
take_line( Line, NS, AS, FS ) :-
|
||||
append( _, [ `Yap_InitAsmPred`, NS, AS, _, FS|_], Line), !.
|
||||
take_line( Line, NS, AS, FS ) :-
|
||||
append( _, [ `Yap_InitCmpPred`, NS, AS, FS|_], Line), !.
|
||||
take_line( Line, NS, AS, FS ) :-
|
||||
append( _, [ `Yap_InitCmpPred`, NS, AS, FS|_], Line), !.
|
||||
take_line( Line, NS, AS, FS ) :-
|
||||
append( _, [ `YAP_UserCPredicate`, NS, FS, AS|_], Line), !.
|
||||
take_line( Line, NS, AS, FS ) :-
|
||||
append( _, [ `PRED`, NS0, AS, FS|_], Line), !,
|
||||
append( [`pl_`, NS0, AS, `_va`], NS ).
|
||||
take_line( Line, NS, AS, FS ) :-
|
||||
append( _, [ `PRED_IMPL`, NS0, AS, FS|_], Line), !,
|
||||
append( [`pl_`, NS0, AS, `_va`], NS ).
|
||||
take_line( Line, NS, AS, FS ) :-
|
||||
append( _, [ `PL_register_foreign`, NS, AS, FS|_], Line), !.
|
||||
take_line( Line, NS, AS, FS ) :-
|
||||
append( _, [ `PRED_DEF`, NS0, AS, FS|_], Line), !,
|
||||
append( [`pl_`, NS0, AS, `_va`], NS ).
|
||||
take_line( Line, NS, AS, FS ) :-
|
||||
append( _, [ `FRG`, NS, AS, FS|_], Line), !.
|
||||
% 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), !.
|
||||
|
||||
|
||||
take_line( Line, AS, FS ) :-
|
||||
append( _, [ `REGISTER_CPRED`, FS, AS], Line), !.
|
||||
|
||||
|
||||
take_line( Line, NS, AS, FSE, FSB ) :-
|
||||
append( _, [ `Yap_InitCPredBack`, NS, AS, _, FSE, FSB|_], Line), !.
|
||||
|
||||
system_mod(`ATTRIBUTES_MODULE`, _, attributes, 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`, _, system , 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 ).
|
||||
|
||||
call_c_files( File, Mod, _Fun, [CFile] ) :-
|
||||
search_file( CFile, File, c, F ),
|
||||
c_file(F, Mod).
|
||||
call_c_files( File, Mod, _Fun, CFile ) :-
|
||||
CFile \= [_|_],
|
||||
search_file( CFile, File, c, F ),
|
||||
c_file(F, Mod).
|
||||
|
||||
|
||||
pl_interfs(Dir - Mod) :-
|
||||
\+ doskip( Dir ),
|
||||
format('% ************* ~a\n', [Dir]),
|
||||
nb_setval( current_module, Mod ),
|
||||
atom( Dir ),
|
||||
directory_files( Dir , Files),
|
||||
member( File, Files ),
|
||||
atom_concat([Dir,'/',File], Path),
|
||||
( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ; sub_atom(File,_,_,0,'.ypp') ) ->
|
||||
ops_restore,
|
||||
absolute_file_name( Path, APath ),
|
||||
pl_interf( APath , Mod )
|
||||
;
|
||||
exists_directory( Path ),
|
||||
\+ atom_concat(_, '/.', Path),
|
||||
\+ atom_concat(_, '/..', Path),
|
||||
\+ atom_concat(_, '/.git', Path),
|
||||
absolute_file_name( Path, APath ),
|
||||
\+ doskip( APath ),
|
||||
pl_interfs( APath - Mod )
|
||||
),
|
||||
fail.
|
||||
pl_interfs(_).
|
||||
|
||||
%%
|
||||
% pl_interf( File, Mod)
|
||||
% adds a node to the file graph and marks which files are modules
|
||||
%
|
||||
% main side-effect facts like edge( F0-Mod:File )
|
||||
% exported( ( FMNATarget :- FMNASource ) ) ou exported(F-M, Op ),
|
||||
% module_on ( M, File )
|
||||
%
|
||||
pl_interf(F, _Mod) :-
|
||||
module_on( F , _M, _Is),
|
||||
!.
|
||||
pl_interf(F, Mod) :-
|
||||
consulted(F, Mod ),
|
||||
!.
|
||||
pl_interf(F, Mod) :-
|
||||
% ( sub_atom(F,_,_,_,'matrix.yap') -> spy get_interf ; true ),
|
||||
% ( sub_atom( F, _, _, 0, 'gecode.yap' ) -> spy user_deps; true ),
|
||||
assert_new(consulted(F, Mod ) ),
|
||||
nb_getval( private, Default ),
|
||||
nb_setval( private, false ),
|
||||
nb_getval( file_entry, OF:OMod ),
|
||||
nb_setval( file_entry, F:Mod ),
|
||||
preprocess_file( F, PF ),
|
||||
catch( open(PF, read, S, [scripting(true)]) , _, fail ),
|
||||
repeat,
|
||||
nb_getval( current_module, MR ),
|
||||
%( sub_atom(F,_,_,_,'e.yap') -> spy get_interf ; nospyall ),
|
||||
catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (ypp(F,Throw), fail)),
|
||||
(
|
||||
T == end_of_file
|
||||
->
|
||||
!,
|
||||
close(S),
|
||||
(
|
||||
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
|
||||
)
|
||||
;
|
||||
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, F, MC ),
|
||||
fail
|
||||
).
|
||||
|
||||
get_interf( T, _F, _M0 ) :-
|
||||
var(T),
|
||||
!.
|
||||
get_interf( T, _F, _M0 ) :-
|
||||
% ( T = (:- op(_,_,_)) -> trace ; true ),
|
||||
var(T),
|
||||
!.
|
||||
get_interf( M:T, F, _M0 ) :- !,
|
||||
get_interf( T, F, M ).
|
||||
get_interf( goal_expansion(G, M, _) , F, _M0 ) :-
|
||||
nonvar( G ),
|
||||
!,
|
||||
( var( M ) -> M1 = prolog ; M = M1 ),
|
||||
functor( G, N, A ),
|
||||
handle_pred( M1, N, A, F ).
|
||||
get_interf( goal_expansion(G, _) , F, _M0 ) :-
|
||||
nonvar( G ),
|
||||
!,
|
||||
functor( G, N, A ),
|
||||
handle_pred( prolog, N, A, F ).
|
||||
get_interf( ( M:H :- _B), F, _M ) :-
|
||||
!,
|
||||
get_interf( H, F, M ).
|
||||
get_interf( ( goal_expansion(G, M, _) :- _) , F, _M0 ) :-
|
||||
nonvar( G ),
|
||||
!,
|
||||
( var( M ) -> M1 = prolog ; M = M1 ),
|
||||
functor( G, N, A ),
|
||||
handle_pred( M1, N, A, F ).
|
||||
get_interf( ( goal_expansion(G, _) :- _) , F, _M0 ) :-
|
||||
nonvar( G ),
|
||||
!,
|
||||
functor( G, N, A ),
|
||||
handle_pred( prolog, N, A, F ).
|
||||
get_interf( ( M:H --> _B), F, _ ) :-
|
||||
!,
|
||||
get_interf( ( H --> _B), F, M ).
|
||||
get_interf( ( A, _ --> _B), F, M ) :-
|
||||
get_interf( ( A --> _B), F, M ).
|
||||
get_interf( (H --> _B), F, M ) :-
|
||||
!,
|
||||
functor( H, N, Ar),
|
||||
Ar2 is Ar+2,
|
||||
functor( H2, N, Ar2),
|
||||
get_interf( H2, F, M ).
|
||||
get_interf( (H :- _B), F, M ) :-
|
||||
!,
|
||||
get_interf( H, F, M ).
|
||||
%% switches to new file n
|
||||
get_interf( (:- V ), _F, _M ) :-
|
||||
var( V ),
|
||||
!.
|
||||
get_interf( (:- module( NM, Is ) ), F, _M ) :-
|
||||
!,
|
||||
assert(module_file( F, NM ) ),
|
||||
nb_setval( current_module, NM ),
|
||||
assert( module_on( F , NM, Is) ),
|
||||
maplist( public(F, NM), Is ),
|
||||
nb_setval( private, true ).
|
||||
get_interf( (:- reexport( Loc, Is ) ), F, M ) :-
|
||||
!,
|
||||
% find the file
|
||||
search_file( Loc, F, pl, NF ),
|
||||
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 ).
|
||||
get_interf( (:- use_module( Loc, Is ) ), F, M ) :- !,
|
||||
!,
|
||||
include_files( F, M, Is, Loc ).
|
||||
get_interf( (:- use_module( Loc ) ), F, M ) :- !,
|
||||
!,
|
||||
include_files( F, M, Loc ).
|
||||
% nb_getval(current_module,MM), writeln(NM:MM:M).
|
||||
get_interf( (:- use_module( Loc, Is, _ ) ), F, M ) :- !,
|
||||
!,
|
||||
include_files( F, M, Is, Loc ).
|
||||
get_interf( (:- consult( Files ) ), F, M ) :-
|
||||
!,
|
||||
include_files( F, M, Files ).
|
||||
get_interf( (:- reconsult( Files ) ), F, M ) :-
|
||||
!,
|
||||
include_files( F, M, Files ).
|
||||
get_interf( (:- ensure_loaded( Files ) ), F, M ) :-
|
||||
!,
|
||||
include_files( F, M, Files ).
|
||||
get_interf( (:- include( Files ) ), F, M ) :-
|
||||
!,
|
||||
source_files( F, M, Files ).
|
||||
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
|
||||
!,
|
||||
include_files( F, M, Files ).
|
||||
get_interf( ( :- ( G -> _ ; _ ) ) , F, M) :-
|
||||
!,
|
||||
get_interf( (:- G ) , F, M).
|
||||
get_interf( (:- catch( G , _, _ ) ) , F, M) :-
|
||||
!,
|
||||
get_interf( (:- G ) , F, M).
|
||||
get_interf( (:- initialization( G , now ) ) , F, M) :-
|
||||
!,
|
||||
get_interf( (:- G ) , F, M).
|
||||
get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :-
|
||||
!,
|
||||
include_files( F, M, Files ).
|
||||
get_interf( (:- [F1|Fs] ), F, M ) :-
|
||||
!,
|
||||
include_files( F, M, [F1|Fs] ).
|
||||
% don't actually use this one.
|
||||
get_interf( (:- load_foreign_files(Fs, _, Fun) ), F, M ) :-
|
||||
!,
|
||||
call_c_files( F, M, Fun, Fs ).
|
||||
get_interf( (:- load_foreign_library(F) ), F0, M ) :-
|
||||
!,
|
||||
always_strip_module(M:F, M1, F1),
|
||||
call_c_files( F0, M1, '', F1 ).
|
||||
get_interf( (:- load_foreign_library(F,Fun) ), F0, M ) :-
|
||||
!,
|
||||
always_strip_module(M:F, M1, F1),
|
||||
call_c_files( F0, M1, Fun, F1 ).
|
||||
get_interf( (:- use_foreign_library(F) ), F0, M ) :-
|
||||
!,
|
||||
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 ) :-
|
||||
!.
|
||||
get_interf( (:- dynamic T), F, M ) :-
|
||||
!,
|
||||
declare_functors( T, F, M ).
|
||||
get_interf( (:- multifile T), F, M ) :- % public?
|
||||
!,
|
||||
declare_functors( T, F, M ).
|
||||
get_interf( (:- meta_predicate T), F, M ) :-!,
|
||||
declare_terms( T, F, M ), % public?
|
||||
!.
|
||||
get_interf( (:- '$install_meta_predicate'( H, M) ), F, __M ) :-
|
||||
!,
|
||||
declare_functors( H, F, M ).
|
||||
get_interf( (:- thread_local T), F, M ) :-
|
||||
!,
|
||||
declare_functors( T, F, M ).
|
||||
get_interf( (:- op( X, Y, Z) ), F, M ) :-
|
||||
!,
|
||||
always_strip_module(M:Z, M1, Z1),
|
||||
handle_op( F, M1, op( X, Y, Z1) ).
|
||||
get_interf( (:- record( Records ) ), F, M ) :-
|
||||
!,
|
||||
handle_record( Records, F, M).
|
||||
get_interf( (:- set_prolog_flag(dollar_as_lower_case,On) ), _F, _M ) :-
|
||||
!,
|
||||
set_prolog_flag(dollar_as_lower_case,On).
|
||||
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 ),
|
||||
!.
|
||||
|
||||
% 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).
|
||||
|
||||
handle_pred( M, N, A, F ) :-
|
||||
(
|
||||
system_mod( _, _, M, sys )
|
||||
->
|
||||
(
|
||||
atom_concat('$',_,N)
|
||||
->
|
||||
private( F, M, N/A )
|
||||
;
|
||||
public( F, M, N/A )
|
||||
)
|
||||
;
|
||||
( nb_getval( private, false )
|
||||
->
|
||||
public( F, M, N/A )
|
||||
;
|
||||
private( F, M, N/A )
|
||||
)
|
||||
).
|
||||
|
||||
handle_op( F, M, Op ) :-
|
||||
( nb_getval( private, false )
|
||||
->
|
||||
public( F, M, Op )
|
||||
;
|
||||
private( F, M, Op )
|
||||
),
|
||||
Op = op(X, Y, Z ),
|
||||
( ( M == user ; M == prolog )
|
||||
->
|
||||
op( X, Y, prolog:Z )
|
||||
;
|
||||
op( X, Y, M:Z )
|
||||
).
|
||||
|
||||
exported( NF, F, NM, M, op(X,Y,Z)) :-
|
||||
!,
|
||||
public( NF , NM:op(X,Y,Z) ),
|
||||
handle_op( F, M , op(X,Y,Z) ).
|
||||
exported( NF, F, NM, M, N/A) :- !,
|
||||
% sink no more
|
||||
retractall( exported(( _ :- F-M:N/A) ) ),
|
||||
assert_new( exported( (F-M:N/A :- NF-NM:N/A )) ).
|
||||
exported( NF, F, NM, M, N/A as NN) :- !,
|
||||
% sink no more
|
||||
retractall( exported(( _ :- F-M:N/A) ) ),
|
||||
assert_new( exported( ( F-M:NN/A :- NF-NM:N/A ) ) ).
|
||||
exported( NF, F, NM, M, N//A) :- !,
|
||||
A2 is A+2,
|
||||
% sink no more
|
||||
retractall( exported(( _ :- F-M:N/A2) ) ),
|
||||
assert_new( exported( (F-M:N/A2 :- NF-NM:N/A2) ) ).
|
||||
exported( NF, F, NM, M, N//A as NN) :- !,
|
||||
A2 is A+2,
|
||||
% sink no more
|
||||
retractall( exported(( _ :- F-M:N/A2) ) ),
|
||||
assert_new( exported( ( F-M:NN/A2 :- NF-NM:N/A2 )) ).
|
||||
|
||||
import_publics( F, ProducerMod, ConsumerMod ) :-
|
||||
public(F, ProducerMod:op(X,Y,Z) ),
|
||||
handle_op( F, ConsumerMod, op(X,Y,Z) ),
|
||||
fail.
|
||||
import_publics( _F, _ProducerMod, _ConsumerMod ).
|
||||
|
||||
all_imported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod ) :-
|
||||
public(ProducerFile, ProducerMod:op(X,Y,Z) ),
|
||||
handle_op( ConsumerFile, ConsumerMod, op(X,Y,Z) ),
|
||||
fail.
|
||||
all_imported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod ) :-
|
||||
public(ProducerFile, ProducerMod:N/A ),
|
||||
exported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod, N/A ),
|
||||
fail.
|
||||
all_imported( _ProducerFile, _ConsumerFile, _ProducerMod, _ConsumerMod ).
|
||||
|
||||
|
||||
include_files( F, M, Files ) :-
|
||||
include_files( F, M, _Is, Files ).
|
||||
|
||||
include_files( F, M, Is, Files ) :-
|
||||
maplist( include_files( F, M, Is ), Files ),
|
||||
!.
|
||||
include_files( F, M, Is, -Files ) :-
|
||||
!,
|
||||
include_files( F, M, Is, Files).
|
||||
include_files( F, M, Is, Files ) :-
|
||||
!,
|
||||
always_strip_module(M:Files, M1, NFiles),
|
||||
include_file( F, M1, Is, NFiles ).
|
||||
include_files( F, M, Is, Loc ) :-
|
||||
include_file( F, M, Is, Loc ).
|
||||
|
||||
include_file( F, M, Is, Loc ) :-
|
||||
is_list( Loc ), !,
|
||||
maplist( include_file( F, M, Is), Loc ).
|
||||
include_file( F, M, Is0, Loc ) :-
|
||||
nb_getval( private, Private ),
|
||||
% find the file
|
||||
once( search_file( Loc, F, pl, NF ) ),
|
||||
% depth visit
|
||||
pl_interf(NF, M), % should verify Is in _Is
|
||||
% link b
|
||||
( module_on(NF, NM, Is)
|
||||
->
|
||||
( var(Is0) -> Is = Is0 ; true ),
|
||||
maplist( exported( NF, F, NM, M) , Is0 )
|
||||
;
|
||||
all_imported( NF, F, NM, M)
|
||||
),
|
||||
nb_setval( private, Private ).
|
||||
|
||||
|
||||
source_files( F, M, Files ) :-
|
||||
maplist( source_files( F, M ), Files ),
|
||||
!.
|
||||
source_files( F, M, Loc ) :-
|
||||
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 ),
|
||||
catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (writeln(F:MR:Throw), break, fail)),
|
||||
(
|
||||
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
|
||||
).
|
||||
|
||||
declare_functors( T, _F, _M1) :- var(T), !,
|
||||
error( unbound_variable ).
|
||||
declare_functors( M:T, F, _M1) :- !,
|
||||
declare_functors( T, F, M).
|
||||
declare_functors( (T1,T2), F, M1) :- !,
|
||||
declare_functors( T1, F, M1),
|
||||
declare_functors( T2, F, M1).
|
||||
declare_functors( Ts, F, M1) :-
|
||||
maplist( declare_functor( F, M1), Ts ), !.
|
||||
declare_functors( T, F, M1) :-
|
||||
declare_functor( F, M1, T).
|
||||
|
||||
declare_functor(File, M, N/A) :-
|
||||
handle_pred( M, N, A, File ).
|
||||
|
||||
declare_terms( T, _F, _M1) :- var(T), !,
|
||||
error( unbound_variable ).
|
||||
declare_terms( M:T, F, _M1) :- !,
|
||||
declare_functors( T, F, M).
|
||||
declare_terms( (N1,N2), F, M) :-
|
||||
number(N1),
|
||||
number(N2),
|
||||
!,
|
||||
declare_term( F, M, (N1,N2)).
|
||||
declare_terms( (T1,T2), F, M1) :- !,
|
||||
declare_terms( T1, F, M1),
|
||||
declare_terms( T2, F, M1).
|
||||
declare_terms( Ts, F, M1) :-
|
||||
maplist( declare_term( F, M1), Ts ), !.
|
||||
declare_terms( T, F, M1) :-
|
||||
declare_term( F, M1, T).
|
||||
|
||||
declare_term(F, M, S) :-
|
||||
functor(S, N, A),
|
||||
handle_pred( M, N, A, F ).
|
||||
File diff suppressed because it is too large
Load Diff
@ -53,6 +53,13 @@ if (Java_Development_FOUND)
|
||||
|
||||
target_link_libraries(jplYap libYap ${JAVA_LIBRARIES} ${JNI_LIBRARIES})
|
||||
|
||||
#SET(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE)
|
||||
LIST(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES "${libdir};${dlls};${JAVA_JVM_LIBRARY}/..;${JAVA_JVM_LIBRARY}/..;" isSystemDir)
|
||||
IF("${isSystemDir}" STREQUAL "-1")
|
||||
SET(CMAKE_INSTALL_RPATH "${libdir};${dlls}")
|
||||
ENDIF("${isSystemDir}" STREQUAL "-1")
|
||||
|
||||
|
||||
set_target_properties(jplYap PROPERTIES
|
||||
OUTPUT_NAME jpl )
|
||||
|
||||
|
||||
@ -473,9 +473,10 @@ load_files(Files,Opts) :-
|
||||
% check if there is a qly file
|
||||
% start_low_level_trace,
|
||||
'$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F,qload_file(File)),
|
||||
open( F, read, Stream , [type(binary)] ),
|
||||
open( F, read, Stream , [type(binary)] ),
|
||||
(
|
||||
'$q_header'( Stream, Type ),
|
||||
writeln(File:Type),
|
||||
Type == file
|
||||
->
|
||||
!
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
xc/*************************************************************************
|
||||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
@ -20,7 +20,7 @@ xc/*************************************************************************
|
||||
% This protects all code from further changes
|
||||
% and also makes it impossible from some predicates to be seen
|
||||
'$protect' :-
|
||||
'$current_predicate'(Name,M,P,_),riteln(P),
|
||||
'$current_predicate'(Name,M,P,_),
|
||||
M \= user,
|
||||
functor(P,Name,Arity),
|
||||
'$new_system_predicate'(Name,Arity,M),
|
||||
|
||||
Reference in New Issue
Block a user