/*********************************************************** 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 ), absolute_file_name( Root, FRoot ), rdir( FRoot ), fail. dirs( _Roots ). rdir( FRoot ) :- absolute_file_name( FRoot, [glob(*), solutions(all), file_errors(fail)], File ), writeln(File), \+ doskip( File ), catch( file_property( File, type(directory) ), _, fail ), assert_new( dir( File ) ), assert_new( sub_dir( FRoot, File ) ), rdir( 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 ), ( String == end_of_file -> ! ; 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_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 ) ), writeln( 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). % :- dynamic undo/3. directive(G, F, M) :- % asserta( directive(G, F, M) ), ( G = set_prolog_flag(F,V) -> prolog_flag(F, O, V), asserta( undo( set_prolog_flag(F, O), F, M)), set_prolog_flag(F, V) ; G = yap_flag(F,V) -> prolog_flag(F, O, V), asserta( undo( yap_flag(F, O), F, M)), yap_flag(F, V) ; G = op(A,B,O) -> (current_op(OA,OB,O) -> true ; OA = 0, OB = fx ), asserta( undo( op(OA,OB,O), F, M)), op( A, B, O) ; assert(M:G, R), asserta( undo(erase(R), F, M)) ). clean_up(F, M) :- undo( G , F, M), call( G ), fail. clean_up(_,_). % % % % 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') ) -> absolute_file_name( Path, APath ), pl_interface( 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_interface( 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_interface(F, _Mod) :- module_on( F , _M, _Is), !. pl_interface(F, Mod) :- consulted(F, Mod ), !. pl_interface(F, Mod) :- format('------------------------- ~a~n',[F]), % ( sub_atom(F,_,_,_,'matrix.yap') -> spy get_interf ; true ), % ( sub_atom( F, _, _, 0, 'gecode.yap' ) -> spy user_deps; true ), %( F = '/Users/vsc/git/yap-6.3/library/ytest.yap' -> spy get_interface/3 ; 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, [script(true)]) , _, fail ), repeat, nb_getval( current_module, MR ), catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, error( Throw)), %( sub_atom(F,_,_,_,'e.y writeln(T), ( T == end_of_file -> !, close(S), clean_up( MR, F ), ( 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_interface( T, F, MC ), fail ). get_interface( T, _F, _M0 ) :- % ( T = (:- op(_,_,_)) -> trace ; true ), var(T), !. %% switches to new file n get_interface( (:- D ), F, M ) :- !, get_directive( D, F, M ). get_interface( (?- _ ), _F, _M ) :- !. get_interface( T, F, M0 ) :- always_strip_module( M0:T, M, NT), ( NT = goal_expansion(_,_) ; NT = goal_expansion(_,_,_); NT = term_expansion( _, _ ) ), !, directive(NT, F, M). get_interf( ( M:H :- _B), F, _M ) :- !, get_interface( H, F, M ). % not the time t get_interface( (H :- _B), F, M ) :- !, get_interface( H, F, M ). get_interface( G , F, M ) :- functor( G, N, A), handle_pred( M, N, A, F ). get_directive( V , _F, _M ) :- var( V ), !. get_directive( module( NM0, Is ), F, _M ) :- !, (NM0 = system(_) -> NM = prolog ; NM = NM0 ), 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_directive( reexport( Loc, Is ), F, M ) :- !, % find the file search_file( Loc, F, prolog, 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_directive( use_module( Loc, Is ), F, M ) :- !, !, include_files( F, M, Is, Loc ). get_directive( use_module( Loc ), F, M ) :- !, !, include_files( F, M, Loc ). % nb_getval(current_module,MM), writeln(NM:MM:M). get_directive( use_module( Loc, Is, _ ), F, M ) :- !, include_files( F, M, Is, Loc ). get_directive( consult( Files ), F, M ) :- !, include_files( F, M, Files ). get_directive( reconsult( Files ), F, M ) :- !, include_files( F, M, Files ). get_directive( ensure_loaded( Files ), F, M ) :- !, include_files( F, M, Files ). get_directive( include( Files ), F, M ) :- !, source_files( F, M, Files ). get_directive( load_files( Files , [_|_] ), F, M ) :- !, include_files( F, M, Files ). get_directive( bootstrap( Files ), F, M ) :- !, include_files( F, M, Files ). get_directive( ( G -> _ ; _ ) , F, M) :- !, get_directive( G , F, M). get_directive( catch( G , _, _ ) , F, M) :- !, get_directive( G , F, M). get_directive( initialization( G , now ) , F, M) :- !, get_directive( G , F, M). get_directive( load_files( Files , [_|_] ), F, M ) :- !, include_files( F, M, Files ). get_directive( [] , _F0, _M ) :- !. get_directive( [F1|Fs] , F, M ) :- strip_module( M:F, M1, F1), !, include_files( F, M1, F1 ), get_directive( Fs , F, M ). % don't actually use \this one. get_directive( load_foreign_files(Fs, _, Fun), F, M ) :- !, call_c_files( F, M, Fun, Fs ). get_directive( load_foreign_library(F), F0, M ) :- !, always_strip_module(M:F, M1, F1), call_c_files( F0, M1, '', F1 ). get_directive( load_foreign_library(F,Fun), F0, M ) :- !, always_strip_module(M:F, M1, F1), call_c_files( F0, M1, Fun, F1 ). get_directive( use_foreign_library(F), F0, M ) :- !, always_strip_module(M:F, M1, F1), call_c_files( F0, M1, '', F1 ). get_directive( system_module( _NM, _Publics, _Hiddens), _F, _M ) :- !. get_directive( style_checker( _ ), _F, _M ) :- !. get_directive( dynamic( T ), F, M ) :- !, declare_functors( T, F, M ). get_directive( multifile( T ), F, M ) :- % public? !, declare_functors( T, F, M ). get_directive( meta_predicate( T ), F, M ) :-!, declare_terms( T, F, M ), % public? !. get_directive( '$install_meta_predicate'( H, M), F, __M ) :- !, declare_functors( H, F, M ). get_directive( thread_local( T ), F, M ) :- !, declare_functors( T, F, M ). get_directive( op( X, Y, Z), F, M ) :- !, always_strip_module(M:Z, M1, Z1), directive(op( X, Y, Z1), F, M1). get_directive( record( Records ), F, M ) :- !, handle_record( Records, F, M). get_directive( set_prolog_flag(dollar_as_lower_case,On), F, M ) :- !, directive(set_prolog_flag(dollar_as_lower_case,On), F, M). % 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 ) :- directive( Op, F, M ). 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_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, prolog, NF ) ), % depth visit pl_interface(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, prolog, 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, error( Throw)), ( 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_interface( 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 ).