diff --git a/C/c_interface.c b/C/c_interface.c index 5e59e905d..8137800a0 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -2358,7 +2358,7 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi) /* if backtracking asked for, recover space and bindings */ if (backtrack) { P = FAILCODE; - Yap_exec_absmi(TRUE); + Yap_exec_absmi( true, YAP_EXEC_ABSMI); /* recover stack space */ HR = B->cp_h; TR = B->cp_tr; @@ -2560,7 +2560,7 @@ YAP_RestartGoal(void) if (LOCAL_AllowRestart) { P = (yamop *)FAILCODE; LOCAL_PrologMode = UserMode; - out = Yap_exec_absmi(TRUE); + out = Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI); LOCAL_PrologMode = UserCCallMode; if (out == FALSE) { /* cleanup */ @@ -2599,7 +2599,7 @@ YAP_ShutdownGoal(int backtrack) B = cut_pt; if (backtrack) { P = FAILCODE; - Yap_exec_absmi(TRUE); + Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI); /* recover stack space */ HR = cut_pt->cp_h; TR = cut_pt->cp_tr; @@ -2626,7 +2626,7 @@ YAP_ContinueGoal(void) BACKUP_MACHINE_REGS(); LOCAL_PrologMode = UserMode; - out = Yap_exec_absmi(TRUE); + out = Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI); LOCAL_PrologMode = UserCCallMode; RECOVER_MACHINE_REGS(); @@ -2936,7 +2936,7 @@ do_bootfile (char *bootfilename) fprintf(stderr, "%s", ErrorMessage); } /* do backtrack */ - YAP_Reset(); + YAP_Reset( YAP_FULL_RESET ); } YAP_EndConsult(bootfile); #if DEBUG @@ -3268,7 +3268,7 @@ YAP_CompareTerms(Term t1, Term t2) } X_API int -YAP_Reset(void) +YAP_Reset(yap_reset_t mode) { CACHE_REGS int res = TRUE; @@ -3278,9 +3278,10 @@ YAP_Reset(void) /* first, backtrack to the root */ while (B->cp_b) { B = B->cp_b; - P = FAILCODE; - res = Yap_exec_absmi(0); } + // B shoul lead to CP with _ystop0,, + P = FAILCODE; + res = Yap_exec_absmi( true, mode ); /* reinitialise the engine */ // Yap_InitYaamRegs( worker_id ); GLOBAL_Initialised = TRUE; diff --git a/C/cdmgr.c b/C/cdmgr.c index 049180b07..03baa2623 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -3407,6 +3407,35 @@ p_set_pred_module( USES_REGS1 ) return(TRUE); } +static Int +p_set_pred_owner( USES_REGS1 ) +{ /* '$set_pred_module'(+P,+File) */ + PredEntry *pe; + Term a2 = Deref( ARG2 ); + + pe = get_pred(Deref(ARG1), CurrentModule, "set_pred_module/1"); + if (EndOfPAEntr(pe)) + return FALSE; + PELOCK(35,pe); + if (pe->PredFlags & (UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) { + UNLOCKPE(56,pe); + return FALSE; + } + if (IsVarTerm(a2)) { + Yap_Error(INSTANTIATION_ERROR, a2, "load_files/2"); + UNLOCKPE(56,pe); + return FALSE; + } + if (!IsAtomTerm(a2)) { + Yap_Error(TYPE_ERROR_ATOM, a2, "load_files/2"); + UNLOCKPE(56,pe); + return FALSE; + } + pe->src.OwnerFile = AtomOfTerm(a2); + UNLOCKPE(56,pe); + return(TRUE); +} + static Int p_undefined( USES_REGS1 ) { /* '$undefined'(P,Mod) */ @@ -6659,6 +6688,7 @@ Yap_InitCdMgr(void) Yap_InitCPred("$call_count_reset", 0, p_call_count_reset, SafePredFlag|SyncPredFlag); Yap_InitCPred("$toggle_static_predicates_in_use", 0, p_toggle_static_predicates_in_use, SafePredFlag|SyncPredFlag); Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag); + Yap_InitCPred("$set_pred_owner", 2, p_set_pred_owner, SafePredFlag); Yap_InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag); Yap_InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag); Yap_InitCPred("$all_system_predicate", 3, p_all_system_pred, SafePredFlag); diff --git a/C/exec.c b/C/exec.c index 36ad5635f..ea0ca0872 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1046,7 +1046,7 @@ p_pred_goal_expansion_on( USES_REGS1 ) { static Int -exec_absmi(int top USES_REGS) +exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { int lval, out; @@ -1152,7 +1152,7 @@ Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS) } static Int -do_goal(yamop *CodeAdr, int arity, CELL *pt, int top USES_REGS) +do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS) { choiceptr saved_b = B; Int out; @@ -1161,7 +1161,7 @@ do_goal(yamop *CodeAdr, int arity, CELL *pt, int top USES_REGS) P = (yamop *) CodeAdr; S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */ - out = exec_absmi(top PASS_REGS); + out = exec_absmi(top, YAP_EXEC_ABSMI PASS_REGS); Yap_flush(); // if (out) { // out = Yap_GetFromSlot(sl); @@ -1171,10 +1171,10 @@ do_goal(yamop *CodeAdr, int arity, CELL *pt, int top USES_REGS) } Int -Yap_exec_absmi(int top) +Yap_exec_absmi(bool top, yap_reset_t has_reset) { CACHE_REGS - return exec_absmi(top PASS_REGS); + return exec_absmi(top, has_reset PASS_REGS); } @@ -1191,7 +1191,7 @@ Yap_execute_pred(PredEntry *ppe, CELL *pt USES_REGS) PELOCK(81,ppe); CodeAdr = ppe->CodeOfPred; UNLOCK(ppe->PELock); - out = do_goal(CodeAdr, ppe->ArityOfPE, pt, FALSE PASS_REGS); + out = do_goal(CodeAdr, ppe->ArityOfPE, pt, false PASS_REGS); if (out == 1) { choiceptr cut_B; @@ -1382,7 +1382,7 @@ Yap_RunTopGoal(Term t) "unable to boot because of too little Trail space"); } #endif - goal_out = do_goal(CodeAdr, arity, pt, TRUE PASS_REGS); + goal_out = do_goal(CodeAdr, arity, pt, true PASS_REGS); return goal_out; } diff --git a/C/load_foreign.c b/C/load_foreign.c index b0f4960bf..65f6dff80 100644 --- a/C/load_foreign.c +++ b/C/load_foreign.c @@ -240,7 +240,7 @@ Detach the shared object identified by _Handle_. */ - Yap_InitCPred("call_shared_object_function", 2, p_call_shared_object_function, SyncPredFlag); + Yap_InitCPred("$call_shared_object_function", 2, p_call_shared_object_function, SyncPredFlag); Yap_InitCPred("$obj_suffix", 1, p_obj_suffix, SafePredFlag); } diff --git a/C/qlyr.c b/C/qlyr.c index 1532b8819..1186d0546 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -276,9 +276,12 @@ static DBRef LookupDBRef(DBRef dbr, int inc_ref) { CACHE_REGS - CELL hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize; + CELL hash; import_dbref_hash_entry_t *p; + if (LOCAL_ImportDBRefHashTableSize == 0) + return NULL; + hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize; p = LOCAL_ImportDBRefHashChain[hash]; while (p) { if (p->oval == dbr) { @@ -297,9 +300,12 @@ static LogUpdClause * LookupMayFailDBRef(DBRef dbr) { CACHE_REGS - CELL hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize; + CELL hash; import_dbref_hash_entry_t *p; + if (LOCAL_ImportDBRefHashTableSize == 0) + return NULL; + hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize; p = LOCAL_ImportDBRefHashChain[hash]; while (p) { if (p->oval == dbr) { @@ -1007,16 +1013,18 @@ static void read_module(IOSTREAM *stream) { qlf_tag_t x; - InitHash(); read_header(stream); + InitHash(); ReadHash(stream); while ((x = read_tag(stream)) == QLY_START_MODULE) { Term mod = (Term)read_UInt(stream); + if (mod == 0) + mod = TermProlog; mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod))); if (mod) - while ((x = read_tag(stream)) == QLY_START_PREDICATE) { - read_pred(stream, mod); - } + while ((x = read_tag(stream)) == QLY_START_PREDICATE) { + read_pred(stream, mod); + } } read_ops(stream); CloseHash(); @@ -1047,10 +1055,6 @@ static void ReInitProlog(void) { Term t = MkAtomTerm(AtomInitProlog); -#if defined(YAPOR) || defined(TABLING) - Yap_init_root_frames(); -#endif /* YAPOR || TABLING */ - Yap_InitYaamRegs( 0 ); YAP_RunGoalOnce(t); } @@ -1073,12 +1077,11 @@ p_read_program( USES_REGS1 ) if (!(stream = Yap_GetInputStream(AtomOfTerm(t1))) ) { return FALSE; } - YAP_Reset(); + YAP_Reset( YAP_RESET_FROM_RESTORE ); read_module(stream); Sclose( stream ); /* back to the top level we go */ ReInitProlog(); - Yap_RestartYap( 3 ); return TRUE; } diff --git a/C/qlyw.c b/C/qlyw.c index d29f78588..dccb81aeb 100755 --- a/C/qlyw.c +++ b/C/qlyw.c @@ -770,9 +770,19 @@ save_ops(IOSTREAM *stream, Term mod) { return 1; } +static int +save_header(IOSTREAM *stream) +{ + char msg[256]; + + sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%s", YAP_BINDIR, 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 ); InitHash(); ModuleAdjust(mod); while (ap) { @@ -798,15 +808,6 @@ save_module(IOSTREAM *stream, Term mod) { return 1; } -static int -save_header(IOSTREAM *stream) -{ - char msg[256]; - - sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%s", YAP_BINDIR, YAP_FULL_VERSION); - return save_bytes(stream, msg, strlen(msg)+1); -} - static size_t save_program(IOSTREAM *stream) { ModEntry *me = CurrentModules; @@ -849,6 +850,52 @@ save_program(IOSTREAM *stream) { return 1; } +static size_t +save_file(IOSTREAM *stream, Atom FileName) { + ModEntry *me = CurrentModules; + + InitHash(); + save_header( stream ); + /* should we allow the user to see hidden predicates? */ + while (me) { + PredEntry *pp; + pp = me->PredForME; + AtomAdjust(me->AtomOfME); + while (pp != NULL) { + pp = PredEntryAdjust(pp); + if (pp && + !(pp->PredFlags & (MultiFileFlag|NumberDBPredFlag|AtomDBPredFlag|CPredFlag|AsmPredFlag|UserCPredFlag)) && + pp->src.OwnerFile == FileName) { + CHECK(mark_pred(pp)); + } + pp = pp->NextPredOfModule; + } + me = me->NextME; + } + + /* just to make sure */ + mark_ops(stream, 0); + SaveHash(stream); + me = CurrentModules; + while (me) { + PredEntry *pp; + pp = me->PredForME; + 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)); + pp = pp->NextPredOfModule; + } + CHECK(save_tag(stream, QLY_END_PREDICATES)); + me = me->NextME; + } + CHECK(save_tag(stream, QLY_END_MODULES)); + save_ops(stream, 0); + CloseHash(); + return 1; +} + static Int p_save_module_preds( USES_REGS1 ) { @@ -902,10 +949,43 @@ p_save_program( USES_REGS1 ) return save_program(stream) != 0; } +static Int +p_save_file( USES_REGS1 ) +{ + IOSTREAM *stream; + Term t1 = Deref(ARG1); + Term tfile = Deref(ARG2); + + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR,t1,"save_file/3"); + return FALSE; + } + if (!IsAtomTerm(t1)) { + Yap_Error(TYPE_ERROR_ATOM,t1,"save_file/3"); + return(FALSE); + } + 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; + } + if (!IsAtomTerm(tfile)) { + Yap_Error(TYPE_ERROR_ATOM,tfile,"save_file/2"); + return FALSE; + } + return save_file(stream, AtomOfTerm(tfile) ) != 0; +} + 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); if (FALSE) { restore_codes(); } diff --git a/H/Yapproto.h b/H/Yapproto.h index 064d813f2..7ec515f9e 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -182,7 +182,7 @@ Int Yap_JumpToEnv(Term); Term Yap_RunTopGoal(Term); void Yap_ResetExceptionTerm(int); Int Yap_execute_goal(Term, int, Term); -Int Yap_exec_absmi(int); +Int Yap_exec_absmi( bool, yap_reset_t ); void Yap_trust_last(void); Term Yap_GetException(void); void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS); diff --git a/Makefile.in b/Makefile.in index ab1957292..cc70faf3f 100755 --- a/Makefile.in +++ b/Makefile.in @@ -693,11 +693,16 @@ FULL_PATH_PL_SOURCES=$(addprefix $(srcdir)/, $(PL_SOURCES) ) FULL_PATH_HEADERS=$(addprefix $(srcdir)/, $(HEADERS) ) TAGS: $(C_SOURCES) $(PL_SOURCES) $(HEADERS) - etags $(FULL_PATH_C_SOURCES) $(FULL_PATH_PL_SOURCES) $(FULL_PATH_HEADERS) - for p in $(PACKAGES); do \ - echo " ============== INSTALLING" $$p; \ - if [ -r $$p/Makefile ]; then $(MAKE) -C $$p TAGS || exit 1; fi; \ - done + rm -f TAGS + find . -name '*.c' -exec etags -a {} \; + find . -name '*.h' -exec etags -a {} \; + find . -name '*.i' -exec etags -a {} \; + find . -name '*.yap' -exec etags -a {} \; + find . -name '*.pl' -exec etags -a {} \; + find . -name '*.cpp' -exec etags -a {} \; + find . -name '*.hh' -exec etags -a {} \; + find . -name '*.java' -exec etags -a {} \; + find . -name '*.py' -exec etags -a {} \; depend: $(HEADERS) $(C_SOURCES) -@if test "$(GCC)" = yes; then\ diff --git a/console/yap.c b/console/yap.c index ef6542d7c..8d7494291 100755 --- a/console/yap.c +++ b/console/yap.c @@ -125,7 +125,7 @@ exec_top_level(int BootMode, YAP_init_args *iap) livegoal = YAP_FullLookupAtom("$live"); atomfalse = YAP_MkAtomTerm (YAP_FullLookupAtom("$false")); while (YAP_GetValue (livegoal) != atomfalse) { - YAP_Reset(); + YAP_Reset( YAP_FULL_RESET ); do_top_goal (YAP_MkAtomTerm (livegoal)); } YAP_Exit(EXIT_SUCCESS); @@ -168,7 +168,7 @@ main (int argc, char **argv) YAP_RunGoalOnce(t_goal); } } - YAP_Reset(); + YAP_Reset( YAP_FULL_RESET ); /* End preprocessor code */ exec_top_level(BootMode, &init_args); diff --git a/docs/doxygen.rc b/docs/doxygen.rc index d803e66ad..fd9aab017 100644 --- a/docs/doxygen.rc +++ b/docs/doxygen.rc @@ -58,7 +58,7 @@ PROJECT_LOGO = misc/icons/yap_96x96x32.png # entered, it will be relative to the location where doxygen was started. If # left blank the current directory will be used. -OUTPUT_DIRECTORY = /scratch/vitor/doxout +OUTPUT_DIRECTORY = /Users/vsc/Yap/doxout # If the CREATE_SUBDIRS tag is set to YES, then doxygen will create 4096 sub- # directories (in 2 levels) under the output directory of each output format and diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index a90e550d8..afb632bb7 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -149,7 +149,7 @@ typedef unsigned long uintptr_t; #endif #ifndef PL_HAVE_TERM_T -#define PL_HAVE_TERM_Temacs +#define PL_HAVE_TERM_T typedef intptr_t term_t; #endif typedef struct mod_entry *module_t; diff --git a/include/YapDefs.h b/include/YapDefs.h index 2e94e9512..8357b56f6 100755 --- a/include/YapDefs.h +++ b/include/YapDefs.h @@ -302,5 +302,11 @@ typedef enum YAPC_ENABLE_AGC /* enable or disable atom garbage collection */ } yap_flag_t; +typedef enum yap_enum_reset_t { + YAP_EXEC_ABSMI = 0, + YAP_FULL_RESET = 1, + YAP_RESET_FROM_RESTORE = 3 +} yap_reset_t; + \ #endif /* _YAPDEFS_H */ diff --git a/include/YapInterface.h b/include/YapInterface.h index 2a3082cf6..9fb6d0c1b 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -859,10 +859,13 @@ Look for the next solution to the current query by forcing YAP to backtrack to the latest goal. Notice that slots allocated since the last YAP_RunGoal() will become invalid. -@Item `int` YAP_Reset(`void`) -Reset execution environment (similar to the [abort/0](@ref abort) -built-in). This is useful when you want to start a new query before -asking all solutions to the previous query. +@Item `int` YAP_Reset(`yap_reset_t mode`) + +Reset execution environment +(similar to the abort/0 built-in). This is useful when +you want to start a new query before asking all solutions to the +previous query. 'mode` specifies how deep the Reset will go and what +to do next. It will be most often set to `YAP_FULL_RESET`.
  • `int` YAP_ShutdownGoal(`int backtrack`) @@ -1829,7 +1832,7 @@ extern X_API YAP_Bool YAP_GoalHasException(YAP_Term *); /* void YAP_ClearExceptions(void) */ extern X_API void YAP_ClearExceptions(void); -extern X_API int YAP_Reset(void); +extern X_API int YAP_Reset(yap_reset_t reset); extern X_API void YAP_Error(int myerrno, YAP_Term t, const char *buf, ...); diff --git a/library/matrix.yap b/library/matrix.yap index c0aacf1e6..32e7fcdd7 100644 --- a/library/matrix.yap +++ b/library/matrix.yap @@ -22,20 +22,21 @@ This package provides a fast implementation of multi-dimensional matrices of integers and floats. In contrast to dynamic arrays, these matrices are multi-dimensional and compact. In contrast to static -arrays. these arrays are allocated in the stack. Matrices are available -by loading the library `library(matrix)`. They are multimensional -objects of type: +arrays. these arrays are allocated in the stack, and disppear in +backtracking. Matrices are available by loading the library +`library(matrix)`. They are multimensional objects of type: + terms: Prolog terms + + ints: bounded integers, represented as an opaque term. The maximum integer depends on hardware, but should be obtained from the natural size of the machine. -+ floats: floating-poiny numbers, represented as an opaque term. ++ floats: floating-point numbers, represented as an opaque term. Matrix elements can be accessed through the `matrix_get/2` predicate or through an R-inspired access notation (that uses the ciao -style extension to `[]`. Examples include: +style extension to `[]`). Examples include: + Access the second row, third column of matrix X. Indices start from @@ -160,21 +161,23 @@ of matrix _M_ at offset _Offset_. create a matrix from a list. Options are: + dim= -a list of dimensions - + type= -integers, floating-point or terms + a list of dimensions + + + type= + integers, floating-point or terms + + base= -a list of base offsets per dimension (all must be the same for arrays of + a list of base offsets per dimension (all must be the same for arrays of integers and floating-points + `matrix/3` create matrix giving two options - + `dim/1` ++ `dim/1` list with matrix dimensions - + `nrow/1` ++ `nrow/1` number of rows in bi-dimensional matrix + `ncol/1` @@ -227,8 +230,9 @@ all elements of a matrix or list + `* /2` - multiply two numbers, multiply two matrices or lists element-by-element, or multiply a number from -all elements of a matrix or list + multiply two numbers, multiply two matrices or lists + element-by-element, or multiply a number from all elements of a + matrix or list + `log/1` @@ -566,10 +570,9 @@ Unify _NElems_ with the type of the elements in _Matrix_. */ :- module( matrix, - [op(100, yf, []), - (<==)/2, op(710, xfx, '<=='), - op(580, xfx, in), - op(580, xfx, ins), + [(<==)/2, op(600, xfx, '<=='), + op(700, xfx, in), + op(700, xfx, ins), op(450, xfx, ..), % should bind more tightly than \/ op(590, xfx, of), of/2, matrix_new/3, @@ -922,7 +925,7 @@ mtimes(I1, I2, V) :- % % three types of matrix: integers, floats and general terms. -% +ยง% matrix_new(terms,Dims, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :- length(Dims,NDims), diff --git a/misc/mkandroid b/misc/mkandroid index 3071a45dd..0d479ab43 100755 --- a/misc/mkandroid +++ b/misc/mkandroid @@ -11,7 +11,7 @@ # ANDROID_RELEASE= 17 is 4.2.2, 19 is 4.4.2 -ANDROID_RELEASE=19 +ANDROID_RELEASE=17 # ANDROID_ARCH= arm, x86, mips ANDROID_ARCH=arm # ANDROID_BUILD=linux diff --git a/packages/jpl b/packages/jpl index ec046839d..d8add7b7d 160000 --- a/packages/jpl +++ b/packages/jpl @@ -1 +1 @@ -Subproject commit ec046839d6f64e030d08bd8781cdc1495fc37f7c +Subproject commit d8add7b7d10f57ce1b96653799b6a5662e3dc5a9 diff --git a/packages/real b/packages/real index 86b82220e..9ee28c079 160000 --- a/packages/real +++ b/packages/real @@ -1 +1 @@ -Subproject commit 86b82220ec929fab1e648109c53f5b46b0569190 +Subproject commit 9ee28c0798c4d7b348c8033e84da6c0a81887e79 diff --git a/pl/absf.yap b/pl/absf.yap index 22b05bef6..dbb25d665 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -76,7 +76,7 @@ 3. `executable` implies `['.so', ',dylib', '.dll']` depending on the Operating system, - 4. `qlf` implies `['.qlf', '']`, + 4. `qly` implies `['.qly', '']`, 5. `directory` implies `['']`, @@ -209,7 +209,7 @@ absolute_file_name(File0,File) :- '$check_fn_type'(prolog,_) :- !. '$check_fn_type'(source,_) :- !. '$check_fn_type'(executable,_) :- !. -'$check_fn_type'(qlf,_) :- !. +'$check_fn_type'(qly,_) :- !. '$check_fn_type'(directory,_) :- !. '$check_fn_type'(T,G) :- atom(T), !, '$do_error'(domain_error(file_type,T),G). @@ -563,6 +563,8 @@ remove_from_path(New) :- '$check_path'(New,Path), prolog_file_type(yap, prolog). prolog_file_type(pl, prolog). prolog_file_type(prolog, prolog). + prolog_file_type(qly, prolog). + prolog_file_type(qly, qly). prolog_file_type(A, prolog) :- current_prolog_flag(associate, A), A \== prolog, @@ -586,8 +588,8 @@ user:prolog_file_type(A, prolog) :- A \== prolog, A \==pl, A \== yap. -%user:prolog_file_type(qlf, prolog). -%user:prolog_file_type(qlf, qlf). +user:prolog_file_type(qly, prolog). +user:prolog_file_type(qly, qly). user:prolog_file_type(A, executable) :- current_prolog_flag(shared_object_extension, A). diff --git a/pl/consult.yap b/pl/consult.yap index 3ef22a481..3eac4a7ef 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -30,7 +30,8 @@ source_file/1, source_file/2, source_file_property/2, - use_module/3], ['$add_multifile'/3, + use_module/3], + ['$add_multifile'/3, '$csult'/2, '$do_startup_reconsult'/1, '$elif'/2, @@ -92,62 +93,79 @@ files and to set-up the Prolog environment. We discuss General implementation of the consult/1 family. Execution is controlled by the following flags: - + consult(+ _Mode_) - This extension controls the type of file to load. If _Mode_ is: - `consult`, clauses are added to the data-base, unless from the same file; - `reconsult`, clauses are recompiled, - `db`, these are facts that need to be added to the data-base, - `exo`, these are facts with atoms and integers that can be stored in a compact representation (see load_exo/1). ++ consult(+ _Mode_) - + silent(+ _Bool_) - If true, load the file without printing a message. The specified value is the default for all files loaded as a result of loading the specified files. + This extension controls the type of file to load. If _Mode_ is: + + `consult`, clauses are added to the data-base, unless from the same file; + `reconsult`, clauses are recompiled, + `db`, these are facts that need to be added to the data-base, + `exo`, these are facts with atoms and integers that can be stored in a compact representation (see load_exo/1). - + stream(+ _Input_) - This SWI-Prolog extension compiles the data from the stream _Input_. If this option is used, _Files_ must be a single atom which is used to identify the source-location of the loaded -clauses as well as remove all clauses if the data is re-consulted. ++ silent(+ _Bool_) - This option is added to allow compiling from non-file locations such as databases, the web, the user (see consult/1) or other servers. + If true, load the file without printing a message. The specified + value is the default for all files loaded as a result of loading + the specified files. - + compilation_mode(+ _Mode_) - This extension controls how procedures are compiled. If _Mode_ - is `compact` clauses are compiled and no source code is stored; - if it is `source` clauses are compiled and source code is stored; - if it is `assert_all` clauses are asserted into the data-base. ++ stream(+ _Input_) - + encoding(+ _Encoding_) - Character encoding used in consulting files. Please (see [Encoding](@ref Encoding)) for - supported encodings. + This SWI-Prolog extension compiles the data from the stream + _Input_. If this option is used, _Files_ must be a single atom + which is used to identify the source-location of the loaded + clauses as well as remove all clauses if the data is re-consulted. -+ expand(+ _Bool_) - If `true`, run the - filenames through expand_file_name/2 and load the returned - files. Default is false, except for consult/1 which is - intended for interactive use. + This option is added to allow compiling from non-file locations + such as databases, the web, the user (see consult/1) or other + servers. - + if(+ _Condition_) - Load the file only if the specified _Condition_ is - satisfied. The value `true` the file unconditionally, - `changed` loads the file if it was not loaded before, or has - been modified since it was loaded the last time, `not_loaded` - loads the file if it was not loaded before. ++ compilation_mode(+ _Mode_) - + imports(+ _ListOrAll_) - If `all` and the file is a module file, import all public - predicates. Otherwise import only the named predicates. Each - predicate is referred to as `\/\`. This option has - no effect if the file is not a module file. + This extension controls how procedures are compiled. If _Mode_ is + `compact` clauses are compiled and no source code is stored; if it + is `source` clauses are compiled and source code is stored; if it + is `assert_all` clauses are asserted into the data-base. - + must_be_module(+ _Bool_) - If true, raise an error if the file is not a module file. Used by -` use_module/1 and use_module/2. ++ encoding(+ _Encoding_) - + autoload(+ _Autoload_) - SWI-compatible option where if _Autoload_ is `true` undefined predicates - are loaded on first call. + Character encoding used in consulting files. Please (see + [Encoding](@ref Encoding)) for supported encodings. + ++ expand(+ _Bool_) + + If `true`, run the filenames through expand_file_name/2 and load + the returned files. Default is false, except for consult/1 which + is intended for interactive use. + ++ if(+ _Condition_) + + Load the file only if the specified _Condition_ is satisfied. The + value `true` the file unconditionally, `changed` loads the file if + it was not loaded before, or has been modified since it was loaded + the last time, `not_loaded` loads the file if it was not loaded + before. + ++ imports(+ _ListOrAll_) + + If `all` and the file is a module file, import all public + predicates. Otherwise import only the named predicates. Each + predicate is referred to as `\/\`. This option has + no effect if the file is not a module file. + ++ must_be_module(+ _Bool_) + + If true, raise an error if the file is not a module file. Used by + ` use_module/1 and use_module/2. + ++ autoload(+ _Autoload_) + + SWI-compatible option where if _Autoload_ is `true` undefined + predicates are loaded on first call. + ++ derived_from(+ _File_) + + SWI-compatible option to control make/0. Currently not supported. - + derived_from(+ _File_) - SWI-compatible option to control make/0. Currently - not supported. */ % % SWI options @@ -368,13 +386,18 @@ load_files(Files,Opts) :- '$lf'([F|Fs], Mod, Call, TOpts) :- !, % clean up after each consult ( '$lf'(F,Mod,Call, TOpts), fail ; - '$lf'(Fs, Mod, Call, TOpts) ). + '$lf'(Fs, Mod, Call, TOpts), fail; + true + ). '$lf'(user, Mod, _, TOpts) :- !, + b_setval('$source_file', user_input), '$do_lf'(Mod, user_input, user_input, TOpts). '$lf'(user_input, Mod, _, TOpts) :- !, + 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) -> /* need_to_open_file */ '$full_filename'(File, Y, Call), @@ -664,16 +687,16 @@ 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, ModExports, _),_), + recorded('$module','$module'(File, Module, _Source, ModExports, _),_), Module \= ContextModule, !, - '$lf_opt'('$call', TOpts, Call), +% '$lf_opt'('$call', TOpts, Call), '$convert_for_export'(Imports, ModExports, Module, ContextModule, TranslationTab, RemainingImports, Goal), '$add_to_imports'(TranslationTab, Module, ContextModule). '$import_to_current_module'(_, _, _, _, _). @@ -888,9 +911,9 @@ prolog_load_context(source, F0) :- prolog_load_context(stream, Stream) :- '$nb_getval'('$consulting_file', _, fail), '$current_loop_stream'(Stream). -% return this term for SWI compatibility. -prolog_load_context(term_position, '$stream_position'(0,Line,0,0,0)) :- - source_location(_, Line). +prolog_load_context(term_position, Position) :- + '$current_loop_stream'(Stream), + stream_property(Stream, position(Position) ). % if the file exports a module, then we can @@ -902,7 +925,7 @@ prolog_load_context(term_position, '$stream_position'(0,Line,0,0,0)) :- '$import_to_current_module'(F1, M, Imports, _, TOpts). '$ensure_file_loaded'(F, M, F1) :- - recorded('$module','$module'(F1,_NM,_P,_),_), + recorded('$module','$module'(F1,_NM,_Source,_P,_),_), recorded('$lf_loaded','$lf_loaded'(F1, _, _),_), same_file(F1,F), !. '$ensure_file_loaded'(F, M, F1) :- @@ -920,7 +943,7 @@ prolog_load_context(term_position, '$stream_position'(0,Line,0,0,0)) :- '$import_to_current_module'(F1, M, Imports, _, TOpts). '$ensure_file_unchanged'(F, M, F1) :- - recorded('$module','$module'(F1,_NM,_P,_),_), + recorded('$module','$module'(F1,_NM,_,_P,_),_), recorded('$lf_loaded','$lf_loaded'(F1,Age,_),R), same_file(F1,F), !, '$file_is_unchanged'(F, R, Age). @@ -1046,7 +1069,7 @@ source_file_property( File0, Prop) :- '$source_file_property'( F, modified(Age)) :- recorded('$lf_loaded','$lf_loaded'( F, Age, _), _). '$source_file_property'( F, module(M)) :- - recorded('$module','$module'(F,M,_,_),_). + recorded('$module','$module'(F,M,_,_,_),_). /** @@ -1094,13 +1117,13 @@ use_module(M,F,Is) :- '$use_module'(M,F,Is). ( var(M) -> true ; absolute_file_name( F0, F1, [expand(true),file_type(prolog)] ), - recorded('$module','$module'(F1,M,_,_),_) + recorded('$module','$module'(F1,M,_,_,_),_) ). '$use_module'(M,F,Is) :- nonvar(M), !, strip_module(F, M0, F0), ( - recorded('$module','$module'(F1,M,_,_),_) + recorded('$module','$module'(F1,M,_,_,_),_) -> '$load_files'(M0:F1, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) ), @@ -1178,9 +1201,11 @@ may result in incorrect execution. This section presents a set of built-ins predicates designed to set the environment for the compiler. - prolog_to_os_filename(+ _PrologPath_,- _OsPath_) @anchor prolog_to_os_filename +*/ + +/** @pred prolog_to_os_filename(+ _PrologPath_,- _OsPath_) This is an SWI-Prolog built-in. Converts between the internal Prolog pathname conventions and the operating-system pathname conventions. The @@ -1223,8 +1248,6 @@ last one, onto underscores. fail. '$remove_multifile_clauses'(_). - - /** @pred initialization(+ _G_) is iso The compiler will execute goals _G_ after consulting the current file. diff --git a/pl/directives.yap b/pl/directives.yap index 97f259c85..586d09b36 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -97,7 +97,12 @@ '$exec_directives'(G1, Mode, M, VL, Pos), '$exec_directives'(G2, Mode, M, VL, Pos). '$exec_directives'(G, Mode, M, VL, Pos) :- - '$exec_directive'(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),_). '$exec_directive'(multifile(D), _, M, _, _) :- '$system_catch'('$multifile'(D, M), M, diff --git a/pl/load_foreign.yap b/pl/load_foreign.yap index 52f44e6b1..20e0ed4a2 100644 --- a/pl/load_foreign.yap +++ b/pl/load_foreign.yap @@ -58,13 +58,19 @@ load_foreign_files(_Objs,_Libs,_Entry) :- recorded( '$load_foreign_done', [F, M0], _), !, '$import_foreign'(F, M0, M). load_foreign_files(Objs,Libs,Entry) :- - '$check_objs_for_load_foreign_files'(Objs,NewObjs,load_foreign_files(Objs,Libs,Entry)), - '$check_libs_for_load_foreign_files'(Libs,NewLibs,load_foreign_files(Objs,Libs,Entry)), - '$check_entry_for_load_foreign_files'(Entry,load_foreign_files(Objs,Libs,Entry)), - '$load_foreign_files'(NewObjs,NewLibs,Entry), + '$check_objs_for_load_foreign_files'(Objs,NewObjs,load_foreign_files(Objs,Libs,Entry)), + '$check_libs_for_load_foreign_files'(Libs,NewLibs,load_foreign_files(Objs,Libs,Entry)), + '$check_entry_for_load_foreign_files'(Entry,load_foreign_files(Objs,Libs,Entry)), + '$load_foreign_files'(NewObjs,NewLibs,Entry), + ignore( recordzifnot( '$foreign', M:'$foreign'(Objs,Libs,Entry), _) ), + ( prolog_load_context(file, F), - prolog_load_context(module, M), - ignore( recordzifnot( '$load_foreign_done', [F, M], _) ), !. + prolog_load_context(module, M) + -> + ignore( recordzifnot( '$load_foreign_done', [F, M], _) ) + ; + true + ), !. '$check_objs_for_load_foreign_files'(V,_,G) :- var(V), !, '$do_error'(instantiation_error,G). @@ -147,7 +153,7 @@ dlerror(). */ open_shared_object(File, Handle) :- - '$open_shared_object'(File, 0, Handle). + open_shared_object(File, [], Handle). /** @pred open_shared_object(+ _File_, - _Handle_, + _Options_) @@ -165,7 +171,9 @@ flags are silently ignored. */ open_shared_object(File, Opts, Handle) :- '$open_shared_opts'(Opts, open_shared_object(File, Opts, Handle), OptsI), - '$open_shared_object'(File, OptsI, Handle). + '$open_shared_object'(File, OptsI, Handle), + prolog_load_context(module, M), + ignore( recordzifnot( '$foreign', M:'$swi_foreign'(File,Opts, Handle), _) ). '$open_shared_opts'(Opts, G, OptsI) :- var(Opts), !, @@ -184,17 +192,18 @@ open_shared_object(File, Opts, Handle) :- '$open_shared_opt'(Opt, Goal, _) :- '$do_error'(domain_error(open_shared_object_option,Opt),Goal). -/** @pred call_shared_object_function(+ _Handle_, + _Function_) - - -Call the named function in the loaded shared library. The function -is called without arguments and the return-value is -ignored. In SWI-Prolog, normally this function installs foreign -language predicates using calls to `PL_register_foreign()`. - +/** @pred call_shared_object_function(+ _Handle_, + _Function_) +Call the named function in the loaded shared library. The function is +called without arguments and the return-value is ignored. YAP supports +installing foreign language predicates using calls to 'UserCCall()`, +`PL_register_foreign()`, and friends. */ +call_shared_object_function( Handle, Function) :- + '$call_shared_object_function'( Handle, Function), + prolog_load_context(module, M), + ignore( recordzifnot( '$foreign', M:'$swi_foreign'( Handle, Function ), _) ). %%! @} diff --git a/pl/modules.yap b/pl/modules.yap index c9bb88339..5e7d811f0 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -389,7 +389,8 @@ name with the `:/2` operator. **/ '$module_dec'(N, Ps) :- source_location(F, _), - '$add_module_on_file'(N, F, Ps), + b_getval( '$source_file', F0 ), + '$add_module_on_file'(N, F, F0, Ps), '$current_module'(_,N). '$module'(_,N,P) :- @@ -399,7 +400,7 @@ name with the `:/2` operator. \pred module(+ M:atom,+ L:list ) is directive the current file defines module _M_ with exports _L_. The list may include - + predicatae indicators + + predicate indicators + operator definitions that look like calls to op/3. @@ -479,21 +480,21 @@ of predicates. '$prepare_restore_hidden'(Old,New) :- recorda('$system_initialisation', source_mode(New,Old), _). -'$add_module_on_file'(DonorMod, DonorF, Exports) :- - recorded('$module','$module'(DonorF, DonorMod, _, _),R), +'$add_module_on_file'(DonorMod, DonorF, SourceF, Exports) :- + recorded('$module','$module'(DonorF, DonorMod, _, _, _),R), % the module has been found, are we reconsulting? ( DonorF \= OtherF -> '$do_error'(permission_error(module,redefined,DonorMod, OtherFile, DonorF),module(Mod,Exports)) ; - recorded('$module','$module'(DonorF,DonorM, _, _), R), + recorded('$module','$module'(DonorF,DonorMod, SourceF, _, _), R), erase( R ), fail ). -'$add_module_on_file'(DonorM, DonorF, Exports) :- +'$add_module_on_file'(DonorM, DonorF, SourceF, Exports) :- '$current_module'( HostM ), - ( recorded('$module','$module'( HostF, HostM, _, _),_) -> true ; HostF = user_input ), + ( recorded('$module','$module'( HostF, HostM, _, _, _),_) -> true ; HostF = user_input ), % first build the initial export tablee '$convert_for_export'(all, Exports, DonorM, HostM, TranslationTab, AllExports0, load_files), sort( AllExports0, AllExports ), @@ -501,17 +502,17 @@ of predicates. '$add_to_imports'(TranslationTab, DonorM, DonorM), % insert ops, at least for now % last, export everything to the host: if the loading crashed you didn't actually do % no evil. - recorda('$module','$module'(DonorF,DonorM,AllExports, Line),_). + recorda('$module','$module'(DonorF,DonorM,SourceF, AllExports, Line),_). '$extend_exports'(HostF, Exports, DonorF ) :- - ( recorded('$module','$module'( DonorF, DonorM, _, DonorExports),_) -> true ; DonorF = user_input ), - ( recorded('$module','$module'( HostF, HostM, _, _),_) -> true ; HostF = user_input ), - recorded('$module','$module'(HostF,HostM,AllExports, _Line), R), erase(R), + ( recorded('$module','$module'( DonorF, DonorM, SourceF, _, DonorExports),_) -> true ; DonorF = user_input ), + ( recorded('$module','$module'( HostF, HostM, _, _, _),_) -> true ; HostF = user_input ), + recorded('$module','$module'(HostF, HostM, _, AllExports, _Line), R), erase(R), '$convert_for_export'(Exports, DonorExports, DonorM, HostM, TranslationTab, AllReExports, reexport(DonorF, Exports)), lists:append( AllReExports, AllExports, Everything0 ), sort( Everything0, Everything ), ( source_location(_, Line) -> true ; Line = 0 ), - recorda('$module','$module'(HostF,HostM,Everything, Line),_). + recorda('$module','$module'(HostF,HostM,SourceF, Everything, Line),_). '$module_produced by'(M, M0, N, K) :- recorded('$import','$import'(M,M0,_,_,N,K),_), !. @@ -552,7 +553,7 @@ Succeeds if _M_ are current modules associated to the file _F_. */ current_module(Mod,TFN) :- '$all_current_modules'(Mod), - ( recorded('$module','$module'(TFN,Mod,_Publics, _),_) -> true ; TFN = user ). + ( recorded('$module','$module'(TFN,Mod,_,_Publics, _),_) -> true ; TFN = user ). /** \pred source_module( - Mod:atom ) is nondet : _Mod_ is the current read-in or source module. @@ -1153,7 +1154,7 @@ be associated to a new file. get rid of a module and of all predicates included in the module. */ abolish_module(Mod) :- - recorded('$module','$module'(_,Mod,_,_),R), erase(R), + recorded('$module','$module'(_,Mod,_,_,_),R), erase(R), fail. abolish_module(Mod) :- recorded('$import','$import'(Mod,_,_,_,_,_),R), erase(R), @@ -1180,23 +1181,23 @@ export_resource(Resource) :- export_resource(P) :- P = F/N, atom(F), number(N), N >= 0, !, '$current_module'(Mod), - ( recorded('$module','$module'(File,Mod,ExportedPreds,Line),R) -> + ( recorded('$module','$module'(File,Mod,SourceF,ExportedPreds,Line),R) -> erase(R), recorda('$module','$module'(File,Mod,[P|ExportedPreds],Line),_) ; prolog_load_context(file, File) -> - recorda('$module','$module'(File,Mod,[P],Line),_) - ; recorda('$module','$module'(user_input,Mod,[P],1),_) + recorda('$module','$module'(File,Mod,SourceF,[P],Line),_) + ; recorda('$module','$module'(user_input,Mod,user_input,[P],1),_) ). export_resource(P0) :- P0 = F//N, atom(F), number(N), N >= 0, !, N1 is N+2, P = F/N1, '$current_module'(Mod), - ( recorded('$module','$module'(File,Mod,ExportedPreds,Line),R) -> + ( recorded('$module','$module'(File,Mod,SourceF,ExportedPreds,Line),R) -> erase(R), - recorda('$module','$module'(File,Mod,[P|ExportedPreds],Line ),_) + recorda('$module','$module'(File,Mod,SourceF,[P|ExportedPreds],Line ),_) ; prolog_load_context(file, File) -> - recorda('$module','$module'(File,Mod,[P],Line),_) - ; recorda('$module','$module'(user_input,Mod,[P],1),_) + recorda('$module','$module'(File,Mod,SourceF,[P],Line),_) + ; recorda('$module','$module'(user_input,Mod,user_input,[P],1),_) ). export_resource(op(Prio,Assoc,Name)) :- !, op(Prio,Assoc,prolog:Name). @@ -1204,7 +1205,7 @@ export_resource(Resource) :- '$do_error'(type_error(predicate_indicator,Resource),export(Resource)). export_list(Module, List) :- - recorded('$module','$module'(_,Module,List,_),_). + recorded('$module','$module'(_,Module,_,List,_),_). '$convert_for_export'(all, Exports, _Module, _ContextModule, Tab, MyExports, _) :- '$simple_conversion'(Exports, Tab, MyExports). @@ -1334,7 +1335,7 @@ export_list(Module, List) :- op(Prio,Assoc,ContextMod:Name). '$do_import'(N0/K0-N0/K0, Mod, Mod) :- !. '$do_import'(_N/K-N1/K, _Mod, ContextMod) :- - recorded('$module','$module'(_F, ContextMod, MyExports,_),_), + recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_), once(lists:member(N1/K, MyExports)), functor(S, N1, K), % reexport predicates if they are undefined in the current module. @@ -1380,10 +1381,10 @@ export_list(Module, List) :- ( C == e -> halt(1) ; C == y ). '$redefine_action'(true, M1, _, _, _, _) :- !, - recorded('$module','$module'(F, M1, _MyExports,_Line),_), + recorded('$module','$module'(F, M1, _, _MyExports,_Line),_), unload_file(F). '$redefine_action'(false, M1, M2, M, ContextM, N/K) :- - recorded('$module','$module'(F, ContextM, _MyExports,_Line),_), + recorded('$module','$module'(F, ContextM, _, _MyExports,_Line),_), '$current_module'(_, M2), '$do_error'(permission_error(import,M1:N/K,redefined,M2),F). @@ -1503,11 +1504,11 @@ delete_import_module(Mod, ImportModule) :- module_property(Mod, class(L)) :- '$module_class'(Mod, L). module_property(Mod, line_count(L)) :- - recorded('$module','$module'(_F,Mod,_,L),_). + recorded('$module','$module'(_F,Mod,_,_,L),_). module_property(Mod, file(F)) :- - recorded('$module','$module'(F,Mod,_,_),_). + recorded('$module','$module'(F,Mod,_,_,_),_). module_property(Mod, exports(Es)) :- - recorded('$module','$module'(_,Mod,Es,_),_). + recorded('$module','$module'(_,Mod,_,Es,_),_). '$module_class'(Mod, system) :- '$system_module'( Mod ). '$module_class'(Mod, library) :- '$library_module'( Mod ). @@ -1517,7 +1518,7 @@ module_property(Mod, exports(Es)) :- '$module_class'(_, development) :- fail. '$library_module'(M1) :- - recorded('$module','$module'(F, M1, _MyExports,_Line),_), + recorded('$module','$module'(F, M1, _, _MyExports,_Line),_), user:library_directory(D), sub_atom(F, 0, _, _, D). diff --git a/pl/preds.yap b/pl/preds.yap index 1fc14eb33..cf0fc9da7 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -1097,7 +1097,7 @@ predicate_property(Pred,Prop) :- '$is_thread_local'(P,M). '$predicate_property'(P,M,M,exported) :- functor(P,N,A), - once(recorded('$module','$module'(_TFN,M,Publics,_L),_)), + once(recorded('$module','$module'(_TFN,M,_S,Publics,_L),_)), lists:memberchk(N/A,Publics). '$predicate_property'(P,Mod,_,number_of_clauses(NCl)) :- '$number_of_clauses'(P,Mod,NCl). diff --git a/pl/qly.yap b/pl/qly.yap index e545a5780..21561a13b 100755 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -390,37 +390,71 @@ save_program(File, _Goal) :- /** @pred qsave_file(+ _File_, +_State_) -Saves an image of all the information compiled by the systemm from file _F_ to _State_. +Saves an image of all the information compiled by the system from file _F_ to _State_. This includes modules and predicatees eventually including multi-predicates. **/ +qsave_file(F0, State) :- + absolute_file_name( F0, File, [expand(true),file_type(qly)]), + '$qsave_file_'(File, State). -qsave_file(File, State) :- - recorded('$module', '$module'(File,Mod,Exps,Line), _), - '$fetch_parents_module'(Mod, Parents), - '$fetch_imports_module'(Mod, Imps), - '$fetch_multi_files_module'(Mod, MFs), - '$fetch_meta_predicates_module'(Mod, Metas), - '$fetch_module_transparents_module'(Mod, ModTransps), - asserta(Mod:'@mod_info'(F, Exps, Line, Parents, Imps, Metas, ModTransps)), - atom_concat(Mod,'.qly',OF), +'$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 ), + 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 ), + fail. +'$qsave_file_'(File, _State) :- + '$fetch_multi_files_file'(File, MultiFiles), + assert(prolog:'$file_property'( multifile(MultiFiles ) ) ), + '$set_owner_file'(prolog:'$file_property'( _ ), File ), + fail. +'$qsave_file_'( File, State ) :- + ( + is_stream( State ) + -> + stream_property(Stream, file_name(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_module_preds'(S, Mod), - close(S), - abolish(Mod:'@mod_info'/7), - fail. -qsave_file(_,_). + '$qsave_file_preds'(S, File), + close(S) + ), abolish(prolog:'$file_property'/1). + +'$fetch_multi_files_file'(File, Multi_Files) :- + setof(Info, '$fetch_multi_file_module'(File, Info), Multi_Files). + +'$fetch_multi_file_file'(FileName, (M:G :- Body)) :- + recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _), + functor(G, Name, Arity ), + clause(M:G, Body, ClauseRef), + clause_property(ClauseRef, file(FileName) ). + +>>>>>>> 3e255ec4a19d133a896343a39ba41bedf47d1ea9 /** @pred qsave_module(+ _Module_, +_State_) Saves an image of all the information compiled by the systemm on module _F_ to _State_. **/ qsave_module(Mod, OF) :- +<<<<<<< HEAD recorded('$module', '$module'(F,Mod,Exps,L),_), +======= + recorded('$module', '$module'(F,Mod,_S,Exps,L), _), +>>>>>>> 3e255ec4a19d133a896343a39ba41bedf47d1ea9 '$fetch_parents_module'(Mod, Parents), '$fetch_imports_module'(Mod, Imps), '$fetch_multi_files_module'(Mod, MFs), '$fetch_meta_predicates_module'(Mod, Metas), '$fetch_module_transparents_module'(Mod, ModTransps), +<<<<<<< HEAD asserta(Mod:'@mod_info'(F, Exps, L, Parents, Imps, Metas, ModTransps)) , atom_concat(Mod,'.qly',OF), open(OF, write, S, [type(binary)]), @@ -437,6 +471,37 @@ qsave_module(Mod) :- atom_concat( Mod, '.qly', F), qsave_module( Mod, F). +======= + asserta(Mod:'@mod_info'(F, Exps, L, Parents, Imps, Metas, + ModTransps)), open(OF, write, S, [type(binary)]), + '$qsave_module_preds'(S, Mod), close(S), + abolish(Mod:'@mod_info'/7), fail. + qsave_module(_, _). + +/** @pred qsave_module(+ _Module_) + +Saves an image of all the information compiled by the systemm on +module _F_ to a file _State.qly_ in the current directory. + +**/ + +qsave_module(Mod) :- + recorded('$module', '$module'(F,Mod,_S,Exps,L), _), + '$fetch_parents_module'(Mod, Parents), + '$fetch_imports_module'(Mod, Imps), + '$fetch_multi_files_module'(Mod, MFs), + '$fetch_meta_predicates_module'(Mod, Metas), + '$fetch_module_transparents_module'(Mod, ModTransps), + '$fetch_foreigns_module'(Mod, Foreigns), + asserta(Mod:'@mod_info'(F, Exps, L, Parents, Imps, Metas, ModTransps, Foreigns)), + atom_concat(Mod,'.qly',OF), + open(OF, write, S, [type(binary)]), + '$qsave_module_preds'(S, Mod), + close(S), + abolish(Mod:'@mod_info'/7), + fail. +qsave_module(_). +>>>>>>> 3e255ec4a19d133a896343a39ba41bedf47d1ea9 /** @pred restore(+ _F_) @@ -449,20 +514,31 @@ restore(File) :- close(S). /** -@pred qload_module(+ _F_) -Restores a previously saved state of YAP with from file _F_. +@pred qload_module(+ _M_) + +Restores a previously save image of module _M_. This built-in searches +for a file M.qly or M according to the rules for qly files. + +The q_load_module/1 built-in tries to reload any modules it imports +from and any foreign files that had been loaded with the original +module. It tries first reloading from qly images, but if they are not +available it tries reconsulting the source file. */ qload_module(Mod) :- - atom_concat(Mod,'.qly',IF), - open(IF, read, S, [type(binary)]), + absolute_file_name( Mod, File, [expand(true),file_type(qly)]), + '$qload_module'(Mod, File). + +'$qload_module'(Mod, File) :- + open(File, read, S, [type(binary)]), '$qload_module_preds'(S), close(S), fail. -qload_module(Mod) :- +'$qload_module'(Mod, _File) :- '$complete_read'(Mod). '$complete_read'(Mod) :- +<<<<<<< HEAD '$current_module'(HostMod), retract(Mod:'@mod_info'(F, Exps, Line,Parents, Imps, Metas, ModTransps)), abolish(Mod:'$mod_info'/7), @@ -478,75 +554,170 @@ qload_module(Mod) :- sort( AllExports0, AllExports ), recorda('$module','$module'(F,Mod,F,AllExports, Line),_). +======= + '$current_module'(CurrentModule), + retract(Mod:'@mod_info'(F, Exps, Line,Parents, Imps, Metas, ModTransps, Foreigns)), + abolish(Mod:'$mod_info'/7), + recorda('$module', '$module'(F,Mod,Exps,Line), _), + '$install_parents_module'(Mod, Parents), + '$install_imports_module'(Mod, Imps, []), + '$install_multi_files_module'(Mod, MFs), + '$install_meta_predicates_module'(Mod, Metas), + '$install_foreigns_module'(Mod, Foreigns), + '$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts). + +>>>>>>> 3e255ec4a19d133a896343a39ba41bedf47d1ea9 '$fetch_imports_module'(Mod, Imports) :- findall(Info, '$fetch_import_module'(Mod, Info), Imports). -% detect an importerator that is local to the module. -'$fetch_import_module'(Mod, '$import'(Mod0,Mod,G0,G,N,K)) :- - recorded('$import', '$import'(Mod0,Mod,G0,G,N,K), _). +% detect an import that is local to the module. +'$fetch_import_module'(Mod, '$import'(Mod0,Mod,G0,G,N,K) - S) :- + recorded('$import', '$import'(Mod0,Mod,G0,G,N,K), _), + ( recorded('$module','$module'(_, Mod0, S, _, _), R) -> true ; S = user_input ). '$fetch_parents_module'(Mod, Parents) :- findall(Parent, prolog:'$parent_module'(Mod,Parent), Parents). '$fetch_module_transparents_module'(Mod, Module_Transparents) :- - findall(Info, '$fetch_module_transparent_module'(Mod, Info), Module_Transparents). + setof(Info, '$fetch_module_transparent_module'(Mod, Info), Module_Transparents). % detect an module_transparenterator that is local to the module. '$fetch_module_transparent_module'(Mod, '$module_transparent'(F,Mod,N,P)) :- prolog:'$module_transparent'(F,Mod0,N,P), Mod0 == Mod. '$fetch_meta_predicates_module'(Mod, Meta_Predicates) :- - findall(Info, '$fetch_meta_predicate_module'(Mod, Info), Meta_Predicates). + setof(Info, '$fetch_meta_predicate_module'(Mod, Info), Meta_Predicates). -% detect an meta_predicateerator that is local to the module. +% detect a meta_predicate that is local to the module. '$fetch_meta_predicate_module'(Mod, '$meta_predicate'(F,Mod,N,P)) :- prolog:'$meta_predicate'(F,Mod0,N,P), Mod0 == Mod. '$fetch_multi_files_module'(Mod, Multi_Files) :- - findall(Info, '$fetch_multi_file_module'(Mod, Info), Multi_Files). + setof(Info, '$fetch_multi_file_module'(Mod, Info), Multi_Files). -% detect an multi_fileerator that is local to the module. +% detect an multi_file that is local to the module. '$fetch_multi_file_module'(Mod, '$defined'(FileName,Name,Arity,Mod)) :- recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _). '$fetch_term_expansions_module'(Mod, Term_Expansions) :- - findall(Info, '$fetch_term_expansion_module'(Mod, Info), Term_Expansions). + setof(Info, '$fetch_term_expansion_module'(Mod, Info), Term_Expansions). % detect an term_expansionerator that is local to the module. '$fetch_term_expansion_module'(Mod,'$defined'(FileName,Name,Arity,Mod)) :- recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _). +'$fetch_foreigns_module'(Mod, Foreigns) :- + setof(Info, '$fetch_foreign_module'(Mod, Info), Foreigns). +% detect an term_expansionerator that is local to the module. +'$fetch_foreign_module'(Mod,Foreign) :- + recorded( '$foreign', Mod:Foreign, _). '$install_ops_module'(_, []). -'$install_ops_module'(Mod, op(X,Y,Op).Ops) :- +'$install_ops_module'(Mod, [op(X,Y,Op)|Ops]) :- op(X, Y, Mod:Op), '$install_ops_module'(Mod, Ops). -'$install_imports_module'(_, []). -'$install_imports_module'(Mod, Import.Imports) :- +'$install_imports_module'(_, [], Fs0) :- + sort(Fs0, Fs), + '$restore_load_files'(Fs). +'$install_imports_module'(Mod, [Import-F|Imports], Fs0) :- recordz('$import', Import, _), - '$install_imports_module'(Mod, Imports). + arg(1, Import, M), + '$install_imports_module'(Mod, Imports, [M-F|Fs0]). + +'$restore_load_files'([]). +'$restore_load_files'([M-F0|Fs]) :- + ( + absolute_file_name( M, File, [expand(true),file_type(qly),access(read),file_errors(fail)]) + -> + qload_module(M) + ; + use_module(M, F0, _) + ), + '$restore_load_files'(Fs). '$install_parents_module'(_, []). -'$install_parents_module'(Mod, Parent.Parents) :- +'$install_parents_module'(Mod, [Parent|Parents]) :- assert(prolog:Parent), '$install_parents_module'(Mod, Parents). '$install_module_transparents_module'(_, []). -'$install_module_transparents_module'(Mod, Module_Transparent.Module_Transparents) :- +'$install_module_transparents_module'(Mod, [Module_Transparent|Module_Transparents]) :- assert(prolog:Module_Transparent), '$install_module_transparents_module'(Mod, Module_Transparents). '$install_meta_predicates_module'(_, []). -'$install_meta_predicates_module'(Mod, Meta_Predicate.Meta_Predicates) :- +'$install_meta_predicates_module'(Mod, [Meta_Predicate|Meta_Predicates]) :- assert(prolog:Meta_Predicate), '$install_meta_predicates_module'(Mod, Meta_Predicates). '$install_multi_files_module'(_, []). -'$install_multi_files_module'(Mod, Multi_File.Multi_Files) :- - recordz('$multifile_defs',Multi_File, _). +'$install_multi_files_module'(Mod, [Multi_File|Multi_Files]) :- + recordz('$multifile_defs',Multi_File, _), '$install_multi_files_module'(Mod, Multi_Files). +'$install_foreigns_module'(_, []). +'$install_foreigns_module'(Mod, [Foreign|Foreigns]) :- + '$do_foreign'(Foreign, Foreigns), + '$install_foreigns_module'(Mod, Foreigns). + +'$do_foreign'('$foreign'(Objs,Libs,Entry), _) :- + load_foreign_files(Objs,Libs,Entry). +'$do_foreign'('$swi_foreign'(File, Opts, Handle), More) :- + open_shared_object(File, Opts, Handle, NewHandle), + '$init_foreigns'(More, NewHandle). +'$do_foreign'('$swi_foreign'(_,_), More). + +'$init_foreigns'([], Handle, NewHandle). +'$init_foreigns'(['$swi_foreign'( Handle, Function )|More], Handle, NewHandle) :- + !, + call_shared_object_function( NewHandle, Function), + '$init_foreigns'(More, Handle, NewHandle). +'$init_foreigns'([_|More], Handle, NewHandle) :- + '$init_foreigns'(More, Handle, NewHandle). + +/** +@pred qload_file(+ _F_) + +Restores a previously saved state of YAP contaianing a qly file _F_. + +*/ +qload_file(F0) :- + H0 is heapused, '$cputime'(T0,_), + ( is_strean( F0 ) + -> + stream_property(F0, file_name(File) ), + S = F0 + ; + absolute_file_name( F0, File, [expand(true),file_type(qly)]), + open(File, read, S, [type(binary)]) + ), + '$qload_file_preds'(S, File), + close(S), + fail + ; + '$complete_read_file'(File). + +'$complete_read_file'(File) :- + file_directory_name(File, DirName), + working_directory(OldD, Dir), + '$process_directives'( File ), + working_directory( _, OldD), + H is heapused-H0, '$cputime'(TF,_), T is TF-T0, + '$current_module'(Mod, SourceModule), + fail. + +'$process_directives' :- + prolog:'$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), + fail. +'$process_directives' :- + abolish(prolog:'$file_property'/1).