qload/qsave implementation.

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
+static bool
-read_header(IOSTREAM *stream)
+checkChars(IOSTREAM *stream, char s[])
 {
-  int ch;
+  int ch, c;
+  char *p = s;
+  
+  while ((ch = *p++)) {
+    if ((c  = read_byte(stream)) != ch ) {
+      return false;
+    }
+  }
+  return TRUE;
+}
+
+static Atom
+get_header(IOSTREAM *stream)
+{
+  char s[256], *p = s, ch;
+  Atom at;
+
+  if (!checkChars( stream, "#!/bin/sh\nexec_dir=${YAPBINDIR:-" ))
+    return NIL;
+  while ((ch = read_byte(stream)) != '\n');
+  if (!checkChars( stream, "exec $exec_dir/yap $0 \"$@\"\nsaved " ))
+    return NIL;
+  while ((ch = read_byte(stream)) != ',')
+    *p++ = ch;
+  *p++ = '\0';
+  at = Yap_LookupAtom( s );
   while ((ch = read_byte(stream)));
+  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)) {
+  if ((stream = Yap_GetInputStream(AtomOfTerm(t1))) ) {
-    Yap_Error(TYPE_ERROR_ATOM,t1,"read_program/3");
-    return(FALSE);
-  }
-  if (!(stream = Yap_GetInputStream(AtomOfTerm(t1))) ) {
     return FALSE;
   }
   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();
   }

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));
+      if (pp &&
-      CHECK(save_pred(stream, 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();
   }

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 == part -> '$do_error'(domain_error(unimplemented_option,expand),Call) ;
-	    Val == false -> true ;
+	    Val == never -> true ;
-	    '$do_error'(domain_error(unimplemented_option,expand(Val)),Call) ).
+	    Val == auto -> true ;
+	    Val == large -> true ;
+	    '$do_error'(domain_error(unknown_option,qcompile(Val)),Call) ).
 '$process_lf_opt'(silent, Val, Call) :-
 	( 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 == source -> true ;
-	    Val == compact -> true ;
+      Val == compact -> true ;
-	    Val == assert_all -> true ;
+      Val == assert_all -> true ;
-	    '$do_error'(domain_error(unimplemented_option,compilation_mode(Val)),Call) ).
+      '$do_error'(domain_error(unimplemented_option,compilation_mode(Val)),Call) ).
 '$process_lf_opt'(consult, Val , Call) :-
-	( Val == reconsult -> true ;
+    ( Val == reconsult -> true ;
-	    Val == consult -> true ;
+      Val == consult -> true ;
-	    Val == exo -> true ;
+      Val == exo -> true ;
-	    Val == db -> true ;
+      Val == db -> true ;
-	    '$do_error'(domain_error(unimplemented_option,consult(Val)),Call) ).
+      '$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),
+    '$lf_opt'(stream, TOpts, Stream),
-	b_setval('$source_file', File),
+    var( 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
+	stream_property(Stream, file_name(Y))
-        ), !,
+    ), !,
-	'$lf_opt'(reexport, TOpts, Reexport),
+    '$lf_opt'(reexport, TOpts, Reexport),
-	'$lf_opt'(if, TOpts, If),
+    '$lf_opt'(if, TOpts, If),
-	( var(If) -> If = true ; true ),
+    ( var(If) -> If = true ; true ),
-	'$lf_opt'(imports, TOpts, Imports),
+    '$lf_opt'(imports, TOpts, Imports),
-	'$start_lf'(If, Mod, Stream, TOpts, File, Reexport, Imports),
+    '$start_lf'(If, Mod, Stream, TOpts, File, Reexport, Imports),
-	close(Stream).
+    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)
 
