diff --git a/C/qlyr.c b/C/qlyr.c
index b4c2f7845..2728c543b 100755
--- a/C/qlyr.c
+++ b/C/qlyr.c
@@ -44,7 +44,8 @@ typedef enum {
BAD_ATOM = 8,
MISMATCH = 9,
INCONSISTENT_CPRED = 10,
- BAD_READ = 11
+ BAD_READ = 11,
+ BAD_HEADER = 12
} qlfr_err_t;
static char *
@@ -77,7 +78,7 @@ static void
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]);
- exit(1);
+ Yap_exit(1);
}
static Atom
@@ -691,11 +692,56 @@ read_tag(IOSTREAM *stream)
return ch;
}
-static void
-read_header(IOSTREAM *stream)
+static bool
+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)));
+ 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
@@ -801,6 +847,7 @@ ReadHash(IOSTREAM *stream)
pe = RepPredProp(PredPropByAtomAndMod(a,mod));
}
} else {
+ /* IDB */
if (arity == (UInt)-1) {
UInt i = read_UInt(stream);
pe = Yap_FindLUIntKey(i);
@@ -808,12 +855,18 @@ ReadHash(IOSTREAM *stream)
Atom oa = (Atom)read_UInt(stream);
Atom a = LookupAtom(oa);
pe = RepPredProp(PredPropByAtomAndMod(a,mod));
+ pe->PredFlags |= AtomDBPredFlag;
} else {
Functor of = (Functor)read_UInt(stream);
Functor f = LookupFunctor(of);
pe = RepPredProp(PredPropByFuncAndMod(f,mod));
}
+ pe->PredFlags |= LogUpdatePredFlag;
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);
}
@@ -959,7 +1012,10 @@ read_pred(IOSTREAM *stream, Term mod) {
if (ap->PredFlags & IndexedPredFlag) {
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
fl1 = flags & ((UInt)STATIC_PRED_FLAGS);
ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS);
@@ -1013,7 +1069,6 @@ static void
read_module(IOSTREAM *stream) {
qlf_tag_t x;
- read_header(stream);
InitHash();
ReadHash(stream);
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");
return FALSE;
}
- if (!IsAtomTerm(t1)) {
- Yap_Error(TYPE_ERROR_ATOM,t1,"read_program/3");
- return(FALSE);
- }
- if (!(stream = Yap_GetInputStream(AtomOfTerm(t1))) ) {
+ if ((stream = Yap_GetInputStream(AtomOfTerm(t1))) ) {
return FALSE;
}
YAP_Reset( YAP_RESET_FROM_RESTORE );
+ if (get_header( stream ) == NIL)
+ return FALSE;
read_module(stream);
Sclose( stream );
/* back to the top level we go */
@@ -1092,6 +1145,8 @@ Yap_Restore(char *s, char *lib_dir)
if (!stream)
return -1;
GLOBAL_RestoreFile = s;
+ if (get_header( stream ) == NIL)
+ return FALSE;
read_module(stream);
Sclose( stream );
GLOBAL_RestoreFile = NULL;
@@ -1102,7 +1157,9 @@ Yap_Restore(char *s, char *lib_dir)
void Yap_InitQLYR(void)
{
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("$q_header", 2, p_get_header, SyncPredFlag|UserCPredFlag);
if (FALSE) {
restore_codes();
}
diff --git a/C/qlyw.c b/C/qlyw.c
index 16d3c465e..b68175696 100755
--- a/C/qlyw.c
+++ b/C/qlyw.c
@@ -771,18 +771,18 @@ save_ops(IOSTREAM *stream, Term mod) {
}
static int
-save_header(IOSTREAM *stream)
+save_header(IOSTREAM *stream, char type[])
{
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);
}
static size_t
save_module(IOSTREAM *stream, Term mod) {
PredEntry *ap = Yap_ModulePred(mod);
- save_header( stream );
+ save_header( stream, "saved module," );
InitHash();
ModuleAdjust(mod);
while (ap) {
@@ -813,7 +813,7 @@ save_program(IOSTREAM *stream) {
ModEntry *me = CurrentModules;
InitHash();
- save_header( stream );
+ save_header( stream, "saved state," );
/* should we allow the user to see hidden predicates? */
while (me) {
PredEntry *pp;
@@ -855,7 +855,7 @@ save_file(IOSTREAM *stream, Atom FileName) {
ModEntry *me = CurrentModules;
InitHash();
- save_header( stream );
+ save_header( stream, "saved file," );
/* should we allow the user to see hidden predicates? */
while (me) {
PredEntry *pp;
@@ -865,6 +865,7 @@ save_file(IOSTREAM *stream, Atom FileName) {
pp = PredEntryAdjust(pp);
if (pp &&
!(pp->PredFlags & (MultiFileFlag|NumberDBPredFlag|AtomDBPredFlag|CPredFlag|AsmPredFlag|UserCPredFlag)) &&
+ pp->ModuleOfPred != IDB_MODULE &&
pp->src.OwnerFile == FileName) {
CHECK(mark_pred(pp));
}
@@ -883,8 +884,12 @@ save_file(IOSTREAM *stream, Atom FileName) {
CHECK(save_tag(stream, QLY_START_MODULE));
CHECK(save_UInt(stream, (UInt)MkAtomTerm(me->AtomOfME)));
while (pp != NULL) {
- CHECK(save_tag(stream, QLY_START_PREDICATE));
- CHECK(save_pred(stream, pp));
+ if (pp &&
+ !(pp->PredFlags & (MultiFileFlag|NumberDBPredFlag|AtomDBPredFlag|CPredFlag|AsmPredFlag|UserCPredFlag)) &&
+ pp->src.OwnerFile == FileName) {
+ CHECK(save_tag(stream, QLY_START_PREDICATE));
+ CHECK(save_pred(stream, pp));
+ }
pp = pp->NextPredOfModule;
}
CHECK(save_tag(stream, QLY_END_PREDICATES));
@@ -966,9 +971,6 @@ p_save_file( USES_REGS1 )
if (!(stream = Yap_GetOutputStream(AtomOfTerm(t1))) ) {
return FALSE;
}
- if (!(stream = Yap_GetOutputStream(AtomOfTerm(t1))) ) {
- return FALSE;
- }
if (IsVarTerm(tfile)) {
Yap_Error(INSTANTIATION_ERROR,tfile,"save_file/2");
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_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) {
restore_codes();
}
diff --git a/pl/consult.yap b/pl/consult.yap
index 3eac4a7ef..9384917fd 100644
--- a/pl/consult.yap
+++ b/pl/consult.yap
@@ -157,6 +157,23 @@ following flags:
If true, raise an error if the file is not a module file. Used by
` 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_)
SWI-compatible option where if _Autoload_ is `true` undefined
@@ -175,7 +192,7 @@ following flags:
% expand(true,false)
% if(changed,true,not_loaded) => implemented
% imports(all,List) => implemented
-% qcompile(true,false)
+% qcompile() => implemented
% silent(true,false) => implemented
% stream(Stream) => implemented
% consult(consult,reconsult,exo,db) => implemented
@@ -191,7 +208,8 @@ load_files(Files,Opts) :-
'$lf_option'(expand, 4, false).
'$lf_option'(if, 5, true).
'$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'(skip_unix_header, 9, false).
'$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) ) ;
'$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) ;
- Val == false -> true ;
- '$do_error'(domain_error(unimplemented_option,expand(Val)),Call) ).
+ ( Val == part -> '$do_error'(domain_error(unimplemented_option,expand),Call) ;
+ Val == never -> true ;
+ Val == auto -> true ;
+ Val == large -> true ;
+ '$do_error'(domain_error(unknown_option,qcompile(Val)),Call) ).
'$process_lf_opt'(silent, Val, Call) :-
( Val == false -> true ;
Val == true -> true ;
@@ -327,19 +347,19 @@ 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 == compact -> true ;
- Val == assert_all -> true ;
- '$do_error'(domain_error(unimplemented_option,compilation_mode(Val)),Call) ).
+ ( Val == source -> true ;
+ Val == compact -> true ;
+ Val == assert_all -> true ;
+ '$do_error'(domain_error(unimplemented_option,compilation_mode(Val)),Call) ).
'$process_lf_opt'(consult, Val , Call) :-
- ( Val == reconsult -> true ;
- Val == consult -> true ;
- Val == exo -> true ;
- Val == db -> true ;
- '$do_error'(domain_error(unimplemented_option,consult(Val)),Call) ).
+ ( Val == reconsult -> true ;
+ Val == consult -> true ;
+ Val == exo -> true ;
+ Val == db -> true ;
+ '$do_error'(domain_error(unimplemented_option,consult(Val)),Call) ).
'$process_lf_opt'(reexport, Val , Call) :-
( Val == true -> true ;
- Val == false -> true ;
+ Val == false -> true ;
'$do_error'(domain_error(unimplemented_option,reexport(Val)),Call) ).
'$process_lf_opt'(must_be_module, Val , Call) :-
( Val == true -> true ;
@@ -396,23 +416,54 @@ load_files(Files,Opts) :-
b_setval('$source_file', user_input),
'$do_lf'(Mod, user_input, user_input, TOpts).
'$lf'(File, Mod, Call, TOpts) :-
- '$lf_opt'(stream, TOpts, Stream),
- b_setval('$source_file', File),
- ( var(Stream) ->
+ '$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_opt'(stream, TOpts, Stream),
+ b_setval('$source_file', File),
+ ( var(Stream) ->
/* need_to_open_file */
'$full_filename'(File, Y, Call),
open(Y, read, Stream)
;
- true
- ), !,
- '$lf_opt'(reexport, TOpts, Reexport),
- '$lf_opt'(if, TOpts, If),
- ( var(If) -> If = true ; true ),
- '$lf_opt'(imports, TOpts, Imports),
- '$start_lf'(If, Mod, Stream, TOpts, File, Reexport, Imports),
- close(Stream).
+ stream_property(Stream, file_name(Y))
+ ), !,
+ '$lf_opt'(reexport, TOpts, Reexport),
+ '$lf_opt'(if, TOpts, If),
+ ( var(If) -> If = true ; true ),
+ '$lf_opt'(imports, TOpts, Imports),
+ '$start_lf'(If, Mod, Stream, TOpts, File, Reexport, Imports),
+ character_count(Stream, Pos),
+ close(Stream).
'$lf'(X, _, Call, _) :-
- '$do_error'(permission_error(input,stream,X),Call).
+ '$do_error'(permission_error(input,stream,X),Call).
'$start_lf'(not_loaded, Mod, Stream, TOpts, UserFile, Reexport,Imports) :-
'$file_loaded'(Stream, Mod, Imports, TOpts), !,
@@ -587,6 +638,9 @@ db_files(Fs) :-
'$lf_opt'('$context_module', TOpts, ContextModule),
'$lf_opt'(reexport, TOpts, Reexport),
'$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] ),
'$lf_opt'(encoding, TOpts, Encoding),
'$set_encoding'(Stream, Encoding),
@@ -618,18 +672,22 @@ db_files(Fs) :-
StartMsg = consulting,
EndMsg = consulted
),
- print_message(Verbosity, loading(StartMsg, File)),
+ print_message(Verbosity, loading(StartMsg, UserFile)),
'$lf_opt'(skip_unix_header , TOpts, SkipUnixHeader),
- ( SkipUnixHeader == true->
+ ( SkipUnixHeader == true
+ ->
'$skip_unix_header'(Stream)
- ;
+ ;
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,
'$current_module'(Mod, SourceModule),
print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
- '$end_consult',
(
Reconsult = reconsult ->
'$clear_reconsulting'
@@ -646,14 +704,21 @@ db_files(Fs) :-
nb_setval('$if_level',OldIfLevel),
'$lf_opt'('$use_module', TOpts, UseModule),
'$bind_module'(Mod, UseModule),
- '$lf_opt'(imports, TOpts, Imports),
- '$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
'$reexport'( TOpts, ParentF, Reexport, Imports, File ),
+ nb_setval('$qcompile', ContextQCompiling),
( LC == 0 -> prompt(_,' |: ') ; true),
'$exec_initialisation_goals',
% 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?
'$msg_level'( TOpts, Verbosity) :-
'$lf_opt'(autoload, TOpts, AutoLoad),
@@ -687,12 +752,11 @@ db_files(Fs) :-
'$bind_module'(Mod, use_module(Mod)).
'$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
recorded( '$load_foreign_done', [File, M0], _),
'$import_foreign'(File, M0, ContextModule ),
fail.
-
'$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts) :-
recorded('$module','$module'(File, Module, _Source, ModExports, _),_),
Module \= ContextModule, !,
@@ -836,59 +900,50 @@ source_file(Mod:Pred, FileName) :-
Obtain information on what is going on in the compilation process. The
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 (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.
-+ module
++ module (prolog_load_context/2 option)
-
-
-Current source module.
+ Current source module.
+ `source` (prolog_load_context/2 option)
Full name for the file currently being read in, which may be consulted,
reconsulted, or included.
-+ `stream`
++ `stream` (prolog_load_context/2 option)
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
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_)`
++ `source_location(? _FileName_, ? _Line_)` (prolog_load_context/2 option)
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.
-+ `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`).
+*/
-
-@section YAPLibraries Library Predicates
+/** @addgroup YAPLibraries Library Predicates
Library files reside in the library_directory path (set by the
`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
% be imported from any module.
'$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),
% format( 'IL=~w~n', [(F1:Imports->M)] ),
'$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.
'$loaded'(Stream, UserFile, M, OldF, Line, Reconsult, F, Dir, Opts) :-
'$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) ),
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 ),
@@ -1071,6 +1134,52 @@ source_file_property( File0, Prop) :-
'$source_file_property'( F, module(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.
-
-
-
-
-
-
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
:- if(test1).
section_1.
diff --git a/pl/directives.yap b/pl/directives.yap
index 586d09b36..54b11fcd4 100644
--- a/pl/directives.yap
+++ b/pl/directives.yap
@@ -93,16 +93,17 @@
'$directive'(use_module(_,_,_)).
'$directive'(wait(_)).
-'$exec_directives'((G1,G2), Mode, M, VL, Pos) :- !,
- '$exec_directives'(G1, Mode, M, VL, Pos),
- '$exec_directives'(G2, Mode, M, VL, Pos).
+'$exec_directives'((G1,G2), Mode, M, VL, Pos) :-
+ !,
+ '$exec_directives'(G1, Mode, M, VL, Pos),
+ '$exec_directives'(G2, Mode, M, VL, Pos).
'$exec_directives'(G, Mode, M, VL, Pos) :-
'$save_directive'(G, Mode, M, VL, Pos),
'$exec_directive'(G, Mode, M, VL, Pos).
'$save_directive'(G, Mode, M, VL, Pos) :-
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, _, _) :-
'$system_catch'('$multifile'(D, M), M,
diff --git a/pl/flags.yap b/pl/flags.yap
index 636e7f719..97d26dd45 100644
--- a/pl/flags.yap
+++ b/pl/flags.yap
@@ -279,6 +279,21 @@ profile_data/3 built-in.
SWI-Compatible option, determines prompting for alternatives in the Prolog toplevel. Default is groundness, YAP prompts for alternatives if and only if the query contains variables. The alternative, default in SWI-Prolog is determinism 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 `
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) :-
'$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) :-
var(X), !,
source_mode( X, X ).
yap_flag(source,X) :-
(X == off -> true ; X == on), !,
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)).
yap_flag(open_expands_filename,Expand) :-
@@ -1375,8 +1399,8 @@ create_prolog_flag(Name, Value, Options) :-
'$flag_domain_from_value'(_, term).
-/**
- @pred source_mode(- _O_,+ _N_)
+/**
+ @pred source_mode(- _O_,+ _N_)
The state of source mode can either be on or off. When the source mode
is on, all clauses are kept both as compiled code and in a "hidden"
diff --git a/pl/modules.yap b/pl/modules.yap
index b77b23618..24726f3fd 100644
--- a/pl/modules.yap
+++ b/pl/modules.yap
@@ -705,8 +705,10 @@ expand_goal(G, G).
'$do_expand'(G, _, _, _, G) :- var(G), !.
'$do_expand'(M:G, _CurMod, SM, HVars, M:GI) :- !,
+ nonvar(M),
'$do_expand'(G, M, SM, HVars, GI).
'$do_expand'(G, CurMod, _SM, _HVars, GI) :-
+ nonvar(G),
(
'$pred_exists'(goal_expansion(G,GI), CurMod),
call(CurMod:goal_expansion(G, GI))
@@ -1567,7 +1569,6 @@ unload_module(Mod) :-
op(X, 0, Mod:Op),
fail.
unload_module(Mod) :-
- fail,
current_predicate(Mod:P),
abolish(P),
fail.
diff --git a/pl/qly.yap b/pl/qly.yap
index ff37df94d..662050cc7 100755
--- a/pl/qly.yap
+++ b/pl/qly.yap
@@ -387,46 +387,54 @@ save_program(File, _Goal) :-
call(db_import(myddas,Table,Table)),
fail.
'$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_)
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) :-
- 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) :-
- '$recorded'('$directive','$d'( File, M:G, Mode, VL, Pos ), _),
- assert(prolog:'$file_property'( directive( M:G, Mode, VL, Pos ) ) ),
- '$set_owner_file'(prolog:'$file_property'( _ ), File ),
+'$qsave_file_'(File, UserF, _State) :-
+ ( File == user_input -> Age = 0 ; time_file64(File, Age) ),
+ assert(user:'$file_property'( '$lf_loaded'( UserF, Age, M) ) ),
+ '$set_owner_file'( '$file_property'( _ ), user, File ),
fail.
-'$qsave_file_'(File, _State) :-
- recorded('$module', '$module'(F,Mod,Source,Exps,L), _),
- '$fetch_parents_module'(Mod, Parents),
- '$fetch_imports_module'(Mod, Imps),
- assert(prolog:'$file_property'( module( Mod, Exps, L, Parents, Imps ) ) ),
- '$set_owner_file'(prolog:'$file_property'( _ ), File ),
+'$qsave_file_'(File, UserF, State) :-
+ recorded('$lf_loaded','$lf_loaded'( File, M, Reconsult, UserFile, OldF, Line, Opts), _),
+ assert(user:'$file_property'( '$lf_loaded'( UserF, M, Reconsult, UserFile, OldF, Line, Opts) ) ),
+ '$set_owner_file'( '$file_property'( _ ), user, File ),
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),
- assert(prolog:'$file_property'( multifile(MultiFiles ) ) ),
- '$set_owner_file'(prolog:'$file_property'( _ ), File ),
+ assert(user:'$file_property'( multifile(MultiFiles ) ) ),
+ '$set_owner_file'('$file_property'( _ ), user, File ),
fail.
-'$qsave_file_'( File, State ) :-
+'$qsave_file_'( File, _UserF, State ) :-
(
is_stream( State )
->
- stream_property(Stream, file_name(File)),
- S = Stream,
- '$qsave_file_preds'(S, File)
+ '$qsave_file_preds'(State, File)
;
- absolute_file_name( F0, File, [expand(true),file_type(qly)]),
open(State, write, S, [type(binary)]),
'$qsave_file_preds'(S, File),
close(S)
- ), abolish(prolog:'$file_property'/2).
+ ),
+ abolish(user:'$file_property'/1).
'$fetch_multi_files_file'(File, 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) :-
- recorded('$module', '$module'(F,Mod,S,Exps,L), _),
+ recorded('$module', '$module'(F,Mod,Source,Exps,L), _),
'$fetch_parents_module'(Mod, Parents),
'$fetch_imports_module'(Mod, Imps),
'$fetch_multi_files_module'(Mod, MFs),
@@ -451,11 +459,11 @@ qsave_module(Mod, OF) :-
'$fetch_module_transparents_module'(Mod, ModTransps),
'$fetch_term_expansions_module'(Mod, TEs),
'$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)]),
'$qsave_module_preds'(S, Mod),
close(S),
- abolish(Mod:'@mod_info'/8),
+ abolish(Mod:'@mod_info'/10),
fail.
qsave_module(_, _).
@@ -512,20 +520,34 @@ qload_module(Mod) :-
'$current_module'(_, SourceModule),
working_directory(_, OldD).
-'$qload_module'(Mod, File, _SourceModule) :-
- unload_module( Mod ),
- fail.
-'$qload_module'(Mod, File, _SourceModule) :-
- open(File, read, S, [type(binary)]),
- '$qload_module_preds'(S),
- close(S),
- fail.
+'$qload_module'(Mod, S, SourceModule) :-
+ is_stream( S ), !,
+ '$q_header'( S, Type ),
+ stream_property( S, file_name( File )),
+ ( Type == module ->
+ '$qload_module'(S , Mod, File, SourceModule)
+ ;
+ Type == file ->
+ '$qload_file'(S, File)
+ ).
'$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),
- abolish(Mod:'@mod_info'/9),
+ abolish(Mod:'@mod_info'/10),
recorda('$module', '$module'(File, Mod, F, Exps, Line), _),
'$install_parents_module'(Mod, Parents),
'$install_imports_module'(Mod, Imps, []),
@@ -536,8 +558,8 @@ qload_module(Mod) :-
'$install_term_expansions_module'(Mod, TEs),
% last, export everything to the host: if the loading crashed you didn't actually do
% no evil.
- '$convert_for_export'(all, Exps, Mod, CurrentModule, TranslationTab, AllExports0, qload_module),
- '$add_to_imports'(TranslationTab, Mod, CurrentModule), % insert ops, at least for now
+ '$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, AllExports0, qload_module),
+ '$add_to_imports'(TranslationTab, Mod, SourceModule), % insert ops, at least for now
sort( AllExports0, AllExports ).
'$fetch_imports_module'(Mod, Imports) :-
@@ -551,7 +573,7 @@ qload_module(Mod) :-
'$fetch_parents_module'(Mod, 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).
% 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.
'$fetch_multi_file_module'(Mod, '$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) :-
- findall(Info, '$fetch_term_expansion_module'(Mod, Info), Term_Expansions).
+'$fetch_term_expansions_module'(Mod, TEs) :-
+ findall(Info, '$fetch_term_expansion_module'(Mod, Info), TEs).
% detect an term_expansionerator that is local to the module.
'$fetch_term_expansion_module'(Mod, ( user:term_expansion(G, GI) :- Bd )) :-
@@ -673,41 +698,78 @@ qload_module(Mod) :-
Restores a previously saved state of YAP contaianing a qly file _F_.
*/
-qload_file(F0) :-
- H0 is heapused, '$cputime'(T0,_),
- ( is_strean( F0 )
+qload_file( F0 ) :-
+ ( '$swi_current_prolog_flag'(verbose_load, false)
+ ->
+ Verbosity = silent
+ ;
+ Verbosity = informational
+ ),
+ StartMsg = loading_module,
+ '$current_module'( SourceModule ),
+ H0 is heapused,
+ '$cputime'(T0,_),
+ ( is_stream( F0 )
->
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, FilePl, [expand(true),file_type(prolog)]),
+ unload_file( FilePl ),
open(File, read, S, [type(binary)])
),
- '$qload_file_preds'(S, File),
- close(S),
- fail
- ;
- '$complete_read_file'(File).
-
-'$complete_read_file'(File) :-
+ print_message(Verbosity, loading(StartMsg, File)),
file_directory_name(File, DirName),
- working_directory(OldD, Dir),
- '$process_directives'( File ),
+ working_directory(OldD, DirName),
+ '$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),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
- '$current_module'(Mod, SourceModule),
- fail.
+ '$current_module'(Mod, Mod ),
+ print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
+ '$exec_initialisation_goals'.
-'$process_directives' :-
- prolog:'$file_property'( multifile( List ) ),
+'$qload_file'(S, SourceModule, F, FilePl, _F0, _ImportList) :-
+ 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 ),
assert( Clause ),
fail.
-'$process_directives' :-
- prolog:'$file_property'( directive( M:G, Mode, VL, Pos ) ),
- '$exec_directive'(G, Mode, M, VL, Pos),
+'$process_directives'( FilePl ) :-
+ user:'$file_property'( directive( MG, Mode, VL, Pos ) ),
+ '$set_source'( FilePl, Pos ),
+ strip_module(MG, M, G),
+ '$process_directive'(G, reconsult, M, VL, Pos),
fail.
-'$process_directives' :-
- abolish(prolog:'$file_property'/1).
+'$process_directives'( _FilePl ) :-
+ abolish(user:'$file_property'/1).