clean up load_files and friends to reuse code
This commit is contained in:
Vítor Santos Costa
parent
08e5dcfbd1
commit
cbba7e93df
230
pl/consult.yap
230
pl/consult.yap
|
|
@ -33,47 +33,59 @@
|
|||
load_files(Files,Opts) :-
|
||||
'$load_files'(Files,Opts,load_files(Files,Opts)).
|
||||
|
||||
'$lf_opt'(autoload, 1).
|
||||
'$lf_opt'(derived_from).
|
||||
'$lf_opt'(encoding, 3).
|
||||
'$lf_opt'(expand, 4).
|
||||
'$lf_opt'(if, 5).
|
||||
'$lf_opt'(imports, 6).
|
||||
'$lf_opt'(qcompile, 7).
|
||||
'$lf_opt'(silent, 8).
|
||||
'$lf_opt'(skip_unix_header, 9).
|
||||
'$lf_opt'(compilation_mode, 10).
|
||||
'$lf_opt'(consult, 11).
|
||||
'$lf_opt'(stream, 12).
|
||||
'$lf_opt'(register, 13).
|
||||
'$lf_opt'('$files', 14).
|
||||
'$lf_opt'('$call', 15).
|
||||
'$lf_opt'('$use_module', 16).
|
||||
'$lf_opt'('$consulted_at', 17).
|
||||
'$lf_opt'('$options', 18).
|
||||
'$lf_opt'('$location', 19).
|
||||
'$lf_opt'(last_opt, 19).
|
||||
'$lf_option'(autoload, 1, false).
|
||||
'$lf_option'(derived_from, 2, false).
|
||||
'$lf_option'(encoding, 3, default).
|
||||
'$lf_option'(expand, 4, false).
|
||||
'$lf_option'(if, 5, true).
|
||||
'$lf_option'(imports, 6, all).
|
||||
'$lf_option'(qcompile, 7, never).
|
||||
'$lf_option'(silent, 8, _).
|
||||
'$lf_option'(skip_unix_header, 9, false).
|
||||
'$lf_option'(compilation_mode, 10, source).
|
||||
'$lf_option'(consult, 11, reconsult).
|
||||
'$lf_option'(stream, 12, _).
|
||||
'$lf_option'(register, 13, true).
|
||||
'$lf_option'('$files', 14, _).
|
||||
'$lf_option'('$call', 15, _).
|
||||
'$lf_option'('$use_module', 16, _).
|
||||
'$lf_option'('$consulted_at', 17, _).
|
||||
'$lf_option'('$options', 18, _).
|
||||
'$lf_option'('$location', 19, _).
|
||||
'$lf_option'(dialect, 20, yap).
|
||||
'$lf_option'(format, 21, source).
|
||||
'$lf_option'(redefine_module, 22, ask).
|
||||
'$lf_option'(reexport, 23, false).
|
||||
'$lf_option'(sandboxed, 24, false).
|
||||
'$lf_option'(scope_settings, 25, false).
|
||||
'$lf_option'(modified, 26, _).
|
||||
'$lf_option'('$context_module', 27, _).
|
||||
'$lf_option'('$parent_topts', 28, _).
|
||||
'$lf_option'(must_be_module, 29, false).
|
||||
|
||||
'$lf_option'(last_opt, 29).
|
||||
|
||||
'$lf_opt'( Op, TOpts, Val) :-
|
||||
'$lf_opt'(Op, Id),
|
||||
'$lf_option'(Op, Id, _),
|
||||
arg( Id, TOpts, Val ).
|
||||
|
||||
'$load_files'(Files, Opts, Call) :-
|
||||
( '$nb_getval'('$lf_status', OldTOpts, fail), nonvar(OldTOpts) -> '$lf_opt'(silent, OldTOpts, OldVerbosity) ; true ),
|
||||
'$check_files'(Files,load_files(Files,Opts)),
|
||||
'$lf_opt'(last_opt, LastOpt),
|
||||
'$lf_option'(last_opt, LastOpt),
|
||||
functor( TOpts, opt, LastOpt ),
|
||||
( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ),
|
||||
'$lf_opt'('$location', TOpts, ParentF:Line),
|
||||
'$lf_opt'('$files', TOpts, Files),
|
||||
'$lf_opt'('$call', TOpts, Call),
|
||||
'$lf_opt'('$options', TOpts, Opts),
|
||||
'$lf_opt'('$parent_topts', TOpts, OldTOpts),
|
||||
'$process_lf_opts'(Opts,TOpts,Files,Call),
|
||||
'$lf_default_opts'(1, LastOpt, TOpts),
|
||||
'$check_use_module'(Call,UseModule),
|
||||
'$lf_opt'('$use_module', TOpts, UseModule),
|
||||
'$current_module'(M0),
|
||||
'$lf_opt'(silent, TOpts, Verbosity),
|
||||
( var(Verbosity) -> Verbosity = OldVerbosity ; true ),
|
||||
% make sure we can run consult
|
||||
'$init_system',
|
||||
'$lf'(Files, M0, Call, TOpts).
|
||||
|
|
@ -119,7 +131,7 @@ load_files(Files,Opts) :-
|
|||
'$do_error'(domain_error(unimplemented_option,autoload(Val)),Call) ).
|
||||
'$process_lf_opt'(derived_from, File, Call) :-
|
||||
( atom(File) -> true ; '$do_error'(type_error(atom,File),Call) ).
|
||||
'$process_lf_opt'(encoding, Encoding, Call) :-
|
||||
'$process_lf_opt'(encoding, Encoding, _Call) :-
|
||||
atom(Encoding).
|
||||
'$process_lf_opt'(expand, Val, Call) :-
|
||||
( Val == true -> '$do_error'(domain_error(unimplemented_option,expand),Call) ;
|
||||
|
|
@ -130,9 +142,10 @@ load_files(Files,Opts) :-
|
|||
If == true -> true ;
|
||||
If == not_loaded -> true ;
|
||||
'$do_error'(domain_error(unimplemented_option,if),Call) ).
|
||||
'$process_lf_opt'(imports, Val, Call).
|
||||
'$process_lf_opt'(imports, Val, Call) :-
|
||||
( Val == all -> true ;
|
||||
is_list(Val) -> true ;
|
||||
var(Val) -> Val = all ;
|
||||
is_list(Val) -> ( ground(Val) -> true ; '$do_error'(instantiation_error,Call) ) ;
|
||||
'$do_error'(domain_error(unimplemented_option,imports(Val)),Call) ).
|
||||
'$process_lf_opt'(qcompile, Val,Call) :-
|
||||
( Val == true -> '$do_error'(domain_error(unimplemented_option,expand),Call) ;
|
||||
|
|
@ -147,7 +160,7 @@ load_files(Files,Opts) :-
|
|||
Val == true -> true ;
|
||||
'$do_error'(domain_error(unimplemented_option,skip_unix_header(Val)),Call) ).
|
||||
'$process_lf_opt'(compilation_mode, Val, Call) :-
|
||||
( Val == source -> true ;
|
||||
( Val == source -> true ;
|
||||
Val == compact -> true ;
|
||||
Val == assert_all -> true ;
|
||||
'$do_error'(domain_error(unimplemented_option,compilation_mode(Val)),Call) ).
|
||||
|
|
@ -156,17 +169,34 @@ load_files(Files,Opts) :-
|
|||
Val == consult -> true ;
|
||||
Val == exo -> true ;
|
||||
Val == db -> true ;
|
||||
'$do_error'(domain_error(unimplemented_option,comnsult(Val)),Call) ).
|
||||
'$do_error'(domain_error(unimplemented_option,consult(Val)),Call) ).
|
||||
'$process_lf_opt'(reexport, Val , Call) :-
|
||||
( Val == true -> true ;
|
||||
Val == false -> true ;
|
||||
'$do_error'(domain_error(unimplemented_option,reexport(Val)),Call) ).
|
||||
'$process_lf_opt'(must_be_module, Val , Call) :-
|
||||
( Val == true -> true ;
|
||||
Val == false -> true ;
|
||||
'$do_error'(domain_error(unimplemented_option,must_be_module(Val)),Call) ).
|
||||
'$process_lf_opt'(stream, Val, Call) :-
|
||||
( current_stream(Val) -> true ;
|
||||
'$do_error'(domain_error(unimplemented_option,stream(Val)),Call) ),
|
||||
'$lf_opt'('$files', TOpts, Files),
|
||||
( atom(File) -> true ; '$do_error'(type_error(atom,Files),Call) ).
|
||||
'$do_error'(type_error(stream,Val),Call) ).
|
||||
'$process_lf_opt'(register, Val, Call) :-
|
||||
( Val == false -> true ;
|
||||
Val == true -> true ;
|
||||
'$do_error'(domain_error(unimplemented_option,register(Val)),Call) ).
|
||||
|
||||
'$lf_default_opts'(I, LastOpt, _TOpts) :- I > LastOpt, !.
|
||||
'$lf_default_opts'(I, LastOpt, TOpts) :-
|
||||
I1 is I+1,
|
||||
arg(I, TOpts, A),
|
||||
( nonvar(A) -> true ;
|
||||
'$lf_option'(_Name, I, A)
|
||||
),
|
||||
'$lf_default_opts'(I1, LastOpt, TOpts).
|
||||
|
||||
|
||||
|
||||
'$check_use_module'(use_module(_), use_module(_)) :- !.
|
||||
'$check_use_module'(use_module(_,_), use_module(_)) :- !.
|
||||
'$check_use_module'(use_module(M,_,_), use_module(M)) :- !.
|
||||
|
|
@ -195,20 +225,15 @@ load_files(Files,Opts) :-
|
|||
'$lf_opt'(stream, TOpts, Stream),
|
||||
( var(Stream) ->
|
||||
/* need_to_open_file */
|
||||
'$lf_opt'(encoding, TOpts, Encoding),
|
||||
'$full_filename'(File, Y, Call),
|
||||
(
|
||||
var(Encoding)
|
||||
->
|
||||
Opts = []
|
||||
;
|
||||
Opts = [encoding(Encoding)]
|
||||
),
|
||||
open(Y, read, Stream, Opts)
|
||||
open(Y, read, Stream)
|
||||
;
|
||||
true
|
||||
), !,
|
||||
'$lf_opt'(if, TOpts, If),
|
||||
( var(If) -> If = true ; true ),
|
||||
'$lf_opt'(encoding, TOpts, Encoding),
|
||||
'$set_encoding'(Stream, Encoding),
|
||||
'$lf_opt'(imports, TOpts, Imports),
|
||||
'$start_lf'(If, Mod, Stream, TOpts, File, Imports),
|
||||
close(Stream).
|
||||
|
|
@ -216,12 +241,12 @@ load_files(Files,Opts) :-
|
|||
'$do_error'(permission_error(input,stream,X),Call).
|
||||
|
||||
'$start_lf'(not_loaded, Mod, Stream, TOpts, UserFile, Imports) :-
|
||||
'$file_loaded'(Stream, Mod, Imports), !,
|
||||
'$file_loaded'(Stream, Mod, Imports, TOpts), !,
|
||||
'$lf_opt'('$options', TOpts, Opts),
|
||||
'$lf_opt'('$location', TOpts, ParentF:Line),
|
||||
'$loaded'(Stream, UserFile, Mod, ParentF, Line, not_loaded, _File, _Dir, Opts).
|
||||
'$start_lf'(changed, Mod, Stream, TOpts, UserFile, Imports) :-
|
||||
'$file_unchanged'(Stream, Mod, Imports), !,
|
||||
'$file_unchanged'(Stream, Mod, Imports, TOpts), !,
|
||||
'$lf_opt'('$options', TOpts, Opts),
|
||||
'$lf_opt'('$location', TOpts, ParentF:Line),
|
||||
'$loaded'(Stream, UserFile, Mod, ParentF, Line, changed, _File, _Dir, Opts).
|
||||
|
|
@ -229,7 +254,7 @@ load_files(Files,Opts) :-
|
|||
'$do_lf'(Mod, Stream, File, TOpts).
|
||||
|
||||
ensure_loaded(Fs) :-
|
||||
'$load_files'(Fs, [if(changed)],ensure_loaded(Fs)).
|
||||
'$load_files'(Fs, [if(not_loaded)],ensure_loaded(Fs)).
|
||||
|
||||
compile(Fs) :-
|
||||
'$load_files'(Fs, [], compile(Fs)).
|
||||
|
|
@ -263,22 +288,20 @@ db_files(Fs) :-
|
|||
'$load_files'(Fs, [consult(db), if(not_loaded)], exo_files(Fs)).
|
||||
|
||||
use_module(F) :-
|
||||
'$load_files'(F, [if(not_loaded)], use_module(F)).
|
||||
'$load_files'(F, [if(not_loaded),must_be_module(true)], use_module(F)).
|
||||
|
||||
use_module(F,Is) :-
|
||||
'$load_files'(F, [if(not_loaded),imports(Is)], use_module(F,Is)).
|
||||
'$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)).
|
||||
|
||||
use_module(M,F,Is) :-
|
||||
'$use_module'(M,F,Is).
|
||||
|
||||
'$use_module'(U,_F,Is) :- nonvar(U), U = user, !,
|
||||
'$import_to_current_module'(user_input, user, Is).
|
||||
'$use_module'(M,F,Is) :- nonvar(M), !,
|
||||
recorded('$module','$module'(F1,M,_),_),
|
||||
'$load_files'(F1, [if(not_loaded),imports(Is)], use_module(M,F,Is)),
|
||||
F1 = F.
|
||||
'$use_module'(M,F,Is) :- nonvar(F),
|
||||
'$load_files'(F, [if(not_loaded),imports(Is)], use_module(M,F,Is)).
|
||||
'$load_files'(F1, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)),
|
||||
( F1 = F -> true ; true ).
|
||||
'$use_module'(M,F,Is) :-
|
||||
'$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)).
|
||||
|
||||
'$csult'(Fs, M) :-
|
||||
'$extract_minus'(Fs, MFs), !,
|
||||
|
|
@ -291,7 +314,9 @@ use_module(M,F,Is) :-
|
|||
'$extract_minus'(Fs, MFs).
|
||||
|
||||
|
||||
'$do_lf'(ContextModule, Stream, UserFile, TOpts) :- %MsgLevel, _, Imports, SkipUnixHeader, CompMode, Reconsult, UseModule) :-
|
||||
'$do_lf'(ContextModule, Stream, UserFile, TOpts) :-
|
||||
% format( 'I=~w~n', [ContextModule=UserFile] ),
|
||||
'$lf_opt'('$context_module', TOpts, ContextModule),
|
||||
'$msg_level'( TOpts, Verbosity),
|
||||
% export to process
|
||||
b_setval('$lf_status', TOpts),
|
||||
|
|
@ -340,7 +365,7 @@ use_module(M,F,Is) :-
|
|||
;
|
||||
true
|
||||
),
|
||||
'$set_current_loop_stream'(_, OldStream),
|
||||
'$set_current_loop_stream'(Stream, OldStream),
|
||||
'$swi_set_prolog_flag'(generate_debug_info, GenerateDebug),
|
||||
'$comp_mode'(CompMode, OldCompMode),
|
||||
working_directory(_,OldD),
|
||||
|
|
@ -350,9 +375,15 @@ use_module(M,F,Is) :-
|
|||
nb_setval('$if_level',OldIfLevel),
|
||||
'$lf_opt'('$use_module', TOpts, UseModule),
|
||||
'$bind_module'(Mod, UseModule),
|
||||
'$lf_opt'(imports, TOpts, Imports0),
|
||||
(Imports0 == all -> true ; Imports = Imports0 ),
|
||||
'$import_to_current_module'(File, ContextModule, Imports),
|
||||
% ( File = '/Users/vsc/Yap/bins/threads/share/Yap/error.pl' -> start_low_level_trace ; stop_low_level_trace ),
|
||||
'$lf_opt'(imports, TOpts, Imports),
|
||||
'$import_to_current_module'(File, ContextModule, Imports, TOpts),
|
||||
'$lf_opt'(reexport, TOpts, Reexport),
|
||||
( Reexport == false -> true ;
|
||||
'$lf_opt'('$parent_topts', TOpts, OldTOpts),
|
||||
'$lf_opt'('$context_module', OldTOpts, OldContextModule),
|
||||
'$import_to_current_module'(File, OldContextModule, Imports, TOpts)
|
||||
),
|
||||
( LC == 0 -> prompt(_,' |: ') ; true),
|
||||
( OldMode == off -> '$exit_system_mode' ; true ),
|
||||
'$exec_initialisation_goals',
|
||||
|
|
@ -364,6 +395,9 @@ use_module(M,F,Is) :-
|
|||
AutoLoad == true,
|
||||
'$swi_current_prolog_flag'(verbose_autoload, false), !,
|
||||
Verbosity = silent.
|
||||
'$msg_level'( _TOpts, Verbosity) :-
|
||||
'$swi_current_prolog_flag'(verbose_load, false), !,
|
||||
Verbosity = silent.
|
||||
'$msg_level'( _TOpts, Verbosity) :-
|
||||
'$swi_current_prolog_flag'(verbose, silent), !,
|
||||
Verbosity = silent.
|
||||
|
|
@ -391,10 +425,20 @@ use_module(M,F,Is) :-
|
|||
'$bind_module'(_, load_files).
|
||||
'$bind_module'(Mod, use_module(Mod)).
|
||||
|
||||
'$import_to_current_module'(File, M, Imports) :-
|
||||
recorded('$module','$module'(File,NM,Ps),_), M \= NM, !,
|
||||
'$use_preds'(Imports, Ps, NM, M).
|
||||
'$import_to_current_module'(_, _, _).
|
||||
'$import_to_current_module'(File, ContextModule, Imports, TOpts) :-
|
||||
recorded('$module','$module'(File, Module, ModExports),_),
|
||||
Module \= ContextModule, !,
|
||||
'$lf_opt'('$call', TOpts, Call),
|
||||
'$convert_for_export'(Imports, ModExports, Module, ContextModule, TranslationTab, _RemainingImports, Goal),
|
||||
% format( 'O=~w~n', [(TranslationTab,ContextModule)] ),
|
||||
'$add_to_imports'(TranslationTab, Module, ContextModule).
|
||||
'$import_to_current_module'(_, _, _, _).
|
||||
|
||||
'$reexport_lf'(Imports, TOpts, Mod, ContextModule) :-
|
||||
'$lf_opt'('$call', TOpts, Goal),
|
||||
( var(Imports) -> Imports = all ; true ),
|
||||
'$reexport'(Imports, Mod, ContextModule, Goal).
|
||||
|
||||
|
||||
'$start_reconsulting'(F) :-
|
||||
recorda('$reconsulted','$',_),
|
||||
|
|
@ -461,7 +505,7 @@ initialization(G,OPT) :-
|
|||
'$initialization'(G,after_load) :-
|
||||
'$initialization'(G).
|
||||
% ignore for now.
|
||||
'$initialization'(G,restore).
|
||||
'$initialization'(_G,restore).
|
||||
|
||||
'$exec_initialisation_goals' :-
|
||||
nb_setval('$initialization_goals',on),
|
||||
|
|
@ -522,12 +566,16 @@ initialization(G,OPT) :-
|
|||
true ;
|
||||
'$do_error'(permission_error(input,stream,Y),include(X))
|
||||
),
|
||||
'$set_current_loop_stream'(OldStream, Stream),
|
||||
H0 is heapused, '$cputime'(T0,_),
|
||||
'$loaded'(Stream, X, Mod, F, L, include, Y, Dir, []),
|
||||
'$loaded'(Stream, X, Mod, F, L, include, Y, _Dir, []),
|
||||
( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ),
|
||||
'$lf_opt'(encoding, TOpts, Encoding),
|
||||
'$set_encoding'(Stream, Encoding),
|
||||
nb_setval('$included_file', Y),
|
||||
print_message(Verbosity, loading(including, Y)),
|
||||
'$loop'(Stream,Status),
|
||||
'$set_current_loop_stream'(Stream, OldStream),
|
||||
close(Stream),
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
print_message(Verbosity, loaded(included, Y, Mod, T, H)),
|
||||
|
|
@ -592,33 +640,34 @@ prolog_load_context(term_position, '$stream_position'(0,Line,0,0,0)) :-
|
|||
|
||||
% if the file exports a module, then we can
|
||||
% be imported from any module.
|
||||
'$file_loaded'(Stream, M, Imports) :-
|
||||
'$file_loaded'(Stream, M, Imports, TOpts) :-
|
||||
'$file_name'(Stream, F),
|
||||
'$ensure_file_loaded'(F, M, Imports).
|
||||
'$ensure_file_loaded'(F, M, Imports, TOpts).
|
||||
|
||||
'$ensure_file_loaded'(F, M, Imports) :-
|
||||
recorded('$module','$module'(F1,NM,P),_),
|
||||
'$ensure_file_loaded'(F, M, Imports, TOpts) :-
|
||||
recorded('$module','$module'(F1,_NM,_P),_),
|
||||
recorded('$lf_loaded','$lf_loaded'(F1,_),_),
|
||||
same_file(F1,F), !,
|
||||
'$use_preds'(Imports,P, NM, M).
|
||||
'$ensure_file_loaded'(F, _M, _) :-
|
||||
'$import_to_current_module'(F1, M, Imports, TOpts).
|
||||
'$ensure_file_loaded'(F, _M, _, _TOpts) :-
|
||||
recorded('$lf_loaded','$lf_loaded'(F1,_),_),
|
||||
same_file(F1,F), !.
|
||||
|
||||
|
||||
% if the file exports a module, then we can
|
||||
% be imported from any module.
|
||||
'$file_unchanged'(Stream, M, Imports) :-
|
||||
'$file_unchanged'(Stream, M, Imports, TOpts) :-
|
||||
'$file_name'(Stream, F),
|
||||
'$ensure_file_unchanged'(F, M, Imports).
|
||||
'$ensure_file_unchanged'(F, M, Imports, TOpts).
|
||||
|
||||
'$ensure_file_unchanged'(F, M, Imports) :-
|
||||
recorded('$module','$module'(F1,NM,P),_),
|
||||
'$ensure_file_unchanged'(F, M, Imports, TOpts) :-
|
||||
recorded('$module','$module'(F1,_NM,_P),_),
|
||||
recorded('$lf_loaded','$lf_loaded'(F1,Age),R),
|
||||
same_file(F1,F), !,
|
||||
'$file_is_unchanged'(F, R, Age),
|
||||
'$use_preds'(Imports, P, NM, M).
|
||||
'$ensure_file_unchanged'(F, M, _) :-
|
||||
% format( 'I=~w~n', [M=Imports] ),
|
||||
'$import_to_current_module'(F1, M, Imports, TOpts).
|
||||
'$ensure_file_unchanged'(F, _M, _, _TOpts) :-
|
||||
recorded('$lf_loaded','$lf_loaded'(F1,Age),R),
|
||||
same_file(F1,F), !,
|
||||
'$file_is_unchanged'(F, R, Age).
|
||||
|
|
@ -690,7 +739,7 @@ remove_from_path(New) :- '$check_path'(New,Path),
|
|||
|
||||
'$loaded'(Stream, UserFile, M, OldF, Line, Reconsult, F, Dir, Opts) :-
|
||||
'$file_name'(Stream, F0),
|
||||
( F0 == user_input, nonvar(File) -> UserFile = F ; F = F0 ),
|
||||
( F0 == user_input, nonvar(UserFile) -> UserFile = F ; F = F0 ),
|
||||
( F == user_input -> working_directory(Dir,Dir) ; file_directory_name(F, Dir) ),
|
||||
nb_setval('$consulting_file', F ),
|
||||
( Reconsult \== consult, Reconsult \== not_loaded, Reconsult \== changed, recorded('$lf_loaded','$lf_loaded'(F, _),R), erase(R), fail ; var(Reconsult) -> Reconsult = consult ; true ),
|
||||
|
|
@ -701,6 +750,9 @@ remove_from_path(New) :- '$check_path'(New,Path),
|
|||
|
||||
'$set_encoding'(Encoding) :-
|
||||
'$current_loop_stream'(Stream),
|
||||
'$set_encoding'(Stream, Encoding).
|
||||
|
||||
'$set_encoding'(Stream, Encoding) :-
|
||||
( Encoding == default -> true ; set_stream(Stream, encoding(Encoding)) ).
|
||||
|
||||
absolute_file_name(V,Out) :- var(V), !,
|
||||
|
|
@ -720,7 +772,7 @@ absolute_file_name(File,TrueFileName,Opts) :-
|
|||
absolute_file_name(File,Opts,TrueFileName) :-
|
||||
'$absolute_file_name'(File,Opts,TrueFileName,absolute_file_name(File,Opts,TrueFileName)).
|
||||
|
||||
'$absolute_file_name'(File,Opts,TrueFileName,G) :- var(File), !,
|
||||
'$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$absolute_file_name'(File,Opts,TrueFileName, G) :-
|
||||
'$process_fn_opts'(Opts,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G),
|
||||
|
|
@ -735,7 +787,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
),
|
||||
'$absolute_file_names'(Solutions, FileNames, FErrors, TrueFileName, File, G).
|
||||
|
||||
'$absolute_file_names'(Solutions, [], error, _, File, G) :- !,
|
||||
'$absolute_file_names'(_Solutions, [], error, _, File, G) :- !,
|
||||
'$do_error'(existence_error(file,File),G).
|
||||
'$absolute_file_names'(Solutions, FileNames, _, TrueFileName, _, _) :-
|
||||
lists:member(TrueFileName, FileNames),
|
||||
|
|
@ -748,7 +800,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
'$process_fn_opts'([Opt|Opts],Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G),
|
||||
'$process_fn_opts'(Opts,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G).
|
||||
'$process_fn_opts'(Opts,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$process_fn_opts'(Opts,_Extensions,_RelTo,_Type,_Access,_FErrors,_Solutions,_Expand,_Debug,G) :- !,
|
||||
'$do_error'(type_error(list,Opts),G).
|
||||
|
||||
'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- var(Opt), !,
|
||||
|
|
@ -783,7 +835,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
|
||||
'$check_atom'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_atom'(A,G) :- atom(A), !.
|
||||
'$check_atom'(A,_G) :- atom(A), !.
|
||||
'$check_atom'(T,G) :- !,
|
||||
'$do_error'(type_error(atom,T),G).
|
||||
|
||||
|
|
@ -834,7 +886,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
% all must try search in path
|
||||
'$find_in_path'(user,_,user_input, _) :- !.
|
||||
'$find_in_path'(user_input,_,user_input, _) :- !.
|
||||
'$find_in_path'(commons(F0),_,_, _) :-
|
||||
'$find_in_path'(commons(D),_,_, _) :-
|
||||
% make sure library_directory is open.
|
||||
\+ clause(user:commons_directory(_),_),
|
||||
'$system_commons_directories'(D),
|
||||
|
|
@ -873,7 +925,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
|
||||
'$get_abs_file'(File,opts(_,RelTo,_,_,_,Expand,_),AbsFile) :-
|
||||
(
|
||||
nonvar(Relto)
|
||||
nonvar(RelTo)
|
||||
->
|
||||
'$dir_separator'(D),
|
||||
atom_concat([RelTo, D, File], ActualFile)
|
||||
|
|
@ -899,7 +951,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
'$add_type_extensions'(Type, File, F0),
|
||||
'$check_file'(F0, Type, Access, F).
|
||||
|
||||
'$check_file'(F, Type, none, F) :- !.
|
||||
'$check_file'(F, _Type, none, F) :- !.
|
||||
'$check_file'(F0, Type, Access, F0) :-
|
||||
access_file(F0, Access),
|
||||
(Type == directory
|
||||
|
|
@ -947,7 +999,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
user:file_search_path(Name, Dir),
|
||||
'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
|
||||
|
||||
'$extend_pathd'(Dir, A, File, Opts, NewFile, Call) :-
|
||||
'$extend_pathd'(Dir, A, File, Opts, NewFile, Goal) :-
|
||||
atom(Dir), !,
|
||||
'$add_file_to_dir'(Dir,A,File,NFile),
|
||||
'$find_in_path'(NFile, Opts, NewFile, Goal), !.
|
||||
|
|
@ -966,7 +1018,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
% This is complicated because of embedded ifs.
|
||||
%
|
||||
'$if'(_,top) :- !, fail.
|
||||
'$if'(Goal,_) :-
|
||||
'$if'(_Goal,_) :-
|
||||
'$get_if'(Level0),
|
||||
Level is Level0 + 1,
|
||||
nb_setval('$if_level',Level),
|
||||
|
|
@ -975,7 +1027,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
nb_setval('$endif',elif(Level,OldEndif,Mode)),
|
||||
fail.
|
||||
% we are in skip mode, ignore....
|
||||
'$if'(Goal,_) :-
|
||||
'$if'(_Goal,_) :-
|
||||
'$nb_getval'('$endif',elif(Level, OldEndif, skip), fail), !,
|
||||
nb_setval('$endif',endif(Level, OldEndif, skip)).
|
||||
% we are in non skip mode, check....
|
||||
|
|
@ -1078,7 +1130,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
'$fetch_comp_status'(compact).
|
||||
|
||||
make :-
|
||||
recorded('$lf_loaded','$lf_loaded'(F1,M,reconsult,_,_,_,_),_),
|
||||
recorded('$lf_loaded','$lf_loaded'(F1,_M,reconsult,_,_,_,_),_),
|
||||
'$load_files'(F1, [if(changed)],make),
|
||||
fail.
|
||||
make.
|
||||
|
|
@ -1097,14 +1149,14 @@ make_library_index(_Directory).
|
|||
|
||||
'$require'(_Ps, _M).
|
||||
|
||||
'$store_clause'('$source_location'(File, Line):Clause, File) :-
|
||||
'$store_clause'('$source_location'(File, _Line):Clause, File) :-
|
||||
assert_static(Clause).
|
||||
|
||||
|
||||
'$set_current_loop_stream'(OldStream, Stream) :-
|
||||
'$current_loop_stream'(OldStream), !,
|
||||
'$new_loop_stream'(Stream).
|
||||
'$set_current_loop_stream'(OldStream, Stream) :-
|
||||
'$set_current_loop_stream'(_OldStream, Stream) :-
|
||||
'$new_loop_stream'(Stream).
|
||||
|
||||
'$new_loop_stream'(Stream) :-
|
||||
|
|
@ -1118,7 +1170,7 @@ make_library_index(_Directory).
|
|||
'$nb_getval'('$loop_stream',Stream, fail).
|
||||
|
||||
exists_source(File) :-
|
||||
'$full_filename'(File, AbsFile, exists_source(File)).
|
||||
'$full_filename'(File, _AbsFile, exists_source(File)).
|
||||
|
||||
% reload_file(File) :-
|
||||
% ' $source_base_name'(File, Compile),
|
||||
|
|
|
|||
|
|
@ -118,15 +118,15 @@
|
|||
'$exec_directive'(reconsult(Fs), _, M, _, _) :-
|
||||
'$load_files'(M:Fs, [], reconsult(Fs)).
|
||||
'$exec_directive'(consult(Fs), _, M, _, _) :-
|
||||
'$consult'(Fs, M).
|
||||
'$load_files'(M:Fs, [consult(consult)], consult(Fs)).
|
||||
'$exec_directive'(use_module(F), _, M, _, _) :-
|
||||
'$load_files'(M:F, [if(not_loaded)],use_module(F)).
|
||||
'$load_files'(M:F, [if(not_loaded),must_be_module(true)],use_module(F)).
|
||||
'$exec_directive'(reexport(F), _, M, _, _) :-
|
||||
'$reexport'(F, all, M).
|
||||
'$load_files'(M:F, [if(not_loaded), silent(true), reexport(true),must_be_module(true)], reexport(F)).
|
||||
'$exec_directive'(reexport(F,Spec), _, M, _, _) :-
|
||||
'$reexport'(F, Spec, M).
|
||||
'$load_files'(M:F, [if(changed), silent(true), imports(Spec), reexport(true),must_be_module(true)], reexport(F, Spec)).
|
||||
'$exec_directive'(use_module(F,Is), _, M, _, _) :-
|
||||
'$load_files'(M:F, [if(not_loaded),imports(Is)],use_module(F,Is)).
|
||||
'$load_files'(M:F, [if(not_loaded),imports(Is),must_be_module(true)],use_module(F,Is)).
|
||||
'$exec_directive'(use_module(Mod,F,Is), _, _, _, _) :-
|
||||
'$use_module'(Mod,F,Is).
|
||||
'$exec_directive'(block(BlockSpec), _, _, _, _) :-
|
||||
|
|
|
|||
339
pl/modules.yap
339
pl/modules.yap
|
|
@ -71,34 +71,24 @@ module(N) :-
|
|||
module(N) :-
|
||||
'$do_error'(type_error(atom,N),module(N)).
|
||||
|
||||
'$module_dec'(N,P) :-
|
||||
'$module_dec'(N, Ps) :-
|
||||
'$current_module'(_,N),
|
||||
source_location(F, _),
|
||||
'$add_module_on_file'(N, F, P).
|
||||
'$add_module_on_file'(N, F, Ps).
|
||||
|
||||
'$add_module_on_file'(Mod, F, Exports) :-
|
||||
recorded('$module','$module'(F0,Mod,_),R), !,
|
||||
'$add_preexisting_module_on_file'(F, F0, Mod, Exports, R).
|
||||
'$add_module_on_file'(Mod, F, Exports) :-
|
||||
'$process_exports'(Exports,Mod,ExportedPreds),
|
||||
recorda('$module','$module'(F,Mod,ExportedPreds),_).
|
||||
|
||||
'$process_exports'([],_,[]).
|
||||
'$process_exports'([Name/Arity|Exports],Mod,[Name/Arity|ExportedPreds]):- !,
|
||||
'$process_exports'(Exports,Mod,ExportedPreds).
|
||||
'$process_exports'([Name//Arity|Exports],Mod,[Name/Arity2|ExportedPreds]):- !,
|
||||
Arity2 is Arity+2,
|
||||
'$process_exports'(Exports,Mod,ExportedPreds).
|
||||
'$process_exports'([op(Prio,Assoc,Name)|Exports],Mod,ExportedPreds) :- !,
|
||||
op(Prio,Assoc,prolog:Name),
|
||||
'$process_exports'(Exports,Mod,ExportedPreds).
|
||||
'$process_exports'([Trash|_],Mod,_) :-
|
||||
'$do_error'(type_error(predicate_indicator,Trash),module(Mod,[Trash])).
|
||||
'$add_module_on_file'(Module, F, Exports) :-
|
||||
'$convert_for_export'(all, Exports, Module, Module, TranslationTab, AllExports0, load_files),
|
||||
'$add_to_imports'(TranslationTab, Module, Module), % insert ops, at least for now
|
||||
sort( AllExports0, AllExports ),
|
||||
recorda('$module','$module'(F,Module,AllExports),_).
|
||||
|
||||
% redefining a previously-defined file, no problem.
|
||||
'$add_preexisting_module_on_file'(F, F, Mod, Exports, R) :- !,
|
||||
erase(R),
|
||||
( recorded('$import','$impovrt'(Mod,_,_,_,_,_),R), erase(R), fail; true),
|
||||
( recorded('$import','$import'(Mod,_,_,_,_,_),R), erase(R), fail; true),
|
||||
recorda('$module','$module'(F,Mod,Exports),_).
|
||||
'$add_preexisting_module_on_file'(F,F0,Mod,Exports,R) :-
|
||||
repeat,
|
||||
|
|
@ -117,88 +107,12 @@ module(N) :-
|
|||
repeat,
|
||||
get0(C),
|
||||
'$skipeol'(C),
|
||||
(C is "y" ; C is "n" ; C is "h", halt ; format(user_error, ' Please answer with ''y'', ''n'' or ''h'' ', []), fail), !.
|
||||
(C is "y" -> true ; C is "n" -> true ; C is "h" -> true ; C is "e" -> halt(1) ; format(user_error, ' Please answer with ''y'', ''n'', ''e'' or ''h'' ', []), fail), !.
|
||||
'$mod_scan'(C) :- C is "n".
|
||||
|
||||
'$import'([],_,_) :- !.
|
||||
'$import'([N/K|L],M,T) :-
|
||||
integer(K), atom(N), !,
|
||||
'$do_import'(N, K, M, T),
|
||||
'$import'(L,M,T).
|
||||
'$import'([N//K|L],M,T) :-
|
||||
integer(K), atom(N), !,
|
||||
N1 is N+2,
|
||||
'$do_import'(N1, K, M, T),
|
||||
'$import'(L,M,T).
|
||||
'$import'([PS|L],_,_) :-
|
||||
'$do_error'(domain_error(predicate_spec,PS),import([PS|L])).
|
||||
|
||||
'$use_preds'(Imports,Publics,Mod,M) :- var(Imports), !,
|
||||
'$import'(Publics,Mod,M).
|
||||
'$use_preds'(M:L,Publics,Mod,_) :-
|
||||
'$use_preds'(L,Publics,Mod,M).
|
||||
'$use_preds'([],_,_,_) :- !.
|
||||
'$use_preds'([P|Ps],Publics,Mod,M) :- !,
|
||||
'$use_preds'(P,Publics,Mod,M),
|
||||
'$use_preds'(Ps,Publics,Mod,M).
|
||||
'$use_preds'(N/K,Publics,M,Mod) :-
|
||||
( lists:memberchk(N/K,Publics) ->
|
||||
true ;
|
||||
print_message(warning,import(N/K,Mod,M,private))
|
||||
),
|
||||
'$do_import'(N, K, M, Mod).
|
||||
'$use_preds'(N//K0,Publics,M,Mod) :-
|
||||
K is K0+2,
|
||||
( lists:memberchk(N/K,Publics) -> true ;
|
||||
print_message(warning,import(N/K,Mod,M,private))
|
||||
),
|
||||
'$do_import'(N, K, M, Mod).
|
||||
|
||||
|
||||
%
|
||||
% ignore imports that we do export
|
||||
%
|
||||
'$do_import'(N, K, M, T) :-
|
||||
recorded('$module','$module'(_F, T, MyExports),_),
|
||||
once(lists:member(N/K, MyExports)),
|
||||
functor(S, N, K),
|
||||
% reexport predicates if they are undefined in the current module.
|
||||
\+ '$undefined'(S, T), !.
|
||||
'$do_import'(N, K, M, T) :-
|
||||
functor(G,N,K),
|
||||
'$follow_import_chain'(M,G,M0,G0),
|
||||
functor(G0,N1,K),
|
||||
( '$check_import'(M0,T,N1,K) ->
|
||||
( T = user ->
|
||||
( recordzifnot('$import','$import'(M0,user,G0,G,N,K),_) -> true ; true)
|
||||
;
|
||||
( recordaifnot('$import','$import'(M0,T,G0,G,N,K),_) -> true ; true )
|
||||
)
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
'$follow_import_chain'(M,G,M0,G0) :-
|
||||
recorded('$import','$import'(M1,M,G1,G,_,_),_), M \= M1, !,
|
||||
'$follow_import_chain'(M1,G1,M0,G0).
|
||||
'$follow_import_chain'(M,G,M,G).
|
||||
|
||||
'$check_import'(M,T,N,K) :-
|
||||
recorded('$import','$import'(MI,T,_,_,N,K),_R),
|
||||
% dereference MI to M1, in order to find who
|
||||
% is actually generating
|
||||
( '$module_produced by'(M1,MI,N,K) -> true ; MI = M1 ),
|
||||
( '$module_produced by'(M2,M,N,K) -> true ; M = M2 ),
|
||||
M2 \= M1, !,
|
||||
format(user_error,'NAME CLASH: ~w was already imported to module ~w;~n',[M1:N/K,M2]),
|
||||
format(user_error,' Do you want to import it from ~w ? [y, n or h] ',M),
|
||||
'$mod_scan'(C),
|
||||
C =:= "y".
|
||||
'$check_import'(_,_,_,_).
|
||||
|
||||
'$module_produced by'(M,M0,N,K) :-
|
||||
'$module_produced by'(M, M0, N, K) :-
|
||||
recorded('$import','$import'(M,M0,_,_,N,K),_), !.
|
||||
'$module_produced by'(M,M0,N,K) :-
|
||||
'$module_produced by'(M, M0, N, K) :-
|
||||
recorded('$import','$import'(MI,M0,G1,_,N,K),_),
|
||||
functor(G1, N1, K1),
|
||||
'$module_produced by'(M,MI,N1,K1).
|
||||
|
|
@ -315,7 +229,7 @@ module(N) :-
|
|||
% if I don't know what the module is, I cannot do anything to the goal,
|
||||
% so I just put a call for later on.
|
||||
'$module_expansion'(M:G,call(M:G),'$execute_wo_mod'(G,M),_,_,_,_) :- var(M), !.
|
||||
'$module_expansion'(M:G,G1,GO,_,CM,_,HVars) :- !,
|
||||
'$module_expansion'(M:G,G1,GO,_,_CM,HM,HVars) :- !,
|
||||
'$module_expansion'(G,G1,GO,M,M,HM,HVars).
|
||||
'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :-
|
||||
% is this imported from some other module M1?
|
||||
|
|
@ -334,11 +248,11 @@ expand_goal(M:G, M:NG) :-
|
|||
'$do_expand'(G, M, NG), !.
|
||||
expand_goal(G, NG) :-
|
||||
'$current_module'(Mod),
|
||||
'$do_expand'(G, M, NG), !.
|
||||
'$do_expand'(G, Mod, NG), !.
|
||||
expand_goal(G, G).
|
||||
|
||||
'$do_expand'(G, _, G) :- var(G), !.
|
||||
'$do_expand'(M:G, CurMod, M:GI) :- !,
|
||||
'$do_expand'(M:G, _CurMod, M:GI) :- !,
|
||||
'$do_expand'(G, M, GI).
|
||||
'$do_expand'(G, CurMod, GI) :-
|
||||
(
|
||||
|
|
@ -387,7 +301,7 @@ expand_goal(G, G).
|
|||
'$do_expand'(G, CurMod, GI),
|
||||
GI \== G, !,
|
||||
'$module_expansion'(GI, G1, GO, CurMod, MM, HM, HVars).
|
||||
'$complete_goal_expansion'(G, M, CM, HM, G1, G2, HVars) :-
|
||||
'$complete_goal_expansion'(G, M, _CM, HM, G1, G2, _HVars) :-
|
||||
'$all_system_predicate'(G,M,ORIG), !,
|
||||
% make built-in processing transparent.
|
||||
'$match_mod'(G, M, ORIG, HM, G1),
|
||||
|
|
@ -412,7 +326,7 @@ expand_goal(G, G).
|
|||
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
|
||||
ExportingMod \= ImportingMod, !,
|
||||
'$exit_undefp'.
|
||||
'$imported_pred'(G, ImportingMod, _, _) :-
|
||||
'$imported_pred'(_G, _ImportingMod, _, _) :-
|
||||
'$exit_undefp',
|
||||
fail.
|
||||
|
||||
|
|
@ -420,7 +334,7 @@ expand_goal(G, G).
|
|||
recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_),
|
||||
'$continue_imported'(ExportingMod, ExportingModI, G0, G0I), !.
|
||||
% SWI builtin
|
||||
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
|
||||
'$get_undefined_pred'(G, _ImportingMod, G0, ExportingMod) :-
|
||||
recorded('$dialect',Dialect,_),
|
||||
Dialect \= yap,
|
||||
functor(G, Name, Arity),
|
||||
|
|
@ -479,7 +393,7 @@ expand_goal(G, G).
|
|||
NFlags is Fl \/ 0x200004,
|
||||
'$flags'(P, M, Fl, NFlags).
|
||||
|
||||
'$is_mt'(M, H0, B, (context_module(CM),B), CM) :-
|
||||
'$is_mt'(M, H, B, (context_module(CM),B), CM) :-
|
||||
'$module_transparent'(_, M, _, H), !.
|
||||
'$is_mt'(M, _, B, B, M).
|
||||
|
||||
|
|
@ -737,67 +651,168 @@ export_resource(Resource) :-
|
|||
|
||||
export_list(Module, List) :-
|
||||
recorded('$module','$module'(_,Module,List),_).
|
||||
|
||||
|
||||
'$reexport'(ModuleSource, Spec, Module) :-
|
||||
source_location(CurrentFile, _),
|
||||
(
|
||||
Spec == all
|
||||
'$convert_for_export'(all, Exports, _Module, _ContextModule, Tab, Exports, _) :-
|
||||
'$simple_conversion'(Exports, Tab).
|
||||
'$convert_for_export'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal) :-
|
||||
'$clean_conversion'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal).
|
||||
'$convert_for_export'(except(Excepts), Exports, Module, ContextModule, Tab, MyExports, Goal) :-
|
||||
'$neg_conversion'(Excepts, Exports, Module, ContextModule, MyExports, Goal),
|
||||
'$simple_conversion'(MyExports, Tab).
|
||||
|
||||
'$simple_conversion'([], []).
|
||||
'$simple_conversion'([F/N|Exports], [F/N-F/N|Tab]) :-
|
||||
'$simple_conversion'(Exports, Tab).
|
||||
'$simple_conversion'([F//N|Exports], [F/N2-F/N2|Tab]) :-
|
||||
N2 is N+1,
|
||||
'$simple_conversion'(Exports, Tab).
|
||||
'$simple_conversion'([F/N as NF|Exports], [F/N-NF/N|Tab]) :-
|
||||
'$simple_conversion'(Exports, Tab).
|
||||
'$simple_conversion'([F//N as BF|Exports], [F/N2-NF/N2|Tab]) :-
|
||||
N2 is N+1,
|
||||
'$simple_conversion'(Exports, Tab).
|
||||
'$simple_conversion'([op(Prio,Assoc,Name)|Exports], [op(Prio,Assoc,Name)|Tab]) :-
|
||||
'$simple_conversion'(Exports, Tab).
|
||||
|
||||
'$clean_conversion'([], _, _, _, [], [], _).
|
||||
'$clean_conversion'([(N1/A1 as N2)|Ps], List, Module, ContextModule, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :- !,
|
||||
( lists:memberchk(N1/A1, List)
|
||||
->
|
||||
Goal = reexport(ModuleSource)
|
||||
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal)
|
||||
;
|
||||
Goal = reexport(ModuleSource,Spec)
|
||||
),
|
||||
absolute_file_name(ModuleSource, File, [access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)]),
|
||||
'$load_files'(File, [if(not_loaded),silent(true), imports(Spec)], Goal),
|
||||
recorded('$module', '$module'(FullFile, Mod, Exports),_),
|
||||
atom_concat(File, _, FullFile), !,
|
||||
'$convert_for_reexport'(Spec, Exports, Tab, MyExports, Goal),
|
||||
'$add_to_imports'(Tab, Module, Mod),
|
||||
recorded('$module', '$module'(CurrentFile, Module, ModExports), Ref),
|
||||
erase(Ref),
|
||||
lists:append(ModExports, MyExports, AllExports),
|
||||
recorda('$module', '$module'(CurrentFile, Module, AllExports), _),
|
||||
'$import'(MyExports, Module, TopModule).
|
||||
'$bad_export'(N1/A1, Module, ContextModule)
|
||||
).
|
||||
'$clean_conversion'([N1/A1|Ps], List, Module, ContextModule, [N1/A1-N1/A1|Tab], [N1/A1|MyExports], Goal) :- !,
|
||||
(
|
||||
lists:memberchk(N1/A1, List)
|
||||
->
|
||||
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal)
|
||||
;
|
||||
'$bad_export'(N1/A1, Module, ContextModule)
|
||||
).
|
||||
'$clean_conversion'([N1//A1|Ps], List, Module, ContextModule, [N1/A2-N1/A2|Tab], [P1|MyExports], Goal) :- !,
|
||||
A2 is A1+2,
|
||||
(
|
||||
lists:memberchk(N1/A2, List)
|
||||
->
|
||||
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal)
|
||||
;
|
||||
'$bad_export'(N1//A1, Module, ContextModule)
|
||||
).
|
||||
'$clean_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|MyExports], Goal) :- !,
|
||||
(
|
||||
lists:memberchk(op(Prio,Assoc,Name), List)
|
||||
->
|
||||
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal)
|
||||
;
|
||||
'$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
|
||||
).
|
||||
'$clean_conversion'([P|_], _List, _, _, _, _, Goal) :-
|
||||
'$do_error'(domain_error(module_export_predicates,P), Goal).
|
||||
|
||||
'$convert_for_reexport'(all, Exports, Tab, MyExports, _) :-
|
||||
'$simple_conversion'(Exports, Tab, MyExports).
|
||||
'$convert_for_reexport'([P1|Ps], Exports, Tab, MyExports, Goal) :-
|
||||
'$clean_conversion'([P1|Ps], Exports, Tab, MyExports, Goal).
|
||||
'$convert_for_reexport'(except(List), Exports, Tab, MyExports, Goal) :-
|
||||
'$neg_conversion'(Exports, List, Tab, MyExports, Goal).
|
||||
'$bad_export'(_, _Module, _ContextModule) :- !.
|
||||
'$bad_export'(Name/Arity, Module, ContextModule) :-
|
||||
functor(P, Name, Arity),
|
||||
predicate_property(Module:P, _), !,
|
||||
print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
|
||||
'$bad_export'(Name//Arity, Module, ContextModule) :-
|
||||
Arity2 is Arity+2,
|
||||
functor(P, Name, Arity2),
|
||||
predicate_property(Module:P, _), !,
|
||||
print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
|
||||
'$bad_export'(Indicator, Module, ContextModule) :- !,
|
||||
print_message(warning, declaration( Indicator, Module, ContextModule, undefined)).
|
||||
|
||||
'$simple_conversion'([], [], []).
|
||||
'$simple_conversion'([P|Exports], [P-P|Tab], [P|MyExports]) :-
|
||||
'$simple_conversion'(Exports, Tab, MyExports).
|
||||
'$neg_conversion'([], Exports, _, _, Exports, _).
|
||||
'$neg_conversion'([N1/A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
|
||||
(
|
||||
lists:delete(List, N1/A1, RList)
|
||||
->
|
||||
'$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
|
||||
;
|
||||
'$bad_export'(N1/A1, Module, ContextModule)
|
||||
).
|
||||
'$neg_conversion'([N1//A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
|
||||
A2 is A1+2,
|
||||
(
|
||||
lists:delete(List, N1/A2, RList)
|
||||
->
|
||||
'$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
|
||||
;
|
||||
'$bad_export'(N1//A1, Module, ContextModule)
|
||||
).
|
||||
'$neg_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
|
||||
(
|
||||
lists:delete(List, op(Prio,Assoc,Name), RList)
|
||||
->
|
||||
'$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
|
||||
;
|
||||
'$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
|
||||
).
|
||||
'$clean_conversion'([P|_], _List, _, _, _, Goal) :-
|
||||
'$do_error'(domain_error(module_export_predicates,P), Goal).
|
||||
|
||||
'$clean_conversion'([], _, [], [], _).
|
||||
'$clean_conversion'([P1|Ps], List, [P1-P1|Tab], [P1|MyExports], Goal) :-
|
||||
lists:memberchk(P1, List), !,
|
||||
'$clean_conversion'(Ps, List, Tab, MyExports, Goal).
|
||||
'$clean_conversion'([(N1/A1 as N2)|Ps], List, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :-
|
||||
lists:memberchk(N1/A1, List), !,
|
||||
'$clean_conversion'(Ps, List, Tab, MyExports, Goal).
|
||||
'$clean_conversion'([P|_], _List, _, _, Goal) :-
|
||||
'$do_error'(domain_error(module_reexport_predicates,P), Goal).
|
||||
|
||||
'$neg_conversion'([], _, [], [], _).
|
||||
'$neg_conversion'([P1|Ps], List, Tab, MyExports, Goal) :-
|
||||
lists:memberchk(P1, List), !,
|
||||
'$neg_conversion'(Ps, List, Tab, MyExports, Goal).
|
||||
'$neg_conversion'([N1/A1|Ps], List, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :-
|
||||
lists:memberchk(N1/A1 as N2, List), !,
|
||||
'$neg_conversion'(Ps, List, Tab, MyExports, Goal).
|
||||
'$neg_conversion'([P|Ps], List, [P-P|Tab], [P|MyExports], Goal) :-
|
||||
'$neg_conversion'(Ps, List, Tab, MyExports, Goal).
|
||||
|
||||
'$add_to_imports'([], _, _).
|
||||
'$add_to_imports'([N0/K0-N1/K1|Tab], Mod, ModR) :-
|
||||
functor(G,N0,K0),
|
||||
G=..[N0|Args],
|
||||
% no need to import from the actual module
|
||||
'$add_to_imports'([T|Tab], Module, ContextModule) :-
|
||||
'$do_import'(T, Module, ContextModule),
|
||||
'$add_to_imports'(Tab, Module, ContextModule).
|
||||
|
||||
'$do_import'(op(Prio,Assoc,Name), _Mod, ContextMod) :-
|
||||
op(Prio,Assoc,ContextMod:Name).
|
||||
'$do_import'(N0/K0-N0/K0, Mod, Mod) :- !.
|
||||
'$do_import'(_N/K-N1/K, _Mod, ContextMod) :-
|
||||
recorded('$module','$module'(_F, ContextMod, MyExports),_),
|
||||
once(lists:member(N1/K, MyExports)),
|
||||
functor(S, N1, K),
|
||||
% reexport predicates if they are undefined in the current module.
|
||||
\+ '$undefined'(S,ContextMod), !.
|
||||
'$do_import'( N/K-N1/K, Mod, ContextMod) :-
|
||||
functor(G,N,K),
|
||||
'$follow_import_chain'(Mod,G,M0,G0),
|
||||
G0=..[N0|Args],
|
||||
G1=..[N1|Args],
|
||||
( recordaifnot('$import','$import'(ModR,Mod,G,G1,N0,K0),_) -> true ; true ),
|
||||
'$add_to_imports'(Tab, Mod, ModR).
|
||||
( '$check_import'(M0,ContextMod,N1,K) ->
|
||||
( ContextMod = user ->
|
||||
( recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_) -> true ; true)
|
||||
;
|
||||
( recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_) -> true ; true )
|
||||
)
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
'$follow_import_chain'(M,G,M0,G0) :-
|
||||
recorded('$import','$import'(M1,M,G1,G,_,_),_), M \= M1, !,
|
||||
'$follow_import_chain'(M1,G1,M0,G0).
|
||||
'$follow_import_chain'(M,G,M,G).
|
||||
|
||||
% trying to import Mod:N/K into ContextM
|
||||
'$check_import'(Mod, ContextM, N, K) :-
|
||||
recorded('$import','$import'(MI, ContextM, _, _, N,K),_R),
|
||||
% dereference MI to M1, in order to find who
|
||||
% is actually generating
|
||||
( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ),
|
||||
( '$module_produced by'(M2, Mod, N, K) -> true ; M = M2 ),
|
||||
M2 \= M1, !,
|
||||
b_getval('$lf_status', TOpts),
|
||||
'$lf_opt'(redefine_module, TOpts, Action),
|
||||
'$redefine_action'(Action, M1, M2, M, N/K).
|
||||
'$check_import'(_,_,_,_).
|
||||
|
||||
'$redefine_action'(ask, M1, M2, M, N/K) :-
|
||||
stream_property(user_input,tty(true)), !,
|
||||
format(user_error,'NAME CLASH: ~w was already imported to module ~w;~n',[M1:N/K,M2]),
|
||||
format(user_error,' Do you want to import it from ~w ? [y, n, e or h] ',M),
|
||||
'$mod_scan'(C),
|
||||
( C =:= 0'e -> halt(1) ;
|
||||
C =:= 0'y ).
|
||||
'$redefine_action'(true, M1, _, _, _) :- !,
|
||||
recorded('$module','$module'(F, M1, _MyExports),_),
|
||||
unload_file(F).
|
||||
'$redefine_action'(false, M1,M2, M, N/K) :-
|
||||
'$do_error'(permission_error(import,M1:N/K,redefined,M2),module(M)).
|
||||
|
||||
% I assume the clause has been processed, so the
|
||||
% var case is long gone! Yes :)
|
||||
|
|
@ -831,7 +846,7 @@ set_base_module(ExportingModule) :-
|
|||
set_base_module(ExportingModule) :-
|
||||
atom(ExportingModule), !,
|
||||
'$current_module'(Mod),
|
||||
retractall(prolog:'$parent_module'(Mod,_)),
|
||||
retractall(prolg:'$parent_module'(Mod,_)),
|
||||
asserta(prolog:'$parent_module'(Mod,ExportingModule)).
|
||||
set_base_module(ExportingModule) :-
|
||||
'$do_error'(type_error(atom,ExportingModule),set_base_module(ExportingModule)).
|
||||
|
|
@ -897,7 +912,7 @@ Start a new (source-)module
|
|||
@param Line is the line-number of the :- module/2 directive.
|
||||
@param Redefine If =true=, allow associating the module to a new file
|
||||
*/
|
||||
'$declare_module'(Name, _Test, Context, _File, _Line, _) :-
|
||||
'$declare_module'(Name, _Test, Context, _File, _Line) :-
|
||||
add_import_module(Name, Context, start).
|
||||
|
||||
module_property(Mod, file(F)) :-
|
||||
|
|
@ -905,3 +920,11 @@ module_property(Mod, file(F)) :-
|
|||
module_property(Mod, exports(Es)) :-
|
||||
recorded('$module','$module'(_,Mod,Es),_).
|
||||
|
||||
ls_imports :-
|
||||
recorded('$import','$import'(M0,M,G0,G,_N,_K),_R),
|
||||
numbervars(G0+G, 0, _),
|
||||
format('~a:~w <- ~a:~w~n', [M, G, M0, G0]),
|
||||
fail.
|
||||
ls_imports.
|
||||
|
||||
|
||||
|
|
|
|||
Reference in New Issue