diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
C/qlyr.c
View File

@ -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();
}

24
C/qlyw.c
View File

@ -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();
}

239
pl/consult.yap
View File

@ -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.

9
pl/directives.yap
View File

@ -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,

30
pl/flags.yap
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.
+ `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"

3
pl/modules.yap
View File

@ -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.

188
pl/qly.yap
View File

@ -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).