-
+    Full name for the directory where YAP is currently consulting the
-+ directory 
-
-
-
-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_)`   (prolog_load_context/2 option)
-+ `source_location(? _FileName_, ? _Line_)` 
 
     SWI-compatible predicate. If the last term has been read from a physical file (i.e., not from the file user or a string), unify File with an absolute path to the file and Line with the line-number in the file. Please use prolog_load_context/2.
 
-+ `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`).
 
+*/
 
-
+/** @addgroup YAPLibraries Library Predicates
-@section 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.

pl/directives.yap

@@ -93,16 +93,17 @@
 '$directive'(use_module(_,_,_)).
 '$directive'(wait(_)).
 
-'$exec_directives'((G1,G2), Mode, M, VL, Pos) :- !,
+'$exec_directives'((G1,G2), Mode, M, VL, Pos) :- 
-	'$exec_directives'(G1, Mode, M, VL, Pos),
+    !,
-	'$exec_directives'(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,

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 <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"

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.

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) :-  
+'$qsave_file_'(File, UserF, _State) :- 
-   '$recorded'('$directive','$d'( File, M:G, Mode,  VL, Pos ), _),
+    ( File == user_input -> Age = 0 ; time_file64(File, Age) ),
-    assert(prolog:'$file_property'( directive( M:G, Mode,  VL, Pos ) ) ),
+    assert(user:'$file_property'( '$lf_loaded'( UserF, Age, M) ) ),
-    '$set_owner_file'(prolog:'$file_property'( _ ), File ),
+    '$set_owner_file'( '$file_property'( _ ), user, File ),
     fail.
-'$qsave_file_'(File, _State) :-
+'$qsave_file_'(File, UserF, State) :- 
-    recorded('$module', '$module'(F,Mod,Source,Exps,L), _),
+    recorded('$lf_loaded','$lf_loaded'( File, M, Reconsult, UserFile, OldF, Line, Opts), _),
-    '$fetch_parents_module'(Mod, Parents),
+    assert(user:'$file_property'( '$lf_loaded'( UserF, M, Reconsult, UserFile, OldF, Line, Opts) ) ),
-    '$fetch_imports_module'(Mod, Imps),
+    '$set_owner_file'( '$file_property'( _ ), user, File ),
-    assert(prolog:'$file_property'( module( Mod, Exps, L, Parents, Imps ) ) ),
-    '$set_owner_file'(prolog:'$file_property'( _ ), File ),
     fail.
-'$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  ) ) ),
+    assert(user:'$file_property'( multifile(MultiFiles  ) ) ),
-    '$set_owner_file'(prolog:'$file_property'( _ ), File ),
+    '$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)),
+	'$qsave_file_preds'(State, File)
-	S = Stream,
-	'$qsave_file_preds'(S, File)
 	;
-        absolute_file_name( F0, File, [expand(true),file_type(qly)]),
 	open(State, write, S, [type(binary)]),
         '$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) :-
+'$qload_module'(Mod, S, SourceModule) :-
-    unload_module( Mod ),
+    is_stream( S ), !,
-    fail.
+    '$q_header'( S, Type ),
-'$qload_module'(Mod, File, _SourceModule) :-
+    stream_property( S, file_name( File )),
-    open(File, read, S, [type(binary)]),
+    ( Type == module ->
-    '$qload_module_preds'(S),
+	  '$qload_module'(S , Mod, File, SourceModule)
-    close(S),
+    ;
-    fail.
+      Type == file ->
+	  '$qload_file'(S, File)	  
+    ).
 '$qload_module'(Mod, File, SourceModule) :-
-    '$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),
+    '$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, AllExports0, qload_module),
-    '$add_to_imports'(TranslationTab, Mod, CurrentModule), % insert ops, at least for now
+    '$add_to_imports'(TranslationTab, Mod, SourceModule), % insert ops, at least for now
     sort( AllExports0, AllExports ).
 
 '$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) :-
+'$fetch_term_expansions_module'(Mod, TEs) :-
-	findall(Info, '$fetch_term_expansion_module'(Mod, Info), Term_Expansions).
+	findall(Info, '$fetch_term_expansion_module'(Mod, Info), TEs).
 
 % detect an term_expansionerator that is local to the module.
 '$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) :-
+qload_file( F0 ) :-
-    H0 is heapused, '$cputime'(T0,_),
+    ( '$swi_current_prolog_flag'(verbose_load, false)
-    ( is_strean( F0 ) 
+      ->
+	Verbosity = silent
+	;
+	Verbosity = informational
+    ),
+    StartMsg = loading_module,
+    '$current_module'( SourceModule ),
+    H0 is heapused, 
+    '$cputime'(T0,_),
+    ( is_stream( F0 ) 
       ->
       stream_property(F0, file_name(File) ),
-      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),
+    print_message(Verbosity, loading(StartMsg, File)),
-    close(S),
-    fail 
-    ;
-    '$complete_read_file'(File).
-
-'$complete_read_file'(File) :-
     file_directory_name(File, DirName),
-    working_directory(OldD, Dir),
+    working_directory(OldD, DirName),
-    '$process_directives'( File ),
+    '$q_header'( S, Type ),
+    ( Type == module ->
+	  '$qload_module'(S , Mod, File, SourceModule)
+    ;
+      Type == file ->
+	  '$qload_file'(S, SourceModule, File, FilePl, F0, all)	  
+    ),
+    close(S),
     working_directory( _, OldD),
     H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
-    '$current_module'(Mod, SourceModule),
+    '$current_module'(Mod, Mod ),
-    fail.
+    print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
+    '$exec_initialisation_goals'.
 
-'$process_directives' :-
+'$qload_file'(S, SourceModule, F, FilePl, _F0, _ImportList) :-
-    prolog:'$file_property'( multifile( List ) ),
+    recorded('$lf_loaded','$lf_loaded'( F, _Age, SourceModule), _),
+   !.
+'$qload_file'(S, _SourceModule, _File, _FilePl, _F0, _ImportList) :-
+    '$qload_file_preds'(S),
+    fail.
+'$qload_file'(S, SourceModule, F, FilePl, _F0, _ImportList) :-
+    user:'$file_property'( '$lf_loaded'( _, Age, _ ) ),
+    recordaifnot('$lf_loaded','$lf_loaded'( F, Age, SourceModule), _),
+    fail.
+'$qload_file'(_S, SourceModule, _File, FilePl, F0, _ImportList) :-
+    b_setval('$source_file', F0 ),
+    '$process_directives'( FilePl ),
+    fail.
+'$qload_file'(_S, SourceModule, _File,  FilePl, _F0, ImportList) :-
+    '$import_to_current_module'(FilePl, SourceModule, ImportList, _, _TOpts).
+
+'$process_directives'( FilePl ) :-
+    user:'$file_property'( '$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts) ),
+    recorda('$lf_loaded','$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts), _),
+    fail.
+'$process_directives'( _FilePl ) :-
+    user:'$file_property'( multifile( List ) ),
     lists:member( Clause, List ),
     assert( Clause ),
     fail.
-'$process_directives' :-
+'$process_directives'( FilePl ) :-
-    prolog:'$file_property'( directive( M:G, Mode,  VL, Pos  ) ),
+    user:'$file_property'( directive( MG, Mode,  VL, Pos  ) ),
-    '$exec_directive'(G, Mode, M, VL, Pos),
+    '$set_source'( FilePl, Pos ),
+    strip_module(MG, M, G),
+    '$process_directive'(G, reconsult, M, VL, Pos),
     fail.
-'$process_directives' :-
+'$process_directives'( _FilePl ) :-
-    abolish(prolog:'$file_property'/1).
+    abolish(user:'$file_property'/1).