qload/qsave implementation.

This commit is contained in:
Vítor Santos Costa 2014-10-02 14:57:50 +01:00
parent ef479f00dc
commit 80faee6824
7 changed files with 412 additions and 162 deletions

View File

@ -44,7 +44,8 @@ typedef enum {
BAD_ATOM = 8, BAD_ATOM = 8,
MISMATCH = 9, MISMATCH = 9,
INCONSISTENT_CPRED = 10, INCONSISTENT_CPRED = 10,
BAD_READ = 11 BAD_READ = 11,
BAD_HEADER = 12
} qlfr_err_t; } qlfr_err_t;
static char * static char *
@ -77,7 +78,7 @@ static void
QLYR_ERROR(qlfr_err_t my_err) QLYR_ERROR(qlfr_err_t my_err)
{ {
Yap_Error(SAVED_STATE_ERROR,TermNil,"error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]); Yap_Error(SAVED_STATE_ERROR,TermNil,"error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]);
exit(1); Yap_exit(1);
} }
static Atom static Atom
@ -691,11 +692,56 @@ read_tag(IOSTREAM *stream)
return ch; return ch;
} }
static void static bool
read_header(IOSTREAM *stream) checkChars(IOSTREAM *stream, char s[])
{ {
int ch; int ch, c;
char *p = s;
while ((ch = *p++)) {
if ((c = read_byte(stream)) != ch ) {
return false;
}
}
return TRUE;
}
static Atom
get_header(IOSTREAM *stream)
{
char s[256], *p = s, ch;
Atom at;
if (!checkChars( stream, "#!/bin/sh\nexec_dir=${YAPBINDIR:-" ))
return NIL;
while ((ch = read_byte(stream)) != '\n');
if (!checkChars( stream, "exec $exec_dir/yap $0 \"$@\"\nsaved " ))
return NIL;
while ((ch = read_byte(stream)) != ',')
*p++ = ch;
*p++ = '\0';
at = Yap_LookupAtom( s );
while ((ch = read_byte(stream))); while ((ch = read_byte(stream)));
return at;
}
static Int
p_get_header( USES_REGS1 )
{
IOSTREAM *stream;
Term t1 = Deref(ARG1);
Atom at;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3");
return FALSE;
}
if (!(stream = Yap_GetInputStream(AtomOfTerm(t1))) ) {
return FALSE;
}
if ((at = get_header( stream )) == NIL)
return FALSE;
return Yap_unify( ARG2, MkAtomTerm( at ) );
} }
static void static void
@ -801,6 +847,7 @@ ReadHash(IOSTREAM *stream)
pe = RepPredProp(PredPropByAtomAndMod(a,mod)); pe = RepPredProp(PredPropByAtomAndMod(a,mod));
} }
} else { } else {
/* IDB */
if (arity == (UInt)-1) { if (arity == (UInt)-1) {
UInt i = read_UInt(stream); UInt i = read_UInt(stream);
pe = Yap_FindLUIntKey(i); pe = Yap_FindLUIntKey(i);
@ -808,12 +855,18 @@ ReadHash(IOSTREAM *stream)
Atom oa = (Atom)read_UInt(stream); Atom oa = (Atom)read_UInt(stream);
Atom a = LookupAtom(oa); Atom a = LookupAtom(oa);
pe = RepPredProp(PredPropByAtomAndMod(a,mod)); pe = RepPredProp(PredPropByAtomAndMod(a,mod));
pe->PredFlags |= AtomDBPredFlag;
} else { } else {
Functor of = (Functor)read_UInt(stream); Functor of = (Functor)read_UInt(stream);
Functor f = LookupFunctor(of); Functor f = LookupFunctor(of);
pe = RepPredProp(PredPropByFuncAndMod(f,mod)); pe = RepPredProp(PredPropByFuncAndMod(f,mod));
} }
pe->PredFlags |= LogUpdatePredFlag;
pe->ArityOfPE = 3; pe->ArityOfPE = 3;
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
pe->OpcodeOfPred = Yap_opcode(_op_fail);
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = FAILCODE;
}
} }
InsertPredEntry(ope, pe); InsertPredEntry(ope, pe);
} }
@ -959,7 +1012,10 @@ read_pred(IOSTREAM *stream, Term mod) {
if (ap->PredFlags & IndexedPredFlag) { if (ap->PredFlags & IndexedPredFlag) {
Yap_RemoveIndexation(ap); Yap_RemoveIndexation(ap);
} }
//if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE)
// printf(" %s/%ld\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE);
//else if (ap->ModuleOfPred != IDB_MODULE)
// printf(" %s/%ld\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE);
#if SIZEOF_INT_P==4 #if SIZEOF_INT_P==4
fl1 = flags & ((UInt)STATIC_PRED_FLAGS); fl1 = flags & ((UInt)STATIC_PRED_FLAGS);
ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS); ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS);
@ -1013,7 +1069,6 @@ static void
read_module(IOSTREAM *stream) { read_module(IOSTREAM *stream) {
qlf_tag_t x; qlf_tag_t x;
read_header(stream);
InitHash(); InitHash();
ReadHash(stream); ReadHash(stream);
while ((x = read_tag(stream)) == QLY_START_MODULE) { while ((x = read_tag(stream)) == QLY_START_MODULE) {
@ -1070,14 +1125,12 @@ p_read_program( USES_REGS1 )
Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3"); Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3");
return FALSE; return FALSE;
} }
if (!IsAtomTerm(t1)) { if ((stream = Yap_GetInputStream(AtomOfTerm(t1))) ) {
Yap_Error(TYPE_ERROR_ATOM,t1,"read_program/3");
return(FALSE);
}
if (!(stream = Yap_GetInputStream(AtomOfTerm(t1))) ) {
return FALSE; return FALSE;
} }
YAP_Reset( YAP_RESET_FROM_RESTORE ); YAP_Reset( YAP_RESET_FROM_RESTORE );
if (get_header( stream ) == NIL)
return FALSE;
read_module(stream); read_module(stream);
Sclose( stream ); Sclose( stream );
/* back to the top level we go */ /* back to the top level we go */
@ -1092,6 +1145,8 @@ Yap_Restore(char *s, char *lib_dir)
if (!stream) if (!stream)
return -1; return -1;
GLOBAL_RestoreFile = s; GLOBAL_RestoreFile = s;
if (get_header( stream ) == NIL)
return FALSE;
read_module(stream); read_module(stream);
Sclose( stream ); Sclose( stream );
GLOBAL_RestoreFile = NULL; GLOBAL_RestoreFile = NULL;
@ -1102,7 +1157,9 @@ Yap_Restore(char *s, char *lib_dir)
void Yap_InitQLYR(void) void Yap_InitQLYR(void)
{ {
Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds, SyncPredFlag|UserCPredFlag); Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds, SyncPredFlag|UserCPredFlag);
Yap_InitCPred("$qload_file_preds", 1, p_read_module_preds, SyncPredFlag|UserCPredFlag);
Yap_InitCPred("$qload_program", 1, p_read_program, SyncPredFlag|UserCPredFlag); Yap_InitCPred("$qload_program", 1, p_read_program, SyncPredFlag|UserCPredFlag);
Yap_InitCPred("$q_header", 2, p_get_header, SyncPredFlag|UserCPredFlag);
if (FALSE) { if (FALSE) {
restore_codes(); restore_codes();
} }

View File

@ -771,18 +771,18 @@ save_ops(IOSTREAM *stream, Term mod) {
} }
static int static int
save_header(IOSTREAM *stream) save_header(IOSTREAM *stream, char type[])
{ {
char msg[256]; char msg[256];
sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%s", YAP_BINDIR, YAP_FULL_VERSION); sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%s %s\n", YAP_BINDIR, type, YAP_FULL_VERSION);
return save_bytes(stream, msg, strlen(msg)+1); return save_bytes(stream, msg, strlen(msg)+1);
} }
static size_t static size_t
save_module(IOSTREAM *stream, Term mod) { save_module(IOSTREAM *stream, Term mod) {
PredEntry *ap = Yap_ModulePred(mod); PredEntry *ap = Yap_ModulePred(mod);
save_header( stream ); save_header( stream, "saved module," );
InitHash(); InitHash();
ModuleAdjust(mod); ModuleAdjust(mod);
while (ap) { while (ap) {
@ -813,7 +813,7 @@ save_program(IOSTREAM *stream) {
ModEntry *me = CurrentModules; ModEntry *me = CurrentModules;
InitHash(); InitHash();
save_header( stream ); save_header( stream, "saved state," );
/* should we allow the user to see hidden predicates? */ /* should we allow the user to see hidden predicates? */
while (me) { while (me) {
PredEntry *pp; PredEntry *pp;
@ -855,7 +855,7 @@ save_file(IOSTREAM *stream, Atom FileName) {
ModEntry *me = CurrentModules; ModEntry *me = CurrentModules;
InitHash(); InitHash();
save_header( stream ); save_header( stream, "saved file," );
/* should we allow the user to see hidden predicates? */ /* should we allow the user to see hidden predicates? */
while (me) { while (me) {
PredEntry *pp; PredEntry *pp;
@ -865,6 +865,7 @@ save_file(IOSTREAM *stream, Atom FileName) {
pp = PredEntryAdjust(pp); pp = PredEntryAdjust(pp);
if (pp && if (pp &&
!(pp->PredFlags & (MultiFileFlag|NumberDBPredFlag|AtomDBPredFlag|CPredFlag|AsmPredFlag|UserCPredFlag)) && !(pp->PredFlags & (MultiFileFlag|NumberDBPredFlag|AtomDBPredFlag|CPredFlag|AsmPredFlag|UserCPredFlag)) &&
pp->ModuleOfPred != IDB_MODULE &&
pp->src.OwnerFile == FileName) { pp->src.OwnerFile == FileName) {
CHECK(mark_pred(pp)); CHECK(mark_pred(pp));
} }
@ -883,8 +884,12 @@ save_file(IOSTREAM *stream, Atom FileName) {
CHECK(save_tag(stream, QLY_START_MODULE)); CHECK(save_tag(stream, QLY_START_MODULE));
CHECK(save_UInt(stream, (UInt)MkAtomTerm(me->AtomOfME))); CHECK(save_UInt(stream, (UInt)MkAtomTerm(me->AtomOfME)));
while (pp != NULL) { while (pp != NULL) {
if (pp &&
!(pp->PredFlags & (MultiFileFlag|NumberDBPredFlag|AtomDBPredFlag|CPredFlag|AsmPredFlag|UserCPredFlag)) &&
pp->src.OwnerFile == FileName) {
CHECK(save_tag(stream, QLY_START_PREDICATE)); CHECK(save_tag(stream, QLY_START_PREDICATE));
CHECK(save_pred(stream, pp)); CHECK(save_pred(stream, pp));
}
pp = pp->NextPredOfModule; pp = pp->NextPredOfModule;
} }
CHECK(save_tag(stream, QLY_END_PREDICATES)); CHECK(save_tag(stream, QLY_END_PREDICATES));
@ -966,9 +971,6 @@ p_save_file( USES_REGS1 )
if (!(stream = Yap_GetOutputStream(AtomOfTerm(t1))) ) { if (!(stream = Yap_GetOutputStream(AtomOfTerm(t1))) ) {
return FALSE; return FALSE;
} }
if (!(stream = Yap_GetOutputStream(AtomOfTerm(t1))) ) {
return FALSE;
}
if (IsVarTerm(tfile)) { if (IsVarTerm(tfile)) {
Yap_Error(INSTANTIATION_ERROR,tfile,"save_file/2"); Yap_Error(INSTANTIATION_ERROR,tfile,"save_file/2");
return FALSE; return FALSE;
@ -984,7 +986,7 @@ void Yap_InitQLY(void)
{ {
Yap_InitCPred("$qsave_module_preds", 2, p_save_module_preds, SyncPredFlag|UserCPredFlag); Yap_InitCPred("$qsave_module_preds", 2, p_save_module_preds, SyncPredFlag|UserCPredFlag);
Yap_InitCPred("$qsave_program", 1, p_save_program, SyncPredFlag|UserCPredFlag); Yap_InitCPred("$qsave_program", 1, p_save_program, SyncPredFlag|UserCPredFlag);
Yap_InitCPred("$qsave_file", 2, p_save_file, SyncPredFlag|UserCPredFlag); Yap_InitCPred("$qsave_file_preds", 2, p_save_file, SyncPredFlag|UserCPredFlag);
if (FALSE) { if (FALSE) {
restore_codes(); restore_codes();
} }

View File

@ -157,6 +157,23 @@ following flags:
If true, raise an error if the file is not a module file. Used by If true, raise an error if the file is not a module file. Used by
` use_module/1 and use_module/2. ` use_module/1 and use_module/2.
+ qcompile(+ _Value_)
SWI-Prolog flag that controls whether loaded files should be also
compiled into `qly` files. The default value is obtained from the flag
`qcompile`:
`never`, no `qly` file is generated unless the user calls
qsave_file/1 and friends, or sets the qcompile option in
load_files/2;
`auto`, all files are qcompiled.
`large`, files above 100KB are qcompiled.
`part`, not supported in YAP.
+ autoload(+ _Autoload_) + autoload(+ _Autoload_)
SWI-compatible option where if _Autoload_ is `true` undefined SWI-compatible option where if _Autoload_ is `true` undefined
@ -175,7 +192,7 @@ following flags:
% expand(true,false) % expand(true,false)
% if(changed,true,not_loaded) => implemented % if(changed,true,not_loaded) => implemented
% imports(all,List) => implemented % imports(all,List) => implemented
% qcompile(true,false) % qcompile() => implemented
% silent(true,false) => implemented % silent(true,false) => implemented
% stream(Stream) => implemented % stream(Stream) => implemented
% consult(consult,reconsult,exo,db) => implemented % consult(consult,reconsult,exo,db) => implemented
@ -191,7 +208,8 @@ load_files(Files,Opts) :-
'$lf_option'(expand, 4, false). '$lf_option'(expand, 4, false).
'$lf_option'(if, 5, true). '$lf_option'(if, 5, true).
'$lf_option'(imports, 6, all). '$lf_option'(imports, 6, all).
'$lf_option'(qcompile, 7, never). '$lf_option'(qcompile, 7, Current) :-
'$nb_getval'('$qcompile', Current, Current = never).
'$lf_option'(silent, 8, _). '$lf_option'(silent, 8, _).
'$lf_option'(skip_unix_header, 9, false). '$lf_option'(skip_unix_header, 9, false).
'$lf_option'(compilation_mode, 10, source). '$lf_option'(compilation_mode, 10, source).
@ -315,9 +333,11 @@ load_files(Files,Opts) :-
is_list(Val) -> ( ground(Val) -> true ; '$do_error'(instantiation_error,Call) ) ; is_list(Val) -> ( ground(Val) -> true ; '$do_error'(instantiation_error,Call) ) ;
'$do_error'(domain_error(unimplemented_option,imports(Val)),Call) ). '$do_error'(domain_error(unimplemented_option,imports(Val)),Call) ).
'$process_lf_opt'(qcompile, Val,Call) :- '$process_lf_opt'(qcompile, Val,Call) :-
( Val == true -> '$do_error'(domain_error(unimplemented_option,expand),Call) ; ( Val == part -> '$do_error'(domain_error(unimplemented_option,expand),Call) ;
Val == false -> true ; Val == never -> true ;
'$do_error'(domain_error(unimplemented_option,expand(Val)),Call) ). Val == auto -> true ;
Val == large -> true ;
'$do_error'(domain_error(unknown_option,qcompile(Val)),Call) ).
'$process_lf_opt'(silent, Val, Call) :- '$process_lf_opt'(silent, Val, Call) :-
( Val == false -> true ; ( Val == false -> true ;
Val == true -> true ; Val == true -> true ;
@ -395,6 +415,36 @@ load_files(Files,Opts) :-
'$lf'(user_input, Mod, _, TOpts) :- !, '$lf'(user_input, Mod, _, TOpts) :- !,
b_setval('$source_file', user_input), b_setval('$source_file', user_input),
'$do_lf'(Mod, user_input, user_input, TOpts). '$do_lf'(Mod, user_input, user_input, TOpts).
'$lf'(File, Mod, Call, TOpts) :-
'$lf_opt'(stream, TOpts, Stream),
var( Stream ),
H0 is heapused, '$cputime'(T0,_),
% check if there is a qly files
'$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F,load_files(File)),
open( F, read, Stream , [type(binary)] ),
( '$q_header'( Stream, Type ),
Type == file
->
time_file64(F, T0F),
'$absolute_file_name'(File,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],FilePl,load_files(File)),
time_file64(FilePl, T0Fl),
T0F >= T0Fl,
!,
file_directory_name(F, Dir),
working_directory(OldD, Dir),
'$msg_level'( TOpts, Verbosity),
'$lf_opt'(imports, TOpts, ImportList),
'$qload_file'(Stream, Mod, F, FilePl, File, ImportList),
close( Stream ),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$current_module'(M, Mod),
working_directory( _, OldD),
print_message(Verbosity, loaded( loaded, F, M, T, H)),
'$exec_initialisation_goals'
;
close( Stream),
fail
).
'$lf'(File, Mod, Call, TOpts) :- '$lf'(File, Mod, Call, TOpts) :-
'$lf_opt'(stream, TOpts, Stream), '$lf_opt'(stream, TOpts, Stream),
b_setval('$source_file', File), b_setval('$source_file', File),
@ -403,13 +453,14 @@ load_files(Files,Opts) :-
'$full_filename'(File, Y, Call), '$full_filename'(File, Y, Call),
open(Y, read, Stream) open(Y, read, Stream)
; ;
true stream_property(Stream, file_name(Y))
), !, ), !,
'$lf_opt'(reexport, TOpts, Reexport), '$lf_opt'(reexport, TOpts, Reexport),
'$lf_opt'(if, TOpts, If), '$lf_opt'(if, TOpts, If),
( var(If) -> If = true ; true ), ( var(If) -> If = true ; true ),
'$lf_opt'(imports, TOpts, Imports), '$lf_opt'(imports, TOpts, Imports),
'$start_lf'(If, Mod, Stream, TOpts, File, Reexport, Imports), '$start_lf'(If, Mod, Stream, TOpts, File, Reexport, Imports),
character_count(Stream, Pos),
close(Stream). close(Stream).
'$lf'(X, _, Call, _) :- '$lf'(X, _, Call, _) :-
'$do_error'(permission_error(input,stream,X),Call). '$do_error'(permission_error(input,stream,X),Call).
@ -587,6 +638,9 @@ db_files(Fs) :-
'$lf_opt'('$context_module', TOpts, ContextModule), '$lf_opt'('$context_module', TOpts, ContextModule),
'$lf_opt'(reexport, TOpts, Reexport), '$lf_opt'(reexport, TOpts, Reexport),
'$msg_level'( TOpts, Verbosity), '$msg_level'( TOpts, Verbosity),
'$lf_opt'(qcompile, TOpts, QCompiling),
'$nb_getval'('$qcompile', ContextQCompiling, ContextQCompiling = never),
nb_setval('$qcompile', QCompiling),
% format( 'I=~w~n', [Verbosity=UserFile] ), % format( 'I=~w~n', [Verbosity=UserFile] ),
'$lf_opt'(encoding, TOpts, Encoding), '$lf_opt'(encoding, TOpts, Encoding),
'$set_encoding'(Stream, Encoding), '$set_encoding'(Stream, Encoding),
@ -618,18 +672,22 @@ db_files(Fs) :-
StartMsg = consulting, StartMsg = consulting,
EndMsg = consulted EndMsg = consulted
), ),
print_message(Verbosity, loading(StartMsg, File)), print_message(Verbosity, loading(StartMsg, UserFile)),
'$lf_opt'(skip_unix_header , TOpts, SkipUnixHeader), '$lf_opt'(skip_unix_header , TOpts, SkipUnixHeader),
( SkipUnixHeader == true-> ( SkipUnixHeader == true
->
'$skip_unix_header'(Stream) '$skip_unix_header'(Stream)
; ;
true true
), ),
'$loop'(Stream,Reconsult), '$loop'(Stream,Reconsult),
'$lf_opt'(imports, TOpts, Imports),
'$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
'$end_consult',
'$q_do_save_file'(File, UserFile, ContextModule, TOpts ),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0, H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$current_module'(Mod, SourceModule), '$current_module'(Mod, SourceModule),
print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)), print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
'$end_consult',
( (
Reconsult = reconsult -> Reconsult = reconsult ->
'$clear_reconsulting' '$clear_reconsulting'
@ -646,14 +704,21 @@ db_files(Fs) :-
nb_setval('$if_level',OldIfLevel), nb_setval('$if_level',OldIfLevel),
'$lf_opt'('$use_module', TOpts, UseModule), '$lf_opt'('$use_module', TOpts, UseModule),
'$bind_module'(Mod, UseModule), '$bind_module'(Mod, UseModule),
'$lf_opt'(imports, TOpts, Imports),
'$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
'$reexport'( TOpts, ParentF, Reexport, Imports, File ), '$reexport'( TOpts, ParentF, Reexport, Imports, File ),
nb_setval('$qcompile', ContextQCompiling),
( LC == 0 -> prompt(_,' |: ') ; true), ( LC == 0 -> prompt(_,' |: ') ; true),
'$exec_initialisation_goals', '$exec_initialisation_goals',
% format( 'O=~w~n', [Mod=UserFile] ), % format( 'O=~w~n', [Mod=UserFile] ),
!. !.
'$q_do_save_file'(File, UserF, ContextModule, TOpts ) :-
'$lf_opt'(qcompile, TOpts, QComp),
( QComp == auto ; QComp == large, Pos > 100*1024),
'$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F,load_files(File)),
!,
'$qsave_file_'( File, UserF, F ).
'$q_do_save_file'(_File, _, _ContextModule, _TOpts ).
% are we in autoload and autoload_flag is false? % are we in autoload and autoload_flag is false?
'$msg_level'( TOpts, Verbosity) :- '$msg_level'( TOpts, Verbosity) :-
'$lf_opt'(autoload, TOpts, AutoLoad), '$lf_opt'(autoload, TOpts, AutoLoad),
@ -687,12 +752,11 @@ db_files(Fs) :-
'$bind_module'(Mod, use_module(Mod)). '$bind_module'(Mod, use_module(Mod)).
'$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts) :- '$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts) :-
\+ recorded('$module','$module'(File, _Module, _, _ModExports, _),_), \+ recorded('$module','$module'(File, _Module, _, _ModExports, _),_),
% enable loading C-predicates from a different file % enable loading C-predicates from a different file
recorded( '$load_foreign_done', [File, M0], _), recorded( '$load_foreign_done', [File, M0], _),
'$import_foreign'(File, M0, ContextModule ), '$import_foreign'(File, M0, ContextModule ),
fail. fail.
'$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts) :- '$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts) :-
recorded('$module','$module'(File, Module, _Source, ModExports, _),_), recorded('$module','$module'(File, Module, _Source, ModExports, _),_),
Module \= ContextModule, !, Module \= ContextModule, !,
@ -836,25 +900,17 @@ source_file(Mod:Pred, FileName) :-
Obtain information on what is going on in the compilation process. The Obtain information on what is going on in the compilation process. The
following keys are available: following keys are available:
+ directory (prolog_load_context/2 option)
+ directory
Full name for the directory where YAP is currently consulting the Full name for the directory where YAP is currently consulting the
file. file.
+ file + file (prolog_load_context/2 option)
Full name for the file currently being consulted. Notice that included Full name for the file currently being consulted. Notice that included
filed are ignored. filed are ignored.
+ module + module (prolog_load_context/2 option)
Current source module. Current source module.
@ -863,32 +919,31 @@ Current source module.
Full name for the file currently being read in, which may be consulted, Full name for the file currently being read in, which may be consulted,
reconsulted, or included. reconsulted, or included.
+ `stream` + `stream` (prolog_load_context/2 option)
Stream currently being read in. Stream currently being read in.
+ `term_position` + `term_position` (prolog_load_context/2 option)
Stream position at the stream currently being read in. For SWI Stream position at the stream currently being read in. For SWI
compatibility, it is a term of the form compatibility, it is a term of the form
'$stream_position'(0,Line,0,0,0). '$stream_position'(0,Line,0,0).
+ `source_location(? _FileName_, ? _Line_)` (prolog_load_context/2 option)
+ `source_location(? _FileName_, ? _Line_)`
SWI-compatible predicate. If the last term has been read from a physical file (i.e., not from the file user or a string), unify File with an absolute path to the file and Line with the line-number in the file. Please use prolog_load_context/2. SWI-compatible predicate. If the last term has been read from a physical file (i.e., not from the file user or a string), unify File with an absolute path to the file and Line with the line-number in the file. Please use prolog_load_context/2.
+ `source_file(? _File_)` + `source_file(? _File_)` (prolog_load_context/2 option)
SWI-compatible predicate. True if _File_ is a loaded Prolog source file. SWI-compatible predicate. True if _File_ is a loaded Prolog source file.
+ `source_file(? _ModuleAndPred_,? _File_)` + `source_file(? _ModuleAndPred_,? _File_)` (prolog_load_context/2 option)
SWI-compatible predicate. True if the predicate specified by _ModuleAndPred_ was loaded from file _File_, where _File_ is an absolute path name (see `absolute_file_name/2`). SWI-compatible predicate. True if the predicate specified by _ModuleAndPred_ was loaded from file _File_, where _File_ is an absolute path name (see `absolute_file_name/2`).
*/
/** @addgroup YAPLibraries Library Predicates
@section YAPLibraries Library Predicates
Library files reside in the library_directory path (set by the Library files reside in the library_directory path (set by the
`LIBDIR` variable in the Makefile for YAP). Currently, `LIBDIR` variable in the Makefile for YAP). Currently,
@ -919,7 +974,14 @@ prolog_load_context(term_position, Position) :-
% if the file exports a module, then we can % if the file exports a module, then we can
% be imported from any module. % be imported from any module.
'$file_loaded'(Stream, M, Imports, TOpts) :- '$file_loaded'(Stream, M, Imports, TOpts) :-
'$file_name'(Stream, F), '$file_name'(Stream, F0),
(
atom_concat(Prefix, '.qly', F0 )
->
'$absolute_file_name'(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F,load_files(Prefix))
;
F0 = F
),
'$ensure_file_loaded'(F, M, F1), '$ensure_file_loaded'(F, M, F1),
% format( 'IL=~w~n', [(F1:Imports->M)] ), % format( 'IL=~w~n', [(F1:Imports->M)] ),
'$import_to_current_module'(F1, M, Imports, _, TOpts). '$import_to_current_module'(F1, M, Imports, _, TOpts).
@ -960,7 +1022,8 @@ prolog_load_context(term_position, Position) :-
% inform the file has been loaded and is now available. % inform the file has been loaded and is now available.
'$loaded'(Stream, UserFile, M, OldF, Line, Reconsult, F, Dir, Opts) :- '$loaded'(Stream, UserFile, M, OldF, Line, Reconsult, F, Dir, Opts) :-
'$file_name'(Stream, F0), '$file_name'(Stream, F0),
( F0 == user_input, nonvar(UserFile) -> 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) ), ( F == user_input -> working_directory(Dir,Dir) ; file_directory_name(F, Dir) ),
nb_setval('$consulting_file', F ), 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 ), ( Reconsult \== consult, Reconsult \== not_loaded, Reconsult \== changed, recorded('$lf_loaded','$lf_loaded'(F, _,_),R), erase(R), fail ; var(Reconsult) -> Reconsult = consult ; true ),
@ -1071,6 +1134,52 @@ source_file_property( File0, Prop) :-
'$source_file_property'( F, module(M)) :- '$source_file_property'( F, module(M)) :-
recorded('$module','$module'(F,M,_,_,_),_). recorded('$module','$module'(F,M,_,_,_),_).
unload_file( F0 ) :-
absolute_file_name( F0, F1, [expand(true),file_type(prolog)] ),
'$unload_file'( F1, F0 ).
% eliminate multi-files;
% get rid of file-only predicataes.
'$unload_file'( FileName, _F0 ) :-
'$current_predicate_var'(A,Mod,P).
'$owner_file'(P,Mod,FileName),
\+ '$is_multifile'(P,Mod),
functor( P, Na, Ar),
abolish(Mod:Na/Ar),
fail.
%next multi-file.
'$unload_file'( FileName, _F0 ) :-
recorded('$lf_loaded','$lf_loaded'( F, Age, _), R),
erase(R),
fail.
'$unload_file'( FileName, _F0 ) :-
recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef), R),
erase(R),
erase(ClauseRef),
fail.
'$unload_file'( FileName, _F0 ) :-
recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,FFileName,R), R1),
erase(R1),
erase(R),
fail.
'$unload_file'( FileName, _F0 ) :-
recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), R),
erase(R),
fail.
'$unload_file'( FileName, _F0 ) :-
recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), R),
erase(R),
fail.
'$unload_file'( FileName, _F0 ) :-
recorded('$module','$module'( FileName, Mod, _SourceF, _, _), R),
erase( R ),
unload_module(Mod),
fail.
'$unload_file'( FileName, _F0 ) :-
recorded('$directive','$d'( FileName, _M:_G, _Mode, _VL, _Pos ), R),
erase(R),
fail.
/** /**
@ -1370,12 +1479,6 @@ part of the code due to different capabilities.
Realise different configuration options for your software. Realise different configuration options for your software.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
:- if(test1). :- if(test1).
section_1. section_1.

View File

@ -93,7 +93,8 @@
'$directive'(use_module(_,_,_)). '$directive'(use_module(_,_,_)).
'$directive'(wait(_)). '$directive'(wait(_)).
'$exec_directives'((G1,G2), Mode, M, VL, Pos) :- !, '$exec_directives'((G1,G2), Mode, M, VL, Pos) :-
!,
'$exec_directives'(G1, Mode, M, VL, Pos), '$exec_directives'(G1, Mode, M, VL, Pos),
'$exec_directives'(G2, Mode, M, VL, Pos). '$exec_directives'(G2, Mode, M, VL, Pos).
'$exec_directives'(G, Mode, M, VL, Pos) :- '$exec_directives'(G, Mode, M, VL, Pos) :-
@ -102,7 +103,7 @@
'$save_directive'(G, Mode, M, VL, Pos) :- '$save_directive'(G, Mode, M, VL, Pos) :-
prolog_load_context(file, FileName), !, prolog_load_context(file, FileName), !,
recorda('$directive', directive(File,M:G, Mode, VL, Pos),_). recordz('$directive', directive(FileName,M:G, Mode, VL, Pos),_).
'$exec_directive'(multifile(D), _, M, _, _) :- '$exec_directive'(multifile(D), _, M, _, _) :-
'$system_catch'('$multifile'(D, M), M, '$system_catch'('$multifile'(D, M), M,

View File

@ -279,6 +279,21 @@ profile_data/3 built-in.
SWI-Compatible option, determines prompting for alternatives in the Prolog toplevel. Default is <tt>groundness</tt>, YAP prompts for alternatives if and only if the query contains variables. The alternative, default in SWI-Prolog is <tt>determinism</tt> which implies the system prompts for alternatives if the goal succeeded while leaving choicepoints. SWI-Compatible option, determines prompting for alternatives in the Prolog toplevel. Default is <tt>groundness</tt>, YAP prompts for alternatives if and only if the query contains variables. The alternative, default in SWI-Prolog is <tt>determinism</tt> which implies the system prompts for alternatives if the goal succeeded while leaving choicepoints.
+ `qcompile(+{never, auto, large, part}, changeable)`
SWI-Prolog flag that controls whether loaded files should be also
compiled into qfiles. The default value is `never`.
`never`, no qcompile file is generated unless the user calls
qsave_file/1 and friends, or sets the qcompile option in
load_files/2;
`auto`, all files are qcompiled.
`large`, files above 100KB are qcompiled.
`part`, not supported in YAP.
+ `redefine_warnings ` + `redefine_warnings `
If _Value_ is unbound, tell whether warnings for procedures defined If _Value_ is unbound, tell whether warnings for procedures defined
@ -873,13 +888,22 @@ yap_flag(chr_toplevel_show_store,X) :-
yap_flag(chr_toplevel_show_store,X) :- yap_flag(chr_toplevel_show_store,X) :-
'$do_error'(domain_error(flag_value,chr_toplevel_show_store+X),yap_flag(chr_toplevel_show_store,X)). '$do_error'(domain_error(flag_value,chr_toplevel_show_store+X),yap_flag(chr_toplevel_show_store,X)).
yap_flag(qcompile,X) :-
var(X), !,
'$nb_getval'('$qcompile', X, X=never).
yap_flag(qcompile,X) :-
(X == never ; X == auto ; X == large ; X == part), !,
nb_setval('$qcompile',X).
yap_flag(qcompile,X) :-
'$do_error'(domain_error(flag_value,qcompile+X),yap_flag(qcompile,X)).
yap_flag(source,X) :- yap_flag(source,X) :-
var(X), !, var(X), !,
source_mode( X, X ). source_mode( X, X ).
yap_flag(source,X) :- yap_flag(source,X) :-
(X == off -> true ; X == on), !, (X == off -> true ; X == on), !,
source_mode( _, X ). source_mode( _, X ).
yap_flag(chr_toplevel_show_store,X) :- yap_flag(source,X) :-
'$do_error'(domain_error(flag_value,source+X),yap_flag(source,X)). '$do_error'(domain_error(flag_value,source+X),yap_flag(source,X)).
yap_flag(open_expands_filename,Expand) :- yap_flag(open_expands_filename,Expand) :-

View File

@ -705,8 +705,10 @@ expand_goal(G, G).
'$do_expand'(G, _, _, _, G) :- var(G), !. '$do_expand'(G, _, _, _, G) :- var(G), !.
'$do_expand'(M:G, _CurMod, SM, HVars, M:GI) :- !, '$do_expand'(M:G, _CurMod, SM, HVars, M:GI) :- !,
nonvar(M),
'$do_expand'(G, M, SM, HVars, GI). '$do_expand'(G, M, SM, HVars, GI).
'$do_expand'(G, CurMod, _SM, _HVars, GI) :- '$do_expand'(G, CurMod, _SM, _HVars, GI) :-
nonvar(G),
( (
'$pred_exists'(goal_expansion(G,GI), CurMod), '$pred_exists'(goal_expansion(G,GI), CurMod),
call(CurMod:goal_expansion(G, GI)) call(CurMod:goal_expansion(G, GI))
@ -1567,7 +1569,6 @@ unload_module(Mod) :-
op(X, 0, Mod:Op), op(X, 0, Mod:Op),
fail. fail.
unload_module(Mod) :- unload_module(Mod) :-
fail,
current_predicate(Mod:P), current_predicate(Mod:P),
abolish(P), abolish(P),
fail. fail.

View File

@ -388,45 +388,53 @@ save_program(File, _Goal) :-
fail. fail.
'$myddas_import_all'. '$myddas_import_all'.
qsave_file(F0) :-
ensure_loaded( F0 ),
absolute_file_name( F0, File, [expand(true),file_type(prolog),access(read),file_errors(fail),solutions(first)]),
absolute_file_name( F0, State, [expand(true),file_type(qly)]),
'$qsave_file_'(File, State).
/** @pred qsave_file(+ _File_, +_State_) /** @pred qsave_file(+ _File_, +_State_)
Saves an image of all the information compiled by the system from file _F_ to _State_. Saves an image of all the information compiled by the system from file _F_ to _State_.
This includes modules and predicatees eventually including multi-predicates. This includes modules and predicates eventually including multi-predicates.
**/ **/
qsave_file(F0, State) :- qsave_file(F0, State) :-
absolute_file_name( F0, File, [expand(true),file_type(qly)]), ensure_loaded( F0 ),
absolute_file_name( F0, File, [expand(true),file_type(prolog),access(read),file_errors(fail),solutions(first)]),
'$qsave_file_'(File, State). '$qsave_file_'(File, State).
'$qsave_file_'(File, _State) :- '$qsave_file_'(File, UserF, _State) :-
'$recorded'('$directive','$d'( File, M:G, Mode, VL, Pos ), _), ( File == user_input -> Age = 0 ; time_file64(File, Age) ),
assert(prolog:'$file_property'( directive( M:G, Mode, VL, Pos ) ) ), assert(user:'$file_property'( '$lf_loaded'( UserF, Age, M) ) ),
'$set_owner_file'(prolog:'$file_property'( _ ), File ), '$set_owner_file'( '$file_property'( _ ), user, File ),
fail. fail.
'$qsave_file_'(File, _State) :- '$qsave_file_'(File, UserF, State) :-
recorded('$module', '$module'(F,Mod,Source,Exps,L), _), recorded('$lf_loaded','$lf_loaded'( File, M, Reconsult, UserFile, OldF, Line, Opts), _),
'$fetch_parents_module'(Mod, Parents), assert(user:'$file_property'( '$lf_loaded'( UserF, M, Reconsult, UserFile, OldF, Line, Opts) ) ),
'$fetch_imports_module'(Mod, Imps), '$set_owner_file'( '$file_property'( _ ), user, File ),
assert(prolog:'$file_property'( module( Mod, Exps, L, Parents, Imps ) ) ),
'$set_owner_file'(prolog:'$file_property'( _ ), File ),
fail. fail.
'$qsave_file_'(File, _State) :- '$qsave_file_'(File, _UserF, _State) :-
recorded('$directive',directive( File, M:G, Mode, VL, Pos ), _),
assert(user:'$file_property'( directive( M:G, Mode, VL, Pos ) ) ),
'$set_owner_file'('$file_property'( _ ), user, File ),
fail.
'$qsave_file_'(File, _UserF, _State) :-
'$fetch_multi_files_file'(File, MultiFiles), '$fetch_multi_files_file'(File, MultiFiles),
assert(prolog:'$file_property'( multifile(MultiFiles ) ) ), assert(user:'$file_property'( multifile(MultiFiles ) ) ),
'$set_owner_file'(prolog:'$file_property'( _ ), File ), '$set_owner_file'('$file_property'( _ ), user, File ),
fail. fail.
'$qsave_file_'( File, State ) :- '$qsave_file_'( File, _UserF, State ) :-
( (
is_stream( State ) is_stream( State )
-> ->
stream_property(Stream, file_name(File)), '$qsave_file_preds'(State, File)
S = Stream,
'$qsave_file_preds'(S, File)
; ;
absolute_file_name( F0, File, [expand(true),file_type(qly)]),
open(State, write, S, [type(binary)]), open(State, write, S, [type(binary)]),
'$qsave_file_preds'(S, File), '$qsave_file_preds'(S, File),
close(S) close(S)
), abolish(prolog:'$file_property'/2). ),
abolish(user:'$file_property'/1).
'$fetch_multi_files_file'(File, Multi_Files) :- '$fetch_multi_files_file'(File, Multi_Files) :-
setof(Info, '$fetch_multi_file_module'(File, Info), Multi_Files). setof(Info, '$fetch_multi_file_module'(File, Info), Multi_Files).
@ -443,7 +451,7 @@ Saves an image of all the information compiled by the systemm on module _F_ to _
**/ **/
qsave_module(Mod, OF) :- qsave_module(Mod, OF) :-
recorded('$module', '$module'(F,Mod,S,Exps,L), _), recorded('$module', '$module'(F,Mod,Source,Exps,L), _),
'$fetch_parents_module'(Mod, Parents), '$fetch_parents_module'(Mod, Parents),
'$fetch_imports_module'(Mod, Imps), '$fetch_imports_module'(Mod, Imps),
'$fetch_multi_files_module'(Mod, MFs), '$fetch_multi_files_module'(Mod, MFs),
@ -451,11 +459,11 @@ qsave_module(Mod, OF) :-
'$fetch_module_transparents_module'(Mod, ModTransps), '$fetch_module_transparents_module'(Mod, ModTransps),
'$fetch_term_expansions_module'(Mod, TEs), '$fetch_term_expansions_module'(Mod, TEs),
'$fetch_foreigns_module'(Mod, Foreigns), '$fetch_foreigns_module'(Mod, Foreigns),
asserta(Mod:'@mod_info'(S, Exps, MFs, L, Parents, Imps, Metas, ModTransps, Foreigns, TEs)), asserta(Mod:'@mod_info'(Source, Exps, MFs, L, Parents, Imps, Metas, ModTransps, Foreigns, TEs)),
open(OF, write, S, [type(binary)]), open(OF, write, S, [type(binary)]),
'$qsave_module_preds'(S, Mod), '$qsave_module_preds'(S, Mod),
close(S), close(S),
abolish(Mod:'@mod_info'/8), abolish(Mod:'@mod_info'/10),
fail. fail.
qsave_module(_, _). qsave_module(_, _).
@ -512,20 +520,34 @@ qload_module(Mod) :-
'$current_module'(_, SourceModule), '$current_module'(_, SourceModule),
working_directory(_, OldD). working_directory(_, OldD).
'$qload_module'(Mod, File, _SourceModule) :- '$qload_module'(Mod, S, SourceModule) :-
unload_module( Mod ), is_stream( S ), !,
fail. '$q_header'( S, Type ),
'$qload_module'(Mod, File, _SourceModule) :- stream_property( S, file_name( File )),
open(File, read, S, [type(binary)]), ( Type == module ->
'$qload_module_preds'(S), '$qload_module'(S , Mod, File, SourceModule)
close(S), ;
fail. Type == file ->
'$qload_file'(S, File)
).
'$qload_module'(Mod, File, SourceModule) :- '$qload_module'(Mod, File, SourceModule) :-
'$complete_read_module'(Mod, File, SourceModule). open(File, read, S, [type(binary)]),
'$q_header'( S, Type ),
( Type == module ->
'$qload_module'(S , Mod, File, SourceModule)
;
Type == file ->
'$qload_file'(S, File)
),
close(S).
'$complete_read_module'(Mod, File, CurrentModule) :- '$qload_module'(_S, Mod, _File, _SourceModule) :-
unload_module( Mod ), fail.
'$qload_module'(S, _Mod, _File, _SourceModule) :-
'$qload_module_preds'(S), fail.
'$qload_module'(_S, Mod, File, SourceModule) :-
Mod:'@mod_info'(F, Exps, MFs, Line,Parents, Imps, Metas, ModTransps, Foreigns, TEs), Mod:'@mod_info'(F, Exps, MFs, Line,Parents, Imps, Metas, ModTransps, Foreigns, TEs),
abolish(Mod:'@mod_info'/9), abolish(Mod:'@mod_info'/10),
recorda('$module', '$module'(File, Mod, F, Exps, Line), _), recorda('$module', '$module'(File, Mod, F, Exps, Line), _),
'$install_parents_module'(Mod, Parents), '$install_parents_module'(Mod, Parents),
'$install_imports_module'(Mod, Imps, []), '$install_imports_module'(Mod, Imps, []),
@ -536,8 +558,8 @@ qload_module(Mod) :-
'$install_term_expansions_module'(Mod, TEs), '$install_term_expansions_module'(Mod, TEs),
% last, export everything to the host: if the loading crashed you didn't actually do % last, export everything to the host: if the loading crashed you didn't actually do
% no evil. % no evil.
'$convert_for_export'(all, Exps, Mod, CurrentModule, TranslationTab, AllExports0, qload_module), '$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, AllExports0, qload_module),
'$add_to_imports'(TranslationTab, Mod, CurrentModule), % insert ops, at least for now '$add_to_imports'(TranslationTab, Mod, SourceModule), % insert ops, at least for now
sort( AllExports0, AllExports ). sort( AllExports0, AllExports ).
'$fetch_imports_module'(Mod, Imports) :- '$fetch_imports_module'(Mod, Imports) :-
@ -551,7 +573,7 @@ qload_module(Mod) :-
'$fetch_parents_module'(Mod, Parents) :- '$fetch_parents_module'(Mod, Parents) :-
findall(Parent, prolog:'$parent_module'(Mod,Parent), Parents). findall(Parent, prolog:'$parent_module'(Mod,Parent), Parents).
'$fetch_module_transparents_module'(Mod, Module_Transparents) :- '$fetch_module_transparents_module'(Mod, Mmodule_Transparents) :-
findall(Info, '$fetch_module_transparent_module'(Mod, Info), Module_Transparents). findall(Info, '$fetch_module_transparent_module'(Mod, Info), Module_Transparents).
% detect an module_transparenterator that is local to the module. % detect an module_transparenterator that is local to the module.
@ -571,9 +593,12 @@ qload_module(Mod) :-
% detect an multi_file that is local to the module. % detect an multi_file that is local to the module.
'$fetch_multi_file_module'(Mod, '$defined'(FileName,Name,Arity,Mod)) :- '$fetch_multi_file_module'(Mod, '$defined'(FileName,Name,Arity,Mod)) :-
recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _). recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _).
'$fetch_multi_file_module'(Mod, '$mf_clause'(FileName,_Name,_Arity,_Module,Clause), _) :-
recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef), _),
instance(R, Clause ).
'$fetch_term_expansions_module'(Mod, Term_Expansions) :- '$fetch_term_expansions_module'(Mod, TEs) :-
findall(Info, '$fetch_term_expansion_module'(Mod, Info), Term_Expansions). findall(Info, '$fetch_term_expansion_module'(Mod, Info), TEs).
% detect an term_expansionerator that is local to the module. % detect an term_expansionerator that is local to the module.
'$fetch_term_expansion_module'(Mod, ( user:term_expansion(G, GI) :- Bd )) :- '$fetch_term_expansion_module'(Mod, ( user:term_expansion(G, GI) :- Bd )) :-
@ -674,40 +699,77 @@ Restores a previously saved state of YAP contaianing a qly file _F_.
*/ */
qload_file( F0 ) :- qload_file( F0 ) :-
H0 is heapused, '$cputime'(T0,_), ( '$swi_current_prolog_flag'(verbose_load, false)
( is_strean( F0 ) ->
Verbosity = silent
;
Verbosity = informational
),
StartMsg = loading_module,
'$current_module'( SourceModule ),
H0 is heapused,
'$cputime'(T0,_),
( is_stream( F0 )
-> ->
stream_property(F0, file_name(File) ), stream_property(F0, file_name(File) ),
S = F0 File = FilePl,
S = File
; ;
absolute_file_name( F0, File, [expand(true),file_type(qly)]), absolute_file_name( F0, File, [expand(true),file_type(qly)]),
absolute_file_name( F0, FilePl, [expand(true),file_type(prolog)]),
unload_file( FilePl ),
open(File, read, S, [type(binary)]) open(File, read, S, [type(binary)])
), ),
'$qload_file_preds'(S, File), print_message(Verbosity, loading(StartMsg, File)),
close(S),
fail
;
'$complete_read_file'(File).
'$complete_read_file'(File) :-
file_directory_name(File, DirName), file_directory_name(File, DirName),
working_directory(OldD, Dir), working_directory(OldD, DirName),
'$process_directives'( File ), '$q_header'( S, Type ),
( Type == module ->
'$qload_module'(S , Mod, File, SourceModule)
;
Type == file ->
'$qload_file'(S, SourceModule, File, FilePl, F0, all)
),
close(S),
working_directory( _, OldD), working_directory( _, OldD),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0, H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$current_module'(Mod, SourceModule), '$current_module'(Mod, Mod ),
fail. print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
'$exec_initialisation_goals'.
'$process_directives' :- '$qload_file'(S, SourceModule, F, FilePl, _F0, _ImportList) :-
prolog:'$file_property'( multifile( List ) ), recorded('$lf_loaded','$lf_loaded'( F, _Age, SourceModule), _),
!.
'$qload_file'(S, _SourceModule, _File, _FilePl, _F0, _ImportList) :-
'$qload_file_preds'(S),
fail.
'$qload_file'(S, SourceModule, F, FilePl, _F0, _ImportList) :-
user:'$file_property'( '$lf_loaded'( _, Age, _ ) ),
recordaifnot('$lf_loaded','$lf_loaded'( F, Age, SourceModule), _),
fail.
'$qload_file'(_S, SourceModule, _File, FilePl, F0, _ImportList) :-
b_setval('$source_file', F0 ),
'$process_directives'( FilePl ),
fail.
'$qload_file'(_S, SourceModule, _File, FilePl, _F0, ImportList) :-
'$import_to_current_module'(FilePl, SourceModule, ImportList, _, _TOpts).
'$process_directives'( FilePl ) :-
user:'$file_property'( '$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts) ),
recorda('$lf_loaded','$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts), _),
fail.
'$process_directives'( _FilePl ) :-
user:'$file_property'( multifile( List ) ),
lists:member( Clause, List ), lists:member( Clause, List ),
assert( Clause ), assert( Clause ),
fail. fail.
'$process_directives' :- '$process_directives'( FilePl ) :-
prolog:'$file_property'( directive( M:G, Mode, VL, Pos ) ), user:'$file_property'( directive( MG, Mode, VL, Pos ) ),
'$exec_directive'(G, Mode, M, VL, Pos), '$set_source'( FilePl, Pos ),
strip_module(MG, M, G),
'$process_directive'(G, reconsult, M, VL, Pos),
fail. fail.
'$process_directives' :- '$process_directives'( _FilePl ) :-
abolish(prolog:'$file_property'/1). abolish(user:'$file_property'/1).