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