diff --git a/C/atomic.c b/C/atomic.c index c6e1bae85..c13005da8 100755 --- a/C/atomic.c +++ b/C/atomic.c @@ -1341,6 +1341,7 @@ restart_aux: while (t1 != TermNil) { inpv[i].type = YAP_STRING_ATOM, inpv[i].val.t = HeadOfTerm(t1); + inpv[i].enc = ENC_ISO_UTF8; i++; t1 = TailOfTerm(t1); } @@ -1389,6 +1390,7 @@ restart_aux: while (t1 != TermNil) { inpv[i].type = YAP_STRING_STRING; inpv[i].val.t = HeadOfTerm(t1); + inpv[i].enc = ENC_ISO_UTF8; i++; t1 = TailOfTerm(t1); } @@ -1428,8 +1430,6 @@ restart_aux: if (*tailp != TermNil) { LOCAL_Error_TYPE = TYPE_ERROR_LIST; } else { - seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t)); - seq_tv_t *out = (seq_tv_t *)Malloc(sizeof(seq_tv_t)); int i = 0; Atom at; @@ -1438,6 +1438,8 @@ restart_aux: pop_text_stack(l); return rc; } + seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t)); + seq_tv_t *out = (seq_tv_t *)Malloc(sizeof(seq_tv_t)); if (!inpv) { LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; goto error; @@ -1448,6 +1450,7 @@ restart_aux: YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_CHARS | YAP_STRING_CODES; inpv[i].val.t = HeadOfTerm(t1); + inpv[i].enc = ENC_ISO_UTF8; i++; t1 = TailOfTerm(t1); } @@ -1464,6 +1467,7 @@ restart_aux: } error: /* Error handling */ + pop_text_stack(l); if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) { goto restart_aux; } @@ -1494,6 +1498,7 @@ restart_aux: inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; inpv[i].val.t = HeadOfTerm(t1); + inpv[i].enc = ENC_ISO_UTF8; i++; t1 = TailOfTerm(t1); } @@ -1543,10 +1548,12 @@ restart_aux: inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; inpv[i].val.t = HeadOfTerm(t1); + inpv[i].enc = ENC_ISO_UTF8; i++; inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; inpv[i].val.t = t2; + inpv[i].enc = ENC_ISO_UTF8; i++; t1 = TailOfTerm(t1); } diff --git a/C/exec.c b/C/exec.c index 86819dc97..58f9788c4 100755 --- a/C/exec.c +++ b/C/exec.c @@ -164,7 +164,7 @@ PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) { restart: if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t0, pname); + Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); return NULL; } else if (IsAtomTerm(t)) { PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod)); @@ -177,7 +177,7 @@ restart: } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname); + Yap_ThrowError(TYPE_ERROR_CALLABLE, t, pname); return NULL; } if (fun == FunctorModule) { diff --git a/C/flags.c b/C/flags.c index 2fa06b596..ed4a78699 100644 --- a/C/flags.c +++ b/C/flags.c @@ -1772,6 +1772,8 @@ void Yap_InitFlags(bool bootstrap) { CACHE_REGS tr_fr_ptr tr0 = TR; flag_info *f = global_flags_setup; + int lvl = push_text_stack(); + char *buf = Malloc(4098); GLOBAL_flagCount = 0; if (bootstrap) { GLOBAL_Flags = (union flagTerm *)Yap_AllocCodeSpace( @@ -1794,7 +1796,16 @@ void Yap_InitFlags(bool bootstrap) { (union flagTerm *)Yap_AllocCodeSpace(sizeof(union flagTerm) * nflags); f = local_flags_setup; while (f->name != NULL) { - bool itf = setInitialValue(bootstrap, f->def, f->init, + char *s; + if (f->init == NULL || f->init[0] == '\0') s = NULL; + else if (strlen(f->init) < 4096) { + s = buf; + strcpy(buf, f->init); + } else { + s = Malloc(strlen(f->init)+1); + strcpy(s, f->init); + } + bool itf = setInitialValue(bootstrap, f->def, s, LOCAL_Flags + LOCAL_flagCount); // Term itf = Yap_BufferToTermWithPrioBindings(f->init, // strlen(f->init)+1, @@ -1809,7 +1820,7 @@ void Yap_InitFlags(bool bootstrap) { if (GLOBAL_Stream[StdInStream].status & Readline_Stream_f) { setBooleanGlobalPrologFlag(READLINE_FLAG, true); } - + pop_text_stack(lvl); if (!bootstrap) { Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag, cont_yap_flag, 0); diff --git a/C/scanner.c b/C/scanner.c index 2e052c8f4..eea251712 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -1592,10 +1592,12 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments, while (TRUE) { if (charp > TokImage + (sz - 1)) { + size_t sz = charp-TokImage; TokImage = Realloc(TokImage, Yap_Min(sz * 2, sz + MBYTE)); if (TokImage == NULL) { return CodeSpaceError(t, p, l); } + charp = TokImage+sz; break; } if (ch == 10 && trueGlobalPrologFlag(ISO_FLAG)) { diff --git a/C/terms.c b/C/terms.c index ebce29029..92f91b17f 100644 --- a/C/terms.c +++ b/C/terms.c @@ -37,9 +37,6 @@ #include "string.h" #endif -#define Malloc malloc -#define Realloc realloc - extern int cs[10]; int cs[10]; diff --git a/C/text.c b/C/text.c index ddb1ba01d..f7effd524 100644 --- a/C/text.c +++ b/C/text.c @@ -18,6 +18,7 @@ #include "Yap.h" #include "YapEval.h" #include "YapHeap.h" +#include "YapStreams.h" #include "YapText.h" #include "Yatom.h" #include "yapio.h" @@ -191,6 +192,8 @@ void *MallocAtLevel(size_t sz, int atL USES_REGS) { void *Realloc(void *pt, size_t sz USES_REGS) { struct mblock *old = pt, *o; + if (!pt) + return Malloc(sz PASS_REGS); old--; sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), Yap_Max(CELLSIZE,sizeof(struct mblock))); o = realloc(old, sz); @@ -464,10 +467,11 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { } } if (err0 != LOCAL_Error_TYPE) { - Yap_ThrowError(LOCAL_Error_TYPE, inp->val.t, "while reading text in"); + Yap_ThrowError(LOCAL_Error_TYPE, + inp->val.t, "while converting term %s", Yap_TermToBuffer( + inp->val.t, Handle_cyclics_f|Quote_illegal_f | Handle_vars_f)); } } - if ((inp->val.t == TermNil) && inp->type & YAP_STRING_PREFER_LIST ) { out = Malloc(4); @@ -580,6 +584,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { } pop_text_stack(lvl); + return inp->val.uc; } if (inp->type & YAP_STRING_WCHARS) { @@ -591,7 +596,10 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { } static Term write_strings(unsigned char *s0, seq_tv_t *out USES_REGS) { - size_t min = 0, max = strlen((char *)s0); + size_t min = 0, max; + + if (s0 && s0[0]) max = strlen((char *)s0); + else max = 0; if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) { if (out->type & YAP_STRING_NCHARS) @@ -962,7 +970,6 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) { // else if (out->type & YAP_STRING_NCHARS && // const unsigned char *ptr = skip_utf8(buf) } - if (out->type & (YAP_STRING_UPCASE | YAP_STRING_DOWNCASE)) { if (out->type & YAP_STRING_UPCASE) { if (!upcase(buf, out)) { diff --git a/os/readterm.c b/os/readterm.c index 5b247f4b6..11fe6548c 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -1185,8 +1185,6 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool return YAP_PARSING_FINISHED; } - static int count; - /** * @brief generic routine to read terms from a stream * @@ -1208,6 +1206,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool int emacs_cares = FALSE; #endif int lvl = push_text_stack(); + Term rc; yap_error_descriptor_t *new = malloc(sizeof *new); FEnv *fe = Malloc(sizeof *fe); REnv *re = Malloc(sizeof *re); @@ -1256,16 +1255,17 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool if (!done) { state = YAP_PARSING_ERROR; - fe->t = 0; + rc = fe->t = 0; break; } #if EMACS first_char = tokstart->TokPos; #endif /* EMACS */ + rc = fe->t; pop_text_stack(lvl); Yap_popErrorContext(err, true); Yap_PopHandle(yopts); - return fe->t; + return rc; } } } diff --git a/packages/ProbLog/problog.yap b/packages/ProbLog/problog.yap index abc8769b9..6bd6a0996 100644 --- a/packages/ProbLog/problog.yap +++ b/packages/ProbLog/problog.yap @@ -524,7 +524,9 @@ every 5th iteration only. :- PD = '/usr/local/bin', set_problog_path(PD). -%:- stop_low_level_trace. +:- PD = '$HOME/,local/bin', + set_problog_path(PD). + %%%%%%%%%%%% @@ -552,10 +554,7 @@ every 5th iteration only. %%%%%%%%%%%% % max number of calls to probabilistic facts per derivation (to ensure termination) %%%%%%%%%%%% - -:- initialization( - problog_define_flag(maxsteps, problog_flag_validate_posint, 'max. number of prob. steps per derivation', 1000, inference) -). +:- initialization( problog_define_flag(maxsteps, problog_flag_validate_posint, 'max. number of prob. steps per derivation', 1000, inference) ). %%%%%%%%%%%% % BDD timeout in seconds, used as option in BDD tool @@ -1826,7 +1825,7 @@ eval_dnf(OriTrie1, Prob, Status) :- ; Trie = OriTrie ), - (problog_flag(bdd_static_order, true) -> + (problog_flag(bdd_static_order, true) -> get_order(Trie, Order), problog_flag(static_order_file, SOFName), convert_filename_to_working_path(SOFName, SOFileName), diff --git a/packages/ProbLog/problog/nestedtries.yap b/packages/ProbLog/problog/nestedtries.yap index d3c245bae..1b39c15a9 100644 --- a/packages/ProbLog/problog/nestedtries.yap +++ b/packages/ProbLog/problog/nestedtries.yap @@ -243,7 +243,7 @@ problog_define_flag(refine_anclst, problog_flag_validate_boolean, 'refine the ancestor list with their childs', false, nested_tries), problog_define_flag(anclst_represent,problog_flag_validate_in_list([list, integer]), 'represent the ancestor list', list, nested_tries) )). -:- stop_low_level_trace. + trie_replace_entry(_Trie, Entry, E, false):- trie_get_entry(Entry, Proof), @@ -486,3 +486,4 @@ get_trie(Trie, Label, Ancestors):- set_trie(Trie, Label, Ancestors):- recordz(problog_trie_table, store(Trie, Ancestors, Label), _). + diff --git a/packages/python/swig/setup.py b/packages/python/swig/setup.py index b5cd8eb28..6d7a94de5 100644 --- a/packages/python/swig/setup.py +++ b/packages/python/swig/setup.py @@ -69,7 +69,7 @@ elif platform.system() == 'Darwin': win_libs = [] local_libs = ['Py4YAP'] elif platform.system() == 'Linux': - my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/lib','-Wl,-rpath,'+join('/lib','..'),'-Wl,-rpath,../yap4py'] + my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-L','/lib','-Wl,-rpath,/lib','-Wl,-rpath,'+join('/lib','..'),'-Wl,-rpath,../yap4py'] win_libs = [] local_libs = ['Py4YAP'] diff --git a/pl/consult.yap b/pl/consult.yap index 59c57672a..61c05716c 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -862,7 +862,6 @@ nb_setval('$if_level',0). '__NB_getval__'('$lf_status', TOpts, fail), '$lf_opt'( initialization, TOpts, Ref), nb:nb_queue_close(Ref, Answers, []), - writeln(init:Answers), '$process_init_goal'(Answers). '$exec_initialization_goals'. @@ -1150,11 +1149,11 @@ exists_source(File) :- '$full_filename'(F0, F) :- - '$undefined'('$absolute_file_name'(F0,[],F),prolog_complete), + '$undefined'(absolute_file_name(F0,[],F),prolog), !, absolute_file_system_path(F0, F). '$full_filename'(F0, F) :- - '$absolute_file_name'(F0,[access(read), + absolute_file_name(F0,[access(read), file_type(prolog), file_errors(fail), solutions(first), @@ -1450,9 +1449,7 @@ environment. Use initialization/2 for more flexible behavior. '$initialization_queue'(G) :- b_getval('$lf_status', TOpts), '$lf_opt'( initialization, TOpts, Ref), - writeln(G), nb:nb_queue_enqueue(Ref, G), - writeln(Ref), fail. '$initialization_queue'(_). diff --git a/pl/corout.yap b/pl/corout.yap index 406ea8959..69c93da07 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -304,9 +304,8 @@ prolog:when(_,Goal) :- % % '$declare_when'(Cond, G) :- - generate_code_for_when(Cond, G, Code), - '$current_module'(Module), - '$$compile'(Code, Code, 5, Module), fail. + generate_code_for_when(Cond, G, Code), + '$$compile'(Code, Module, assertz, Code, _), fail. '$declare_when'(_,_). % @@ -434,8 +433,8 @@ suspend_when_goals([_|_], _). % prolog:'$block'(Conds) :- generate_blocking_code(Conds, _, Code), - '$current_module'(Module), - '$$compile'(Code, Code, 5, Module), fail. + '$yap_strip_module'(Code, Module, NCode), + '$$compile'(Code, assertz, Code, _), fail. prolog:'$block'(_). generate_blocking_code(Conds, G, Code) :- @@ -515,8 +514,7 @@ generate_for_each_arg_in_block([V|L], (var(V),If), (nonvar(V);Whens)) :- prolog:'$wait'(Na/Ar) :- functor(S, Na, Ar), arg(1, S, A), - '$current_module'(M), - '$$compile'((S :- var(A), !, freeze(A, S)), (S :- var(A), !, freeze(A, S)), 5, M), fail. + '$$compile'((S :- var(A), !, freeze(A, S)), assertz, (S :- var(A), !, freeze(A, S)), _), fail. prolog:'$wait'(_). /** @pred frozen( _X_, _G_) diff --git a/pl/dbload.yap b/pl/dbload.yap index 5e3354a4d..75cd96d99 100644 --- a/pl/dbload.yap +++ b/pl/dbload.yap @@ -20,8 +20,6 @@ :- module('$db_load', []). -:- use_system_module( '$_boot', ['$$compile'/4]). - :- use_system_module( '$_errors', ['$do_error'/2]). :- use_system_module( attributes, [get_module_atts/2, diff --git a/pl/debug.yap b/pl/debug.yap index d7af3a948..5889ebe90 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -477,7 +477,7 @@ be lost. '$trace_goal'(G, M, GoalNumber, H) :- '$undefined'(G, M), !, - '$get_undefined_predicates'(M:G, NM:Goal), + '$get_predicate_definition'(M:G, NM:Goal), ( ( M == NM ; NM == prolog), G == Goal -> yap_flag( unknown, Action ), diff --git a/pl/imports.yap b/pl/imports.yap index 9dc3433d3..31856c77a 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -33,50 +33,75 @@ fail. %:- start_low_level_trace. % parent module mechanism -'$get_undefined_predicates'(ImportingMod:G,ExportingMod:G0) :- - recorded('$import','$import'(ExportingMod,ImportingMod,G,G0,_,_),_) - -> - true - ; - %% this should have been caught before - '$is_system_predicate'(G, ImportingMod) - -> - true - ; -% autoload - current_prolog_flag(autoload, true) --> - '$autoload'(G, ImportingMod, ExportingMod, swi) -; - '$parent_module'(ImportingMod, NewImportingMod) - -> - '$get_undefined_predicates'(NewImportingMod:G, ExportingMod:G0). +%% system has priority +'$get_predicate_definition'(_ImportingMod:G,prolog:G) :- + '$pred_exists'(G,prolog). +%% I am there, no need to import +'$get_predicate_definition'(Mod:Pred,Mod:Pred) :- + '$pred_exists'(Pred, Mod). +%% export table +'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :- + recorded('$import','$import'(ExportingMod,ImportingMod,G0,G,_,_),_). +%% parent/user +'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :- + ( '$parent_module'(ImportingMod, PMod) ), %; PMod = user), + ('$pred_exists'(PMod,G0), PMod:G0 = ExportingMod:G; + recorded('$import','$import'(ExportingMod,PMod,G0,G,_,_),_) + ). +%% autoload` +'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :- + current_prolog_flag(autoload, true), + '$autoload'(G, ImportingMod, ExportingMod, swi). -'$continue_imported'(Mod:Pred,Mod,Pred) :- - '$pred_exists'(Pred, Mod), + +'$predicate_definition'(Imp:Pred,Exp:NPred) :- + '$predicate_definition'(Imp:Pred,[],Exp:NPred), +%writeln((Imp:Pred -> Exp:NPred )). !. -'$continue_imported'(FM:FPred,Mod:Pred) :- - '$get_undefined_predicates'(FM:FPred, ModI:PredI), - '$continue_imported'(ModI:PredI,Mod:Pred). + +'$one_predicate_definition'(Imp:Pred,Exp:NPred) :- + '$predicate_definition'(Imp:Pred,[],Exp:NPred), +%writeln((Imp:Pred -> Exp:NPred )). + !. +'$one_predicate_definition'(Exp:Pred,Exp:Pred). + +'$predicate_definition'(M0:Pred0,Path,ModF:PredF) :- + '$get_predicate_definition'(M0:Pred0, Mod:Pred), + \+ lists:member(Mod:Pred,Path), + ( + '$predicate_definition'(Mod:Pred,[Mod:Pred|Path],ModF:PredF) + ; + Mod = ModF, Pred = PredF + ). % -'$get_undefined_pred'(ImportingMod:G, ExportingMod:G0) :- - must_be_callable( ImportingMod:G ), - '$get_undefined_predicates'(ImportingMod:G, ExportingMod:G0). +'$get_undefined_predicate'(ImportingMod:G, ExportingMod:G0) :- + is_callable( ImportingMod:G ), + '$predicate_definition'(ImportingMod:G,[], ExportingMod:G0), + ImportingMod:G \= ExportingMod:G0, + !. % be careful here not to generate an undefined exception. '$imported_predicate'(ImportingMod:G, ExportingMod:G0) :- - var(G) -> - '$current_predicate'(_,G,ImportingMod,_), - '$imported_predicate'(ImportingMod:G, ExportingMod:G0) - ; - var(ImportingMod) -> - current_module(ImportingMod), - '$imported_predicate'(ImportingMod:G, ExportingMod:G0) - ; - '$undefined'(G, ImportingMod), - '$get_undefined_predicates'(ImportingMod:G, ExportingMod:G0), - ExportingMod \= ImportingMod. + ( var(ImportingMod) -> + current_module(ImportingMod) + ; + true + ), + ( + var(G) -> + '$current_predicate'(_,G,ImportingMod,_) + ; + true + ), + ( + '$undefined'(G, ImportingMod) + -> + '$predicate_definition'(ImportingMod:G, ExportingMod:G0), + ExportingMod \= ImportingMod + ; + ExportingMod = ImportingMod, G = G0 + ). % check if current module redefines an imported predicate. @@ -92,16 +117,6 @@ fail. '$not_imported'(_, _). -'$verify_import'(_M:G, prolog:G) :- - '$is_system_predicate'(G, prolog). -'$verify_import'(M:G, NM:NG) :- - '$get_undefined_predicates'(M:G, M, NM:NG), - !. -'$verify_import'(MG, MG). - - - - '$autoload'(G, _mportingMod, ExportingMod, Dialect) :- functor(G, Name, Arity), '$pred_exists'(index(Name,Arity,ExportingMod,_),Dialect), diff --git a/pl/meta.yap b/pl/meta.yap index 93b4a5e12..7e54109d4 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -201,7 +201,7 @@ meta_predicate(P) :- '$yap_strip_module'(CM:G, NCM, NG). '$match_mod'(G, _HMod, _SMod, M, O) :- - '$is_system_predicate'(G,M), + M = prolog, !, O = G. '$match_mod'(G, M, M, M, G) :- !. diff --git a/pl/modules.yap b/pl/modules.yap index 87fb38cbd..b4193a6df 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -41,7 +41,6 @@ '$convert_for_export'/7, '$do_import'/3, '$extend_exports'/3, - '$get_undefined_pred'/4, '$imported_predicate'/2, '$meta_expand'/6, '$meta_predicate'/2, @@ -85,6 +84,8 @@ /** @pred use_module( +Files ) is directive + + @brief load a module file This predicate loads the file specified by _Files_, importing all @@ -311,16 +312,6 @@ use_module(F,Is) :- '$not_imported'(_, _). -'$verify_import'(_M:G, prolog:G) :- - '$is_system_predicate'(G, prolog). -'$verify_import'(M:G, NM:NG) :- - '$get_undefined_pred'(G, M, NG, NM), - !. -'$verify_import'(MG, MG). - - - - /** @pred current_module( ? Mod:atom) is nondet @@ -453,8 +444,10 @@ export_list(Module, List) :- '$add_to_imports'(Tab, Module, ContextModule). %'$do_import'(K, _, _) :- writeln(K), fail. -'$do_import'(op(Prio,Assoc,Name), _Mod, ContextMod) :- - op(Prio,Assoc,ContextMod:Name). +'$do_import'(op(Prio,Assoc,Name), Mod, ContextMod) :- + op(Prio,Assoc,Mod:Name), + op(Prio,Assoc,ContextMod:Name), +!. '$do_import'(N0/K0-N0/K0, Mod, Mod) :- !. '$do_import'(N0/K0-N0/K0, _Mod, prolog) :- !. '$do_import'(_N/K-N1/K, _Mod, ContextMod) :- @@ -465,26 +458,17 @@ export_list(Module, List) :- \+ '$undefined'(S,ContextMod), !. '$do_import'( N/K-N1/K, Mod, ContextMod) :- functor(G,N,K), - '$follow_import_chain'(Mod,G,M0,G0), + '$one_predicate_definition'(Mod:G,M0:G0), + M0\=prolog, + (Mod\=M0->N\=N1;true), G0=..[_N0|Args], G1=..[N1|Args], - ( '$check_import'(M0,ContextMod,N1,K) -> - ( ContextMod == prolog -> - recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_), - \+ '$is_system_predicate'(G1, prolog), - '$compile'((G1:-M0:G0), reconsult,(user:G1:-M0:G0) , user, R), - fail - ; - recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_), - \+ '$is_system_predicate'(G1, prolog), - '$compile'((G1:-M0:G0), reconsult,(ContextMod:G1:-M0:G0) , ContextMod, R), - fail - ; - true - ) - ; - true - ). + recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_), + %\+ '$is_system_predicate'(G1, prolog), + %'$compile'((G1:-M0:G0), reconsult,(ContextMod:G1:-M0:G0) , ContextMod, R), + fail. +% always succeed. +'$do_import'(_,_,_). '$follow_import_chain'(M,G,M0,G0) :- recorded('$import','$import'(M1,M,G1,G,_,_),_), M \= M1, !, diff --git a/pl/preddyns.yap b/pl/preddyns.yap index ab4aee3f0..a09f37e9e 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -50,9 +50,8 @@ assert(Clause) :- '$assert'(Clause, assertz, _). '$assert'(Clause, Where, R) :- - '$yap_strip_clause'(Clause, _, _Clause0), - '$expand_clause'(Clause,C0,C), - '$$compile'(C, Where, C0, R). + '$expand_clause'(Clause0,C0,C), + '$$compile'(CC, Where, C0, R). /** @pred asserta(+ _C_,- _R_) diff --git a/pl/preds.yap b/pl/preds.yap index 379230edd..5be04dd24 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -395,15 +395,7 @@ predicate_property(Pred,Prop) :- '$current_predicate'(_,M,Pred,system), '$yap_strip_module'(M:Pred, Mod, TruePred) ), - - ( - '$pred_exists'(TruePred, Mod) - -> - M = Mod, - NPred = TruePred - ; - '$get_undefined_pred'(Mod:TruePred, M:NPred) - ), + '$predicate_definition'(Mod:TruePred, M:NPred), '$predicate_property'(NPred,M,Mod,Prop). '$predicate_property'(P,M,_,built_in) :- diff --git a/pl/top.yap b/pl/top.yap index a318890c5..41f544686 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -218,22 +218,23 @@ live :- '$go_compile_clause'(G, _Vs, _Pos, Where, Source) :- '$precompile_term'(G, Source, G1), !, - '$$compile'(G1, Where, Source, _). + '$$compile'(G1, M, Where, Source, _). '$go_compile_clause'(G,_Vs,_Pos, _Where, _Source) :- throw(error(system, compilation_failed(G))). '$$compile'(C, Where, C0, R) :- - '$head_and_body'( C, MH, B ), - strip_module( MH, Mod, H), + '$head_and_body'( M0:C, MH, B ), + '$yap_strip_module'( MH, Mod, H), + '$yap_strip_module'( MB, ModB, BF), ( '$undefined'(H, Mod) -> '$init_pred'(H, Mod, Where) ; - true + trueq ), % writeln(Mod:((H:-B))), - '$compile'((H:-B), Where, C0, Mod, R). + '$compile'((H:-ModB:BF), Where, C0, Mod, R). '$init_pred'(H, Mod, _Where ) :- recorded('$import','$import'(NM,Mod,NH,H,_,_),RI), @@ -783,7 +784,8 @@ Command = (H --> B) -> '$boot_dcg'( H, B, Where ) :- '$translate_rule'((H --> B), (NH :- NB) ), - '$$compile'((NH :- NB), Where, ( H --> B), _R), + '$yap_strip_module'((NH :- NB), M, G), + '$$compile'(G, M, Where, ( H --> B), _R), !. '$boot_dcg'( H, B, _ ) :- format(user_error, ' ~w --> ~w failed.~n', [H,B]). @@ -875,7 +877,7 @@ gated_call(Setup, Goal, Catcher, Cleanup) :- '$precompile_term'(Term, Term, Term). '$expand_clause'(InputCl, C1, CO) :- - '$yap_strip_clause'(InputCl, M, ICl), + '$yap_strip_module'(InputCl, M, ICl), '$expand_a_clause'( M:ICl, M, C1, CO), !. '$expand_clause'(Cl, Cl, Cl). diff --git a/pl/undefined.yap b/pl/undefined.yap index 980259645..37b8fb4c3 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -91,23 +91,23 @@ undefined_query(G0, M0, Cut) :- user:unknown_predicate_handler(GM0,EM0,MG), !. '$undefp_search'(M0:G0, MG) :- - '$get_undefined_predicates'(M0:G0, MG), !. + '$predicate_definition'(M0:G0, MG), !. % undef handler -'$undefp'([M0|G0],MG) :- +'$undefp'([M0|G0],true) :- % make sure we do not loop on undefined predicates setup_call_cleanup( '$undef_setup'(M0:G0, Action,Debug,Current, MGI), - ignore('$get_undefined_predicates'( MGI, MG )), + '$get_undefined_predicate'( MGI, MG ), '$undef_cleanup'(Action,Debug,Current) ), '$undef_error'(Action, M0:G0, MGI, MG). -'$undef_setup'(G0,Action,Debug,Current,GI) :- +'$undef_setup'(G0,Action,Debug,Current,G0) :- yap_flag( unknown, Action, fail), yap_flag( debug, Debug, false), - '$stop_creeping'(Current), - '$g2i'(G0,GI). + '$stop_creeping'(Current). + '$g2i'(user:G, Na/Ar ) :- !, @@ -141,7 +141,7 @@ The unknown predicate, informs about what the user wants to be done nonvar(M), nonvar(G), !, - '$start_creep'([prolog|true], creep). + '$start_creep'([M|G], creep). '$undef_error'(_, M0:G0, _, MG) :- '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), '$yap_strip_module'(M0:G0, EM0, GM0), @@ -151,12 +151,12 @@ The unknown predicate, informs about what the user wants to be done '$undef_error'(error, Mod:Goal, I,_) :- '$do_error'(existence_error(procedure,I), Mod:Goal). '$undef_error'(warning,Mod:Goal,I,_) :- - 'program_continuation'(PMod,PName,PAr), + '$program_continuation'(PMod,PName,PAr), print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))), - '$start_creep'([fail|true], creep), + %'$start_creep'([prolog|fail], creep), fail. '$undef_error'(fail,_Goal,_,_Mod) :- - '$start_creep'([fail|true], creep), + % '$start_creep'([prolog|fail], creep), fail. unknown(P, NP) :-