From 3699a715ced89f1d9251217b6d5c03abe58a5a8d Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 23 Dec 2018 15:38:56 +0000 Subject: [PATCH 001/101] yapi --- packages/python/pybips.c | 150 ++++----------------------- packages/python/pypreds.c | 2 +- packages/python/swig/prolog/yapi.yap | 50 +++++---- pl/control.yap | 24 +++-- pl/undefined.yap | 1 - 5 files changed, 56 insertions(+), 171 deletions(-) diff --git a/packages/python/pybips.c b/packages/python/pybips.c index 986162d01..18a26bea8 100644 --- a/packages/python/pybips.c +++ b/packages/python/pybips.c @@ -601,132 +601,6 @@ static long get_len_of_range(long lo, long hi, long step) { {"A29", NULL}, {"A29", NULL}, {"A30", NULL}, {"A31", NULL}, {"A32", NULL}, {NULL, NULL}}; - static PyObject *structseq_str(PyStructSequence *obj ) { - -/* buffer and type size were chosen well considered. */ -#define REPR_BUFFER_SIZE 512 -#define TYPE_MAXSIZE 100 - - bool removelast = false; - PyTypeObject *typ = Py_TYPE(obj); - const char *type_name = typ->tp_name; - Py_ssize_t len, i; - char buf[REPR_BUFFER_SIZE]; - char *endofbuf, *pbuf = buf; - /* pointer to end of writeable buffer; safes space for "...)\0" */ - endofbuf = &buf[REPR_BUFFER_SIZE - 5]; - - /* "typename(", limited to TYPE_MAXSIZE */ - len = - strnlen(type_name, TYPE_MAXSIZE); - strncpy(pbuf, type_name, len); - pbuf += len; - *pbuf++ = '('; - - for (i = 0; i < ((PyStructSequence *)obj)->ob_base.ob_size; i++) { - PyObject *val, *repr; - const char *crepr; - - val = PyStructSequence_GET_ITEM(obj, i); - repr = PyObject_Str(val); - if (repr == NULL) - return Py_None; - crepr = PyUnicode_AsUTF8(repr); - if (crepr == NULL) { - Py_DECREF(repr); - return Py_None; - } - - /* + 3: keep space for ", " */ - len = strlen(crepr) + 2; - if ((pbuf + len) <= endofbuf) { - strcpy(pbuf, crepr); - pbuf += strlen(crepr); - *pbuf++ = ','; - *pbuf++ = ' '; - removelast = 1; - Py_DECREF(repr); - } else { - strcpy(pbuf, "..."); - pbuf += 3; - removelast = 0; - Py_DECREF(repr); - break; - } - } - if (removelast) { - /* overwrite last ", " */ - pbuf -= 2; - } - *pbuf++ = ')'; - *pbuf = '\0'; - - return PyUnicode_FromString(buf); -} - - static PyObject *structseq_repr(PyObject *iobj) { - -/* buffer and type size were chosen well considered. */ -#define REPR_BUFFER_SIZE 512 -#define TYPE_MAXSIZE 100 - - PyStructSequence *obj = (PyStructSequence *)iobj; - PyTypeObject *typ = Py_TYPE(obj); - const char *type_name = typ->tp_name; - bool removelast = false; - Py_ssize_t len, i; - char buf[REPR_BUFFER_SIZE]; - char *endofbuf, *pbuf = buf; - /* pointer to end of writeable buffer; safes space for "...)\0" */ - endofbuf = &buf[REPR_BUFFER_SIZE - 5]; - - /* "typename(", limited to TYPE_MAXSIZE */ - len = - strnlen(type_name, TYPE_MAXSIZE); - strncpy(pbuf, type_name, len); - pbuf += len; - *pbuf++ = '('; - - for (i = 0; i < ((PyStructSequence *)obj)->ob_base.ob_size; i++) { - PyObject *val, *repr; - const char *crepr; - - val = PyStructSequence_GET_ITEM(obj, i); - repr = PyObject_Repr(val); - if (repr == NULL) - return NULL; - crepr = PyUnicode_AsUTF8(repr); - if (crepr == NULL) { - Py_DECREF(repr); - return NULL; - } - - /* + 3: keep space for ", " */ - len = strlen(crepr) + 2; - if ((pbuf + len) <= endofbuf) { - strcpy(pbuf, crepr); - pbuf += strlen(crepr); - *pbuf++ = ','; - *pbuf++ = ' '; - removelast = 1; - Py_DECREF(repr); - } else { - strcpy(pbuf, "..."); - pbuf += 3; - removelast = 0; - Py_DECREF(repr); - break; - } - } - if (removelast) { - /* overwrite last ", " */ - pbuf -= 2; - } - *pbuf++ = ')'; - *pbuf = '\0'; - - return PyUnicode_FromString(buf); -} #endif static bool legal_symbol(const char *s) { @@ -761,8 +635,9 @@ PyObject *term_to_nametuple(const char *s, arity_t arity, PyObject *tuple) { typp = (PyTypeObject *)d; } else { PyStructSequence_Desc *desc = PyMem_Calloc(sizeof(PyStructSequence_Desc), 1); - desc->name = PyMem_Malloc(strlen(s) + 1); - strcpy(desc->name, s); + char *tnp; + desc->name = tnp = PyMem_Malloc(strlen(s) + 1); + strcpy(tnp, s); desc->doc = "YAPTerm"; desc->fields = pnull; desc->n_in_sequence = arity; @@ -773,7 +648,7 @@ PyObject *term_to_nametuple(const char *s, arity_t arity, PyObject *tuple) { return NULL; typp->tp_traverse = NULL; typp->tp_flags |= - Py_TPFLAGS_TUPLE_SUBCLASS| + // Py_TPFLAGS_TUPLE_SUBCLASS| Py_TPFLAGS_BASETYPE| Py_TPFLAGS_HEAPTYPE; // don't do this: we cannot add a type as an atribute. @@ -783,8 +658,6 @@ PyObject *term_to_nametuple(const char *s, arity_t arity, PyObject *tuple) { Py_INCREF(key); Py_INCREF(typp); } - typp->tp_repr = structseq_repr; - typp->tp_str = structseq_str; } PyObject *o = PyStructSequence_New(typp); Py_INCREF(typp); @@ -915,7 +788,14 @@ PyObject *compound_to_pytree(term_t t, PyObject *context, bool cvt) { PyTuple_SET_ITEM(n, 1, out); return n; } - return term_to_nametuple(s, arity, out); + if (cvt) + return term_to_nametuple(s, arity, out); + else { + PyObject *rc = PyTuple_New(2); + PyTuple_SetItem(rc, 0, PyUnicode_FromString(s)); + PyTuple_SetItem(rc, 1, out); + return rc; + } } } @@ -1146,7 +1026,13 @@ PyObject *compound_to_pyeval(term_t t, PyObject *context, bool cvt) { // PyObject_Print(rc, stderr, 0); // DebugPrintf("CallObject %p\n", rc); } else { + if (cvt) rc = term_to_nametuple(s, arity, pArgs); + else { + rc = PyTuple_New(2); + PyTuple_SetItem(rc, 0, ys); + PyTuple_SetItem(rc, 1, pArgs); + } } return rc; diff --git a/packages/python/pypreds.c b/packages/python/pypreds.c index 20cf338c8..9b357ea6a 100644 --- a/packages/python/pypreds.c +++ b/packages/python/pypreds.c @@ -31,7 +31,7 @@ static foreign_t python_represent( term_t name, term_t tobj) { term_t stackp = python_acquire_GIL(); PyObject *e; - e = term_to_python(tobj, false, NULL, true); + e = term_to_python(tobj, false, NULL, false); if (e == NULL) { python_release_GIL(stackp); pyErrorAndReturn(false); diff --git a/packages/python/swig/prolog/yapi.yap b/packages/python/swig/prolog/yapi.yap index dbf909df0..a125f02e6 100644 --- a/packages/python/swig/prolog/yapi.yap +++ b/packages/python/swig/prolog/yapi.yap @@ -74,48 +74,46 @@ argi(N,I,I1) :- python_query( Caller, String ) :- atomic_to_term( String, Goal, VarNames ), - query_to_answer( Goal, VarNames, Status, Bindings), + query_to_answer( Goal, _, Status, VarNames, Bindings), Caller.port := Status, - write_query_answer( Bindings ), - answer := {}, - foldl(ground_dict(answer), Bindings, [], Ts), - term_variables( Ts, Hidden), - foldl(bv, Hidden , 0, _), + output(Caller, Bindings). + +output( _, Bindings ) :- + write_query_answer( Bindings ), + fail. +output( Caller, Bindings ) :- + answer := {}, + foldl(ground_dict(answer), Bindings, [], Ts), + term_variables( Ts, Hidden), + foldl(bv, Hidden , 0, _), maplist(into_dict(answer),Ts), Caller.answer := json.dumps(answer), - S := Caller.answer, -format(user_error, '~nor ~s~n~n',S). - + S := Caller.answer, + format(user_error, '~nor ~s~n~n',S), + fail. +output(_Caller, _Bindings). bv(V,I,I1) :- atomic_concat(['__',I],V), I1 is I+1. into_dict(D,V0=T) :- - D[V0] := T. + python_represents(D[V0], T). /** * */ -ground_dict(_Dict, var([V,V]), I, I) :- +ground_dict(_Dict,var([_V]), I, I) :- !. -ground_dict(Dict, nonvar([V0|Vs], T),I0, [V0=T| I0]) :- +ground_dict(_Dict,var([V,V]), I, I) :- + !. +ground_dict(Dict, nonvar([V0|Vs],T),I0, [V0=T| I0]) :- !, - ground_dict( Dict, var([V0|Vs]), I0, I0). -ground_dict(Dict, var([V0,V|Vs]), I, I) :- + ground_dict(Dict, var([V0|Vs]),I0, I0). +ground_dict(Dict, var([V0,V1|Vs]), I, I) :- !, - Dict[V]=V0, - ground_dict( Dict, var([V0|Vs]), I, I). -ground_dict(_, _, _, _). + Dict[V1] := V0, + ground_dict(Dict, var([V0|Vs]), I, I). -bound_dict(Dict, nonvar([V0|Vs], T)) :- - !, - Dict[V0] := T, - bound_dict( Dict, var([V0|Vs])). -bound_dict(Dict, var([V0,V|Vs])) :- - !, - Dict[V] := V0, - bound_dict( Dict, var([V0|Vs])). -bound_dict(_, _). diff --git a/pl/control.yap b/pl/control.yap index c00c55652..19d7d3c4d 100644 --- a/pl/control.yap +++ b/pl/control.yap @@ -389,20 +389,22 @@ version(T) :- fail. '$set_toplevel_hook'(_). -query_to_answer(G, V, Status, Vs) :- - gated_call( true, (G,'$delayed_goals'(G, V, Vs, LGs, _DCP)), Status, '$answer'( Status, LGs, Vs ) ). +query_to_answer(G, V, Status, Vs, Bindings ) :- + gated_call( true, (G,'$delayed_goals'(G, V, Vs, LGs, _DCP)), Status, '$answer'( Status, LGs, Vs, Bindings ) ). -'$answer'( exit, LGs, Vs) :- - !. %, -%'$process_answer'(Vs, LGs). -'$answer'( answer, LGs, Vs) :- - !. %, -% '$process_answer'(Vs, LGs, Bindings). -'$answer'(!, _, _). -'$answer'(fail,_,_). +'$answer'( exit, LGs, Vs, Bindings ) :- + !, + '$sort'(Vs, NVs), + '$prep_answer_var_by_var'(NVs, Bindings , LGs). +'$answer'( answer, LGs, Vs, Bindings) :- + !, + '$sort'(Vs, NVs), + '$prep_answer_var_by_var'(NVs, Bindings , LGs). +'$answer'(!, _, _,_). +'$answer'(fail,_,_,_). '$answer'(exception(E),_,_,_) :- '$LoopError'(E,error). -'$answer'(external_exception(_),_,_). +'$answer'(external_exception(_),_,_,_). %% @} diff --git a/pl/undefined.yap b/pl/undefined.yap index fd2d14731..3c11f1a1d 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -113,7 +113,6 @@ undefined_query(G0, M0, Cut) :- % undef handler '$undefp'([M0|G0],_) :- -start_low_level_trace, % make sure we do not loop on undefined predicates setup_call_catcher_cleanup( '$undef_set'(Action,Debug,Current), From 3f1c2352f300ca71f4f517eccc1d171ad7e11bf2 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 28 Dec 2018 17:44:28 +0000 Subject: [PATCH 002/101] jpl fixes --- CMakeLists.txt | 4 ++-- packages/jpl/src/c/jpl.c | 29 +++++++++++++++++------------ 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 9b31c68d8..10fe55339 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -855,8 +855,8 @@ if (WITH_JAVA) if (APPLE) set(CMAKE_MACOSX_RPATH 1) find_library (JLI jli ${JAVA_AWT_DIR}/jli) - find_library (JAL JavaApplicationLauncher FRAMEWORK ONLY PATH /System/Library/PrivateFrameworks) - find_library (JL JavaLaunching FRAMEWORK ONLY PATH /System/Library/PrivateFrameworks) + #find_library (JAL JavaApplicationLauncher FRAMEWORK ONLY PATH /System/Library/PrivateFrameworks) + #find_library (JL JavaLaunching FRAMEWORK ONLY PATH /System/Library/PrivateFrameworks) list(APPEND CMAKE_INSTALL_RPATH ${JAVA_AWT_DIR}/jli) list(APPEND JNI_LIBRARIES ${JLI};${JAL};${JL}) endif() diff --git a/packages/jpl/src/c/jpl.c b/packages/jpl/src/c/jpl.c index 1f05f8ca9..ae7d24eb0 100755 --- a/packages/jpl/src/c/jpl.c +++ b/packages/jpl/src/c/jpl.c @@ -48,6 +48,8 @@ refactoring (trivial): #define JPL_C_LIB_VERSION_PATCH 4 #define JPL_C_LIB_VERSION_STATUS "alpha" +#define JPL_DEBUG + #ifndef JPL_DEBUG /*#define DEBUG(n, g) ((void)0) */ #define DEBUG_LEVEL 4 @@ -640,7 +642,7 @@ static JNIEnv* jni_env(void) /* economically gets a JNIEnv pointer, valid for this thread */ { JNIEnv *env; - switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_1_8) ) + switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_9) ) { case JNI_OK: return env; case JNI_EDETACHED: @@ -1819,20 +1821,20 @@ jni_create_jvm_c( char *cpoptp; JavaVMOption opt[MAX_JVM_OPTIONS]; int r; - jint n; + jint n = 1; int optn = 0; JNIEnv *env; JPL_DEBUG(1, Sdprintf( "[creating JVM with 'java.class.path=%s']\n", classpath)); - vm_args.version = JNI_VERSION_1_6; /* "Java 1.2 please" */ + vm_args.version = JNI_VERSION_1_6zzzz; /* "Java 1.2 please" */ if ( classpath ) { - cpoptp = (char *)malloc(strlen(classpath)+20); - strcpy( cpoptp, "-Djava.class.path="); /* was cpopt */ - strcat( cpoptp, classpath); /* oughta check length... */ - vm_args.options = opt; - opt[optn].optionString = cpoptp; /* was cpopt */ - optn++; + cpoptp = (char *)malloc(strlen(classpath) + strlen("-Djava.class.path=")+1); + strcpy(cpoptp, "-Djava.class.path="); /* was cpopt */ + strcat(cpoptp, classpath); /* oughta check length... */ + vm_args.options = opt; + opt[optn].optionString = cpoptp; /* was cpopt */ + optn++; } /* opt[optn++].optionString = "-Djava.compiler=NONE"; */ /* opt[optn].optionString = "exit"; // I don't understand this yet... */ @@ -1841,10 +1843,12 @@ jni_create_jvm_c( /* opt[optn++].extraInfo = jvm_abort; // this function has been moved to jpl_extras.c */ /* opt[optn++].optionString = "-Xcheck:jni"; // extra checking of JNI calls */ #if __YAP_PROLOG__ - opt[optn++].optionString = "-Xmx512m"; // give java enough space + opt[optn].optionString = malloc(strlen("-Xmx512m")+1); // give java enough space + strcpy(opt[optn++].optionString,"-Xmx512m"); // give java enough space #if defined(__APPLE__) - // I can't make jpl work with AWT graphics, without creating the extra thread. - opt[optn++].optionString = "-Djava.awt.headless=true"; + // I can't make jpl work with AWT graphics, without creating the extra thread. + opt[optn].optionString = malloc(strlen("-Djava.awt.headless=true") + 1); // give java enough space + strcpy(opt[optn++].optionString, "-Djava.awt.headless=true"); // give java enough space #endif // opt[optn++].optionString = "-XstartOnFirstThread"; #endif @@ -1853,6 +1857,7 @@ jni_create_jvm_c( /* opt[optn++].extraInfo = fprintf; // no O/P, then SEGV */ /* opt[optn++].extraInfo = xprintf; // one message, then SEGV */ /* opt[optn++].optionString = "-verbose:jni"; */ + opt[optn].optionString = NULL; if ( jvm_dia != NULL ) { From 86decdddde9b9cab1f410d6da12c34717a4237b5 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 21 Jan 2019 01:11:42 +0000 Subject: [PATCH 003/101] modules --- C/absmi.c | 56 +- C/c_interface.c | 9 +- C/dbase.c | 4 +- C/errors.c | 60 +- C/modules.c | 4 +- C/utilpreds.c | 46 +- C/yap-args.c | 1187 +++++++++++++++-------------- CMakeLists.txt | 22 +- H/YapGFlagInfo.h | 35 +- include/YapError.h | 2 +- library/CMakeLists.txt | 2 - library/autoloader.yap | 9 +- library/maplist.yap | 54 +- library/system/sys_config.h | 2 +- packages/clpqr/CMakeLists.txt | 5 +- packages/clpqr/clpr.pl | 2 +- packages/jpl/src/c/CMakeLists.txt | 2 +- packages/python/pybips.c | 2 +- packages/python/swig/README.md | 45 +- packages/python/swig/setup.py | 8 +- pl/CMakeLists.txt | 2 +- pl/boot.yap | 5 +- pl/consult.yap | 12 +- pl/debug.yap | 2 +- pl/error.yap | 35 +- pl/imports.yap | 18 +- pl/modules.yap | 12 +- pl/preddyns.yap | 2 +- pl/preds.yap | 183 +---- pl/threads.yap | 12 +- pl/top.yap | 21 +- pl/undefined.yap | 4 +- swi/library/CMakeLists.txt | 2 + {library => swi/library}/INDEX.pl | 0 swi/library/autoloader.yap | 132 ++++ 35 files changed, 1041 insertions(+), 957 deletions(-) rename {library => swi/library}/INDEX.pl (100%) create mode 100644 swi/library/autoloader.yap diff --git a/C/absmi.c b/C/absmi.c index fcd31e639..1ec017858 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -916,24 +916,26 @@ static int interrupt_dexecute(USES_REGS1) { static void undef_goal(USES_REGS1) { PredEntry *pe = PredFromDefCode(P); - BEGD(d0); -/* avoid trouble with undefined dynamic procedures */ -/* I assume they were not locked beforehand */ -#if defined(YAPOR) || defined(THREADS) + /* avoid trouble with undefined dynamic procedures */ + /* I assume they were not locked beforehand */ + #if defined(YAPOR) || defined(THREADS) if (!PP) { PELOCK(19, pe); PP = pe; } #endif - if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ) { + BACKUP_MACHINE_REGS(); +if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ) { #if defined(YAPOR) || defined(THREADS) UNLOCKPE(19, PP); PP = NULL; #endif CalculateStackGap(PASS_REGS1); P = FAILCODE; + RECOVER_MACHINE_REGS(); return; } +#if DEBUG if (UndefCode == NULL || UndefCode->OpcodeOfPred == UNDEF_OPCODE) { fprintf(stderr,"call to undefined Predicates %s ->", IndicatorOfPred(pe)); Yap_DebugPlWriteln(ARG1); @@ -946,16 +948,28 @@ static void undef_goal(USES_REGS1) { #endif CalculateStackGap(PASS_REGS1); P = FAILCODE; + RECOVER_MACHINE_REGS(); return; } +#endif #if defined(YAPOR) || defined(THREADS) UNLOCKPE(19, PP); PP = NULL; -#endif - if (pe->ArityOfPE == 0) { - d0 = MkAtomTerm((Atom)(pe->FunctorOfPred)); + #endif + CELL o = AbsPair(HR); + if (pe->ModuleOfPred == PROLOG_MODULE) { + if (CurrentModule == PROLOG_MODULE) + HR[0] = TermProlog; + else + HR[0] = CurrentModule; } else { - d0 = AbsAppl(HR); + HR[0] = Yap_Module_Name(pe); + } + HR += 2; + if (pe->ArityOfPE == 0) { + HR[-1] = MkAtomTerm((Atom)(pe->FunctorOfPred)); + } else { + HR[-1] = AbsAppl(HR); *HR++ = (CELL)pe->FunctorOfPred; CELL *ip=HR; UInt imax = pe->ArityOfPE; @@ -984,30 +998,20 @@ static void undef_goal(USES_REGS1) { ENDD(d1); } } - ARG1 = AbsPair(HR); - HR[1] = d0; -ENDD(d0); - if (pe->ModuleOfPred == PROLOG_MODULE) { - if (CurrentModule == PROLOG_MODULE) - HR[0] = TermProlog; - else - HR[0] = CurrentModule; - } else { - HR[0] = Yap_Module_Name(pe); - } - ARG2 = Yap_getUnknownModule(Yap_GetModuleEntry(HR[0])); - HR += 2; + ARG1 = o; + ARG2 = MkVarTerm(); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) low_level_trace(enter_pred, UndefCode, XREGS + 1); #endif /* LOW_LEVEL_TRACE */ P = UndefCode->CodeOfPred; + RECOVER_MACHINE_REGS(); } static void spy_goal(USES_REGS1) { PredEntry *pe = PredFromDefCode(P); - + BACKUP_MACHINE_REGS(); #if defined(YAPOR) || defined(THREADS) if (!PP) { PELOCK(14, pe); @@ -1027,6 +1031,7 @@ static void spy_goal(USES_REGS1) { PP = NULL; } #endif + RECOVER_MACHINE_REGS(); return; } } @@ -1044,6 +1049,7 @@ static void spy_goal(USES_REGS1) { } #endif Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT, ""); + RECOVER_MACHINE_REGS(); return; } LOCAL_PredEntriesCounter--; @@ -1055,6 +1061,7 @@ static void spy_goal(USES_REGS1) { } #endif Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, ""); + RECOVER_MACHINE_REGS(); return; } if ((pe->PredFlags & (CountPredFlag | ProfiledPredFlag | SpiedPredFlag)) == @@ -1066,6 +1073,7 @@ static void spy_goal(USES_REGS1) { } #endif P = pe->cs.p_code.TrueCodeOfPred; + RECOVER_MACHINE_REGS(); return; } } @@ -1084,6 +1092,7 @@ static void spy_goal(USES_REGS1) { PP = NULL; } #endif + RECOVER_MACHINE_REGS(); return; } } @@ -1153,6 +1162,7 @@ static void spy_goal(USES_REGS1) { low_level_trace(enter_pred, pt0, XREGS + 1); #endif /* LOW_LEVEL_TRACE */ } + RECOVER_MACHINE_REGS(); } Int Yap_absmi(int inp) { diff --git a/C/c_interface.c b/C/c_interface.c index b757f8b93..756abb7af 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -1725,6 +1725,7 @@ X_API YAP_PredEntryPtr YAP_AtomToPredInModule(YAP_Atom at, Term mod) { return RepPredProp(PredPropByAtom(at, mod)); } +/* static int run_emulator(USES_REGS1) { int out; @@ -1732,6 +1733,7 @@ static int run_emulator(USES_REGS1) { LOCAL_PrologMode |= UserCCallMode; return out; } +*/ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) { CACHE_REGS @@ -2210,8 +2212,10 @@ X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) { BACKUP_MACHINE_REGS(); Term t = Yap_read_term( sno, - MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs), - MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1), + MkPairTerm( + Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs), + MkPairTerm( + Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1), 1, &pos), TermNil)), true); @@ -2268,6 +2272,7 @@ X_API char *YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) { } } } + return out.val.c = pop_output_text_stack(l,buf); } /// write a a term to n user-provided buffer: make sure not tp diff --git a/C/dbase.c b/C/dbase.c index db253b349..70c6deea2 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -4000,7 +4000,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) { if (ap->cs.p_code.NOfClauses > 1) { if (ap->TimeStampOfPred >= TIMESTAMP_RESET) Yap_UpdateTimestamps(ap); - ++ap->TimeStampOfPred; + ++(ap->TimeStampOfPred); /* fprintf(stderr,"- * %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/ ap->LastCallOfPred = LUCALL_RETRACT; @@ -4017,7 +4017,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) { ap->LastCallOfPred = LUCALL_ASSERT; } } - clau->ClTimeEnd = ap->TimeStampOfPred; + //clau->ClTimeEnd = ap->TimeStampOfPred; Yap_RemoveClauseFromIndex(ap, clau->ClCode); /* release the extra reference */ } diff --git a/C/errors.c b/C/errors.c index 53c53bd7f..2e02c1cbe 100755 --- a/C/errors.c +++ b/C/errors.c @@ -41,8 +41,8 @@ #define set_key_i(k, ks, q, i, t) \ if (strcmp(ks, q) == 0) { \ - i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \ - return IsIntegerTerm(t); \ + i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \ + return IsIntegerTerm(t); \ } #define set_key_s(k, ks, q, i, t) \ @@ -99,7 +99,7 @@ if (strcmp(ks, q) == 0) { \ #define query_key_s(k, ks, q, i) \ if (strcmp(ks, q) == 0 ) \ -{ if (i->k) return MkAtomTerm(Yap_LookupAtom(i->k)); else return TermNil; } +{ if (i->k) return MkAtomTerm(Yap_LookupAtom(i->k)); else return TermEmptyAtom; } #define query_key_t(k, ks, q, i) \ @@ -1258,15 +1258,25 @@ static Int is_callable(USES_REGS1) { return false; } -static Int is_predicate_indicator(USES_REGS1) { +/** + * @pred is_predicate_indicator( Term, Module, Name, Arity ) + * + * This predicates can be used to verify if Term is a predicate indicator, that is of the form: + * + Name/Arity + * + Name//Arity-2 + * + Module:Name/Arity + * + Module:Name//Arity-2 + * + * if it is, it will extract the predicate's module, name, and arity. + */ +static Int get_predicate_indicator(USES_REGS1) { Term G = Deref(ARG1); // Term Context = Deref(ARG2); Term mod = CurrentModule; G = Yap_YapStripModule(G, &mod); if (IsVarTerm(G)) { - Yap_Error(INSTANTIATION_ERROR, G, NULL); - return false; + Yap_ThrowError(INSTANTIATION_ERROR, G, NULL); } if (!IsVarTerm(mod) && !IsAtomTerm(mod)) { Yap_Error(TYPE_ERROR_ATOM, G, NULL); @@ -1275,13 +1285,34 @@ static Int is_predicate_indicator(USES_REGS1) { if (IsApplTerm(G)) { Functor f = FunctorOfTerm(G); if (IsExtensionFunctor(f)) { - Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL); + Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL); } if (f == FunctorSlash || f == FunctorDoubleSlash) { - return true; + Term name = ArgOfTerm(1,G), arity = ArgOfTerm(2,G); + if (IsVarTerm(name)) { + Yap_ThrowError(INSTANTIATION_ERROR, name, NULL); + } else if (!IsAtomTerm(name)) { + Yap_ThrowError(TYPE_ERROR_ATOM, name, NULL); + } + if (IsVarTerm(arity)) { + Yap_ThrowError(INSTANTIATION_ERROR, arity, NULL); + } else if (!IsIntegerTerm(arity)) { + Yap_ThrowError(TYPE_ERROR_INTEGER, arity, NULL); + } else { + Int ar = IntegerOfTerm(arity); + if (ar < 0) { + Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, arity, NULL); + } + if ( f == FunctorDoubleSlash) { + arity = MkIntegerTerm(ar+2); + } + return Yap_unify(mod, ARG2) && + Yap_unify(name, ARG3) && + Yap_unify(arity, ARG4); + } + } } - } - Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL); + Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL); return false; } @@ -1296,9 +1327,8 @@ void Yap_InitErrorPreds(void) { Yap_InitCPred("$query_exception", 3, query_exception, 0); Yap_InitCPred("$drop_exception", 1, drop_exception, 0); Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag); - Yap_InitCPred("is_boolean", 2, is_boolean, TestPredFlag); - Yap_InitCPred("is_callable", 2, is_callable, TestPredFlag); - Yap_InitCPred("is_atom", 2, is_atom, TestPredFlag); - Yap_InitCPred("is_predicate_indicator", 2, is_predicate_indicator, - TestPredFlag); + Yap_InitCPred("is_boolean", 1, is_boolean, TestPredFlag); + Yap_InitCPred("is_callable", 1, is_callable, TestPredFlag); + Yap_InitCPred("is_atom", 1, is_atom, TestPredFlag); + Yap_InitCPred("get_predicate_indicator", 4, get_predicate_indicator, 0); } diff --git a/C/modules.c b/C/modules.c index 3aac99e55..798e05cb5 100644 --- a/C/modules.c +++ b/C/modules.c @@ -6,7 +6,7 @@ * * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * * -*************************************************************** f*********** +************************************************************************** * * File: modules.c * * Last rev: * @@ -24,7 +24,7 @@ static char SccsId[] = "%W% %G%"; #include "YapHeap.h" #include "Yatom.h" -static Int current_module(USES_REGS1); +static Int currgent_module(USES_REGS1); static Int current_module1(USES_REGS1); static ModEntry *LookupModule(Term a); static ModEntry *LookupSystemModule(Term a); diff --git a/C/utilpreds.c b/C/utilpreds.c index 903c08ca2..2a60761b5 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -93,12 +93,12 @@ typedef struct non_single_struct_t { #define def_trail_overflow() \ trail_overflow:{ \ - pop_text_stack(lvl);\ while (to_visit > to_visit0) {\ to_visit --;\ CELL *ptd0 = to_visit->ptd0;\ *ptd0 = to_visit->d0;\ }\ + pop_text_stack(lvl);\ LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;\ LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);\ clean_tr(TR0 PASS_REGS);\ @@ -640,7 +640,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te { if (IsPairTerm(d0)) { CELL *ap2 = RepPair(d0); - fprintf(stderr, "%d \n", RepPair(ap2[0])- ptf); + //fprintf(stderr, "%d \n", RepPair(ap2[0])- ptf); if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) { Term v = MkVarTerm(); *ptf = v; @@ -2656,13 +2656,13 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - pop_text_stack(lvl); while (to_visit > to_visit0) { to_visit --; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; } - return FALSE; + pop_text_stack(lvl); + return false; } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { @@ -2675,7 +2675,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R goto restart; } pop_text_stack(lvl); - return TRUE; + return true; def_aux_overflow(); } @@ -4340,6 +4340,7 @@ int vsc; static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) { + int lvl = push_text_stack(); struct non_single_struct_t @@ -4480,6 +4481,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share int ground = share; Int max = -1; + int lvl = push_text_stack(); HB = HLow; to_visit0 = to_visit; loop: @@ -4501,7 +4503,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share } *ptf = AbsPair(HR); ptf++; -#ifdef RATIONAL_TREES if (to_visit+1 >= (struct cp_frame *)AuxSp) { goto heap_overflow; } @@ -4513,18 +4514,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* fool the system into thinking we had a variable there */ *pt0 = AbsPair(HR); to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif ground = share; pt0 = ap2 - 1; pt0_end = ap2 + 1; @@ -4553,6 +4542,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share Int id = IntegerOfTerm(ap2[1]); ground = FALSE; if (id < -1) { + pop_text_stack(lvl); Yap_Error(RESOURCE_ERROR_STACK, TermNil, "unnumber vars cannot cope with VAR(-%d)", id); return 0L; } @@ -4587,7 +4577,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share *ptf = AbsAppl(HR); ptf++; /* store the terms to visit */ -#ifdef RATIONAL_TREES if (to_visit+1 >= (struct cp_frame *)AuxSp) { goto heap_overflow; } @@ -4599,18 +4588,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* fool the system into thinking we had a variable there */ *pt0 = AbsAppl(HR); to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif ground = (f != FunctorMutable) && share; d0 = ArityOfFunctor(f); pt0 = ap2; @@ -4661,6 +4638,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* restore our nice, friendly, term to its original state */ clean_dirty_tr(TR0 PASS_REGS); HB = HB0; + pop_text_stack(lvl); return ground; overflow: @@ -4669,7 +4647,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; @@ -4677,9 +4654,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share ptf = to_visit->to; *pt0 = to_visit->oldv; } -#endif reset_trail(TR0); /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); return -1; heap_overflow: @@ -4688,7 +4665,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; @@ -4696,9 +4672,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share ptf = to_visit->to; *pt0 = to_visit->oldv; } -#endif reset_trail(TR0); LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + pop_text_stack(lvl); return -3; } diff --git a/C/yap-args.c b/C/yap-args.c index 45eb54fff..f03161571 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -76,11 +76,13 @@ static void init_globals(YAP_init_args *yap_init) { #endif /* YAPOR || TABLING */ #ifdef YAPOR Yap_init_yapor_workers(); + if ( #if YAPOR_THREADS - if (Yap_thread_self() != 0) { + Yap_thread_self() != 0 #else - if (worker_id != 0) { + worker_id != 0 #endif + ) { #if defined(YAPOR_COPY) || defined(YAPOR_SBA) /* In the SBA we cannot just happily inherit registers @@ -96,7 +98,7 @@ static void init_globals(YAP_init_args *yap_init) { P = GETWORK_FIRST_TIME; Yap_exec_absmi(FALSE, YAP_EXEC_ABSMI); Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "abstract machine unexpected exit (YAP_Init)"); + "abstract machine unexpected exit (YAP_Init)"); } #endif /* YAPOR */ RECOVER_MACHINE_REGS(); @@ -118,25 +120,25 @@ static void init_globals(YAP_init_args *yap_init) { } if (yap_init->PrologRCFile) { Yap_PutValue(AtomConsultOnBoot, - MkAtomTerm(Yap_LookupAtom(yap_init->PrologRCFile))); + MkAtomTerm(Yap_LookupAtom(yap_init->PrologRCFile))); /* This must be done again after restore, as yap_flags has been overwritten .... */ setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG, - yap_init->HaltAfterBoot); + yap_init->HaltAfterBoot); } if (yap_init->PrologTopLevelGoal) { Yap_PutValue(AtomTopLevelGoal, - MkAtomTerm(Yap_LookupAtom(yap_init->PrologTopLevelGoal))); + MkAtomTerm(Yap_LookupAtom(yap_init->PrologTopLevelGoal))); } if (yap_init->PrologGoal) { Yap_PutValue(AtomInitGoal, - MkAtomTerm(Yap_LookupAtom(yap_init->PrologGoal))); + MkAtomTerm(Yap_LookupAtom(yap_init->PrologGoal))); } if (yap_init->PrologAddPath) { Yap_PutValue(AtomExtendFileSearchPath, - MkAtomTerm(Yap_LookupAtom(yap_init->PrologAddPath))); + MkAtomTerm(Yap_LookupAtom(yap_init->PrologAddPath))); } if (yap_init->QuietMode) { @@ -144,9 +146,10 @@ static void init_globals(YAP_init_args *yap_init) { } } + const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR, - *Yap_PLDIR, *Yap_BOOTSTRAP, *Yap_COMMONSDIR, *Yap_INPUT_STARTUP, - *Yap_OUTPUT_STARTUP, *Yap_SOURCEBOOT, *Yap_INCLUDEDIR, *Yap_PLBOOTDIR; + *Yap_PLDIR, *Yap_BOOTSTRAP, *Yap_COMMONSDIR, *Yap_INPUT_STARTUP, + *Yap_OUTPUT_STARTUP, *Yap_SOURCEBOOT, *Yap_INCLUDEDIR, *Yap_PLBOOTDIR; /** * consult loop in C: used to boot the system, butt supports goal execution and @@ -157,21 +160,21 @@ static bool load_file(const char *b_file USES_REGS) { Term t; int c_stream, osno, oactive; - Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1); + Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1); Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1); Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1); /* consult in C */ int lvl = push_text_stack(); char *full; - /* the consult mode does not matter here, really */ + /* the consult mode does not matter here, really */ if ((osno = Yap_CheckAlias(AtomLoopStream)) < 0) { osno = 0; } c_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, &full, &oactive); - __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "done init_ consult %s ",b_file); - if (c_stream < 0) { + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid", "done init_consult %s ",b_file); + if (c_stream < 0) { fprintf(stderr, "[ FATAL ERROR: could not open file %s ]\n", b_file); pop_text_stack(lvl); exit(1); @@ -181,51 +184,54 @@ static bool load_file(const char *b_file USES_REGS) { return false; } __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file); + ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file); - do { + while (t != TermEof) { CACHE_REGS - YAP_Reset(YAP_FULL_RESET, false); - Yap_StartSlots(); + YAP_Reset(YAP_FULL_RESET, false); + Yap_StartSlots(); Term vs = MkVarTerm(), pos = MkVarTerm(); t = YAP_ReadClauseFromStream(c_stream, vs, pos); // Yap_GetNèwSlot(t); - if (t == TermEof) - break; - if (t == 0) { - fprintf(stderr, "[ %s:%d: error: SYNTAX ERROR\n", - b_file, GLOBAL_Stream[c_stream].linecount); - break; - } -// -// { -// char buu[1024]; -// -// YAP_WriteBuffer(t, buu, 1023, 0); -// fprintf(stderr, "[ %s ]\n" , buu); -// } - - if (IsVarTerm(t) || t == TermNil) { - fprintf(stderr, "[ unbound or []: while parsing %s at line %d ]\n", - GLOBAL_Stream[c_stream].linecount); - } else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query || - FunctorOfTerm(t) == functor_command1)) { + if (t == TermEof || t == TermNil) { + continue; + } else if (t == 0) { + fprintf(stderr, "%s:" Int_FORMAT " :0: error: SYNTAX ERROR\n", + b_file, GLOBAL_Stream[c_stream].linecount); + // + // { + // char buu[1024]; + //1 + // YAP_WriteBuffer(t, buu, 1023, 0); + // fprintf(stderr, "[ %s ]\n" , buu); + // } + continue; + } else if (IsVarTerm(t)) { + fprintf(stderr, "%s:" Int_FORMAT ":0: error: unbound or NULL parser output\n\n", + b_file, + GLOBAL_Stream[c_stream].linecount); + continue; + } else if (IsApplTerm(t) && + (FunctorOfTerm(t) == functor_query || + FunctorOfTerm(t) == functor_command1)) { t = ArgOfTerm(1, t); if (IsApplTerm(t) && FunctorOfTerm(t) == functor_compile2) { - load_file(RepAtom(AtomOfTerm(ArgOfTerm(1, t)))->StrOfAE); + load_file(RepAtom(AtomOfTerm(ArgOfTerm(1, t)))->StrOfAE); Yap_ResetException(LOCAL_ActiveError); + continue; } else { - YAP_RunGoalOnce(t); + YAP_RunGoalOnce(t); } } else { YAP_CompileClause(t); } + yap_error_descriptor_t *errd; - if ((errd = Yap_GetException(LOCAL_ActiveError)) && (errd->errorNo != YAP_NO_ERROR)) { - fprintf(stderr, "%s:%ld:0: Error %s %s Found\n", errd->errorFile, - (long int)errd->errorLine, errd->classAsText, errd->errorAsText); + if ((errd = Yap_GetException(LOCAL_ActiveError)) && + (errd->errorNo != YAP_NO_ERROR)) { + fprintf(stderr, "%s:" Int_FORMAT ":0: error: %s/%s %s\n\n", b_file, errd->errorLine, errd->errorAsText, errd->classAsText, errd->errorMsg); } - } while (true); + } BACKUP_MACHINE_REGS(); YAP_EndConsult(c_stream, &osno, full); if (!Yap_AddAlias(AtomLoopStream, osno)) { @@ -233,24 +239,24 @@ static bool load_file(const char *b_file USES_REGS) { return false; } pop_text_stack(lvl); - return true; + return t == TermEof; } static const char * EOLIST ="EOLINE"; - static bool is_install; +static bool is_install; - static bool is_dir( const char *path, const void *info) { - if (is_install) - return true; +static bool is_dir( const char *path, const void *info) { + if (is_install) + return true; - if (Yap_isDirectory( path )) - return true; - char s[YAP_FILENAME_MAX + 1]; - Int i = strlen(path); - strncpy(s, path, YAP_FILENAME_MAX); + if (Yap_isDirectory( path )) + return true; + char s[YAP_FILENAME_MAX + 1]; + Int i = strlen(path); + strncpy(s, path, YAP_FILENAME_MAX); while (--i) { if (Yap_dir_separator((int)path[i])) - break; + break; } if (i == 0) { s[0] = '.'; @@ -258,80 +264,84 @@ static const char * EOLIST ="EOLINE"; } s[i] = '\0'; if (info == NULL) - return true; + return true; return strcmp(info,s) == 0 || Yap_isDirectory( s ); - } - - static bool is_file( const char *path, const void *info) { - if (is_install) - return true; - return Yap_Exists( path ); - } - - static bool is_wfile( const char *path, const void *info) { - - return true; - } +} + +static bool is_file( const char *path, const void *info) { + if (is_install) + return true; + return Yap_Exists( path ); +} + +static bool is_wfile( const char *path, const void *info) { + + return true; +} - typedef bool testf(const char *s, const void *info); +typedef bool testf(const char *s, const void *info); /// /// - static const char *sel( - testf test, const void *info, const char *s1, ...) { - const char *fmt = s1; -va_list ap; - char *buf = malloc(FILENAME_MAX + 1); +static const char *sel( + testf test, const void *info, const char *s1, ...) { + const char *fmt = s1; + va_list ap; + char *buf = malloc(FILENAME_MAX + 1); - va_start(ap, s1); - while (fmt != EOLIST) { - if (fmt == NULL || fmt[0]=='\0') { - fmt = va_arg(ap, const char *); - continue; - } - strncpy(buf, fmt, FILENAME_MAX); // Yap_AbsoluteFile(fmt,true), FILENAME_MAX); - if (test(buf,info)) { - buf = realloc(buf, strlen(buf) + 1); - va_end(ap); - return buf; - } - fmt = va_arg(ap, const char *); - } - - va_end(ap); - free(buf); -return NULL; + va_start(ap, s1); + while (fmt != EOLIST) { + if (fmt == NULL || fmt[0]=='\0') { + fmt = va_arg(ap, const char *); + continue; } + strncpy(buf, fmt, FILENAME_MAX); // Yap_AbsoluteFile(fmt,true), FILENAME_MAX); + if (test(buf,info)) { + buf = realloc(buf, strlen(buf) + 1); + va_end(ap); + return buf; + } + fmt = va_arg(ap, const char *); + } + + va_end(ap); + free(buf); + return NULL; +} static const char *join(const char *s0, const char *s1) { CACHE_REGS - if (!s0 || s0[0] == '\0') - return s1; + if (!s0 || s0[0] == '\0') { + if (s1 && s1[0]) + return s1; + else + return NULL; + } if (!s1 || s1[0] == '\0') return s0; // int lvl = push_text_stack(); char *buf = malloc(strlen(s0)+strlen(s1) + 2); strcpy(buf, s0); if (Yap_dir_separator(s0[strlen(s0)-1])) { - if (Yap_dir_separator(s1[0])) { - s1 += 1; - } + if (Yap_dir_separator(s1[0])) { + s1 += 1; + } } else { if (!Yap_dir_separator(s1[0]-1)) { - strcat(buf, "/"); - } + strcat(buf, "/"); + } } strcat(buf, s1); return buf; } static void Yap_set_locations(YAP_init_args *iap) { -is_install= iap->install; + is_install= iap->install; /// ROOT_DIR is the home of the YAP system. It can be: /// -- provided by the user; /// -- obtained from DESTDIR + DE=efalkRoot @@ -339,136 +349,137 @@ is_install= iap->install; /// It is: // --_not useful in Android, WIN32; /// -- DESTDIR/ in Anaconda - /// -- /usr/locall in most Unix style systems - Yap_ROOTDIR = sel( is_dir, NULL, - iap->ROOTDIR, - getenv("YAPROOTDIR"), - join(getenv("DESTDIR"), YAP_ROOTDIR), + /// -- /usr/loca77l in most Unix style systems + Yap_ROOTDIR = sel( is_dir, NULL, + iap->ROOTDIR, + getenv("YAPROOTDIR"), + join(getenv("DESTDIR"), YAP_ROOTDIR), #if __ANDROID__ - "/", + "/", #else - join(getenv("DESTDIR"), YAP_ROOTDIR), - join(getenv("DESTDIR"), join(getenv("ḦOME"),".local")), - join(getenv("DESTDIR"), "/usr/local"), - join(getenv("DESTDIR"), "/usr"), - join(getenv("DESTDIR"), "/opt"), + join(getenv("DESTDIR"), YAP_ROOTDIR), + join(getenv("DESTDIR"), join(getenv("ḦOME"),".local")), + join(getenv("DESTDIR"), "/usr/local"), + join(getenv("DESTDIR"), "/usr"), + join(getenv("DESTDIR"), "/opt"), #endif - EOLIST - ); - __android_log_print( - ANDROID_LOG_INFO,"YAPDroid", "Yap_ROOTDIR %s", Yap_ROOTDIR); + EOLIST + ); + __android_log_print( + ANDROID_LOG_INFO,"YAPDroid", "Yap_ROOTDIR %s", Yap_ROOTDIR); - /// BINDIR: where the OS stores header files, namely libYap... - Yap_BINDIR = sel( is_dir, Yap_ROOTDIR, iap->BINDIR, - getenv("YAPBINDIR"), + /// BINDIR: where the OS stores header files, namely libYap... + Yap_BINDIR = sel( is_dir, Yap_ROOTDIR, iap->BINDIR, + getenv("YAPBINDIR"), #if !defined(__ANDROID__) - join(getenv("DESTDIR"), YAP_BINDIR), + join(getenv("DESTDIR"), YAP_BINDIR), #endif - join(Yap_ROOTDIR, "bin"), - EOLIST); + join(Yap_ROOTDIR, "bin"), + EOLIST); /// LIBDIR: where the OS stores dynamic libraries, namely libYap... - Yap_LIBDIR = sel( is_dir, Yap_ROOTDIR, iap->LIBDIR, + Yap_LIBDIR = sel( is_dir, Yap_ROOTDIR, iap->LIBDIR, #if !defined(__ANDROID__) - join(getenv("DESTDIR"), YAP_LIBDIR), + join(getenv("DESTDIR"), YAP_LIBDIR), #endif - join(Yap_ROOTDIR, "lib"), - EOLIST); + join(Yap_ROOTDIR, "lib"), + EOLIST); /// DLLDIR: where libraries can find expicitely loaded DLLs - Yap_DLLDIR = sel(is_dir, Yap_LIBDIR, iap->DLLDIR, - getenv("YAPLIBDIR"), - join(getenv("DESTDIR"), YAP_DLLDIR), - join(Yap_LIBDIR, "/Yap"), - EOLIST); + Yap_DLLDIR = sel(is_dir, Yap_LIBDIR, iap->DLLDIR, + getenv("YAPLIBDIR"), + join(getenv("DESTDIR"), YAP_DLLDIR), + join(Yap_DLLDIR, "Yap"), + EOLIST); /// INCLUDEDIR: where the OS stores header files, namely libYap... - Yap_INCLUDEDIR = sel(is_dir, Yap_ROOTDIR, iap->INCLUDEDIR, + Yap_INCLUDEDIR = sel(is_dir, Yap_ROOTDIR, iap->INCLUDEDIR, #if !defined(__ANDROID__) - join(getenv("DESTDIR"), YAP_INCLUDEDIR), + join(getenv("DESTDIR"), YAP_INCLUDEDIR), #endif join(Yap_ROOTDIR, "include"), EOLIST); - /// SHAREDIR: where OS & ARCH independent files live - Yap_SHAREDIR = sel( is_dir, Yap_ROOTDIR, iap->SHAREDIR, - getenv("YAPSHAREDIR"), + /// SHAREDIR: where OS & ARCH independent files live + Yap_SHAREDIR = sel( is_dir, Yap_ROOTDIR, iap->SHAREDIR, + getenv("YAPSHAREDIR"), #if __ANDROID__ - "/data/data/pt.up.yap/files", - "/assets", + "/data/data/pt.up.yap/files", + "/assets", #endif - join(getenv("DESTDIR"), YAP_SHAREDIR), - join(Yap_ROOTDIR, "share"), - join(Yap_ROOTDIR, "files"), - EOLIST); - __android_log_print( - ANDROID_LOG_INFO,"YAPDroid", "Yap_SHAREDIR %s", Yap_SHAREDIR); + join(getenv("DESTDIR"), YAP_SHAREDIR), + join(Yap_ROOTDIR, "share"), + join(Yap_ROOTDIR, "files"), + EOLIST); + __android_log_print( + ANDROID_LOG_INFO,"YAPDroid", "Yap_SHAREDIR %s", Yap_SHAREDIR); - /// PLDIR: where we can find Prolog files + /// PLDIR: where we can find Prolog files Yap_PLDIR = sel( is_dir, Yap_SHAREDIR, iap->PLDIR, - join(getenv("DESTDIR"), join(Yap_SHAREDIR, "Yap")), - join(getenv("DESTDIR"), YAP_PLDIR), - EOLIST); + join(getenv("DESTDIR"), join(Yap_SHAREDIR, "Yap")), + EOLIST); - __android_log_print( - ANDROID_LOG_INFO, "YAPDroid","Yap_PLDIR %s", Yap_PLDIR); + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid","Yap_PLDIR %s", Yap_PLDIR); - /// ``COMMONSDIR: Prolog Commons + /// ``COMMONSDIR: Prolog Commons Yap_COMMONSDIR = sel(is_dir, Yap_SHAREDIR, iap->COMMONSDIR, - join(getenv("DESTDIR"), join(Yap_SHAREDIR, "PrologCommons")), - EOLIST); + join(getenv("DESTDIR"), join(Yap_SHAREDIR, "PrologCommons")), + EOLIST); /// SOURCEBOOT: booting from the Prolog boot file at compilation-time so we should not assume pl is installed. - Yap_SOURCEBOOT = sel( is_file, Yap_AbsoluteFile("pl",false), iap->SOURCEBOOT, - YAP_SOURCEBOOT, - "boot.yap", - EOLIST); - __android_log_print( - ANDROID_LOG_INFO, "YAPDroid","Yap_SOURCEBOOT %s", Yap_SOURCEBOOT); - Yap_PLBOOTDIR = sel( is_dir, Yap_PLDIR, iap->BOOTDIR, - join(getenv("DESTDIR"),join(Yap_PLDIR, "pl")), - EOLIST); - __android_log_print( - ANDROID_LOG_INFO, "YAPDroid","Yap_BOOTSTRAP %s", Yap_BOOTSTRAP); -/// BOOTSTRAP: booting from the Prolog boot file after YAP is installed - Yap_BOOTSTRAP = sel( is_file, Yap_PLBOOTDIR, iap->BOOTSTRAP, - join(getenv("DESTDIR"),YAP_BOOTSTRAP), - join(getenv("DESTDIR"),join(Yap_PLBOOTDIR, "boot.yap")), - EOLIST); - __android_log_print( - ANDROID_LOG_INFO,"YAPDroid", "Yap_BOOTSTRAP %s", Yap_PLBOOTDIR); + Yap_SOURCEBOOT = sel( is_file, Yap_AbsoluteFile("pl",false), iap->SOURCEBOOT, + YAP_SOURCEBOOT, + "boot.yap", + "../pl/boot.yap", + EOLIST); + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid","Yap_SOURCEBOOT %s", Yap_SOURCEBOOT); + + Yap_PLBOOTDIR = sel( is_dir, Yap_PLDIR, iap->BOOTDIR, + join(getenv("DESTDIR"),join(Yap_PLDIR, "pl")), + EOLIST); + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid","Yap_BOOTSTRAP %s", Yap_BOOTSTRAP); + /// BOOTSTRAP: booting from the Prolog boot file after YAP is installed + Yap_BOOTSTRAP = sel( is_file, Yap_PLBOOTDIR, iap->BOOTSTRAP, + join(getenv("DESTDIR"),YAP_BOOTSTRAP), + join(getenv("DESTDIR"),join(Yap_PLBOOTDIR, "boot.yap")), + EOLIST); + __android_log_print( + ANDROID_LOG_INFO,"YAPDroid", "Yap_BOOTSTRAP %s", Yap_PLBOOTDIR); /// STARTUP: where we can find the core Prolog bootstrap file Yap_OUTPUT_STARTUP = - sel( is_wfile, ".", iap->OUTPUT_STARTUP, - YAP_OUTPUT_STARTUP, - join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")), - join(getenv("DESTDIR"), join(Yap_DLLDIR,iap->OUTPUT_STARTUP)), - "startup.yss", - EOLIST); + sel( is_wfile, ".", iap->OUTPUT_STARTUP, + YAP_OUTPUT_STARTUP, + join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")), + join(getenv("DESTDIR"), join(Yap_DLLDIR,iap->OUTPUT_STARTUP)), + "startup.yss", + EOLIST); Yap_INPUT_STARTUP = sel( is_file, Yap_DLLDIR, iap->INPUT_STARTUP, - "startup.yss", - join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")), + "startup.yss", + join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")), #if !defined(__ANDROID__) - join(getenv("DESTDIR"), YAP_INPUT_STARTUP), + join(getenv("DESTDIR"), YAP_INPUT_STARTUP), #endif - "/usr/local/lib/Yap/startup.yss", - "/usr/lib/Yap/startup.yss", - EOLIST); + "/usr/local/lib/Yap/startup.yss", + "/usr/lib/Yap/startup.yss", + EOLIST); - if (Yap_ROOTDIR) + if (Yap_ROOTDIR) setAtomicGlobalPrologFlag(HOME_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR))); + MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR))); if (Yap_PLDIR) setAtomicGlobalPrologFlag(PROLOG_LIBRARY_DIRECTORY_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_PLDIR))); + MkAtomTerm(Yap_LookupAtom(Yap_PLDIR))); if (Yap_DLLDIR) setAtomicGlobalPrologFlag(PROLOG_FOREIGN_DIRECTORY_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_DLLDIR))); + MkAtomTerm(Yap_LookupAtom(Yap_DLLDIR))); } static void print_usage(void) { @@ -485,16 +496,16 @@ static void print_usage(void) { fprintf(stderr, " -L run Prolog file and exit\n"); fprintf(stderr, " -p extra path for file-search-path\n"); fprintf(stderr, " -hSize Heap area in Kbytes (default: %d, minimum: %d)\n", - DefHeapSpace, MinHeapSpace); + DefHeapSpace, MinHeapSpace); fprintf(stderr, - " -sSize Stack area in Kbytes (default: %d, minimum: %d)\n", - DefStackSpace, MinStackSpace); + " -sSize Stack area in Kbytes (default: %d, minimum: %d)\n", + DefStackSpace, MinStackSpace); fprintf(stderr, - " -tSize Trail area in Kbytes (default: %d, minimum: %d)\n", - DefTrailSpace, MinTrailSpace); + " -tSize Trail area in Kbytes (default: %d, minimum: %d)\n", + DefTrailSpace, MinTrailSpace); fprintf(stderr, " -GSize Max Area for Global Stack\n"); fprintf(stderr, - " -LSize Max Area for Local Stack (number must follow L)\n"); + " -LSize Max Area for Local Stack (number must follow L)\n"); fprintf(stderr, " -TSize Max Area for Trail (number must follow T)\n"); fprintf(stderr, " -nosignals disable signal handling from Prolog\n"); fprintf(stderr, "\n[Execution Modes]\n"); @@ -506,18 +517,18 @@ static void print_usage(void) { #ifdef TABLING fprintf(stderr, - " -ts Maximum table space area in Mbytes (default: unlimited)\n"); + " -ts Maximum table space area in Mbytes (default: unlimited)\n"); #endif /* TABLING */ -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ - defined(YAPOR_THREADS) +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ + defined(YAPOR_THREADS) fprintf(stderr, " -w Number of workers (default: %d)\n", - DEFAULT_NUMBERWORKERS); + DEFAULT_NUMBERWORKERS); fprintf(stderr, - " -sl Loop scheduler executions before look for hiden " - "shared work (default: %d)\n", - DEFAULT_SCHEDULERLOOP); + " -sl Loop scheduler executions before look for hiden " + "shared work (default: %d)\n", + DEFAULT_SCHEDULERLOOP); fprintf(stderr, " -d Value of delayed release of load (default: %d)\n", - DEFAULT_DELAYEDRELEASELOAD); + DEFAULT_DELAYEDRELEASELOAD); #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ /* nf: Preprocessor */ /* fprintf(stderr," -DVar=Name Persistent definition\n"); */ @@ -564,14 +575,14 @@ static int dump_runtime_variables(void) { } X_API YAP_file_type_t Yap_InitDefaults(void *x, char *saved_state, int argc, - char *argv[]) { + char *argv[]) { if (!LOCAL_TextBuffer) LOCAL_TextBuffer = Yap_InitTextAllocator(); YAP_init_args *iap = x; memset(iap, 0, sizeof(YAP_init_args)); - iap->Argc = argc; - iap->Argv = argv; + iap->Argc = argc; + iap->Argv = argv; #if __ANDROID__ iap->boot_file_type = YAP_PL; iap->INPUT_STARTUP = NULL; @@ -601,401 +612,401 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_a if (*p == '-') switch (*++p) { case 'b': - iap->boot_file_type = YAP_PL; - if (p[1]) - iap->BOOTSTRAP = p + 1; - else if (argv[1] && *argv[1] != '-') { - iap->BOOTSTRAP = *++argv; - argc--; - } - break; + iap->boot_file_type = YAP_PL; + if (p[1]) + iap->BOOTSTRAP = p + 1; + else if (argv[1] && *argv[1] != '-') { + iap->BOOTSTRAP = *++argv; + argc--; + } + break; case 'B': - iap->boot_file_type = YAP_SOURCE_PL; - if (p[1]) - iap->SOURCEBOOT = p + 1; - else if (argv[1] && *argv[1] != '-') { - iap->SOURCEBOOT = *++argv; - argc--; - } - iap->install = true; - break; + iap->boot_file_type = YAP_SOURCE_PL; + if (p[1]) + iap->SOURCEBOOT = p + 1; + else if (argv[1] && *argv[1] != '-') { + iap->SOURCEBOOT = *++argv; + argc--; + } + iap->install = true; + break; case '?': - print_usage(); - exit(EXIT_SUCCESS); + print_usage(); + exit(EXIT_SUCCESS); case 'q': - iap->QuietMode = TRUE; - break; -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ - defined(YAPOR_THREADS) + iap->QuietMode = TRUE; + break; +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ + defined(YAPOR_THREADS) case 'w': - ssize = &(iap->NumberWorkers); - goto GetSize; + ssize = &(iap->NumberWorkers); + goto GetSize; case 'd': - if (!strcmp("dump-runtime-variables", p)) - return dump_runtime_variables(); - ssize = &(iap->DelayedReleaseLoad); - goto GetSize; + if (!strcmp("dump-runtime-variables", p)) + return dump_runtime_variables(); + ssize = &(iap->DelayedReleaseLoad); + goto GetSize; #else case 'd': - if (!strcmp("dump-runtime-variables", p)) - return dump_runtime_variables(); + if (!strcmp("dump-runtime-variables", p)) + return dump_runtime_variables(); #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ case 'F': - /* just ignore for now */ - argc--; - argv++; - break; + /* just ignore for now */ + argc--; + argv++; + break; case 'f': - iap->FastBoot = TRUE; - if (argc > 1 && argv[1][0] != '-') { - argc--; - argv++; - if (strcmp(*argv, "none")) { - iap->PrologRCFile = *argv; - } - break; - } - break; - // execution mode + iap->FastBoot = TRUE; + if (argc > 1 && argv[1][0] != '-') { + argc--; + argv++; + if (strcmp(*argv, "none")) { + iap->PrologRCFile = *argv; + } + break; + } + break; + // execution mode case 'J': - switch (p[1]) { - case '0': - iap->ExecutionMode = YAPC_INTERPRETED; - break; - case '1': - iap->ExecutionMode = YAPC_MIXED_MODE_USER; - break; - case '2': - iap->ExecutionMode = YAPC_MIXED_MODE_ALL; - break; - case '3': - iap->ExecutionMode = YAPC_COMPILE_USER; - break; - case '4': - iap->ExecutionMode = YAPC_COMPILE_ALL; - break; - default: - fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c%c ]\n", - *p, p[1]); - exit(EXIT_FAILURE); - } - p++; - break; + switch (p[1]) { + case '0': + iap->ExecutionMode = YAPC_INTERPRETED; + break; + case '1': + iap->ExecutionMode = YAPC_MIXED_MODE_USER; + break; + case '2': + iap->ExecutionMode = YAPC_MIXED_MODE_ALL; + break; + case '3': + iap->ExecutionMode = YAPC_COMPILE_USER; + break; + case '4': + iap->ExecutionMode = YAPC_COMPILE_ALL; + break; + default: + fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c%c ]\n", + *p, p[1]); + exit(EXIT_FAILURE); + } + p++; + break; case 'G': - ssize = &(iap->MaxGlobalSize); - goto GetSize; - break; + ssize = &(iap->MaxGlobalSize); + goto GetSize; + break; case 's': case 'S': - ssize = &(iap->StackSize); -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ - defined(YAPOR_THREADS) - if (p[1] == 'l') { - p++; - ssize = &(iap->SchedulerLoop); - } + ssize = &(iap->StackSize); +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ + defined(YAPOR_THREADS) + if (p[1] == 'l') { + p++; + ssize = &(iap->SchedulerLoop); + } #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ - goto GetSize; + goto GetSize; case 'a': case 'A': - ssize = &(iap->AttsSize); - goto GetSize; + ssize = &(iap->AttsSize); + goto GetSize; case 'T': - ssize = &(iap->MaxTrailSize); - goto get_trail_size; + ssize = &(iap->MaxTrailSize); + goto get_trail_size; case 't': - ssize = &(iap->TrailSize); + ssize = &(iap->TrailSize); #ifdef TABLING - if (p[1] == 's') { - p++; - ssize = &(iap->MaxTableSpaceSize); - } + if (p[1] == 's') { + p++; + ssize = &(iap->MaxTableSpaceSize); + } #endif /* TABLING */ get_trail_size: - if (*++p == '\0') { - if (argc > 1) - --argc, p = *++argv; - else { - fprintf(stderr, - "[ YAP unrecoverable error: missing size in flag %s ]", - argv[0]); - print_usage(); - exit(EXIT_FAILURE); - } - } - { - unsigned long int i = 0, ch; - while ((ch = *p++) >= '0' && ch <= '9') - i = i * 10 + ch - '0'; - switch (ch) { - case 'M': - case 'm': - i *= 1024; - ch = *p++; - break; - case 'g': - i *= 1024 * 1024; - ch = *p++; - break; - case 'k': - case 'K': - ch = *p++; - break; - } - if (ch) { - iap->PrologTopLevelGoal = add_end_dot(*argv); - } else { - *ssize = i; - } - } - break; + if (*++p == '\0') { + if (argc > 1) + --argc, p = *++argv; + else { + fprintf(stderr, + "[ YAP unrecoverable error: missing size in flag %s ]", + argv[0]); + print_usage(); + exit(EXIT_FAILURE); + } + } + { + unsigned long int i = 0, ch; + while ((ch = *p++) >= '0' && ch <= '9') + i = i * 10 + ch - '0'; + switch (ch) { + case 'M': + case 'm': + i *= 1024; + ch = *p++; + break; + case 'g': + i *= 1024 * 1024; + ch = *p++; + break; + case 'k': + case 'K': + ch = *p++; + break; + } + if (ch) { + iap->PrologTopLevelGoal = add_end_dot(*argv); + } else { + *ssize = i; + } + } + break; case 'h': case 'H': - ssize = &(iap->HeapSize); + ssize = &(iap->HeapSize); GetSize: - if (*++p == '\0') { - if (argc > 1) - --argc, p = *++argv; - else { - fprintf(stderr, - "[ YAP unrecoverable error: missing size in flag %s ]", - argv[0]); - print_usage(); - exit(EXIT_FAILURE); - } - } - { - unsigned long int i = 0, ch; - while ((ch = *p++) >= '0' && ch <= '9') - i = i * 10 + ch - '0'; - switch (ch) { - case 'M': - case 'm': - i *= 1024; - ch = *p++; - break; - case 'g': - case 'G': - i *= 1024 * 1024; - ch = *p++; - break; - case 'k': - case 'K': - ch = *p++; - break; - } - if (ch) { - fprintf( - stderr, - "[ YAP unrecoverable error: illegal size specification %s ]", - argv[-1]); - Yap_exit(1); - } - *ssize = i; - } - break; + if (*++p == '\0') { + if (argc > 1) + --argc, p = *++argv; + else { + fprintf(stderr, + "[ YAP unrecoverable error: missing size in flag %s ]", + argv[0]); + print_usage(); + exit(EXIT_FAILURE); + } + } + { + unsigned long int i = 0, ch; + while ((ch = *p++) >= '0' && ch <= '9') + i = i * 10 + ch - '0'; + switch (ch) { + case 'M': + case 'm': + i *= 1024; + ch = *p++; + break; + case 'g': + case 'G': + i *= 1024 * 1024; + ch = *p++; + break; + case 'k': + case 'K': + ch = *p++; + break; + } + if (ch) { + fprintf( + stderr, + "[ YAP unrecoverable error: illegal size specification %s ]", + argv[-1]); + Yap_exit(1); + } + *ssize = i; + } + break; #ifdef DEBUG case 'P': - if (p[1] != '\0') { - while (p[1] != '\0') { - int ch = p[1]; - if (ch >= 'A' && ch <= 'Z') - ch += ('a' - 'A'); - if (ch >= 'a' && ch <= 'z') - GLOBAL_Option[ch - 96] = 1; - p++; - } - } else { - YAP_SetOutputMessage(); - } - break; + if (p[1] != '\0') { + while (p[1] != '\0') { + int ch = p[1]; + if (ch >= 'A' && ch <= 'Z') + ch += ('a' - 'A'); + if (ch >= 'a' && ch <= 'z') + GLOBAL_Option[ch - 96] = 1; + p++; + } + } else { + YAP_SetOutputMessage(); + } + break; #endif case 'L': - if (p[1] && p[1] >= '0' && - p[1] <= '9') /* hack to emulate SWI's L local option */ - { - ssize = &(iap->MaxStackSize); - goto GetSize; - } - iap->QuietMode = TRUE; - iap->HaltAfterBoot = true; + if (p[1] && p[1] >= '0' && + p[1] <= '9') /* hack to emulate SWI's L local option */ + { + ssize = &(iap->MaxStackSize); + goto GetSize; + } + iap->QuietMode = TRUE; + iap->HaltAfterBoot = true; case 'l': - p++; - if (!*++argv) { - fprintf(stderr, - "%% YAP unrecoverable error: missing load file name\n"); - exit(1); - } else if (!strcmp("--", *argv)) { - /* shell script, the next entry should be the file itself */ - iap->PrologRCFile = argv[1]; - argc = 1; - break; - } else { - iap->PrologRCFile = *argv; - argc--; - } - if (*p) { - /* we have something, usually, of the form: - -L -- - FileName - ExtraArgs - */ - /* being called from a script */ - while (*p && (*p == ' ' || *p == '\t')) - p++; - if (p[0] == '-' && p[1] == '-') { - /* ignore what is next */ - argc = 1; - } - } - break; - /* run goal before top-level */ + p++; + if (!*++argv) { + fprintf(stderr, + "%% YAP unrecoverable error: missing load file name\n"); + exit(1); + } else if (!strcmp("--", *argv)) { + /* shell script, the next entry should be the file itself */ + iap->PrologRCFile = argv[1]; + argc = 1; + break; + } else { + iap->PrologRCFile = *argv; + argc--; + } + if (*p) { + /* we have something, usually, of the form: + -L -- + FileName + ExtraArgs + */ + /* being called from a script */ + while (*p && (*p == ' ' || *p == '\t')) + p++; + if (p[0] == '-' && p[1] == '-') { + /* ignore what is next */ + argc = 1; + } + } + break; + /* run goal before top-level */ case 'g': - if ((*argv)[0] == '\0') - iap->PrologGoal = *argv; - else { - argc--; - if (argc == 0) { - fprintf(stderr, " [ YAP unrecoverable error: missing " - "initialization goal for option 'g' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->PrologGoal = *argv; - } - break; - /* run goal as top-level */ + if ((*argv)[0] == '\0') + iap->PrologGoal = *argv; + else { + argc--; + if (argc == 0) { + fprintf(stderr, " [ YAP unrecoverable error: missing " + "initialization goal for option 'g' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->PrologGoal = *argv; + } + break; + /* run goal as top-level */ case 'z': - if ((*argv)[0] == '\0') - iap->PrologTopLevelGoal = *argv; - else { - argc--; - if (argc == 0) { - fprintf(stderr, " [ YAP unrecoverable error: missing goal for " - "option 'z' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->PrologTopLevelGoal = add_end_dot(*argv); - } - iap->HaltAfterBoot = true; - break; + if ((*argv)[0] == '\0') + iap->PrologTopLevelGoal = *argv; + else { + argc--; + if (argc == 0) { + fprintf(stderr, " [ YAP unrecoverable error: missing goal for " + "option 'z' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->PrologTopLevelGoal = add_end_dot(*argv); + } + iap->HaltAfterBoot = true; + break; case 'n': - if (!strcmp("nosignals", p)) { - iap->PrologCannotHandleInterrupts = true; - break; - } - break; + if (!strcmp("nosignals", p)) { + iap->PrologCannotHandleInterrupts = true; + break; + } + break; case '-': - if (!strcmp("-nosignals", p)) { - iap->PrologCannotHandleInterrupts = true; - break; - } else if (!strncmp("-output-saved-state=", p, - strlen("-output-saved-state="))) { - iap->OUTPUT_STARTUP = p + strlen("-output-saved-state="); - } else if (!strncmp("-home=", p, strlen("-home="))) { - iap->ROOTDIR = p + strlen("-home="); - } else if (!strncmp("-system-library-directory=", p, - strlen("-system-library-directory="))) { - iap->LIBDIR = p + strlen("-system-library-directory="); - } else if (!strncmp("-system-shared-directory=", p, - strlen("-system-shared-directory="))) { - iap->SHAREDIR = p + strlen("-system-shared-directory="); - } else if (!strncmp("-prolog-library-directory=", p, - strlen("-prolog-library-directory="))) { - iap->PLDIR = p + strlen("-prolog-library-directory="); - } else if (!strncmp("-dll-library-directory=", p, - strlen("-dll-library-directory="))) { - iap->DLLDIR = p + strlen("-dll-library-directory="); - } else if (!strncmp("-home=", p, strlen("-home="))) { - iap->ROOTDIR = p + strlen("-home="); - } else if (!strncmp("-cwd=", p, strlen("-cwd="))) { - if (!Yap_ChDir(p + strlen("-cwd="))) { - fprintf(stderr, " [ YAP unrecoverable error in setting cwd: %s ]\n", - strerror(errno)); - } - } else if (!strncmp("-stack=", p, strlen("-stack="))) { - ssize = &(iap->StackSize); - p += strlen("-stack="); - goto GetSize; - } else if (!strncmp("-trail=", p, strlen("-trail="))) { - ssize = &(iap->TrailSize); - p += strlen("-trail="); - goto GetSize; - } else if (!strncmp("-heap=", p, strlen("-heap="))) { - ssize = &(iap->HeapSize); - p += strlen("-heap="); - goto GetSize; - } else if (!strncmp("-max-stack=", p, strlen("-max-stack="))) { - ssize = &(iap->MaxStackSize); - p += strlen("-max-stack="); - goto GetSize; - } else if (!strncmp("-max-trail=", p, strlen("-max-trail="))) { - ssize = &(iap->MaxTrailSize); - p += strlen("-max-trail="); - goto GetSize; - } else if (!strncmp("-max-heap=", p, strlen("-max-heap="))) { - ssize = &(iap->MaxHeapSize); - p += strlen("-max-heap="); - goto GetSize; - } else if (!strncmp("-goal=", p, strlen("-goal="))) { - iap->PrologGoal = p + strlen("-goal="); - } else if (!strncmp("-top-level=", p, strlen("-top-level="))) { - iap->PrologTopLevelGoal = p + strlen("-top-level="); - } else if (!strncmp("-table=", p, strlen("-table="))) { - ssize = &(iap->MaxTableSpaceSize); - p += strlen("-table="); - goto GetSize; - } else if (!strncmp("-", p, strlen("-="))) { - ssize = &(iap->MaxTableSpaceSize); - p += strlen("-table="); - /* skip remaining arguments */ - argc = 1; - } - break; + if (!strcmp("-nosignals", p)) { + iap->PrologCannotHandleInterrupts = true; + break; + } else if (!strncmp("-output-saved-state=", p, + strlen("-output-saved-state="))) { + iap->OUTPUT_STARTUP = p + strlen("-output-saved-state="); + } else if (!strncmp("-home=", p, strlen("-home="))) { + iap->ROOTDIR = p + strlen("-home="); + } else if (!strncmp("-system-library-directory=", p, + strlen("-system-library-directory="))) { + iap->LIBDIR = p + strlen("-system-library-directory="); + } else if (!strncmp("-system-shared-directory=", p, + strlen("-system-shared-directory="))) { + iap->SHAREDIR = p + strlen("-system-shared-directory="); + } else if (!strncmp("-prolog-library-directory=", p, + strlen("-prolog-library-directory="))) { + iap->PLDIR = p + strlen("-prolog-library-directory="); + } else if (!strncmp("-dll-library-directory=", p, + strlen("-dll-library-directory="))) { + iap->DLLDIR = p + strlen("-dll-library-directory="); + } else if (!strncmp("-home=", p, strlen("-home="))) { + iap->ROOTDIR = p + strlen("-home="); + } else if (!strncmp("-cwd=", p, strlen("-cwd="))) { + if (!Yap_ChDir(p + strlen("-cwd="))) { + fprintf(stderr, " [ YAP unrecoverable error in setting cwd: %s ]\n", + strerror(errno)); + } + } else if (!strncmp("-stack=", p, strlen("-stack="))) { + ssize = &(iap->StackSize); + p += strlen("-stack="); + goto GetSize; + } else if (!strncmp("-trail=", p, strlen("-trail="))) { + ssize = &(iap->TrailSize); + p += strlen("-trail="); + goto GetSize; + } else if (!strncmp("-heap=", p, strlen("-heap="))) { + ssize = &(iap->HeapSize); + p += strlen("-heap="); + goto GetSize; + } else if (!strncmp("-max-stack=", p, strlen("-max-stack="))) { + ssize = &(iap->MaxStackSize); + p += strlen("-max-stack="); + goto GetSize; + } else if (!strncmp("-max-trail=", p, strlen("-max-trail="))) { + ssize = &(iap->MaxTrailSize); + p += strlen("-max-trail="); + goto GetSize; + } else if (!strncmp("-max-heap=", p, strlen("-max-heap="))) { + ssize = &(iap->MaxHeapSize); + p += strlen("-max-heap="); + goto GetSize; + } else if (!strncmp("-goal=", p, strlen("-goal="))) { + iap->PrologGoal = p + strlen("-goal="); + } else if (!strncmp("-top-level=", p, strlen("-top-level="))) { + iap->PrologTopLevelGoal = p + strlen("-top-level="); + } else if (!strncmp("-table=", p, strlen("-table="))) { + ssize = &(iap->MaxTableSpaceSize); + p += strlen("-table="); + goto GetSize; + } else if (!strncmp("-", p, strlen("-="))) { + ssize = &(iap->MaxTableSpaceSize); + p += strlen("-table="); + /* skip remaining arguments */ + argc = 1; + } + break; case 'p': - if ((*argv)[0] == '\0') - iap->PrologAddPath = *argv; - else { - argc--; - if (argc == 0) { - fprintf(stderr, " [ YAP unrecoverable error: missing paths for " - "option 'p' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->PrologAddPath = *argv; - } - break; - /* nf: Begin preprocessor code */ + if ((*argv)[0] == '\0') + iap->PrologAddPath = *argv; + else { + argc--; + if (argc == 0) { + fprintf(stderr, " [ YAP unrecoverable error: missing paths for " + "option 'p' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->PrologAddPath = *argv; + } + break; + /* nf: Begin preprocessor code */ case 'D': { - char *var, *value; - ++p; - var = p; - if (var == NULL || *var == '\0') - break; - while (*p != '=' && *p != '\0') - ++p; - if (*p == '\0') - break; - *p = '\0'; - ++p; - value = p; - if (*value == '\0') - break; - if (iap->def_c == YAP_MAX_YPP_DEFS) - break; - iap->def_var[iap->def_c] = var; - iap->def_value[iap->def_c] = value; - ++(iap->def_c); - break; + char *var, *value; + ++p; + var = p; + if (var == NULL || *var == '\0') + break; + while (*p != '=' && *p != '\0') + ++p; + if (*p == '\0') + break; + *p = '\0'; + ++p; + value = p; + if (*value == '\0') + break; + if (iap->def_c == YAP_MAX_YPP_DEFS) + break; + iap->def_var[iap->def_c] = var; + iap->def_value[iap->def_c] = value; + ++(iap->def_c); + break; } - /* End preprocessor code */ + /* End preprocessor code */ default: { - fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c ]\n", - *p); - print_usage(); - exit(EXIT_FAILURE); + fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c ]\n", + *p); + print_usage(); + exit(EXIT_FAILURE); } } else { @@ -1044,20 +1055,20 @@ bool Yap_Embedded; static void init_hw(YAP_init_args *yap_init, struct ssz_t *spt) { Yap_page_size = Yap_InitPageSize(); /* init memory page size, required by - later functions */ + later functions */ #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) Yap_init_yapor_global_local_memory(); #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */ if (yap_init->Embedded) { yap_init->install = false; GLOBAL_PrologShouldHandleInterrupts = - yap_init->PrologCannotHandleInterrupts = true; + yap_init->PrologCannotHandleInterrupts = true; } else { GLOBAL_PrologShouldHandleInterrupts = - !yap_init->PrologCannotHandleInterrupts; + !yap_init->PrologCannotHandleInterrupts; } Yap_InitSysbits(0); /* init signal handling and time, required by later - functions */ + functions */ GLOBAL_argv = yap_init->Argv; GLOBAL_argc = yap_init->Argc; @@ -1115,10 +1126,10 @@ static void start_modules(void) { X_API void YAP_Init(YAP_init_args *yap_init) { bool try_restore = yap_init->boot_file_type == YAP_QLY; bool do_bootstrap = yap_init->boot_file_type == YAP_PL || - yap_init->boot_file_type == YAP_SOURCE_PL; + yap_init->boot_file_type == YAP_SOURCE_PL; struct ssz_t minfo; - __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "start init "); + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid", "start init "); if (YAP_initialized) /* ignore repeated calls to YAP_Init */ return; @@ -1130,14 +1141,14 @@ X_API void YAP_Init(YAP_init_args *yap_init) { minfo.Trail = 0, minfo.Stack = 0, minfo.Trail = 0; init_hw(yap_init, &minfo); Yap_InitWorkspace(yap_init, minfo.Heap, minfo.Stack, minfo.Trail, 0, - yap_init->MaxTableSpaceSize, yap_init->NumberWorkers, - yap_init->SchedulerLoop, yap_init->DelayedReleaseLoad); + yap_init->MaxTableSpaceSize, yap_init->NumberWorkers, + yap_init->SchedulerLoop, yap_init->DelayedReleaseLoad); // CACHE_REGS CurrentModule = PROLOG_MODULE; - if (yap_init->QuietMode) { + if (yap_init->QuietMode) { setVerbosity(TermSilent); } if (yap_init->PrologRCFile != NULL) { @@ -1146,7 +1157,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) { restore will print out messages .... */ setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG, - yap_init->HaltAfterBoot); + yap_init->HaltAfterBoot); } /* tell the system who should cope with interrupts */ Yap_ExecutionMode = yap_init->ExecutionMode; @@ -1156,41 +1167,41 @@ X_API void YAP_Init(YAP_init_args *yap_init) { try_restore = false; if (do_bootstrap || !try_restore || !Yap_SavedInfo(Yap_INPUT_STARTUP, &minfo.Trail, &minfo.Stack, - &minfo.Heap)) { + &minfo.Heap)) { init_globals(yap_init); start_modules(); - TermEof = MkAtomTerm(Yap_LookupAtom("end_of_file")); + TermEof = MkAtomTerm(Yap_LookupAtom("end_of_file")); LOCAL_consult_level = -1; __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "init %s ", Yap_BOOTSTRAP); + ANDROID_LOG_INFO, "YAPDroid", "init %s ", Yap_BOOTSTRAP); if (yap_init->install) { - load_file(Yap_SOURCEBOOT PASS_REGS); - setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_SOURCEBOOT))); + load_file(Yap_SOURCEBOOT PASS_REGS); + setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, + MkAtomTerm(Yap_LookupAtom(Yap_SOURCEBOOT))); } else { - load_file(Yap_BOOTSTRAP PASS_REGS); - setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_BOOTSTRAP))); + load_file(Yap_BOOTSTRAP PASS_REGS); + setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, + MkAtomTerm(Yap_LookupAtom(Yap_BOOTSTRAP))); } CurrentModule = LOCAL_SourceModule = TermUser; - setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false); + setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false); } else { if (yap_init->QuietMode) { - setVerbosity(TermSilent); - } + setVerbosity(TermSilent); + } __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "restore %s ",Yap_INPUT_STARTUP ); + ANDROID_LOG_INFO, "YAPDroid", "restore %s ",Yap_INPUT_STARTUP ); Yap_Restore(Yap_INPUT_STARTUP); - CurrentModule = LOCAL_SourceModule = TermUser; + CurrentModule = LOCAL_SourceModule = TermUser; init_globals(yap_init); start_modules(); if (yap_init->install && Yap_OUTPUT_STARTUP) { setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_INPUT_STARTUP))); + MkAtomTerm(Yap_LookupAtom(Yap_INPUT_STARTUP))); setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true); } LOCAL_consult_level = -1; @@ -1199,7 +1210,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) { if (yap_init->install && Yap_OUTPUT_STARTUP) { Term t = MkAtomTerm(Yap_LookupAtom(Yap_OUTPUT_STARTUP)); Term g = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("qsave_program"), 1), - 1, &t); + 1, &t); YAP_RunGoalOnce(g); } diff --git a/CMakeLists.txt b/CMakeLists.txt index dd11fab71..bdcc46d1c 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -375,22 +375,30 @@ if (GMP_INCLUDE_DIRS) endif () -if (WITH_READLINE) +# - Find the readline library +# This module defines +# READLINE_INCLUDE_DIR, path to readline/readline.h, etc. +# READLINE_LIBRARIES, the libraries required to use READLINE. +# READLINE_FOUND, If false, do not try to use READLINE. +# also defined, but not for general use are +# READLINE_readline_LIBRARY, where to find the READLINE library. +# READLINE_ncurses_LIBRARY, where to find the ncurses library [might not be defined] + include(FindReadline) - List(APPEND YAP_SYSTEM_OPTIONS readline) + option (WITH_READLINE "use Readline" ON) # include subdirectories configuration ## after we have all functionality in # # ADD_SUBDIRECTORY(console/terminal) if (READLINE_FOUND) + List(APPEND YAP_SYSTEM_OPTIONS readline) # required for configure - list(APPEND CMAKE_REQUIRED_INCLUDES ${READLINE_INCLUDE_DIR} + include_directories( ${READLINE_INCLUDE_DIR} ${READLINE_INCLUDE_DIR}/readline ) endif () -endif() include_directories(H H/generated @@ -450,7 +458,6 @@ set(DEF_STACKSPACE 0) set(DEF_HEAPSPACE 0) set(DEF_TRAILSPACE 0) -# option (RATIONAL_TREES "support infinite rational trees" ON) # dd_definitions (-D) ## don't touch these opts @@ -582,8 +589,12 @@ ADD_SUBDIRECTORY(pl) ADD_SUBDIRECTORY(library) +ADD_SUBDIRECTORY(swi/library) + add_subDIRECTORY(utf8proc ) + + if(ANDROID) set(CXX_SWIG_OUTDIR ${CMAKE_BINARY_DIR}/packages/swig/android) @@ -612,6 +623,7 @@ endif() add_subDIRECTORY( packages/myddas ) +add_subDIRECTORY( packages/clpqr ) List(APPEND YLIBS $) diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index e797ce9ed..f8466d7dd 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -354,23 +354,12 @@ vxu `on` consider `$` a lower case character. */ YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL), - /**< if defined, first location where YAP expects to find the YAP Prolog - library. Takes precedence over library_directory */ - YAP_FLAG(PROLOG_LIBRARY_DIRECTORY_FLAG, "prolog_library_directory", true, - isatom, "", NULL), - - /**< if defined, first location where YAP expects to find the YAP Prolog - shared libraries (DLLS). Takes precedence over executable_directory/2. */ /**< `max_arity is iso ` - YAP_FLAG(MAX_ARITY_FLAG, "max_arity", false, isatom, "unbounded", NULL), Read-only flag telling the maximum arity of a functor. Takes the value `unbounded` for the current version of YAP. */ - YAP_FLAG(PROLOG_FOREIGN_DIRECTORY_FLAG, "prolog_foreign_directory", true, - isatom, "", NULL), - - + YAP_FLAG(MAX_ARITY_FLAG, "max_arity", false, isatom, "unbounded", NULL), YAP_FLAG(MAX_TAGGED_INTEGER_FLAG, "max_tagged_integer", false, at2n, "INT_MAX", NULL), @@ -378,7 +367,14 @@ vxu `on` consider `$` a lower case character. YAP_FLAG(MAX_WORKERS_FLAG, "max_workers", false, at2n, "MAX_WORKERS", NULL), YAP_FLAG(MIN_TAGGED_INTEGER_FLAG, "min_tagged_integer", false, at2n, "INT_MIN", NULL), - YAP_FLAG(N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro, + + + YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators", + true, booleanFlag, "false", NULL), + + + + YAP_FLAG(N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro, "256", NULL), YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, booleanFlag, "false", NULL), @@ -407,8 +403,16 @@ vxu `on` consider `$` a lower case character. "true", NULL), - YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators", - true, booleanFlag, "false", NULL), + /**< if defined, first location where YAP expects to find the YAP Prolog + library. Takes precedence over library_directory */ + YAP_FLAG(PROLOG_LIBRARY_DIRECTORY_FLAG, "prolog_library_directory", true, + isatom, "", NULL), + + /**< if defined, first location where YAP expects to find the YAP Prolog + shared libraries (DLLS). Takes precedence over executable_directory/2. */ + YAP_FLAG(PROLOG_FOREIGN_DIRECTORY_FLAG, "prolog_foreign_directory", true, + isatom, "", NULL), + YAP_FLAG(OPTIMISE_FLAG, "optimise", true, booleanFlag, "false", NULL), YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "@boot", NULL), @@ -566,7 +570,6 @@ and if it is bound to `off` disable them. The default for YAP is */ YAP_FLAG(TABLING_MODE_FLAG, "tabling_mode", true, isatom, "[]", NULL), - YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL), YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL), /**< `toplevel_hook ` diff --git a/include/YapError.h b/include/YapError.h index 83bfb4e0c..246e5c81f 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -53,7 +53,7 @@ extern void Yap_ThrowError__(const char *file, const char *function, int lineno, ; #define Yap_NilError(id, ...) \ - Yap_Error__(false, __FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__) +Yap_Error__(false, __FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__) #define Yap_InitError(id, ...) \ Yap_InitError__(__FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__) diff --git a/library/CMakeLists.txt b/library/CMakeLists.txt index d231de802..219c2b7f0 100644 --- a/library/CMakeLists.txt +++ b/library/CMakeLists.txt @@ -1,11 +1,9 @@ set (LIBRARY_PL - INDEX.pl apply.yap apply_macros.yap arg.yap assoc.yap atts.yap - autoloader.yap avl.yap bhash.yap charsio.yap diff --git a/library/autoloader.yap b/library/autoloader.yap index 2037a5825..621ade734 100644 --- a/library/autoloader.yap +++ b/library/autoloader.yap @@ -120,10 +120,7 @@ find_predicate(G,ExportingModI) :- var(G), index(Name,Arity,ExportingModI,File), functor(G, Name, Arity), - ensure_file_loaded(File). + ensure_loaded(File). + +:- ensure_loaded('INDEX'). -ensure_file_loaded(File) :- - loaded(File), !. -ensure_file_loaded(File) :- - load_files(autoloader:File,[silent(true),if(not_loaded)]), - assert(loaded(File)). diff --git a/library/maplist.yap b/library/maplist.yap index 76368f864..7d4cc40d2 100644 --- a/library/maplist.yap +++ b/library/maplist.yap @@ -705,7 +705,7 @@ scanl_([H1|T1], [H2|T2], [H3|T3], [H4|T4], Goal, V, [VH|VT]) :- goal_expansion(checklist(Meta, List), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -726,7 +726,7 @@ goal_expansion(checklist(Meta, List), Mod:Goal) :- goal_expansion(maplist(Meta, List), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -747,7 +747,7 @@ goal_expansion(maplist(Meta, List), Mod:Goal) :- goal_expansion(maplist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -768,7 +768,7 @@ goal_expansion(maplist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion(maplist(Meta, L1, L2, L3), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -789,7 +789,7 @@ goal_expansion(maplist(Meta, L1, L2, L3), Mod:Goal) :- goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -810,7 +810,7 @@ goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod:Goal) :- goal_expansion(maplist(Meta, L1, L2, L3, L4, L5), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -831,7 +831,7 @@ goal_expansion(maplist(Meta, L1, L2, L3, L4, L5), Mod:Goal) :- goal_expansion(selectlist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -854,7 +854,7 @@ goal_expansion(selectlist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion(selectlist(Meta, ListIn, ListIn1, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -877,7 +877,7 @@ goal_expansion(selectlist(Meta, ListIn, ListIn1, ListOut), Mod:Goal) :- goal_expansion(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -901,7 +901,7 @@ goal_expansion(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal) % same as selectlist goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -924,7 +924,7 @@ goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion(exclude(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -947,7 +947,7 @@ goal_expansion(exclude(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion(partition(Meta, ListIn, List1, List2), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -970,7 +970,7 @@ goal_expansion(partition(Meta, ListIn, List1, List2), Mod:Goal) :- goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1010,7 +1010,7 @@ goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod:Goal) :- goal_expansion(convlist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1033,7 +1033,7 @@ goal_expansion(convlist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion(convlist(Meta, ListIn, ListExtra, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1056,7 +1056,7 @@ goal_expansion(convlist(Meta, ListIn, ListExtra, ListOut), Mod:Goal) :- goal_expansion(sumlist(Meta, List, AccIn, AccOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1077,7 +1077,7 @@ goal_expansion(sumlist(Meta, List, AccIn, AccOut), Mod:Goal) :- goal_expansion(foldl(Meta, List, AccIn, AccOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1098,7 +1098,7 @@ goal_expansion(foldl(Meta, List, AccIn, AccOut), Mod:Goal) :- goal_expansion(foldl(Meta, List1, List2, AccIn, AccOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1119,7 +1119,7 @@ goal_expansion(foldl(Meta, List1, List2, AccIn, AccOut), Mod:Goal) :- goal_expansion(foldl(Meta, List1, List2, List3, AccIn, AccOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1140,7 +1140,7 @@ goal_expansion(foldl(Meta, List1, List2, List3, AccIn, AccOut), Mod:Goal) :- goal_expansion(foldl2(Meta, List, AccIn, AccOut, W0, W), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1161,7 +1161,7 @@ goal_expansion(foldl2(Meta, List, AccIn, AccOut, W0, W), Mod:Goal) :- goal_expansion(foldl2(Meta, List1, List2, AccIn, AccOut, W0, W), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1182,7 +1182,7 @@ goal_expansion(foldl2(Meta, List1, List2, AccIn, AccOut, W0, W), Mod:Goal) :- goal_expansion(foldl2(Meta, List1, List2, List3, AccIn, AccOut, W0, W), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1203,7 +1203,7 @@ goal_expansion(foldl2(Meta, List1, List2, List3, AccIn, AccOut, W0, W), Mod:Goal goal_expansion(foldl3(Meta, List, AccIn, AccOut, W0, W, X0, X), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1224,7 +1224,7 @@ goal_expansion(foldl3(Meta, List, AccIn, AccOut, W0, W, X0, X), Mod:Goal) :- goal_expansion(foldl4(Meta, List, AccIn, AccOut, W0, W, X0, X, Y0, Y), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1245,7 +1245,7 @@ goal_expansion(foldl4(Meta, List, AccIn, AccOut, W0, W, X0, X, Y0, Y), Mod:Goal) goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1277,7 +1277,7 @@ goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod:Goal) :- goal_expansion(checknodes(Meta, Term), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1307,7 +1307,7 @@ goal_expansion(checknodes(Meta, Term), Mod:Goal) :- goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, diff --git a/library/system/sys_config.h b/library/system/sys_config.h index 17e29d49d..ace898575 100644 --- a/library/system/sys_config.h +++ b/library/system/sys_config.h @@ -5,7 +5,7 @@ /* Define to 1 if you have the header file. */ #ifndef HAVE_APR_1_APR_MD5_H -#define HAVE_APR_1_APR_MD5_H 1 +/* #undef HAVE_APR_1_APR_MD5_H */ #endif diff --git a/packages/clpqr/CMakeLists.txt b/packages/clpqr/CMakeLists.txt index b66383937..a00ed9b11 100644 --- a/packages/clpqr/CMakeLists.txt +++ b/packages/clpqr/CMakeLists.txt @@ -19,7 +19,10 @@ set (CLPQRPRIV clpqr/class.pl clpqr/dump.pl clpqr/project.pl clpqr/redund.pl) set (LIBPL clpr.pl clpq.pl ${CLPRPRIV} ${CLPQPRIV} ${CLPQRPRIV} ) -install ( FILES ${YAP_INSTALL_DATADIR} DESTINATION ${YAP_INSTALL_DATADIR} ) +install ( FILES ${CLPQPRIV} DESTINATION ${YAP_INSTALL_DATADIR}/clpq ) +install ( FILES ${CLPRPRIV} DESTINATION ${YAP_INSTALL_DATADIR}/clpr ) +install ( FILES ${CLPQRPRIV} DESTINATION ${YAP_INSTALL_DATADIR}/clpqr ) +install ( FILES clpr.pl clpq.pl DESTINATION ${YAP_INSTALL_DATADIR} ) # $(PL) -q -f $(srcdir)/clpr_test.pl -g test,halt -t 'halt(1)' diff --git a/packages/clpqr/clpr.pl b/packages/clpqr/clpr.pl index d84070ba4..2669b337e 100644 --- a/packages/clpqr/clpr.pl +++ b/packages/clpqr/clpr.pl @@ -128,7 +128,7 @@ minimise variable _V_ dump/3%, projecting_assert/1 ]). -:- expects_dialect(swi). +%:- expects_dialect(swi). % % Don't report export of private predicates from clpr diff --git a/packages/jpl/src/c/CMakeLists.txt b/packages/jpl/src/c/CMakeLists.txt index 5c309c77e..9e7415b5e 100644 --- a/packages/jpl/src/c/CMakeLists.txt +++ b/packages/jpl/src/c/CMakeLists.txt @@ -1,6 +1,6 @@ # set(CMAKE_MACOSX_RPATH 1) -add_lib(jplYap jpl.h jpl.c hacks.h) +add_library(jplYap jpl.c) include_directories (${JAVA_INCLUDE_PATH} ${JAVA_INCLUDE_PATH2} ${JAVA_AWT_PATH} ) diff --git a/packages/python/pybips.c b/packages/python/pybips.c index 986162d01..a160dc1e6 100644 --- a/packages/python/pybips.c +++ b/packages/python/pybips.c @@ -762,7 +762,7 @@ PyObject *term_to_nametuple(const char *s, arity_t arity, PyObject *tuple) { } else { PyStructSequence_Desc *desc = PyMem_Calloc(sizeof(PyStructSequence_Desc), 1); desc->name = PyMem_Malloc(strlen(s) + 1); - strcpy(desc->name, s); + strcpy((char *)desc->name, s); desc->doc = "YAPTerm"; desc->fields = pnull; desc->n_in_sequence = arity; diff --git a/packages/python/swig/README.md b/packages/python/swig/README.md index 90f64fe05..d609f6392 100644 --- a/packages/python/swig/README.md +++ b/packages/python/swig/README.md @@ -1,16 +1,14 @@ -The YAP Prolog System {#main} -=========== +
![The YAP Logo](docs/icons/yap_128x128x32.png)
NOTE: this version of YAP is still experimental, documentation may be out of date. -Introduction -++++++++++ +## Introduction This document provides User information on version 6.3.4 of -YAP (*Yet Another Prolog*). The YAP Prolog System is a +YAP (Yet Another Prolog). The YAP Prolog System is a high-performance Prolog compiler developed at Universidade do Porto. YAP supports stream Input/Output, sockets, modules, exceptions, Prolog debugger, C-interface, dynamic code, internal @@ -18,6 +16,7 @@ Porto. YAP supports stream Input/Output, sockets, modules, We explicitly allow both commercial and non-commercial use of YAP. + YAP is based on the David H. D. Warren's WAM (Warren Abstract Machine), with several optimizations for better performance. YAP follows the Edinburgh tradition, and was originally designed to be largely @@ -48,33 +47,47 @@ different licenses. If you have a question about this software, desire to add code, found a bug, want to request a feature, or wonder how to get further assistance, -please send e-mail to `yap-users AT lists.sourceforge.net. To -subscribe to the mailing list, visit the [YAP Mailing list page](https://lists.sourceforge.net/lists/listinfo/yap-users). +please send e-mail to . To +subscribe to the mailing list, visit the page +. On-line documentation is available for [YAP](http://www.dcc.fp.pt/~vsc/yap/) + + The packages are, in alphabetical order: -+ The CHR package developed by Tom Schrijvers, Christian Holzbaur, and Jan Wielemaker. ++ The CHR package developed by Tom Schrijvers, +Christian Holzbaur, and Jan Wielemaker. + The CLP(BN) package and Horus toolkit developed by Tiago Gomes, and Vítor Santos Costa. -+ The CLP(R) package developed by Leslie De Koninck, Bart Demoen, Tom Schrijvers, and Jan Wielemaker, based on the CLP(Q,R) implementation by Christian Holzbaur. ++ The CLP(R) package developed by Leslie De Koninck, Bart Demoen, Tom +Schrijvers, and Jan Wielemaker, based on the CLP(Q,R) implementation +by Christian Holzbaur. -+ The CPLint package developed by Fabrizio Riguzzi's research laboratory at the [University of Ferrara](http://www.ing.unife.it/Docenti/FabrizioRiguzzi/). ++ The CPLint package developed by Fabrizio Riguzzi's research +laboratory at the [University of Ferrara](http://www.ing.unife.it/Docenti/FabrizioRiguzzi/) -+ The CUDA interface package developed by Carlos Martínez, Jorge Buenabad, Inês Dutra and Vítor Santos Costa. ++ The CUDA interface package developed by Carlos Martínez, Jorge +Buenabad, Inês Dutra and Vítor Santos Costa. + The [GECODE](http://www.gecode.org) interface package developed by Denys Duchier and Vítor Santos Costa. + The [JPL](http://www.swi-prolog.org/packages/jpl/) (Java-Prolog Library) package developed by . -+ The minisat SAT solver interface developed by Michael Codish, Vitaly Lagoon, and Peter J. Stuckey. + The minisat SAT solver interface developed by Michael Codish, + Vitaly Lagoon, and Peter J. Stuckey. -+ The MYDDAS relational data-base interface developed at the Universidade do Porto by Tiago Soares, Michel Ferreira, and Ricardo Rocha. ++ The MYDDAS relational data-base interface developed at the + Universidade do Porto by Tiago Soares, Michel Ferreira, and Ricardo Rocha. -+ The [PRISM](http://rjida.meijo-u.ac.jp/prism/) logic-based programming system for statistical modeling developed at the Sato Research Laboratory, TITECH, Japan. ++ The [PRISM](http://rjida.meijo-u.ac.jp/prism/) logic-based +programming system for statistical modeling developed at the Sato +Research Laboratory, TITECH, Japan. -+ The ProbLog 1 system developed by the [ProbLog](https://dtai.cs.kuleuven.be/problog) team in the DTAI group of KULeuven. ++ The ProbLog 1 system developed by the [ProbLog](https://dtai.cs.kuleuven.be/problog) team in the +DTAI group of KULeuven. -+ The [R](http://stoics.org.uk/~nicos/sware/packs/real/) interface package developed by Nicos Angelopoulos, Vítor Santos Costa, João Azevedo, Jan Wielemaker, and Rui Camacho. ++ The [R](http://stoics.org.uk/~nicos/sware/packs/real/) interface package developed by Nicos Angelopoulos, +Vítor Santos Costa, João Azevedo, Jan Wielemaker, and Rui Camacho. diff --git a/packages/python/swig/setup.py b/packages/python/swig/setup.py index 23c49be72..3082198f7 100644 --- a/packages/python/swig/setup.py +++ b/packages/python/swig/setup.py @@ -65,11 +65,11 @@ if platform.system() == 'Windows': win_libs = ['wsock32','ws2_32'] my_extra_link_args = ['-Wl,-export-all-symbols'] elif platform.system() == 'Darwin': - my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/usr/local/lib','-Wl,-rpath,../yap4py'] + my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/lib','-Wl,-rpath,../yap4py'] 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,/usr/local/lib','-Wl,-rpath,'+join('/usr/local/lib','..'),'-Wl,-rpath,../yap4py'] + my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/lib','-Wl,-rpath,'+join('/lib','..'),'-Wl,-rpath,../yap4py'] win_libs = [] local_libs = ['Py4YAP'] @@ -91,10 +91,10 @@ extensions = [Extension('_yap', native_sources, ('PYTHONSWIG', '1'), ('_GNU_SOURCE', '1')], runtime_library_dirs=[ - abspath(join(sysconfig.get_path('platlib'),'yap4py')), abspath(sysconfig.get_path('platlib')),'/usr/local/lib'], + abspath(join(sysconfig.get_path('platlib'),'yap4py')), abspath(sysconfig.get_path('platlib')),'/lib'], swig_opts=['-modern', '-c++', '-py3', '-DX_API', '-Iyap4py/include' ], - library_dirs=[".",'../../..','/usr/local/lib'], + library_dirs=[".",'../../..','/lib'], extra_link_args=my_extra_link_args, libraries=['Yap','gmp']+win_libs+local_libs, include_dirs=['/home/vsc/github/yap-6.3/H', diff --git a/pl/CMakeLists.txt b/pl/CMakeLists.txt index 9697c2d7e..36b79a68a 100644 --- a/pl/CMakeLists.txt +++ b/pl/CMakeLists.txt @@ -1,4 +1,4 @@ -set(11PL_BOOT_SOURCES +set(PL_BOOT_SOURCES absf.yap android.yap arith.yap diff --git a/pl/boot.yap b/pl/boot.yap index 4c8f1381e..4837158ca 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -53,7 +53,6 @@ private(_). true/0], ['$$compile'/4, '$call'/4, '$catch'/3, - '$check_callable'/2, '$check_head_and_body'/4, '$check_if_reconsulted'/2, '$clear_reconsulting'/0, @@ -118,7 +117,7 @@ print_message(L,E) :- -> true ; - error(_,Info), + system_error(_,Info), '$error_descriptor'(Info, Desc), query_exception(prologPredFile, Desc, File), query_exception(prologPredLine, Desc, FilePos), @@ -132,7 +131,7 @@ print_message(L,E) :- format(user_error,'~a:~d: error: undefined ~w~n:',[F,L,M:G]), fail ; - format(user_error,' call to ~w~n',[M:G]), + format(user_error,' call to undefined procedure ~w~n',[M:G]), fail. :- '$undefp_handler'('$undefp0'(_,_),prolog). diff --git a/pl/consult.yap b/pl/consult.yap index a7b1f71f6..5920f944e 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -265,7 +265,7 @@ load_files(Files0,Opts) :- '$lf_option'(sandboxed, 24, false). '$lf_option'(scope_settings, 25, false). '$lf_option'(modified, 26, _). -'$lf_option'('$context_module', 27, _). +'$lf_option'(source_module, 27, _). '$lf_option'('$parent_topts', 28, _). '$lf_option'(must_be_module, 29, false). '$lf_option'('$source_pos', 30, _). @@ -317,12 +317,12 @@ load_files(Files0,Opts) :- '__NB_getval__'('$lf_status', OldTOpts, fail), nonvar(OldTOpts), functor( OldTOpts, opt, LastOpt ), '$lf_opt'(autoload, OldTOpts, OldAutoload), - '$lf_opt'('$context_module', OldTOpts, OldContextModule) + '$lf_opt'(source_module, OldTOpts, OldContextModule) ; current_prolog_flag(autoload, OldAutoload), functor( OldTOpts, opt, LastOpt ), '$lf_opt'(autoload, OldTOpts, OldAutoload), - '$lf_opt'('$context_module', OldTOpts, OldContextModule) + '$lf_opt'(source_module, OldTOpts, OldContextModule) ), functor( TOpts, opt, LastOpt ), ( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ), @@ -448,7 +448,7 @@ load_files(Files0,Opts) :- ( Val == false -> true ; Val == true -> true ; '$do_error'(domain_error(unimplemented_option,register(Val)),Call) ). -'$process_lf_opt'('$context_module', Mod, Call) :- +'$process_lf_opt'(source_module, Mod, Call) :- ( atom(Mod) -> true ; '$do_error'(type_error(atom,Mod),Call) ). @@ -724,7 +724,7 @@ db_files(Fs) :- set_stream( Stream, [alias(loop_stream), encoding(Encoding)] ), '__NB_getval__'('$loop_streams',Sts0, Sts0=[]), nb_setval('$loop_streams',[Stream|Sts0]), - '$lf_opt'('$context_module', TOpts, ContextModule), + '$lf_opt'(source_module, TOpts, ContextModule), '$lf_opt'(reexport, TOpts, Reexport), '$lf_opt'(qcompile, TOpts, QCompiling), '__NB_getval__'('$qcompile', ContextQCompiling, ContextQCompiling = never), @@ -1359,7 +1359,7 @@ account the following observations: '$reexport'( TOpts, File, Reexport, Imports, OldF ) :- ( Reexport == false -> true ; ( '$lf_opt'('$parent_topts', TOpts, OldTOpts), - '$lf_opt'('$context_module', OldTOpts, OldContextModule) + '$lf_opt'(source_module, OldTOpts, OldContextModule) -> true ; diff --git a/pl/debug.yap b/pl/debug.yap index 04223319d..ca648226f 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_pred'(G, M, Goal, NM), + '$get_undefined_pred'(M:G, NM:Goal), ( ( M == NM ; NM == prolog), G == Goal -> yap_flag( unknown, Action ), diff --git a/pl/error.yap b/pl/error.yap index 864484bd2..c71a0d1a9 100644 --- a/pl/error.yap +++ b/pl/error.yap @@ -10,8 +10,10 @@ [ must_be_of_type/2, % +Type, +Term must_be_of_type/3, % +Type, +Term, +Comment must_be/2, % +Type, +Term + must_be_callable/1, % +Type, +Term must_be/3, % +Type, +Term, +Comment type_error/2, % +Type, +Term + must_be_called/1, % must_be_in_domain/2, % +Domain, +Term % must_be_in_domain/3, % +Domain, +Term, +Comment domain_error/3, % +Domain, +Values, +Term @@ -21,7 +23,9 @@ must_bind_to_type/2, % +Type, ?Term instantiation_error/1, % +Term representation_error/1, % +Reason - is_of_type/2 % +Type, +Term + is_of_type/2, % +Type, +Term + is_callable/1, + is_callable/2 ]), []) . /** @@ -104,13 +108,13 @@ must_be(Type, X, Comment) :- must_be_of_type(callable, X) :- !, - is_callable(X, _). + is_callable(X). must_be_of_type(atom, X) :- !, - is_atom(X, _). + is_atom(X). must_be_of_type(module, X) :- !, - is_atom(X, _). + is_atom(X). must_be_of_type(predicate_indicator, X) :- !, is_predicate_indicator(X, _). @@ -120,19 +124,12 @@ must_be_of_type(Type, X) :- ; is_not(Type, X) ). -inline(must_be_of_type( atom, X ), is_atom(X, _) ). -inline(must_be_of_type( module, X ), is_module(X, _) ). -inline(must_be_of_type( callable, X ), is_callable(X, _) ). -inline(must_be_of_type( callable, X ), is_callable(X, _) ). -inline(must_be_atom( X ), is_callable(X, _) ). -inline(must_be_module( X ), is_atom(X, _) ). - must_be_of_type(predicate_indicator, X, Comment) :- !, is_predicate_indicator(X, Comment). -must_be_of_type(callable, X, Comment) :- +must_be_of_type(callable, X, _Comment) :- !, - is_callable(X, Comment). + is_callable(X). must_be_of_type(Type, X, _Comment) :- ( has_type(Type, X) -> true @@ -335,4 +332,16 @@ must_be_instantiated(X) :- must_be_instantiated(X, Comment) :- ( var(X) -> instantiation_error(X, Comment) ; true). +must_be_callable(X) :- + is_callable(X). + + +inline(must_be_of_type( atom, X ), is_atom(X) ). +inline(must_be_of_type( module, X ), is_atom(X) ). +inline(must_be_of_type( callable, X ), is_callable(X) ). +inline(must_be_atom( X ), is_atom(X) ). +inline(must_be_module( X ), is_atom(X) ). +inline(must_be_callable( X ), is_callable(X) ). +inline(is_callable( X,_ ), is_callable(X) ). + %% @} diff --git a/pl/imports.yap b/pl/imports.yap index 77bf042d9..10c759ed7 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -60,7 +60,7 @@ fail. % '$get_undefined_pred'(ImportingMod:G, ExportingMod:G0) :- - must_be_callablle( ImportingMod:G ), + must_be_callable( ImportingMod:G ), '$get_undefined_predicates'(ImportingMod:G, ExportingMod:G0). % be careful here not to generate an undefined exception. @@ -94,7 +94,7 @@ fail. '$verify_import'(_M:G, prolog:G) :- '$is_system_predicate'(G, prolog). '$verify_import'(M:G, NM:NG) :- - '$get_undefined_pred'(G, M, NG, NM), + '$get_undefined_predicates'(M:G, M, NM:NG), !. '$verify_import'(MG, MG). @@ -111,8 +111,13 @@ fail. functor(G0, N, K), '$autoloader_find_predicate'(G0,ExportingMod), ExportingMod \= ImportingMod, -% assert_static(ExportingMod:G0 :- ImportingMod:G0), - (recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_) -> true ; true ). + (recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_), + \+ '$system_predicate'(G0,prolog) + -> + '$compile'((G:-ExportingMod:G0), reconsult ,(ImportingMod:G:-ExportingMod:G0), ImportingMod, _) + ; + true + ). '$autoloader_find_predicate'(G,ExportingMod) :- @@ -122,10 +127,7 @@ fail. yap_flag(autoload, true, false), yap_flag( unknown, Unknown, fail), yap_flag(debug, Debug, false), !, - load_files([library(autoloader), - autoloader:library('NDEX'), - swi:library('dialect/swi/NDEX')], - [autoload(true),if(not_loaded)]), + load_files([library(autoloader)],[silent(true)]), nb_setval('$autoloader_set', true), yap_flag(autoload, _, true), yap_flag( unknown, _, Unknown), diff --git a/pl/modules.yap b/pl/modules.yap index 95ce44332..87fb38cbd 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -302,7 +302,7 @@ use_module(F,Is) :- % and remove import. % '$not_imported'(H, Mod) :- - recorded('$import','$import'(NM,Mod,NH,H,_,_),R), + recorded('$import','$import'(NM,Mod,NH,H,_,_),R), NM \= Mod, functor(NH,N,Ar), print_message(warning,redefine_imported(Mod,NM,N/Ar)), @@ -470,10 +470,14 @@ export_list(Module, List) :- G1=..[N1|Args], ( '$check_import'(M0,ContextMod,N1,K) -> ( ContextMod == prolog -> - recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_), - fail + 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 @@ -535,7 +539,7 @@ other source modules. This built-in was introduced by SWI-Prolog. In YAP, by default, modules only inherit from `prolog`. This extension allows predicates in the current module (see module/2 and module/1) to inherit from `user` or other modules. - + x2 */ set_base_module(ExportingModule) :- var(ExportingModule), diff --git a/pl/preddyns.yap b/pl/preddyns.yap index a9922e23f..ab4aee3f0 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -248,7 +248,7 @@ Retract all the clauses whose head matches the goal _G_. Goal */ retractall(V) :- '$yap_strip_module'(V,M,P), - is_callable(M,P), + is_callable(M:P), '$retractall'(P,M). '$retractall'(T,M) :- diff --git a/pl/preds.yap b/pl/preds.yap index 2bb938faf..9cb45460b 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -248,163 +248,55 @@ nth_clause(V,I,R) :- '$nth_clause'(P,M,I,R) :- '$fetch_nth_clause'(P,M,I,R). + +/** + @pred abolish(+ _PredSpec_) is iso + + +Deletes the predicate given by _PredSpec_ from the database. All +state on the predicate, including whether it is dynamic or static, +multifile, or meta-predicate, will be lost. The specification must +include the name and arity, and it may include module +information. Under iso language mode this built-in will only +abolish dynamic procedures. Under other modes it will abolish any +procedures. + +Older versions of YAP would accept unbound arguments; please use +current_predicate/2 to enumerate the predicates you want to discard. + +*/ +abolish(X) :- + get_predicate_indicator(X, M, Na, Ar), + functor(H, Na, Ar), + ( '$is_dynamic'(H, M) -> '$abolishd'(H, M) ; + '$undefined'(H, M) -> true ; + current_prolog_flag(language, iso) -> '$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(X)) ; + '$abolishs'(H,M) + ). + /** @pred abolish(+ _P_,+ _N_) Completely delete the predicate with name _P_ and arity _N_. It will remove both static and dynamic predicates. All state on the predicate, including whether it is dynamic or static, multifile, or meta-predicate, will be lost. -*/ -abolish(N0,A) :- - strip_module(N0, Mod, N), !, - '$abolish'(N,A,Mod). - -'$abolish'(N,A,M) :- var(N), !, - '$do_error'(instantiation_error,abolish(M:N,A)). -'$abolish'(N,A,M) :- var(A), !, - '$do_error'(instantiation_error,abolish(M:N,A)). -'$abolish'(N,A,M) :- - ( recorded('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ), - fail. -'$abolish'(N,A,M) :- functor(T,N,A), - ( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ; - /* else */ '$abolishs'(T,M) ). - -/** @pred abolish(+ _PredSpec_) is iso - - -Deletes the predicate given by _PredSpec_ from the database. If -§§ _PredSpec_ is an unbound variable, delete all predicates for the -current module. The -specification must include the name and arity, and it may include module -information. Under iso language mode this built-in will only abolish -dynamic procedures. Under other modes it will abolish any procedures. +abolish/2 is similar to abolish/1, but it always tries to erase static properties. It should not be confused with SICStus Prolog abolish/2, which is abolish/1 plus a list of options. */ -abolish(X0) :- - strip_module(X0,M,X), - '$abolish'(X,M). - -'$abolish'(X,M) :- - current_prolog_flag(language, sicstus), !, - '$new_abolish'(X,M). -'$abolish'(X, M) :- - '$old_abolish'(X,M). - -'$new_abolish'(V,M) :- var(V), !, - '$abolish_all_in_module'(M). -'$new_abolish'(A/V,M) :- atom(A), var(V), !, - '$abolish_all_atoms'(A,M). -'$new_abolish'(Na//Ar1, M) :- - integer(Ar1), - !, - Ar is Ar1+2, - '$new_abolish'(Na//Ar, M). -'$new_abolish'(Na/Ar, M) :- +abolish(N,A) :- + get_predicate_indicator(N/A, M, Na, Ar), functor(H, Na, Ar), - '$is_dynamic'(H, M), !, - '$abolishd'(H, M). -'$new_abolish'(Na/Ar, M) :- % succeed for undefined procedures. - functor(T, Na, Ar), - '$undefined'(T, M), !. -'$new_abolish'(Na/Ar, M) :- - '$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar)). -'$new_abolish'(T, M) :- - '$do_error'(type_error(predicate_indicator,T),abolish(M:T)). + ( '$is_dynamic'(H, M) -> '$abolishd'(H, M) ; + '$undefined'(H, M) -> true ; + '$abolishs'(H,M) + ). -'$abolish_all_in_module'(M) :- - '$current_predicate'(Na, M, S, _), - functor(S, Na, Ar), - '$new_abolish'(Na/Ar, M), - fail. -'$abolish_all_in_module'(_). -'$abolish_all_atoms'(Na, M) :- - '$current_predicate'(Na,M,S,_), - functor(S, Na, Ar), - '$new_abolish'(Na/Ar, M), - fail. -'$abolish_all_atoms'(_,_). - -'$check_error_in_predicate_indicator'(V, Msg) :- - var(V), !, - '$do_error'(instantiation_error, Msg). -'$check_error_in_predicate_indicator'(M:S, Msg) :- !, - '$check_error_in_module'(M, Msg), - '$check_error_in_predicate_indicator'(S, Msg). -'$check_error_in_predicate_indicator'(S, Msg) :- - S \= _/_, - S \= _//_, !, - '$do_error'(type_error(predicate_indicator,S), Msg). -'$check_error_in_predicate_indicator'(Na/_, Msg) :- - var(Na), !, - '$do_error'(instantiation_error, Msg). -'$check_error_in_predicate_indicator'(Na/_, Msg) :- - \+ atom(Na), !, - '$do_error'(type_error(atom,Na), Msg). -'$check_error_in_predicate_indicator'(_/Ar, Msg) :- - var(Ar), !, - '$do_error'(instantiation_error, Msg). -'$check_error_in_predicate_indicator'(_/Ar, Msg) :- - \+ integer(Ar), !, - '$do_error'(type_error(integer,Ar), Msg). -'$check_error_in_predicate_indicator'(_/Ar, Msg) :- - Ar < 0, !, - '$do_error'(domain_error(not_less_than_zero,Ar), Msg). -% not yet implemented! -%'$check_error_in_predicate_indicator'(Na/Ar, Msg) :- -% Ar < maxarity, !, -% '$do_error'(type_error(representation_error(max_arity),Ar), Msg). - -'$check_error_in_module'(M, Msg) :- - var(M), !, - '$do_error'(instantiation_error, Msg). -'$check_error_in_module'(M, Msg) :- - \+ atom(M), !, - '$do_error'(type_error(atom,M), Msg). - -'$old_abolish'(V,M) :- var(V), !, - ( true -> % current_prolog_flag(language, sicstus) -> - '$do_error'(instantiation_error,abolish(M:V)) - ; - '$abolish_all_old'(M) - ). -'$old_abolish'(N/A, M) :- !, - '$abolish'(N, A, M). -'$old_abolish'(A,M) :- atom(A), !, - ( current_prolog_flag(language, iso) -> - '$do_error'(type_error(predicate_indicator,A),abolish(M:A)) - ; - '$abolish_all_atoms_old'(A,M) - ). -'$old_abolish'([], _) :- !. -'$old_abolish'([H|T], M) :- !, '$old_abolish'(H, M), '$old_abolish'(T, M). -'$old_abolish'(T, M) :- - '$do_error'(type_error(predicate_indicator,T),abolish(M:T)). - -'$abolish_all_old'(M) :- - '$current_predicate'(Na, M, S, _), - functor( S, Na, Ar ), - '$abolish'(Na, Ar, M), - fail. -'$abolish_all_old'(_). - -'$abolish_all_atoms_old'(Na, M) :- - '$current_predicate'(Na, M, S, _), - functor(S, Na, Ar), - '$abolish'(Na, Ar, M), - fail. -'$abolish_all_atoms_old'(_,_). - -'$abolishs'(G, M) :- '$system_predicate'(G,M), !, - functor(G,Name,Arity), - '$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)). -'$abolishs'(G, Module) :- - current_prolog_flag(language, sicstus), % only do this in sicstus mode - '$undefined'(G, Module), +'$abolishs'(G, M) :- + '$system_predicate'(G,M), !, functor(G,Name,Arity), - print_message(warning,no_match(abolish(Module:Name/Arity))). + '$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)). '$abolishs'(G, M) :- '$is_multifile'(G,M), functor(G,Name,Arity), @@ -420,6 +312,7 @@ abolish(X0) :- '$purge_clauses'(G, M), fail. '$abolishs'(_, _). + /** @pred stash_predicate(+ _Pred_) Make predicate _Pred_ invisible to new code, and to `current_predicate/2`, `listing`, and friends. New predicates with the same name and @@ -509,7 +402,7 @@ predicate_property(Pred,Prop) :- M = Mod, NPred = TruePred ; - '$get_undefined_pred'(TruePred, Mod, NPred, M) + '$get_undefined_pred'(Mod:TruePred, M:NPred) ), '$predicate_property'(NPred,M,Mod,Prop). diff --git a/pl/threads.yap b/pl/threads.yap index 5fe496375..ca03a31a6 100644 --- a/pl/threads.yap +++ b/pl/threads.yap @@ -73,7 +73,7 @@ for MS-Windows. '$thread_gfetch'/1, '$thread_local'/2]). -:- use_system_module( '$_boot', ['$check_callable'/2, +:- use_system_module( '$_boot', [ '$run_at_thread_start'/0, '$system_catch'/4]). @@ -162,7 +162,7 @@ Create a new Prolog detached thread using default options. See thread_create/3. */ thread_create(Goal) :- G0 = thread_create(Goal), - '$check_callable'(Goal, G0), + is_callable(Goal), '$thread_options'([detached(true)], [], Stack, Trail, System, Detached, AtExit, G0), '$thread_new_tid'(Id), % '$erase_thread_info'(Id), % this should not be here @@ -184,7 +184,7 @@ Create a new Prolog thread using default options. See thread_create/3. */ thread_create(Goal, Id) :- G0 = thread_create(Goal, Id), - '$check_callable'(Goal, G0), + is_callable(Goal), ( nonvar(Id) -> '$do_error'(uninstantiation_error(Id),G0) ; true ), '$thread_options'([], [], Stack, Trail, System, Detached, AtExit, G0), '$thread_new_tid'(Id), @@ -243,7 +243,7 @@ data from their stacks. */ thread_create(Goal, Id, Options) :- G0 = thread_create(Goal, Id, Options), - '$check_callable'(Goal,G0), + is_callable(Goal), ( nonvar(Id) -> '$do_error'(uninstantiation_error(Id),G0) ; true ), '$thread_options'(Options, Alias, Stack, Trail, System, Detached, AtExit, G0), '$thread_new_tid'(Id), @@ -564,7 +564,7 @@ using instead the `at_exit/1` option of thread_create/3. */ thread_at_exit(Goal) :- - '$check_callable'(Goal,thread_at_exit(Goal)), + is_callable(Goal), '$thread_self'(Id0), recordz('$thread_exit_hook',[Id0|Goal],_). @@ -1284,7 +1284,7 @@ thread_sleep(Time) :- thread_signal(Id, Goal) :- '$check_thread_or_alias'(Id, thread_signal(Id, Goal)), - '$check_callable'(Goal, thread_signal(Id, Goal)), + is_callable(Goal), '$thread_id_alias'(Id0, Id), ( recorded('$thread_signal', [Id0| _], R), erase(R), fail ; true diff --git a/pl/top.yap b/pl/top.yap index 9845b32fb..242fbc30f 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -731,19 +731,6 @@ write_query_answer( Bindings ) :- % */ '$execute0'(G, CurMod). -'$check_callable'(V,G) :- var(V), !, - '$do_error'(instantiation_error,G). -'$check_callable'(M:_G1,G) :- var(M), !, - '$do_error'(instantiation_error,G). -'$check_callable'(_:G1,G) :- !, - '$check_callable'(G1,G). -'$check_callable'(A,G) :- number(A), !, - '$do_error'(type_error(callable,A),G). -'$check_callable'(R,G) :- db_reference(R), !, - '$do_error'(type_error(callable,R),G). -'$check_callable'(_,_). - - '$loop'(Stream,exo) :- prolog_flag(agc_margin,Old,0), prompt1(': '), prompt(_,' '), @@ -861,16 +848,16 @@ gated_call(Setup, Goal, Catcher, Cleanup) :- % % split head and body, generate an error if body is unbound. % -'$check_head_and_body'(C,M,H,B,P) :- +'$check_head_and_body'(C,M,H,B,_P) :- '$yap_strip_module'(C,M1,(MH:-B0)), !, '$yap_strip_module'(M1:MH,M,H), ( M == M1 -> B = B0 ; B = M1:B0), - is_callable(M:H,P). + is_callable(M:H). -'$check_head_and_body'(MH, M, H, true, P) :- +'$check_head_and_body'(MH, M, H, true, _XsP) :- '$yap_strip_module'(MH,M,H), - is_callable(M:H,P). + is_callable(M:H). % term expansion % % return two arguments: Expanded0 is the term after "USER" expansion. diff --git a/pl/undefined.yap b/pl/undefined.yap index 4b01e029d..016ca7cf3 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -72,9 +72,7 @@ undefined_query(G0, M0, Cut) :- '$handle_error'(error,Goal,Mod) :- functor(Goal,Name,Arity), - 'program_continuation'(PMod,PName,PAr), - '$do_error'(existence_error(procedure,Name/Arity), - context(Mod:Goal,PMod:PName/PAr)). + '$do_error'(existence_error(procedure,Name/Arity), Mod:Goal). '$handle_error'(warning,Goal,Mod) :- functor(Goal,Name,Arity), 'program_continuation'(PMod,PName,PAr), diff --git a/swi/library/CMakeLists.txt b/swi/library/CMakeLists.txt index 8b8889098..2c8c5c614 100644 --- a/swi/library/CMakeLists.txt +++ b/swi/library/CMakeLists.txt @@ -1,5 +1,7 @@ set (LIBRARY_PL +INDEX.pl aggregate.pl + autoloader.yap base64.pl broadcast.pl ctypes.pl diff --git a/library/INDEX.pl b/swi/library/INDEX.pl similarity index 100% rename from library/INDEX.pl rename to swi/library/INDEX.pl diff --git a/swi/library/autoloader.yap b/swi/library/autoloader.yap new file mode 100644 index 000000000..b37ac4102 --- /dev/null +++ b/swi/library/autoloader.yap @@ -0,0 +1,132 @@ +/** + * @file autoloader.yap + + */ +:- module(autoloader,[make_library_index/0]). + +:- use_module(library(lists),[append/3]). + +:- dynamic exported/3, loaded/1. + +make_library_index :- + scan_library_exports, + scan_swi_exports. + +scan_library_exports :- + % init table file. + open('INDEX.pl', write, W), + close(W), + scan_exports('../GPL/aggregate', library(aggregate)), + scan_exports(apply, library(apply)), + scan_exports(arg, library(arg)), + scan_exports(assoc, library(assoc)), + scan_exports(avl, library(avl)), + scan_exports(bhash, library(bhash)), + scan_exports(charsio, library(charsio)), + scan_exports('../packages/chr/chr_swi', library(chr)), + scan_exports(clp/clpfd, library(clpfd)), + scan_exports('../packages/clpqr/clpr', library(clpr)), + scan_exports(gensym, library(gensym)), + scan_exports(heaps, library(heaps)), + scan_exports('../packages/jpl/jpl', library(jpl)), + scan_exports(lists, library(lists)), + scan_exports(nb, library(nb)), + scan_exports(occurs, library(occurs)), + scan_exports('../LGPL/option', library(option)), + scan_exports(ordsets, library(ordsets)), + scan_exports(pairs, library(pairs)), + scan_exports('../LGPL/prolog_xref', library(prolog_xref)), + scan_exports('../packages/plunit/plunit', library(plunit)), + scan_exports(queues, library(queues)), + scan_exports(random, library(random)), + scan_exports(rbtrees, library(rbtrees)), + scan_exports('../LGPL/readutil', library(readutil)), + scan_exports(regexp, library(regexp)), + scan_exports('../LGPL/shlib', library(shlib)), + scan_exports(system, library(system)), + scan_exports(terms, library(terms)), + scan_exports(timeout, library(timeout)), + scan_exports(trees, library(trees)). + +scan_exports(Library, CallName) :- + absolute_file_name(Library, Path, + [ file_type(prolog), + access(read), + file_errors(fail) + ]), + open(Path, read, O), + !, + get_exports(O, Exports, Module), + close(O), + open('INDEX.pl', append, W), + publish_exports(Exports, W, CallName, Module), + close(W). +scan_exports(Library) :- + format(user_error,'[ warning: library ~w not defined ]~n',[Library]). + +% +% SWI is the only language that uses autoload. +% +scan_swi_exports :- + retractall(exported(_,_,_)), + absolute_file_name(dialect/swi, Path, + [ file_type(prolog), + access(read), + file_errors(fail) + ]), + open(Path, read, O), + get_exports(O, Exports, Module), + get_reexports(O, Reexports, Exports), + close(O), + open('dialect/swi/INDEX.pl', write, W), + publish_exports(Reexports, W, library(dialect/swi), Module), + close(W). + +get_exports(O, Exports, Module) :- + read(O, (:- module(Module,Exports))), !. +get_exports(O, Exports, Module) :- + get_exports(O, Exports, Module). + +get_reexports(O, Exports, ExportsL) :- + read(O, (:- reexport(_File,ExportsI))), !, + get_reexports(O, Exports0, ExportsL), + append(ExportsI, Exports0, Exports). +get_reexports(_, Exports, Exports). + +publish_exports([], _, _, _). +publish_exports([F/A|Exports], W, Path, Module) :- + publish_export(F, A, W, Path, Module), + publish_exports(Exports, W, Path, Module). +publish_exports([F//A0|Exports], W, Path, Module) :- + A is A0+2, + publish_export(F, A, W, Path, Module), + publish_exports(Exports, W, Path, Module). +publish_exports([op(_,_,_)|Exports], W, Path, Module) :- + publish_exports(Exports, W, Path, Module). + +publish_export(F, A, _, _, Module) :- + exported(F, A, M), M \= Module, !, + format(user_error,'[ warning: clash between ~a and ~a over ~a/~d ]~n',[Module,M,F,A]). +publish_export(F, A, W, Path, Module) :- + assert(exported(F, A, Module)), !, + portray_clause(W, index(F, A, Module, Path)). + +find_predicate(G,ExportingModI) :- + nonvar(G), !, + functor(G, Name, Arity), + index(Name,Arity,ExportingModI,File), + ensure_file_loaded(File). +find_predicate(G,ExportingModI) :- + var(G), + index(Name,Arity,ExportingModI,File), + functor(G, Name, Arity), + ensure_file_loaded(File). + +ensure_file_loaded(File) :- + loaded(File), !. +ensure_file_loaded(File) :- + load_files(autoloader:File,[silent(true),if(not_loaded)]), + assert(loaded(File)). + +:- include('INDEX'). + From e83d1f9d43d673893505ed7296e8596bc91ff8a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 21 Jan 2019 18:54:14 +0000 Subject: [PATCH 004/101] : --- CMakeLists.txt | 37 +++++++++++++++---------------- packages/jpl/src/c/CMakeLists.txt | 2 +- 2 files changed, 19 insertions(+), 20 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 2c332760c..5940a406a 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -365,17 +365,6 @@ find_package(GMP) list(APPEND YAP_SYSTEM_OPTIONS big_numbers) -include_directories(H - H/generated - include os OPTYap utf8proc JIT/HPP) -include_directories(BEFORE ${CMAKE_BINARY_DIR} ${CMAKE_TOP_BINARY_DIR}) - -add_subdirectory( H ) - -if (GMP_INCLUDE_DIRS) - #config.h needs this (TODO: change in code latter) - include_directories(${GMP_INCLUDE_DIRS}) - endif () if (WITH_READLINE) @@ -387,14 +376,24 @@ if (WITH_READLINE) # # ADD_SUBDIRECTORY(console/terminal) - if (READLINE_FOUND) - include_directories(${READLINE_INCLUDE_DIR}) - # required for configure - list(APPEND CMAKE_REQUIRED_LIBRARIES ${READLINE_LIBRARIES}) + target_link_libraries(libYap android log) list(APPEND CMAKE_REQUIRED_INCLUDES ${READLINE_INCLUDE_DIR}) - endif () endif() +set_directory_properties( PROPERTIES INCLUDE_DIRECTORIES + H + H/generated + include + os + OPTYap + utf8proc + JIT/HPP + ${GMP_INCLUDE_DIRS} + ${READLINE_LIBRARIES} + ${SQLITE_LIBRARIES} + ${ANDROID_LIBRARIES} + ) + #MPI STUFF # library/mpi/mpi.c library/mpi/mpe.c # library/lammpi/yap_mpi.c library/lammpi/hash.c library/lammpi/prologterms2c.c @@ -410,8 +409,8 @@ endif() set(YAP_FOUND ON) set(YAP_MAJOR_VERSION 6) -set(YAP_MINOR_VERSION 4) -set(YAP_PATCH_VERSION 1) +set(YAP_MINOR_VERSION 5) +set(YAP_PATCH_VERSION 0) set(YAP_FULL_VERSION ${YAP_MAJOR_VERSION}.${YAP_MINOR_VERSION}.${YAP_PATCH_VERSION}) @@ -634,7 +633,7 @@ add_library( # Sets the name of the library. ) if (GMP_FOUND) - target_link_libraries(libYap ${GMP_LIBRARIES}) + target_link_libraries(libYap ) endif (GMP_FOUND) if (READLINE_FOUND) diff --git a/packages/jpl/src/c/CMakeLists.txt b/packages/jpl/src/c/CMakeLists.txt index 5c309c77e..1dc29a90e 100644 --- a/packages/jpl/src/c/CMakeLists.txt +++ b/packages/jpl/src/c/CMakeLists.txt @@ -1,6 +1,6 @@ # set(CMAKE_MACOSX_RPATH 1) -add_lib(jplYap jpl.h jpl.c hacks.h) +add_library(jplYap jpl.h jpl.c hacks.h) include_directories (${JAVA_INCLUDE_PATH} ${JAVA_INCLUDE_PATH2} ${JAVA_AWT_PATH} ) From 17a75d79ff41d54598bbe027b8a26466b4c7b9ab Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 22 Jan 2019 01:47:07 +0000 Subject: [PATCH 005/101] metas --- C/globals.c | 801 ++++++++++++++++------------------ C/modules.c | 2 +- C/utilpreds.c | 22 +- packages/clpqr/clpq/itf_q.pl | 4 +- packages/clpqr/clpqr/geler.pl | 4 + packages/clpqr/clpqr/itf.pl | 4 + packages/clpqr/clpr/itf_r.pl | 4 + 7 files changed, 408 insertions(+), 433 deletions(-) diff --git a/C/globals.c b/C/globals.c index 5f5ec6963..67e401e99 100644 --- a/C/globals.c +++ b/C/globals.c @@ -1,19 +1,19 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: non backtrackable term support * -* Last rev: 2/8/06 * -* mods: * -* comments: non-backtrackable term support * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: non backtrackable term support * + * Last rev: 2/8/06 * + * mods: * + * comments: non-backtrackable term support * + * * + *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif @@ -30,82 +30,82 @@ static char SccsId[] = "%W% %G%"; /** - @defgroup Global_Variables Global Variables -@ingroup builtins -@{ + @defgroup Global_Variables Global Variables + @ingroup builtins + @{ -Global variables are associations between names (atoms) and -terms. They differ in various ways from storing information using -assert/1 or recorda/3. + Global variables are associations between names (atoms) and + terms. They differ in various ways from storing information using + assert/1 or recorda/3. -+ The value lives on the Prolog (global) stack. This implies that -lookup time is independent from the size of the term. This is -particularly interesting for large data structures such as parsed XML -documents or the CHR global constraint store. + + The value lives on the Prolog (global) stack. This implies that + lookup time is independent from the size of the term. This is + particularly interesting for large data structures such as parsed XML + documents or the CHR global constraint store. -+ They support both global assignment using nb_setval/2 and -backtrackable assignment using b_setval/2. + + They support both global assignment using nb_setval/2 and + backtrackable assignment using b_setval/2. -+ Only one value (which can be an arbitrary complex Prolog term) -can be associated to a variable at a time. + + Only one value (which can be an arbitrary complex Prolog term) + can be associated to a variable at a time. -+ Their value cannot be shared among threads. Each thread has its own -namespace and values for global variables. + + Their value cannot be shared among threads. Each thread has its own + namespace and values for global variables. -Currently global variables are scoped globally. We may consider module -scoping in future versions. Both b_setval/2 and -nb_setval/2 implicitly create a variable if the referenced name -does not already refer to a variable. + Currently global variables are scoped globally. We may consider module + scoping in future versions. Both b_setval/2 and + nb_setval/2 implicitly create a variable if the referenced name + does not already refer to a variable. -Global variables may be initialized from directives to make them -available during the program lifetime, but some considerations are -necessary for saved-states and threads. Saved-states to not store -global variables, which implies they have to be declared with -initialization/1 to recreate them after loading the saved -state. Each thread has its own set of global variables, starting with -an empty set. Using `thread_initialization/1` to define a global -variable it will be defined, restored after reloading a saved state -and created in all threads that are created after the -registration. Finally, global variables can be initialized using the -exception hook called exception/3. The latter technique is used -by CHR. + Global variables may be initialized from directives to make them + available during the program lifetime, but some considerations are + necessary for saved-states and threads. Saved-states to not store + global variables, which implies they have to be declared with + initialization/1 to recreate them after loading the saved + state. Each thread has its own set of global variables, starting with + an empty set. Using `thread_initialization/1` to define a global + variable it will be defined, restored after reloading a saved state + and created in all threads that are created after the + registration. Finally, global variables can be initialized using the + exception hook called exception/3. The latter technique is used + by CHR. -SWI-Prolog global variables are associations between names (atoms) and -terms. They differ in various ways from storing information using -assert/1 or recorda/3. + SWI-Prolog global variables are associations between names (atoms) and + terms. They differ in various ways from storing information using + assert/1 or recorda/3. -+ The value lives on the Prolog (global) stack. This implies -that lookup time is independent from the size of the term. -This is particulary interesting for large data structures -such as parsed XML documents or the CHR global constraint -store. + + The value lives on the Prolog (global) stack. This implies + that lookup time is independent from the size of the term. + This is particulary interesting for large data structures + such as parsed XML documents or the CHR global constraint + store. -They support both global assignment using nb_setval/2 and -backtrackable assignment using b_setval/2. + They support both global assignment using nb_setval/2 and + backtrackable assignment using b_setval/2. -+ Only one value (which can be an arbitrary complex Prolog -term) can be associated to a variable at a time. + + Only one value (which can be an arbitrary complex Prolog + term) can be associated to a variable at a time. -+ Their value cannot be shared among threads. Each thread -has its own namespace and values for global variables. + + Their value cannot be shared among threads. Each thread + has its own namespace and values for global variables. -+ Currently global variables are scoped globally. We may -consider module scoping in future versions. + + Currently global variables are scoped globally. We may + consider module scoping in future versions. -Both b_setval/2 and nb_setval/2 implicitly create a variable if the -referenced name does not already refer to a variable. + Both b_setval/2 and nb_setval/2 implicitly create a variable if the + referenced name does not already refer to a variable. -Global variables may be initialized from directives to make them -available during the program lifetime, but some considerations are -necessary for saved-states and threads. Saved-states to not store global -variables, which implies they have to be declared with initialization/1 -to recreate them after loading the saved state. Each thread has -its own set of global variables, starting with an empty set. Using -`thread_inititialization/1` to define a global variable it will be -defined, restored after reloading a saved state and created in all -threads that are created after the registration. + Global variables may be initialized from directives to make them + available during the program lifetime, but some considerations are + necessary for saved-states and threads. Saved-states to not store global + variables, which implies they have to be declared with initialization/1 + to recreate them after loading the saved state. Each thread has + its own set of global variables, starting with an empty set. Using + `thread_inititialization/1` to define a global variable it will be + defined, restored after reloading a saved state and created in all + threads that are created after the registration. */ @@ -123,7 +123,7 @@ threads that are created after the registration. special term on the heap. Arenas automatically contract as we add terms to the front. - */ +*/ #define QUEUE_FUNCTOR_ARITY 4 @@ -148,12 +148,12 @@ threads that are created after the registration. static size_t big2arena_sz(CELL *arena_base) { return (((MP_INT *)(arena_base + 2))->_mp_alloc * sizeof(mp_limb_t) + sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / - sizeof(CELL); + sizeof(CELL); } static size_t arena2big_sz(size_t sz) { return sz - - (sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL); + (sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL); } /* pointer to top of an arena */ @@ -191,24 +191,24 @@ static Term NewArena(size_t size, int wid, UInt arity, CELL *where) { size_t new_size; WORKER_REGS(wid) - if (where == NULL || where == HR) { - while (HR + size > ASP - 1024) { - if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); - return TermNil; + if (where == NULL || where == HR) { + while (HR + size > ASP - 1024) { + if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); + return TermNil; + } } + t = CreateNewArena(HR, size); + HR += size; + } else { + if ((new_size = Yap_InsertInGlobal(where, size * sizeof(CELL))) == 0) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, + "No Stack Space for Non-Backtrackable terms"); + return TermNil; + } + size = new_size / sizeof(CELL); + t = CreateNewArena(where, size); } - t = CreateNewArena(HR, size); - HR += size; - } else { - if ((new_size = Yap_InsertInGlobal(where, size * sizeof(CELL))) == 0) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, - "No Stack Space for Non-Backtrackable terms"); - return TermNil; - } - size = new_size / sizeof(CELL); - t = CreateNewArena(where, size); - } return t; } @@ -292,30 +292,30 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size, CELL *Yap_GetFromArena(Term *arenap, size_t cells, UInt arity) { CACHE_REGS -restart : { - Term arena = *arenap; - CELL *max = ArenaLimit(arena); - CELL *base = ArenaPt(arena); - CELL *newH; - size_t old_sz = ArenaSz(arena), new_size; + restart : { + Term arena = *arenap; + CELL *max = ArenaLimit(arena); + CELL *base = ArenaPt(arena); + CELL *newH; + size_t old_sz = ArenaSz(arena), new_size; - if (IN_BETWEEN(base, HR, max)) { - base = HR; - HR += cells; + if (IN_BETWEEN(base, HR, max)) { + base = HR; + HR += cells; + return base; + } + if (base + cells > max - 1024) { + if (!GrowArena(arena, max, old_sz, old_sz + sizeof(CELL) * 1024, + arity PASS_REGS)) + return NULL; + goto restart; + } + + newH = base + cells; + new_size = old_sz - cells; + *arenap = CreateNewArena(newH, new_size); return base; } - if (base + cells > max - 1024) { - if (!GrowArena(arena, max, old_sz, old_sz + sizeof(CELL) * 1024, - arity PASS_REGS)) - return NULL; - goto restart; - } - - newH = base + cells; - new_size = old_sz - cells; - *arenap = CreateNewArena(newH, new_size); - return base; -} } static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, @@ -340,6 +340,7 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { if (IsVarTerm(p)) { RESET_VARIABLE(p); } else { + /* copy downwards */ TrailTerm(TR0 + 1) = TrailTerm(pt); TrailTerm(TR0) = TrailTerm(TR0 + 2) = p; @@ -351,17 +352,18 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { } } -#define expand_stack(S0,SP,SF,TYPE) \ - { size_t sz = SF-S0, used = SP-S0; \ - S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ - SP = S0+used; SF = S0+sz; } +#define expand_stack(S0,SP,SF,TYPE) \ + { size_t sz = SF-S0, used = SP-S0; \ + S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ + SP = S0+used; SF = S0+sz; } static int copy_complex_term(register CELL *pt0, register CELL *pt0_end, bool share, bool copy_att_vars, CELL *ptf, CELL *HLow USES_REGS) { int lvl = push_text_stack(); - struct cp_frame *to_visit0, *to_visit = Malloc(1024*sizeof(struct cp_frame)); + struct cp_frame *to_visit0, + *to_visit = Malloc(1024*sizeof(struct cp_frame)); struct cp_frame *to_visit_max; CELL *HB0 = HB; @@ -371,186 +373,159 @@ static int copy_complex_term(register CELL *pt0, register CELL *pt0_end, HB = HLow; to_visit0 = to_visit; to_visit_max = to_visit+1024; -loop: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++pt0; - ptd0 = pt0; - d0 = *ptd0; + + ptd0 = ++pt0; + d0 = *pt0; + if (d0 != TermNil) + Yap_DebugPlWriteln(d0); + deref: deref_head(d0, copy_term_unk); copy_term_nvar : { - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - *ptf = AbsPair(HR); - ptf++; -#ifdef RATIONAL_TREES - if (to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsPair(HR); - to_visit++; -#else - if (pt0 < pt0_end) { - if (to_visit + 32 >= to_visit_max - 32) { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + if (//(share && ap2 < HB) || + (ap2 >= HB && ap2 < HR)) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + if (to_visit >= to_visit_max-32) { expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + pt0 = ap2; + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end = pt0+2; + to_visit->to = ptf; + d0 = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + MaBind(pt0,AbsPair(HR)); + to_visit++; + ground = true; + HR += 2; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + ptd0 = pt0; + goto deref; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if (//(share && ap2 < HB) || + (ap2 >= HB && ap2 < HR)) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + f = (Functor)(*ap2); - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit++; - } -#endif - ground = TRUE; - pt0 = ap2 - 1; - pt0_end = ap2 + 1; - ptf = HR; - HR += 2; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - switch ((CELL)f) { - case (CELL) FunctorDBRef: - case (CELL) FunctorAttVar: - *ptf++ = d0; - break; - case (CELL) FunctorLongInt: - if (HR > ASP - (MIN_ARENA_SIZE + 3)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = ap2[1]; - HR[2] = EndSpecials; - HR += 3; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - break; - case (CELL) FunctorDouble: - if (HR > - ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = ap2[1]; + if (IsExtensionFunctor(f)) { + switch ((CELL)f) { + case (CELL) FunctorDBRef: + case (CELL) FunctorAttVar: + *ptf++ = d0; + break; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = ap2[1]; + HR[2] = EndSpecials; + HR += 3; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + break; + case (CELL) FunctorDouble: + if (HR > + ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = ap2[1]; #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - HR[2] = ap2[2]; - HR[3] = EndSpecials; - HR += 4; + HR[2] = ap2[2]; + HR[3] = EndSpecials; + HR += 4; #else - HR[2] = EndSpecials; - HR += 3; + HR[2] = EndSpecials; + HR += 3; #endif - break; - case (CELL) FunctorString: - if (ASP - HR < MIN_ARENA_SIZE + 3 + ap2[1]) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - memmove(HR, ap2, sizeof(CELL) * (3 + ap2[1])); - HR += ap2[1] + 3; - break; - default: { - /* big int */ - size_t sz = (sizeof(MP_INT) + 3 * CellSize + - ((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) / - CellSize, - i; + break; + case (CELL) FunctorString: + if (ASP - HR < MIN_ARENA_SIZE + 3 + ap2[1]) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + memmove(HR, ap2, sizeof(CELL) * (3 + ap2[1])); + HR += ap2[1] + 3; + break; + default: { + /* big int */ + size_t sz = (sizeof(MP_INT) + 3 * CellSize + + ((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) / + CellSize, + i; - if (HR > ASP - (MIN_ARENA_SIZE + sz)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - for (i = 1; i < sz; i++) { - HR[i] = ap2[i]; - } - HR += sz; + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + for (i = 1; i < sz; i++) { + HR[i] = ap2[i]; + } + HR += sz; + } + } + continue; } - } - continue; + /* store the terms to visit */ + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + if (++to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + /* fool the system into thinking we had a variable there */ + ptf = HR; + *ptf++ = d0 = *ap2; + MaBind(ap2++,AbsAppl(HR)); + to_visit++; + ground = true; + arity_t a = ArityOfFunctor((Functor)d0); + HR = ptf+a; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + pt0 = ap2; + pt0_end = ap2+a; + ground = (f != FunctorMutable); + } else { + /* just copy atoms or integers */ + *ptf++ = d0; } - *ptf = AbsAppl(HR); - ptf++; -/* store the terms to visit */ -#ifdef RATIONAL_TREES - if (to_visit + 32 >= to_visit_max) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsAppl(HR); - to_visit++; -#else - if (pt0 < pt0_end) { - if (to_visit++ >= (CELL **)AuxSp) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit++; - } -#endif - ground = (f != FunctorMutable); - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - HR[0] = (CELL)f; - ptf = HR + 1; - HR += 1 + d0; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - } else { - /* just copy atoms or integers */ - *ptf++ = d0; + continue; } - continue; - } derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = FALSE; + ground = false; /* don't need to copy variables if we want to share the global term */ - if ((share && ptd0 < HB && ptd0 > H0) || (ptd0 >= HLow && ptd0 < HR)) { + if (//(share && ptd0 < HB && ptd0 > H0) || + (ptd0 >= HLow && ptd0 < HR)) { /* we have already found this cell */ *ptf++ = (CELL)ptd0; } else { -#if COROUTINING if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { /* if unbound, call the standard copy term routine */ struct cp_frame *bp; @@ -572,16 +547,13 @@ loop: Bind_and_Trail(ptd0, new); ptf++; } else { -#endif /* first time we met this term */ RESET_VARIABLE(ptf); if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) goto trail_overflow; - Bind_and_Trail(ptd0, (CELL)ptf); + MaBind(ptd0, (CELL)ptf); ptf++; -#ifdef COROUTINING } -#endif } } @@ -591,9 +563,6 @@ loop: pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; -#ifdef RATIONAL_TREES - *pt0 = to_visit->oldv; -#endif ground = (ground && to_visit->ground); goto loop; } @@ -602,16 +571,15 @@ loop: HB = HB0; clean_dirty_tr(TR0 PASS_REGS); /* follow chain of multi-assigned variables */ - pop_text_stack(lvl); + pop_text_stack(lvl); return 0; -overflow: + overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit--; pt0 = to_visit->start_cp; @@ -619,18 +587,16 @@ overflow: ptf = to_visit->to; *pt0 = to_visit->oldv; } -#endif reset_trail(TR0); - pop_text_stack(lvl); + pop_text_stack(lvl); return -1; -trail_overflow: + trail_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit--; pt0 = to_visit->start_cp; @@ -638,9 +604,8 @@ trail_overflow: ptf = to_visit->to; *pt0 = to_visit->oldv; } -#endif reset_trail(TR0); - pop_text_stack(lvl); + pop_text_stack(lvl); return -4; } @@ -654,7 +619,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, int res = 0; Term tn; -restart: + restart: t = Deref(t); if (IsVarTerm(t)) { ASP = ArenaLimit(arena); @@ -787,7 +752,7 @@ restart: CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); return tf; } -error_handler: + error_handler: HR = HB; CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); XREGS[arity + 1] = t; @@ -835,7 +800,7 @@ static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Functor f = Yap_MkFunctor(Na, Nar); UInt i; -restart: + restart: HR = HB = ArenaPt(arena); ASP = ArenaLimit(arena); HB0 = HR; @@ -984,8 +949,8 @@ static Int p_nb_setarg(USES_REGS1) { to = Deref(ARG3); to = CopyTermToArena( - ARG3, LOCAL_GlobalArena, FALSE, TRUE, 3, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG3, LOCAL_GlobalArena, FALSE, TRUE, 3, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; @@ -1028,8 +993,8 @@ static Int p_nb_set_shared_arg(USES_REGS1) { if (pos < 1 || pos > arity) return FALSE; to = CopyTermToArena( - ARG3, LOCAL_GlobalArena, TRUE, TRUE, 3, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG3, LOCAL_GlobalArena, TRUE, TRUE, 3, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; if (IsPairTerm(dest)) { @@ -1110,8 +1075,8 @@ static Int p_nb_create_accumulator(USES_REGS1) { return FALSE; } to = CopyTermToArena( - t, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + t, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; t2 = Deref(ARG2); @@ -1164,9 +1129,9 @@ static Int p_nb_add_to_accumulator(USES_REGS1) { } else { /* we need to create a new long int */ new = CopyTermToArena( - new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) - PASS_REGS); + new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) + PASS_REGS); destp = RepAppl(Deref(ARG1)); destp[1] = new; } @@ -1194,8 +1159,8 @@ static Int p_nb_add_to_accumulator(USES_REGS1) { new = Yap_Eval(new); new = CopyTermToArena( - new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); destp = RepAppl(Deref(ARG1)); destp[1] = new; @@ -1225,12 +1190,12 @@ static Int p_nb_accumulator_value(USES_REGS1) { Term Yap_SetGlobalVal(Atom at, Term t0) { CACHE_REGS - Term to; + Term to; GlobalEntry *ge; ge = GetGlobalEntry(at PASS_REGS); to = CopyTermToArena( - t0, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + t0, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return to; WRITE_LOCK(ge->GRWLock); @@ -1241,10 +1206,10 @@ Term Yap_SetGlobalVal(Atom at, Term t0) { Term Yap_SaveTerm(Term t0) { CACHE_REGS - Term to; + Term to; to = CopyTermToArena( Deref(t0), LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return to; return to; @@ -1274,8 +1239,8 @@ static Int p_nb_set_shared_val(USES_REGS1) { } ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS); to = CopyTermToArena( - ARG2, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG2, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; WRITE_LOCK(ge->GRWLock); @@ -1359,7 +1324,7 @@ static Int p_nb_getval(USES_REGS1) { Term Yap_GetGlobal(Atom at) { CACHE_REGS - GlobalEntry *ge; + GlobalEntry *ge; Term to; ge = FindGlobalEntry(at PASS_REGS); @@ -1417,7 +1382,7 @@ static Int nbdelete(Atom at USES_REGS) { Int Yap_DeleteGlobal(Atom at) { CACHE_REGS - return nbdelete(at PASS_REGS); + return nbdelete(at PASS_REGS); } @@ -1552,7 +1517,7 @@ static Int nb_queue(UInt arena_sz USES_REGS) { return (FunctorOfTerm(t) == FunctorNBQueue); } ar[QUEUE_ARENA] = ar[QUEUE_HEAD] = ar[QUEUE_TAIL] = ar[QUEUE_SIZE] = - MkIntTerm(0); + MkIntTerm(0); queue = Yap_MkApplTerm(FunctorNBQueue, QUEUE_FUNCTOR_ARITY, ar); if (!Yap_unify(queue, ARG1)) return FALSE; @@ -1860,8 +1825,8 @@ static Int p_nb_heap(USES_REGS1) { } while ((heap = MkZeroApplTerm( - Yap_MkFunctor(AtomHeap, 2 * hsize + HEAP_START + 1), - 2 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { + Yap_MkFunctor(AtomHeap, 2 * hsize + HEAP_START + 1), + 2 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { if (!Yap_gcl((2 * hsize + HEAP_START + 1) * sizeof(CELL), 2, ENV, P)) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return FALSE; @@ -1959,7 +1924,7 @@ static Int p_nb_heap_add_to_heap(USES_REGS1) { if (!qd) return FALSE; -restart: + restart: hsize = IntegerOfTerm(qd[HEAP_SIZE]); hmsize = IntegerOfTerm(qd[HEAP_MAX]); if (hsize == hmsize) { @@ -2127,8 +2092,8 @@ static Int p_nb_beam(USES_REGS1) { hsize = IntegerOfTerm(tsize); } while ((beam = MkZeroApplTerm( - Yap_MkFunctor(AtomHeap, 5 * hsize + HEAP_START + 1), - 5 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { + Yap_MkFunctor(AtomHeap, 5 * hsize + HEAP_START + 1), + 5 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { if (!Yap_gcl((4 * hsize + HEAP_START + 1) * sizeof(CELL), 2, ENV, P)) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return FALSE; @@ -2159,7 +2124,7 @@ static Int p_nb_beam_close(USES_REGS1) { return p_nb_heap_close(PASS_REGS1); } */ static void PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to) { CACHE_REGS - UInt off = hsize, off2 = hsize; + UInt off = hsize, off2 = hsize; Term toff, toff2; /* push into first queue */ @@ -2203,7 +2168,7 @@ static void PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to) { static void DelBeamMax(CELL *pt, CELL *pt2, UInt sz) { CACHE_REGS - UInt off = IntegerOfTerm(pt2[1]); + UInt off = IntegerOfTerm(pt2[1]); UInt indx = 0; Term tk, ti, tv; @@ -2277,7 +2242,7 @@ static void DelBeamMax(CELL *pt, CELL *pt2, UInt sz) { static Term DelBeamMin(CELL *pt, CELL *pt2, UInt sz) { CACHE_REGS - UInt off2 = IntegerOfTerm(pt[1]); + UInt off2 = IntegerOfTerm(pt[1]); Term ov = pt2[3 * off2 + 2]; /* return value */ UInt indx = 0; Term tk, tv; @@ -2497,7 +2462,7 @@ static Int p_nb_beam_keys(USES_REGS1) { CELL *pt, *ho; UInt i; -restart: + restart: qd = GetHeap(ARG1, "beam_keys"); if (!qd) return FALSE; @@ -2598,7 +2563,7 @@ static Int init_current_nb(USES_REGS1) { /* current_atom(?Atom) */ void Yap_InitGlobals(void) { CACHE_REGS - Term cm = CurrentModule; + Term cm = CurrentModule; Yap_InitCPred("$allocate_arena", 2, p_allocate_arena, 0); Yap_InitCPred("arena_size", 1, p_default_arena_size, 0); Yap_InitCPred("b_setval", 2, p_b_setval, SafePredFlag); @@ -2606,22 +2571,22 @@ void Yap_InitGlobals(void) { /** @pred b_setval(+ _Name_, + _Value_) - Associate the term _Value_ with the atom _Name_ or replaces - the currently associated value with _Value_. If _Name_ does - not refer to an existing global variable a variable with initial value - [] is created (the empty list). On backtracking the assignment is - reversed. + Associate the term _Value_ with the atom _Name_ or replaces + the currently associated value with _Value_. If _Name_ does + not refer to an existing global variable a variable with initial value + [] is created (the empty list). On backtracking the assignment is + reversed. */ /** @pred b_setval(+ _Name_,+ _Value_) - Associate the term _Value_ with the atom _Name_ or replaces - the currently associated value with _Value_. If _Name_ does - not refer to an existing global variable a variable with initial value - `[]` is created (the empty list). On backtracking the - assignment is reversed. + Associate the term _Value_ with the atom _Name_ or replaces + the currently associated value with _Value_. If _Name_ does + not refer to an existing global variable a variable with initial value + `[]` is created (the empty list). On backtracking the + assignment is reversed. */ @@ -2630,18 +2595,18 @@ void Yap_InitGlobals(void) { /** @pred nb_setval(+ _Name_, + _Value_) - Associates a copy of _Value_ created with duplicate_term/2 with - the atom _Name_. Note that this can be used to set an initial - value other than `[]` prior to backtrackable assignment. + Associates a copy of _Value_ created with duplicate_term/2 with + the atom _Name_. Note that this can be used to set an initial + value other than `[]` prior to backtrackable assignment. */ /** @pred nb_setval(+ _Name_,+ _Value_) - Associates a copy of _Value_ created with duplicate_term/2 - with the atom _Name_. Note that this can be used to set an - initial value other than `[]` prior to backtrackable assignment. + Associates a copy of _Value_ created with duplicate_term/2 + with the atom _Name_. Note that this can be used to set an + initial value other than `[]` prior to backtrackable assignment. */ @@ -2649,25 +2614,25 @@ void Yap_InitGlobals(void) { /** @pred nb_set_shared_val(+ _Name_, + _Value_) - Associates the term _Value_ with the atom _Name_, but sharing - non-backtrackable terms. This may be useful if you want to rewrite a - global variable so that the new copy will survive backtracking, but - you want to share structure with the previous term. + Associates the term _Value_ with the atom _Name_, but sharing + non-backtrackable terms. This may be useful if you want to rewrite a + global variable so that the new copy will survive backtracking, but + you want to share structure with the previous term. - The next example shows the differences between the three built-ins: + The next example shows the differences between the three built-ins: - ~~~~~ - ?- nb_setval(a,a(_)),nb_getval(a,A),nb_setval(b,t(C,A)),nb_getval(b,B). - A = a(_A), - B = t(_B,a(_C)) ? + ~~~~~ + ?- nb_setval(a,a(_)),nb_getval(a,A),nb_setval(b,t(C,A)),nb_getval(b,B). + A = a(_A), + B = t(_B,a(_C)) ? - ?- - nb_setval(a,a(_)),nb_getval(a,A),nb_set_shared_val(b,t(C,A)),nb_getval(b,B). + ?- + nb_setval(a,a(_)),nb_getval(a,A),nb_set_shared_val(b,t(C,A)),nb_getval(b,B). - ?- nb_setval(a,a(_)),nb_getval(a,A),nb_linkval(b,t(C,A)),nb_getval(b,B). - A = a(_A), - B = t(C,a(_A)) ? - ~~~~~ + ?- nb_setval(a,a(_)),nb_getval(a,A),nb_linkval(b,t(C,A)),nb_getval(b,B). + A = a(_A), + B = t(C,a(_A)) ? + ~~~~~ */ @@ -2675,26 +2640,26 @@ void Yap_InitGlobals(void) { /** @pred nb_linkval(+ _Name_, + _Value_) - Associates the term _Value_ with the atom _Name_ without - copying it. This is a fast special-purpose variation of nb_setval/2 - intended for expert users only because the semantics on backtracking - to a point before creating the link are poorly defined for compound - terms. The principal term is always left untouched, but backtracking - behaviour on arguments is undone if the original assignment was - trailed and left alone otherwise, which implies that the history that - created the term affects the behaviour on backtracking. Please - consider the following example: + Associates the term _Value_ with the atom _Name_ without + copying it. This is a fast special-purpose variation of nb_setval/2 + intended for expert users only because the semantics on backtracking + to a point before creating the link are poorly defined for compound + terms. The principal term is always left untouched, but backtracking + behaviour on arguments is undone if the original assignment was + trailed and left alone otherwise, which implies that the history that + created the term affects the behaviour on backtracking. Please + consider the following example: - ~~~~~ - demo_nb_linkval :- - T = nice(N), - ( N = world, - nb_linkval(myvar, T), - fail - ; nb_getval(myvar, V), - writeln(V) - ). - ~~~~~ + ~~~~~ + demo_nb_linkval :- + T = nice(N), + ( N = world, + nb_linkval(myvar, T), + fail + ; nb_getval(myvar, V), + writeln(V) + ). + ~~~~~ */ @@ -2706,31 +2671,31 @@ void Yap_InitGlobals(void) { - Assigns the _Arg_-th argument of the compound term _Term_ with - the given _Value_ as setarg/3, but on backtracking the assignment - is not reversed. If _Term_ is not atomic, it is duplicated using - duplicate_term/2. This predicate uses the same technique as - nb_setval/2. We therefore refer to the description of - nb_setval/2 for details on non-backtrackable assignment of - terms. This predicate is compatible to GNU-Prolog - `setarg(A,T,V,false)`, removing the type-restriction on - _Value_. See also nb_linkarg/3. Below is an example for - counting the number of solutions of a goal. Note that this - implementation is thread-safe, reentrant and capable of handling - exceptions. Realising these features with a traditional implementation - based on assert/retract or flag/3 is much more complicated. + Assigns the _Arg_-th argument of the compound term _Term_ with + the given _Value_ as setarg/3, but on backtracking the assignment + is not reversed. If _Term_ is not atomic, it is duplicated using + duplicate_term/2. This predicate uses the same technique as + nb_setval/2. We therefore refer to the description of + nb_setval/2 for details on non-backtrackable assignment of + terms. This predicate is compatible to GNU-Prolog + `setarg(A,T,V,false)`, removing the type-restriction on + _Value_. See also nb_linkarg/3. Below is an example for + counting the number of solutions of a goal. Note that this + implementation is thread-safe, reentrant and capable of handling + exceptions. Realising these features with a traditional implementation + based on assert/retract or flag/3 is much more complicated. - ~~~~~ + ~~~~~ succeeds_n_times(Goal, Times) :- - Counter = counter(0), - ( Goal, - arg(1, Counter, N0), - N is N0 + 1, - nb_setarg(1, Counter, N), - fail - ; arg(1, Counter, Times) - ). - ~~~~~ + Counter = counter(0), + ( Goal, + arg(1, Counter, N0), + N is N0 + 1, + nb_setarg(1, Counter, N), + fail + ; arg(1, Counter, Times) + ). + ~~~~~ */ @@ -2739,9 +2704,9 @@ void Yap_InitGlobals(void) { - As nb_setarg/3, but like nb_linkval/2 it does not - duplicate the global sub-terms in _Value_. Use with extreme care - and consult the documentation of nb_linkval/2 before use. + As nb_setarg/3, but like nb_linkval/2 it does not + duplicate the global sub-terms in _Value_. Use with extreme care + and consult the documentation of nb_linkval/2 before use. */ @@ -2750,9 +2715,9 @@ void Yap_InitGlobals(void) { - As nb_setarg/3, but like nb_linkval/2 it does not - duplicate _Value_. Use with extreme care and consult the - documentation of nb_linkval/2 before use. + As nb_setarg/3, but like nb_linkval/2 it does not + duplicate _Value_. Use with extreme care and consult the + documentation of nb_linkval/2 before use. */ @@ -2760,20 +2725,20 @@ void Yap_InitGlobals(void) { /** @pred nb_delete(+ _Name_) - Delete the named global variable. + Delete the named global variable. - Global variables have been introduced by various Prolog - implementations recently. We follow the implementation of them in - SWI-Prolog, itself based on hProlog by Bart Demoen. + Global variables have been introduced by various Prolog + implementations recently. We follow the implementation of them in + SWI-Prolog, itself based on hProlog by Bart Demoen. - GNU-Prolog provides a rich set of global variables, including - arrays. Arrays can be implemented easily in YAP and SWI-Prolog using - functor/3 and `setarg/3` due to the unrestricted arity of - compound terms. + GNU-Prolog provides a rich set of global variables, including + arrays. Arrays can be implemented easily in YAP and SWI-Prolog using + functor/3 and `setarg/3` due to the unrestricted arity of + compound terms. - @} */ + @} */ Yap_InitCPred("nb_create", 3, p_nb_create, 0L); Yap_InitCPred("nb_create", 4, p_nb_create2, 0L); Yap_InitCPredBack("$nb_current", 1, 1, init_current_nb, cont_current_nb, @@ -2817,5 +2782,5 @@ void Yap_InitGlobals(void) { } /** -@} + @} */ diff --git a/C/modules.c b/C/modules.c index 798e05cb5..465025b20 100644 --- a/C/modules.c +++ b/C/modules.c @@ -24,7 +24,7 @@ static char SccsId[] = "%W% %G%"; #include "YapHeap.h" #include "Yatom.h" -static Int currgent_module(USES_REGS1); +static Int current_module(USES_REGS1); static Int current_module1(USES_REGS1); static ModEntry *LookupModule(Term a); static ModEntry *LookupSystemModule(Term a); diff --git a/C/utilpreds.c b/C/utilpreds.c index 2a60761b5..dd0d3b839 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -52,6 +52,7 @@ typedef struct non_single_struct_t { }\ LIST0;\ ptd0 = RepPair(d0);\ + if (*ptd0 == TermFreeTerm) continue;\ to_visit->pt0 = pt0;\ to_visit->pt0_end = pt0_end;\ to_visit->ptd0 = ptd0;\ @@ -59,7 +60,7 @@ typedef struct non_single_struct_t { to_visit ++;\ d0 = ptd0[0];\ pt0 = ptd0;\ - *ptd0 = TermNil;\ + *ptd0 = TermFreeTerm;\ pt0_end = pt0 + 1;\ goto list_loop;\ } else if (IsApplTerm(d0)) {\ @@ -2269,9 +2270,8 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), *to_visit0 = to_visit, *to_visit_max = to_visit+1024; + Term o = TermNil; CELL *InitialH = HR; - *HR++ = MkAtomTerm(AtomDollar); - to_visit0 = to_visit; restart: while (pt0 < pt0_end) { @@ -2284,7 +2284,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - WALK_COMPLEX_TERM() + WALK_COMPLEX_TERM(); continue; } @@ -2293,10 +2293,13 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end *ptd0 = TermNil; /* leave an empty slot to fill in later */ if (HR+1024 > ASP) { + o = TermNil; goto global_overflow; } HR[0] = (CELL)ptd0; - HR ++; + HR[1] = o; + o = AbsPair(HR); + HR += 2; /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ @@ -2318,13 +2321,8 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end } clean_tr(TR0 PASS_REGS); -pop_text_stack(lvl); - if (HR > InitialH+1) { - InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1); - return AbsAppl(InitialH); - } else { - return MkAtomTerm(AtomDollar); - } + pop_text_stack(lvl); + return o; def_trail_overflow(); diff --git a/packages/clpqr/clpq/itf_q.pl b/packages/clpqr/clpq/itf_q.pl index 7add42fa7..0b6020e40 100644 --- a/packages/clpqr/clpq/itf_q.pl +++ b/packages/clpqr/clpq/itf_q.pl @@ -62,7 +62,7 @@ [ class_drop/2 ]). - + do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :- numbers_only(Y), verify_nonzero(No,Y), @@ -76,7 +76,7 @@ numbers_only(Y) :- ; throw(type_error(_X = Y,2,'a rational number',Y)) ), !. - +ø % verify_nonzero(Nonzero,Y) % % if Nonzero = nonzero, then verify that Y is not zero diff --git a/packages/clpqr/clpqr/geler.pl b/packages/clpqr/clpqr/geler.pl index b3fd410bf..e04c3ce60 100644 --- a/packages/clpqr/clpqr/geler.pl +++ b/packages/clpqr/clpqr/geler.pl @@ -43,6 +43,10 @@ project_nonlin/3, collect_nonlin/3 ]). +:- use_module(library(maplist), + [ + maplist/2 + ]). % l2conj(List,Conj) % diff --git a/packages/clpqr/clpqr/itf.pl b/packages/clpqr/clpqr/itf.pl index 427d13ea0..43907c049 100644 --- a/packages/clpqr/clpqr/itf.pl +++ b/packages/clpqr/clpqr/itf.pl @@ -47,6 +47,10 @@ dump_nonzero/3, clp_type/2 ]). +:- use_module(library(maplist), + [ + maplist/2 + ]). clp_type(Var,Type) :- diff --git a/packages/clpqr/clpr/itf_r.pl b/packages/clpqr/clpr/itf_r.pl index 753e2037b..ec1754311 100644 --- a/packages/clpqr/clpr/itf_r.pl +++ b/packages/clpqr/clpr/itf_r.pl @@ -63,6 +63,10 @@ [ class_drop/2 ]). +:- use_module(library(maplist), + [ + maplist/2 + ]). do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :- numbers_only(Y), From c682058942027e120688c023b178d821c9d59bec Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 22 Jan 2019 03:08:26 +0000 Subject: [PATCH 006/101] xmas --- C/stack.c | 2 +- C/yap-args.c | 4 ++-- packages/jpl/src/c/jpl.c | 2 +- packages/python/pypreds.c | 11 +++++++++++ pl/android.yap | 6 ++---- pl/undefined.yap | 3 +-- 6 files changed, 18 insertions(+), 10 deletions(-) diff --git a/C/stack.c b/C/stack.c index 4c67b57e4..618aedf02 100644 --- a/C/stack.c +++ b/C/stack.c @@ -2134,7 +2134,7 @@ static void shortstack( choiceptr b_ptr, CELL * env_ptr , buf_struct_t *bufp) { void DumpActiveGoals(USES_REGS1) { /* try to dump active goals */ void *ep = YENV; /* and current environment */ - void *cp; + void *cp ; PredEntry *pe; struct buf_struct_t buf0, *bufp = &buf0; diff --git a/C/yap-args.c b/C/yap-args.c index f03161571..ccd7083fe 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -175,7 +175,7 @@ static bool load_file(const char *b_file USES_REGS) { __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "done init_consult %s ",b_file); if (c_stream < 0) { - fprintf(stderr, "[ FATAL ERROR: could not open file %s ]\n", b_file); + fprintf(stderr, "[ FATAL ERROR: could not open file %s\n", b_file); pop_text_stack(lvl); exit(1); } @@ -185,7 +185,7 @@ static bool load_file(const char *b_file USES_REGS) { } __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file); - + t = 0; while (t != TermEof) { CACHE_REGS YAP_Reset(YAP_FULL_RESET, false); diff --git a/packages/jpl/src/c/jpl.c b/packages/jpl/src/c/jpl.c index ae7d24eb0..838f7bfbe 100755 --- a/packages/jpl/src/c/jpl.c +++ b/packages/jpl/src/c/jpl.c @@ -1826,7 +1826,7 @@ jni_create_jvm_c( JNIEnv *env; JPL_DEBUG(1, Sdprintf( "[creating JVM with 'java.class.path=%s']\n", classpath)); - vm_args.version = JNI_VERSION_1_6zzzz; /* "Java 1.2 please" */ + vm_args.version = JNI_VERSION_1_6; /* "Java 1.2 please" */ if ( classpath ) { cpoptp = (char *)malloc(strlen(classpath) + strlen("-Djava.class.path=")+1); diff --git a/packages/python/pypreds.c b/packages/python/pypreds.c index 9b357ea6a..c51fe48a7 100644 --- a/packages/python/pypreds.c +++ b/packages/python/pypreds.c @@ -1,4 +1,15 @@ + + + + + + + + + + + #include "Yap.h" #include "py4yap.h" diff --git a/pl/android.yap b/pl/android.yap index 488204c7c..6de2bfcfd 100644 --- a/pl/android.yap +++ b/pl/android.yap @@ -1,8 +1,6 @@ -%:- start_low_level_trace. - -%:- module(android, -% [text_to_query/2]). +:- module(android, + [text_to_query/2]). :- initialization(yap_flag(verbose,_,normal)). diff --git a/pl/undefined.yap b/pl/undefined.yap index 4d573335b..3113cbc3c 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -97,8 +97,7 @@ undefined_query(G0, M0, Cut) :- % undef handler '$undefp'([M0|G0],MG) :- - setup_call_cleanup( - % make sure we do not loop on undefined predicates +x % make sure we do not loop on undefined predicates '$undef_setup'(Action,Debug,Current), ('$get_undefined_predicates'(M0:G0, MG) -> From a6d709dabf1c8daf5ce70f302f7d03db0fe032b3 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 22 Jan 2019 19:32:19 +0000 Subject: [PATCH 007/101] copy_term --- C/globals.c | 263 +----------- C/utilpreds.c | 680 +++++++++++++++--------------- H/Yapproto.h | 3 + H/amiops.h | 6 + packages/jpl/src/c/CMakeLists.txt | 1 + pl/undefined.yap | 51 +-- 6 files changed, 372 insertions(+), 632 deletions(-) diff --git a/C/globals.c b/C/globals.c index 67e401e99..5a457f19f 100644 --- a/C/globals.c +++ b/C/globals.c @@ -352,263 +352,6 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { } } -#define expand_stack(S0,SP,SF,TYPE) \ - { size_t sz = SF-S0, used = SP-S0; \ - S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ - SP = S0+used; SF = S0+sz; } - -static int copy_complex_term(register CELL *pt0, register CELL *pt0_end, - bool share, bool copy_att_vars, CELL *ptf, - CELL *HLow USES_REGS) { - - int lvl = push_text_stack(); - struct cp_frame *to_visit0, - *to_visit = Malloc(1024*sizeof(struct cp_frame)); - struct cp_frame *to_visit_max; - - CELL *HB0 = HB; - tr_fr_ptr TR0 = TR; - int ground = TRUE; - - HB = HLow; - to_visit0 = to_visit; - to_visit_max = to_visit+1024; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - - ptd0 = ++pt0; - d0 = *pt0; - if (d0 != TermNil) - Yap_DebugPlWriteln(d0); - deref: - deref_head(d0, copy_term_unk); - copy_term_nvar : { - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if (//(share && ap2 < HB) || - (ap2 >= HB && ap2 < HR)) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - if (to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - pt0 = ap2; - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end = pt0+2; - to_visit->to = ptf; - d0 = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - MaBind(pt0,AbsPair(HR)); - to_visit++; - ground = true; - HR += 2; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - ptd0 = pt0; - goto deref; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - if (//(share && ap2 < HB) || - (ap2 >= HB && ap2 < HR)) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - switch ((CELL)f) { - case (CELL) FunctorDBRef: - case (CELL) FunctorAttVar: - *ptf++ = d0; - break; - case (CELL) FunctorLongInt: - if (HR > ASP - (MIN_ARENA_SIZE + 3)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = ap2[1]; - HR[2] = EndSpecials; - HR += 3; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - break; - case (CELL) FunctorDouble: - if (HR > - ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = ap2[1]; -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - HR[2] = ap2[2]; - HR[3] = EndSpecials; - HR += 4; -#else - HR[2] = EndSpecials; - HR += 3; -#endif - break; - case (CELL) FunctorString: - if (ASP - HR < MIN_ARENA_SIZE + 3 + ap2[1]) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - memmove(HR, ap2, sizeof(CELL) * (3 + ap2[1])); - HR += ap2[1] + 3; - break; - default: { - /* big int */ - size_t sz = (sizeof(MP_INT) + 3 * CellSize + - ((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) / - CellSize, - i; - - if (HR > ASP - (MIN_ARENA_SIZE + sz)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - for (i = 1; i < sz; i++) { - HR[i] = ap2[i]; - } - HR += sz; - } - } - continue; - } - /* store the terms to visit */ - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - if (++to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - /* fool the system into thinking we had a variable there */ - ptf = HR; - *ptf++ = d0 = *ap2; - MaBind(ap2++,AbsAppl(HR)); - to_visit++; - ground = true; - arity_t a = ArityOfFunctor((Functor)d0); - HR = ptf+a; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - pt0 = ap2; - pt0_end = ap2+a; - ground = (f != FunctorMutable); - } else { - /* just copy atoms or integers */ - *ptf++ = d0; - } - continue; - } - - derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = false; - /* don't need to copy variables if we want to share the global term */ - if (//(share && ptd0 < HB && ptd0 > H0) || - (ptd0 >= HLow && ptd0 < HR)) { - /* we have already found this cell */ - *ptf++ = (CELL)ptd0; - } else { - if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { - /* if unbound, call the standard copy term routine */ - struct cp_frame *bp; - CELL new; - - bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, - ptf PASS_REGS)) { - goto overflow; - } - to_visit = bp; - new = *ptf; - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - Bind_and_Trail(ptd0, new); - ptf++; - } else { - /* first time we met this term */ - RESET_VARIABLE(ptf); - if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) - goto trail_overflow; - MaBind(ptd0, (CELL)ptf); - ptf++; - } - } - } - - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - ground = (ground && to_visit->ground); - goto loop; - } - - /* restore our nice, friendly, term to its original state */ - HB = HB0; - clean_dirty_tr(TR0 PASS_REGS); - /* follow chain of multi-assigned variables */ - pop_text_stack(lvl); - return 0; - - overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - *pt0 = to_visit->oldv; - } - reset_trail(TR0); - pop_text_stack(lvl); - return -1; - - trail_overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - *pt0 = to_visit->oldv; - } - reset_trail(TR0); - pop_text_stack(lvl); - return -4; -} - static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, UInt arity, Term *newarena, size_t min_grow USES_REGS) { @@ -631,7 +374,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, *HR = t; Hi = HR + 1; HR += 2; - if ((res = copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi, + if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0) goto error_handler; CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); @@ -665,7 +408,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, Hi = HR; tf = AbsPair(HR); HR += 2; - if ((res = copy_complex_term(ap - 1, ap + 1, share, copy_att_vars, Hi, + if ((res = Yap_copy_complex_term(ap - 1, ap + 1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0) { goto error_handler; } @@ -743,7 +486,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, res = -1; goto error_handler; } - if ((res = copy_complex_term(ap, ap + ArityOfFunctor(f), share, + if ((res = Yap_copy_complex_term(ap, ap + ArityOfFunctor(f), share, copy_att_vars, HB0 + 1, HB0 PASS_REGS)) < 0) { goto error_handler; diff --git a/C/utilpreds.c b/C/utilpreds.c index dd0d3b839..0d66fcb09 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -45,92 +45,92 @@ typedef struct non_single_struct_t { CELL *pt0, *pt0_end; } non_singletons_t; -#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ - if (IsPairTerm(d0)) {\ - if (to_visit + 32 >= to_visit_max) {\ - goto aux_overflow;\ - }\ - LIST0;\ - ptd0 = RepPair(d0);\ - if (*ptd0 == TermFreeTerm) continue;\ - to_visit->pt0 = pt0;\ - to_visit->pt0_end = pt0_end;\ - to_visit->ptd0 = ptd0;\ - to_visit->d0 = *ptd0;\ - to_visit ++;\ - d0 = ptd0[0];\ - pt0 = ptd0;\ - *ptd0 = TermFreeTerm;\ - pt0_end = pt0 + 1;\ - goto list_loop;\ - } else if (IsApplTerm(d0)) {\ - register Functor f;\ - register CELL *ap2;\ - /* store the terms to visit */\ - ap2 = RepAppl(d0);\ - f = (Functor)(*ap2);\ -\ - if (IsExtensionFunctor(f)) {\ -\ - continue;\ - }\ - STRUCT0;\ - if (to_visit + 32 >= to_visit_max) {\ - goto aux_overflow;\ - }\ - to_visit->pt0 = pt0;\ - to_visit->pt0_end = pt0_end;\ - to_visit->ptd0 = ap2;\ - to_visit->d0 = *ap2;\ - to_visit ++;\ -\ - *ap2 = TermNil;\ - d0 = ArityOfFunctor(f);\ - pt0 = ap2;\ - pt0_end = ap2 + d0;\ - } +#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ + if (IsPairTerm(d0)) { \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + LIST0; \ + ptd0 = RepPair(d0); \ + if (*ptd0 == TermFreeTerm) continue; \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = *ptd0; \ + to_visit ++; \ + d0 = ptd0[0]; \ + pt0 = ptd0; \ + *ptd0 = TermFreeTerm; \ + pt0_end = pt0 + 1; \ + goto list_loop; \ + } else if (IsApplTerm(d0)) { \ + register Functor f; \ + register CELL *ap2; \ + /* store the terms to visit */ \ + ap2 = RepAppl(d0); \ + f = (Functor)(*ap2); \ + \ + if (IsExtensionFunctor(f)) { \ + \ + continue; \ + } \ + STRUCT0; \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ap2; \ + to_visit->d0 = *ap2; \ + to_visit ++; \ + \ + *ap2 = TermNil; \ + d0 = ArityOfFunctor(f); \ + pt0 = ap2; \ + pt0_end = ap2 + d0; \ + } #define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}) -#define def_trail_overflow() \ - trail_overflow:{ \ - while (to_visit > to_visit0) {\ - to_visit --;\ - CELL *ptd0 = to_visit->ptd0;\ - *ptd0 = to_visit->d0;\ - }\ - pop_text_stack(lvl);\ - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;\ - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);\ - clean_tr(TR0 PASS_REGS);\ - HR = InitialH;\ - return 0L;\ -} +#define def_trail_overflow() \ + trail_overflow:{ \ + while (to_visit > to_visit0) { \ + to_visit --; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + return 0L; \ + } -#define def_aux_overflow() \ - aux_overflow:{ \ - size_t d1 = to_visit-to_visit0;\ - size_t d2 = to_visit_max-to_visit0;\ -to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \ - to_visit = to_visit0+d1;\ -to_visit_max = to_visit0+(d2+128); \ - pt0--;\ - goto restart;\ - } +#define def_aux_overflow() \ + aux_overflow:{ \ + size_t d1 = to_visit-to_visit0; \ + size_t d2 = to_visit_max-to_visit0; \ + to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \ + to_visit = to_visit0+d1; \ + to_visit_max = to_visit0+(d2+128); \ + pt0--; \ + goto restart; \ + } -#define def_global_overflow() \ +#define def_global_overflow() \ global_overflow:{ \ - while (to_visit > to_visit0) { \ - to_visit --;\ - CELL *ptd0 = to_visit->ptd0;\ - *ptd0 = to_visit->d0;\ - }\ - pop_text_stack(lvl);\ - clean_tr(TR0 PASS_REGS);\ - HR = InitialH;\ - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;\ - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL);\ - return false; } + while (to_visit > to_visit0) { \ + to_visit --; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); \ + return false; } static Int p_non_singletons_in_term( USES_REGS1); @@ -140,7 +140,6 @@ static Int ground_complex_term(CELL *, CELL * CACHE_TYPE); static Int p_ground( USES_REGS1 ); static Int p_copy_term( USES_REGS1 ); static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); -static int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE); static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); #ifdef DEBUG @@ -159,145 +158,191 @@ clean_tr(tr_fr_ptr TR0 USES_REGS) { static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { - if (TR != TR0) { - tr_fr_ptr pt = TR0; - - do { - Term p = TrailTerm(pt++); + tr_fr_ptr pt0 = TR; + while (pt0 != TR0) { + Term p = TrailTerm(--pt0); + if (IsApplTerm(p)) { + CELL *pt = RepAppl(p); +#ifdef FROZEN_STACKS + pt[0] = TrailVal(pt0); +#else + pt[0] = TrailTerm(pt0 - 1); + pt0 --; +#endif /* FROZEN_STACKS */ + } else { RESET_VARIABLE(p); - } while (pt != TR); - TR = TR0; - } + } + } + TR = TR0; } -static int -copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS) -{ +#define expand_stack(S0,SP,SF,TYPE) \ + { size_t sz = SF-S0, used = SP-S0; \ + S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ + SP = S0+used; SF = S0+sz; } + +#define MIN_ARENA_SIZE (1048L) + +int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, + bool share, bool copy_att_vars, CELL *ptf, + CELL *HLow USES_REGS) { + // fprintf(stderr,"+++++++++\n"); + //CELL *x = pt0; while(x != pt0_end) Yap_DebugPlWriteln(*++ x); + + int lvl = push_text_stack(); + + struct cp_frame *to_visit0, + *to_visit = Malloc(1024*sizeof(struct cp_frame)); + struct cp_frame *to_visit_max; - struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace() ; CELL *HB0 = HB; tr_fr_ptr TR0 = TR; - int ground = TRUE; + int ground = true; - HB = HR; + HB = HLow; to_visit0 = to_visit; + to_visit_max = to_visit+1024; loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; - ptd0 = pt0; + + ptd0 = ++pt0; d0 = *ptd0; + deref: deref_head(d0, copy_term_unk); - copy_term_nvar: - { + copy_term_nvar : { if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if (ap2 >= HB && ap2 < HR) { + CELL *headp = RepPair(d0); + if (//(share && headp < HB) || + (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR)) { /* If this is newer than the current term, just reuse */ - *ptf++ = d0; + *ptf++ = *headp; continue; } + if (to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } *ptf = AbsPair(HR); ptf++; - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldv = *pt0; to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsPair(HR); - to_visit ++; - ground = true; - pt0 = ap2 - 1; - pt0_end = ap2 + 1; + to_visit++; + // move to new list + d0 = *headp; + TrailedMaBind(headp, AbsPair(HR)); + pt0 = headp; + pt0_end = headp + 1; ptf = HR; + ground = true; HR += 2; - if (HR > ASP - 2048) { + if (HR > ASP - MIN_ARENA_SIZE) { goto overflow; } + ptd0 = pt0; + goto deref; } else if (IsApplTerm(d0)) { register Functor f; - register CELL *ap2; + register CELL *headp; /* store the terms to visit */ - ap2 = RepAppl(d0); - if (ap2 >= HB && ap2 <= HR) { + headp = RepAppl(d0); + if (IsApplTerm(*headp)//(share && headp < HB) || + ) { /* If this is newer than the current term, just reuse */ - *ptf++ = d0; + *ptf++ = *headp; continue; } - f = (Functor)(*ap2); + f = (Functor)(*headp); if (IsExtensionFunctor(f)) { -#if MULTIPLE_STACKS - if (f == FunctorDBRef) { - DBRef entryref = DBRefOfTerm(d0); - if (entryref->Flags & LogUpdMask) { - LogUpdClause *luclause = (LogUpdClause *)entryref; - PELOCK(100,luclause->ClPred); - UNLOCK(luclause->ClPred->PELock); - } else { - LOCK(entryref->lock); - TRAIL_REF(entryref); /* So that fail will erase it */ - INC_DBREF_COUNT(entryref); - UNLOCK(entryref->lock); + switch ((CELL)f) { + case (CELL) FunctorDBRef: + case (CELL) FunctorAttVar: + *ptf++ = d0; + break; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { + goto overflow; } - *ptf++ = d0; /* you can just copy other extensions. */ - } else + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; + HR[2] = EndSpecials; + HR += 3; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + break; + case (CELL) FunctorDouble: + if (HR > + ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + HR[2] = headp[2]; + HR[3] = EndSpecials; + HR += 4; +#else + HR[2] = EndSpecials; + HR += 3; #endif - if (!share) { - UInt sz; - - *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */ - /* make sure to copy floats */ - if (f== FunctorDouble) { - sz = sizeof(Float)/sizeof(CELL)+2; - } else if (f== FunctorLongInt) { - sz = 3; - } else if (f== FunctorString) { - sz = 3+ap2[1]; - } else { - CELL *pt = ap2+1; - sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t)); - } - if (HR+sz > ASP - 2048) { - goto overflow; - } - memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); - HR += sz; - } else { - *ptf++ = d0; /* you can just copy other extensions. */ + break; + case (CELL) FunctorString: + if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) { + goto overflow; } + *ptf++ = AbsAppl(HR); + memmove(HR, headp, sizeof(CELL) * (3 + headp[1])); + HR += headp[1] + 3; + break; + default: { + /* big int */ + size_t sz = (sizeof(MP_INT) + 3 * CellSize + + ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / + CellSize, + i; + + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + for (i = 1; i < sz; i++) { + HR[i] = headp[i]; + + } + HR += sz; + } + } continue; - } - *ptf = AbsAppl(HR); + } + *ptf = AbsAppl(HR); ptf++; /* store the terms to visit */ - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldv = *pt0; to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsAppl(HR); - to_visit ++; - ground = (f != FunctorMutable); - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - HR[0] = (CELL)f; - ptf = HR+1; - HR += 1+d0; - if (HR > ASP - 2048) { + if (++to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + TrailedMaBind(headp,AbsAppl(HR)); + ptf = HR; + *ptf++ = (CELL)f; + ground = true; + arity_t a = ArityOfFunctor(f); + HR = ptf+a; + if (HR > ASP - MIN_ARENA_SIZE) { goto overflow; } + pt0 = headp; + pt0_end = headp+a; + ground = (f != FunctorMutable); } else { /* just copy atoms or integers */ *ptf++ = d0; @@ -306,66 +351,60 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, } derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = FALSE; - if (ptd0 >= HLow && ptd0 < HR) { + ground = false; + /* don't need to copy variables if we want to share the global term */ + if (//(share && ptd0 < HB && ptd0 > H0) || + (ptd0 >= HLow && ptd0 < HR)) { /* we have already found this cell */ - *ptf++ = (CELL) ptd0; - } else -#if COROUTINING - if (newattvs && IsAttachedTerm((CELL)ptd0)) { - /* if unbound, call the standard copy term routine */ - struct cp_frame *bp; + *ptf++ = (CELL)ptd0; + } else { + if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { + /* if unbound, call the standard copy term routine */ + struct cp_frame *bp; + CELL new; - CELL new; - - bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { - goto overflow; - } - to_visit = bp; - new = *ptf; - Bind_NonAtt(ptd0, new); - ptf++; + bp = to_visit; + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, + ptf PASS_REGS)) { + goto overflow; + } + to_visit = bp; + new = *ptf; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailedMaBind(ptd0, new); + ptf++; } else { -#endif - /* first time we met this term */ - RESET_VARIABLE(ptf); - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - Bind_NonAtt(ptd0, (CELL)ptf); - ptf++; + /* first time we met this term */ + RESET_VARIABLE(ptf); + if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) + goto trail_overflow; + TrailedMaBind(ptd0, (CELL)ptf); + ptf++; } + } } + /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit --; - if (ground && share) { - CELL old = to_visit->oldv; - CELL *newp = to_visit->to-1; - CELL new = *newp; - - *newp = old; - if (IsApplTerm(new)) - HR = RepAppl(new); - else - HR = RepPair(new); - } + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; - *pt0 = to_visit->oldv; ground = (ground && to_visit->ground); goto loop; } /* restore our nice, friendly, term to its original state */ clean_dirty_tr(TR0 PASS_REGS); - HB = HB0; - return ground; + /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); + return 0; + overflow: /* oops, we're in trouble */ @@ -374,14 +413,13 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; - *pt0 = to_visit->oldv; } reset_trail(TR0); - /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); return -1; trail_overflow: @@ -391,37 +429,14 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; - *pt0 = to_visit->oldv; - } - { - tr_fr_ptr oTR = TR; - reset_trail(TR0); - if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - return -4; - } - return -2; - } - - heap_overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - *pt0 = to_visit->oldv; } reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; - return -3; + pop_text_stack(lvl); + return -4; } @@ -477,7 +492,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { *HR = t; Hi = HR+1; HR += 2; - if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { HR = Hi-1; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -501,7 +516,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { HR += 2; { int res; - if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { HR = Hi; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -533,7 +548,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { } else { int res; - if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { HR = HB0; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -640,9 +655,9 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te copy_term_nvar: { if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - //fprintf(stderr, "%d \n", RepPair(ap2[0])- ptf); - if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) { + CELL *headp = RepPair(d0); + //fprintf(stderr, "%d \n", RepPair(headp[0])- ptf); + if (IsVarTerm(headp[0]) && IN_BETWEEN(HB, (headp[0]),HR)) { Term v = MkVarTerm(); *ptf = v; vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) ); @@ -656,19 +671,19 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldp = ap2; - d0 = to_visit->oldv = ap2[0]; + to_visit->oldp = headp; + d0 = to_visit->oldv = headp[0]; /* fool the system into thinking we had a variable there */ to_visit ++; - pt0 = ap2; - pt0_end = ap2 + 1; + pt0 = headp; + pt0_end = headp + 1; ptf = HR; - *ap2 = AbsPair(HR); + *headp = AbsPair(HR); HR += 2; if (HR > ASP - 2048) { goto overflow; } - if (IsVarTerm(d0) && d0 == (CELL)ap2) { + if (IsVarTerm(d0) && d0 == (CELL)headp) { RESET_VARIABLE(ptf); ptf++; continue; @@ -682,17 +697,17 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te continue; } else if (IsApplTerm(d0)) { register Functor f; - register CELL *ap2; + register CELL *headp; /* store the terms to visit */ - ap2 = RepAppl(d0)+1; - f = (Functor)(ap2[-1]); + headp = RepAppl(d0)+1; + f = (Functor)(headp[-1]); if (IsExtensionFunctor(f)) { *ptf++ = d0; /* you can just copy other extensions. */ continue; } - if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) { + if (IsApplTerm(headp[0]) && IN_BETWEEN(HB, RepAppl(headp[0]),HR)) { RESET_VARIABLE(ptf); - vin = add_to_list(vin, (CELL)ptf, ap2[0] ); + vin = add_to_list(vin, (CELL)ptf, headp[0] ); ptf++; continue; } @@ -705,24 +720,19 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldp = ap2; - d0 = to_visit->oldv = ap2[0]; + to_visit->oldp = headp; + d0 = to_visit->oldv = headp[0]; /* fool the system into thinking we had a variable there */ to_visit ++; - pt0 = ap2; - pt0_end = ap2 + (arity-1); + pt0 = headp; + pt0_end = headp + (arity-1); ptf = HR; if (HR > ASP - 2048) { goto overflow; } *ptf++ =(CELL)f; - *ap2 = AbsAppl(HR); + *headp = AbsAppl(HR); HR += (arity+1); - if (IsVarTerm(d0) && d0 == (CELL)(ap2)) { - RESET_VARIABLE(ptf); - ptf++; - continue; - } d0 = Deref(d0); if (!IsVarTerm(d0)) { goto copy_term_nvar; @@ -884,7 +894,7 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL if (new) { /* mark cell as pointing to new copy */ /* we can only mark after reading the value of the first argument */ - MaBind(pt0, new); + TrailedMaBind(pt0, new); new = 0L; } deref_head(d0, break_rationals_unk); @@ -1642,7 +1652,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), *to_visit0 = to_visit, *to_visit_max = to_visit+1024; - register tr_fr_ptr TR0 = TR; + register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); @@ -1657,8 +1667,8 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: - WALK_COMPLEX_TERM(); - continue ; + WALK_COMPLEX_TERM(); + continue ; derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); /* do or pt2 are unbound */ @@ -1681,14 +1691,14 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; + to_visit--; pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; goto loop; - } + } clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); @@ -1885,63 +1895,63 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), *to_visit0 = to_visit, *to_visit_max = to_visit+1024; - register tr_fr_ptr TR0 = TR; + register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, attvars_in_term_unk); - attvars_in_term_nvar: - { - WALK_COMPLEX_TERM(); - continue; - } - - - derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); - if (IsAttVar(ptd0)) { - /* do or pt2 are unbound */ - attvar_record *a0 = RepAttVar(ptd0); - if (a0->AttFunc ==(Functor) TermNil) continue; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)&(a0->Done); - /* store the terms to visit */ - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - ptd0 = (CELL*)a0; - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->d0 = *ptd0; - to_visit->ptd0 = ptd0; - to_visit ++; - *ptd0 = TermNil; - pt0 = ptd0; - pt0_end = &RepAttVar(ptd0)->Atts; - } + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, attvars_in_term_unk); + attvars_in_term_nvar: + { + WALK_COMPLEX_TERM(); + continue; } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; + + + derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); + if (IsAttVar(ptd0)) { + /* do or pt2 are unbound */ + attvar_record *a0 = RepAttVar(ptd0); + if (a0->AttFunc ==(Functor) TermNil) continue; + /* leave an empty slot to fill in later */ + if (HR+1024 > ASP) { + goto global_overflow; + } + HR[1] = AbsPair(HR+2); + HR += 2; + HR[-2] = (CELL)&(a0->Done); + /* store the terms to visit */ + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + ptd0 = (CELL*)a0; + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->d0 = *ptd0; + to_visit->ptd0 = ptd0; + to_visit ++; + *ptd0 = TermNil; + pt0 = ptd0; + pt0_end = &RepAttVar(ptd0)->Atts; + } + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; goto restart; - } + } clean_tr(TR0 PASS_REGS); @@ -2089,7 +2099,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; + to_visit--; pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; @@ -2182,7 +2192,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - WALK_COMPLEX_TERM(); + WALK_COMPLEX_TERM(); continue; } @@ -2208,7 +2218,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; + to_visit--; pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; @@ -2285,7 +2295,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end vars_within_term_nvar: { WALK_COMPLEX_TERM(); - continue; + continue; } derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); @@ -2334,7 +2344,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) { register CELL **to_visit0, - **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + **to_visit = (CELL **)Yap_PreAllocCodeSpace(); CELL *InitialH = HR; to_visit0 = to_visit; @@ -2676,7 +2686,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R return true; def_aux_overflow(); - } +} bool Yap_IsGroundTerm(Term t) { @@ -4328,11 +4338,11 @@ extern int vsc; int vsc; -#define RENUMBER_SINGLES\ - if (singles && ap2 >= InitialH && ap2 < HR) {\ - renumbervar(d0, numbv++ PASS_REGS);\ - continue;\ - } +#define RENUMBER_SINGLES \ + if (singles && ap2 >= InitialH && ap2 < HR) { \ + renumbervar(d0, numbv++ PASS_REGS); \ + continue; \ + } static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) diff --git a/H/Yapproto.h b/H/Yapproto.h index 4171421b4..8f7b2561a 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -477,6 +477,9 @@ extern void Yap_InitUserCPreds(void); extern void Yap_InitUserBacks(void); /* utilpreds.c */ +int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, + bool share, bool copy_att_vars, CELL *ptf, + CELL *HLow USES_REGS); extern Term Yap_CopyTerm(Term); extern bool Yap_Variant(Term, Term); extern size_t Yap_ExportTerm(Term, char *, size_t, UInt); diff --git a/H/amiops.h b/H/amiops.h index 12514a8c9..44718dae2 100644 --- a/H/amiops.h +++ b/H/amiops.h @@ -418,6 +418,12 @@ extern void Yap_WakeUp(CELL *v); *(VP) = (D); \ } +#define TrailedMaBind(VP, D) \ + { \ + DO_MATRAIL((VP), *(VP), (D)); \ + *(VP) = (D); \ + } + /************************************************************ Unification Routines diff --git a/packages/jpl/src/c/CMakeLists.txt b/packages/jpl/src/c/CMakeLists.txt index 9e7415b5e..2da29d17b 100644 --- a/packages/jpl/src/c/CMakeLists.txt +++ b/packages/jpl/src/c/CMakeLists.txt @@ -1,5 +1,6 @@ # set(CMAKE_MACOSX_RPATH 1) + add_library(jplYap jpl.c) include_directories (${JAVA_INCLUDE_PATH} ${JAVA_INCLUDE_PATH2} ${JAVA_AWT_PATH} ) diff --git a/pl/undefined.yap b/pl/undefined.yap index 3113cbc3c..0041a7811 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -67,12 +67,10 @@ followed by the failure of that call. :- multifile user:unknown_predicate_handler/3. undefined_query(G0, M0, Cut) :- - recorded('$import','$import'(M,M0,G,G0,_,_),_), - '$call'(G, Cut, G, M). + recorded('$import','$import'(M,M0,G,G0,_,_),_), + '$call'(G, Cut, G, M). -:- '$set_no_trace'('$handle_error'(_,_,_), prolog). - /** * @pred '$undefp_search'(+ M0:G0, -MG) * @@ -97,23 +95,22 @@ undefined_query(G0, M0, Cut) :- % undef handler '$undefp'([M0|G0],MG) :- -x % make sure we do not loop on undefined predicates - '$undef_setup'(Action,Debug,Current), - ('$get_undefined_predicates'(M0:G0, MG) - -> + % make sure we do not loop on undefined predicates + '$undef_setup'(Action,Debug,Current), + ('$get_undefined_predicates'(M0:G0, MG) + -> true - ; - '$undef_error'(M0:G0, MG) - ), - '$undef_cleanup'(Action,Debug,Current) - ). + ; + '$undef_error'(M0:G0, MG) + ), + '$undef_cleanup'(Action,Debug,Current). '$undef_error'(M0:G0, MG) :- '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), '$yap_strip_module'(M0:G0, EM0, GM0), user:unknown_predicate_handler(GM0,EM0,MG), !. - '$handle_error'(Mod:Goal,_) :- +'$handle_error'(Mod:Goal,_) :- functor(Goal,Name,Arity), '$do_error'(existence_error(procedure,Name/Arity), Mod:Goal). '$handle_error'(warning,Goal,Mod) :- @@ -123,9 +120,6 @@ x % make sure we do not loop on undefined predicates fail. '$handle_error'(fail,_Goal,_Mod) :- fail. - - - '$undefp'([M0|G0],MG) '$undef_setup'(Action,Debug,Current) :- yap_flag( unknown, Action, fail), @@ -133,29 +127,12 @@ x % make sure we do not loop on undefined predicates '$stop_creeping'(Current). -'$undef_cleanup'(fail,M0:G0,NM:NG,Action,Debug,Current) :- - '$undefp_search'(M0:G0, NM:NG), - '$pred_exists'(NG,NM), - !, +'$undef_cleanup'(Action,Debug,_Current) :- yap_flag( unknown, _, Action), yap_flag( debug, _, Debug), - nonvar(NG), - nonvar(NM), - ( - Current == true - -> - % carry on signal processing - '$start_creep'([NM|NG], creep) - ; - '$execute0'(NG, NM) - ). -'$search_def'(M0:G0,_,Action,Debug,_Current) :- - yap_flag( unknown, _, Action), - yap_flag( debug, _, Debug), -'$start_creep'([prolog|true], creep), -'$handle_error'(Action,G0,M0). + '$start_creep'([prolog|true], creep). -:- '$undefp_handler'('$undefp'(_,_), prolog). + :- '$undefp_handler'('$undefp'(_,_), prolog). /** @pred unknown(- _O_,+ _N_) From 2a090f3484d68a507ac925525dcf02567367cb87 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 23 Jan 2019 14:31:31 +0000 Subject: [PATCH 008/101] term to term --- C/globals.c | 6 +- C/utilpreds.c | 449 +++++++++++++++++++++------------------ H/TermExt.h | 3 +- H/Yapproto.h | 2 +- packages/jpl/src/c/jpl.c | 8 +- 5 files changed, 251 insertions(+), 217 deletions(-) diff --git a/C/globals.c b/C/globals.c index 5a457f19f..6d6e06d16 100644 --- a/C/globals.c +++ b/C/globals.c @@ -374,7 +374,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, *HR = t; Hi = HR + 1; HR += 2; - if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi, + if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, NULL, copy_att_vars, Hi, Hi PASS_REGS)) < 0) goto error_handler; CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); @@ -408,7 +408,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, Hi = HR; tf = AbsPair(HR); HR += 2; - if ((res = Yap_copy_complex_term(ap - 1, ap + 1, share, copy_att_vars, Hi, + if ((res = Yap_copy_complex_term(ap - 1, ap + 1, share, NULL, copy_att_vars, Hi, Hi PASS_REGS)) < 0) { goto error_handler; } @@ -487,7 +487,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, goto error_handler; } if ((res = Yap_copy_complex_term(ap, ap + ArityOfFunctor(f), share, - copy_att_vars, HB0 + 1, HB0 PASS_REGS)) < + NULL, copy_att_vars, HB0 + 1, HB0 PASS_REGS)) < 0) { goto error_handler; } diff --git a/C/utilpreds.c b/C/utilpreds.c index 0d66fcb09..cdf66b7d5 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -184,13 +184,13 @@ clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { #define MIN_ARENA_SIZE (1048L) int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, - bool share, bool copy_att_vars, CELL *ptf, + bool share, Term *split, bool copy_att_vars, CELL *ptf, CELL *HLow USES_REGS) { // fprintf(stderr,"+++++++++\n"); //CELL *x = pt0; while(x != pt0_end) Yap_DebugPlWriteln(*++ x); int lvl = push_text_stack(); - + Term o = TermNil; struct cp_frame *to_visit0, *to_visit = Malloc(1024*sizeof(struct cp_frame)); struct cp_frame *to_visit_max; @@ -214,229 +214,264 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, copy_term_nvar : { if (IsPairTerm(d0)) { CELL *headp = RepPair(d0); - if (//(share && headp < HB) || - (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR)) { + if (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR) { + if (split) { + Term v = Yap_MkNewApplTerm(FunctorEq, 2); + RepAppl(v)[1] = *headp; + *headp = *ptf++ = RepAppl(v)[0]; + o = MkPairTerm( v, o ); + } else { + /* If this is newer than the current term, just reuse */ + *ptf++ = (CELL)RepAppl(*headp); + } + } + else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) { + *ptf++ = AbsPair(RepAppl(*headp)); + continue; + } + if (to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + *ptf = AbsPair(HR); + ptf++; + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->curp = headp; + d0 = *headp; + to_visit->oldv = d0; + to_visit->ground = ground; + to_visit++; + // move to new list + if (share) { + TrailedMaBind(headp,AbsPair(HR)); + } else { + *headp = AbsPair(HR); + } + pt0 = headp; + pt0_end = headp + 1; + ptf = HR; + ground = true; + HR += 2; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + ptd0 = pt0; + goto deref; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *headp; + /* store the terms to visit */ + headp = RepAppl(d0); + if (IsPairTerm(*headp)//(share && headp < HB) || + ) { + if (split) { + Term v = Yap_MkNewApplTerm(FunctorEq, 2); + RepAppl(v)[1] = *headp; + *headp = *ptf++ = RepAppl(v)[0]; + o = MkPairTerm( v, o ); + } else { /* If this is newer than the current term, just reuse */ - *ptf++ = *headp; - continue; + *ptf++ = AbsPair(RepAppl(*headp)); } - if (to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - *ptf = AbsPair(HR); - ptf++; - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit++; - // move to new list - d0 = *headp; - TrailedMaBind(headp, AbsPair(HR)); - pt0 = headp; - pt0_end = headp + 1; - ptf = HR; - ground = true; - HR += 2; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - ptd0 = pt0; - goto deref; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *headp; - /* store the terms to visit */ - headp = RepAppl(d0); - if (IsApplTerm(*headp)//(share && headp < HB) || - ) { - /* If this is newer than the current term, just reuse */ - *ptf++ = *headp; - continue; - } - f = (Functor)(*headp); + continue; + } + f = (Functor)(*headp); - if (IsExtensionFunctor(f)) { - switch ((CELL)f) { - case (CELL) FunctorDBRef: - case (CELL) FunctorAttVar: - *ptf++ = d0; - break; - case (CELL) FunctorLongInt: - if (HR > ASP - (MIN_ARENA_SIZE + 3)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = headp[1]; - HR[2] = EndSpecials; - HR += 3; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - break; - case (CELL) FunctorDouble: - if (HR > - ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = headp[1]; + if (IsExtensionFunctor(f)) { + if (share) { + *ptf++ = d0; + continue; + } + switch ((CELL)f) { + case (CELL) FunctorDBRef: + case (CELL) FunctorAttVar: + *ptf++ = d0; + break; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; + HR[2] = EndSpecials; + HR += 3; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + break; + case (CELL) FunctorDouble: + if (HR > + ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - HR[2] = headp[2]; - HR[3] = EndSpecials; - HR += 4; + HR[2] = headp[2]; + HR[3] = EndSpecials; + HR += 4; #else - HR[2] = EndSpecials; - HR += 3; + HR[2] = EndSpecials; + HR += 3; #endif - break; - case (CELL) FunctorString: - if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - memmove(HR, headp, sizeof(CELL) * (3 + headp[1])); - HR += headp[1] + 3; - break; - default: { - /* big int */ - size_t sz = (sizeof(MP_INT) + 3 * CellSize + - ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / - CellSize, - i; - - if (HR > ASP - (MIN_ARENA_SIZE + sz)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - for (i = 1; i < sz; i++) { - HR[i] = headp[i]; - - } - HR += sz; + break; + case (CELL) FunctorString: + if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) { + goto overflow; } + *ptf++ = AbsAppl(HR); + memmove(HR, headp, sizeof(CELL) * (3 + headp[1])); + HR += headp[1] + 3; + break; + default: { + /* big int */ + size_t sz = (sizeof(MP_INT) + 3 * CellSize + + ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / + CellSize, + i; + + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + goto overflow; } - continue; - } - *ptf = AbsAppl(HR); - ptf++; - /* store the terms to visit */ - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - if (++to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + for (i = 1; i < sz; i++) { + HR[i] = headp[i]; + + } + HR += sz; } - TrailedMaBind(headp,AbsAppl(HR)); - ptf = HR; - *ptf++ = (CELL)f; - ground = true; - arity_t a = ArityOfFunctor(f); - HR = ptf+a; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; } - pt0 = headp; - pt0_end = headp+a; - ground = (f != FunctorMutable); - } else { - /* just copy atoms or integers */ - *ptf++ = d0; + continue; } - continue; - } - - derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = false; - /* don't need to copy variables if we want to share the global term */ - if (//(share && ptd0 < HB && ptd0 > H0) || - (ptd0 >= HLow && ptd0 < HR)) { - /* we have already found this cell */ - *ptf++ = (CELL)ptd0; + *ptf = AbsAppl(HR); + ptf++; + /* store the terms to visit */ + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->curp = headp; + d0 = *headp; + to_visit->oldv = d0; + to_visit->ground = ground; + if (++to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + if (share) { + TrailedMaBind(headp,AbsPair(HR)); + } else { + *headp = AbsPair(HR); + } + ptf = HR; + ptf[-1] = (CELL)f; + ground = true; + arity_t a = ArityOfFunctor(f); + HR = ptf+a; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + pt0 = headp; + pt0_end = headp+a; + ground = (f != FunctorMutable); } else { - if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { - /* if unbound, call the standard copy term routine */ - struct cp_frame *bp; - CELL new; + /* just copy atoms or integers */ + *ptf++ = d0; + } + continue; + } - bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, - ptf PASS_REGS)) { - goto overflow; - } - to_visit = bp; - new = *ptf; - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailedMaBind(ptd0, new); - ptf++; - } else { - /* first time we met this term */ - RESET_VARIABLE(ptf); - if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) - goto trail_overflow; - TrailedMaBind(ptd0, (CELL)ptf); - ptf++; + derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); + ground = false; + /* don't need to copy variables if we want to share the global term */ + if (//(share && ptd0 < HB && ptd0 > H0) || + (ptd0 >= HLow && ptd0 < HR)) { + /* we have already found this cell */ + *ptf++ = (CELL)ptd0; + } else { + if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { + /* if unbound, call the standard copy term routine */ + struct cp_frame *bp; + CELL new; + + bp = to_visit; + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, + ptf PASS_REGS)) { + goto overflow; } + to_visit = bp; + new = *ptf; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailedMaBind(ptd0, new); + ptf++; + } else { + /* first time we met this term */ + RESET_VARIABLE(ptf); + if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) + goto trail_overflow; + TrailedMaBind(ptd0, (CELL)ptf); + ptf++; } } +} - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - ground = (ground && to_visit->ground); - goto loop; - } +/* Do we still have compound terms to visit */ +if (to_visit > to_visit0) { + to_visit--; + if (!share) + *to_visit->curp = to_visit->oldv; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + ground = (ground && to_visit->ground); + goto loop; + } - /* restore our nice, friendly, term to its original state */ - clean_dirty_tr(TR0 PASS_REGS); - /* follow chain of multi-assigned variables */ - pop_text_stack(lvl); - return 0; +/* restore our nice, friendly, term to its original state */ +clean_dirty_tr(TR0 PASS_REGS); +/* follow chain of multi-assigned variables */ +pop_text_stack(lvl); +return 0; - overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - } - reset_trail(TR0); - pop_text_stack(lvl); - return -1; +overflow: +/* oops, we're in trouble */ +HR = HLow; +/* we've done it */ +/* restore our nice, friendly, term to its original state */ +HB = HB0; +while (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + } +reset_trail(TR0); +pop_text_stack(lvl); +return -1; - trail_overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - } - reset_trail(TR0); - pop_text_stack(lvl); - return -4; +trail_overflow: +/* oops, we're in trouble */ +HR = HLow; +/* we've done it */ +/* restore our nice, friendly, term to its original state */ +HB = HB0; +while (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + } +reset_trail(TR0); +pop_text_stack(lvl); +return -4; } @@ -492,7 +527,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { *HR = t; Hi = HR+1; HR += 2; - if ((res = Yap_copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(Hi-2, Hi-1, share, NULL, newattvs, Hi, Hi PASS_REGS)) < 0) { HR = Hi-1; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -516,7 +551,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { HR += 2; { int res; - if ((res = Yap_copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(ap-1, ap+1, share, NULL, newattvs, Hi, Hi PASS_REGS)) < 0) { HR = Hi; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -548,7 +583,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { } else { int res; - if ((res = Yap_copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(ap, ap+ArityOfFunctor(f), share, NULL, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { HR = HB0; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; diff --git a/H/TermExt.h b/H/TermExt.h index fed59fcbd..ccd1eb827 100755 --- a/H/TermExt.h +++ b/H/TermExt.h @@ -111,10 +111,9 @@ typedef struct cp_frame { CELL *start_cp; CELL *end_cp; CELL *to; -#ifdef RATIONAL_TREES + CELL *curp; CELL oldv; int ground; -#endif } copy_frame; #ifdef COROUTINING diff --git a/H/Yapproto.h b/H/Yapproto.h index 8f7b2561a..4750e4d5b 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -478,7 +478,7 @@ extern void Yap_InitUserBacks(void); /* utilpreds.c */ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, - bool share, bool copy_att_vars, CELL *ptf, + bool share, Term *split, bool copy_att_vars, CELL *ptf, CELL *HLow USES_REGS); extern Term Yap_CopyTerm(Term); extern bool Yap_Variant(Term, Term); diff --git a/packages/jpl/src/c/jpl.c b/packages/jpl/src/c/jpl.c index 838f7bfbe..af40c856d 100755 --- a/packages/jpl/src/c/jpl.c +++ b/packages/jpl/src/c/jpl.c @@ -48,12 +48,12 @@ refactoring (trivial): #define JPL_C_LIB_VERSION_PATCH 4 #define JPL_C_LIB_VERSION_STATUS "alpha" -#define JPL_DEBUG +//#define JPL_DEBUG #ifndef JPL_DEBUG /*#define DEBUG(n, g) ((void)0) */ #define DEBUG_LEVEL 4 -#define JPL_DEBUG(n, g) ( n >= DEBUG_LEVEL ? g : (void)0 ) +#define JPL_DEBUG(n, g) ( false && n >= DEBUG_LEVEL ? g : (void)0 ) #endif /* disable type-of-ref caching (at least until GC issues are resolved) */ @@ -642,7 +642,7 @@ static JNIEnv* jni_env(void) /* economically gets a JNIEnv pointer, valid for this thread */ { JNIEnv *env; - switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_9) ) + switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_1_2) ) { case JNI_OK: return env; case JNI_EDETACHED: @@ -1826,7 +1826,7 @@ jni_create_jvm_c( JNIEnv *env; JPL_DEBUG(1, Sdprintf( "[creating JVM with 'java.class.path=%s']\n", classpath)); - vm_args.version = JNI_VERSION_1_6; /* "Java 1.2 please" */ + vm_args.version = JNI_VERSION_1_2; /* "Java 1.2 please" */ if ( classpath ) { cpoptp = (char *)malloc(strlen(classpath) + strlen("-Djava.class.path=")+1); From 92089074f17a22e499e676d209d90e6a4a3a43f0 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 24 Jan 2019 13:27:23 +0000 Subject: [PATCH 009/101] write_loops --- C/utilpreds.c | 145 +++++++++++++++++++++++++++++++++---------------- C/write.c | 52 +++++++++++------- os/writeterm.c | 4 ++ 3 files changed, 134 insertions(+), 67 deletions(-) diff --git a/C/utilpreds.c b/C/utilpreds.c index cdf66b7d5..0a0d18c68 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -176,6 +176,42 @@ clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { TR = TR0; } +/// @brief recover original term while fixing direct refs. +/// +/// @param USES_REGS +/// +static inline void +clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { + tr_fr_ptr pt0 = TR; + while (pt0 != TR0) { + Term p = TrailTerm(--pt0); + if (IsApplTerm(p)) { + /// pt: points to the address of the new term we may want to fix. + CELL *pt = RepAppl(p); + if (pt >= HB && pt < HR) { /// is it new? + Term v = pt[0]; + if (IsApplTerm(v)) { + /// yes, more than a single ref + *pt = (CELL)RepAppl(v); + } +#ifndef FROZEN_STACKS + pt0 --; +#endif /* FROZEN_STACKS */ + continue; + } +#ifdef FROZEN_STACKS + pt[0] = TrailVal(pt0); +#else + pt[0] = TrailTerm(pt0 - 1); + pt0 --; +#endif /* FROZEN_STACKS */ + } else { + RESET_VARIABLE(p); + } + } + TR = TR0; +} + #define expand_stack(S0,SP,SF,TYPE) \ { size_t sz = SF-S0, used = SP-S0; \ S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ @@ -214,69 +250,79 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, copy_term_nvar : { if (IsPairTerm(d0)) { CELL *headp = RepPair(d0); - if (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR) { + Term head = *headp; + if (IsPairTerm(head) && RepPair(head) >= HB && RepPair(head) < HR) { if (split) { Term v = Yap_MkNewApplTerm(FunctorEq, 2); - RepAppl(v)[1] = *headp; + RepAppl(v)[1] = AbsPair(ptf); *headp = *ptf++ = RepAppl(v)[0]; o = MkPairTerm( v, o ); } else { - /* If this is newer than the current term, just reuse */ - *ptf++ = (CELL)RepAppl(*headp); + *ptf++ = head; } - } - else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) { + continue; + } else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) { *ptf++ = AbsPair(RepAppl(*headp)); - continue; - } - if (to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - *ptf = AbsPair(HR); - ptf++; - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->curp = headp; - d0 = *headp; - to_visit->oldv = d0; - to_visit->ground = ground; - to_visit++; - // move to new list - if (share) { - TrailedMaBind(headp,AbsPair(HR)); - } else { - *headp = AbsPair(HR); - } - pt0 = headp; - pt0_end = headp + 1; - ptf = HR; - ground = true; - HR += 2; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - ptd0 = pt0; - goto deref; - } else if (IsApplTerm(d0)) { + continue; + } + if (to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + *ptf = AbsPair(HR); + ptf++; + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->curp = headp; + to_visit->oldv = head; + to_visit->ground = ground; + to_visit++; + // move to new list + if (share) { + TrailedMaBind(headp,AbsPair(HR)); + } else { + /* If this is newer than the current term, just reuse */ + *headp = AbsPair(HR); + } + if (split) { + TrailedMaBind(ptf,AbsPair(HR)); + } + pt0 = headp; + pt0_end = headp + 1; + ptf = HR; + ground = true; + HR += 2; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + ptd0 = pt0; + goto deref; + } else if (IsApplTerm(d0)) { register Functor f; - register CELL *headp; + register CELL *headp, head; /* store the terms to visit */ headp = RepAppl(d0); - if (IsPairTerm(*headp)//(share && headp < HB) || + head = *headp; + + if (IsPairTerm(head)//(share && headp < HB) || ) { if (split) { Term v = Yap_MkNewApplTerm(FunctorEq, 2); - RepAppl(v)[1] = *headp; + RepAppl(v)[1] = head; *headp = *ptf++ = RepAppl(v)[0]; o = MkPairTerm( v, o ); } else { /* If this is newer than the current term, just reuse */ - *ptf++ = AbsPair(RepAppl(*headp)); + *ptf++ = AbsAppl(RepPair(head)); } continue; } - f = (Functor)(*headp); + if (IsApplTerm(head)//(share && headp < HB) || + ) { + *ptf++ = head; + continue; + } + f = (Functor)(head); if (IsExtensionFunctor(f)) { if (share) { @@ -365,6 +411,11 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, } else { *headp = AbsPair(HR); } + if (split) { + // must be after trailing source term, so that we can check the source + // term and confirm it is still ok. + TrailedMaBind(ptf,AbsAppl(HR)); + } ptf = HR; ptf[-1] = (CELL)f; ground = true; @@ -435,10 +486,10 @@ if (to_visit > to_visit0) { } /* restore our nice, friendly, term to its original state */ -clean_dirty_tr(TR0 PASS_REGS); -/* follow chain of multi-assigned variables */ -pop_text_stack(lvl); -return 0; + clean_complex_tr(TR0 PASS_REGS); + /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); + return 0; overflow: diff --git a/C/write.c b/C/write.c index 95df7a945..aec28c6df 100644 --- a/C/write.c +++ b/C/write.c @@ -77,6 +77,7 @@ typedef struct write_globs { int last_atom_minus; UInt MaxDepth, MaxArgs; wtype lw; + int sl0; } wglbs; #define lastw wglb->lw @@ -100,11 +101,20 @@ static bool callPortray(Term t, int sno USES_REGS) { return false; } -#define PROTECT(t, F) \ - { \ - yhandle_t yt = Yap_InitHandle(t); \ - F; \ - t = Yap_PopHandle(yt); \ +#define PROTECT(t, F) \ + { \ + yhandle_t yt = Yap_InitHandle(t); \ + if (wglb->Write_Loops) { \ + yhandle_t i; \ + for (i=wglb->sl0;istream ); return; \ + } \ + } \ + } \ + F; \ + t = Yap_PopHandle(yt);\ } static void wrputn(Int, struct write_globs *); static void wrputf(Float, struct write_globs *); @@ -267,7 +277,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg, return; } else if (big_tag == BIG_RATIONAL) { Term trat = Yap_RatTermToApplTerm(t); - writeTerm(trat, p, depth, rinfixarg, wglb, rwt); + PROTECT(t,writeTerm(trat, p, depth, rinfixarg, wglb, rwt)); return; #endif } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) { @@ -701,11 +711,11 @@ static void write_var(CELL *t, struct write_globs *wglb, wrputs("$AT(", wglb->stream); write_var(t, wglb, rwt); wrputc(',', wglb->stream); - PROTECT(*t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); + PROTECT(t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); attv = RepAttVar(t); wrputc(',', wglb->stream); l++; - writeTerm(*l, 999, 1, FALSE, wglb, &nrwt); + PROTECT(t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); wrclose_bracket(wglb, TRUE); } wglb->Portray_delays = TRUE; @@ -767,14 +777,14 @@ static void write_list(Term t, int direction, int depth, /* we found an infinite loop */ /* keep going on the list */ wrputc(',', wglb->stream); - write_list(ti, direction, depth, wglb, &nrwt); + PROTECT(t,write_list(ti, direction, depth, wglb, &nrwt)); } else if (ti != MkAtomTerm(AtomNil)) { if (lastw == symbol || lastw == separator) { wrputc(' ', wglb->stream); } wrputc('|', wglb->stream); lastw = separator; - writeTerm(ti, 999, depth, FALSE, wglb, &nrwt); + PROTECT(ti,writeTerm(ti, 999, depth, FALSE, wglb, &nrwt)); } } @@ -807,7 +817,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); wrputs(",", wglb->stream); - writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt); + PROTECT(t, writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); wrclose_bracket(wglb, TRUE); return; } @@ -901,7 +911,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, } else if (atom == AtomMinus) { last_minus = TRUE; } - writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt); + PROTECT(t,writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt)); if (bracket_right) { wrclose_bracket(wglb, TRUE); } @@ -934,7 +944,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, if (bracket_left) { wropen_bracket(wglb, TRUE); } - writeTerm(ArgOfTerm(offset, t), lp, depth + 1, rinfixarg, wglb, &nrwt); + PROTECT(t,writeTerm(ArgOfTerm(offset, t), lp, depth + 1, rinfixarg, wglb, &nrwt)); if (bracket_left) { wrclose_bracket(wglb, TRUE); } @@ -999,7 +1009,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, if (bracket_right) { wropen_bracket(wglb, TRUE); } - writeTerm(ArgOfTerm(2, t), rp, depth + 1, TRUE, wglb, &nrwt); + PROTECT(t,writeTerm(ArgOfTerm(2, t), rp, depth + 1, TRUE, wglb, &nrwt)); if (bracket_right) { wrclose_bracket(wglb, TRUE); } @@ -1039,14 +1049,14 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, } else { wrputs("'$VAR'(", wglb->stream); lastw = separator; - writeTerm(ArgOfTerm(1, t), 999, depth + 1, FALSE, wglb, &nrwt); + PROTECT(t,writeTerm(ArgOfTerm(1, t), 999, depth + 1, FALSE, wglb, &nrwt)); wrclose_bracket(wglb, TRUE); } } else if (!wglb->Ignore_ops && functor == FunctorBraces) { wrputc('{', wglb->stream); lastw = separator; - writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb, - &nrwt); + PROTECT(t,writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb, + &nrwt)); wrputc('}', wglb->stream); lastw = separator; } else if (atom == AtomArray) { @@ -1057,7 +1067,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, wrputs("...", wglb->stream); break; } - writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt); + PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt)); if (op != Arity) { PROTECT(t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt)); @@ -1065,7 +1075,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, lastw = separator; } } - writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt); + PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt)); wrputc('}', wglb->stream); lastw = separator; } else { @@ -1084,7 +1094,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, wrputc(',', wglb->stream); lastw = separator; } - writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt); + PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt)); wrclose_bracket(wglb, TRUE); } } @@ -1102,6 +1112,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, yhandle_t sls = Yap_CurrentSlot(); int lvl = push_text_stack(); + wglb.sl0 = sls; if (t == 0) return; if (!mywrite) { @@ -1124,6 +1135,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, rwt.parent = NULL; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; + wglb.Write_Loops = !(flags &Ignore_cyclics_f); if (!(flags & Ignore_cyclics_f) && false) { Term ts[2]; ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS); diff --git a/os/writeterm.c b/os/writeterm.c index 715d84e3c..b55b96c63 100644 --- a/os/writeterm.c +++ b/os/writeterm.c @@ -573,6 +573,8 @@ static Int writeln1(USES_REGS1) { args[WRITE_NL].tvalue = TermTrue; args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].tvalue = TermTrue; + args[WRITE_CYCLES].used = true; + args[WRITE_CYCLES].tvalue = TermTrue; LOCK(GLOBAL_Stream[output_stream].streamlock); write_term(output_stream, ARG1, args PASS_REGS); UNLOCK(GLOBAL_Stream[output_stream].streamlock); @@ -603,6 +605,8 @@ static Int writeln(USES_REGS1) { args[WRITE_NL].tvalue = TermTrue; args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].tvalue = TermTrue; + args[WRITE_CYCLES].used = true; + args[WRITE_CYCLES].tvalue = TermTrue; write_term(output_stream, ARG2, args PASS_REGS); UNLOCK(GLOBAL_Stream[output_stream].streamlock); free(args); From 93bb39d5f71c635f8befed97e050ea5a333005e8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 24 Jan 2019 19:03:18 +0000 Subject: [PATCH 010/101] copy_term --- C/utilpreds.c | 415 ++++++++++++++++---------------- C/write.c | 34 +-- CMakeLists.txt | 26 +- packages/ProbLog/CMakeLists.txt | 1 - packages/ProbLog/problog.yap | 4 +- 5 files changed, 238 insertions(+), 242 deletions(-) diff --git a/C/utilpreds.c b/C/utilpreds.c index 0a0d18c68..6f0afc98d 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -8,10 +8,8 @@ * * ************************************************************************** * * - * File: utilpreds.c * - * Last rev: 4/03/88 * - * mods: * - * comments: new utility predicates for YAP * + * File: utilpreds.c * Last rev: 4/03/88 + ** mods: * comments: new utility predicates for YAP * * * *************************************************************************/ #ifdef SCCS @@ -195,9 +193,9 @@ clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { *pt = (CELL)RepAppl(v); } #ifndef FROZEN_STACKS - pt0 --; + pt0 --; #endif /* FROZEN_STACKS */ - continue; + continue; } #ifdef FROZEN_STACKS pt[0] = TrailVal(pt0); @@ -220,7 +218,7 @@ clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { #define MIN_ARENA_SIZE (1048L) int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, - bool share, Term *split, bool copy_att_vars, CELL *ptf, + bool share, Term *split, bool copy_att_vars, CELL *ptf, CELL *HLow USES_REGS) { // fprintf(stderr,"+++++++++\n"); //CELL *x = pt0; while(x != pt0_end) Yap_DebugPlWriteln(*++ x); @@ -265,11 +263,11 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, *ptf++ = AbsPair(RepAppl(*headp)); continue; } + *ptf = AbsPair(HR); + ptf++; if (to_visit >= to_visit_max-32) { expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); } - *ptf = AbsPair(HR); - ptf++; to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; @@ -298,231 +296,232 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, ptd0 = pt0; goto deref; } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *headp, head; - /* store the terms to visit */ - headp = RepAppl(d0); - head = *headp; + Functor f; + CELL *headp, head; + /* store the terms to visit */ + headp = RepAppl(d0); + head = *headp; - if (IsPairTerm(head)//(share && headp < HB) || - ) { - if (split) { - Term v = Yap_MkNewApplTerm(FunctorEq, 2); - RepAppl(v)[1] = head; - *headp = *ptf++ = RepAppl(v)[0]; - o = MkPairTerm( v, o ); - } else { - /* If this is newer than the current term, just reuse */ - *ptf++ = AbsAppl(RepPair(head)); + if (IsPairTerm(head)//(share && headp < HB) || + ) { + if (split) { + Term v = Yap_MkNewApplTerm(FunctorEq, 2); + RepAppl(v)[1] = head; + *headp = *ptf++ = RepAppl(v)[0]; + o = MkPairTerm( v, o ); + } else { + /* If this is newer than the current term, just reuse */ + *ptf++ = AbsAppl(RepPair(head)); + } + continue; } - continue; - } - if (IsApplTerm(head)//(share && headp < HB) || - ) { - *ptf++ = head; - continue; - } - f = (Functor)(head); - - if (IsExtensionFunctor(f)) { - if (share) { + if (IsApplTerm(head)//(share && headp < HB) || + ) { + *ptf++ = head; + continue; + } + f = (Functor)(head); + if (share && (ground || IsExtensionFunctor(f))) { *ptf++ = d0; continue; } - switch ((CELL)f) { - case (CELL) FunctorDBRef: - case (CELL) FunctorAttVar: - *ptf++ = d0; - break; - case (CELL) FunctorLongInt: - if (HR > ASP - (MIN_ARENA_SIZE + 3)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = headp[1]; - HR[2] = EndSpecials; - HR += 3; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - break; - case (CELL) FunctorDouble: - if (HR > - ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = headp[1]; + /* store the terms to visit */ + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->curp = headp; + to_visit->oldv = head; + to_visit->ground = ground; + if (++to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + *ptf = AbsAppl(HR); + ptf++; + ptf = HR; + + if (IsExtensionFunctor(f)) { + switch ((CELL)f) { + case (CELL) FunctorDBRef: + case (CELL) FunctorAttVar: + *ptf++ = d0; + break; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; + HR[2] = EndSpecials; + HR += 3; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + break; + case (CELL) FunctorDouble: + if (HR > + ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - HR[2] = headp[2]; - HR[3] = EndSpecials; - HR += 4; + HR[2] = headp[2]; + HR[3] = EndSpecials; + HR += 4; #else - HR[2] = EndSpecials; - HR += 3; + HR[2] = EndSpecials; + HR += 3; #endif - break; - case (CELL) FunctorString: - if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - memmove(HR, headp, sizeof(CELL) * (3 + headp[1])); - HR += headp[1] + 3; - break; - default: { - /* big int */ - size_t sz = (sizeof(MP_INT) + 3 * CellSize + - ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / - CellSize, - i; + break; + case (CELL) FunctorString: + if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + memmove(HR, headp, sizeof(CELL) * (3 + headp[1])); + HR += headp[1] + 3; + break; + default: { + /* big int */ + size_t sz = (sizeof(MP_INT) + 3 * CellSize + + ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / + CellSize, + i; - if (HR > ASP - (MIN_ARENA_SIZE + sz)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - for (i = 1; i < sz; i++) { - HR[i] = headp[i]; + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + for (i = 1; i < sz; i++) { + HR[i] = headp[i]; + } + HR += sz; } - HR += sz; + } + continue; } + if (share) { + TrailedMaBind(headp,AbsPair(HR)); + } else { + *headp = AbsPair(HR); } - continue; - } - *ptf = AbsAppl(HR); - ptf++; - /* store the terms to visit */ - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->curp = headp; - d0 = *headp; - to_visit->oldv = d0; - to_visit->ground = ground; - if (++to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - if (share) { - TrailedMaBind(headp,AbsPair(HR)); + if (split) { + // must be after trailing source term, so that we can check the source + // term and confirm it is still ok. + TrailedMaBind(ptf,AbsAppl(HR)); + } + ptf = HR; + ptf[-1] = (CELL)f; + ground = true; + arity_t a = ArityOfFunctor(f); + HR = ptf+a; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + pt0 = headp; + pt0_end = headp+a; + ground = (f != FunctorMutable); } else { - *headp = AbsPair(HR); + /* just copy atoms or integers */ + *ptf++ = d0; } - if (split) { - // must be after trailing source term, so that we can check the source - // term and confirm it is still ok. - TrailedMaBind(ptf,AbsAppl(HR)); - } - ptf = HR; - ptf[-1] = (CELL)f; - ground = true; - arity_t a = ArityOfFunctor(f); - HR = ptf+a; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - pt0 = headp; - pt0_end = headp+a; - ground = (f != FunctorMutable); - } else { - /* just copy atoms or integers */ - *ptf++ = d0; + continue; } - continue; - } - derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = false; - /* don't need to copy variables if we want to share the global term */ - if (//(share && ptd0 < HB && ptd0 > H0) || - (ptd0 >= HLow && ptd0 < HR)) { - /* we have already found this cell */ - *ptf++ = (CELL)ptd0; - } else { - if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { - /* if unbound, call the standard copy term routine */ - struct cp_frame *bp; - CELL new; + derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); + ground = false; + /* don't need to copy variables if we want to share the global term */ + if (//(share && ptd0 < HB && ptd0 > H0) || + (ptd0 >= HLow && ptd0 < HR)) { + /* we have already found this cell */ + *ptf++ = (CELL)ptd0; + } else { + if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { + /* if unbound, call the standard copy term routine */ + struct cp_frame *bp; + CELL new; - bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, - ptf PASS_REGS)) { - goto overflow; - } - to_visit = bp; - new = *ptf; - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; + bp = to_visit; + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, + ptf PASS_REGS)) { + goto overflow; } + to_visit = bp; + new = *ptf; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailedMaBind(ptd0, new); + ptf++; + } else { + /* first time we met this term */ + RESET_VARIABLE(ptf); + if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) + goto trail_overflow; + DO_TRAIL(ptd0, (CELL)ptf); + *ptd0 = (CELL)ptf; + ptf++; } - TrailedMaBind(ptd0, new); - ptf++; - } else { - /* first time we met this term */ - RESET_VARIABLE(ptf); - if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) - goto trail_overflow; - TrailedMaBind(ptd0, (CELL)ptf); - ptf++; } } -} + + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + if (!share) + *to_visit->curp = to_visit->oldv; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + ground = (ground && to_visit->ground); + goto loop; + } -/* Do we still have compound terms to visit */ -if (to_visit > to_visit0) { - to_visit--; - if (!share) - *to_visit->curp = to_visit->oldv; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - ground = (ground && to_visit->ground); - goto loop; - } - -/* restore our nice, friendly, term to its original state */ - clean_complex_tr(TR0 PASS_REGS); - /* follow chain of multi-assigned variables */ - pop_text_stack(lvl); - return 0; + /* restore our nice, friendly, term to its original state */ + clean_complex_tr(TR0 PASS_REGS); + /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); + return 0; -overflow: -/* oops, we're in trouble */ -HR = HLow; -/* we've done it */ -/* restore our nice, friendly, term to its original state */ -HB = HB0; -while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - } -reset_trail(TR0); -pop_text_stack(lvl); -return -1; + overflow: + /* oops, we're in trouble */ + HR = HLow; + /* we've done it */ + /* restore our nice, friendly, term to its original state */ + HB = HB0; + while (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + } + reset_trail(TR0); + pop_text_stack(lvl); + return -1; -trail_overflow: -/* oops, we're in trouble */ -HR = HLow; -/* we've done it */ -/* restore our nice, friendly, term to its original state */ -HB = HB0; -while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - } -reset_trail(TR0); -pop_text_stack(lvl); -return -4; + trail_overflow: + /* oops, we're in trouble */ + HR = HLow; + /* we've done it */ + /* restore our nice, friendly, term to its original state */ + HB = HB0; + while (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + } + reset_trail(TR0); + pop_text_stack(lvl); + return -4; } diff --git a/C/write.c b/C/write.c index aec28c6df..c549c7b82 100644 --- a/C/write.c +++ b/C/write.c @@ -101,20 +101,22 @@ static bool callPortray(Term t, int sno USES_REGS) { return false; } -#define PROTECT(t, F) \ - { \ - yhandle_t yt = Yap_InitHandle(t); \ - if (wglb->Write_Loops) { \ - yhandle_t i; \ - for (i=wglb->sl0;istream ); return; \ - } \ - } \ - } \ - F; \ - t = Yap_PopHandle(yt);\ +#define PROTECT(t, F) \ + { \ + yhandle_t yt = Yap_InitHandle(t); \ + if (wglb->Write_Loops) { \ + yhandle_t i; \ + for (i = yt - 1; i >= wglb->sl0; i--) { \ + if (Yap_GetFromHandle(i) == t) { \ + char buf[63]; \ + snprintf(buf, 63, " @{ ^^%ld } ", yt - i); \ + wrputs(buf, wglb->stream); \ + return; \ + } \ + } \ + } \ + F; \ + t = Yap_PopHandle(yt); \ } static void wrputn(Int, struct write_globs *); static void wrputf(Float, struct write_globs *); @@ -711,11 +713,11 @@ static void write_var(CELL *t, struct write_globs *wglb, wrputs("$AT(", wglb->stream); write_var(t, wglb, rwt); wrputc(',', wglb->stream); - PROTECT(t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); + PROTECT(*l, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); attv = RepAttVar(t); wrputc(',', wglb->stream); l++; - PROTECT(t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); + PROTECT(*l, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); wrclose_bracket(wglb, TRUE); } wglb->Portray_delays = TRUE; diff --git a/CMakeLists.txt b/CMakeLists.txt index af0bd3868..0ababa270 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -400,27 +400,23 @@ if (GMP_INCLUDE_DIRS) ) endif () -include_directories(H - H/generated - include os OPTYap utf8proc JIT/HPP) -include_directories(BEFORE ${CMAKE_BINARY_DIR}) - -add_subdirectory( H ) - -set_directory_properties( PROPERTIES INCLUDE_DIRECTORIES - H - H/generated - include - os - OPTYap - utf8proc - JIT/HPP +include_directories( +${CMAKE_SOURCE_DIR}/H +${CMAKE_SOURCE_DIR}/H/generated +${CMAKE_SOURCE_DIR}/include +${CMAKE_SOURCE_DIR}/os +${CMAKE_SOURCE_DIR}/OPTYap +${CMAKE_SOURCE_DIR}/utf8proc + ${CMAKE_SOURCE_DIR}/JIT/HPP ${GMP_INCLUDE_DIRS} ${READLINE_LIBRARIES} ${SQLITE_LIBRARIES} ${ANDROID_LIBRARIES} + ${CMAKE_BINARY_DIR} ) + add_subdirectory( H ) + #MPI STUFF # library/mpi/mpi.c library/mpi/mpe.c # library/lammpi/yap_mpi.c library/lammpi/hash.c library/lammpi/prologterms2c.c diff --git a/packages/ProbLog/CMakeLists.txt b/packages/ProbLog/CMakeLists.txt index 1a5e419fb..0a397543c 100644 --- a/packages/ProbLog/CMakeLists.txt +++ b/packages/ProbLog/CMakeLists.txt @@ -5,7 +5,6 @@ set (PROGRAMS dtproblog.yap aproblog.yap problog_learning.yap - problog_lbfgs.yap problog_learning_lbdd.yap ) diff --git a/packages/ProbLog/problog.yap b/packages/ProbLog/problog.yap index bc20ad8b4..199b6e752 100644 --- a/packages/ProbLog/problog.yap +++ b/packages/ProbLog/problog.yap @@ -2453,8 +2453,8 @@ uses local dynamic predicates max_probability/1 and max_proof/1 problog_max(Goal, Prob, Facts) :- problog_flag(first_threshold,InitT), init_problog_max(InitT), - problog_control(off,up), - problog_max_id(Goal, Prob, FactIDs),theo todo + problog_control(off,up), % + problog_max_id(Goal, Prob, FactIDs), %theo todo ( FactIDs = [_|_] -> get_fact_list(FactIDs, Facts); Facts = FactIDs). From bfe5fc2f490db9568db9b2be248e178f26003ab9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 24 Jan 2019 19:08:10 +0000 Subject: [PATCH 011/101] tests on infinite terms. --- regression/cyclics.yap | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 regression/cyclics.yap diff --git a/regression/cyclics.yap b/regression/cyclics.yap new file mode 100644 index 000000000..af86be0d2 --- /dev/null +++ b/regression/cyclics.yap @@ -0,0 +1,7 @@ +:- X = [X], copy_term(X,Y), writeln(X), writeln(Y), fail. +:- X = [_|X], copy_term(X,Y), writeln(X), writeln(Y), fail. +:- X= f(X), copy_term(X,Y), writeln(X), writeln(Y), fail. +:- X= f(X,X), copy_term(X,Y), writeln(X), writeln(Y), fail. +:- X= f(_,X), copy_term(X,Y), writeln(X), writeln(Y), fail. +:- X= f(X,[X,X]), copy_term(X,Y), writeln(X), writeln(Y), fail. +:- X= f(X,[X,g(X)]), copy_term(X,Y), writeln(X), writeln(Y), fail. From 650653cc64753c6698a17ab991dbac41bc7c8a38 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 25 Jan 2019 08:57:13 +0000 Subject: [PATCH 012/101] fixes --- C/utilpreds.c | 26 +++++---- C/write.c | 121 +++++++++++++++++++++++++---------------- regression/cyclics.yap | 18 +++--- 3 files changed, 100 insertions(+), 65 deletions(-) diff --git a/C/utilpreds.c b/C/utilpreds.c index 6f0afc98d..4c424d928 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -60,6 +60,7 @@ typedef struct non_single_struct_t { pt0 = ptd0; \ *ptd0 = TermFreeTerm; \ pt0_end = pt0 + 1; \ + if (pt0 <= pt0_end) \ goto list_loop; \ } else if (IsApplTerm(d0)) { \ register Functor f; \ @@ -293,7 +294,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, if (HR > ASP - MIN_ARENA_SIZE) { goto overflow; } - ptd0 = pt0; goto deref; } else if (IsApplTerm(d0)) { Functor f; @@ -337,7 +337,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, } *ptf = AbsAppl(HR); ptf++; - ptf = HR; if (IsExtensionFunctor(f)) { switch ((CELL)f) { @@ -415,15 +414,16 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, TrailedMaBind(ptf,AbsAppl(HR)); } ptf = HR; - ptf[-1] = (CELL)f; + ptf[0] = (CELL)f; ground = true; arity_t a = ArityOfFunctor(f); - HR = ptf+a; - if (HR > ASP - MIN_ARENA_SIZE) { + if (HR > ASP - MIN_ARENA_SIZE) { goto overflow; } - pt0 = headp; - pt0_end = headp+a; + ptf++; + HR = ptf+a; + pt0_end = headp+(a); + pt0 = headp; ground = (f != FunctorMutable); } else { /* just copy atoms or integers */ @@ -436,10 +436,10 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, ground = false; /* don't need to copy variables if we want to share the global term */ if (//(share && ptd0 < HB && ptd0 > H0) || - (ptd0 >= HLow && ptd0 < HR)) { + (ptd0 >= HB && ptd0 < HR)) { /* we have already found this cell */ *ptf++ = (CELL)ptd0; - } else { + } else if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { /* if unbound, call the standard copy term routine */ struct cp_frame *bp; @@ -463,12 +463,12 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, } else { /* first time we met this term */ RESET_VARIABLE(ptf); - if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) + if ((ADDR)TR > LOCAL_TrailTop - 16) goto trail_overflow; DO_TRAIL(ptd0, (CELL)ptf); *ptd0 = (CELL)ptf; ptf++; - } + continue; } } @@ -2069,7 +2069,7 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */ Term t = Deref(ARG1); if (IsVarTerm(t)) { out = attvars_in_complex_term(VarOfTerm(t)-1, - VarOfTerm(t)+1, TermNil PASS_REGS); + VarOfTerm(t), TermNil PASS_REGS); } else if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); } else if (IsPairTerm(t)) { @@ -2080,9 +2080,11 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */ Functor f = FunctorOfTerm(t); if (IsExtensionFunctor(f)) return Yap_unify(TermNil, ARG2); + RepAppl(t)[0] = TermNil; out = attvars_in_complex_term(RepAppl(t), RepAppl(t)+ ArityOfFunctor(f), TermNil PASS_REGS); + RepAppl(t)[0] = (CELL)f; } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) diff --git a/C/write.c b/C/write.c index c549c7b82..d61217857 100644 --- a/C/write.c +++ b/C/write.c @@ -77,7 +77,8 @@ typedef struct write_globs { int last_atom_minus; UInt MaxDepth, MaxArgs; wtype lw; - int sl0; + yhandle_t sl0, sl; + bool protectedEntry; } wglbs; #define lastw wglb->lw @@ -101,22 +102,9 @@ static bool callPortray(Term t, int sno USES_REGS) { return false; } -#define PROTECT(t, F) \ - { \ - yhandle_t yt = Yap_InitHandle(t); \ - if (wglb->Write_Loops) { \ - yhandle_t i; \ - for (i = yt - 1; i >= wglb->sl0; i--) { \ - if (Yap_GetFromHandle(i) == t) { \ - char buf[63]; \ - snprintf(buf, 63, " @{ ^^%ld } ", yt - i); \ - wrputs(buf, wglb->stream); \ - return; \ - } \ - } \ - } \ - F; \ - t = Yap_PopHandle(yt); \ +#define PROTECT(t, F) \ + { \ + F; \ } static void wrputn(Int, struct write_globs *); static void wrputf(Float, struct write_globs *); @@ -129,6 +117,9 @@ static void putAtom(Atom, int, struct write_globs *); static void writeTerm(Term, int, int, int, struct write_globs *, struct rewind_term *); +static void write_list(Term t, int direction, int depth, + struct write_globs *wglb, struct rewind_term *rwt); + #define wrputc(WF, X) \ (X)->stream_wputc(X - GLOBAL_Stream, WF) /* writes a character */ @@ -279,7 +270,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg, return; } else if (big_tag == BIG_RATIONAL) { Term trat = Yap_RatTermToApplTerm(t); - PROTECT(t,writeTerm(trat, p, depth, rinfixarg, wglb, rwt)); + writeTerm(trat, p, depth, rinfixarg, wglb, rwt); return; #endif } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) { @@ -393,8 +384,7 @@ int Yap_FormatFloat(Float f, char **s, size_t sz) { struct write_globs wglb; int sno; - sno = Yap_open_buf_write_stream(GLOBAL_Stream[LOCAL_c_output_stream].encoding, - 0); + sno = Yap_open_buf_write_stream(GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); if (sno < 0) return false; wglb.lw = separator; @@ -713,11 +703,11 @@ static void write_var(CELL *t, struct write_globs *wglb, wrputs("$AT(", wglb->stream); write_var(t, wglb, rwt); wrputc(',', wglb->stream); - PROTECT(*l, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); + PROTECT(*t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); attv = RepAttVar(t); wrputc(',', wglb->stream); l++; - PROTECT(*l, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); + writeTerm(*l, 999, 1, FALSE, wglb, &nrwt); wrclose_bracket(wglb, TRUE); } wglb->Portray_delays = TRUE; @@ -730,13 +720,32 @@ static void write_var(CELL *t, struct write_globs *wglb, } } -static void write_list(Term t, int direction, int depth, +static bool check_for_loops(Term t, struct write_globs *wglb) +{ + yhandle_t i, sl = wglb->sl; + if ((wglb->Write_Loops)) { + return false; + } + for (i=sl-1; i>wglb->sl0;i--) { + if (Yap_GetFromHandle(i) == t) { + char buf[64]; + snprintf(buf,63," @{ ^^%ld } " ,sl-i); + wrputs(buf, wglb->stream); + return true; + } + } + return false; +} + + +static void write_list__(Term t, yhandle_t sl, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt) { Term ti; struct rewind_term nrwt; nrwt.parent = rwt; nrwt.u_sd.s.ptr = 0; + while (1) { int ndirection; int do_jump; @@ -751,12 +760,12 @@ static void write_list(Term t, int direction, int depth, /* make sure we're not trapped in loops */ if (ndirection > 0) { do_jump = (direction <= 0); - } else if (ndirection == 0) { + } /*else if (ndirection == 0) { wrputc(',', wglb->stream); putAtom(AtomFoundVar, wglb->Quote_illegal, wglb); lastw = separator; return; - } else { + } */ else { do_jump = (direction >= 0); } if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { @@ -779,27 +788,34 @@ static void write_list(Term t, int direction, int depth, /* we found an infinite loop */ /* keep going on the list */ wrputc(',', wglb->stream); - PROTECT(t,write_list(ti, direction, depth, wglb, &nrwt)); + write_list(ti, direction, depth, wglb, &nrwt); } else if (ti != MkAtomTerm(AtomNil)) { if (lastw == symbol || lastw == separator) { wrputc(' ', wglb->stream); } wrputc('|', wglb->stream); lastw = separator; - PROTECT(ti,writeTerm(ti, 999, depth, FALSE, wglb, &nrwt)); + writeTerm(ti, 999, depth, FALSE, wglb, &nrwt); } } -static void writeTerm(Term t, int p, int depth, int rinfixarg, - struct write_globs *wglb, struct rewind_term *rwt) +static void write_list(Term t, int direction, int depth, + struct write_globs *wglb, struct rewind_term *rwt) { + if (check_for_loops(t,wglb)) return; + yhandle_t sl = wglb->sl = Yap_InitHandle(t); + write_list__(t, sl, direction, depth, + wglb, rwt); + Yap_PopHandle(sl); +} + + +static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, + struct write_globs *wglb, struct rewind_term *rwt) /* term to write */ /* context priority */ { CACHE_REGS - struct rewind_term nrwt; - nrwt.parent = rwt; - nrwt.u_sd.s.ptr = 0; - + struct rewind_term nrwt; if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { putAtom(Atom3Dots, wglb->Quote_illegal, wglb); return; @@ -819,7 +835,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); wrputs(",", wglb->stream); - PROTECT(t, writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); + writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt); wrclose_bracket(wglb, TRUE); return; } @@ -885,7 +901,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, *p++; lastw = separator; /* cannot use the term directly with the SBA */ - PROTECT(t, writeTerm(*p, 999, depth + 1, FALSE, wglb, &nrwt)); + writeTerm(*p, 999, depth + 1, FALSE, wglb, &nrwt); if (*p) wrputc(',', wglb->stream); argno++; @@ -913,7 +929,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, } else if (atom == AtomMinus) { last_minus = TRUE; } - PROTECT(t,writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt)); + writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt); if (bracket_right) { wrclose_bracket(wglb, TRUE); } @@ -946,7 +962,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, if (bracket_left) { wropen_bracket(wglb, TRUE); } - PROTECT(t,writeTerm(ArgOfTerm(offset, t), lp, depth + 1, rinfixarg, wglb, &nrwt)); + writeTerm(ArgOfTerm(offset, t), lp, depth + 1, rinfixarg, wglb, &nrwt); if (bracket_left) { wrclose_bracket(wglb, TRUE); } @@ -1011,7 +1027,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, if (bracket_right) { wropen_bracket(wglb, TRUE); } - PROTECT(t,writeTerm(ArgOfTerm(2, t), rp, depth + 1, TRUE, wglb, &nrwt)); + writeTerm(ArgOfTerm(2, t), rp, depth + 1, TRUE, wglb, &nrwt); if (bracket_right) { wrclose_bracket(wglb, TRUE); } @@ -1051,14 +1067,14 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, } else { wrputs("'$VAR'(", wglb->stream); lastw = separator; - PROTECT(t,writeTerm(ArgOfTerm(1, t), 999, depth + 1, FALSE, wglb, &nrwt)); + writeTerm(ArgOfTerm(1, t), 999, depth + 1, FALSE, wglb, &nrwt); wrclose_bracket(wglb, TRUE); } } else if (!wglb->Ignore_ops && functor == FunctorBraces) { wrputc('{', wglb->stream); lastw = separator; - PROTECT(t,writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb, - &nrwt)); + writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb, + &nrwt); wrputc('}', wglb->stream); lastw = separator; } else if (atom == AtomArray) { @@ -1069,7 +1085,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, wrputs("...", wglb->stream); break; } - PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt)); + writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt); if (op != Arity) { PROTECT(t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt)); @@ -1077,7 +1093,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, lastw = separator; } } - PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt)); + writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt); wrputc('}', wglb->stream); lastw = separator; } else { @@ -1096,12 +1112,22 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, wrputc(',', wglb->stream); lastw = separator; } - PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt)); + writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt); wrclose_bracket(wglb, TRUE); } } } +static void writeTerm(Term t, int p, int depth, int rinfixarg, + struct write_globs *wglb, struct rewind_term *rwt) +{ + if (check_for_loops(t,wglb)) return; + yhandle_t sl = wglb->sl = Yap_InitHandle(t); + writeTerm__(t, sl, p, depth, rinfixarg, + wglb, rwt); + Yap_PopHandle(sl); +} + void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int priority) /* term to be written */ @@ -1114,7 +1140,6 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, yhandle_t sls = Yap_CurrentSlot(); int lvl = push_text_stack(); - wglb.sl0 = sls; if (t == 0) return; if (!mywrite) { @@ -1137,7 +1162,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, rwt.parent = NULL; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; - wglb.Write_Loops = !(flags &Ignore_cyclics_f); + wglb.Write_Loops = flags & YAP_WRITE_HANDLE_CYCLES; if (!(flags & Ignore_cyclics_f) && false) { Term ts[2]; ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS); @@ -1149,7 +1174,11 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, } } /* protect slots for portray */ + yhandle_t sl; + wglb.sl0 = (sl = wglb.sl = Yap_InitHandle(t)) -1; + wglb.protectedEntry = false; \ writeTerm(t, priority, 1, FALSE, &wglb, &rwt); + t = Yap_PopHandle(sl); \ if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); diff --git a/regression/cyclics.yap b/regression/cyclics.yap index af86be0d2..de0981bf7 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -1,7 +1,11 @@ -:- X = [X], copy_term(X,Y), writeln(X), writeln(Y), fail. -:- X = [_|X], copy_term(X,Y), writeln(X), writeln(Y), fail. -:- X= f(X), copy_term(X,Y), writeln(X), writeln(Y), fail. -:- X= f(X,X), copy_term(X,Y), writeln(X), writeln(Y), fail. -:- X= f(_,X), copy_term(X,Y), writeln(X), writeln(Y), fail. -:- X= f(X,[X,X]), copy_term(X,Y), writeln(X), writeln(Y), fail. -:- X= f(X,[X,g(X)]), copy_term(X,Y), writeln(X), writeln(Y), fail. +:- X = [], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X = [_A], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X = [a,A], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X = [X], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X = [_|X], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X= f(X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X= f(X,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X= f(_,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X= f(X,[X,X]), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X= f(X,[X,g(X)]), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X=f(_,X/[X]),copy_term(X,Y), writeln('....'),writeln(X),writeln(Y). \ No newline at end of file From 700d6ae707013dd73c9825fd316ae9e83220b60d Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 25 Jan 2019 13:54:02 +0000 Subject: [PATCH 013/101] fixes --- C/globals.c | 121 ++---------------- C/utilpreds.c | 269 +++++++++-------------------------------- C/write.c | 17 ++- regression/cyclics.yap | 4 +- 4 files changed, 77 insertions(+), 334 deletions(-) diff --git a/C/globals.c b/C/globals.c index 6d6e06d16..56aa0a41e 100644 --- a/C/globals.c +++ b/C/globals.c @@ -331,27 +331,6 @@ static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, ASP = oldASP; } -static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { - if (TR != TR0) { - tr_fr_ptr pt = TR0; - - do { - Term p = TrailTerm(pt++); - if (IsVarTerm(p)) { - RESET_VARIABLE(p); - } else { - - /* copy downwards */ - TrailTerm(TR0 + 1) = TrailTerm(pt); - TrailTerm(TR0) = TrailTerm(TR0 + 2) = p; - pt += 2; - TR0 += 3; - } - } while (pt != TR); - TR = TR0; - } -} - static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, UInt arity, Term *newarena, size_t min_grow USES_REGS) { @@ -394,106 +373,20 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, return tn; } else if (IsAtomOrIntTerm(t)) { return t; - } else if (IsPairTerm(t)) { - Term tf; - CELL *ap; + } else { CELL *Hi; - if (share && ArenaPt(arena) > RepPair(t)) { - return t; - } + Hi = HR; + HR++; + oldH = HR; HR = HB = ArenaPt(arena); ASP = ArenaLimit(arena); - ap = RepPair(t); - Hi = HR; - tf = AbsPair(HR); - HR += 2; - if ((res = Yap_copy_complex_term(ap - 1, ap + 1, share, NULL, copy_att_vars, Hi, - Hi PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(&t - 1, &t, share, NULL, copy_att_vars, Hi, + HR PASS_REGS)) < 0) { goto error_handler; } CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); - return tf; - } else { - Functor f; - Term tf; - CELL *HB0; - CELL *ap; - - if (share && ArenaPt(arena) > RepAppl(t)) { - return t; - } - HR = HB = ArenaPt(arena); - ASP = ArenaLimit(arena); - f = FunctorOfTerm(t); - HB0 = HR; - ap = RepAppl(t); - tf = AbsAppl(HR); - HR[0] = (CELL)f; - if (IsExtensionFunctor(f)) { - switch ((CELL)f) { - case (CELL) FunctorDBRef: - CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); - return t; - case (CELL) FunctorLongInt: - if (HR > ASP - (MIN_ARENA_SIZE + 3)) { - res = -1; - goto error_handler; - } - HR[1] = ap[1]; - HR[2] = EndSpecials; - HR += 3; - break; - case (CELL) FunctorDouble: - if (HR > ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { - res = -1; - goto error_handler; - } - HR[1] = ap[1]; -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - HR[2] = ap[2]; - HR[3] = EndSpecials; - HR += 4; -#else - HR[2] = EndSpecials; - HR += 3; -#endif - break; - case (CELL) FunctorString: - if (HR > ASP - (MIN_ARENA_SIZE + 3 + ap[1])) { - res = -1; - goto error_handler; - } - memmove(HR, ap, sizeof(CELL) * (3 + ap[1])); - HR += ap[1] + 3; - break; - default: { - UInt sz = ArenaSz(t), i; - - if (HR > ASP - (MIN_ARENA_SIZE + sz)) { - res = -1; - goto error_handler; - } - for (i = 1; i < sz; i++) { - HR[i] = ap[i]; - } - HR += sz; - } - } - } else { - HR += 1 + ArityOfFunctor(f); - if (HR > ASP - MIN_ARENA_SIZE) { - res = -1; - goto error_handler; - } - if ((res = Yap_copy_complex_term(ap, ap + ArityOfFunctor(f), share, - NULL, copy_att_vars, HB0 + 1, HB0 PASS_REGS)) < - 0) { - goto error_handler; - } - } - CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); - return tf; + return Hi[0]; } error_handler: HR = HB; diff --git a/C/utilpreds.c b/C/utilpreds.c index 4c424d928..938aa8ca3 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -265,7 +265,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, continue; } *ptf = AbsPair(HR); - ptf++; if (to_visit >= to_visit_max-32) { expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); } @@ -273,7 +272,7 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, to_visit->end_cp = pt0_end; to_visit->to = ptf; to_visit->curp = headp; - to_visit->oldv = head; + d0 = to_visit->oldv = head; to_visit->ground = ground; to_visit++; // move to new list @@ -468,7 +467,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, DO_TRAIL(ptd0, (CELL)ptf); *ptd0 = (CELL)ptf; ptf++; - continue; } } @@ -566,85 +564,27 @@ static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; - - if (IsVarTerm(t)) { -#if COROUTINING - if (newattvs && IsAttachedTerm(t)) { - CELL *Hi; - int res; - restart_attached: - - *HR = t; - Hi = HR+1; - HR += 2; - if ((res = Yap_copy_complex_term(Hi-2, Hi-1, share, NULL, newattvs, Hi, Hi PASS_REGS)) < 0) { - HR = Hi-1; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_attached; - } - return Hi[0]; - } -#endif - return MkVarTerm(); - } else if (IsPrimitiveTerm(t)) { - return t; - } else if (IsPairTerm(t)) { - Term tf; - CELL *ap; CELL *Hi; - restart_list: - ap = RepPair(t); + if (IsPrimitiveTerm(t)) { + return t; + } + while( true ) { + int res; Hi = HR; - tf = AbsPair(HR); - HR += 2; - { - int res; - if ((res = Yap_copy_complex_term(ap-1, ap+1, share, NULL, newattvs, Hi, Hi PASS_REGS)) < 0) { + HR ++; + + if ((res = Yap_copy_complex_term((&t)-1, &t, share, NULL, newattvs, Hi, HR PASS_REGS)) < 0) { HR = Hi; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; - goto restart_list; } else if (res && share) { HR = Hi; return t; } + return Hi[0]; } - return tf; - } else { - Functor f = FunctorOfTerm(t); - Term tf; - CELL *HB0; - CELL *ap; - - restart_appl: - f = FunctorOfTerm(t); - HB0 = HR; - ap = RepAppl(t); - tf = AbsAppl(HR); - HR[0] = (CELL)f; - HR += 1+ArityOfFunctor(f); - if (HR > ASP-128) { - HR = HB0; - if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L) - return FALSE; - goto restart_appl; - } else { - int res; - - if ((res = Yap_copy_complex_term(ap, ap+ArityOfFunctor(f), share, NULL, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { - HR = HB0; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_appl; - } else if (res && share && FunctorOfTerm(t) != FunctorMutable) { - HR = HB0; - return t; - } - } - return tf; - } + return 0; } Term @@ -1866,25 +1806,9 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ } do { Term t = Deref(ARG1); - if (IsVarTerm(t)) { - out = AbsPair(HR); - HR += 2; - RESET_VARIABLE(HR-2); - RESET_VARIABLE(HR-1); - Yap_unify((CELL)(HR-2),ARG1); - Yap_unify((CELL)(HR-1),ARG2); - } else if (IsPrimitiveTerm(t)) - out = ARG2; - else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, ARG2 PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), ARG2 PASS_REGS); - } + out = vars_in_complex_term(&(t)-1, + &(t), + ARG2 PASS_REGS); if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) return FALSE; @@ -1898,6 +1822,7 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ static Int p_term_variables( USES_REGS1 ) /* variables in term t */ { + Term t = Deref(ARG1); Term out; if (!Yap_IsListOrPartialListTerm(ARG2)) { @@ -1905,30 +1830,16 @@ p_term_variables( USES_REGS1 ) /* variables in term t */ return FALSE; } - do { - Term t = Deref(ARG1); - if (IsVarTerm(t)) { - Term out = Yap_MkNewPairTerm(); - return - Yap_unify(t,HeadOfTerm(out)) && - Yap_unify(TermNil, TailOfTerm(out)) && - Yap_unify(out, ARG2); - } else if (IsPrimitiveTerm(t)) { + if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); - } else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); - } - if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; - } + } + do { + out = vars_in_complex_term(&(t)-1, + &(t), TermNil PASS_REGS); + if (out == 0L) { + if (!expand_vts( 3 PASS_REGS )) + return FALSE; + } } while (out == 0L); return Yap_unify(ARG2,out); } @@ -1948,17 +1859,11 @@ Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ t = Deref(t); if (IsVarTerm(t)) { return MkPairTerm(t, TermNil); - } else if (IsPrimitiveTerm(t)) { + } else if (IsPrimitiveTerm(t)) { return TermNil; - } else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); + } else { + out = vars_in_complex_term(&(t)-1, + &(t), TermNil PASS_REGS); } if (out == 0L) { if (!expand_vts( arity PASS_REGS )) @@ -2067,29 +1972,15 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */ do { Term t = Deref(ARG1); - if (IsVarTerm(t)) { - out = attvars_in_complex_term(VarOfTerm(t)-1, - VarOfTerm(t), TermNil PASS_REGS); - } else if (IsPrimitiveTerm(t)) { - return Yap_unify(TermNil, ARG2); - } else if (IsPairTerm(t)) { - out = attvars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - if (IsExtensionFunctor(f)) - return Yap_unify(TermNil, ARG2); - RepAppl(t)[0] = TermNil; - out = attvars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); - RepAppl(t)[0] = (CELL)f; - } - if (out == 0L) { + if (IsPrimitiveTerm(t)) { + return Yap_unify(TermNil, ARG2); + } + out = attvars_in_complex_term(&(t)-1, + &(t), TermNil PASS_REGS); + if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) - return FALSE; - } + return false; + } } while (out == 0L); return Yap_unify(ARG2,out); } @@ -2109,15 +2000,9 @@ p_term_variables3( USES_REGS1 ) /* variables in term t */ Yap_unify(out, ARG2); } else if (IsPrimitiveTerm(t)) { return Yap_unify(ARG2, ARG3); - } else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, ARG3 PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), ARG3 PASS_REGS); + } else { + out = vars_in_complex_term(&(t)-1, + &(t), ARG3 PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) @@ -2217,21 +2102,11 @@ p_variables_within_term( USES_REGS1 ) /* variables within term t */ do { Term t = Deref(ARG2); - if (IsVarTerm(t)) { - out = vars_within_complex_term(VarOfTerm(t)-1, - VarOfTerm(t), Deref(ARG1) PASS_REGS); - - } else if (IsPrimitiveTerm(t)) + if (IsPrimitiveTerm(t)) out = TermNil; - else if (IsPairTerm(t)) { - out = vars_within_complex_term(RepPair(t)-1, - RepPair(t)+1, Deref(ARG1) PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = vars_within_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), Deref(ARG1) PASS_REGS); + else { + out = vars_within_complex_term(&(t)-1, + &(t), Deref(ARG1) PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) @@ -2335,21 +2210,11 @@ p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ do { Term t = Deref(ARG2); - if (IsVarTerm(t)) { - out = new_vars_in_complex_term(VarOfTerm(t)-1, - VarOfTerm(t), Deref(ARG1) PASS_REGS); - - } else if (IsPrimitiveTerm(t)) + if (IsPrimitiveTerm(t)) out = TermNil; - else if (IsPairTerm(t)) { - out = new_vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, Deref(ARG1) PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = new_vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), Deref(ARG1) PASS_REGS); + else { + out = new_vars_in_complex_term(&(t)-1, + &(t), Deref(ARG1) PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) @@ -2592,21 +2457,11 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ } t = ArgOfTerm(2,t); } - if (IsVarTerm(t)) { - out = free_vars_in_complex_term(VarOfTerm(t)-1, - VarOfTerm(t), TR0 PASS_REGS); - - } else if (IsPrimitiveTerm(t)) + if (IsPrimitiveTerm(t)) out = TermNil; - else if (IsPairTerm(t)) { - out = free_vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TR0 PASS_REGS); - } else { - Functor f = FunctorOfTerm(t); - out = free_vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TR0 PASS_REGS); + out = free_vars_in_complex_term(&(t)-1, + &(t), TR0 PASS_REGS); } if (out == 0L) { trail_overflow: @@ -2705,13 +2560,9 @@ p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ out = ARG2; } else if (IsPrimitiveTerm(t)) { out = ARG2; - } else if (IsPairTerm(t)) { - out = non_singletons_in_complex_term(RepPair(t)-1, - RepPair(t)+1 PASS_REGS); } else { - out = non_singletons_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(FunctorOfTerm(t)) PASS_REGS); + out = non_singletons_in_complex_term(&(t)-1, + &(t) PASS_REGS); } if (out != 0L) { return Yap_unify(ARG3,out); @@ -2785,22 +2636,11 @@ bool Yap_IsGroundTerm(Term t) return FALSE; } else if (IsPrimitiveTerm(t)) { return TRUE; - } else if (IsPairTerm(t)) { - if ((out =ground_complex_term(RepPair(t)-1, - RepPair(t)+1 PASS_REGS)) >= 0) { - return out != 0; - } } else { - Functor fun = FunctorOfTerm(t); - - if (IsExtensionFunctor(fun)) - return TRUE; - else if ((out = ground_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(fun) PASS_REGS)) >= 0) { + if ((out =ground_complex_term(&(t)-1, + &(t) PASS_REGS)) >= 0) { return out != 0; } - } if (out < 0) { *HR++ = t; if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { @@ -2810,6 +2650,7 @@ bool Yap_IsGroundTerm(Term t) t = *--HR; } } + } } static Int diff --git a/C/write.c b/C/write.c index d61217857..4849bbf24 100644 --- a/C/write.c +++ b/C/write.c @@ -105,6 +105,7 @@ static bool callPortray(Term t, int sno USES_REGS) { #define PROTECT(t, F) \ { \ F; \ + t = Yap_GetFromSlot(wglb->sl); \ } static void wrputn(Int, struct write_globs *); static void wrputf(Float, struct write_globs *); @@ -703,7 +704,9 @@ static void write_var(CELL *t, struct write_globs *wglb, wrputs("$AT(", wglb->stream); write_var(t, wglb, rwt); wrputc(',', wglb->stream); - PROTECT(*t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); + CELL tt = (CELL)t; + PROTECT(tt, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); + t = (CELL *)tt; attv = RepAttVar(t); wrputc(',', wglb->stream); l++; @@ -756,6 +759,8 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth, break; if (!IsPairTerm(ti)) break; + if (check_for_loops(ti,wglb)) return; + wglb->sl = Yap_InitHandle(ti); ndirection = RepPair(ti) - RepPair(t); /* make sure we're not trapped in loops */ if (ndirection > 0) { @@ -806,6 +811,7 @@ static void write_list(Term t, int direction, int depth, write_list__(t, sl, direction, depth, wglb, rwt); Yap_PopHandle(sl); + wglb->sl = sl-1; } @@ -849,7 +855,7 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, wrputc('[', wglb->stream); lastw = separator; /* we assume t was already saved in the stack */ - write_list(t, 0, depth, wglb, rwt); + write_list__(t, wglb->sl, 0, depth, wglb, rwt); wrputc(']', wglb->stream); lastw = separator; } @@ -1125,7 +1131,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, yhandle_t sl = wglb->sl = Yap_InitHandle(t); writeTerm__(t, sl, p, depth, rinfixarg, wglb, rwt); - Yap_PopHandle(sl); + Yap_PopHandle(sl); + wglb->sl = sl-1; } void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, @@ -1176,9 +1183,9 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, /* protect slots for portray */ yhandle_t sl; wglb.sl0 = (sl = wglb.sl = Yap_InitHandle(t)) -1; - wglb.protectedEntry = false; \ + wglb.protectedEntry = false; writeTerm(t, priority, 1, FALSE, &wglb, &rwt); - t = Yap_PopHandle(sl); \ + t = Yap_PopHandle(sl); if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); diff --git a/regression/cyclics.yap b/regression/cyclics.yap index de0981bf7..cc04e8eb2 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -1,11 +1,13 @@ :- X = [], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). :- X = [_A], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X = [a,A], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X = [a,_A], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). :- X = [X], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). :- X = [_|X], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). :- X= f(X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). :- X= f(X,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). :- X= f(_,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X= f(A,A,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). +:- X= f(A,g(X,[A|A]),X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). :- X= f(X,[X,X]), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). :- X= f(X,[X,g(X)]), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). :- X=f(_,X/[X]),copy_term(X,Y), writeln('....'),writeln(X),writeln(Y). \ No newline at end of file From b395177faaef6cf7e528a9cdd32396537263f963 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sat, 26 Jan 2019 12:44:43 +0000 Subject: [PATCH 014/101] fixes --- C/utilpreds.c | 54 ++++++++++++++------------------------------------- 1 file changed, 15 insertions(+), 39 deletions(-) diff --git a/C/utilpreds.c b/C/utilpreds.c index 4c424d928..77251f1b1 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -69,7 +69,8 @@ typedef struct non_single_struct_t { ap2 = RepAppl(d0); \ f = (Functor)(*ap2); \ \ - if (IsExtensionFunctor(f)) { \ + if (IsExtensionFunctor(f) || \ + IsAtomTerm((CELL)f)) { \ \ continue; \ } \ @@ -1746,12 +1747,14 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter register CELL d0; register CELL *ptd0; restart: + ++ pt0; ptd0 = pt0; d0 = *ptd0; list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: + WALK_COMPLEX_TERM(); continue ; @@ -1785,6 +1788,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter goto loop; } + clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); @@ -1876,8 +1880,8 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ } else if (IsPrimitiveTerm(t)) out = ARG2; else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, ARG2 PASS_REGS); + out = vars_in_complex_term(&t-1, + &(t), ARG2 PASS_REGS); } else { Functor f = FunctorOfTerm(t); @@ -1907,24 +1911,9 @@ p_term_variables( USES_REGS1 ) /* variables in term t */ do { Term t = Deref(ARG1); - if (IsVarTerm(t)) { - Term out = Yap_MkNewPairTerm(); - return - Yap_unify(t,HeadOfTerm(out)) && - Yap_unify(TermNil, TailOfTerm(out)) && - Yap_unify(out, ARG2); - } else if (IsPrimitiveTerm(t)) { - return Yap_unify(TermNil, ARG2); - } else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); - } + + out = vars_in_complex_term(&(t)-1, + &(t), TermNil PASS_REGS); if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) return FALSE; @@ -2023,8 +2012,8 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, to_visit->ptd0 = ptd0; to_visit ++; *ptd0 = TermNil; - pt0 = ptd0; pt0_end = &RepAttVar(ptd0)->Atts; + pt0 = pt0_end-1; } } /* Do we still have compound terms to visit */ @@ -2067,24 +2056,11 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */ do { Term t = Deref(ARG1); - if (IsVarTerm(t)) { - out = attvars_in_complex_term(VarOfTerm(t)-1, - VarOfTerm(t), TermNil PASS_REGS); - } else if (IsPrimitiveTerm(t)) { + if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); - } else if (IsPairTerm(t)) { - out = attvars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - if (IsExtensionFunctor(f)) - return Yap_unify(TermNil, ARG2); - RepAppl(t)[0] = TermNil; - out = attvars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); - RepAppl(t)[0] = (CELL)f; + } else { + out = attvars_in_complex_term(&(t)-1, + &(t), TermNil PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) From 13d764067f2c2d5fa030de69d03bb6fe6ad714db Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 27 Jan 2019 10:11:56 +0000 Subject: [PATCH 015/101] write --- C/c_interface.c | 8 ++++---- C/utilpreds.c | 12 ++++++------ C/write.c | 8 +++++--- pl/top.yap | 7 ++++--- pl/undefined.yap | 29 ++++++++++++++++++----------- 5 files changed, 37 insertions(+), 27 deletions(-) diff --git a/C/c_interface.c b/C/c_interface.c index 756abb7af..7cded6b1f 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -2109,7 +2109,9 @@ X_API void YAP_ClearExceptions(void) { X_API int YAP_InitConsult(int mode, const char *fname, char **full, int *osnop) { CACHE_REGS - int sno; + +int sno; +int lvl = push_text_stack(); BACKUP_MACHINE_REGS(); const char *fl = NULL; if (mode == YAP_BOOT_MODE) { @@ -2126,8 +2128,6 @@ X_API int YAP_InitConsult(int mode, const char *fname, char **full, } __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "done init_ consult %s ",fl); - -int lvl = push_text_stack(); char *d = Malloc(strlen(fl) + 1); strcpy(d, fl); bool consulted = (mode == YAP_CONSULT_MODE); @@ -2136,9 +2136,9 @@ int lvl = push_text_stack(); LOCAL_encoding); __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "OpenStream got %d ",sno); - pop_text_stack(lvl); if (sno < 0 || !Yap_ChDir(dirname((char *)d))) { *full = NULL; + pop_text_stack(lvl); return -1; } LOCAL_PrologMode = UserMode; diff --git a/C/utilpreds.c b/C/utilpreds.c index a9f704316..2067b0ea4 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -439,7 +439,7 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, (ptd0 >= HB && ptd0 < HR)) { /* we have already found this cell */ *ptf++ = (CELL)ptd0; - } else + } else if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { /* if unbound, call the standard copy term routine */ struct cp_frame *bp; @@ -458,16 +458,16 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, goto trail_overflow; } } - TrailedMaBind(ptd0, new); - ptf++; - } else { + + } else { /* first time we met this term */ RESET_VARIABLE(ptf); - if ((ADDR)TR > LOCAL_TrailTop - 16) - goto trail_overflow; DO_TRAIL(ptd0, (CELL)ptf); *ptd0 = (CELL)ptf; ptf++; + if ((ADDR)TR > LOCAL_TrailTop - 16) + goto trail_overflow; + } } diff --git a/C/write.c b/C/write.c index 4849bbf24..f4be86371 100644 --- a/C/write.c +++ b/C/write.c @@ -117,6 +117,8 @@ static wtype AtomIsSymbols(unsigned char *); static void putAtom(Atom, int, struct write_globs *); static void writeTerm(Term, int, int, int, struct write_globs *, struct rewind_term *); +static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, + struct write_globs *wglb, struct rewind_term *rwt); static void write_list(Term t, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt); @@ -760,7 +762,7 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth, if (!IsPairTerm(ti)) break; if (check_for_loops(ti,wglb)) return; - wglb->sl = Yap_InitHandle(ti); + sl = wglb->sl = Yap_InitHandle(ti); ndirection = RepPair(ti) - RepPair(t); /* make sure we're not trapped in loops */ if (ndirection > 0) { @@ -793,14 +795,14 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth, /* we found an infinite loop */ /* keep going on the list */ wrputc(',', wglb->stream); - write_list(ti, direction, depth, wglb, &nrwt); + write_list__(ti, sl, direction, depth, wglb, &nrwt); } else if (ti != MkAtomTerm(AtomNil)) { if (lastw == symbol || lastw == separator) { wrputc(' ', wglb->stream); } wrputc('|', wglb->stream); lastw = separator; - writeTerm(ti, 999, depth, FALSE, wglb, &nrwt); + writeTerm__(ti, sl, 999, depth, FALSE, wglb, &nrwt); } } diff --git a/pl/top.yap b/pl/top.yap index 242fbc30f..c401d98a5 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -11,7 +11,8 @@ * [TOC] * * @{ - * \*/ + * + */ :- '$system_meta_predicates'([ gated_call(0,0,?,0), @@ -330,8 +331,8 @@ live :- '$process_answer'(Vs, LGs, Bindings) :- - '$purge_dontcares'(Vs,IVs), - '$sort'(IVs, NVs), + %'$purge_dontcares'(Vs,IVs), + '$sort'(Vs, NVs), '$prep_answer_var_by_var'(NVs, LAnsw, LGs), '$name_vars_in_goals'(LAnsw, Vs, Bindings). diff --git a/pl/undefined.yap b/pl/undefined.yap index 0041a7811..963a481a5 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -96,27 +96,25 @@ undefined_query(G0, M0, Cut) :- % undef handler '$undefp'([M0|G0],MG) :- % make sure we do not loop on undefined predicates - '$undef_setup'(Action,Debug,Current), - ('$get_undefined_predicates'(M0:G0, MG) + '$undef_setup'(M0:G0, Action,Debug,Current, MGI), + ('$get_undefined_predicates'(Current, MGI, MG ) , MG) -> true ; - '$undef_error'(M0:G0, MG) - ), + '$undef_error'(Current, M0:G0, MGI, MG) + , '$undef_cleanup'(Action,Debug,Current). -'$undef_error'(M0:G0, MG) :- +'$undef_error'(_, M0:G0, _, MG) :- '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), '$yap_strip_module'(M0:G0, EM0, GM0), user:unknown_predicate_handler(GM0,EM0,MG), !. -'$handle_error'(Mod:Goal,_) :- - functor(Goal,Name,Arity), - '$do_error'(existence_error(procedure,Name/Arity), Mod:Goal). -'$handle_error'(warning,Goal,Mod) :- - functor(Goal,Name,Arity), +'$handle_error'(error, Mod:Goal, I,_) :- + '$do_error'(existence_error(procedure,I), Mod:Goal). +'$handle_error'(warning,Mod:Goal,I,_) :- 'program_continuation'(PMod,PName,PAr), - print_message(warning,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))), + print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))), fail. '$handle_error'(fail,_Goal,_Mod) :- fail. @@ -126,6 +124,15 @@ undefined_query(G0, M0, Cut) :- yap_flag( debug, Debug, false), '$stop_creeping'(Current). +'$g2i'(user:G, Na/Ar ) :- + !, +functor(G, Na, Ar). +'$g2i'(prolog:G, Na/Ar ) :- + !, + functor(G, Na, Ar). +'$g2i'(M:G, M:Na/Ar ) :- + !, +functor(G, Na, Ar). '$undef_cleanup'(Action,Debug,_Current) :- yap_flag( unknown, _, Action), From 36fedfa321fab0a45e7c17fee4c0e5543671d6a2 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 27 Jan 2019 11:05:20 +0000 Subject: [PATCH 016/101] fixes --- C/cdmgr.c | 4 ++-- C/write.c | 15 ++++++--------- 2 files changed, 8 insertions(+), 11 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index f9f7cdcef..6610616c6 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2429,7 +2429,7 @@ static Int } /* @pred '$new_multifile'(+G,+Mod) - * declares rgi/////// the multi-file flag + * declares the multi-file flag * */ static Int new_multifile(USES_REGS1) { PredEntry *pe; @@ -2734,7 +2734,7 @@ static Int p_is_dynamic(USES_REGS1) { /* '$is_dynamic'(+P) */ return (out); } -/* @pred '$new_multifile'(+G,+Mod) +/* @pred '$new_meta'(+G,+Mod) * sets the multi-file flag * */ static Int new_meta_pred(USES_REGS1) { diff --git a/C/write.c b/C/write.c index f4be86371..d2c49ab89 100644 --- a/C/write.c +++ b/C/write.c @@ -273,7 +273,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg, return; } else if (big_tag == BIG_RATIONAL) { Term trat = Yap_RatTermToApplTerm(t); - writeTerm(trat, p, depth, rinfixarg, wglb, rwt); + writeTerm__(trat,wglb->sl, p, depth, rinfixarg, wglb, rwt); return; #endif } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) { @@ -762,7 +762,7 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth, if (!IsPairTerm(ti)) break; if (check_for_loops(ti,wglb)) return; - sl = wglb->sl = Yap_InitHandle(ti); + wglb->sl = Yap_InitHandle(ti); ndirection = RepPair(ti) - RepPair(t); /* make sure we're not trapped in loops */ if (ndirection > 0) { @@ -795,14 +795,14 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth, /* we found an infinite loop */ /* keep going on the list */ wrputc(',', wglb->stream); - write_list__(ti, sl, direction, depth, wglb, &nrwt); + write_list(ti, direction, depth, wglb, &nrwt); } else if (ti != MkAtomTerm(AtomNil)) { if (lastw == symbol || lastw == separator) { wrputc(' ', wglb->stream); } wrputc('|', wglb->stream); lastw = separator; - writeTerm__(ti, sl, 999, depth, FALSE, wglb, &nrwt); + writeTerm(ti, 999, depth, FALSE, wglb, &nrwt); } } @@ -1183,11 +1183,8 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, } } /* protect slots for portray */ - yhandle_t sl; - wglb.sl0 = (sl = wglb.sl = Yap_InitHandle(t)) -1; - wglb.protectedEntry = false; - writeTerm(t, priority, 1, FALSE, &wglb, &rwt); - t = Yap_PopHandle(sl); + wglb.sl0 = (wglb.sl = Yap_InitHandle(t))-1; + writeTerm__(t,wglb.sl, priority, 1, FALSE, &wglb, &rwt); if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); From 7f71184785f0b1f88397e9a5af153c3fbb8b965d Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 27 Jan 2019 23:54:02 +0000 Subject: [PATCH 017/101] bug --- C/globals.c | 85 ++++++++++++++---------------------------------- C/qlyr.c | 7 ++++ C/utilpreds.c | 15 ++++----- C/write.c | 82 ++++++++++++++++++++++++++++------------------ pl/consult.yap | 3 ++ pl/messages.yap | 6 ++-- pl/undefined.yap | 7 ++-- 7 files changed, 99 insertions(+), 106 deletions(-) diff --git a/C/globals.c b/C/globals.c index 56aa0a41e..52bafa947 100644 --- a/C/globals.c +++ b/C/globals.c @@ -335,61 +335,24 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, UInt arity, Term *newarena, size_t min_grow USES_REGS) { size_t old_size = ArenaSz(arena); - CELL *oldH = HR; + CELL *Hi; + int res = 0; + + t = Deref(t); Yap_DebugPlWriteln(t); + + CELL *oldH = HR; CELL *oldHB = HB; CELL *oldASP = ASP; - int res = 0; - Term tn; - - restart: - t = Deref(t); - if (IsVarTerm(t)) { ASP = ArenaLimit(arena); HR = HB = ArenaPt(arena); -#if COROUTINING - if (GlobalIsAttachedTerm(t)) { - CELL *Hi; - - *HR = t; - Hi = HR + 1; - HR += 2; - if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, NULL, copy_att_vars, Hi, - Hi PASS_REGS)) < 0) - goto error_handler; + Term o = MkVarTerm(); + while (true) { + if ((res = Yap_copy_complex_term(&t-1, &t, share, NULL, copy_att_vars, + VarOfTerm(o), HB PASS_REGS)) == 0) { CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); - return Hi[0]; + Yap_DebugPlWriteln(o); + return o; } -#endif - if (share && VarOfTerm(t) > ArenaPt(arena)) { - CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); - return t; - } - tn = MkVarTerm(); - if (HR > ASP - MIN_ARENA_SIZE) { - res = -1; - goto error_handler; - } - CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); - return tn; - } else if (IsAtomOrIntTerm(t)) { - return t; - } else { - CELL *Hi; - - Hi = HR; - HR++; - oldH = HR; - HR = HB = ArenaPt(arena); - ASP = ArenaLimit(arena); - if ((res = Yap_copy_complex_term(&t - 1, &t, share, NULL, copy_att_vars, Hi, - HR PASS_REGS)) < 0) { - goto error_handler; - } - CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); - return Hi[0]; - } - error_handler: - HR = HB; CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); XREGS[arity + 1] = t; XREGS[arity + 2] = arena; @@ -422,7 +385,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, arena = Deref(XREGS[arity + 2]); t = XREGS[arity + 1]; old_size = ArenaSz(arena); - goto restart; +} } static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, @@ -513,7 +476,7 @@ inline static GlobalEntry *GetGlobalEntry(Atom at USES_REGS) { Prop p0; AtomEntry *ae = RepAtom(at); - GlobalEntry *new; + GlobalEntry *nx; WRITE_LOCK(ae->ARWLock); p0 = ae->PropsOfAE; @@ -529,19 +492,19 @@ inline static GlobalEntry *GetGlobalEntry(Atom at USES_REGS) } p0 = pe->NextOfPE; } - new = (GlobalEntry *)Yap_AllocAtomSpace(sizeof(*new)); - INIT_RWLOCK(new->GRWLock); - new->KindOfPE = GlobalProperty; + nx = (GlobalEntry *)Yap_AllocAtomSpace(sizeof(*nx)); + INIT_RWLOCK(nx->GRWLock); + nx->KindOfPE = GlobalProperty; #if THREADS - new->owner_id = worker_id; + nx->owner_id = worker_id; #endif - new->NextGE = LOCAL_GlobalVariables; - LOCAL_GlobalVariables = new; - new->AtomOfGE = ae; - AddPropToAtom(ae, (PropEntry *)new); - RESET_VARIABLE(&new->global); + nx->NextGE = LOCAL_GlobalVariables; + LOCAL_GlobalVariables = nx; + nx->AtomOfGE = ae; + AddPropToAtom(ae, (PropEntry *)nx); + RESET_VARIABLE(&nx->global); WRITE_UNLOCK(ae->ARWLock); - return new; + return nx; } static UInt garena_overflow_size(CELL *arena USES_REGS) { diff --git a/C/qlyr.c b/C/qlyr.c index 53907c602..c961dc7b9 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -863,6 +863,9 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, } while (cl != NULL); } if (!nclauses) { + pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE; + pp->OpcodeOfPred = FAIL_OPCODE; + return; } while ((read_tag(stream) == QLY_START_LU_CLAUSE)) { @@ -947,6 +950,10 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, Yap_EraseStaticClause(cl, pp, CurrentModule); cl = ncl; } while (cl != NULL); + } else if (flags & MultiFileFlag) { + pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE; + pp->OpcodeOfPred = FAIL_OPCODE; + } for (i = 0; i < nclauses; i++) { char *base = (void *)read_UInt(stream); diff --git a/C/utilpreds.c b/C/utilpreds.c index 2067b0ea4..9a7763814 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -258,6 +258,7 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, *headp = *ptf++ = RepAppl(v)[0]; o = MkPairTerm( v, o ); } else { + *headp = RepAppl(ptf); *ptf++ = head; } continue; @@ -326,6 +327,8 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, continue; } /* store the terms to visit */ + *ptf = AbsAppl(HR); + ptf++; to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; @@ -335,8 +338,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, if (++to_visit >= to_visit_max-32) { expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); } - *ptf = AbsAppl(HR); - ptf++; if (IsExtensionFunctor(f)) { switch ((CELL)f) { @@ -393,11 +394,10 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, goto overflow; } *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - for (i = 1; i < sz; i++) { - HR[i] = headp[i]; - - } + memmove(HR, headp, sz*sizeof(CELL)); + MP_INT *new = (MP_INT *)(HR + 2); + new->_mp_d = (mp_limb_t *)(new + 1); + HR += sz; } } @@ -462,7 +462,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, } else { /* first time we met this term */ RESET_VARIABLE(ptf); - DO_TRAIL(ptd0, (CELL)ptf); *ptd0 = (CELL)ptf; ptf++; if ((ADDR)TR > LOCAL_TrailTop - 16) diff --git a/C/write.c b/C/write.c index d2c49ab89..c6812904c 100644 --- a/C/write.c +++ b/C/write.c @@ -103,9 +103,9 @@ static bool callPortray(Term t, int sno USES_REGS) { } #define PROTECT(t, F) \ - { \ + { /*yhandle_t sl = Yap_InitHandle(t);*/ \ F; \ - t = Yap_GetFromSlot(wglb->sl); \ + /*t = Yap_GetFromSlot(sl);*/ \ } static void wrputn(Int, struct write_globs *); static void wrputf(Float, struct write_globs *); @@ -117,7 +117,7 @@ static wtype AtomIsSymbols(unsigned char *); static void putAtom(Atom, int, struct write_globs *); static void writeTerm(Term, int, int, int, struct write_globs *, struct rewind_term *); -static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, +static void writeTerm__(Term t, Term *h, int p, int depth, int rinfixarg, struct write_globs *wglb, struct rewind_term *rwt); static void write_list(Term t, int direction, int depth, @@ -273,7 +273,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg, return; } else if (big_tag == BIG_RATIONAL) { Term trat = Yap_RatTermToApplTerm(t); - writeTerm__(trat,wglb->sl, p, depth, rinfixarg, wglb, rwt); + writeTerm(trat, p, depth, rinfixarg, wglb, rwt); return; #endif } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) { @@ -684,6 +684,7 @@ static void putUnquotedString(Term string, struct write_globs *wglb) static void write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt) { CACHE_REGS + // yhandle_t sl = wglb->sl; if (lastw == alphanum) { wrputc(' ', wglb->stream); } @@ -706,9 +707,7 @@ static void write_var(CELL *t, struct write_globs *wglb, wrputs("$AT(", wglb->stream); write_var(t, wglb, rwt); wrputc(',', wglb->stream); - CELL tt = (CELL)t; - PROTECT(tt, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); - t = (CELL *)tt; + writeTerm(*l, 999, 1, FALSE, wglb, &nrwt); attv = RepAttVar(t); wrputc(',', wglb->stream); l++; @@ -727,23 +726,24 @@ static void write_var(CELL *t, struct write_globs *wglb, static bool check_for_loops(Term t, struct write_globs *wglb) { - yhandle_t i, sl = wglb->sl; if ((wglb->Write_Loops)) { return false; } - for (i=sl-1; i>wglb->sl0;i--) { - if (Yap_GetFromHandle(i) == t) { + if ((IsPairTerm(t) && + HeadOfTerm(t) == TermFoundVar) || + (IsApplTerm(t) && + FunctorOfTerm(t) == (Functor)TermFoundVar)) { + char buf[64]; - snprintf(buf,63," @{ ^^%ld } " ,sl-i); + snprintf(buf,63," @{ ^^%ld } " ,0L); wrputs(buf, wglb->stream); return true; } - } return false; } -static void write_list__(Term t, yhandle_t sl, int direction, int depth, +static void write_list__(Term t, Term *hp, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt) { Term ti; struct rewind_term nrwt; @@ -755,7 +755,7 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth, int ndirection; int do_jump; - PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); + PROTECT(t, writeTerm(*hp, 999, depth + 1, FALSE, wglb, &nrwt)); ti = TailOfTerm(t); if (IsVarTerm(ti)) break; @@ -808,16 +808,18 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth, static void write_list(Term t, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt) { - if (check_for_loops(t,wglb)) return; - yhandle_t sl = wglb->sl = Yap_InitHandle(t); - write_list__(t, sl, direction, depth, + write_list__(t, RepPair(t), direction, depth, wglb, rwt); - Yap_PopHandle(sl); - wglb->sl = sl-1; +/* if (check_for_loops(t,wglb)) return; */ +/* Term h = RepPair(t)[0]; */ +/* RepPair(t)[0] = TermFoundVar; */ +/* write_list__(t, &h, direction, depth, */ +/* wglb, rwt); */ +/* RepPair(t)[0] = h; */ } -static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, +static void writeTerm__(Term t, CELL *hp, int p, int depth, int rinfixarg, struct write_globs *wglb, struct rewind_term *rwt) /* term to write */ /* context priority */ @@ -841,7 +843,7 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, wrputs("'.'(", wglb->stream); lastw = separator; - PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); + PROTECT(t, writeTerm(*hp, 999, depth + 1, FALSE, wglb, &nrwt)); wrputs(",", wglb->stream); writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt); wrclose_bracket(wglb, TRUE); @@ -855,14 +857,13 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, putString(t, wglb); } else { wrputc('[', wglb->stream); - lastw = separator; - /* we assume t was already saved in the stack */ - write_list__(t, wglb->sl, 0, depth, wglb, rwt); + lastw = separator; + write_list__(t, hp, 0, depth, wglb, rwt); wrputc(']', wglb->stream); lastw = separator; } } else { /* compound term */ - Functor functor = FunctorOfTerm(t); + Functor functor = (Functor)*hp; int Arity; Atom atom; int op, lp, rp; @@ -1129,12 +1130,30 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, static void writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, struct rewind_term *rwt) { - if (check_for_loops(t,wglb)) return; - yhandle_t sl = wglb->sl = Yap_InitHandle(t); - writeTerm__(t, sl, p, depth, rinfixarg, + if (IsPairTerm(t)) { + writeTerm__(t,RepPair(t), p, depth,rinfixarg, wglb, rwt); - Yap_PopHandle(sl); - wglb->sl = sl-1; + } else if (IsApplTerm(t)) { + writeTerm__(t, RepAppl(t), p, depth,rinfixarg, + wglb, rwt); + } else + writeTerm__(t, &t, p, depth,rinfixarg, + wglb, rwt); +/* if (check_for_loops(t,wglb)) return; */ +/* if (IsPairTerm(t)) { */ +/* Term h = HeadOfTerm(t); */ +/* RepPair(t)[0] = TermFoundVar; */ +/* writeTerm__(t, &h, p, depth, rinfixarg, */ +/* wglb, rwt); */ +/* RepPair(t)[0] = h; */ +/* } else if (IsApplTerm(t)) { */ +/* Term h = RepAppl(t)[0]; */ +/* RepAppl(t)[0] = TermFoundVar; */ +/* writeTerm__(t, &h, p, depth, rinfixarg, */ +/* wglb, rwt); */ +/* RepAppl(t)[0] = h; */ +/* } */ + } void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, @@ -1183,8 +1202,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, } } /* protect slots for portray */ - wglb.sl0 = (wglb.sl = Yap_InitHandle(t))-1; - writeTerm__(t,wglb.sl, priority, 1, FALSE, &wglb, &rwt); + writeTerm(t, priority, 1, FALSE, &wglb, &rwt); if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); diff --git a/pl/consult.yap b/pl/consult.yap index 5920f944e..59c57672a 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -862,6 +862,7 @@ 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'. @@ -1449,7 +1450,9 @@ 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/messages.yap b/pl/messages.yap index 9209911f1..a1fb3a93e 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -108,7 +108,8 @@ In YAP, the info field describes: :- use_system_module( user, [message_hook/3]). %:- start_low_level_trace. -:- multifile prolog:message/3. +:- dynamic prolog:message//1. +:- multifile prolog:message//1. %:- stop_low_level_trace. :- multifile user:message_hook/3. @@ -374,7 +375,8 @@ display_consulting( F, Level, Info, LC) --> '$error_descriptor'(Info, Desc), query_exception(prologParserFile, Desc, F0), query_exception(prologParserLine, Desc, L), - F \= F0 + integer(L) +, F \= F0 }, !, [ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ]. display_consulting( F, Level, _, LC) --> diff --git a/pl/undefined.yap b/pl/undefined.yap index 963a481a5..811891732 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -97,7 +97,7 @@ undefined_query(G0, M0, Cut) :- '$undefp'([M0|G0],MG) :- % make sure we do not loop on undefined predicates '$undef_setup'(M0:G0, Action,Debug,Current, MGI), - ('$get_undefined_predicates'(Current, MGI, MG ) , MG) + ('$get_undefined_predicates'( MGI, MG ) , MG) -> true ; @@ -119,10 +119,11 @@ undefined_query(G0, M0, Cut) :- '$handle_error'(fail,_Goal,_Mod) :- fail. -'$undef_setup'(Action,Debug,Current) :- +'$undef_setup'(G0,Action,Debug,Current,GI) :- yap_flag( unknown, Action, fail), yap_flag( debug, Debug, false), - '$stop_creeping'(Current). + '$stop_creeping'(Current), + '$g2i'(G0,GI). '$g2i'(user:G, Na/Ar ) :- !, From 09d8d07b7e0ed4dbf3a87af81e11da15f025f749 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 28 Jan 2019 15:02:55 +0000 Subject: [PATCH 018/101] ugh --- C/globals.c | 911 +++++++++++++----- C/qlyr.c | 7 + C/utilpreds.c | 2351 +++++++++++++++++++++++++++++----------------- C/write.c | 91 +- pl/messages.yap | 6 +- pl/undefined.yap | 7 +- 6 files changed, 2186 insertions(+), 1187 deletions(-) diff --git a/C/globals.c b/C/globals.c index 56aa0a41e..59be2a42b 100644 --- a/C/globals.c +++ b/C/globals.c @@ -1,19 +1,19 @@ /************************************************************************* - * * - * YAP Prolog * - * * - * Yap Prolog was developed at NCCUP - Universidade do Porto * - * * - * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * - * * - ************************************************************************** - * * - * File: non backtrackable term support * - * Last rev: 2/8/06 * - * mods: * - * comments: non-backtrackable term support * - * * - *************************************************************************/ +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: non backtrackable term support * +* Last rev: 2/8/06 * +* mods: * +* comments: non-backtrackable term support * +* * +*************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif @@ -30,82 +30,82 @@ static char SccsId[] = "%W% %G%"; /** - @defgroup Global_Variables Global Variables - @ingroup builtins - @{ + @defgroup Global_Variables Global Variables +@ingroup builtins +@{ - Global variables are associations between names (atoms) and - terms. They differ in various ways from storing information using - assert/1 or recorda/3. +Global variables are associations between names (atoms) and +terms. They differ in various ways from storing information using +assert/1 or recorda/3. - + The value lives on the Prolog (global) stack. This implies that - lookup time is independent from the size of the term. This is - particularly interesting for large data structures such as parsed XML - documents or the CHR global constraint store. ++ The value lives on the Prolog (global) stack. This implies that +lookup time is independent from the size of the term. This is +particularly interesting for large data structures such as parsed XML +documents or the CHR global constraint store. - + They support both global assignment using nb_setval/2 and - backtrackable assignment using b_setval/2. ++ They support both global assignment using nb_setval/2 and +backtrackable assignment using b_setval/2. - + Only one value (which can be an arbitrary complex Prolog term) - can be associated to a variable at a time. ++ Only one value (which can be an arbitrary complex Prolog term) +can be associated to a variable at a time. - + Their value cannot be shared among threads. Each thread has its own - namespace and values for global variables. ++ Their value cannot be shared among threads. Each thread has its own +namespace and values for global variables. - Currently global variables are scoped globally. We may consider module - scoping in future versions. Both b_setval/2 and - nb_setval/2 implicitly create a variable if the referenced name - does not already refer to a variable. +Currently global variables are scoped globally. We may consider module +scoping in future versions. Both b_setval/2 and +nb_setval/2 implicitly create a variable if the referenced name +does not already refer to a variable. - Global variables may be initialized from directives to make them - available during the program lifetime, but some considerations are - necessary for saved-states and threads. Saved-states to not store - global variables, which implies they have to be declared with - initialization/1 to recreate them after loading the saved - state. Each thread has its own set of global variables, starting with - an empty set. Using `thread_initialization/1` to define a global - variable it will be defined, restored after reloading a saved state - and created in all threads that are created after the - registration. Finally, global variables can be initialized using the - exception hook called exception/3. The latter technique is used - by CHR. +Global variables may be initialized from directives to make them +available during the program lifetime, but some considerations are +necessary for saved-states and threads. Saved-states to not store +global variables, which implies they have to be declared with +initialization/1 to recreate them after loading the saved +state. Each thread has its own set of global variables, starting with +an empty set. Using `thread_initialization/1` to define a global +variable it will be defined, restored after reloading a saved state +and created in all threads that are created after the +registration. Finally, global variables can be initialized using the +exception hook called exception/3. The latter technique is used +by CHR. - SWI-Prolog global variables are associations between names (atoms) and - terms. They differ in various ways from storing information using - assert/1 or recorda/3. +SWI-Prolog global variables are associations between names (atoms) and +terms. They differ in various ways from storing information using +assert/1 or recorda/3. - + The value lives on the Prolog (global) stack. This implies - that lookup time is independent from the size of the term. - This is particulary interesting for large data structures - such as parsed XML documents or the CHR global constraint - store. ++ The value lives on the Prolog (global) stack. This implies +that lookup time is independent from the size of the term. +This is particulary interesting for large data structures +such as parsed XML documents or the CHR global constraint +store. - They support both global assignment using nb_setval/2 and - backtrackable assignment using b_setval/2. +They support both global assignment using nb_setval/2 and +backtrackable assignment using b_setval/2. - + Only one value (which can be an arbitrary complex Prolog - term) can be associated to a variable at a time. ++ Only one value (which can be an arbitrary complex Prolog +term) can be associated to a variable at a time. - + Their value cannot be shared among threads. Each thread - has its own namespace and values for global variables. ++ Their value cannot be shared among threads. Each thread +has its own namespace and values for global variables. - + Currently global variables are scoped globally. We may - consider module scoping in future versions. ++ Currently global variables are scoped globally. We may +consider module scoping in future versions. - Both b_setval/2 and nb_setval/2 implicitly create a variable if the - referenced name does not already refer to a variable. +Both b_setval/2 and nb_setval/2 implicitly create a variable if the +referenced name does not already refer to a variable. - Global variables may be initialized from directives to make them - available during the program lifetime, but some considerations are - necessary for saved-states and threads. Saved-states to not store global - variables, which implies they have to be declared with initialization/1 - to recreate them after loading the saved state. Each thread has - its own set of global variables, starting with an empty set. Using - `thread_inititialization/1` to define a global variable it will be - defined, restored after reloading a saved state and created in all - threads that are created after the registration. +Global variables may be initialized from directives to make them +available during the program lifetime, but some considerations are +necessary for saved-states and threads. Saved-states to not store global +variables, which implies they have to be declared with initialization/1 +to recreate them after loading the saved state. Each thread has +its own set of global variables, starting with an empty set. Using +`thread_inititialization/1` to define a global variable it will be +defined, restored after reloading a saved state and created in all +threads that are created after the registration. */ @@ -123,7 +123,7 @@ static char SccsId[] = "%W% %G%"; special term on the heap. Arenas automatically contract as we add terms to the front. -*/ + */ #define QUEUE_FUNCTOR_ARITY 4 @@ -145,21 +145,21 @@ static char SccsId[] = "%W% %G%"; #define Global_MkIntegerTerm(I) MkIntegerTerm(I) -static size_t big2arena_sz(CELL *arena_base) { +static UInt big2arena_sz(CELL *arena_base) { return (((MP_INT *)(arena_base + 2))->_mp_alloc * sizeof(mp_limb_t) + sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / - sizeof(CELL); + sizeof(CELL); } -static size_t arena2big_sz(size_t sz) { +static UInt arena2big_sz(UInt sz) { return sz - - (sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL); + (sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL); } /* pointer to top of an arena */ static inline CELL *ArenaLimit(Term arena) { CELL *arena_base = RepAppl(arena); - size_t sz = big2arena_sz(arena_base); + UInt sz = big2arena_sz(arena_base); return arena_base + sz; } @@ -171,9 +171,9 @@ CELL *Yap_ArenaLimit(Term arena) { /* pointer to top of an arena */ static inline CELL *ArenaPt(Term arena) { return (CELL *)RepAppl(arena); } -static inline size_t ArenaSz(Term arena) { return big2arena_sz(RepAppl(arena)); } +static inline UInt ArenaSz(Term arena) { return big2arena_sz(RepAppl(arena)); } -static Term CreateNewArena(CELL *ptr, size_t size) { +static Term CreateNewArena(CELL *ptr, UInt size) { Term t = AbsAppl(ptr); MP_INT *dst; @@ -186,29 +186,29 @@ static Term CreateNewArena(CELL *ptr, size_t size) { return t; } -static Term NewArena(size_t size, int wid, UInt arity, CELL *where) { +static Term NewArena(UInt size, int wid, UInt arity, CELL *where) { Term t; - size_t new_size; + UInt new_size; WORKER_REGS(wid) - if (where == NULL || where == HR) { - while (HR + size > ASP - 1024) { - if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); - return TermNil; - } + if (where == NULL || where == HR) { + while (HR + size > ASP - 1024) { + if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); + return TermNil; } - t = CreateNewArena(HR, size); - HR += size; - } else { - if ((new_size = Yap_InsertInGlobal(where, size * sizeof(CELL))) == 0) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, - "No Stack Space for Non-Backtrackable terms"); - return TermNil; - } - size = new_size / sizeof(CELL); - t = CreateNewArena(where, size); } + t = CreateNewArena(HR, size); + HR += size; + } else { + if ((new_size = Yap_InsertInGlobal(where, size * sizeof(CELL))) == 0) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, + "No Stack Space for Non-Backtrackable terms"); + return TermNil; + } + size = new_size / sizeof(CELL); + t = CreateNewArena(where, size); + } return t; } @@ -232,7 +232,7 @@ void Yap_AllocateDefaultArena(size_t gsize, int wid) { REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL); } -static void adjust_cps(size_t size USES_REGS) { +static void adjust_cps(UInt size USES_REGS) { /* adjust possible back pointers in choice-point stack */ choiceptr b_ptr = B; while (b_ptr->cp_h == HR) { @@ -290,37 +290,37 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size, return TRUE; } -CELL *Yap_GetFromArena(Term *arenap, size_t cells, UInt arity) { +CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) { CACHE_REGS - restart : { - Term arena = *arenap; - CELL *max = ArenaLimit(arena); - CELL *base = ArenaPt(arena); - CELL *newH; - size_t old_sz = ArenaSz(arena), new_size; +restart : { + Term arena = *arenap; + CELL *max = ArenaLimit(arena); + CELL *base = ArenaPt(arena); + CELL *newH; + UInt old_sz = ArenaSz(arena), new_size; - if (IN_BETWEEN(base, HR, max)) { - base = HR; - HR += cells; - return base; - } - if (base + cells > max - 1024) { - if (!GrowArena(arena, max, old_sz, old_sz + sizeof(CELL) * 1024, - arity PASS_REGS)) - return NULL; - goto restart; - } - - newH = base + cells; - new_size = old_sz - cells; - *arenap = CreateNewArena(newH, new_size); + if (IN_BETWEEN(base, HR, max)) { + base = HR; + HR += cells; return base; } + if (base + cells > max - 1024) { + if (!GrowArena(arena, max, old_sz, old_sz + sizeof(CELL) * 1024, + arity PASS_REGS)) + return NULL; + goto restart; + } + + newH = base + cells; + new_size = old_sz - cells; + *arenap = CreateNewArena(newH, new_size); + return base; +} } static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, - size_t old_size USES_REGS) { - size_t new_size; + UInt old_size USES_REGS) { + UInt new_size; if (HR == oldH) return; @@ -331,6 +331,319 @@ static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, ASP = oldASP; } +static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { + if (TR != TR0) { + tr_fr_ptr pt = TR0; + + do { + Term p = TrailTerm(pt++); + if (IsVarTerm(p)) { + RESET_VARIABLE(p); + } else { + /* copy downwards */ + TrailTerm(TR0 + 1) = TrailTerm(pt); + TrailTerm(TR0) = TrailTerm(TR0 + 2) = p; + pt += 2; + TR0 += 3; + } + } while (pt != TR); + TR = TR0; + } +} + +#define expand_stack(S0,SP,SF,TYPE) \ + { size_t sz = SF-S0, used = SP-S0; \ + S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ + SP = S0+used; SF = S0+sz; } + +static int copy_complex_term(register CELL *pt0, register CELL *pt0_end, + int share, int copy_att_vars, CELL *ptf, + CELL *HLow USES_REGS) { + + int lvl = push_text_stack(); + struct cp_frame *to_visit0, *to_visit = Malloc(1024*sizeof(struct cp_frame)); + struct cp_frame *to_visit_max; + + CELL *HB0 = HB; + tr_fr_ptr TR0 = TR; + int ground = TRUE; + + HB = HLow; + to_visit0 = to_visit; + to_visit_max = to_visit+1024; +loop: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++pt0; + ptd0 = pt0; + d0 = *ptd0; + deref_head(d0, copy_term_unk); + copy_term_nvar : { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + *ptf = AbsPair(HR); + ptf++; +#ifdef RATIONAL_TREES + if (to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsPair(HR); + to_visit++; +#else + if (pt0 < pt0_end) { + if (to_visit + 32 >= to_visit_max - 32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit++; + } +#endif + ground = TRUE; + pt0 = ap2 - 1; + pt0_end = ap2 + 1; + ptf = HR; + HR += 2; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + f = (Functor)(*ap2); + + if (IsExtensionFunctor(f)) { + switch ((CELL)f) { + case (CELL) FunctorDBRef: + case (CELL) FunctorAttVar: + *ptf++ = d0; + break; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = ap2[1]; + HR[2] = EndSpecials; + HR += 3; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + break; + case (CELL) FunctorDouble: + if (HR > + ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = ap2[1]; +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + HR[2] = ap2[2]; + HR[3] = EndSpecials; + HR += 4; +#else + HR[2] = EndSpecials; + HR += 3; +#endif + break; + case (CELL) FunctorString: + if (ASP - HR < MIN_ARENA_SIZE + 3 + ap2[1]) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + memmove(HR, ap2, sizeof(CELL) * (3 + ap2[1])); + HR += ap2[1] + 3; + break; + default: { + /* big int */ + UInt sz = (sizeof(MP_INT) + 3 * CellSize + + ((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) / + CellSize, + i; + + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + for (i = 1; i < sz; i++) { + HR[i] = ap2[i]; + } + HR += sz; + } + } + continue; + } + *ptf = AbsAppl(HR); + ptf++; +/* store the terms to visit */ +#ifdef RATIONAL_TREES + if (to_visit + 32 >= to_visit_max) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsAppl(HR); + to_visit++; +#else + if (pt0 < pt0_end) { + if (to_visit++ >= (CELL **)AuxSp) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit++; + } +#endif + ground = (f != FunctorMutable); + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + /* store the functor for the new term */ + HR[0] = (CELL)f; + ptf = HR + 1; + HR += 1 + d0; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + } else { + /* just copy atoms or integers */ + *ptf++ = d0; + } + continue; + } + + derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); + ground = FALSE; + /* don't need to copy variables if we want to share the global term */ + if ((share && ptd0 < HB && ptd0 > H0) || (ptd0 >= HLow && ptd0 < HR)) { + /* we have already found this cell */ + *ptf++ = (CELL)ptd0; + } else { +#if COROUTINING + if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { + /* if unbound, call the standard copy term routine */ + struct cp_frame *bp; + CELL new; + + bp = to_visit; + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, + ptf PASS_REGS)) { + goto overflow; + } + to_visit = bp; + new = *ptf; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + Bind_and_Trail(ptd0, new); + ptf++; + } else { +#endif + /* first time we met this term */ + RESET_VARIABLE(ptf); + if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) + goto trail_overflow; + Bind_and_Trail(ptd0, (CELL)ptf); + ptf++; +#ifdef COROUTINING + } +#endif + } + } + + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; +#ifdef RATIONAL_TREES + *pt0 = to_visit->oldv; +#endif + ground = (ground && to_visit->ground); + goto loop; + } + + /* restore our nice, friendly, term to its original state */ + HB = HB0; + clean_dirty_tr(TR0 PASS_REGS); + /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); + return 0; + +overflow: + /* oops, we're in trouble */ + HR = HLow; + /* we've done it */ + /* restore our nice, friendly, term to its original state */ + HB = HB0; +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + *pt0 = to_visit->oldv; + } +#endif + reset_trail(TR0); + pop_text_stack(lvl); + return -1; + +trail_overflow: + /* oops, we're in trouble */ + HR = HLow; + /* we've done it */ + /* restore our nice, friendly, term to its original state */ + HB = HB0; +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + *pt0 = to_visit->oldv; + } +#endif + reset_trail(TR0); + pop_text_stack(lvl); + return -4; +} + static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, UInt arity, Term *newarena, size_t min_grow USES_REGS) { @@ -341,7 +654,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, int res = 0; Term tn; - restart: +restart: t = Deref(t); if (IsVarTerm(t)) { ASP = ArenaLimit(arena); @@ -353,7 +666,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, *HR = t; Hi = HR + 1; HR += 2; - if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, NULL, copy_att_vars, Hi, + if ((res = copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0) goto error_handler; CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); @@ -373,22 +686,108 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, return tn; } else if (IsAtomOrIntTerm(t)) { return t; - } else { + } else if (IsPairTerm(t)) { + Term tf; + CELL *ap; CELL *Hi; - Hi = HR; - HR++; - oldH = HR; + if (share && ArenaPt(arena) > RepPair(t)) { + return t; + } HR = HB = ArenaPt(arena); ASP = ArenaLimit(arena); - if ((res = Yap_copy_complex_term(&t - 1, &t, share, NULL, copy_att_vars, Hi, - HR PASS_REGS)) < 0) { + ap = RepPair(t); + Hi = HR; + tf = AbsPair(HR); + HR += 2; + if ((res = copy_complex_term(ap - 1, ap + 1, share, copy_att_vars, Hi, + Hi PASS_REGS)) < 0) { goto error_handler; } CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); - return Hi[0]; + return tf; + } else { + Functor f; + Term tf; + CELL *HB0; + CELL *ap; + + if (share && ArenaPt(arena) > RepAppl(t)) { + return t; + } + HR = HB = ArenaPt(arena); + ASP = ArenaLimit(arena); + f = FunctorOfTerm(t); + HB0 = HR; + ap = RepAppl(t); + tf = AbsAppl(HR); + HR[0] = (CELL)f; + if (IsExtensionFunctor(f)) { + switch ((CELL)f) { + case (CELL) FunctorDBRef: + CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); + return t; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { + res = -1; + goto error_handler; + } + HR[1] = ap[1]; + HR[2] = EndSpecials; + HR += 3; + break; + case (CELL) FunctorDouble: + if (HR > ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + res = -1; + goto error_handler; + } + HR[1] = ap[1]; +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + HR[2] = ap[2]; + HR[3] = EndSpecials; + HR += 4; +#else + HR[2] = EndSpecials; + HR += 3; +#endif + break; + case (CELL) FunctorString: + if (HR > ASP - (MIN_ARENA_SIZE + 3 + ap[1])) { + res = -1; + goto error_handler; + } + memmove(HR, ap, sizeof(CELL) * (3 + ap[1])); + HR += ap[1] + 3; + break; + default: { + UInt sz = ArenaSz(t), i; + + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + res = -1; + goto error_handler; + } + for (i = 1; i < sz; i++) { + HR[i] = ap[i]; + } + HR += sz; + } + } + } else { + HR += 1 + ArityOfFunctor(f); + if (HR > ASP - MIN_ARENA_SIZE) { + res = -1; + goto error_handler; + } + if ((res = copy_complex_term(ap, ap + ArityOfFunctor(f), share, + copy_att_vars, HB0 + 1, HB0 PASS_REGS)) < + 0) { + goto error_handler; + } + } + CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); + return tf; } - error_handler: +error_handler: HR = HB; CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); XREGS[arity + 1] = t; @@ -436,7 +835,7 @@ static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Functor f = Yap_MkFunctor(Na, Nar); UInt i; - restart: +restart: HR = HB = ArenaPt(arena); ASP = ArenaLimit(arena); HB0 = HR; @@ -585,8 +984,8 @@ static Int p_nb_setarg(USES_REGS1) { to = Deref(ARG3); to = CopyTermToArena( - ARG3, LOCAL_GlobalArena, FALSE, TRUE, 3, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG3, LOCAL_GlobalArena, FALSE, TRUE, 3, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; @@ -629,8 +1028,8 @@ static Int p_nb_set_shared_arg(USES_REGS1) { if (pos < 1 || pos > arity) return FALSE; to = CopyTermToArena( - ARG3, LOCAL_GlobalArena, TRUE, TRUE, 3, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG3, LOCAL_GlobalArena, TRUE, TRUE, 3, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; if (IsPairTerm(dest)) { @@ -711,8 +1110,8 @@ static Int p_nb_create_accumulator(USES_REGS1) { return FALSE; } to = CopyTermToArena( - t, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + t, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; t2 = Deref(ARG2); @@ -765,9 +1164,9 @@ static Int p_nb_add_to_accumulator(USES_REGS1) { } else { /* we need to create a new long int */ new = CopyTermToArena( - new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) - PASS_REGS); + new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) + PASS_REGS); destp = RepAppl(Deref(ARG1)); destp[1] = new; } @@ -795,8 +1194,8 @@ static Int p_nb_add_to_accumulator(USES_REGS1) { new = Yap_Eval(new); new = CopyTermToArena( - new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); destp = RepAppl(Deref(ARG1)); destp[1] = new; @@ -826,12 +1225,12 @@ static Int p_nb_accumulator_value(USES_REGS1) { Term Yap_SetGlobalVal(Atom at, Term t0) { CACHE_REGS - Term to; + Term to; GlobalEntry *ge; ge = GetGlobalEntry(at PASS_REGS); to = CopyTermToArena( - t0, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + t0, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return to; WRITE_LOCK(ge->GRWLock); @@ -842,10 +1241,10 @@ Term Yap_SetGlobalVal(Atom at, Term t0) { Term Yap_SaveTerm(Term t0) { CACHE_REGS - Term to; + Term to; to = CopyTermToArena( Deref(t0), LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return to; return to; @@ -875,8 +1274,8 @@ static Int p_nb_set_shared_val(USES_REGS1) { } ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS); to = CopyTermToArena( - ARG2, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG2, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; WRITE_LOCK(ge->GRWLock); @@ -960,7 +1359,7 @@ static Int p_nb_getval(USES_REGS1) { Term Yap_GetGlobal(Atom at) { CACHE_REGS - GlobalEntry *ge; + GlobalEntry *ge; Term to; ge = FindGlobalEntry(at PASS_REGS); @@ -1018,7 +1417,7 @@ static Int nbdelete(Atom at USES_REGS) { Int Yap_DeleteGlobal(Atom at) { CACHE_REGS - return nbdelete(at PASS_REGS); + return nbdelete(at PASS_REGS); } @@ -1153,7 +1552,7 @@ static Int nb_queue(UInt arena_sz USES_REGS) { return (FunctorOfTerm(t) == FunctorNBQueue); } ar[QUEUE_ARENA] = ar[QUEUE_HEAD] = ar[QUEUE_TAIL] = ar[QUEUE_SIZE] = - MkIntTerm(0); + MkIntTerm(0); queue = Yap_MkApplTerm(FunctorNBQueue, QUEUE_FUNCTOR_ARITY, ar); if (!Yap_unify(queue, ARG1)) return FALSE; @@ -1461,8 +1860,8 @@ static Int p_nb_heap(USES_REGS1) { } while ((heap = MkZeroApplTerm( - Yap_MkFunctor(AtomHeap, 2 * hsize + HEAP_START + 1), - 2 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { + Yap_MkFunctor(AtomHeap, 2 * hsize + HEAP_START + 1), + 2 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { if (!Yap_gcl((2 * hsize + HEAP_START + 1) * sizeof(CELL), 2, ENV, P)) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return FALSE; @@ -1560,7 +1959,7 @@ static Int p_nb_heap_add_to_heap(USES_REGS1) { if (!qd) return FALSE; - restart: +restart: hsize = IntegerOfTerm(qd[HEAP_SIZE]); hmsize = IntegerOfTerm(qd[HEAP_MAX]); if (hsize == hmsize) { @@ -1728,8 +2127,8 @@ static Int p_nb_beam(USES_REGS1) { hsize = IntegerOfTerm(tsize); } while ((beam = MkZeroApplTerm( - Yap_MkFunctor(AtomHeap, 5 * hsize + HEAP_START + 1), - 5 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { + Yap_MkFunctor(AtomHeap, 5 * hsize + HEAP_START + 1), + 5 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { if (!Yap_gcl((4 * hsize + HEAP_START + 1) * sizeof(CELL), 2, ENV, P)) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return FALSE; @@ -1760,7 +2159,7 @@ static Int p_nb_beam_close(USES_REGS1) { return p_nb_heap_close(PASS_REGS1); } */ static void PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to) { CACHE_REGS - UInt off = hsize, off2 = hsize; + UInt off = hsize, off2 = hsize; Term toff, toff2; /* push into first queue */ @@ -1804,7 +2203,7 @@ static void PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to) { static void DelBeamMax(CELL *pt, CELL *pt2, UInt sz) { CACHE_REGS - UInt off = IntegerOfTerm(pt2[1]); + UInt off = IntegerOfTerm(pt2[1]); UInt indx = 0; Term tk, ti, tv; @@ -1878,7 +2277,7 @@ static void DelBeamMax(CELL *pt, CELL *pt2, UInt sz) { static Term DelBeamMin(CELL *pt, CELL *pt2, UInt sz) { CACHE_REGS - UInt off2 = IntegerOfTerm(pt[1]); + UInt off2 = IntegerOfTerm(pt[1]); Term ov = pt2[3 * off2 + 2]; /* return value */ UInt indx = 0; Term tk, tv; @@ -2098,7 +2497,7 @@ static Int p_nb_beam_keys(USES_REGS1) { CELL *pt, *ho; UInt i; - restart: +restart: qd = GetHeap(ARG1, "beam_keys"); if (!qd) return FALSE; @@ -2199,7 +2598,7 @@ static Int init_current_nb(USES_REGS1) { /* current_atom(?Atom) */ void Yap_InitGlobals(void) { CACHE_REGS - Term cm = CurrentModule; + Term cm = CurrentModule; Yap_InitCPred("$allocate_arena", 2, p_allocate_arena, 0); Yap_InitCPred("arena_size", 1, p_default_arena_size, 0); Yap_InitCPred("b_setval", 2, p_b_setval, SafePredFlag); @@ -2207,22 +2606,22 @@ void Yap_InitGlobals(void) { /** @pred b_setval(+ _Name_, + _Value_) - Associate the term _Value_ with the atom _Name_ or replaces - the currently associated value with _Value_. If _Name_ does - not refer to an existing global variable a variable with initial value - [] is created (the empty list). On backtracking the assignment is - reversed. + Associate the term _Value_ with the atom _Name_ or replaces + the currently associated value with _Value_. If _Name_ does + not refer to an existing global variable a variable with initial value + [] is created (the empty list). On backtracking the assignment is + reversed. */ /** @pred b_setval(+ _Name_,+ _Value_) - Associate the term _Value_ with the atom _Name_ or replaces - the currently associated value with _Value_. If _Name_ does - not refer to an existing global variable a variable with initial value - `[]` is created (the empty list). On backtracking the - assignment is reversed. + Associate the term _Value_ with the atom _Name_ or replaces + the currently associated value with _Value_. If _Name_ does + not refer to an existing global variable a variable with initial value + `[]` is created (the empty list). On backtracking the + assignment is reversed. */ @@ -2231,18 +2630,18 @@ void Yap_InitGlobals(void) { /** @pred nb_setval(+ _Name_, + _Value_) - Associates a copy of _Value_ created with duplicate_term/2 with - the atom _Name_. Note that this can be used to set an initial - value other than `[]` prior to backtrackable assignment. + Associates a copy of _Value_ created with duplicate_term/2 with + the atom _Name_. Note that this can be used to set an initial + value other than `[]` prior to backtrackable assignment. */ /** @pred nb_setval(+ _Name_,+ _Value_) - Associates a copy of _Value_ created with duplicate_term/2 - with the atom _Name_. Note that this can be used to set an - initial value other than `[]` prior to backtrackable assignment. + Associates a copy of _Value_ created with duplicate_term/2 + with the atom _Name_. Note that this can be used to set an + initial value other than `[]` prior to backtrackable assignment. */ @@ -2250,25 +2649,25 @@ void Yap_InitGlobals(void) { /** @pred nb_set_shared_val(+ _Name_, + _Value_) - Associates the term _Value_ with the atom _Name_, but sharing - non-backtrackable terms. This may be useful if you want to rewrite a - global variable so that the new copy will survive backtracking, but - you want to share structure with the previous term. + Associates the term _Value_ with the atom _Name_, but sharing + non-backtrackable terms. This may be useful if you want to rewrite a + global variable so that the new copy will survive backtracking, but + you want to share structure with the previous term. - The next example shows the differences between the three built-ins: + The next example shows the differences between the three built-ins: - ~~~~~ - ?- nb_setval(a,a(_)),nb_getval(a,A),nb_setval(b,t(C,A)),nb_getval(b,B). - A = a(_A), - B = t(_B,a(_C)) ? + ~~~~~ + ?- nb_setval(a,a(_)),nb_getval(a,A),nb_setval(b,t(C,A)),nb_getval(b,B). + A = a(_A), + B = t(_B,a(_C)) ? - ?- - nb_setval(a,a(_)),nb_getval(a,A),nb_set_shared_val(b,t(C,A)),nb_getval(b,B). + ?- + nb_setval(a,a(_)),nb_getval(a,A),nb_set_shared_val(b,t(C,A)),nb_getval(b,B). - ?- nb_setval(a,a(_)),nb_getval(a,A),nb_linkval(b,t(C,A)),nb_getval(b,B). - A = a(_A), - B = t(C,a(_A)) ? - ~~~~~ + ?- nb_setval(a,a(_)),nb_getval(a,A),nb_linkval(b,t(C,A)),nb_getval(b,B). + A = a(_A), + B = t(C,a(_A)) ? + ~~~~~ */ @@ -2276,26 +2675,26 @@ void Yap_InitGlobals(void) { /** @pred nb_linkval(+ _Name_, + _Value_) - Associates the term _Value_ with the atom _Name_ without - copying it. This is a fast special-purpose variation of nb_setval/2 - intended for expert users only because the semantics on backtracking - to a point before creating the link are poorly defined for compound - terms. The principal term is always left untouched, but backtracking - behaviour on arguments is undone if the original assignment was - trailed and left alone otherwise, which implies that the history that - created the term affects the behaviour on backtracking. Please - consider the following example: + Associates the term _Value_ with the atom _Name_ without + copying it. This is a fast special-purpose variation of nb_setval/2 + intended for expert users only because the semantics on backtracking + to a point before creating the link are poorly defined for compound + terms. The principal term is always left untouched, but backtracking + behaviour on arguments is undone if the original assignment was + trailed and left alone otherwise, which implies that the history that + created the term affects the behaviour on backtracking. Please + consider the following example: - ~~~~~ - demo_nb_linkval :- - T = nice(N), - ( N = world, - nb_linkval(myvar, T), - fail - ; nb_getval(myvar, V), - writeln(V) - ). - ~~~~~ + ~~~~~ + demo_nb_linkval :- + T = nice(N), + ( N = world, + nb_linkval(myvar, T), + fail + ; nb_getval(myvar, V), + writeln(V) + ). + ~~~~~ */ @@ -2307,31 +2706,31 @@ void Yap_InitGlobals(void) { - Assigns the _Arg_-th argument of the compound term _Term_ with - the given _Value_ as setarg/3, but on backtracking the assignment - is not reversed. If _Term_ is not atomic, it is duplicated using - duplicate_term/2. This predicate uses the same technique as - nb_setval/2. We therefore refer to the description of - nb_setval/2 for details on non-backtrackable assignment of - terms. This predicate is compatible to GNU-Prolog - `setarg(A,T,V,false)`, removing the type-restriction on - _Value_. See also nb_linkarg/3. Below is an example for - counting the number of solutions of a goal. Note that this - implementation is thread-safe, reentrant and capable of handling - exceptions. Realising these features with a traditional implementation - based on assert/retract or flag/3 is much more complicated. + Assigns the _Arg_-th argument of the compound term _Term_ with + the given _Value_ as setarg/3, but on backtracking the assignment + is not reversed. If _Term_ is not atomic, it is duplicated using + duplicate_term/2. This predicate uses the same technique as + nb_setval/2. We therefore refer to the description of + nb_setval/2 for details on non-backtrackable assignment of + terms. This predicate is compatible to GNU-Prolog + `setarg(A,T,V,false)`, removing the type-restriction on + _Value_. See also nb_linkarg/3. Below is an example for + counting the number of solutions of a goal. Note that this + implementation is thread-safe, reentrant and capable of handling + exceptions. Realising these features with a traditional implementation + based on assert/retract or flag/3 is much more complicated. - ~~~~~ + ~~~~~ succeeds_n_times(Goal, Times) :- - Counter = counter(0), - ( Goal, - arg(1, Counter, N0), - N is N0 + 1, - nb_setarg(1, Counter, N), - fail - ; arg(1, Counter, Times) - ). - ~~~~~ + Counter = counter(0), + ( Goal, + arg(1, Counter, N0), + N is N0 + 1, + nb_setarg(1, Counter, N), + fail + ; arg(1, Counter, Times) + ). + ~~~~~ */ @@ -2340,9 +2739,9 @@ void Yap_InitGlobals(void) { - As nb_setarg/3, but like nb_linkval/2 it does not - duplicate the global sub-terms in _Value_. Use with extreme care - and consult the documentation of nb_linkval/2 before use. + As nb_setarg/3, but like nb_linkval/2 it does not + duplicate the global sub-terms in _Value_. Use with extreme care + and consult the documentation of nb_linkval/2 before use. */ @@ -2351,9 +2750,9 @@ void Yap_InitGlobals(void) { - As nb_setarg/3, but like nb_linkval/2 it does not - duplicate _Value_. Use with extreme care and consult the - documentation of nb_linkval/2 before use. + As nb_setarg/3, but like nb_linkval/2 it does not + duplicate _Value_. Use with extreme care and consult the + documentation of nb_linkval/2 before use. */ @@ -2361,20 +2760,20 @@ void Yap_InitGlobals(void) { /** @pred nb_delete(+ _Name_) - Delete the named global variable. + Delete the named global variable. - Global variables have been introduced by various Prolog - implementations recently. We follow the implementation of them in - SWI-Prolog, itself based on hProlog by Bart Demoen. + Global variables have been introduced by various Prolog + implementations recently. We follow the implementation of them in + SWI-Prolog, itself based on hProlog by Bart Demoen. - GNU-Prolog provides a rich set of global variables, including - arrays. Arrays can be implemented easily in YAP and SWI-Prolog using - functor/3 and `setarg/3` due to the unrestricted arity of - compound terms. + GNU-Prolog provides a rich set of global variables, including + arrays. Arrays can be implemented easily in YAP and SWI-Prolog using + functor/3 and `setarg/3` due to the unrestricted arity of + compound terms. - @} */ + @} */ Yap_InitCPred("nb_create", 3, p_nb_create, 0L); Yap_InitCPred("nb_create", 4, p_nb_create2, 0L); Yap_InitCPredBack("$nb_current", 1, 1, init_current_nb, cont_current_nb, @@ -2418,5 +2817,5 @@ void Yap_InitGlobals(void) { } /** - @} +@} */ diff --git a/C/qlyr.c b/C/qlyr.c index 53907c602..c961dc7b9 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -863,6 +863,9 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, } while (cl != NULL); } if (!nclauses) { + pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE; + pp->OpcodeOfPred = FAIL_OPCODE; + return; } while ((read_tag(stream) == QLY_START_LU_CLAUSE)) { @@ -947,6 +950,10 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, Yap_EraseStaticClause(cl, pp, CurrentModule); cl = ncl; } while (cl != NULL); + } else if (flags & MultiFileFlag) { + pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE; + pp->OpcodeOfPred = FAIL_OPCODE; + } for (i = 0; i < nclauses; i++) { char *base = (void *)read_UInt(stream); diff --git a/C/utilpreds.c b/C/utilpreds.c index 2067b0ea4..bcb42b72d 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -1,23 +1,23 @@ /************************************************************************* - * * - * YAP Prolog * - * * - * Yap Prolog was developed at NCCUP - Universidade do Porto * - * * - * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * - * * - ************************************************************************** - * * - * File: utilpreds.c * Last rev: 4/03/88 - ** mods: * comments: new utility predicates for YAP * - * * - *************************************************************************/ +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: utilpreds.c * +* Last rev: 4/03/88 * +* mods: * +* comments: new utility predicates for YAP * +* * +*************************************************************************/ #ifdef SCCS static char SccsId[] = "@(#)utilpreds.c 1.3"; #endif /** - * @file utilpreds.c - * * @addtogroup Terms */ @@ -30,109 +30,14 @@ static char SccsId[] = "@(#)utilpreds.c 1.3"; #include "string.h" #endif - typedef struct { - Term old_var; - Term new_var; + Term old_var; + Term new_var; } *vcell; -typedef struct non_single_struct_t { - CELL *ptd0; - CELL d0; - CELL *pt0, *pt0_end; -} non_singletons_t; - -#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ - if (IsPairTerm(d0)) { \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - LIST0; \ - ptd0 = RepPair(d0); \ - if (*ptd0 == TermFreeTerm) continue; \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ - to_visit->d0 = *ptd0; \ - to_visit ++; \ - d0 = ptd0[0]; \ - pt0 = ptd0; \ - *ptd0 = TermFreeTerm; \ - pt0_end = pt0 + 1; \ - if (pt0 <= pt0_end) \ - goto list_loop; \ - } else if (IsApplTerm(d0)) { \ - register Functor f; \ - register CELL *ap2; \ - /* store the terms to visit */ \ - ap2 = RepAppl(d0); \ - f = (Functor)(*ap2); \ - \ - if (IsExtensionFunctor(f) || \ - IsAtomTerm((CELL)f)) { \ - \ - continue; \ - } \ - STRUCT0; \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ap2; \ - to_visit->d0 = *ap2; \ - to_visit ++; \ - \ - *ap2 = TermNil; \ - d0 = ArityOfFunctor(f); \ - pt0 = ap2; \ - pt0_end = ap2 + d0; \ - } - -#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}) - -#define def_trail_overflow() \ - trail_overflow:{ \ - while (to_visit > to_visit0) { \ - to_visit --; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - return 0L; \ - } - -#define def_aux_overflow() \ - aux_overflow:{ \ - size_t d1 = to_visit-to_visit0; \ - size_t d2 = to_visit_max-to_visit0; \ - to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \ - to_visit = to_visit0+d1; \ - to_visit_max = to_visit0+(d2+128); \ - pt0--; \ - goto restart; \ - } - -#define def_global_overflow() \ - global_overflow:{ \ - while (to_visit > to_visit0) { \ - to_visit --; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); \ - return false; } - - +static int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE); +static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); static Int p_non_singletons_in_term( USES_REGS1); static CELL non_singletons_in_complex_term(CELL *, CELL * CACHE_TYPE); static Int p_variables_in_term( USES_REGS1 ); @@ -140,7 +45,6 @@ static Int ground_complex_term(CELL *, CELL * CACHE_TYPE); static Int p_ground( USES_REGS1 ); static Int p_copy_term( USES_REGS1 ); static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); -static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); #ifdef DEBUG static Int p_force_trail_expansion( USES_REGS1 ); @@ -158,273 +62,145 @@ clean_tr(tr_fr_ptr TR0 USES_REGS) { static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { - tr_fr_ptr pt0 = TR; - while (pt0 != TR0) { - Term p = TrailTerm(--pt0); - if (IsApplTerm(p)) { - CELL *pt = RepAppl(p); -#ifdef FROZEN_STACKS - pt[0] = TrailVal(pt0); -#else - pt[0] = TrailTerm(pt0 - 1); - pt0 --; -#endif /* FROZEN_STACKS */ - } else { + if (TR != TR0) { + tr_fr_ptr pt = TR0; + + do { + Term p = TrailTerm(pt++); RESET_VARIABLE(p); - } - } - TR = TR0; + } while (pt != TR); + TR = TR0; + } } -/// @brief recover original term while fixing direct refs. -/// -/// @param USES_REGS -/// -static inline void -clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { - tr_fr_ptr pt0 = TR; - while (pt0 != TR0) { - Term p = TrailTerm(--pt0); - if (IsApplTerm(p)) { - /// pt: points to the address of the new term we may want to fix. - CELL *pt = RepAppl(p); - if (pt >= HB && pt < HR) { /// is it new? - Term v = pt[0]; - if (IsApplTerm(v)) { - /// yes, more than a single ref - *pt = (CELL)RepAppl(v); - } -#ifndef FROZEN_STACKS - pt0 --; -#endif /* FROZEN_STACKS */ - continue; - } -#ifdef FROZEN_STACKS - pt[0] = TrailVal(pt0); -#else - pt[0] = TrailTerm(pt0 - 1); - pt0 --; -#endif /* FROZEN_STACKS */ - } else { - RESET_VARIABLE(p); - } - } - TR = TR0; -} - -#define expand_stack(S0,SP,SF,TYPE) \ - { size_t sz = SF-S0, used = SP-S0; \ - S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ - SP = S0+used; SF = S0+sz; } - -#define MIN_ARENA_SIZE (1048L) - -int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, - bool share, Term *split, bool copy_att_vars, CELL *ptf, - CELL *HLow USES_REGS) { - // fprintf(stderr,"+++++++++\n"); - //CELL *x = pt0; while(x != pt0_end) Yap_DebugPlWriteln(*++ x); - - int lvl = push_text_stack(); - Term o = TermNil; - struct cp_frame *to_visit0, - *to_visit = Malloc(1024*sizeof(struct cp_frame)); - struct cp_frame *to_visit_max; +static int +copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS) +{ + struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace() ; CELL *HB0 = HB; tr_fr_ptr TR0 = TR; - int ground = true; + int ground = TRUE; - HB = HLow; + HB = HR; to_visit0 = to_visit; - to_visit_max = to_visit+1024; loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - - ptd0 = ++pt0; + ++ pt0; + ptd0 = pt0; d0 = *ptd0; - deref: deref_head(d0, copy_term_unk); - copy_term_nvar : { + copy_term_nvar: + { if (IsPairTerm(d0)) { - CELL *headp = RepPair(d0); - Term head = *headp; - if (IsPairTerm(head) && RepPair(head) >= HB && RepPair(head) < HR) { - if (split) { - Term v = Yap_MkNewApplTerm(FunctorEq, 2); - RepAppl(v)[1] = AbsPair(ptf); - *headp = *ptf++ = RepAppl(v)[0]; - o = MkPairTerm( v, o ); - } else { - *ptf++ = head; - } - continue; - } else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) { - *ptf++ = AbsPair(RepAppl(*headp)); - continue; - } - *ptf = AbsPair(HR); - if (to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->curp = headp; - d0 = to_visit->oldv = head; - to_visit->ground = ground; - to_visit++; - // move to new list - if (share) { - TrailedMaBind(headp,AbsPair(HR)); - } else { + CELL *ap2 = RepPair(d0); + if (ap2 >= HB && ap2 < HR) { /* If this is newer than the current term, just reuse */ - *headp = AbsPair(HR); - } - if (split) { - TrailedMaBind(ptf,AbsPair(HR)); - } - pt0 = headp; - pt0_end = headp + 1; - ptf = HR; - ground = true; - HR += 2; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - goto deref; - } else if (IsApplTerm(d0)) { - Functor f; - CELL *headp, head; - /* store the terms to visit */ - headp = RepAppl(d0); - head = *headp; - - if (IsPairTerm(head)//(share && headp < HB) || - ) { - if (split) { - Term v = Yap_MkNewApplTerm(FunctorEq, 2); - RepAppl(v)[1] = head; - *headp = *ptf++ = RepAppl(v)[0]; - o = MkPairTerm( v, o ); - } else { - /* If this is newer than the current term, just reuse */ - *ptf++ = AbsAppl(RepPair(head)); - } - continue; - } - if (IsApplTerm(head)//(share && headp < HB) || - ) { - *ptf++ = head; - continue; - } - f = (Functor)(head); - if (share && (ground || IsExtensionFunctor(f))) { *ptf++ = d0; continue; } - /* store the terms to visit */ + *ptf = AbsPair(HR); + ptf++; + if (to_visit+1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->curp = headp; - to_visit->oldv = head; + to_visit->oldv = *pt0; to_visit->ground = ground; - if (++to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + /* fool the system into thinking we had a variable there */ + *pt0 = AbsPair(HR); + to_visit ++; + ground = TRUE; + pt0 = ap2 - 1; + pt0_end = ap2 + 1; + ptf = HR; + HR += 2; + if (HR > ASP - 2048) { + goto overflow; } - *ptf = AbsAppl(HR); - ptf++; - + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if (ap2 >= HB && ap2 <= HR) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { - switch ((CELL)f) { - case (CELL) FunctorDBRef: - case (CELL) FunctorAttVar: - *ptf++ = d0; - break; - case (CELL) FunctorLongInt: - if (HR > ASP - (MIN_ARENA_SIZE + 3)) { - goto overflow; +#if MULTIPLE_STACKS + if (f == FunctorDBRef) { + DBRef entryref = DBRefOfTerm(d0); + if (entryref->Flags & LogUpdMask) { + LogUpdClause *luclause = (LogUpdClause *)entryref; + PELOCK(100,luclause->ClPred); + UNLOCK(luclause->ClPred->PELock); + } else { + LOCK(entryref->lock); + TRAIL_REF(entryref); /* So that fail will erase it */ + INC_DBREF_COUNT(entryref); + UNLOCK(entryref->lock); } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = headp[1]; - HR[2] = EndSpecials; - HR += 3; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - break; - case (CELL) FunctorDouble: - if (HR > - ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = headp[1]; -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - HR[2] = headp[2]; - HR[3] = EndSpecials; - HR += 4; -#else - HR[2] = EndSpecials; - HR += 3; + *ptf++ = d0; /* you can just copy other extensions. */ + } else #endif - break; - case (CELL) FunctorString: - if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) { + if (!share) { + UInt sz; + + *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */ + /* make sure to copy floats */ + if (f== FunctorDouble) { + sz = sizeof(Float)/sizeof(CELL)+2; + } else if (f== FunctorLongInt) { + sz = 3; + } else if (f== FunctorString) { + sz = 3+ap2[1]; + } else { + CELL *pt = ap2+1; + sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t)); + } + if (HR+sz > ASP - 2048) { goto overflow; } - *ptf++ = AbsAppl(HR); - memmove(HR, headp, sizeof(CELL) * (3 + headp[1])); - HR += headp[1] + 3; - break; - default: { - /* big int */ - size_t sz = (sizeof(MP_INT) + 3 * CellSize + - ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / - CellSize, - i; - - if (HR > ASP - (MIN_ARENA_SIZE + sz)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - for (i = 1; i < sz; i++) { - HR[i] = headp[i]; - - } + memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); HR += sz; - } + } else { + *ptf++ = d0; /* you can just copy other extensions. */ } continue; } - if (share) { - TrailedMaBind(headp,AbsPair(HR)); - } else { - *headp = AbsPair(HR); + *ptf = AbsAppl(HR); + ptf++; + /* store the terms to visit */ + if (to_visit+1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; } - if (split) { - // must be after trailing source term, so that we can check the source - // term and confirm it is still ok. - TrailedMaBind(ptf,AbsAppl(HR)); - } - ptf = HR; - ptf[0] = (CELL)f; - ground = true; - arity_t a = ArityOfFunctor(f); - if (HR > ASP - MIN_ARENA_SIZE) { + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsAppl(HR); + to_visit ++; + ground = (f != FunctorMutable); + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + /* store the functor for the new term */ + HR[0] = (CELL)f; + ptf = HR+1; + HR += 1+d0; + if (HR > ASP - 2048) { goto overflow; } - ptf++; - HR = ptf+a; - pt0_end = headp+(a); - pt0 = headp; - ground = (f != FunctorMutable); } else { /* just copy atoms or integers */ *ptf++ = d0; @@ -433,62 +209,66 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, } derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = false; - /* don't need to copy variables if we want to share the global term */ - if (//(share && ptd0 < HB && ptd0 > H0) || - (ptd0 >= HB && ptd0 < HR)) { + ground = FALSE; + if (ptd0 >= HLow && ptd0 < HR) { /* we have already found this cell */ - *ptf++ = (CELL)ptd0; - } else - if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { + *ptf++ = (CELL) ptd0; + } else +#if COROUTINING + if (newattvs && IsAttachedTerm((CELL)ptd0)) { /* if unbound, call the standard copy term routine */ struct cp_frame *bp; + CELL new; bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, - ptf PASS_REGS)) { + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { goto overflow; } to_visit = bp; new = *ptf; + Bind_NonAtt(ptd0, new); + ptf++; + } else { +#endif + /* first time we met this term */ + RESET_VARIABLE(ptf); if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { goto trail_overflow; } } - - } else { - /* first time we met this term */ - RESET_VARIABLE(ptf); - DO_TRAIL(ptd0, (CELL)ptf); - *ptd0 = (CELL)ptf; + Bind_NonAtt(ptd0, (CELL)ptf); ptf++; - if ((ADDR)TR > LOCAL_TrailTop - 16) - goto trail_overflow; - } } - /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - if (!share) - *to_visit->curp = to_visit->oldv; + to_visit --; + if (ground && share) { + CELL old = to_visit->oldv; + CELL *newp = to_visit->to-1; + CELL new = *newp; + + *newp = old; + if (IsApplTerm(new)) + HR = RepAppl(new); + else + HR = RepPair(new); + } pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; + *pt0 = to_visit->oldv; ground = (ground && to_visit->ground); goto loop; } /* restore our nice, friendly, term to its original state */ - clean_complex_tr(TR0 PASS_REGS); - /* follow chain of multi-assigned variables */ - pop_text_stack(lvl); - return 0; - + clean_dirty_tr(TR0 PASS_REGS); + HB = HB0; + return ground; overflow: /* oops, we're in trouble */ @@ -497,38 +277,62 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit--; + to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; + *pt0 = to_visit->oldv; } reset_trail(TR0); - pop_text_stack(lvl); + /* follow chain of multi-assigned variables */ return -1; - trail_overflow: +trail_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit--; + to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; + *pt0 = to_visit->oldv; + } + { + tr_fr_ptr oTR = TR; + reset_trail(TR0); + if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + return -4; + } + return -2; + } + + heap_overflow: + /* oops, we're in trouble */ + HR = HLow; + /* we've done it */ + /* restore our nice, friendly, term to its original state */ + HB = HB0; + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + *pt0 = to_visit->oldv; } reset_trail(TR0); - pop_text_stack(lvl); - return -4; -} + LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + return -3; + } static Term handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) { CACHE_REGS - XREGS[arity+1] = t; + XREGS[arity+1] = t; switch(res) { case -1: if (!Yap_gcl((ASP-HR)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { @@ -565,39 +369,97 @@ static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; + + if (IsVarTerm(t)) { +#if COROUTINING + if (newattvs && IsAttachedTerm(t)) { + CELL *Hi; + int res; + restart_attached: + + *HR = t; + Hi = HR+1; + HR += 2; + if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { + HR = Hi-1; + if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) + return FALSE; + goto restart_attached; + } + return Hi[0]; + } +#endif + return MkVarTerm(); + } else if (IsPrimitiveTerm(t)) { + return t; + } else if (IsPairTerm(t)) { + Term tf; + CELL *ap; CELL *Hi; - if (IsPrimitiveTerm(t)) { - return t; - } - while( true ) { - int res; + restart_list: + ap = RepPair(t); Hi = HR; - HR ++; - - if ((res = Yap_copy_complex_term((&t)-1, &t, share, NULL, newattvs, Hi, HR PASS_REGS)) < 0) { + tf = AbsPair(HR); + HR += 2; + { + int res; + if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { HR = Hi; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; + goto restart_list; } else if (res && share) { HR = Hi; return t; } - return Hi[0]; } - return 0; + return tf; + } else { + Functor f = FunctorOfTerm(t); + Term tf; + CELL *HB0; + CELL *ap; + + restart_appl: + f = FunctorOfTerm(t); + HB0 = HR; + ap = RepAppl(t); + tf = AbsAppl(HR); + HR[0] = (CELL)f; + HR += 1+ArityOfFunctor(f); + if (HR > ASP-128) { + HR = HB0; + if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L) + return FALSE; + goto restart_appl; + } else { + int res; + + if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { + HR = HB0; + if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) + return FALSE; + goto restart_appl; + } else if (res && share && FunctorOfTerm(t) != FunctorMutable) { + HR = HB0; + return t; + } + } + return tf; + } } Term Yap_CopyTerm(Term inp) { CACHE_REGS - return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); + return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); } Term Yap_CopyTermNoShare(Term inp) { CACHE_REGS - return CopyTerm(inp, 0, FALSE, FALSE PASS_REGS); + return CopyTerm(inp, 0, FALSE, FALSE PASS_REGS); } static Int @@ -670,7 +532,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te HB = HR; to_visit0 = to_visit; - loop: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; @@ -681,9 +543,9 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te copy_term_nvar: { if (IsPairTerm(d0)) { - CELL *headp = RepPair(d0); - //fprintf(stderr, "%d \n", RepPair(headp[0])- ptf); - if (IsVarTerm(headp[0]) && IN_BETWEEN(HB, (headp[0]),HR)) { + CELL *ap2 = RepPair(d0); + fprintf(stderr, "%ld \n", RepPair(ap2[0])- ptf); + if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) { Term v = MkVarTerm(); *ptf = v; vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) ); @@ -697,19 +559,19 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldp = headp; - d0 = to_visit->oldv = headp[0]; + to_visit->oldp = ap2; + d0 = to_visit->oldv = ap2[0]; /* fool the system into thinking we had a variable there */ to_visit ++; - pt0 = headp; - pt0_end = headp + 1; + pt0 = ap2; + pt0_end = ap2 + 1; ptf = HR; - *headp = AbsPair(HR); + *ap2 = AbsPair(HR); HR += 2; if (HR > ASP - 2048) { goto overflow; } - if (IsVarTerm(d0) && d0 == (CELL)headp) { + if (IsVarTerm(d0) && d0 == (CELL)ap2) { RESET_VARIABLE(ptf); ptf++; continue; @@ -723,17 +585,17 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te continue; } else if (IsApplTerm(d0)) { register Functor f; - register CELL *headp; + register CELL *ap2; /* store the terms to visit */ - headp = RepAppl(d0)+1; - f = (Functor)(headp[-1]); + ap2 = RepAppl(d0)+1; + f = (Functor)(ap2[-1]); if (IsExtensionFunctor(f)) { - *ptf++ = d0; /* you can just copy other extensions. */ + *ptf++ = d0; /* you can just copy other extensions. */ continue; } - if (IsApplTerm(headp[0]) && IN_BETWEEN(HB, RepAppl(headp[0]),HR)) { + if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) { RESET_VARIABLE(ptf); - vin = add_to_list(vin, (CELL)ptf, headp[0] ); + vin = add_to_list(vin, (CELL)ptf, ap2[0] ); ptf++; continue; } @@ -746,19 +608,24 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldp = headp; - d0 = to_visit->oldv = headp[0]; + to_visit->oldp = ap2; + d0 = to_visit->oldv = ap2[0]; /* fool the system into thinking we had a variable there */ to_visit ++; - pt0 = headp; - pt0_end = headp + (arity-1); + pt0 = ap2; + pt0_end = ap2 + (arity-1); ptf = HR; if (HR > ASP - 2048) { goto overflow; } *ptf++ =(CELL)f; - *headp = AbsAppl(HR); + *ap2 = AbsAppl(HR); HR += (arity+1); + if (IsVarTerm(d0) && d0 == (CELL)(ap2)) { + RESET_VARIABLE(ptf); + ptf++; + continue; + } d0 = Deref(d0); if (!IsVarTerm(d0)) { goto copy_term_nvar; @@ -831,7 +698,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te } -Term + Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { Term t = Deref(inp); Term tii = ti; @@ -841,7 +708,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { *to = ti; return t; } else if (IsPrimitiveTerm(t)) { - *to = ti; + *to = ti; return t; } else if (IsPairTerm(t)) { CELL *ap; @@ -882,7 +749,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { arity = ArityOfFunctor(f); HR += 1+arity; - { + { Int res; if ((res = break_rationals_complex_term(ap, ap+(arity), HB0+1, to, ti, HB0 PASS_REGS)) < 0) { HR = HB0; @@ -899,7 +766,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { } } -static int + static int break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS) { @@ -920,7 +787,7 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL if (new) { /* mark cell as pointing to new copy */ /* we can only mark after reading the value of the first argument */ - TrailedMaBind(pt0, new); + MaBind(pt0, new); new = 0L; } deref_head(d0, break_rationals_unk); @@ -1054,7 +921,7 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL return -3; } -Term + Term Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; @@ -1106,21 +973,21 @@ p_break_rational3( USES_REGS1 ) /* - FAST EXPORT ROUTINE. Export a Prolog term to something like: + FAST EXPORT ROUTINE. Export a Prolog term to something like: - CELL 0: offset for start of term - CELL 1: size of actual term (to be copied to stack) - CELL 2: the original term (just for reference) + CELL 0: offset for start of term + CELL 1: size of actual term (to be copied to stack) + CELL 2: the original term (just for reference) - Atoms and functors: - - atoms are either: - 0 and a char *string - -1 and a wchar_t *string - - functors are a CELL with arity and a string. + Atoms and functors: + - atoms are either: + 0 and a char *string + -1 and a wchar_t *string + - functors are a CELL with arity and a string. - Compiled Term. + Compiled Term. -*/ + */ static inline CELL *CellDifH(CELL *hptr, CELL *hlow) @@ -1175,14 +1042,14 @@ Functor export_functor(Functor f, char **hpp, char *buf, size_t len) return (Functor)(((char *)hptr-buf)+1); } -#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \ - do { \ - if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \ - (A) = (CELL *)(D); \ - (D) = *(CELL *)(D); \ - if(!IsVarTerm(D)) goto LabelNonVar; \ - LabelUnk: ; \ - } while (Unsigned(A) != (D)) +#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \ + do { \ + if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \ + (A) = (CELL *)(D); \ + (D) = *(CELL *)(D); \ + if(!IsVarTerm(D)) goto LabelNonVar; \ + LabelUnk: ; \ + } while (Unsigned(A) != (D)) static int @@ -1424,7 +1291,7 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0, /* follow chain of multi-assigned variables */ return -1; - trail_overflow: +trail_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -1501,7 +1368,7 @@ ExportTerm(Term inp, char * buf, size_t len, UInt arity, int newattvs USES_REGS) size_t Yap_ExportTerm(Term inp, char * buf, size_t len, UInt arity) { CACHE_REGS - return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS); + return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS); } @@ -1519,7 +1386,7 @@ addAtom(Atom t, char *buf) if (!*s) { return Yap_LookupAtom(s+1); } - return NULL; + return NULL; } static UInt @@ -1591,7 +1458,7 @@ import_pair(CELL *hp, char *abase, char *buf, CELL *amax) Term Yap_ImportTerm(char * buf) { CACHE_REGS - CELL *bc = (CELL *)buf; + CELL *bc = (CELL *)buf; size_t sz = bc[1]; Term tinp, tret; tinp = bc[2]; @@ -1672,31 +1539,74 @@ p_kill_exported_term( USES_REGS1 ) static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); + to_visit0 = to_visit; loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - restart: - ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: + { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } + continue; + } - WALK_COMPLEX_TERM(); - continue ; derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); /* do or pt2 are unbound */ @@ -1719,19 +1629,21 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif goto loop; } - clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); - + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); @@ -1746,9 +1658,50 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter return(inp); } - def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + aux_overflow: + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + return 0L; } @@ -1810,9 +1763,25 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ } do { Term t = Deref(ARG1); - out = vars_in_complex_term(&(t)-1, - &(t), - ARG2 PASS_REGS); + if (IsVarTerm(t)) { + out = AbsPair(HR); + HR += 2; + RESET_VARIABLE(HR-2); + RESET_VARIABLE(HR-1); + Yap_unify((CELL)(HR-2),ARG1); + Yap_unify((CELL)(HR-1),ARG2); + } else if (IsPrimitiveTerm(t)) + out = ARG2; + else if (IsPairTerm(t)) { + out = vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, ARG2 PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), ARG2 PASS_REGS); + } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) return FALSE; @@ -1826,7 +1795,6 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ static Int p_term_variables( USES_REGS1 ) /* variables in term t */ { - Term t = Deref(ARG1); Term out; if (!Yap_IsListOrPartialListTerm(ARG2)) { @@ -1836,9 +1804,24 @@ p_term_variables( USES_REGS1 ) /* variables in term t */ do { Term t = Deref(ARG1); - - out = vars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + if (IsVarTerm(t)) { + Term out = Yap_MkNewPairTerm(); + return + Yap_unify(t,HeadOfTerm(out)) && + Yap_unify(TermNil, TailOfTerm(out)) && + Yap_unify(out, ARG2); + } else if (IsPrimitiveTerm(t)) { + return Yap_unify(TermNil, ARG2); + } else if (IsPairTerm(t)) { + out = vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, TermNil PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), TermNil PASS_REGS); + } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) return FALSE; @@ -1858,15 +1841,21 @@ Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ { Term out; - do { + do { t = Deref(t); if (IsVarTerm(t)) { return MkPairTerm(t, TermNil); - } else if (IsPrimitiveTerm(t)) { + } else if (IsPrimitiveTerm(t)) { return TermNil; - } else { - out = vars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + } else if (IsPairTerm(t)) { + out = vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, TermNil PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), TermNil PASS_REGS); } if (out == 0L) { if (!expand_vts( arity PASS_REGS )) @@ -1884,26 +1873,82 @@ typedef struct att_rec { static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { int lvl = push_text_stack(); - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; + att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t)); + att_rec_t *to_visit_max; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); + to_visit0 = to_visit; + to_visit_max = to_visit0+1024; restart: + do { while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, attvars_in_term_unk); attvars_in_term_nvar: { - WALK_COMPLEX_TERM(); + if (IsPairTerm(d0)) { + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + { + CELL *npt0 = RepPair(d0); + if(IsAtomicTerm(Deref(npt0[0]))) { + pt0 = npt0; + pt0_end = pt0 + 1; + continue; + } + } +#ifdef RATIONAL_TREES + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = pt0+2; + } else if (IsApplTerm(d0)) { + Functor f; + CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + arity_t a = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + a; + } continue; } @@ -1911,44 +1956,62 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); if (IsAttVar(ptd0)) { /* do or pt2 are unbound */ - attvar_record *a0 = RepAttVar(ptd0); - if (a0->AttFunc ==(Functor) TermNil) continue; + *ptd0 = TermNil; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; /* leave an empty slot to fill in later */ if (HR+1024 > ASP) { - goto global_overflow; + goto global_overflow; } HR[1] = AbsPair(HR+2); HR += 2; - HR[-2] = (CELL)&(a0->Done); + HR[-2] = (CELL)ptd0; /* store the terms to visit */ if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } - ptd0 = (CELL*)a0; - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->d0 = *ptd0; - to_visit->ptd0 = ptd0; - to_visit ++; - *ptd0 = TermNil; +#ifdef RATIONAL_TREES + + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = &RepAttVar(ptd0)->Value; pt0_end = &RepAttVar(ptd0)->Atts; - pt0 = pt0_end-1; } + continue; } /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; + if (to_visit == to_visit0) + break; +#ifdef RATIONAL_TREES + to_visit --; + pt0 = to_visit->beg; + pt0_end = to_visit->end; + *pt0 = to_visit->oval; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + } while(true); - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; - } - - clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); + pop_text_stack(lvl); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); @@ -1963,8 +2026,46 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, return(inp); } - def_aux_overflow(); - def_global_overflow(); + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->beg; + *pt0 = to_visit->oval; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); + HR = InitialH; + return 0L; + + aux_overflow: + { + size_t d1 = to_visit-to_visit0; + size_t d2 = to_visit_max-to_visit0; + to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024); + to_visit = to_visit0+d1; + to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); +} +pt0--; +goto restart; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->beg; + *pt0 = to_visit->oval; + } +#endif + clean_tr(TR0 PASS_REGS); +pop_text_stack(lvl); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + return 0L; } @@ -1975,16 +2076,27 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */ do { Term t = Deref(ARG1); - if (IsPrimitiveTerm(t)) { + if (IsVarTerm(t)) { + out = attvars_in_complex_term(VarOfTerm(t)-1, + VarOfTerm(t)+1, TermNil PASS_REGS); + } else if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); - } else { - out = attvars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + } else if (IsPairTerm(t)) { + out = attvars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, TermNil PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + if (IsExtensionFunctor(f)) + return Yap_unify(TermNil, ARG2); + out = attvars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), TermNil PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) - return false; - } + return FALSE; + } } while (out == 0L); return Yap_unify(ARG2,out); } @@ -2004,9 +2116,15 @@ p_term_variables3( USES_REGS1 ) /* variables in term t */ Yap_unify(out, ARG2); } else if (IsPrimitiveTerm(t)) { return Yap_unify(ARG2, ARG3); - } else { - out = vars_in_complex_term(&(t)-1, - &(t), ARG3 PASS_REGS); + } else if (IsPairTerm(t)) { + out = vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, ARG3 PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), ARG3 PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) @@ -2021,12 +2139,7 @@ p_term_variables3( USES_REGS1 ) /* variables in term t */ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); @@ -2046,19 +2159,65 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, } inp = TailOfTerm(inp); } - restart: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - WALK_COMPLEX_TERM() - else if (d0 == TermFoundVar) { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } else if (d0 == TermFoundVar) { /* leave an empty slot to fill in later */ if (HR+1024 > ASP) { goto global_overflow; @@ -2068,24 +2227,28 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, HR[-2] = (CELL)ptd0; *ptd0 = TermNil; } + continue; } - continue; derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; } clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); if (HR != InitialH) { HR[-1] = TermNil; return output; @@ -2093,10 +2256,51 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, return TermNil; } + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + aux_overflow: + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + return 0L; - def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); } static Int @@ -2106,11 +2310,21 @@ p_variables_within_term( USES_REGS1 ) /* variables within term t */ do { Term t = Deref(ARG2); - if (IsPrimitiveTerm(t)) + if (IsVarTerm(t)) { + out = vars_within_complex_term(VarOfTerm(t)-1, + VarOfTerm(t), Deref(ARG1) PASS_REGS); + + } else if (IsPrimitiveTerm(t)) out = TermNil; - else { - out = vars_within_complex_term(&(t)-1, - &(t), Deref(ARG1) PASS_REGS); + else if (IsPairTerm(t)) { + out = vars_within_complex_term(RepPair(t)-1, + RepPair(t)+1, Deref(ARG1) PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = vars_within_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), Deref(ARG1) PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) @@ -2122,12 +2336,7 @@ p_variables_within_term( USES_REGS1 ) /* variables within term t */ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); @@ -2147,19 +2356,65 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } inp = TailOfTerm(inp); } - restart: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - WALK_COMPLEX_TERM(); - + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } continue; } @@ -2184,17 +2439,21 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; } clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); if (HR != InitialH) { HR[-1] = TermNil; return output; @@ -2202,9 +2461,51 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, return TermNil; } - def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + aux_overflow: + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + return 0L; + } static Int @@ -2214,11 +2515,21 @@ p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ do { Term t = Deref(ARG2); - if (IsPrimitiveTerm(t)) + if (IsVarTerm(t)) { + out = new_vars_in_complex_term(VarOfTerm(t)-1, + VarOfTerm(t), Deref(ARG1) PASS_REGS); + + } else if (IsPrimitiveTerm(t)) out = TermNil; - else { - out = new_vars_in_complex_term(&(t)-1, - &(t), Deref(ARG1) PASS_REGS); + else if (IsPairTerm(t)) { + out = new_vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, Deref(ARG1) PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = new_vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), Deref(ARG1) PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) @@ -2230,27 +2541,70 @@ p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; - Term o = TermNil; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); CELL *InitialH = HR; + *HR++ = MkAtomTerm(AtomDollar); + to_visit0 = to_visit; - restart: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - WALK_COMPLEX_TERM(); + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } continue; } @@ -2259,13 +2613,10 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end *ptd0 = TermNil; /* leave an empty slot to fill in later */ if (HR+1024 > ASP) { - o = TermNil; goto global_overflow; } HR[0] = (CELL)ptd0; - HR[1] = o; - o = AbsPair(HR); - HR += 2; + HR ++; /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ @@ -2277,30 +2628,78 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; } clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); - return o; + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + if (HR != InitialH) { + InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1); + return AbsAppl(InitialH); + } else { + return MkAtomTerm(AtomDollar); + } - - def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + aux_overflow: + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + return 0L; } static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) { - register CELL **to_visit0, - **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); CELL *InitialH = HR; to_visit0 = to_visit; @@ -2443,7 +2842,7 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ Functor f = FunctorOfTerm(t); if (f == FunctorHat) { out = bind_vars_in_complex_term(RepAppl(t), - RepAppl(t)+1, TR0 PASS_REGS); + RepAppl(t)+1, TR0 PASS_REGS); if (out == 0L) { goto trail_overflow; } @@ -2461,11 +2860,21 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ } t = ArgOfTerm(2,t); } - if (IsPrimitiveTerm(t)) + if (IsVarTerm(t)) { + out = free_vars_in_complex_term(VarOfTerm(t)-1, + VarOfTerm(t), TR0 PASS_REGS); + + } else if (IsPrimitiveTerm(t)) out = TermNil; + else if (IsPairTerm(t)) { + out = free_vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, TR0 PASS_REGS); + } else { - out = free_vars_in_complex_term(&(t)-1, - &(t), TR0 PASS_REGS); + Functor f = FunctorOfTerm(t); + out = free_vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), TR0 PASS_REGS); } if (out == 0L) { trail_overflow: @@ -2486,36 +2895,80 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) { - int lvl = push_text_stack(); - struct non_single_struct_t *to_visit0, - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit_max; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: { - WALK_COMPLEX_TERM() - else if (d0 == TermFoundVar) { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + + if (IsExtensionFunctor(f)) { + + continue; + } + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } else if (d0 == TermFoundVar) { CELL *pt2 = pt0; while(IsVarTerm(*pt2)) pt2 = (CELL *)(*pt2); - HR[1] = AbsPair(HR+2); - HR[0] = (CELL)pt2; + HR[0] = AbsPair(HR+2); HR += 2; + HR[-1] = (CELL)pt2; *pt2 = TermRefoundVar; } continue; @@ -2530,26 +2983,47 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; + goto loop; } clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); if (HR != InitialH) { - /* close the list */ + CELL *pt0 = InitialH, *pt1 = pt0; + while (pt0 < InitialH) { + if(Deref(pt0[0]) == TermFoundVar) { + pt1[0] = pt0[0]; + pt1[1] = AbsAppl(pt1+2); + pt1 += 2; + } + pt0 += 2; + } + } + if (HR != InitialH) { + /* close the list */ HR[-1] = Deref(ARG2); return output; } else { return ARG2; } - def_aux_overflow(); + aux_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + clean_tr(TR0 PASS_REGS); + if (HR != InitialH) { + /* close the list */ + RESET_VARIABLE(HR-1); + } + return 0L; } static Int @@ -2564,9 +3038,13 @@ p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ out = ARG2; } else if (IsPrimitiveTerm(t)) { out = ARG2; + } else if (IsPairTerm(t)) { + out = non_singletons_in_complex_term(RepPair(t)-1, + RepPair(t)+1 PASS_REGS); } else { - out = non_singletons_in_complex_term(&(t)-1, - &(t) PASS_REGS); + out = non_singletons_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(FunctorOfTerm(t)) PASS_REGS); } if (out != 0L) { return Yap_unify(ARG3,out); @@ -2581,15 +3059,11 @@ p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) { - int lvl = push_text_stack(); - struct non_single_struct_t *to_visit0, - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit_max; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; @@ -2597,64 +3071,137 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R ++pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: - WALK_COMPLEX_TERM(); - continue; + { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } + continue; + } derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); +#ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; } - pop_text_stack(lvl); - return false; +#endif + return FALSE; } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; } - pop_text_stack(lvl); - return true; + return TRUE; - def_aux_overflow(); + aux_overflow: + /* unwind stack */ +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + return -1; } bool Yap_IsGroundTerm(Term t) { CACHE_REGS - while (TRUE) { - Int out; + while (TRUE) { + Int out; - if (IsVarTerm(t)) { - return FALSE; - } else if (IsPrimitiveTerm(t)) { + if (IsVarTerm(t)) { + return FALSE; + } else if (IsPrimitiveTerm(t)) { + return TRUE; + } else if (IsPairTerm(t)) { + if ((out =ground_complex_term(RepPair(t)-1, + RepPair(t)+1 PASS_REGS)) >= 0) { + return out != 0; + } + } else { + Functor fun = FunctorOfTerm(t); + + if (IsExtensionFunctor(fun)) return TRUE; - } else { - if ((out =ground_complex_term(&(t)-1, - &(t) PASS_REGS)) >= 0) { - return out != 0; - } - if (out < 0) { - *HR++ = t; - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); - return false; - } - t = *--HR; + else if ((out = ground_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(fun) PASS_REGS)) >= 0) { + return out != 0; } } + if (out < 0) { + *HR++ = t; + if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); + return false; + } + t = *--HR; } + } } static Int @@ -2807,32 +3354,32 @@ int Yap_SizeGroundTerm(Term t, int ground) { CACHE_REGS - if (IsVarTerm(t)) { - if (!ground) - return 1; - return 0; - } else if (IsPrimitiveTerm(t)) { + if (IsVarTerm(t)) { + if (!ground) return 1; - } else if (IsPairTerm(t)) { - int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground PASS_REGS); - if (sz <= 0) - return sz; - return sz+2; - } else { - int sz = 0; - Functor fun = FunctorOfTerm(t); + return 0; + } else if (IsPrimitiveTerm(t)) { + return 1; + } else if (IsPairTerm(t)) { + int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground PASS_REGS); + if (sz <= 0) + return sz; + return sz+2; +} else { + int sz = 0; + Functor fun = FunctorOfTerm(t); - if (IsExtensionFunctor(fun)) - return 1+ SizeOfExtension(t); + if (IsExtensionFunctor(fun)) + return 1+ SizeOfExtension(t); - sz = sz_ground_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(fun), - ground PASS_REGS); - if (sz <= 0) - return sz; - return 1+ArityOfFunctor(fun)+sz; - } + sz = sz_ground_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(fun), + ground PASS_REGS); + if (sz <= 0) + return sz; + return 1+ArityOfFunctor(fun)+sz; + } } static Int var_in_complex_term(register CELL *pt0, @@ -3003,52 +3550,52 @@ p_var_in_term( USES_REGS1 ) // And it has a few limitations - // 1. It will not work incrementally. -// 2. It will not produce the same results on litle-endian and big-endian +// 2. It will not produce the same results on little-endian and big-endian // machines. static unsigned int MurmurHashNeutral2 ( const void * key, int len, unsigned int seed ) { - const unsigned int m = 0x5bd1e995; - const int r = 24; + const unsigned int m = 0x5bd1e995; + const int r = 24; - unsigned int h = seed ^ len; + unsigned int h = seed ^ len; - const unsigned char * data = (const unsigned char *)key; + const unsigned char * data = (const unsigned char *)key; - while(len >= 4) - { - unsigned int k; + while(len >= 4) + { + unsigned int k; - k = data[0]; - k |= data[1] << 8; - k |= data[2] << 16; - k |= data[3] << 24; + k = data[0]; + k |= data[1] << 8; + k |= data[2] << 16; + k |= data[3] << 24; - k *= m; - k ^= k >> r; - k *= m; + k *= m; + k ^= k >> r; + k *= m; - h *= m; - h ^= k; + h *= m; + h ^= k; - data += 4; - len -= 4; - } + data += 4; + len -= 4; + } - switch(len) - { - case 3: h ^= data[2] << 16; - case 2: h ^= data[1] << 8; - case 1: h ^= data[0]; - h *= m; - }; + switch(len) + { + case 3: h ^= data[2] << 16; + case 2: h ^= data[1] << 8; + case 1: h ^= data[0]; + h *= m; + }; - h ^= h >> 13; - h *= m; - h ^= h >> 15; + h ^= h >> 13; + h *= m; + h ^= h >> 15; - return h; + return h; } static CELL * @@ -3056,20 +3603,20 @@ addAtomToHash(CELL *st, Atom at) { unsigned int len; - char *c = RepAtom(at)->StrOfAE; - int ulen = strlen(c); - /* fix hashing over empty atom */ - if (!ulen) { - return st; - } - if (ulen % CellSize == 0) { - len = ulen/CellSize; - } else { - len = ulen/CellSize; - len++; - } - st[len-1] = 0L; - strncpy((char *)st, c, ulen); + char *c = RepAtom(at)->StrOfAE; + int ulen = strlen(c); + /* fix hashing over empty atom */ + if (!ulen) { + return st; + } + if (ulen % CellSize == 0) { + len = ulen/CellSize; + } else { + len = ulen/CellSize; + len++; + } + st[len-1] = 0L; + strncpy((char *)st, c, ulen); return st+len; } @@ -3241,7 +3788,7 @@ Int Yap_TermHash(Term t, Int size, Int depth, int variant) { CACHE_REGS - unsigned int i1; + unsigned int i1; Term t1 = Deref(t); while (TRUE) { @@ -3386,7 +3933,7 @@ p_instantiated_term_hash( USES_REGS1 ) } static int variant_complex(register CELL *pt0, register CELL *pt0_end, register - CELL *pt1 USES_REGS) + CELL *pt1 USES_REGS) { tr_fr_ptr OLDTR = TR; register CELL **to_visit = (CELL **)ASP; @@ -3475,16 +4022,16 @@ static int variant_complex(register CELL *pt0, register CELL *pt0_end, register continue; } #ifdef RATIONAL_TREES - /* now link the two structures so that no one else will */ - /* come here */ - to_visit -= 4; - if ((CELL *)to_visit < HR+1024) - goto out_of_stack; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)*pt0; - *pt0 = d1; + /* now link the two structures so that no one else will */ + /* come here */ + to_visit -= 4; + if ((CELL *)to_visit < HR+1024) + goto out_of_stack; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = (CELL *)*pt0; + *pt0 = d1; #else /* store the terms to visit */ if (pt0 < pt0_end) { @@ -3628,7 +4175,7 @@ bool Yap_Variant(Term t1, Term t2) { CACHE_REGS - return is_variant(t1, t2, 0 PASS_REGS); + return is_variant(t1, t2, 0 PASS_REGS); } static Int @@ -3639,7 +4186,7 @@ p_variant( USES_REGS1 ) /* variant terms t1 and t2 */ static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register - CELL *pt1 USES_REGS) + CELL *pt1 USES_REGS) { register CELL **to_visit = (CELL **)ASP; tr_fr_ptr OLDTR = TR, new_tr; @@ -3868,8 +4415,8 @@ p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */ if (IsPairTerm(t1)) { if (IsPairTerm(t2)) { return(subsumes_complex(RepPair(t1)-1, - RepPair(t1)+1, - RepPair(t2)-1 PASS_REGS)); + RepPair(t1)+1, + RepPair(t2)-1 PASS_REGS)); } else return (FALSE); } else { @@ -3883,8 +4430,8 @@ p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */ return(unify_extension(f1, t1, RepAppl(t1), t2)); } return(subsumes_complex(RepAppl(t1), - RepAppl(t1)+ArityOfFunctor(f1), - RepAppl(t2) PASS_REGS)); + RepAppl(t1)+ArityOfFunctor(f1), + RepAppl(t2) PASS_REGS)); } } @@ -4135,7 +4682,7 @@ p_term_subsumer( USES_REGS1 ) /* term_subsumer terms t1 and t2 */ HB = B->cp_h; return Yap_unify(ARG3,tf); } - } else if (IsApplTerm(t1) && IsApplTerm(t2)) { + } else if (IsApplTerm(t1) && IsApplTerm(t2)) { Functor f1; if ((f1 = FunctorOfTerm(t1)) == FunctorOfTerm(t2)) { @@ -4270,41 +4817,64 @@ extern int vsc; int vsc; -#define RENUMBER_SINGLES \ - if (singles && ap2 >= InitialH && ap2 < HR) { \ - renumbervar(d0, numbv++ PASS_REGS); \ - continue; \ - } - - static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; + att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t)); + att_rec_t *to_visit_max; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: + to_visit_max = to_visit0+1024; +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: { - WALK_COMPLEX_TERM__({},RENUMBER_SINGLES); - + if (IsPairTerm(d0)) { + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; + *pt0 = TermNil; + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + Functor f; + CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + if (singles && ap2 >= InitialH && ap2 < HR) { + renumbervar(d0, numbv++ PASS_REGS); + continue; + } + /* store the terms to visit */ + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; + *pt0 = TermNil; + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } continue; } @@ -4334,30 +4904,74 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; +#ifdef RATIONAL_TREES + to_visit --; + pt0 = to_visit->beg; + pt0_end = to_visit->end; + *pt0 = to_visit->oval; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; } prune(B PASS_REGS); pop_text_stack(lvl); return numbv; - def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->beg; + pt0_end = to_visit->end; + *pt0 = to_visit->oval; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + HR = InitialH; + pop_text_stack(lvl); + return numbv-1; + + aux_overflow: + { + size_t d1 = to_visit-to_visit0; + size_t d2 = to_visit_max-to_visit0; + to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024); + to_visit = to_visit0+d1; + to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); +} +pt0--; +goto loop; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->beg; + pt0_end = to_visit->end; + *pt0 = to_visit->oval; + } +#endif + clean_tr(TR0 PASS_REGS); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + pop_text_stack(lvl); + return numbv-1; + } Int Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* - * numbervariables in term t */ + * numbervariables in term t */ { CACHE_REGS - Int out; + Int out; Term t; restart: @@ -4381,7 +4995,7 @@ Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* Functor f = FunctorOfTerm(t); out = numbervars_in_complex_term(RepAppl(t), - RepAppl(t)+ + RepAppl(t)+ ArityOfFunctor(f), numbv, handle_singles PASS_REGS); } if (out < numbv) { @@ -4421,7 +5035,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share int ground = share; Int max = -1; - int lvl = push_text_stack(); HB = HLow; to_visit0 = to_visit; loop: @@ -4443,6 +5056,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share } *ptf = AbsPair(HR); ptf++; +#ifdef RATIONAL_TREES if (to_visit+1 >= (struct cp_frame *)AuxSp) { goto heap_overflow; } @@ -4454,6 +5068,18 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* fool the system into thinking we had a variable there */ *pt0 = AbsPair(HR); to_visit ++; +#else + if (pt0 < pt0_end) { + if (to_visit+1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit ++; + } +#endif ground = share; pt0 = ap2 - 1; pt0_end = ap2 + 1; @@ -4482,7 +5108,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share Int id = IntegerOfTerm(ap2[1]); ground = FALSE; if (id < -1) { - pop_text_stack(lvl); Yap_Error(RESOURCE_ERROR_STACK, TermNil, "unnumber vars cannot cope with VAR(-%d)", id); return 0L; } @@ -4517,6 +5142,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share *ptf = AbsAppl(HR); ptf++; /* store the terms to visit */ +#ifdef RATIONAL_TREES if (to_visit+1 >= (struct cp_frame *)AuxSp) { goto heap_overflow; } @@ -4528,6 +5154,18 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* fool the system into thinking we had a variable there */ *pt0 = AbsAppl(HR); to_visit ++; +#else + if (pt0 < pt0_end) { + if (to_visit+1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit ++; + } +#endif ground = (f != FunctorMutable) && share; d0 = ArityOfFunctor(f); pt0 = ap2; @@ -4578,7 +5216,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* restore our nice, friendly, term to its original state */ clean_dirty_tr(TR0 PASS_REGS); HB = HB0; - pop_text_stack(lvl); return ground; overflow: @@ -4587,6 +5224,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; +#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; @@ -4594,9 +5232,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share ptf = to_visit->to; *pt0 = to_visit->oldv; } +#endif reset_trail(TR0); /* follow chain of multi-assigned variables */ - pop_text_stack(lvl); return -1; heap_overflow: @@ -4605,6 +5243,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; +#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; @@ -4612,9 +5251,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share ptf = to_visit->to; *pt0 = to_visit->oldv; } +#endif reset_trail(TR0); LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; - pop_text_stack(lvl); return -3; } @@ -4689,7 +5328,7 @@ UnnumberTerm(Term inp, UInt arity, int share USES_REGS) { Term Yap_UnNumberTerm(Term inp, int share) { CACHE_REGS - return UnnumberTerm(inp, 0, share PASS_REGS); + return UnnumberTerm(inp, 0, share PASS_REGS); } static Int @@ -4709,19 +5348,19 @@ Yap_SkipList(Term *l, Term **tailp) s = l; if ( IsPairTerm(*l) ) - { intptr_t power = 1, lam = 0; - do - { if ( power == lam ) - { s = l; - power *= 2; - lam = 0; - } - lam++; - length++; - l = RepPair(*l)+1; - do_derefa(v,l,derefa2_unk,derefa2_nonvar); - } while ( *l != *s && IsPairTerm(*l) ); - } + { intptr_t power = 1, lam = 0; + do + { if ( power == lam ) + { s = l; + power *= 2; + lam = 0; + } + lam++; + length++; + l = RepPair(*l)+1; + do_derefa(v,l,derefa2_unk,derefa2_nonvar); + } while ( *l != *s && IsPairTerm(*l) ); + } *tailp = l; return length; @@ -4844,121 +5483,121 @@ p_reset_variables( USES_REGS1 ) void Yap_InitUtilCPreds(void) { CACHE_REGS - Term cm = CurrentModule; + Term cm = CurrentModule; Yap_InitCPred("copy_term", 2, p_copy_term, 0); - /** @pred copy_term(? _TI_,- _TF_) is iso +/** @pred copy_term(? _TI_,- _TF_) is iso - Term _TF_ is a variant of the original term _TI_, such that for - each variable _V_ in the term _TI_ there is a new variable _V'_ - in term _TF_. Notice that: +Term _TF_ is a variant of the original term _TI_, such that for +each variable _V_ in the term _TI_ there is a new variable _V'_ +in term _TF_. Notice that: - + suspended goals and attributes for attributed variables in _TI_ are also duplicated; - + ground terms are shared between the new and the old term. ++ suspended goals and attributes for attributed variables in _TI_ are also duplicated; ++ ground terms are shared between the new and the old term. - If you do not want any sharing to occur please use - duplicate_term/2. +If you do not want any sharing to occur please use +duplicate_term/2. - */ +*/ Yap_InitCPred("duplicate_term", 2, p_duplicate_term, 0); - /** @pred duplicate_term(? _TI_,- _TF_) +/** @pred duplicate_term(? _TI_,- _TF_) - Term _TF_ is a variant of the original term _TI_, such that - for each variable _V_ in the term _TI_ there is a new variable - _V'_ in term _TF_, and the two terms do not share any - structure. All suspended goals and attributes for attributed variables - in _TI_ are also duplicated. +Term _TF_ is a variant of the original term _TI_, such that +for each variable _V_ in the term _TI_ there is a new variable + _V'_ in term _TF_, and the two terms do not share any +structure. All suspended goals and attributes for attributed variables +in _TI_ are also duplicated. - Also refer to copy_term/2. +Also refer to copy_term/2. - */ +*/ Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0); - /** @pred copy_term_nat(? _TI_,- _TF_) +/** @pred copy_term_nat(? _TI_,- _TF_) - As copy_term/2. Attributes however, are not copied but replaced - by fresh variables. +As copy_term/2. Attributes however, are not copied but replaced +by fresh variables. - */ + */ Yap_InitCPred("ground", 1, p_ground, SafePredFlag); - /** @pred ground( _T_) is iso +/** @pred ground( _T_) is iso - Succeeds if there are no free variables in the term _T_. +Succeeds if there are no free variables in the term _T_. - */ +*/ Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); Yap_InitCPred("term_variables", 2, p_term_variables, 0); - /** @pred term_variables(? _Term_, - _Variables_) is iso +/** @pred term_variables(? _Term_, - _Variables_) is iso - Unify _Variables_ with the list of all variables of term - _Term_. The variables occur in the order of their first - appearance when traversing the term depth-first, left-to-right. +Unify _Variables_ with the list of all variables of term + _Term_. The variables occur in the order of their first +appearance when traversing the term depth-first, left-to-right. - */ +*/ Yap_InitCPred("term_variables", 3, p_term_variables3, 0); Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); - /** @pred term_attvars(+ _Term_,- _AttVars_) +/** @pred term_attvars(+ _Term_,- _AttVars_) - _AttVars_ is a list of all attributed variables in _Term_ and - its attributes. I.e., term_attvars/2 works recursively through - attributes. This predicate is Cycle-safe. + _AttVars_ is a list of all attributed variables in _Term_ and +its attributes. I.e., term_attvars/2 works recursively through +attributes. This predicate is Cycle-safe. - */ +*/ Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag|TestPredFlag); Yap_InitCPred("$is_list_or_partial_list", 1, p_is_list_or_partial_list, SafePredFlag|TestPredFlag); Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0); - /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) +/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) - The term _TF_ is a forest representation (without cycles and repeated - terms) for the Prolog term _TI_. The term _TF_ is the main term. The - difference list _SubTerms_-_MoreSubterms_ stores terms of the form - _V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy - of a sub-term from _TI_. +The term _TF_ is a forest representation (without cycles and repeated +terms) for the Prolog term _TI_. The term _TF_ is the main term. The +difference list _SubTerms_-_MoreSubterms_ stores terms of the form +_V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy +of a sub-term from _TI_. - */ +*/ Yap_InitCPred("term_factorized", 3, p_break_rational3, 0); - /** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) +/** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) - Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. +Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. - */ +*/ Yap_InitCPred("=@=", 2, p_variant, 0); Yap_InitCPred("numbervars", 3, p_numbervars, 0); - /** @pred numbervars( _T_,+ _N1_,- _Nn_) +/** @pred numbervars( _T_,+ _N1_,- _Nn_) - Instantiates each variable in term _T_ to a term of the form: - `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. +Instantiates each variable in term _T_ to a term of the form: +`$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. - */ +*/ Yap_InitCPred("unnumbervars", 2, p_unnumbervars, 0); - /** @pred unnumbervars( _T_,+ _NT_) +/** @pred unnumbervars( _T_,+ _NT_) - Replace every `$VAR( _I_)` by a free variable. +Replace every `$VAR( _I_)` by a free variable. - */ +*/ /* use this carefully */ Yap_InitCPred("$skip_list", 3, p_skip_list, SafePredFlag|TestPredFlag); Yap_InitCPred("$skip_list", 4, p_skip_list4, SafePredFlag|TestPredFlag); diff --git a/C/write.c b/C/write.c index d2c49ab89..95df7a945 100644 --- a/C/write.c +++ b/C/write.c @@ -77,8 +77,6 @@ typedef struct write_globs { int last_atom_minus; UInt MaxDepth, MaxArgs; wtype lw; - yhandle_t sl0, sl; - bool protectedEntry; } wglbs; #define lastw wglb->lw @@ -102,10 +100,11 @@ static bool callPortray(Term t, int sno USES_REGS) { return false; } -#define PROTECT(t, F) \ - { \ - F; \ - t = Yap_GetFromSlot(wglb->sl); \ +#define PROTECT(t, F) \ + { \ + yhandle_t yt = Yap_InitHandle(t); \ + F; \ + t = Yap_PopHandle(yt); \ } static void wrputn(Int, struct write_globs *); static void wrputf(Float, struct write_globs *); @@ -117,11 +116,6 @@ static wtype AtomIsSymbols(unsigned char *); static void putAtom(Atom, int, struct write_globs *); static void writeTerm(Term, int, int, int, struct write_globs *, struct rewind_term *); -static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, - struct write_globs *wglb, struct rewind_term *rwt); - -static void write_list(Term t, int direction, int depth, - struct write_globs *wglb, struct rewind_term *rwt); #define wrputc(WF, X) \ (X)->stream_wputc(X - GLOBAL_Stream, WF) /* writes a character */ @@ -273,7 +267,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg, return; } else if (big_tag == BIG_RATIONAL) { Term trat = Yap_RatTermToApplTerm(t); - writeTerm__(trat,wglb->sl, p, depth, rinfixarg, wglb, rwt); + writeTerm(trat, p, depth, rinfixarg, wglb, rwt); return; #endif } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) { @@ -387,7 +381,8 @@ int Yap_FormatFloat(Float f, char **s, size_t sz) { struct write_globs wglb; int sno; - sno = Yap_open_buf_write_stream(GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); + sno = Yap_open_buf_write_stream(GLOBAL_Stream[LOCAL_c_output_stream].encoding, + 0); if (sno < 0) return false; wglb.lw = separator; @@ -706,9 +701,7 @@ static void write_var(CELL *t, struct write_globs *wglb, wrputs("$AT(", wglb->stream); write_var(t, wglb, rwt); wrputc(',', wglb->stream); - CELL tt = (CELL)t; - PROTECT(tt, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); - t = (CELL *)tt; + PROTECT(*t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); attv = RepAttVar(t); wrputc(',', wglb->stream); l++; @@ -725,32 +718,13 @@ static void write_var(CELL *t, struct write_globs *wglb, } } -static bool check_for_loops(Term t, struct write_globs *wglb) -{ - yhandle_t i, sl = wglb->sl; - if ((wglb->Write_Loops)) { - return false; - } - for (i=sl-1; i>wglb->sl0;i--) { - if (Yap_GetFromHandle(i) == t) { - char buf[64]; - snprintf(buf,63," @{ ^^%ld } " ,sl-i); - wrputs(buf, wglb->stream); - return true; - } - } - return false; -} - - -static void write_list__(Term t, yhandle_t sl, int direction, int depth, +static void write_list(Term t, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt) { Term ti; struct rewind_term nrwt; nrwt.parent = rwt; nrwt.u_sd.s.ptr = 0; - while (1) { int ndirection; int do_jump; @@ -761,18 +735,16 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth, break; if (!IsPairTerm(ti)) break; - if (check_for_loops(ti,wglb)) return; - wglb->sl = Yap_InitHandle(ti); ndirection = RepPair(ti) - RepPair(t); /* make sure we're not trapped in loops */ if (ndirection > 0) { do_jump = (direction <= 0); - } /*else if (ndirection == 0) { + } else if (ndirection == 0) { wrputc(',', wglb->stream); putAtom(AtomFoundVar, wglb->Quote_illegal, wglb); lastw = separator; return; - } */ else { + } else { do_jump = (direction >= 0); } if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { @@ -806,24 +778,16 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth, } } -static void write_list(Term t, int direction, int depth, - struct write_globs *wglb, struct rewind_term *rwt) { - if (check_for_loops(t,wglb)) return; - yhandle_t sl = wglb->sl = Yap_InitHandle(t); - write_list__(t, sl, direction, depth, - wglb, rwt); - Yap_PopHandle(sl); - wglb->sl = sl-1; -} - - -static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, - struct write_globs *wglb, struct rewind_term *rwt) +static void writeTerm(Term t, int p, int depth, int rinfixarg, + struct write_globs *wglb, struct rewind_term *rwt) /* term to write */ /* context priority */ { CACHE_REGS - struct rewind_term nrwt; + struct rewind_term nrwt; + nrwt.parent = rwt; + nrwt.u_sd.s.ptr = 0; + if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { putAtom(Atom3Dots, wglb->Quote_illegal, wglb); return; @@ -857,7 +821,7 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, wrputc('[', wglb->stream); lastw = separator; /* we assume t was already saved in the stack */ - write_list__(t, wglb->sl, 0, depth, wglb, rwt); + write_list(t, 0, depth, wglb, rwt); wrputc(']', wglb->stream); lastw = separator; } @@ -909,7 +873,7 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, *p++; lastw = separator; /* cannot use the term directly with the SBA */ - writeTerm(*p, 999, depth + 1, FALSE, wglb, &nrwt); + PROTECT(t, writeTerm(*p, 999, depth + 1, FALSE, wglb, &nrwt)); if (*p) wrputc(',', wglb->stream); argno++; @@ -1126,17 +1090,6 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, } } -static void writeTerm(Term t, int p, int depth, int rinfixarg, - struct write_globs *wglb, struct rewind_term *rwt) -{ - if (check_for_loops(t,wglb)) return; - yhandle_t sl = wglb->sl = Yap_InitHandle(t); - writeTerm__(t, sl, p, depth, rinfixarg, - wglb, rwt); - Yap_PopHandle(sl); - wglb->sl = sl-1; -} - void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int priority) /* term to be written */ @@ -1171,7 +1124,6 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, rwt.parent = NULL; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; - wglb.Write_Loops = flags & YAP_WRITE_HANDLE_CYCLES; if (!(flags & Ignore_cyclics_f) && false) { Term ts[2]; ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS); @@ -1183,8 +1135,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, } } /* protect slots for portray */ - wglb.sl0 = (wglb.sl = Yap_InitHandle(t))-1; - writeTerm__(t,wglb.sl, priority, 1, FALSE, &wglb, &rwt); + writeTerm(t, priority, 1, FALSE, &wglb, &rwt); if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); diff --git a/pl/messages.yap b/pl/messages.yap index 9209911f1..a1fb3a93e 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -108,7 +108,8 @@ In YAP, the info field describes: :- use_system_module( user, [message_hook/3]). %:- start_low_level_trace. -:- multifile prolog:message/3. +:- dynamic prolog:message//1. +:- multifile prolog:message//1. %:- stop_low_level_trace. :- multifile user:message_hook/3. @@ -374,7 +375,8 @@ display_consulting( F, Level, Info, LC) --> '$error_descriptor'(Info, Desc), query_exception(prologParserFile, Desc, F0), query_exception(prologParserLine, Desc, L), - F \= F0 + integer(L) +, F \= F0 }, !, [ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ]. display_consulting( F, Level, _, LC) --> diff --git a/pl/undefined.yap b/pl/undefined.yap index 963a481a5..811891732 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -97,7 +97,7 @@ undefined_query(G0, M0, Cut) :- '$undefp'([M0|G0],MG) :- % make sure we do not loop on undefined predicates '$undef_setup'(M0:G0, Action,Debug,Current, MGI), - ('$get_undefined_predicates'(Current, MGI, MG ) , MG) + ('$get_undefined_predicates'( MGI, MG ) , MG) -> true ; @@ -119,10 +119,11 @@ undefined_query(G0, M0, Cut) :- '$handle_error'(fail,_Goal,_Mod) :- fail. -'$undef_setup'(Action,Debug,Current) :- +'$undef_setup'(G0,Action,Debug,Current,GI) :- yap_flag( unknown, Action, fail), yap_flag( debug, Debug, false), - '$stop_creeping'(Current). + '$stop_creeping'(Current), + '$g2i'(G0,GI). '$g2i'(user:G, Na/Ar ) :- !, From dfe0698f03ef04087d4c1cda4cea5b729757ca5f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 30 Jan 2019 10:44:28 +0000 Subject: [PATCH 019/101] small booting fixes --- C/errors.c | 7 + C/globals.c | 2 +- C/write.c | 17 - pl/absf.yap | 819 ++++++++++++++++++++++++------------------------- pl/boot.yap | 143 ++++----- pl/consult.yap | 12 +- pl/protect.yap | 3 +- 7 files changed, 481 insertions(+), 522 deletions(-) diff --git a/C/errors.c b/C/errors.c index 2e02c1cbe..dc5dc7c61 100755 --- a/C/errors.c +++ b/C/errors.c @@ -1030,6 +1030,13 @@ static Int print_exception(USES_REGS1) { Term t1 = Deref(ARG1); if (IsAddressTerm(t1)) { yap_error_descriptor_t *t = AddressOfTerm(t1); + if (t->parserFile && t->parserLine) { + fprintf(stderr,"\n%s:%ld:0 error: while parsing %s\n\n", t->parserFile, t->parserLine,t->errorAsText); + } else if (t->prologPredFile && t->prologPredLine) { + fprintf(stderr,"\n%s:%ld:0 error: while running %s\n\n", t->prologPredFile, t->prologPredLine,t->errorAsText); + } else if (t->errorFile && t->errorLine) { + fprintf(stderr,"\n%s:%ld:0 error: while executing %s\n\n", t->errorFile, t->errorLine,t->errorAsText); + } printErr(t); } else { return Yap_WriteTerm(LOCAL_c_error_stream,t1,TermNil PASS_REGS); diff --git a/C/globals.c b/C/globals.c index 1e77bf2d1..59be2a42b 100644 --- a/C/globals.c +++ b/C/globals.c @@ -228,7 +228,7 @@ static Int p_default_arena_size(USES_REGS1) { return Yap_unify(ARG1, MkIntegerTerm(ArenaSz(LOCAL_GlobalArena))); } -void Yap_AllocateDefaultArena(Int gsize, Int attsize, int wid) { +void Yap_AllocateDefaultArena(size_t gsize, int wid) { REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL); } diff --git a/C/write.c b/C/write.c index 95df7a945..f7fd79969 100644 --- a/C/write.c +++ b/C/write.c @@ -726,8 +726,6 @@ static void write_list(Term t, int direction, int depth, nrwt.u_sd.s.ptr = 0; while (1) { - int ndirection; - int do_jump; PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); ti = TailOfTerm(t); @@ -735,18 +733,6 @@ static void write_list(Term t, int direction, int depth, break; if (!IsPairTerm(ti)) break; - ndirection = RepPair(ti) - RepPair(t); - /* make sure we're not trapped in loops */ - if (ndirection > 0) { - do_jump = (direction <= 0); - } else if (ndirection == 0) { - wrputc(',', wglb->stream); - putAtom(AtomFoundVar, wglb->Quote_illegal, wglb); - lastw = separator; - return; - } else { - do_jump = (direction >= 0); - } if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { if (lastw == symbol || lastw == separator) { wrputc(' ', wglb->stream); @@ -756,10 +742,7 @@ static void write_list(Term t, int direction, int depth, return; } lastw = separator; - direction = ndirection; depth++; - if (do_jump) - break; wrputc(',', wglb->stream); t = ti; } diff --git a/pl/absf.yap b/pl/absf.yap index f271bbec0..43bbe3aa9 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -1,4 +1,4 @@ -qqqqq/************************************************************************* +/************************************************************************* * * * YAP Prolog * * * @@ -30,14 +30,413 @@ qqqqq/************************************************************************* add_to_path/1, add_to_path/2, path/1, - remove_from_path/1], ['$full_filename'/2, - '$system_library_directories'/2]). + remove_from_path/1]). -:- use_system_module( '$_boot', ['$system_catch'/4]). -:- use_system_module( '$_errors', ['$do_error'/2]). +absolute_file_name__(File,LOpts,TrueFileName) :- + % must_be_of_type( atom, File ), + % look for solutions + gated_call( -:- use_system_module( '$_lists', [member/2]). + '$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ), + '$find_in_path'(File, Opts,TrueFileName, HasSol, TakeFirst), + Port, + '$absf_port'(Port, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) + ). + +'$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- + ( var(File) -> instantiation_error(File) ; true), + abs_file_parameters(LOpts,Opts), + current_prolog_flag(open_expands_filename, OldF), + current_prolog_flag( fileerrors, PreviousFileErrors ), + current_prolog_flag( verbose_file_search, PreviousVerbose ), + get_abs_file_parameter( verbose_file_search, Opts,Verbose ), + get_abs_file_parameter( expand, Opts, Expand ), + set_prolog_flag( verbose_file_search, Verbose ), + get_abs_file_parameter( file_errors, Opts, FErrors ), + get_abs_file_parameter( solutions, Opts, TakeFirst ), + ( FErrors == fail -> FileErrors = false ; FileErrors = true ), + set_prolog_flag( fileerrors, FileErrors ), + set_prolog_flag(file_name_variables, Expand), + absf_trace(File), + '$absf_trace_options'(LOpts), + HasSol = t(no). + +'$absf_port'(answer, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- + '$absf_port'(exit, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). +'$absf_port'(exit, _File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, TakeFirst, _FileErrors ) :- + (TakeFirst == first -> ! ; nb_setarg(1, HasSol, yes) ), + set_prolog_flag( fileerrors, PreviousFileErrors ), + set_prolog_flag( open_expands_filename, OldF), + set_prolog_flag( verbose_file_search, PreviousVerbose ), + absf_trace(' |------- found ~a', [TrueFileName]). +'$absf_port'(redo, File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, Expand, Verbose, _TakeFirst, FileErrors ) :- + set_prolog_flag( fileerrors, FileErrors ), + set_prolog_flag( verbose_file_search, Verbose ), + set_prolog_flag( file_name_variables, Expand ), + absf_trace(' |------- restarted search for ~a', [File]). +'$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, _TakeFirst, FileErrors ) :- + absf_trace(' !------- failed.', []), + set_prolog_flag( fileerrors, PreviousFileErrors ), + set_prolog_flag( verbose_file_search, PreviousVerbose ), + set_prolog_flag(file_name_variables, OldF), + % check if no solution + arg(1,HasSol,no), + FileErrors = error, + '$do_error'(existence_error(file,File),absolute_file_name(File, TrueFileName, ['...'])). +'$absf_port'(!, _File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, _Expand, _Verbose, _TakeFirst, _FileErrors ). +'$absf_port'(exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- + '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). +'$absf_port'(external_exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- + '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). + + + +core_file_name(Name, Opts) --> + '$file_name'(Name, Opts, E), + '$suffix'(E, Opts), + '$glob'(Opts). + + % +% handle library(lists) or foreign(jpl) +% +'$file_name'(Name, Opts, E) --> + { Name =.. [Lib, P0] }, + !, + { user:file_search_path(Lib, IDirs) }, + { '$paths'(IDirs, Dir ) }, + absf_trace(' ~w first', [Dir]), + '$file_name'(Dir, Opts, _), + '$dir', + { absf_trace(' ~w next', [P0]) }, + '$cat_file_name'(P0, E). +'$file_name'(Name, _Opts, E) --> + '$cat_file_name'(Name, E ). + /* + ( + { + get_abs_file_parameter( file_type, _Opts, Lib ), + nonvar(Lib) + } + -> + { user:file_search_path(Lib, IDirs) }, + { '$paths'(IDirs, Dir ) }, + absf_trace(' ~w first', [Dir]), + '$file_name'(Dir, Opts, _), + '$dir', + { absf_trace(' ~w next', [P0]) } + ; + [] + ). + */ + + +'$cat_file_name'(A/B, E ) --> + '$cat_file_name'(A, _), + '$dir', + '$cat_file_name'(B, E). +'$cat_file_name'(File, F) --> + { atom(File), atom_codes(File, F) }, + !, + F. +'$cat_file_name'(File, S) --> + {string(File), string_codes(File, S) }, + S. + + +'$variable_expansion'( Path, Opts, APath ) :- + get_abs_file_parameter( expand, Opts, true ), + !, + '$expand_file_name'( Path, APath ). +'$variable_expansion'( Path, _, Path ). + + +'$var'(S) --> + "{", !, '$id'(S), "}". +'$var'(S) --> + '$id'(S). + +'$drive'(C) --> + '$id'(C), + ":\\\\". + +'$id'([C|S]) --> [C], + { C >= "a", C =< "z" ; C >= "A", C =< "Z" ; + C >= "0", C =< "9" ; C =:= "_" }, + !, + '$id'(S). +'$id'([]) --> []. + + +% always verify if a directory +'$check_file'(F, directory, _) :- + !, + exists_directory(F). +'$check_file'(_F, _Type, none) :- !. +'$check_file'(F, _Type, exist) :- + '$access_file'(F, exist). % if it has a type cannot be a directory.. +'$check_file'(F, _Type, Access) :- + '$access_file'(F, Access), + \+ exists_directory(F). % if it has a type cannot be a directory.. + +'$suffix'(Last, _Opts) --> + { lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) }, + absf_trace(' suffix in ~s', [Alphas]), + !. +'$suffix'(_, Opts) --> + { + ( + get_abs_file_parameter( extensions, Opts, Exts ), + Exts \= [] + -> + lists:member(Ext, Exts), + absf_trace(' trying suffix ~a from ~w', [Ext,Exts]) + ; + get_abs_file_parameter( file_type, Opts, Type ), + ( Type == source -> NType = prolog ; NType = Type ), + user:prolog_file_type(Ext, NType) + ), + absf_trace(' trying suffix ~a from type ~a', [Ext, NType]), + atom_codes(Ext, Cs) + }, + '$add_suffix'(Cs). +'$suffix'(_,_Opts) --> + absf_trace(' try no suffix', []). + +'$add_suffix'(Cs) --> + ( + { Cs = [0'. |_Codes] } + -> + Cs + ; + ".", Cs ). + +'$glob'(Opts) --> + { + get_abs_file_parameter( glob, Opts, G ), + G \= '', + atom_codes( G, Gs ) + }, + !, + '$dir', + Gs. +'$glob'(_Opts) --> + []. + +'$enumerate_glob'(_File1, [ExpFile], ExpFile) :- + !. +'$enumerate_glob'(_File1, ExpFiles, ExpFile) :- + lists:member(ExpFile, ExpFiles), + file_base_name( ExpFile, Base ), + Base \= '.', + Base \='..'. + +'$file_prefix'( CorePath, _Opts) --> + { is_absolute_file_name( CorePath ) }, + !, + CorePath. +'$file_prefix'( CorePath, Opts) --> + { get_abs_file_parameter( relative_to, Opts, File_Prefix ), + File_Prefix \= '', + absf_trace(' relative_to ~a', [File_Prefix]), + sub_atom(File_Prefix, _, 1, 0, Last), + atom_codes(File_Prefix, S) + }, + !, + S, + '$dir'(Last), + CorePath. +'$file_prefix'( CorePath, _) --> + { + recorded('$path',File_Prefix,_), + absf_trace(' try YAP path database ~a', [File_Prefix]), + sub_atom(File_Prefix, _, _, 1, Last), + atom_codes(File_Prefix, S) }, + S, + '$dir'(Last), + CorePath. +'$file_prefix'(CorePath, _ ) --> + absf_trace(' empty file_prefix ', []), + CorePath. + + +'$dir' --> { current_prolog_flag(windows, true) }, + "\\", + !. +'$dir' --> "/". + +'$dir'('/') --> !. +'$dir'('\\') --> { current_prolog_flag(windows, true) }, + !. +'$dir'(_) --> '$dir'. + +% +% +% +'$system_library_directories'(library, Dir) :- + user:library_directory( Dir ). +% '$split_by_sep'(0, 0, Dirs, Dir). +'$system_library_directories'(foreign, Dir) :- + user:foreign_directory( Dir ). +% compatibility with old versions +% +% search the current directory first. +'$system_library_directories'(commons, Dir) :- + user:commons_directory( Dir ). + + +% enumerate all paths separated by a path_separator. +'$paths'(Cs, C) :- + atom(Cs), + ( current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ), + sub_atom(Cs, N0, 1, N, Sep), + !, + ( + sub_atom(Cs,0,N0,_,C) + ; + sub_atom(Cs,_,N,0,RC), + '$paths'(RC, C) + ). +'$paths'(S, S). + +absf_trace(Msg, Args ) --> + { current_prolog_flag( verbose_file_search, true ) }, + { print_message( informational, absolute_file_path( Msg, Args ) ) }, + !. +absf_trace(_Msg, _Args ) --> []. + +absf_trace(Msg, Args ) :- + current_prolog_flag( verbose_file_search, true ), + print_message( informational, absolute_file_path( Msg, Args ) ), + !. +absf_trace(_Msg, _Args ). + +absf_trace( File ) :- + current_prolog_flag( verbose_file_search, true ), + print_message( informational, absolute_file_path( File ) ), + !. +absf_trace( _File ). + +'$absf_trace_options'(Args ) :- + current_prolog_flag( verbose_file_search, true ), + print_message( informational, arguments( Args ) ), + !. +'$absf_trace_options'( _Args ). + +/** @pred prolog_file_name( +File, -PrologFileaNme) + +Unify _PrologFileName_ with the Prolog file associated to _File_. + +*/ +prolog_file_name(File, PrologFileName) :- + var(File), !, + '$do_error'(instantiation_error, prolog_file_name(File, PrologFileName)). +prolog_file_name(user, Out) :- !, Out = user. +prolog_file_name(File, PrologFileName) :- + atom(File), !, + system:true_file_name(File, PrologFileName). +prolog_file_name(File, PrologFileName) :- + '$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)). + +/** + @pred path(-Directories:list) is det,deprecated + + YAP specific procedure that returns a list of user-defined directories + in the library search-path.We suggest using user:file_search_path/2 for + compatibility with other Prologs. +*/ +path(Path) :- + findall(X,'$in_path'(X),Path). + +'$in_path'(X) :- + recorded('$path',Path,_), + atom_codes(Path,S), + ( S = [] -> X = '.' ; + atom_codes(X,S) ). + +/** + @pred add_to_path(+Directory:atom) is det,deprecated + + YAP-specific predicate to include directory in library search path. + We suggest using user:file_search_path/2 for + compatibility with other Prologs. +*/ +add_to_path(New) :- + add_to_path(New,last). + +/** + @pred add_to_path(+Directory:atom, +Position:atom) is det,deprecated + + YAP-specific predicate to include directory in front or back of + library search path. We suggest using user:file_search_path/2 for + compatibility with other Prologs and more extensive functionality. +*/ +add_to_path(New,Pos) :- + atom(New), !, + '$check_path'(New,Str), + atom_codes(Path,Str), + '$add_to_path'(Path,Pos). + +'$add_to_path'(New,_) :- + recorded('$path',New,R), + erase(R), + fail. +'$add_to_path'(New,last) :- + !, + recordz('$path',New,_). +'$add_to_path'(New,first) :- + recorda('$path',New,_). + +/** @pred remove_from_path(+Directory:atom) is det,deprecated + +@} + +*/ +remove_from_path(New) :- '$check_path'(New,Path), + recorded('$path',Path,R), erase(R). + +'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt). +'$check_path'([],[]). +'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !. +'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A). +'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN). + +% This sequence must be followed: +% user and user_input are special; +% library(F) must check library_directories +% T(F) must check file_search_path +% all must try search in path +'$find_in_path'(user,_,user_input, _, _) :- !. +'$find_in_path'(user_input,_,user_input, _, _) :- !. +'$find_in_path'(user_output,_,user_ouput, _, _) :- !. +'$find_in_path'(user_error,_,user_error, _, _) :- !. +'$find_in_path'(Name, Opts, File, _, First) :- + % ( atom(Name) -> true ; start_low_level_trace ), + get_abs_file_parameter( file_type, Opts, Type ), + get_abs_file_parameter( access, Opts, Access ), + get_abs_file_parameter( expand, Opts, Expand ), + absf_trace('start with ~w', [Name]), + core_file_name(Name, Opts, CorePath, []), + absf_trace(' after name/library unfolding: ~w', [Name]), + '$variable_expansion'(CorePath, Opts,ExpandedPath), + absf_trace(' after environment variable expansion: ~s', [ExpandedPath]), + '$file_prefix'(ExpandedPath, Opts, Path , []), + absf_trace(' after file_prefix expansion: ~s', [Path]), + atom_codes( APath, Path ), + ( + Expand = true + -> + expand_file_name( APath, EPaths), + absf_trace(' after shell globbing: ~w', [EPaths]), + lists:member(EPath, EPaths) + ; + EPath = APath + ), + real_path( EPath, File), + absf_trace(' after canonical path name: ~a', [File]), + '$check_file'( File, Type, Access ), + absf_trace(' after testing ~a for ~a and ~a', [File,Type,Access]), + (First == first -> ! ; true ). /** @@ -144,7 +543,7 @@ absolute_file_name(File,TrueFileName,Opts) :- !, absolute_file_name(File,Opts,TrueFileName). absolute_file_name(File,Opts,TrueFileName) :- - '$absolute_file_name'(File,Opts,TrueFileName). + absolute_file_name__(File,Opts,TrueFileName). /** @pred absolute_file_name(+Name:atom,+Path:atom) is nondet @@ -156,408 +555,4 @@ absolute_file_name(V,Out) :- var(V), '$do_error'(instantiation_error, absolute_file_name(V, Out)). absolute_file_name(user,user) :- !. absolute_file_name(File0,File) :- - '$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File). - -'$absolute_file_name'(File,LOpts,TrueFileName) :- - % must_be_of_type( atom, File ), - % look for solutions - gated_call( - - '$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ), - '$find_in_path'(File, Opts,TrueFileName, HasSol, TakeFirst), - Port, - '$absf_port'(Port, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) - ). - -'$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- - ( var(File) -> instantiation_error(File) ; true), - abs_file_parameters(LOpts,Opts), - current_prolog_flag(open_expands_filename, OldF), - current_prolog_flag( fileerrors, PreviousFileErrors ), - current_prolog_flag( verbose_file_search, PreviousVerbose ), - get_abs_file_parameter( verbose_file_search, Opts,Verbose ), - get_abs_file_parameter( expand, Opts, Expand ), - set_prolog_flag( verbose_file_search, Verbose ), - get_abs_file_parameter( file_errors, Opts, FErrors ), - get_abs_file_parameter( solutions, Opts, TakeFirst ), - ( FErrors == fail -> FileErrors = false ; FileErrors = true ), - set_prolog_flag( fileerrors, FileErrors ), - set_prolog_flag(file_name_variables, Expand), - '$absf_trace'(File), - '$absf_trace_options'(LOpts), - HasSol = t(no). - -'$absf_port'(answer, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- - '$absf_port'(exit, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). -'$absf_port'(exit, _File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, TakeFirst, _FileErrors ) :- - (TakeFirst == first -> ! ; nb_setarg(1, HasSol, yes) ), - set_prolog_flag( fileerrors, PreviousFileErrors ), - set_prolog_flag( open_expands_filename, OldF), - set_prolog_flag( verbose_file_search, PreviousVerbose ), - '$absf_trace'(' |------- found ~a', [TrueFileName]). -'$absf_port'(redo, File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, Expand, Verbose, _TakeFirst, FileErrors ) :- - set_prolog_flag( fileerrors, FileErrors ), - set_prolog_flag( verbose_file_search, Verbose ), - set_prolog_flag( file_name_variables, Expand ), - '$absf_trace'(' |------- restarted search for ~a', [File]). -'$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, _TakeFirst, FileErrors ) :- - '$absf_trace'(' !------- failed.', []), - set_prolog_flag( fileerrors, PreviousFileErrors ), - set_prolog_flag( verbose_file_search, PreviousVerbose ), - set_prolog_flag(file_name_variables, OldF), - % check if no solution - arg(1,HasSol,no), - FileErrors = error, - '$do_error'(existence_error(file,File),absolute_file_name(File, TrueFileName, ['...'])). -'$absf_port'(!, _File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, _Expand, _Verbose, _TakeFirst, _FileErrors ). -'$absf_port'(exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- - '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). -'$absf_port'(external_exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- - '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). - -% This sequence must be followed: -% user and user_input are special; -% library(F) must check library_directories -% T(F) must check file_search_path -% all must try search in path -'$find_in_path'(user,_,user_input, _, _) :- !. -'$find_in_path'(user_input,_,user_input, _, _) :- !. -'$find_in_path'(user_output,_,user_ouput, _, _) :- !. -'$find_in_path'(user_error,_,user_error, _, _) :- !. -'$find_in_path'(Name, Opts, File, _, First) :- - % ( atom(Name) -> true ; start_low_level_trace ), - get_abs_file_parameter( file_type, Opts, Type ), - get_abs_file_parameter( access, Opts, Access ), - get_abs_file_parameter( expand, Opts, Expand ), - '$absf_trace'('start with ~w', [Name]), - '$core_file_name'(Name, Opts, CorePath, []), - '$absf_trace'(' after name/library unfolding: ~w', [Name]), - '$variable_expansion'(CorePath, Opts,ExpandedPath), - '$absf_trace'(' after environment variable expansion: ~s', [ExpandedPath]), - '$file_prefix'(ExpandedPath, Opts, Path , []), - '$absf_trace'(' after file_prefix expansion: ~s', [Path]), - atom_codes( APath, Path ), - ( - Expand = true - -> - expand_file_name( APath, EPaths), - '$absf_trace'(' after shell globbing: ~w', [EPaths]), - lists:member(EPath, EPaths) - ; - EPath = APath - ), - real_path( EPath, File), - '$absf_trace'(' after canonical path name: ~a', [File]), - '$check_file'( File, Type, Access ), - '$absf_trace'(' after testing ~a for ~a and ~a', [File,Type,Access]), - (First == first -> ! ; true ). - - % allow paths in File Name -'$core_file_name'(Name, Opts) --> - '$file_name'(Name, Opts, E), - '$suffix'(E, Opts), - '$glob'(Opts). - - % -% handle library(lists) or foreign(jpl) -% -'$file_name'(Name, Opts, E) --> - { Name =.. [Lib, P0] }, - !, - { user:file_search_path(Lib, IDirs) }, - { '$paths'(IDirs, Dir ) }, - '$absf_trace'(' ~w first', [Dir]), - '$file_name'(Dir, Opts, _), - '$dir', - { '$absf_trace'(' ~w next', [P0]) }, - '$cat_file_name'(P0, E). -'$file_name'(Name, _Opts, E) --> - '$cat_file_name'(Name, E ). - /* - ( - { - get_abs_file_parameter( file_type, _Opts, Lib ), - nonvar(Lib) - } - -> - { user:file_search_path(Lib, IDirs) }, - { '$paths'(IDirs, Dir ) }, - '$absf_trace'(' ~w first', [Dir]), - '$file_name'(Dir, Opts, _), - '$dir', - { '$absf_trace'(' ~w next', [P0]) } - ; - [] - ). - */ - - -'$cat_file_name'(A/B, E ) --> - '$cat_file_name'(A, _), - '$dir', - '$cat_file_name'(B, E). -'$cat_file_name'(File, F) --> - { atom(File), atom_codes(File, F) }, - !, - F. -'$cat_file_name'(File, S) --> - {string(File), string_codes(File, S) }, - S. - - -'$variable_expansion'( Path, Opts, APath ) :- - get_abs_file_parameter( expand, Opts, true ), - !, - '$expand_file_name'( Path, APath ). -'$variable_expansion'( Path, _, Path ). - - -'$var'(S) --> - "{", !, '$id'(S), "}". -'$var'(S) --> - '$id'(S). - -'$drive'(C) --> - '$id'(C), - ":\\\\". - -'$id'([C|S]) --> [C], - { C >= "a", C =< "z" ; C >= "A", C =< "Z" ; - C >= "0", C =< "9" ; C =:= "_" }, - !, - '$id'(S). -'$id'([]) --> []. - - -% always verify if a directory -'$check_file'(F, directory, _) :- - !, - exists_directory(F). -'$check_file'(_F, _Type, none) :- !. -'$check_file'(F, _Type, exist) :- - '$access_file'(F, exist). % if it has a type cannot be a directory.. -'$check_file'(F, _Type, Access) :- - '$access_file'(F, Access), - \+ exists_directory(F). % if it has a type cannot be a directory.. - -'$suffix'(Last, _Opts) --> - { lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) }, - '$absf_trace'(' suffix in ~s', [Alphas]), - !. -'$suffix'(_, Opts) --> - { - ( - get_abs_file_parameter( extensions, Opts, Exts ), - Exts \= [] - -> - lists:member(Ext, Exts), - '$absf_trace'(' trying suffix ~a from ~w', [Ext,Exts]) - ; - get_abs_file_parameter( file_type, Opts, Type ), - ( Type == source -> NType = prolog ; NType = Type ), - user:prolog_file_type(Ext, NType) - ), - '$absf_trace'(' trying suffix ~a from type ~a', [Ext, NType]), - atom_codes(Ext, Cs) - }, - '$add_suffix'(Cs). -'$suffix'(_,_Opts) --> - '$absf_trace'(' try no suffix', []). - -'$add_suffix'(Cs) --> - ( - { Cs = [0'. |_Codes] } - -> - Cs - ; - ".", Cs ). - -'$glob'(Opts) --> - { - get_abs_file_parameter( glob, Opts, G ), - G \= '', - atom_codes( G, Gs ) - }, - !, - '$dir', - Gs. -'$glob'(_Opts) --> - []. - -'$enumerate_glob'(_File1, [ExpFile], ExpFile) :- - !. -'$enumerate_glob'(_File1, ExpFiles, ExpFile) :- - lists:member(ExpFile, ExpFiles), - file_base_name( ExpFile, Base ), - Base \= '.', - Base \='..'. - -'$file_prefix'( CorePath, _Opts) --> - { is_absolute_file_name( CorePath ) }, - !, - CorePath. -'$file_prefix'( CorePath, Opts) --> - { get_abs_file_parameter( relative_to, Opts, File_Prefix ), - File_Prefix \= '', - '$absf_trace'(' relative_to ~a', [File_Prefix]), - sub_atom(File_Prefix, _, 1, 0, Last), - atom_codes(File_Prefix, S) - }, - !, - S, - '$dir'(Last), - CorePath. -'$file_prefix'( CorePath, _) --> - { - recorded('$path',File_Prefix,_), - '$absf_trace'(' try YAP path database ~a', [File_Prefix]), - sub_atom(File_Prefix, _, _, 1, Last), - atom_codes(File_Prefix, S) }, - S, - '$dir'(Last), - CorePath. -'$file_prefix'(CorePath, _ ) --> - '$absf_trace'(' empty file_prefix ', []), - CorePath. - - -'$dir' --> { current_prolog_flag(windows, true) }, - "\\", - !. -'$dir' --> "/". - -'$dir'('/') --> !. -'$dir'('\\') --> { current_prolog_flag(windows, true) }, - !. -'$dir'(_) --> '$dir'. - -% -% -% -'$system_library_directories'(library, Dir) :- - user:library_directory( Dir ). -% '$split_by_sep'(0, 0, Dirs, Dir). -'$system_library_directories'(foreign, Dir) :- - user:foreign_directory( Dir ). -% compatibility with old versions -% -% search the current directory first. -'$system_library_directories'(commons, Dir) :- - user:commons_directory( Dir ). - - -% enumerate all paths separated by a path_separator. -'$paths'(Cs, C) :- - atom(Cs), - ( current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ), - sub_atom(Cs, N0, 1, N, Sep), - !, - ( - sub_atom(Cs,0,N0,_,C) - ; - sub_atom(Cs,_,N,0,RC), - '$paths'(RC, C) - ). -'$paths'(S, S). - -'$absf_trace'(Msg, Args ) --> - { current_prolog_flag( verbose_file_search, true ) }, - { print_message( informational, absolute_file_path( Msg, Args ) ) }, - !. -'$absf_trace'(_Msg, _Args ) --> []. - -'$absf_trace'(Msg, Args ) :- - current_prolog_flag( verbose_file_search, true ), - print_message( informational, absolute_file_path( Msg, Args ) ), - !. -'$absf_trace'(_Msg, _Args ). - -'$absf_trace'( File ) :- - current_prolog_flag( verbose_file_search, true ), - print_message( informational, absolute_file_path( File ) ), - !. -'$absf_trace'( _File ). - -'$absf_trace_options'(Args ) :- - current_prolog_flag( verbose_file_search, true ), - print_message( informational, arguments( Args ) ), - !. -'$absf_trace_options'( _Args ). - -/** @pred prolog_file_name( +File, -PrologFileaNme) - -Unify _PrologFileName_ with the Prolog file associated to _File_. - -*/ -prolog_file_name(File, PrologFileName) :- - var(File), !, - '$do_error'(instantiation_error, prolog_file_name(File, PrologFileName)). -prolog_file_name(user, Out) :- !, Out = user. -prolog_file_name(File, PrologFileName) :- - atom(File), !, - system:true_file_name(File, PrologFileName). -prolog_file_name(File, PrologFileName) :- - '$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)). - -/** - @pred path(-Directories:list) is det,deprecated - - YAP specific procedure that returns a list of user-defined directories - in the library search-path.We suggest using user:file_search_path/2 for - compatibility with other Prologs. -*/ -path(Path) :- - findall(X,'$in_path'(X),Path). - -'$in_path'(X) :- - recorded('$path',Path,_), - atom_codes(Path,S), - ( S = [] -> X = '.' ; - atom_codes(X,S) ). - -/** - @pred add_to_path(+Directory:atom) is det,deprecated - - YAP-specific predicate to include directory in library search path. - We suggest using user:file_search_path/2 for - compatibility with other Prologs. -*/ -add_to_path(New) :- - add_to_path(New,last). - -/** - @pred add_to_path(+Directory:atom, +Position:atom) is det,deprecated - - YAP-specific predicate to include directory in front or back of - library search path. We suggest using user:file_search_path/2 for - compatibility with other Prologs and more extensive functionality. -*/ -add_to_path(New,Pos) :- - atom(New), !, - '$check_path'(New,Str), - atom_codes(Path,Str), - '$add_to_path'(Path,Pos). - -'$add_to_path'(New,_) :- - recorded('$path',New,R), - erase(R), - fail. -'$add_to_path'(New,last) :- - !, - recordz('$path',New,_). -'$add_to_path'(New,first) :- - recorda('$path',New,_). - -/** @pred remove_from_path(+Directory:atom) is det,deprecated - -@} - -*/ -remove_from_path(New) :- '$check_path'(New,Path), - recorded('$path',Path,R), erase(R). - -'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt). -'$check_path'([],[]). -'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !. -'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A). -'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN). + absolute_file_name__(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File). diff --git a/pl/boot.yap b/pl/boot.yap index 4837158ca..c146b1b4d 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -28,13 +28,33 @@ */ +/** +* @pred system_module( +_Mod_, +_ListOfPublicPredicates, +ListOfPrivatePredicates * + * Define a system module _Mod_. _ListOfPublicPredicates_ . Currentlt, all + * predicates are in the 'prolog' module. The first + * are visible outside the Prolog module, all others are hidden at the end of booting. + * +*/ +system_module(Mod, SysExps) :- + system_module(Mod, SysExps, []). -system_module(_Mod, _SysExps, _Decls). -% new_system_module(Mod). +system_module(_Mod, SysExps, _Decls) :- + ( + '$new_system_predicates'(SysExps), + fail + ; + stream_property(loop_stream,file_name(File)) + -> + recordz(system_file, File, _ ) + ; + recordz(system_file, loop_stream, _ ) + ). -use_system_module(_Module, _SysExps). - -private(_). +'$new_system_predicates'([P|_Ps]) :- + functor(P, N, Ar), + '$new_system_predicate'(N, Ar, prolog). +'$new_system_predicates'([_P|Ps]) :- + '$new_system_predicates'(Ps). % % boootstrap predicates. @@ -45,94 +65,42 @@ private(_). catch/3, catch_ball/2, expand_term/2, + print_message/2, import_system_module/2, + system_module/2, + private/1, incore/1, (not)/1, repeat/0, throw/1, - true/0], ['$$compile'/4, - '$call'/4, - '$catch'/3, - '$check_head_and_body'/4, - '$check_if_reconsulted'/2, - '$clear_reconsulting'/0, - '$command'/4, - '$cut_by'/1, - '$disable_debugging'/0, - '$do_live'/0, - '$'/0, - '$find_goal_definition'/4, - '$head_and_body'/3, - '$inform_as_reconsulted'/2, - '$init_system'/0, - '$init_win_graphics'/0, - '$loop'/2, - '$meta_call'/2, - '$prompt_alternatives_on'/1, - '$run_at_thread_start'/0, - '$system_catch'/4, - '$undefp'/1, - '$version'/0]). - -:- use_system_module( '$_absf', ['$system_library_directories'/2]). - -:- use_system_module( '$_checker', ['$check_term'/5, - '$sv_warning'/2]). - -:- use_system_module( '$_consult', ['$csult'/2]). - -:- use_system_module( '$_control', ['$run_atom_goal'/1]). - -:- use_system_module( '$_directives', ['$all_directives'/1, - '$exec_directives'/5]). - -:- use_system_module( '$_errors', ['$do_error'/2]). - -:- use_system_module( '$_grammar', ['$translate_rule'/2]). - -:- use_system_module( '$_modules', ['$get_undefined_pred'/4, - '$meta_expansion'/6, - '$module_expansion'/6]). - -:- use_system_module( '$_preddecls', ['$dynamic'/2]). - -:- use_system_module( '$_preds', ['$assert_static'/5, - '$assertz_dynamic'/4, - '$init_preds'/0, - '$unknown_error'/1, - '$unknown_warning'/1]). - -:- use_system_module( '$_qly', ['$init_state'/0]). - -:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1, - '$iso_check_goal'/2]). + true/0]). % be careful here not to generate an undefined exception.. +use_system_module(_,_). +private(_). + print_message(L,E) :- - %stop_low_level_trace, - '$number_of_clauses'(print_message(L,E), prolog_complete, 1), - !, (L = informational -> - true + '$query_exception'(prologPredFile, Desc, File), + '$query_exception'(prologPredLine, Desc, FilePos), + format(user_error,'~a:~d: error:', [File,FilePos]) ; - system_error(_,Info), - '$error_descriptor'(Info, Desc), - query_exception(prologPredFile, Desc, File), - query_exception(prologPredLine, Desc, FilePos), - format(user_error,'~a:~d: error:', [File,FilePos]), - '$print_exception'(Info), + + %throw(error(error, print_message(['while calling goal = ~w'-E,nl]))). + '$get_exception'(Desc), + '$query_exception'(prologPredFile, Desc, File), + '$query_exception'(prologPredLine, Desc, FilePos), + format(user_error,'~a:~d: error:', [File,FilePos]), + '$print_exception'(Desc), format( user_error, '~w from bootstrap: got ~w~n',[L,E]) ). '$undefp0'([M|G], _Action) :- - stream_property( loop_stream, [file_name(F), line_number(L)]), - format(user_error,'~a:~d: error: undefined ~w~n:',[F,L,M:G]), - fail - ; - format(user_error,' call to undefined procedure ~w~n',[M:G]), - fail. + functor(G,N,A), + print_message( error, error(error(unknown, M:N/A),M:G)), + fail. :- '$undefp_handler'('$undefp0'(_,_),prolog). @@ -151,11 +119,11 @@ print_message(L,E) :- '$compile'(G, assertz, G, prolog, _R), '$system_meta_predicates'(L). - :- '$mk_dynamic'( prolog_file_type(_Ext, _NType), user). - :- '$new_multifile'( prolog_file_type(_Ext, _NType), user). +:- '$mk_dynamic'( prolog_file_type(_Ext, _NType), user). +:- '$new_multifile'( prolog_file_type(_Ext, _NType), user). - :- '$mk_dynamic'( '$meta_predicate'(_N,_M,_A,_P), prolog). - :- '$new_multifile'( '$meta_predicate'(_N,_M,_A,_P), prolog). +:- '$mk_dynamic'( '$meta_predicate'(_N,_M,_A,_P), prolog). +:- '$new_multifile'( '$meta_predicate'(_N,_M,_A,_P), prolog). :- '$new_multifile'('$full_clause_optimisation'(_H, _M, _B0, _BF), prolog). :- '$new_multifile'('$exec_directive'(_,_,_,_,_), prolog). @@ -172,7 +140,8 @@ print_message(L,E) :- otherwise/0, term_expansion/2, version/2, - '$do_log_upd_clause'/6, + [ + '$do_log_upd_clause'/6, '$do_log_upd_clause0'/6, '$do_log_upd_clause_erase'/6, '$do_static_clause'/5], [ @@ -228,15 +197,19 @@ print_message(L,E) :- '$execute_command'(EG,EM,VL,Pos,Con,_Source). '$command'(C,VL,Pos,Con) :- ( (Con = top ; var(C) ; C = [_|_]) -> - '$yap_strip_module'(C, EM, EG), + '$yap_strip_module'(C, EM, EG), '$execute_command'(EG,EM,VL,Pos,Con,C) ; % do term expansion '$expand_term'(C, Con, EC), - '$yap_strip_module'(EC, EM2, EG2), + ( var(EC) -> + '$yap_strip_module'(EC, EM2, EG2) + ; + '$yap_strip_module'(C, EM2, EG2) + ), % execute a list of commands '$execute_commands'(EG2,EM2,VL,Pos,Con,_Source) ), - % succeed only if the *original* was at end of file. + % succeed only if the *original* was at end of file. C == end_of_file. :- c_compile('arith.yap'). diff --git a/pl/consult.yap b/pl/consult.yap index 59c57672a..741b69bca 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -516,8 +516,8 @@ load_files(Files0,Opts) :- '$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :- % check if there is a qly file % start_low_level_trace, - '$pred_exists'('$absolute_file_name'(File,[],F),prolog), - '$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F), + '$pred_exists'(absolute_file_name__(File,[],F),prolog), + absolute_file_name__(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F), open( F, read, Stream , [type(binary)] ), ( '$q_header'( Stream, Type ), @@ -804,7 +804,7 @@ db_files(Fs) :- '$lf_opt'('$source_pos', TOpts, Pos), '$lf_opt'('$from_stream', TOpts, false), ( QComp == auto ; QComp == large, Pos > 100*1024), - '$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F), + absolute_file_name__(UserF,[file_type(qly),solutions(first),expand(true)],F), !, '$qsave_file_'( File, UserF, F ). '$q_do_save_file'(_File, _, _TOpts ). @@ -1043,7 +1043,7 @@ prolog_load_context(stream, Stream) :- %format( 'L=~w~n', [(F0)] ), ( atom_concat(Prefix, '.qly', F0 ), - '$absolute_file_name'(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F) + absolute_file_name__(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F) ; F0 = F ), @@ -1150,11 +1150,11 @@ exists_source(File) :- '$full_filename'(F0, F) :- - '$undefined'('$absolute_file_name'(F0,[],F),prolog_complete), + '$undefined'(absolute_file_name__(F0,[],F),prolog_complete), !, 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), diff --git a/pl/protect.yap b/pl/protect.yap index 5fe5a9210..2522dc6bd 100755 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -42,7 +42,7 @@ prolog:'$protect' :- new_system_module( M ), fail. prolog:'$protect' :- - '$current_predicate'(Name,M,P,_), + '$current_predicate'(Name,M,P,_), '$is_system_module'(M), functor(P,Name,Arity), '$new_system_predicate'(Name,Arity,M), @@ -84,3 +84,4 @@ prolog:'$protect'. '$visible'('$init_prolog'). '$visible'('$x_yap_flag' ). %% @} + From 0507d804038d3a1b911042e8fec114eac36d9421 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 30 Jan 2019 11:17:53 +0000 Subject: [PATCH 020/101] docs --- H/YapGFlagInfo.h | 25 ++++++++++++++++--------- docs/md/INSTALL.md | 18 ++++++++---------- docs/md/run.md | 2 +- library/charsio.yap | 1 + library/clp/clpfd.pl | 12 +++++++----- library/coinduction.yap | 2 ++ library/maplist.yap | 19 ++++++++++++------- library/splay.yap | 37 +++++++++++++++++++------------------ pl/consult.yap | 10 ++++++---- pl/imports.yap | 17 +++++++++-------- pl/top.yap | 17 +++++++---------- 11 files changed, 88 insertions(+), 72 deletions(-) diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index f8466d7dd..e822ad1be 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -149,14 +149,14 @@ opportunity. Initial value is 10,000. May be changed. A value of 0 YAP_FLAG(CHARACTER_ESCAPES_FLAG, "character_escapes", true, booleanFlag, "true", NULL), - /**< `compiled_at ` + YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context", + true, booleanFlag, "true", NULL), + + /**< Read-only flag that gives the time when the main YAP binary was compiled. It is obtained staight from the __TIME__ macro, as defined in the C99. */ - YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context", - true, booleanFlag, "true", NULL), - YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT, NULL), /**< @@ -167,18 +167,25 @@ opportunity. Initial value is 10,000. May be changed. A value of 0 */ YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL), - YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL), - /**< + // YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL), + /**< + +Says whether to call the debUgger on an exception. False in YAP.. + */ + YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "false", + NULL), + + /**< If bound, set the argument to the `write_term/3` options the debugger uses to write terms. If unbound, show the current options. */ - YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "true", - NULL), - YAP_FLAG(DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true, list_option, "[quoted(true),numbervars(true),portrayed(true),max_depth(10)]", NULL), + /**< +Show their ancestors while debuggIng + */ YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true, booleanFlag, "false", NULL), /**< diff --git a/docs/md/INSTALL.md b/docs/md/INSTALL.md index 5d28f4063..5e1aaac9f 100644 --- a/docs/md/INSTALL.md +++ b/docs/md/INSTALL.md @@ -53,21 +53,19 @@ generate Makefiles, Ninja, Apple's XCode, VisualStudio and ANdroid Studio, and because it includes packaging suppport, The steps required to install core YAP under `cmake` are presented in detail next. -@subsubsection Compilation The compiler +@subsection Compilation The compiler: *Status as of early 2017* - *Status as of early 2017* +YAP should compile well under the [GNU-CC](https://gcc.gnu.org/) and + the [C-LANG](https://clang.llvm.org/) families, that are available + across most configurations. It sshould also compile well undder + Intel `icc`. - YAP should compile well under the [GNU-CC](https://gcc.gnu.org/) - and the [C-LANG](https://clang.llvm.org/) families, that are - available across most configurations. It sshould also compile well - undder Intel `icc`. - - We do not recommend using Microoft's VC++. To the best of our +We do not recommend using Microoft's VC++. To the best of our knowledge MSC does not support threaded emulation, which YAP recquires for performance, You can still use the IDE, and experiment with the c-lang plugin. - YAP compiles cleanly under cross-compilers, and we have used the +YAP compiles cleanly under cross-compilers, and we have used the crosss-compilation system [mxe](http://mxe.cc/) system with good results. @subsection cmake cmake @@ -214,7 +212,7 @@ brew install cudd cmake -DOPENSSL_ROOT_DIR=/usr/local/opt/openssl .. ~~~~~ -@sususbsection TuningDroid Compilation Notes for Android +@subsection TuningDroid Compilation Notes for Android Next we present the compilation process for Android. The environment is an OSX, but steps should be similar for Linux machines. We assume you have downloaded both the Android NDK and the Android SDK. diff --git a/docs/md/run.md b/docs/md/run.md index ed32ea1a2..c96a8221a 100644 --- a/docs/md/run.md +++ b/docs/md/run.md @@ -88,7 +88,7 @@ the environment variable YAPBINDIR. + YAP will try to find library files from the YAPSHAREDIR/library directory. @section RunningScripts Running Prolog Files --------------------- + YAP can also be used to run Prolog files as scripts, at least in Unix-like environments. A simple example is shown next (do not forget diff --git a/library/charsio.yap b/library/charsio.yap index 3055dac5b..150e4b8e4 100644 --- a/library/charsio.yap +++ b/library/charsio.yap @@ -45,6 +45,7 @@ /** @defgroup charsio Operations on Sequences of Codes. @ingroup library +@{ Term to sequence of codes conversion, mostly replaced by engine code. You can use the following directive to load the files. diff --git a/library/clp/clpfd.pl b/library/clp/clpfd.pl index e20b4ab8a..1615baaee 100644 --- a/library/clp/clpfd.pl +++ b/library/clp/clpfd.pl @@ -1,5 +1,7 @@ /* $Id$ +@file clpfd/clpfd.pl + Part of SWI-Prolog Author: Markus Triska @@ -91,7 +93,7 @@ used in modes that can also be handled by built-in arithmetic. To currently, let us define a new custom constraint "oneground(X,Y,Z)", where Z shall be 1 if at least one of X and Y is instantiated: - == + ~~ :- use_module(library(clpfd)). :- multifile clpfd:run_propagator/2. @@ -107,7 +109,7 @@ used in modes that can also be handled by built-in arithmetic. To ; integer(Y) -> clpfd:kill(MState), Z = 1 ; true ). - == + ~~~ First, clpfd:make_propagator/2 is used to transform a user-defined representation of the new constraint to an internal form. With @@ -124,12 +126,12 @@ used in modes that can also be handled by built-in arithmetic. To the constraint has become entailed, by using clpfd:kill/1. An example of using the new constraint: - == + ~~~ ?- oneground(X, Y, Z), Y = 5. Y = 5, Z = 1, X in inf..sup. - == + ~~~ @author Markus Triska */ @@ -192,7 +194,7 @@ used in modes that can also be handled by built-in arithmetic. To ]). -:- expects_dialect(swi). +% :- expects_dialect(swi). :- use_module(library(assoc)). :- use_module(library(apply)). diff --git a/library/coinduction.yap b/library/coinduction.yap index fe53d7712..9552a72fd 100644 --- a/library/coinduction.yap +++ b/library/coinduction.yap @@ -80,6 +80,8 @@ regardless of the cycle-length. @see "Co-Logic Programming: Extending Logic Programming with Coinduction" by Luke Somin et al. +@addtogroup coinduction Co-induction +@ingroup library @{ */ diff --git a/library/maplist.yap b/library/maplist.yap index 7d4cc40d2..b322fba98 100644 --- a/library/maplist.yap +++ b/library/maplist.yap @@ -488,6 +488,13 @@ sumnodes_body(Pred, Term, A1, A3, N0, Ar) :- /** @pred oldl(: _Pred_, + _List1_, + _List2_, ? _AccIn_, ? _AccOut_) + The foldl family of predicates is defined + == + foldl(P, [X11,...,X1n],V0, Vn, W0, WN) :- + P(X11, V0, V1, W0, W1), + ... + P(X1n, Vn1, Vn, Wn1, Wn). + == Calls _Pred_ on all elements of `List1` and collects a result in _Accumulator_. Same as foldr/3. */ @@ -506,13 +513,6 @@ foldl_([H|T], Goal, V0, V) :- _List2_ and collects a result in _Accumulator_. Same as foldr/4. - The foldl family of predicates is defined - == - foldl(P, [X11,...,X1n],V0, Vn, W0, WN) :- - P(X11, V0, V1, W0, W1), - ... - P(X1n, Vn1, Vn, Wn1, Wn). - == */ foldl(Goal, List1, List2, V0, V) :- foldl_(List1, List2, Goal, V0, V). @@ -524,6 +524,11 @@ foldl_([H1|T1], [H2|T2], Goal, V0, V) :- /** +@pred foldl(Goal, List1, List2, List3, V0, V) + +Apply _Goal_ plus five arguuments, three map to lists, +two can be used as a difference_type. + */ foldl(Goal, List1, List2, List3, V0, V) :- foldl_(List1, List2, List3, Goal, V0, V). diff --git a/library/splay.yap b/library/splay.yap index 37b17dd03..5066fb20f 100644 --- a/library/splay.yap +++ b/library/splay.yap @@ -147,13 +147,9 @@ will fail if _Key_ is not present. */ -/** @pred splay_init(- _NewTree_) +splay_access(V, Item, Val, Tree, NewTree):- + bst(access(V), Item, Val, Tree, NewTree). - -Initialize a new splay tree. - - -*/ /** @pred splay_insert(+ _Key_,? _Val_,+ _Tree_,- _NewTree_) @@ -165,6 +161,13 @@ already there: rather it is unified with the item already in the tree. */ +splay_insert(Item, Val,Tree, NewTree):- + bst(insert, Item, Val, Tree, NewTree). + +splay_del(Item, Tree, NewTree):- + bst(access(true), Item, Val, Tree, n(Item, Val, Left, Right)), + splay_join(Left, Right, NewTree). + /** @pred splay_join(+ _LeftTree_,+ _RighTree_,- _NewTree_) @@ -175,25 +178,16 @@ assumes that all items in _LeftTree_ are less than all those in */ -/** @pred splay_split(+ _Key_,? _Val_,+ _Tree_,- _LeftTree_,- _RightTree_) +splay_join(Left, Right, New):- + join(L-L, Left, Right, New). +/** @pred splay_split(+ _Key_,? _Val_,+ _Tree_,- _LeftTree_,- _RightTree_) Construct and return two trees _LeftTree_ and _RightTree_, where _LeftTree_ contains all items in _Tree_ less than _Key_, and _RightTree_ contains all items in _Tree_ greater than _Key_. This operations destroys _Tree_. */ - - -splay_access(V, Item, Val, Tree, NewTree):- - bst(access(V), Item, Val, Tree, NewTree). -splay_insert(Item, Val,Tree, NewTree):- - bst(insert, Item, Val, Tree, NewTree). -splay_del(Item, Tree, NewTree):- - bst(access(true), Item, Val, Tree, n(Item, Val, Left, Right)), - splay_join(Left, Right, NewTree). -splay_join(Left, Right, New):- - join(L-L, Left, Right, New). splay_split(Item, Val, Tree, Left, Right):- bst(access(true), Item, Val, Tree, n(Item, Val, Left, Right)). @@ -272,6 +266,13 @@ join(Left-n(Y, VY, n(X, VX, C, B), NL), n(X, VX, C, n(Y, VY, B, n(Z, VZ, A1, A2) join(Left-NL, n(Z, VZ,A1, A2), Right, New). +/** @pred splay_init(- _NewTree_) + + +Initialize a new splay tree. + + +*/ splay_init(_). /** @} */ diff --git a/pl/consult.yap b/pl/consult.yap index 59c57672a..029768dc7 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -1273,6 +1273,7 @@ module(Mod, Decls) :- % prevent modules within the kernel module... + /** @pred use_module(? _M_,? _F_,+ _L_) is directive SICStus compatible way of using a module @@ -1504,9 +1505,6 @@ initialization(_G,_OPT). @} */ -%% @{ - - /** @@ -1514,6 +1512,9 @@ initialization(_G,_OPT). @ingroup YAPCompilerSettings +%% @{ + + Conditional compilation builds on the same principle as term_expansion/2, goal_expansion/2 and the expansion of grammar rules to compile sections of the source-code @@ -1636,6 +1637,7 @@ no test succeeds the else branch is processed. '$elif'(_,_). /** @pred endif + End of conditional compilation. */ @@ -1688,7 +1690,7 @@ End of conditional compilation. current_prolog_flag(source, true), !. '$fetch_comp_status'(compact). -/** consult_depth(-int:_LV_) +/** @pred consult_depth(-int:_LV_) * * Unify _LV_ with the number of files being consulted. */ diff --git a/pl/imports.yap b/pl/imports.yap index 10c759ed7..606d9981a 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -7,7 +7,7 @@ */ /** - * @ingroup ModuleBuiltins + * @addtogroup ModuleBuiltins * @{ * * YAP follows the following protovol: @@ -15,10 +15,17 @@ * - predicate is in user * - predicate will be autoloaded, SWI style. */ + :- '$mk_dynamic'('$parent_module'(_,_),prolog). +/** @pred mimp + +debug import table + +*/ mimp :- - recorded('$import',I,_), %'$import'(ExportingMod,ImportingMod,G0,G,_,_),_), + recorded('$import',I,_), + %'$import'(ExportingMod,ImportingMod,G0,G,_,_),_), writeln(I), %(ImportingMod:G :- ExportingMod:G0)), fail. @@ -45,12 +52,6 @@ fail. -> '$get_undefined_predicates'(NewImportingMod:G, ExportingMod:G0). -/** - * - * @pred '$continue_imported'(+Modn, +ModOut, +Predn ,+PredOut) - * - * @return - */ '$continue_imported'(Mod:Pred,Mod,Pred) :- '$pred_exists'(Pred, Mod), !. diff --git a/pl/top.yap b/pl/top.yap index c401d98a5..bd76975b8 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -15,7 +15,7 @@ */ :- '$system_meta_predicates'([ - gated_call(0,0,?,0), + gated_call(0,0,?,0), catch(0,?,0), log_event(+,:)]). @@ -61,10 +61,6 @@ live :- throw(E). -/** @pred stream_property( Stream, Prop ) - -*/ - % reset alarms when entering top-level. '$enter_top_level' :- '$alarm'(0, 0, _, _), @@ -926,9 +922,9 @@ expand_term(Term,Expanded) :- %% @} -%% @addtogroup YAPControl - -%% @{ +%% @addtogroup CathThrow Catch and Throw +% @ingroup YAPControl +% @{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % catch/throw implementation @@ -936,7 +932,9 @@ expand_term(Term,Expanded) :- % at each catch point I need to know: % what is ball; % where was the previous catch -/** @pred catch( : _Goal_,+ _Exception_,+ _Action_) is iso + +/** +@pred catch( : _Goal_,+ _Exception_,+ _Action_) is iso The goal `catch( _Goal_, _Exception_, _Action_)` tries to @@ -949,7 +947,6 @@ again throws the exception. The top-level of YAP maintains a default exception handler that is responsible to capture uncaught exceptions. - */ catch(G, C, A) :- '$catch'(G,C,A). From f7ed109d1c6ae4b8f10f302aa72fcf7517c738dd Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 30 Jan 2019 15:24:06 +0000 Subject: [PATCH 021/101] debugging --- C/stdpreds.c | 1 + C/terms.c | 1534 ++++++++++++++++++++++++ C/utilpreds.c | 2769 ++++++++----------------------------------- CMakeLists.txt | 4 +- H/YapGFlagInfo.h | 2 +- cmake/Sources.cmake | 1 + pl/boot.yap | 22 +- pl/init.yap | 7 +- pl/qly.yap | 4 +- 9 files changed, 2078 insertions(+), 2266 deletions(-) create mode 100644 C/terms.c diff --git a/C/stdpreds.c b/C/stdpreds.c index 8ffa8c46f..e14d54e9d 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -1592,6 +1592,7 @@ void Yap_InitCPreds(void) { Yap_udi_init(); Yap_udi_Interval_init(); Yap_InitSignalCPreds(); + Yap_InitTermCPreds(); Yap_InitUserCPreds(); Yap_InitUtilCPreds(); Yap_InitSortPreds(); diff --git a/C/terms.c b/C/terms.c new file mode 100644 index 000000000..b6aa1768f --- /dev/null +++ b/C/terms.c @@ -0,0 +1,1534 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: utilpreds.c * +* Last rev: 4/03/88 * +* mods: * +* comments: new utility predicates for YAP * +* * +*************************************************************************/ +#ifdef SCCS +static char SccsId[] = "@(#)utilpreds.c 1.3"; +#endif +/** + * @file C/terms.c + * + * @brief applications of the tree walker pattern. + * + * @addtogroup Terms + * @{ + */ + +#include "absmi.h" +#include "YapHeap.h" +#include "yapio.h" +#include "attvar.h" +#ifdef HAVE_STRING_H +#include "string.h" +#endif + + + +static int +expand_vts( int args USES_REGS ) +{ + UInt expand = LOCAL_Error_Size; + yap_error_number yap_errno = LOCAL_Error_TYPE; + + LOCAL_Error_Size = 0; + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (yap_errno == RESOURCE_ERROR_TRAIL) { + /* Trail overflow */ + if (!Yap_growtrail(expand, FALSE)) { + return FALSE; + } + } else if (yap_errno == RESOURCE_ERROR_AUXILIARY_STACK) { + /* Aux space overflow */ + if (expand > 4*1024*1024) + expand = 4*1024*1024; + if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, TRUE)) { + return FALSE; + } + } else { + if (!Yap_gcl(expand, 3, ENV, gc_P(P,CP))) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_variables"); + return FALSE; + } + } + return TRUE; +} + +static inline void +clean_tr(tr_fr_ptr TR0 USES_REGS) { + if (TR != TR0) { + do { + Term p = TrailTerm(--TR); + RESET_VARIABLE(p); + } while (TR != TR0); + } +} + +static inline void +clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { + tr_fr_ptr pt0 = TR; + while (pt0 != TR0) { + Term p = TrailTerm(--pt0); + if (IsApplTerm(p)) { + CELL *pt = RepAppl(p); +#ifdef FROZEN_STACKS + pt[0] = TrailVal(pt0); +#else + pt[0] = TrailTerm(pt0 - 1); + pt0 --; +#endif /* FROZEN_STACKS */ + } else { + RESET_VARIABLE(p); + } + } + TR = TR0; +} + +/// @brief recover original term while fixing direct refs. +/// +/// @param USES_REGS +/// +static inline void +clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { + tr_fr_ptr pt0 = TR; + while (pt0 != TR0) { + Term p = TrailTerm(--pt0); + if (IsApplTerm(p)) { + /// pt: points to the address of the new term we may want to fix. + CELL *pt = RepAppl(p); + if (pt >= HB && pt < HR) { /// is it new? + Term v = pt[0]; + if (IsApplTerm(v)) { + /// yes, more than a single ref + *pt = (CELL)RepAppl(v); + } +#ifndef FROZEN_STACKS + pt0 --; +#endif /* FROZEN_STACKS */ + continue; + } +#ifdef FROZEN_STACKS + pt[0] = TrailVal(pt0); +#else + pt[0] = TrailTerm(pt0 - 1); + pt0 --; +#endif /* FROZEN_STACKS */ + } else { + RESET_VARIABLE(p); + } + } + TR = TR0; +} + +typedef struct { + Term old_var; + Term new_var; +} *vcell; + + +typedef struct non_single_struct_t { + CELL *ptd0; + CELL d0; + CELL *pt0, *pt0_end; +} non_singletons_t; + +#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ + if (IsPairTerm(d0)) { \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + LIST0; \ + ptd0 = RepPair(d0); \ + if (*ptd0 == TermFreeTerm) continue; \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = *ptd0; \ + to_visit ++; \ + d0 = ptd0[0]; \ + pt0 = ptd0; \ + *ptd0 = TermFreeTerm; \ + pt0_end = pt0 + 1; \ + if (pt0 <= pt0_end) \ + goto list_loop; \ + } else if (IsApplTerm(d0)) { \ + register Functor f; \ + register CELL *ap2; \ + /* store the terms to visit */ \ + ap2 = RepAppl(d0); \ + f = (Functor)(*ap2); \ + \ + if (IsExtensionFunctor(f) || \ + IsAtomTerm((CELL)f)) { \ + \ + continue; \ + } \ + STRUCT0; \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ap2; \ + to_visit->d0 = *ap2; \ + to_visit ++; \ + \ + *ap2 = TermNil; \ + d0 = ArityOfFunctor(f); \ + pt0 = ap2; \ + pt0_end = ap2 + d0; \ + } + +#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}) + +#define def_trail_overflow() \ + trail_overflow:{ \ + while (to_visit > to_visit0) { \ + to_visit --; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + return 0L; \ + } + +#define def_aux_overflow() \ + aux_overflow:{ \ + size_t d1 = to_visit-to_visit0; \ + size_t d2 = to_visit_max-to_visit0; \ + to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \ + to_visit = to_visit0+d1; \ + to_visit_max = to_visit0+(d2+128); \ + pt0--; \ + goto restart; \ + } + +#define def_global_overflow() \ + global_overflow:{ \ + while (to_visit > to_visit0) { \ + to_visit --; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); \ + return false; } + +static Int var_in_complex_term(register CELL *pt0, + register CELL *pt0_end, + Term v USES_REGS) +{ + + int lvl = push_text_stack(); + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; + + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + restart: + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, var_in_term_unk); + var_in_term_nvar: + { + WALK_COMPLEX_TERM(); + continue; + } + deref_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); + if ((CELL)ptd0 == v) { /* we found it */ + /* Do we still have compound terms to visit */ + while (to_visit > to_visit0) { + to_visit--; + + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + } + pop_text_stack(lvl); + return true; + } + } + + pop_text_stack(lvl); + return false; + + def_aux_overflow(); +} + +static Int +var_in_term(Term v, Term t USES_REGS) /* variables in term t */ +{ + + if (IsVarTerm(t)) { + return(v == t); + } else if (IsPrimitiveTerm(t)) { + return(FALSE); + } else if (IsPairTerm(t)) { + return(var_in_complex_term(RepPair(t)-1, + RepPair(t)+1,v PASS_REGS)); + } + else return(var_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(FunctorOfTerm(t)),v PASS_REGS)); +} + +static Int +p_var_in_term( USES_REGS1 ) +{ + return(var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS)); +} + +/** + @brief routine to locate all variables in a term, and its applications */ + +static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) +{ + + int lvl = push_text_stack(); + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; + register tr_fr_ptr TR0 = TR; + CELL *InitialH = HR; + CELL output = AbsPair(HR); + + loop: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + restart: + + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, vars_in_term_unk); + vars_in_term_nvar: + + WALK_COMPLEX_TERM(); + continue ; + + derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); + /* do or pt2 are unbound */ + *ptd0 = TermNil; + /* leave an empty slot to fill in later */ + if (HR+1024 > ASP) { + goto global_overflow; + } + HR[1] = AbsPair(HR+2); + HR += 2; + HR[-2] = (CELL)ptd0; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto loop; + } + + + clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); + + if (HR != InitialH) { + /* close the list */ + Term t2 = Deref(inp); + if (IsVarTerm(t2)) { + RESET_VARIABLE(HR-1); + Yap_unify((CELL)(HR-1),inp); + } else { + HR[-1] = t2; /* don't need to trail */ + } + return(output); + } else { + return(inp); + } + + def_trail_overflow(); + def_aux_overflow(); + def_global_overflow(); + +} + + +static Int +p_variables_in_term( USES_REGS1 ) /* variables in term t */ +{ + Term out, inp; + int count; + + + restart: + count = 0; + inp = Deref(ARG2); + while (!IsVarTerm(inp) && IsPairTerm(inp)) { + Term t = HeadOfTerm(inp); + if (IsVarTerm(t)) { + CELL *ptr = VarOfTerm(t); + *ptr = TermFoundVar; + TrailTerm(TR++) = t; + count++; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + clean_tr(TR-count PASS_REGS); + if (!Yap_growtrail(count*sizeof(tr_fr_ptr *), FALSE)) { + return FALSE; + } + goto restart; + } + } + inp = TailOfTerm(inp); + } + do { + Term t = Deref(ARG1); + out = vars_in_complex_term(&(t)-1, + &(t), + ARG2 PASS_REGS); + if (out == 0L) { + if (!expand_vts( 3 PASS_REGS )) + return FALSE; + } + } while (out == 0L); + clean_tr(TR-count PASS_REGS); + return Yap_unify(ARG3,out); +} + + +/** @pred term_variables(? _Term_, - _Variables_, +_ExternalVars_) is iso + + + + Unify the difference list between _Variables_ and _ExternaVars_ + with the list of all variables of term _Term_. The variables + occur in the order of their first appearance when traversing the + term depth-first, left-to-right. + + +*/ +static Int +p_term_variables3( USES_REGS1 ) /* variables in term t */ +{ + Term out; + + do { + Term t = Deref(ARG1); + if (IsVarTerm(t)) { + Term out = Yap_MkNewPairTerm(); + return + Yap_unify(t,HeadOfTerm(out)) && + Yap_unify(ARG3, TailOfTerm(out)) && + Yap_unify(out, ARG2); + } else if (IsPrimitiveTerm(t)) { + return Yap_unify(ARG2, ARG3); + } else { + out = vars_in_complex_term(&(t)-1, + &(t), ARG3 PASS_REGS); + } + if (out == 0L) { + if (!expand_vts( 3 PASS_REGS )) + return FALSE; + } + } while (out == 0L); + + return Yap_unify(ARG2,out); +} + +/** + * Exports a nil-terminated list with all the variables in a term. + * @param[t] the term + * @param[arity] the arity of the calling predicate (required for exact garbage collection). + * @param[USES_REGS] threading + */ +Term +Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ +{ + Term out; + + do { + t = Deref(t); + if (IsVarTerm(t)) { + return MkPairTerm(t, TermNil); + } else if (IsPrimitiveTerm(t)) { + return TermNil; + } else { + out = vars_in_complex_term(&(t)-1, + &(t), TermNil PASS_REGS); + } + if (out == 0L) { + if (!expand_vts( arity PASS_REGS )) + return FALSE; + } + } while (out == 0L); + return out; +} + +/** @pred term_variables(? _Term_, - _Variables_) is iso + + + + Unify _Variables_ with the list of all variables of term + _Term_. The variables occur in the order of their first + appearance when traversing the term depth-first, left-to-right. + + +*/ +static Int +p_term_variables( USES_REGS1 ) /* variables in term t */ +{ + Term out; + + if (!Yap_IsListOrPartialListTerm(ARG2)) { + Yap_Error(TYPE_ERROR_LIST,ARG2,"term_variables/2"); + return FALSE; + } + + do { + Term t = Deref(ARG1); + + out = vars_in_complex_term(&(t)-1, + &(t), TermNil PASS_REGS); + if (out == 0L) { + if (!expand_vts( 3 PASS_REGS )) + return FALSE; + } + } while (out == 0L); + return Yap_unify(ARG2,out); +} + +/** routine to locate attributed variables */ + + +typedef struct att_rec { + CELL *beg, *end; + CELL oval; +} att_rec_t; + +static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) +{ + int lvl = push_text_stack(); + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; + register tr_fr_ptr TR0 = TR; + CELL *InitialH = HR; + CELL output = AbsPair(HR); + + restart: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, attvars_in_term_unk); + attvars_in_term_nvar: + { + WALK_COMPLEX_TERM(); + continue; + } + + + derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); + if (IsAttVar(ptd0)) { + /* do or pt2 are unbound */ + attvar_record *a0 = RepAttVar(ptd0); + if (a0->AttFunc ==(Functor) TermNil) continue; + /* leave an empty slot to fill in later */ + if (HR+1024 > ASP) { + goto global_overflow; + } + HR[1] = AbsPair(HR+2); + HR += 2; + HR[-2] = (CELL)&(a0->Done); + /* store the terms to visit */ + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + ptd0 = (CELL*)a0; + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->d0 = *ptd0; + to_visit->ptd0 = ptd0; + to_visit ++; + *ptd0 = TermNil; + pt0_end = &RepAttVar(ptd0)->Atts; + pt0 = pt0_end-1; + } + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; + } + + + clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); + if (HR != InitialH) { + /* close the list */ + Term t2 = Deref(inp); + if (IsVarTerm(t2)) { + RESET_VARIABLE(HR-1); + Yap_unify((CELL)(HR-1), t2); + } else { + HR[-1] = t2; /* don't need to trail */ + } + return(output); + } else { + return(inp); + } + + def_aux_overflow(); + def_global_overflow(); + +} + + /** @pred term_attvars(+ _Term_,- _AttVars_) + + + _AttVars_ is a list of all attributed variables in _Term_ and + its attributes. I.e., term_attvars/2 works recursively through + attributes. This predicate is Cycle-safe. + + + */ +static Int +p_term_attvars( USES_REGS1 ) /* variables in term t */ +{ + Term out; + + do { + Term t = Deref(ARG1); + if (IsPrimitiveTerm(t)) { + return Yap_unify(TermNil, ARG2); + } else { + out = attvars_in_complex_term(&(t)-1, + &(t), TermNil PASS_REGS); + } + if (out == 0L) { + if (!expand_vts( 3 PASS_REGS )) + return false; + } + } while (out == 0L); + return Yap_unify(ARG2,out); +} + +/** @brief output the difference between variables in _T_ and variables in some list. + */ +static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) +{ + int lvl = push_text_stack(); + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; + register tr_fr_ptr TR0 = TR; + CELL *InitialH = HR; + CELL output = AbsPair(HR); + + to_visit0 = to_visit; + while (!IsVarTerm(inp) && IsPairTerm(inp)) { + Term t = HeadOfTerm(inp); + if (IsVarTerm(t)) { + CELL *ptr = VarOfTerm(t); + *ptr = TermFoundVar; + TrailTerm(TR++) = t; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + } + inp = TailOfTerm(inp); + } + restart: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, vars_within_term_unk); + vars_within_term_nvar: + { + WALK_COMPLEX_TERM(); + + continue; + } + + derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); + /* do or pt2 are unbound */ + *ptd0 = TermNil; + /* leave an empty slot to fill in later */ + if (HR+1024 > ASP) { + goto global_overflow; + } + HR[1] = AbsPair(HR+2); + HR += 2; + HR[-2] = (CELL)ptd0; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; + } + + clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); + if (HR != InitialH) { + HR[-1] = TermNil; + return output; + } else { + return TermNil; + } + + def_trail_overflow(); + def_aux_overflow(); + def_global_overflow(); +} + + +/** @pred new_variables_in_term(+_CurrentVariables_, ? _Term_, -_Variables_) + + + + Unify _Variables_ with the list of all variables of term + _Term_ that do not occur in _CurrentVariables_. The variables occur in the order of their first + appearance when traversing the term depth-first, left-to-right. + + +*/ +static Int +p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ +{ + Term out; + + do { + Term t = Deref(ARG2); + if (IsPrimitiveTerm(t)) + out = TermNil; + else { + out = new_vars_in_complex_term(&(t)-1, + &(t), Deref(ARG1) PASS_REGS); + } + if (out == 0L) { + if (!expand_vts( 3 PASS_REGS )) + return FALSE; + } + } while (out == 0L); + return Yap_unify(ARG3,out); +} + + +static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) +{ + + int lvl = push_text_stack(); + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; + register tr_fr_ptr TR0 = TR; + CELL *InitialH = HR; + CELL output = AbsPair(HR); + + to_visit0 = to_visit; + while (!IsVarTerm(inp) && IsPairTerm(inp)) { + Term t = HeadOfTerm(inp); + if (IsVarTerm(t)) { + CELL *ptr = VarOfTerm(t); + *ptr = TermFoundVar; + TrailTerm(TR++) = t; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + } + inp = TailOfTerm(inp); + } + restart: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, vars_within_term_unk); + vars_within_term_nvar: + { + WALK_COMPLEX_TERM() + else if (d0 == TermFoundVar) { + /* leave an empty slot to fill in later */ + if (HR+1024 > ASP) { + goto global_overflow; + } + HR[1] = AbsPair(HR+2); + HR += 2; + HR[-2] = (CELL)ptd0; + *ptd0 = TermNil; + } + } + continue; + + derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; + } + + clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); + if (HR != InitialH) { + HR[-1] = TermNil; + return output; + } else { + return TermNil; + } + + + def_trail_overflow(); + def_aux_overflow(); + def_global_overflow(); +} + +/** @pred variables_within_term(+_CurrentVariables_, ? _Term_, -_Variables_) + + + + Unify _Variables_ with the list of all variables of term + _Term_ that *also* occur in _CurrentVariables_. The variables occur in the order of their first + appearance when traversing the term depth-first, left-to-right. + +This predicate performs the opposite of new_variables_in_term/3. + +*/ +static Int +p_variables_within_term( USES_REGS1 ) /* variables within term t */ +{ + Term out; + + do { + Term t = Deref(ARG2); + if (IsPrimitiveTerm(t)) + out = TermNil; + else { + out = vars_within_complex_term(&(t)-1, + &(t), Deref(ARG1) PASS_REGS); + } + if (out == 0L) { + if (!expand_vts( 3 PASS_REGS )) + return FALSE; + } + } while (out == 0L); + return Yap_unify(ARG3,out); +} + + +static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) +{ + int lvl = push_text_stack(); + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; + Term o = TermNil; + CELL *InitialH = HR; + to_visit0 = to_visit; + restart: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, vars_within_term_unk); + vars_within_term_nvar: + { + WALK_COMPLEX_TERM(); + continue; + } + + derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); + /* do or pt2 are unbound */ + *ptd0 = TermNil; + /* leave an empty slot to fill in later */ + if (HR+1024 > ASP) { + o = TermNil; + goto global_overflow; + } + HR[0] = (CELL)ptd0; + HR[1] = o; + o = AbsPair(HR); + HR += 2; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; + } + + clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); + return o; + + + def_trail_overflow(); + def_aux_overflow(); + def_global_overflow(); + +} + +static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) +{ + register CELL **to_visit0, + **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + CELL *InitialH = HR; + + to_visit0 = to_visit; + loop: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + deref_head(d0, vars_within_term_unk); + vars_within_term_nvar: + { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } + continue; + } + + derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); + /* do or pt2 are unbound */ + *ptd0 = TermFoundVar; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; + } + + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + return TermNil; + + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + aux_overflow: + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + +} + + +static Int +p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ +{ + Term out; + Term t, t0; + Term found_module = 0L; + + do { + tr_fr_ptr TR0 = TR; + + t = t0 = Deref(ARG1); + while (!IsVarTerm(t) && IsApplTerm(t)) { + Functor f = FunctorOfTerm(t); + if (f == FunctorHat) { + out = bind_vars_in_complex_term(RepAppl(t), + RepAppl(t)+1, TR0 PASS_REGS); + if (out == 0L) { + goto trail_overflow; + } + } else if (f == FunctorModule) { + found_module = ArgOfTerm(1, t); + } else if (f == FunctorCall) { + t = ArgOfTerm(1, t); + continue; + } else if (f == FunctorExecuteInMod) { + found_module = ArgOfTerm(2, t); + t = ArgOfTerm(1, t); + continue; + } else { + break; + } + t = ArgOfTerm(2,t); + } + if (IsPrimitiveTerm(t)) + out = TermNil; + else { + out = free_vars_in_complex_term(&(t)-1, + &(t), TR0 PASS_REGS); + } + if (out == 0L) { + trail_overflow: + if (!expand_vts( 3 PASS_REGS )) + return FALSE; + } + } while (out == 0L); + if (found_module && t!=t0) { + Term ts[2]; + ts[0] = found_module; + ts[1] = t; + t = Yap_MkApplTerm(FunctorModule, 2, ts); + } + return + Yap_unify(ARG2, t) && + Yap_unify(ARG3,out); +} + + + +static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) +{ + int lvl = push_text_stack(); + + struct non_single_struct_t *to_visit0, + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit_max; + register tr_fr_ptr TR0 = TR; + CELL *InitialH = HR; + CELL output = AbsPair(HR); + + to_visit0 = to_visit; + to_visit_max = to_visit0+1024; + restart: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, vars_in_term_unk); + vars_in_term_nvar: + { + WALK_COMPLEX_TERM() + else if (d0 == TermFoundVar) { + CELL *pt2 = pt0; + while(IsVarTerm(*pt2)) + pt2 = (CELL *)(*pt2); + HR[1] = AbsPair(HR+2); + HR[0] = (CELL)pt2; + HR += 2; + *pt2 = TermRefoundVar; + } + continue; + } + + + derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); + /* do or pt2 are unbound */ + *ptd0 = TermFoundVar; + /* next make sure we can recover the variable again */ + TrailTerm(TR++) = (CELL)ptd0; + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; + } + + clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); + if (HR != InitialH) { + /* close the list */ + HR[-1] = Deref(ARG2); + return output; + } else { + return ARG2; + } + + def_aux_overflow(); +} + +static Int +p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ +{ + Term t; + Term out; + + while (TRUE) { + t = Deref(ARG1); + if (IsVarTerm(t)) { + out = ARG2; + } else if (IsPrimitiveTerm(t)) { + out = ARG2; + } else { + out = non_singletons_in_complex_term(&(t)-1, + &(t) PASS_REGS); + } + if (out != 0L) { + return Yap_unify(ARG3,out); + } else { + if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in singletons"); + return FALSE; + } + } + } +} + +static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) +{ + int lvl = push_text_stack(); + + struct non_single_struct_t *to_visit0, + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit_max; + + to_visit0 = to_visit; + to_visit_max = to_visit0+1024; + restart: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + + ++pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, vars_in_term_unk); + vars_in_term_nvar: + WALK_COMPLEX_TERM(); + continue; + + + + derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); + while (to_visit > to_visit0) { + to_visit --; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + } + pop_text_stack(lvl); + return false; + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; + } + pop_text_stack(lvl); + return true; + + def_aux_overflow(); +} + +bool Yap_IsGroundTerm(Term t) +{ + CACHE_REGS + while (TRUE) { + Int out; + + if (IsVarTerm(t)) { + return FALSE; + } else if (IsPrimitiveTerm(t)) { + return TRUE; + } else { + if ((out =ground_complex_term(&(t)-1, + &(t) PASS_REGS)) >= 0) { + return out != 0; + } + if (out < 0) { + *HR++ = t; + if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); + return false; + } + t = *--HR; + } + } + } +} + + /** @pred ground( _T_) is iso + + + Succeeds if there are no free variables in the term _T_. + + + */ +static Int +p_ground( USES_REGS1 ) /* ground(+T) */ +{ + return Yap_IsGroundTerm(Deref(ARG1)); +} + +static Term +numbervar(Int id USES_REGS) +{ + Term ts[1]; + ts[0] = MkIntegerTerm(id); + return Yap_MkApplTerm(FunctorDollarVar, 1, ts); +} + +static Term +numbervar_singleton(USES_REGS1) +{ + Term ts[1]; + ts[0] = MkIntegerTerm(-1); + return Yap_MkApplTerm(FunctorDollarVar, 1, ts); +} + +static void +renumbervar(Term t, Int id USES_REGS) +{ + Term *ts = RepAppl(t); + ts[1] = MkIntegerTerm(id); +} + +#define RENUMBER_SINGLES \ + if (singles && ap2 >= InitialH && ap2 < HR) { \ + renumbervar(d0, numbv++ PASS_REGS); \ + continue; \ + } + + +static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) +{ + + + int lvl = push_text_stack(); + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; + register tr_fr_ptr TR0 = TR; + CELL *InitialH = HR; + + to_visit0 = to_visit; + to_visit_max = to_visit0+1024; + restart: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, vars_in_term_unk); + vars_in_term_nvar: + { + WALK_COMPLEX_TERM__({},RENUMBER_SINGLES); + + continue; + } + + + derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); + /* do or pt2 are unbound */ + if (singles) + *ptd0 = numbervar_singleton( PASS_REGS1 ); + else + *ptd0 = numbervar(numbv++ PASS_REGS); + /* leave an empty slot to fill in later */ + if (HR+1024 > ASP) { + goto global_overflow; + } + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + +#if defined(TABLING) || defined(YAPOR_SBA) + TrailVal(TR) = (CELL)ptd0; +#endif + TrailTerm(TR++) = (CELL)ptd0; + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; + } + + prune(B PASS_REGS); + pop_text_stack(lvl); + return numbv; + + def_trail_overflow(); + def_aux_overflow(); + def_global_overflow(); +} + + +Int +Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* + * numbervariables in term t */ +{ + CACHE_REGS + Int out; + Term t; + + restart: + t = Deref(inp); + if (IsVarTerm(t)) { + CELL *ptd0 = VarOfTerm(t); + TrailTerm(TR++) = (CELL)ptd0; + if (handle_singles) { + *ptd0 = numbervar_singleton( PASS_REGS1 ); + return numbv; + } else { + *ptd0 = numbervar(numbv PASS_REGS); + return numbv+1; + } + } else if (IsPrimitiveTerm(t)) { + return numbv; + } else if (IsPairTerm(t)) { + out = numbervars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, numbv, handle_singles PASS_REGS); + } else { + Functor f = FunctorOfTerm(t); + + out = numbervars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), numbv, handle_singles PASS_REGS); + } + if (out < numbv) { + if (!expand_vts( 3 PASS_REGS )) + return FALSE; + goto restart; + } +} + + /** @pred numbervars( _T_,+ _N1_,- _Nn_) + + + Instantiates each variable in term _T_ to a term of the form: + `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. + + + */ +static Int +p_numbervars( USES_REGS1 ) +{ + Term t2 = Deref(ARG2); + Int out; + + if (IsVarTerm(t2)) { + Yap_Error(INSTANTIATION_ERROR,t2,"numbervars/3"); + return FALSE; + } + if (!IsIntegerTerm(t2)) { + Yap_Error(TYPE_ERROR_INTEGER,t2,"numbervars/3"); + return(FALSE); + } + if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), FALSE)) < 0) + return FALSE; + return Yap_unify(ARG3, MkIntegerTerm(out)); +} + +void Yap_InitTermCPreds(void) +{ + Yap_InitCPred("term_variables", 2, p_term_variables, 0); + Yap_InitCPred("term_variables", 3, p_term_variables3, 0); + Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); + + Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); + + Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); + + CurrentModule = TERMS_MODULE; + Yap_InitCPred("variable_in_term", 2, p_var_in_term, 0); + Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0); + Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0); + CurrentModule = PROLOG_MODULE; + + Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); + + Yap_InitCPred("ground", 1, p_ground, SafePredFlag); + + Yap_InitCPred("numbervars", 3, p_numbervars, 0); +} + diff --git a/C/utilpreds.c b/C/utilpreds.c index bcb42b72d..d78470071 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -1,23 +1,23 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: utilpreds.c * -* Last rev: 4/03/88 * -* mods: * -* comments: new utility predicates for YAP * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: utilpreds.c * Last rev: 4/03/88 + ** mods: * comments: new utility predicates for YAP * + * * + *************************************************************************/ #ifdef SCCS static char SccsId[] = "@(#)utilpreds.c 1.3"; #endif /** + * @file utilpreds.c + * * @addtogroup Terms */ @@ -30,21 +30,55 @@ static char SccsId[] = "@(#)utilpreds.c 1.3"; #include "string.h" #endif -typedef struct { - Term old_var; - Term new_var; -} *vcell; +typedef struct non_single_struct_t { + CELL *ptd0; + CELL d0; + CELL *pt0, *pt0_end; +} non_singletons_t; + +#define def_trail_overflow() \ + trail_overflow:{ \ + while (to_visit > to_visit0) { \ + to_visit --; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + return 0L; \ + } + +#define def_aux_overflow() \ + aux_overflow:{ \ + size_t d1 = to_visit-to_visit0; \ + size_t d2 = to_visit_max-to_visit0; \ + to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \ + to_visit = to_visit0+d1; \ + to_visit_max = to_visit0+(d2+128); \ + pt0--; \ + goto restart; \ + } + +#define def_global_overflow() \ + global_overflow:{ \ + while (to_visit > to_visit0) { \ + to_visit --; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); \ + return false; } -static int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE); -static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); -static Int p_non_singletons_in_term( USES_REGS1); -static CELL non_singletons_in_complex_term(CELL *, CELL * CACHE_TYPE); -static Int p_variables_in_term( USES_REGS1 ); -static Int ground_complex_term(CELL *, CELL * CACHE_TYPE); -static Int p_ground( USES_REGS1 ); static Int p_copy_term( USES_REGS1 ); -static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); + #ifdef DEBUG static Int p_force_trail_expansion( USES_REGS1 ); @@ -62,145 +96,268 @@ clean_tr(tr_fr_ptr TR0 USES_REGS) { static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { - if (TR != TR0) { - tr_fr_ptr pt = TR0; - - do { - Term p = TrailTerm(pt++); + tr_fr_ptr pt0 = TR; + while (pt0 != TR0) { + Term p = TrailTerm(--pt0); + if (IsApplTerm(p)) { + CELL *pt = RepAppl(p); +#ifdef FROZEN_STACKS + pt[0] = TrailVal(pt0); +#else + pt[0] = TrailTerm(pt0 - 1); + pt0 --; +#endif /* FROZEN_STACKS */ + } else { RESET_VARIABLE(p); - } while (pt != TR); - TR = TR0; - } + } + } + TR = TR0; } -static int -copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS) -{ +/// @brief recover original term while fixing direct refs. +/// +/// @param USES_REGS +/// +static inline void +clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { + tr_fr_ptr pt0 = TR; + while (pt0 != TR0) { + Term p = TrailTerm(--pt0); + if (IsApplTerm(p)) { + /// pt: points to the address of the new term we may want to fix. + CELL *pt = RepAppl(p); + if (pt >= HB && pt < HR) { /// is it new? + Term v = pt[0]; + if (IsApplTerm(v)) { + /// yes, more than a single ref + *pt = (CELL)RepAppl(v); + } +#ifndef FROZEN_STACKS + pt0 --; +#endif /* FROZEN_STACKS */ + continue; + } +#ifdef FROZEN_STACKS + pt[0] = TrailVal(pt0); +#else + pt[0] = TrailTerm(pt0 - 1); + pt0 --; +#endif /* FROZEN_STACKS */ + } else { + RESET_VARIABLE(p); + } + } + TR = TR0; +} + +#define expand_stack(S0,SP,SF,TYPE) \ + { size_t sz = SF-S0, used = SP-S0; \ + S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ + SP = S0+used; SF = S0+sz; } + +#define MIN_ARENA_SIZE (1048L) + +int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, + bool share, Term *split, bool copy_att_vars, CELL *ptf, + CELL *HLow USES_REGS) { + // fprintf(stderr,"+++++++++\n"); + //CELL *x = pt0; while(x != pt0_end) Yap_DebugPlWriteln(*++ x); + + int lvl = push_text_stack(); + Term o = TermNil; + struct cp_frame *to_visit0, + *to_visit = Malloc(1024*sizeof(struct cp_frame)); + struct cp_frame *to_visit_max; - struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace() ; CELL *HB0 = HB; tr_fr_ptr TR0 = TR; - int ground = TRUE; + int ground = true; - HB = HR; + HB = HLow; to_visit0 = to_visit; + to_visit_max = to_visit+1024; loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; - ptd0 = pt0; + + ptd0 = ++pt0; d0 = *ptd0; + deref: deref_head(d0, copy_term_unk); - copy_term_nvar: - { + copy_term_nvar : { if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if (ap2 >= HB && ap2 < HR) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; + CELL *headp = RepPair(d0); + Term head = *headp; + if (IsPairTerm(head) && RepPair(head) >= HB && RepPair(head) < HR) { + if (split) { + Term v = Yap_MkNewApplTerm(FunctorEq, 2); + RepAppl(v)[1] = AbsPair(ptf); + *headp = *ptf++ = RepAppl(v)[0]; + o = MkPairTerm( v, o ); + } else { + *ptf++ = RepPair(head)[0];; + } + continue; + } else if (IsApplTerm(head) && RepAppl(head) >= HB && RepAppl(head) < HR) { + *ptf++ = RepAppl(head)[0]; continue; } - *ptf = AbsPair(HR); - ptf++; - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; + *ptf++ = AbsPair(HR); + if (to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); } to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldv = *pt0; + to_visit->curp = headp; + d0 = to_visit->oldv = head; to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsPair(HR); - to_visit ++; - ground = TRUE; - pt0 = ap2 - 1; - pt0_end = ap2 + 1; + to_visit++; + // move to new list + if (share) { + TrailedMaBind(headp,AbsPair(HR)); + } else { + /* If this is newer than the current term, just reuse */ + *headp = AbsPair(HR); + } + if (split) { + TrailedMaBind(ptf,AbsPair(HR)); + } + pt0 = headp; + pt0_end = headp + 1; ptf = HR; + ground = true; HR += 2; - if (HR > ASP - 2048) { + if (HR > ASP - MIN_ARENA_SIZE) { goto overflow; } + d0 = head; + goto deref; } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; + Functor f; + CELL *headp, head; /* store the terms to visit */ - ap2 = RepAppl(d0); - if (ap2 >= HB && ap2 <= HR) { - /* If this is newer than the current term, just reuse */ + headp = RepAppl(d0); + head = *headp; + + if (IsPairTerm(head)) { + if (split) { + Term v = Yap_MkNewApplTerm(FunctorEq, 2); + RepAppl(v)[1] = AbsPair(ptf); + *headp = *ptf++ = RepAppl(v)[0]; + o = MkPairTerm( v, o ); + } else { + *ptf++ = RepPair(head)[0];; + } + continue; + } else if (IsApplTerm(head)) { + *ptf++ = RepAppl(head)[0]; + continue; + } + f = (Functor)(head); + if (share && (ground || IsExtensionFunctor(f))) { *ptf++ = d0; continue; } - f = (Functor)(*ap2); - + /* store the terms to visit */ + *ptf = AbsAppl(HR); + ptf++; + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->curp = headp; + to_visit->oldv = head; + to_visit->ground = ground; + if (++to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + if (IsExtensionFunctor(f)) { -#if MULTIPLE_STACKS - if (f == FunctorDBRef) { - DBRef entryref = DBRefOfTerm(d0); - if (entryref->Flags & LogUpdMask) { - LogUpdClause *luclause = (LogUpdClause *)entryref; - PELOCK(100,luclause->ClPred); - UNLOCK(luclause->ClPred->PELock); - } else { - LOCK(entryref->lock); - TRAIL_REF(entryref); /* So that fail will erase it */ - INC_DBREF_COUNT(entryref); - UNLOCK(entryref->lock); - } - *ptf++ = d0; /* you can just copy other extensions. */ - } else -#endif - if (!share) { - UInt sz; - - *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */ - /* make sure to copy floats */ - if (f== FunctorDouble) { - sz = sizeof(Float)/sizeof(CELL)+2; - } else if (f== FunctorLongInt) { - sz = 3; - } else if (f== FunctorString) { - sz = 3+ap2[1]; - } else { - CELL *pt = ap2+1; - sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t)); - } - if (HR+sz > ASP - 2048) { + switch ((CELL)f) { + case (CELL) FunctorDBRef: + case (CELL) FunctorAttVar: + *ptf++ = d0; + break; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { goto overflow; } - memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; + HR[2] = EndSpecials; + HR += 3; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + break; + case (CELL) FunctorDouble: + if (HR > + ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + HR[2] = headp[2]; + HR[3] = EndSpecials; + HR += 4; +#else + HR[2] = EndSpecials; + HR += 3; +#endif + break; + case (CELL) FunctorString: + if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + memmove(HR, headp, sizeof(CELL) * (3 + headp[1])); + HR += headp[1] + 3; + break; + default: { + /* big int */ + size_t sz = (sizeof(MP_INT) + 3 * CellSize + + ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / + CellSize; + + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + memmove(HR, headp, sz*sizeof(CELL)); + MP_INT *new = (MP_INT *)(HR + 2); + new->_mp_d = (mp_limb_t *)(new + 1); + HR += sz; - } else { - *ptf++ = d0; /* you can just copy other extensions. */ + } } continue; } - *ptf = AbsAppl(HR); - ptf++; - /* store the terms to visit */ - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; + if (share) { + TrailedMaBind(headp,AbsPair(HR)); + } else { + *headp = AbsPair(HR); } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsAppl(HR); - to_visit ++; - ground = (f != FunctorMutable); - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - HR[0] = (CELL)f; - ptf = HR+1; - HR += 1+d0; - if (HR > ASP - 2048) { + if (split) { + // must be after trailing source term, so that we can check the source + // term and confirm it is still ok. + TrailedMaBind(ptf,AbsAppl(HR)); + } + ptf = HR; + ptf[0] = (CELL)f; + ground = true; + arity_t a = ArityOfFunctor(f); + if (HR > ASP - MIN_ARENA_SIZE) { goto overflow; } + ptf++; + HR = ptf+a; + pt0_end = headp+(a); + pt0 = headp; + ground = (f != FunctorMutable); } else { /* just copy atoms or integers */ *ptf++ = d0; @@ -209,66 +366,61 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, } derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = FALSE; - if (ptd0 >= HLow && ptd0 < HR) { + ground = false; + /* don't need to copy variables if we want to share the global term */ + if (//(share && ptd0 < HB && ptd0 > H0) || + (ptd0 >= HB && ptd0 < HR)) { /* we have already found this cell */ - *ptf++ = (CELL) ptd0; - } else -#if COROUTINING - if (newattvs && IsAttachedTerm((CELL)ptd0)) { + *ptf++ = (CELL)ptd0; + } else + if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { /* if unbound, call the standard copy term routine */ struct cp_frame *bp; - CELL new; bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, + ptf PASS_REGS)) { goto overflow; } to_visit = bp; new = *ptf; - Bind_NonAtt(ptd0, new); - ptf++; - } else { -#endif - /* first time we met this term */ - RESET_VARIABLE(ptf); if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { goto trail_overflow; } } - Bind_NonAtt(ptd0, (CELL)ptf); + + } else { + /* first time we met this term */ + RESET_VARIABLE(ptf); + *ptd0 = (CELL)ptf; ptf++; + if ((ADDR)TR > LOCAL_TrailTop - 16) + goto trail_overflow; + } } + /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit --; - if (ground && share) { - CELL old = to_visit->oldv; - CELL *newp = to_visit->to-1; - CELL new = *newp; - - *newp = old; - if (IsApplTerm(new)) - HR = RepAppl(new); - else - HR = RepPair(new); - } + to_visit--; + if (!share) + *to_visit->curp = to_visit->oldv; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; - *pt0 = to_visit->oldv; ground = (ground && to_visit->ground); goto loop; } /* restore our nice, friendly, term to its original state */ - clean_dirty_tr(TR0 PASS_REGS); - HB = HB0; - return ground; + clean_complex_tr(TR0 PASS_REGS); + /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); + return 0; + overflow: /* oops, we're in trouble */ @@ -277,62 +429,38 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; - *pt0 = to_visit->oldv; } reset_trail(TR0); - /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); return -1; -trail_overflow: + trail_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; - *pt0 = to_visit->oldv; - } - { - tr_fr_ptr oTR = TR; - reset_trail(TR0); - if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - return -4; - } - return -2; - } - - heap_overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - *pt0 = to_visit->oldv; } reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; - return -3; - } + pop_text_stack(lvl); + return -4; +} static Term handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) { CACHE_REGS - XREGS[arity+1] = t; + XREGS[arity+1] = t; switch(res) { case -1: if (!Yap_gcl((ASP-HR)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { @@ -369,97 +497,39 @@ static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; - - if (IsVarTerm(t)) { -#if COROUTINING - if (newattvs && IsAttachedTerm(t)) { - CELL *Hi; - int res; - restart_attached: - - *HR = t; - Hi = HR+1; - HR += 2; - if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { - HR = Hi-1; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_attached; - } - return Hi[0]; - } -#endif - return MkVarTerm(); - } else if (IsPrimitiveTerm(t)) { - return t; - } else if (IsPairTerm(t)) { - Term tf; - CELL *ap; CELL *Hi; - restart_list: - ap = RepPair(t); + if (IsPrimitiveTerm(t)) { + return t; + } + while( true ) { + int res; Hi = HR; - tf = AbsPair(HR); - HR += 2; - { - int res; - if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { + HR ++; + + if ((res = Yap_copy_complex_term((&t)-1, &t, share, NULL, newattvs, Hi, HR PASS_REGS)) < 0) { HR = Hi; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; - goto restart_list; } else if (res && share) { HR = Hi; return t; } + return Hi[0]; } - return tf; - } else { - Functor f = FunctorOfTerm(t); - Term tf; - CELL *HB0; - CELL *ap; - - restart_appl: - f = FunctorOfTerm(t); - HB0 = HR; - ap = RepAppl(t); - tf = AbsAppl(HR); - HR[0] = (CELL)f; - HR += 1+ArityOfFunctor(f); - if (HR > ASP-128) { - HR = HB0; - if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L) - return FALSE; - goto restart_appl; - } else { - int res; - - if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { - HR = HB0; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_appl; - } else if (res && share && FunctorOfTerm(t) != FunctorMutable) { - HR = HB0; - return t; - } - } - return tf; - } + return 0; } Term Yap_CopyTerm(Term inp) { CACHE_REGS - return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); + return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); } Term Yap_CopyTermNoShare(Term inp) { CACHE_REGS - return CopyTerm(inp, 0, FALSE, FALSE PASS_REGS); + return CopyTerm(inp, 0, FALSE, FALSE PASS_REGS); } static Int @@ -532,7 +602,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te HB = HR; to_visit0 = to_visit; - loop: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; @@ -543,9 +613,9 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te copy_term_nvar: { if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - fprintf(stderr, "%ld \n", RepPair(ap2[0])- ptf); - if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) { + CELL *headp = RepPair(d0); + //fprintf(stderr, "%d \n", RepPair(headp[0])- ptf); + if (IsVarTerm(headp[0]) && IN_BETWEEN(HB, (headp[0]),HR)) { Term v = MkVarTerm(); *ptf = v; vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) ); @@ -559,19 +629,19 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldp = ap2; - d0 = to_visit->oldv = ap2[0]; + to_visit->oldp = headp; + d0 = to_visit->oldv = headp[0]; /* fool the system into thinking we had a variable there */ to_visit ++; - pt0 = ap2; - pt0_end = ap2 + 1; + pt0 = headp; + pt0_end = headp + 1; ptf = HR; - *ap2 = AbsPair(HR); + *headp = AbsPair(HR); HR += 2; if (HR > ASP - 2048) { goto overflow; } - if (IsVarTerm(d0) && d0 == (CELL)ap2) { + if (IsVarTerm(d0) && d0 == (CELL)headp) { RESET_VARIABLE(ptf); ptf++; continue; @@ -585,17 +655,17 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te continue; } else if (IsApplTerm(d0)) { register Functor f; - register CELL *ap2; + register CELL *headp; /* store the terms to visit */ - ap2 = RepAppl(d0)+1; - f = (Functor)(ap2[-1]); + headp = RepAppl(d0)+1; + f = (Functor)(headp[-1]); if (IsExtensionFunctor(f)) { - *ptf++ = d0; /* you can just copy other extensions. */ + *ptf++ = d0; /* you can just copy other extensions. */ continue; } - if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) { + if (IsApplTerm(headp[0]) && IN_BETWEEN(HB, RepAppl(headp[0]),HR)) { RESET_VARIABLE(ptf); - vin = add_to_list(vin, (CELL)ptf, ap2[0] ); + vin = add_to_list(vin, (CELL)ptf, headp[0] ); ptf++; continue; } @@ -608,24 +678,19 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldp = ap2; - d0 = to_visit->oldv = ap2[0]; + to_visit->oldp = headp; + d0 = to_visit->oldv = headp[0]; /* fool the system into thinking we had a variable there */ to_visit ++; - pt0 = ap2; - pt0_end = ap2 + (arity-1); + pt0 = headp; + pt0_end = headp + (arity-1); ptf = HR; if (HR > ASP - 2048) { goto overflow; } *ptf++ =(CELL)f; - *ap2 = AbsAppl(HR); + *headp = AbsAppl(HR); HR += (arity+1); - if (IsVarTerm(d0) && d0 == (CELL)(ap2)) { - RESET_VARIABLE(ptf); - ptf++; - continue; - } d0 = Deref(d0); if (!IsVarTerm(d0)) { goto copy_term_nvar; @@ -698,7 +763,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te } - Term +Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { Term t = Deref(inp); Term tii = ti; @@ -708,7 +773,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { *to = ti; return t; } else if (IsPrimitiveTerm(t)) { - *to = ti; + *to = ti; return t; } else if (IsPairTerm(t)) { CELL *ap; @@ -749,7 +814,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { arity = ArityOfFunctor(f); HR += 1+arity; - { + { Int res; if ((res = break_rationals_complex_term(ap, ap+(arity), HB0+1, to, ti, HB0 PASS_REGS)) < 0) { HR = HB0; @@ -766,7 +831,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { } } - static int +static int break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS) { @@ -787,7 +852,7 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL if (new) { /* mark cell as pointing to new copy */ /* we can only mark after reading the value of the first argument */ - MaBind(pt0, new); + TrailedMaBind(pt0, new); new = 0L; } deref_head(d0, break_rationals_unk); @@ -921,7 +986,7 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL return -3; } - Term +Term Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; @@ -973,21 +1038,21 @@ p_break_rational3( USES_REGS1 ) /* - FAST EXPORT ROUTINE. Export a Prolog term to something like: + FAST EXPORT ROUTINE. Export a Prolog term to something like: - CELL 0: offset for start of term - CELL 1: size of actual term (to be copied to stack) - CELL 2: the original term (just for reference) + CELL 0: offset for start of term + CELL 1: size of actual term (to be copied to stack) + CELL 2: the original term (just for reference) - Atoms and functors: - - atoms are either: - 0 and a char *string - -1 and a wchar_t *string - - functors are a CELL with arity and a string. + Atoms and functors: + - atoms are either: + 0 and a char *string + -1 and a wchar_t *string + - functors are a CELL with arity and a string. - Compiled Term. + Compiled Term. - */ +*/ static inline CELL *CellDifH(CELL *hptr, CELL *hlow) @@ -1042,14 +1107,14 @@ Functor export_functor(Functor f, char **hpp, char *buf, size_t len) return (Functor)(((char *)hptr-buf)+1); } -#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \ - do { \ - if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \ - (A) = (CELL *)(D); \ - (D) = *(CELL *)(D); \ - if(!IsVarTerm(D)) goto LabelNonVar; \ - LabelUnk: ; \ - } while (Unsigned(A) != (D)) +#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \ + do { \ + if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \ + (A) = (CELL *)(D); \ + (D) = *(CELL *)(D); \ + if(!IsVarTerm(D)) goto LabelNonVar; \ + LabelUnk: ; \ + } while (Unsigned(A) != (D)) static int @@ -1291,7 +1356,7 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0, /* follow chain of multi-assigned variables */ return -1; -trail_overflow: + trail_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -1368,7 +1433,7 @@ ExportTerm(Term inp, char * buf, size_t len, UInt arity, int newattvs USES_REGS) size_t Yap_ExportTerm(Term inp, char * buf, size_t len, UInt arity) { CACHE_REGS - return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS); + return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS); } @@ -1386,7 +1451,7 @@ addAtom(Atom t, char *buf) if (!*s) { return Yap_LookupAtom(s+1); } - return NULL; + return NULL; } static UInt @@ -1458,7 +1523,7 @@ import_pair(CELL *hp, char *abase, char *buf, CELL *amax) Term Yap_ImportTerm(char * buf) { CACHE_REGS - CELL *bc = (CELL *)buf; + CELL *bc = (CELL *)buf; size_t sz = bc[1]; Term tinp, tret; tinp = bc[2]; @@ -1536,174 +1601,6 @@ p_kill_exported_term( USES_REGS1 ) } -static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ - - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - CELL output = AbsPair(HR); - - to_visit0 = to_visit; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; - } - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; - } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; - } - - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - if (HR != InitialH) { - /* close the list */ - Term t2 = Deref(inp); - if (IsVarTerm(t2)) { - RESET_VARIABLE(HR-1); - Yap_unify((CELL)(HR-1),inp); - } else { - HR[-1] = t2; /* don't need to trail */ - } - return(output); - } else { - return(inp); - } - - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - return 0L; - -} static int expand_vts( int args USES_REGS ) @@ -1734,972 +1631,11 @@ expand_vts( int args USES_REGS ) return TRUE; } -static Int -p_variables_in_term( USES_REGS1 ) /* variables in term t */ -{ - Term out, inp; - int count; - - - restart: - count = 0; - inp = Deref(ARG2); - while (!IsVarTerm(inp) && IsPairTerm(inp)) { - Term t = HeadOfTerm(inp); - if (IsVarTerm(t)) { - CELL *ptr = VarOfTerm(t); - *ptr = TermFoundVar; - TrailTerm(TR++) = t; - count++; - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - clean_tr(TR-count PASS_REGS); - if (!Yap_growtrail(count*sizeof(tr_fr_ptr *), FALSE)) { - return FALSE; - } - goto restart; - } - } - inp = TailOfTerm(inp); - } - do { - Term t = Deref(ARG1); - if (IsVarTerm(t)) { - out = AbsPair(HR); - HR += 2; - RESET_VARIABLE(HR-2); - RESET_VARIABLE(HR-1); - Yap_unify((CELL)(HR-2),ARG1); - Yap_unify((CELL)(HR-1),ARG2); - } else if (IsPrimitiveTerm(t)) - out = ARG2; - else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, ARG2 PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), ARG2 PASS_REGS); - } - if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; - } - } while (out == 0L); - clean_tr(TR-count PASS_REGS); - return Yap_unify(ARG3,out); -} - - -static Int -p_term_variables( USES_REGS1 ) /* variables in term t */ -{ - Term out; - - if (!Yap_IsListOrPartialListTerm(ARG2)) { - Yap_Error(TYPE_ERROR_LIST,ARG2,"term_variables/2"); - return FALSE; - } - - do { - Term t = Deref(ARG1); - if (IsVarTerm(t)) { - Term out = Yap_MkNewPairTerm(); - return - Yap_unify(t,HeadOfTerm(out)) && - Yap_unify(TermNil, TailOfTerm(out)) && - Yap_unify(out, ARG2); - } else if (IsPrimitiveTerm(t)) { - return Yap_unify(TermNil, ARG2); - } else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); - } - if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; - } - } while (out == 0L); - return Yap_unify(ARG2,out); -} - -/** - * Exports a nil-terminated list with all the variables in a term. - * @param[t] the term - * @param[arity] the arity of the calling predicate (required for exact garbage collection). - * @param[USES_REGS] threading - */ -Term -Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ -{ - Term out; - - do { - t = Deref(t); - if (IsVarTerm(t)) { - return MkPairTerm(t, TermNil); - } else if (IsPrimitiveTerm(t)) { - return TermNil; - } else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); - } - if (out == 0L) { - if (!expand_vts( arity PASS_REGS )) - return FALSE; - } - } while (out == 0L); - return out; -} - -typedef struct att_rec { - CELL *beg, *end; - CELL oval; -} att_rec_t; - -static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ - int lvl = push_text_stack(); - att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t)); - att_rec_t *to_visit_max; - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - CELL output = AbsPair(HR); - - to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: - do { - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, attvars_in_term_unk); - attvars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - { - CELL *npt0 = RepPair(d0); - if(IsAtomicTerm(Deref(npt0[0]))) { - pt0 = npt0; - pt0_end = pt0 + 1; - continue; - } - } -#ifdef RATIONAL_TREES - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = pt0+2; - } else if (IsApplTerm(d0)) { - Functor f; - CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - arity_t a = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + a; - } - continue; - } - - - derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); - if (IsAttVar(ptd0)) { - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - /* store the terms to visit */ - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = &RepAttVar(ptd0)->Value; - pt0_end = &RepAttVar(ptd0)->Atts; - } - continue; - } - /* Do we still have compound terms to visit */ - if (to_visit == to_visit0) - break; -#ifdef RATIONAL_TREES - to_visit --; - pt0 = to_visit->beg; - pt0_end = to_visit->end; - *pt0 = to_visit->oval; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - } while(true); - - clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); - if (HR != InitialH) { - /* close the list */ - Term t2 = Deref(inp); - if (IsVarTerm(t2)) { - RESET_VARIABLE(HR-1); - Yap_unify((CELL)(HR-1), t2); - } else { - HR[-1] = t2; /* don't need to trail */ - } - return(output); - } else { - return(inp); - } - - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->beg; - *pt0 = to_visit->oval; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); - HR = InitialH; - return 0L; - - aux_overflow: - { - size_t d1 = to_visit-to_visit0; - size_t d2 = to_visit_max-to_visit0; - to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024); - to_visit = to_visit0+d1; - to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); -} -pt0--; -goto restart; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->beg; - *pt0 = to_visit->oval; - } -#endif - clean_tr(TR0 PASS_REGS); -pop_text_stack(lvl); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - return 0L; - -} - -static Int -p_term_attvars( USES_REGS1 ) /* variables in term t */ -{ - Term out; - - do { - Term t = Deref(ARG1); - if (IsVarTerm(t)) { - out = attvars_in_complex_term(VarOfTerm(t)-1, - VarOfTerm(t)+1, TermNil PASS_REGS); - } else if (IsPrimitiveTerm(t)) { - return Yap_unify(TermNil, ARG2); - } else if (IsPairTerm(t)) { - out = attvars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - if (IsExtensionFunctor(f)) - return Yap_unify(TermNil, ARG2); - out = attvars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); - } - if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; - } - } while (out == 0L); - return Yap_unify(ARG2,out); -} - -static Int -p_term_variables3( USES_REGS1 ) /* variables in term t */ -{ - Term out; - - do { - Term t = Deref(ARG1); - if (IsVarTerm(t)) { - Term out = Yap_MkNewPairTerm(); - return - Yap_unify(t,HeadOfTerm(out)) && - Yap_unify(ARG3, TailOfTerm(out)) && - Yap_unify(out, ARG2); - } else if (IsPrimitiveTerm(t)) { - return Yap_unify(ARG2, ARG3); - } else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, ARG3 PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), ARG3 PASS_REGS); - } - if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; - } - } while (out == 0L); - - return Yap_unify(ARG2,out); -} - - -static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ - - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - CELL output = AbsPair(HR); - - to_visit0 = to_visit; - while (!IsVarTerm(inp) && IsPairTerm(inp)) { - Term t = HeadOfTerm(inp); - if (IsVarTerm(t)) { - CELL *ptr = VarOfTerm(t); - *ptr = TermFoundVar; - TrailTerm(TR++) = t; - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - } - inp = TailOfTerm(inp); - } - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } else if (d0 == TermFoundVar) { - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - *ptd0 = TermNil; - } - continue; - } - - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; - } - - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - if (HR != InitialH) { - HR[-1] = TermNil; - return output; - } else { - return TermNil; - } - - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - return 0L; - -} - -static Int -p_variables_within_term( USES_REGS1 ) /* variables within term t */ -{ - Term out; - - do { - Term t = Deref(ARG2); - if (IsVarTerm(t)) { - out = vars_within_complex_term(VarOfTerm(t)-1, - VarOfTerm(t), Deref(ARG1) PASS_REGS); - - } else if (IsPrimitiveTerm(t)) - out = TermNil; - else if (IsPairTerm(t)) { - out = vars_within_complex_term(RepPair(t)-1, - RepPair(t)+1, Deref(ARG1) PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = vars_within_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), Deref(ARG1) PASS_REGS); - } - if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; - } - } while (out == 0L); - return Yap_unify(ARG3,out); -} - -static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - CELL output = AbsPair(HR); - - to_visit0 = to_visit; - while (!IsVarTerm(inp) && IsPairTerm(inp)) { - Term t = HeadOfTerm(inp); - if (IsVarTerm(t)) { - CELL *ptr = VarOfTerm(t); - *ptr = TermFoundVar; - TrailTerm(TR++) = t; - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - } - inp = TailOfTerm(inp); - } - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; - } - - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; - } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; - } - - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - if (HR != InitialH) { - HR[-1] = TermNil; - return output; - } else { - return TermNil; - } - - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - return 0L; - -} - -static Int -p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ -{ - Term out; - - do { - Term t = Deref(ARG2); - if (IsVarTerm(t)) { - out = new_vars_in_complex_term(VarOfTerm(t)-1, - VarOfTerm(t), Deref(ARG1) PASS_REGS); - - } else if (IsPrimitiveTerm(t)) - out = TermNil; - else if (IsPairTerm(t)) { - out = new_vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, Deref(ARG1) PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = new_vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), Deref(ARG1) PASS_REGS); - } - if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; - } - } while (out == 0L); - return Yap_unify(ARG3,out); -} - -static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) -{ - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); - CELL *InitialH = HR; - *HR++ = MkAtomTerm(AtomDollar); - - to_visit0 = to_visit; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; - } - - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[0] = (CELL)ptd0; - HR ++; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; - } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; - } - - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - if (HR != InitialH) { - InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1); - return AbsAppl(InitialH); - } else { - return MkAtomTerm(AtomDollar); - } - - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - return 0L; - -} static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) { - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + register CELL **to_visit0, + **to_visit = (CELL **)Yap_PreAllocCodeSpace(); CELL *InitialH = HR; to_visit0 = to_visit; @@ -2796,13 +1732,11 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end return TermNil; trail_overflow: -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; pt0 = to_visit[0]; *pt0 = (CELL)to_visit[2]; } -#endif LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); @@ -2827,388 +1761,7 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end } -static Int -p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ -{ - Term out; - Term t, t0; - Term found_module = 0L; - do { - tr_fr_ptr TR0 = TR; - - t = t0 = Deref(ARG1); - while (!IsVarTerm(t) && IsApplTerm(t)) { - Functor f = FunctorOfTerm(t); - if (f == FunctorHat) { - out = bind_vars_in_complex_term(RepAppl(t), - RepAppl(t)+1, TR0 PASS_REGS); - if (out == 0L) { - goto trail_overflow; - } - } else if (f == FunctorModule) { - found_module = ArgOfTerm(1, t); - } else if (f == FunctorCall) { - t = ArgOfTerm(1, t); - continue; - } else if (f == FunctorExecuteInMod) { - found_module = ArgOfTerm(2, t); - t = ArgOfTerm(1, t); - continue; - } else { - break; - } - t = ArgOfTerm(2,t); - } - if (IsVarTerm(t)) { - out = free_vars_in_complex_term(VarOfTerm(t)-1, - VarOfTerm(t), TR0 PASS_REGS); - - } else if (IsPrimitiveTerm(t)) - out = TermNil; - else if (IsPairTerm(t)) { - out = free_vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TR0 PASS_REGS); - } - else { - Functor f = FunctorOfTerm(t); - out = free_vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TR0 PASS_REGS); - } - if (out == 0L) { - trail_overflow: - if (!expand_vts( 3 PASS_REGS )) - return FALSE; - } - } while (out == 0L); - if (found_module && t!=t0) { - Term ts[2]; - ts[0] = found_module; - ts[1] = t; - t = Yap_MkApplTerm(FunctorModule, 2, ts); - } - return - Yap_unify(ARG2, t) && - Yap_unify(ARG3,out); -} - -static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) -{ - - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - CELL output = AbsPair(HR); - - to_visit0 = to_visit; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - - continue; - } - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } else if (d0 == TermFoundVar) { - CELL *pt2 = pt0; - while(IsVarTerm(*pt2)) - pt2 = (CELL *)(*pt2); - HR[0] = AbsPair(HR+2); - HR += 2; - HR[-1] = (CELL)pt2; - *pt2 = TermRefoundVar; - } - continue; - } - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; - /* next make sure we can recover the variable again */ - TrailTerm(TR++) = (CELL)ptd0; - } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; - goto loop; - } - - clean_tr(TR0 PASS_REGS); - if (HR != InitialH) { - CELL *pt0 = InitialH, *pt1 = pt0; - while (pt0 < InitialH) { - if(Deref(pt0[0]) == TermFoundVar) { - pt1[0] = pt0[0]; - pt1[1] = AbsAppl(pt1+2); - pt1 += 2; - } - pt0 += 2; - } - } - if (HR != InitialH) { - /* close the list */ - HR[-1] = Deref(ARG2); - return output; - } else { - return ARG2; - } - - aux_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - if (HR != InitialH) { - /* close the list */ - RESET_VARIABLE(HR-1); - } - return 0L; -} - -static Int -p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ -{ - Term t; - Term out; - - while (TRUE) { - t = Deref(ARG1); - if (IsVarTerm(t)) { - out = ARG2; - } else if (IsPrimitiveTerm(t)) { - out = ARG2; - } else if (IsPairTerm(t)) { - out = non_singletons_in_complex_term(RepPair(t)-1, - RepPair(t)+1 PASS_REGS); - } else { - out = non_singletons_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(FunctorOfTerm(t)) PASS_REGS); - } - if (out != 0L) { - return Yap_unify(ARG3,out); - } else { - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in singletons"); - return FALSE; - } - } - } -} - -static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) -{ - - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); - - to_visit0 = to_visit; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - - ++pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - continue; - } - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; - } - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; - } -#endif - return FALSE; - } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; - } - return TRUE; - - aux_overflow: - /* unwind stack */ -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - return -1; -} - -bool Yap_IsGroundTerm(Term t) -{ - CACHE_REGS - while (TRUE) { - Int out; - - if (IsVarTerm(t)) { - return FALSE; - } else if (IsPrimitiveTerm(t)) { - return TRUE; - } else if (IsPairTerm(t)) { - if ((out =ground_complex_term(RepPair(t)-1, - RepPair(t)+1 PASS_REGS)) >= 0) { - return out != 0; - } - } else { - Functor fun = FunctorOfTerm(t); - - if (IsExtensionFunctor(fun)) - return TRUE; - else if ((out = ground_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(fun) PASS_REGS)) >= 0) { - return out != 0; - } - } - if (out < 0) { - *HR++ = t; - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); - return false; - } - t = *--HR; - } - } -} - -static Int -p_ground( USES_REGS1 ) /* ground(+T) */ -{ - return Yap_IsGroundTerm(Deref(ARG1)); -} static int SizeOfExtension(Term t) @@ -3354,32 +1907,32 @@ int Yap_SizeGroundTerm(Term t, int ground) { CACHE_REGS - if (IsVarTerm(t)) { - if (!ground) + if (IsVarTerm(t)) { + if (!ground) + return 1; + return 0; + } else if (IsPrimitiveTerm(t)) { return 1; - return 0; - } else if (IsPrimitiveTerm(t)) { - return 1; - } else if (IsPairTerm(t)) { - int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground PASS_REGS); - if (sz <= 0) - return sz; - return sz+2; -} else { - int sz = 0; - Functor fun = FunctorOfTerm(t); + } else if (IsPairTerm(t)) { + int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground PASS_REGS); + if (sz <= 0) + return sz; + return sz+2; + } else { + int sz = 0; + Functor fun = FunctorOfTerm(t); - if (IsExtensionFunctor(fun)) - return 1+ SizeOfExtension(t); + if (IsExtensionFunctor(fun)) + return 1+ SizeOfExtension(t); - sz = sz_ground_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(fun), - ground PASS_REGS); - if (sz <= 0) - return sz; - return 1+ArityOfFunctor(fun)+sz; - } + sz = sz_ground_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(fun), + ground PASS_REGS); + if (sz <= 0) + return sz; + return 1+ArityOfFunctor(fun)+sz; + } } static Int var_in_complex_term(register CELL *pt0, @@ -3550,52 +2103,52 @@ p_var_in_term( USES_REGS1 ) // And it has a few limitations - // 1. It will not work incrementally. -// 2. It will not produce the same results on little-endian and big-endian +// 2. It will not produce the same results on litle-endian and big-endian // machines. static unsigned int MurmurHashNeutral2 ( const void * key, int len, unsigned int seed ) { - const unsigned int m = 0x5bd1e995; - const int r = 24; + const unsigned int m = 0x5bd1e995; + const int r = 24; - unsigned int h = seed ^ len; + unsigned int h = seed ^ len; - const unsigned char * data = (const unsigned char *)key; + const unsigned char * data = (const unsigned char *)key; - while(len >= 4) - { - unsigned int k; + while(len >= 4) + { + unsigned int k; - k = data[0]; - k |= data[1] << 8; - k |= data[2] << 16; - k |= data[3] << 24; + k = data[0]; + k |= data[1] << 8; + k |= data[2] << 16; + k |= data[3] << 24; - k *= m; - k ^= k >> r; - k *= m; + k *= m; + k ^= k >> r; + k *= m; - h *= m; - h ^= k; + h *= m; + h ^= k; - data += 4; - len -= 4; - } + data += 4; + len -= 4; + } - switch(len) - { - case 3: h ^= data[2] << 16; - case 2: h ^= data[1] << 8; - case 1: h ^= data[0]; - h *= m; - }; + switch(len) + { + case 3: h ^= data[2] << 16; + case 2: h ^= data[1] << 8; + case 1: h ^= data[0]; + h *= m; + }; - h ^= h >> 13; - h *= m; - h ^= h >> 15; + h ^= h >> 13; + h *= m; + h ^= h >> 15; - return h; + return h; } static CELL * @@ -3603,20 +2156,20 @@ addAtomToHash(CELL *st, Atom at) { unsigned int len; - char *c = RepAtom(at)->StrOfAE; - int ulen = strlen(c); - /* fix hashing over empty atom */ - if (!ulen) { - return st; - } - if (ulen % CellSize == 0) { - len = ulen/CellSize; - } else { - len = ulen/CellSize; - len++; - } - st[len-1] = 0L; - strncpy((char *)st, c, ulen); + char *c = RepAtom(at)->StrOfAE; + int ulen = strlen(c); + /* fix hashing over empty atom */ + if (!ulen) { + return st; + } + if (ulen % CellSize == 0) { + len = ulen/CellSize; + } else { + len = ulen/CellSize; + len++; + } + st[len-1] = 0L; + strncpy((char *)st, c, ulen); return st+len; } @@ -3788,7 +2341,7 @@ Int Yap_TermHash(Term t, Int size, Int depth, int variant) { CACHE_REGS - unsigned int i1; + unsigned int i1; Term t1 = Deref(t); while (TRUE) { @@ -3933,7 +2486,7 @@ p_instantiated_term_hash( USES_REGS1 ) } static int variant_complex(register CELL *pt0, register CELL *pt0_end, register - CELL *pt1 USES_REGS) + CELL *pt1 USES_REGS) { tr_fr_ptr OLDTR = TR; register CELL **to_visit = (CELL **)ASP; @@ -4022,16 +2575,16 @@ static int variant_complex(register CELL *pt0, register CELL *pt0_end, register continue; } #ifdef RATIONAL_TREES - /* now link the two structures so that no one else will */ - /* come here */ - to_visit -= 4; - if ((CELL *)to_visit < HR+1024) - goto out_of_stack; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)*pt0; - *pt0 = d1; + /* now link the two structures so that no one else will */ + /* come here */ + to_visit -= 4; + if ((CELL *)to_visit < HR+1024) + goto out_of_stack; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = (CELL *)*pt0; + *pt0 = d1; #else /* store the terms to visit */ if (pt0 < pt0_end) { @@ -4175,7 +2728,7 @@ bool Yap_Variant(Term t1, Term t2) { CACHE_REGS - return is_variant(t1, t2, 0 PASS_REGS); + return is_variant(t1, t2, 0 PASS_REGS); } static Int @@ -4186,7 +2739,7 @@ p_variant( USES_REGS1 ) /* variant terms t1 and t2 */ static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register - CELL *pt1 USES_REGS) + CELL *pt1 USES_REGS) { register CELL **to_visit = (CELL **)ASP; tr_fr_ptr OLDTR = TR, new_tr; @@ -4415,8 +2968,8 @@ p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */ if (IsPairTerm(t1)) { if (IsPairTerm(t2)) { return(subsumes_complex(RepPair(t1)-1, - RepPair(t1)+1, - RepPair(t2)-1 PASS_REGS)); + RepPair(t1)+1, + RepPair(t2)-1 PASS_REGS)); } else return (FALSE); } else { @@ -4430,8 +2983,8 @@ p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */ return(unify_extension(f1, t1, RepAppl(t1), t2)); } return(subsumes_complex(RepAppl(t1), - RepAppl(t1)+ArityOfFunctor(f1), - RepAppl(t2) PASS_REGS)); + RepAppl(t1)+ArityOfFunctor(f1), + RepAppl(t2) PASS_REGS)); } } @@ -4682,7 +3235,7 @@ p_term_subsumer( USES_REGS1 ) /* term_subsumer terms t1 and t2 */ HB = B->cp_h; return Yap_unify(ARG3,tf); } - } else if (IsApplTerm(t1) && IsApplTerm(t2)) { + } else if (IsApplTerm(t1) && IsApplTerm(t2)) { Functor f1; if ((f1 = FunctorOfTerm(t1)) == FunctorOfTerm(t2)) { @@ -4817,214 +3370,6 @@ extern int vsc; int vsc; -static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) -{ - - int lvl = push_text_stack(); - att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t)); - att_rec_t *to_visit_max; - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - - to_visit0 = to_visit; - to_visit_max = to_visit0+1024; -loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - Functor f; - CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - if (singles && ap2 >= InitialH && ap2 < HR) { - renumbervar(d0, numbv++ PASS_REGS); - continue; - } - /* store the terms to visit */ - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; - } - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - /* do or pt2 are unbound */ - if (singles) - *ptd0 = numbervar_singleton( PASS_REGS1 ); - else - *ptd0 = numbervar(numbv++ PASS_REGS); - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - -#if defined(TABLING) || defined(YAPOR_SBA) - TrailVal(TR) = (CELL)ptd0; -#endif - TrailTerm(TR++) = (CELL)ptd0; - } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit --; - pt0 = to_visit->beg; - pt0_end = to_visit->end; - *pt0 = to_visit->oval; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; - } - - prune(B PASS_REGS); - pop_text_stack(lvl); - return numbv; - - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->beg; - pt0_end = to_visit->end; - *pt0 = to_visit->oval; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - HR = InitialH; - pop_text_stack(lvl); - return numbv-1; - - aux_overflow: - { - size_t d1 = to_visit-to_visit0; - size_t d2 = to_visit_max-to_visit0; - to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024); - to_visit = to_visit0+d1; - to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); -} -pt0--; -goto loop; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->beg; - pt0_end = to_visit->end; - *pt0 = to_visit->oval; - } -#endif - clean_tr(TR0 PASS_REGS); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - pop_text_stack(lvl); - return numbv-1; - -} - -Int -Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* - * numbervariables in term t */ -{ - CACHE_REGS - Int out; - Term t; - - restart: - t = Deref(inp); - if (IsVarTerm(t)) { - CELL *ptd0 = VarOfTerm(t); - TrailTerm(TR++) = (CELL)ptd0; - if (handle_singles) { - *ptd0 = numbervar_singleton( PASS_REGS1 ); - return numbv; - } else { - *ptd0 = numbervar(numbv PASS_REGS); - return numbv+1; - } - } else if (IsPrimitiveTerm(t)) { - return numbv; - } else if (IsPairTerm(t)) { - out = numbervars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, numbv, handle_singles PASS_REGS); - } else { - Functor f = FunctorOfTerm(t); - - out = numbervars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), numbv, handle_singles PASS_REGS); - } - if (out < numbv) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; - goto restart; - } - return out; -} - -static Int -p_numbervars( USES_REGS1 ) -{ - Term t2 = Deref(ARG2); - Int out; - - if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"numbervars/3"); - return FALSE; - } - if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4"); - return(FALSE); - } - if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), FALSE)) < 0) - return FALSE; - return Yap_unify(ARG3, MkIntegerTerm(out)); -} - static int unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share USES_REGS) { @@ -5035,6 +3380,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share int ground = share; Int max = -1; + int lvl = push_text_stack(); HB = HLow; to_visit0 = to_visit; loop: @@ -5056,7 +3402,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share } *ptf = AbsPair(HR); ptf++; -#ifdef RATIONAL_TREES if (to_visit+1 >= (struct cp_frame *)AuxSp) { goto heap_overflow; } @@ -5068,18 +3413,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* fool the system into thinking we had a variable there */ *pt0 = AbsPair(HR); to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif ground = share; pt0 = ap2 - 1; pt0_end = ap2 + 1; @@ -5108,6 +3441,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share Int id = IntegerOfTerm(ap2[1]); ground = FALSE; if (id < -1) { + pop_text_stack(lvl); Yap_Error(RESOURCE_ERROR_STACK, TermNil, "unnumber vars cannot cope with VAR(-%d)", id); return 0L; } @@ -5142,7 +3476,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share *ptf = AbsAppl(HR); ptf++; /* store the terms to visit */ -#ifdef RATIONAL_TREES if (to_visit+1 >= (struct cp_frame *)AuxSp) { goto heap_overflow; } @@ -5154,18 +3487,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* fool the system into thinking we had a variable there */ *pt0 = AbsAppl(HR); to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif ground = (f != FunctorMutable) && share; d0 = ArityOfFunctor(f); pt0 = ap2; @@ -5216,6 +3537,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* restore our nice, friendly, term to its original state */ clean_dirty_tr(TR0 PASS_REGS); HB = HB0; + pop_text_stack(lvl); return ground; overflow: @@ -5224,7 +3546,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; @@ -5232,9 +3553,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share ptf = to_visit->to; *pt0 = to_visit->oldv; } -#endif reset_trail(TR0); /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); return -1; heap_overflow: @@ -5243,7 +3564,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; @@ -5251,9 +3571,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share ptf = to_visit->to; *pt0 = to_visit->oldv; } -#endif reset_trail(TR0); LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + pop_text_stack(lvl); return -3; } @@ -5328,7 +3648,7 @@ UnnumberTerm(Term inp, UInt arity, int share USES_REGS) { Term Yap_UnNumberTerm(Term inp, int share) { CACHE_REGS - return UnnumberTerm(inp, 0, share PASS_REGS); + return UnnumberTerm(inp, 0, share PASS_REGS); } static Int @@ -5348,19 +3668,19 @@ Yap_SkipList(Term *l, Term **tailp) s = l; if ( IsPairTerm(*l) ) - { intptr_t power = 1, lam = 0; - do - { if ( power == lam ) - { s = l; - power *= 2; - lam = 0; - } - lam++; - length++; - l = RepPair(*l)+1; - do_derefa(v,l,derefa2_unk,derefa2_nonvar); - } while ( *l != *s && IsPairTerm(*l) ); - } + { intptr_t power = 1, lam = 0; + do + { if ( power == lam ) + { s = l; + power *= 2; + lam = 0; + } + lam++; + length++; + l = RepPair(*l)+1; + do_derefa(v,l,derefa2_unk,derefa2_nonvar); + } while ( *l != *s && IsPairTerm(*l) ); + } *tailp = l; return length; @@ -5483,134 +3803,89 @@ p_reset_variables( USES_REGS1 ) void Yap_InitUtilCPreds(void) { CACHE_REGS - Term cm = CurrentModule; + Term cm = CurrentModule; Yap_InitCPred("copy_term", 2, p_copy_term, 0); -/** @pred copy_term(? _TI_,- _TF_) is iso + /** @pred copy_term(? _TI_,- _TF_) is iso -Term _TF_ is a variant of the original term _TI_, such that for -each variable _V_ in the term _TI_ there is a new variable _V'_ -in term _TF_. Notice that: + Term _TF_ is a variant of the original term _TI_, such that for + each variable _V_ in the term _TI_ there is a new variable _V'_ + in term _TF_. Notice that: -+ suspended goals and attributes for attributed variables in _TI_ are also duplicated; -+ ground terms are shared between the new and the old term. + + suspended goals and attributes for attributed variables in _TI_ are also duplicated; + + ground terms are shared between the new and the old term. -If you do not want any sharing to occur please use -duplicate_term/2. + If you do not want any sharing to occur please use + duplicate_term/2. -*/ + */ Yap_InitCPred("duplicate_term", 2, p_duplicate_term, 0); -/** @pred duplicate_term(? _TI_,- _TF_) + /** @pred duplicate_term(? _TI_,- _TF_) -Term _TF_ is a variant of the original term _TI_, such that -for each variable _V_ in the term _TI_ there is a new variable - _V'_ in term _TF_, and the two terms do not share any -structure. All suspended goals and attributes for attributed variables -in _TI_ are also duplicated. + Term _TF_ is a variant of the original term _TI_, such that + for each variable _V_ in the term _TI_ there is a new variable + _V'_ in term _TF_, and the two terms do not share any + structure. All suspended goals and attributes for attributed variables + in _TI_ are also duplicated. -Also refer to copy_term/2. + Also refer to copy_term/2. -*/ + */ Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0); -/** @pred copy_term_nat(? _TI_,- _TF_) + /** @pred copy_term_nat(? _TI_,- _TF_) -As copy_term/2. Attributes however, are not copied but replaced -by fresh variables. + As copy_term/2. Attributes however, are not copied but replaced + by fresh variables. - */ - Yap_InitCPred("ground", 1, p_ground, SafePredFlag); -/** @pred ground( _T_) is iso - - -Succeeds if there are no free variables in the term _T_. - - -*/ - Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); - Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); - Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); - Yap_InitCPred("term_variables", 2, p_term_variables, 0); -/** @pred term_variables(? _Term_, - _Variables_) is iso - - - -Unify _Variables_ with the list of all variables of term - _Term_. The variables occur in the order of their first -appearance when traversing the term depth-first, left-to-right. - - -*/ - Yap_InitCPred("term_variables", 3, p_term_variables3, 0); - Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); -/** @pred term_attvars(+ _Term_,- _AttVars_) - - - _AttVars_ is a list of all attributed variables in _Term_ and -its attributes. I.e., term_attvars/2 works recursively through -attributes. This predicate is Cycle-safe. - - -*/ + */ Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag|TestPredFlag); Yap_InitCPred("$is_list_or_partial_list", 1, p_is_list_or_partial_list, SafePredFlag|TestPredFlag); Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0); -/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) + /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) -The term _TF_ is a forest representation (without cycles and repeated -terms) for the Prolog term _TI_. The term _TF_ is the main term. The -difference list _SubTerms_-_MoreSubterms_ stores terms of the form -_V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy -of a sub-term from _TI_. + The term _TF_ is a forest representation (without cycles and repeated + terms) for the Prolog term _TI_. The term _TF_ is the main term. The + difference list _SubTerms_-_MoreSubterms_ stores terms of the form + _V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy + of a sub-term from _TI_. -*/ + */ Yap_InitCPred("term_factorized", 3, p_break_rational3, 0); -/** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) + /** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) -Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. + Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. -*/ + */ Yap_InitCPred("=@=", 2, p_variant, 0); - Yap_InitCPred("numbervars", 3, p_numbervars, 0); -/** @pred numbervars( _T_,+ _N1_,- _Nn_) - - -Instantiates each variable in term _T_ to a term of the form: -`$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. - - -*/ Yap_InitCPred("unnumbervars", 2, p_unnumbervars, 0); -/** @pred unnumbervars( _T_,+ _NT_) + /** @pred unnumbervars( _T_,+ _NT_) -Replace every `$VAR( _I_)` by a free variable. + Replace every `$VAR( _I_)` by a free variable. -*/ + */ /* use this carefully */ Yap_InitCPred("$skip_list", 3, p_skip_list, SafePredFlag|TestPredFlag); Yap_InitCPred("$skip_list", 4, p_skip_list4, SafePredFlag|TestPredFlag); Yap_InitCPred("$free_arguments", 1, p_free_arguments, TestPredFlag); CurrentModule = TERMS_MODULE; - Yap_InitCPred("variable_in_term", 2, p_var_in_term, 0); Yap_InitCPred("term_hash", 4, p_term_hash, 0); Yap_InitCPred("instantiated_term_hash", 4, p_instantiated_term_hash, 0); Yap_InitCPred("variant", 2, p_variant, 0); Yap_InitCPred("subsumes", 2, p_subsumes, 0); Yap_InitCPred("term_subsumer", 3, p_term_subsumer, 0); - Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0); - Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0); Yap_InitCPred("export_term", 3, p_export_term, 0); Yap_InitCPred("kill_exported_term", 1, p_kill_exported_term, SafePredFlag); Yap_InitCPred("import_term", 2, p_import_term, 0); diff --git a/CMakeLists.txt b/CMakeLists.txt index 0ababa270..01576f7bf 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -409,9 +409,7 @@ ${CMAKE_SOURCE_DIR}/OPTYap ${CMAKE_SOURCE_DIR}/utf8proc ${CMAKE_SOURCE_DIR}/JIT/HPP ${GMP_INCLUDE_DIRS} - ${READLINE_LIBRARIES} - ${SQLITE_LIBRARIES} - ${ANDROID_LIBRARIES} + ${READLINE_INCLUDE_DIR} ${CMAKE_BINARY_DIR} ) diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index e822ad1be..85997466f 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -167,7 +167,7 @@ opportunity. Initial value is 10,000. May be changed. A value of 0 */ YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL), - // YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL), + YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL), /**< Says whether to call the debUgger on an exception. False in YAP.. diff --git a/cmake/Sources.cmake b/cmake/Sources.cmake index a891c4621..6bd9429d5 100644 --- a/cmake/Sources.cmake +++ b/cmake/Sources.cmake @@ -65,6 +65,7 @@ set (ENGINE_SOURCES C/tracer.c C/unify.c C/userpreds.c + C/terms.c C/utilpreds.c C/yap-args.c C/write.c diff --git a/pl/boot.yap b/pl/boot.yap index c146b1b4d..420f0b3a5 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -29,7 +29,7 @@ */ /** -* @pred system_module( +_Mod_, +_ListOfPublicPredicates, +ListOfPrivatePredicates * +* @pred system_module( _Mod_, _ListOfPublicPredicates, ListOfPrivatePredicates * * Define a system module _Mod_. _ListOfPublicPredicates_ . Currentlt, all * predicates are in the 'prolog' module. The first * are visible outside the Prolog module, all others are hidden at the end of booting. @@ -37,21 +37,26 @@ */ system_module(Mod, SysExps) :- system_module(Mod, SysExps, []). + + +use_system_module(_Module, _SysExps). system_module(_Mod, SysExps, _Decls) :- + % '$new_system_predicates'(SysExps), + fail. + system_module(_Mod, _SysExps, _Decls) :- ( - '$new_system_predicates'(SysExps), - fail - ; stream_property(loop_stream,file_name(File)) -> recordz(system_file, File, _ ) ; recordz(system_file, loop_stream, _ ) ). + +private(_). -'$new_system_predicates'([P|_Ps]) :- - functor(P, N, Ar), +'$new_system_predicates'([]). +'$new_system_predicates'([N/Ar|_Ps]) :- '$new_system_predicate'(N, Ar, prolog). '$new_system_predicates'([_P|Ps]) :- '$new_system_predicates'(Ps). @@ -77,9 +82,6 @@ system_module(_Mod, SysExps, _Decls) :- % be careful here not to generate an undefined exception.. -use_system_module(_,_). -private(_). - print_message(L,E) :- (L = informational -> @@ -247,7 +249,7 @@ initialize_prolog :- :- c_compile( 'preds.yap' ). :- c_compile( 'modules.yap' ). :- c_compile( 'grammar.yap' ). -:- c_compile( 'protect.yap' ). +%:- c_compile( 'protect.yap' ). :- ['absf.yap']. diff --git a/pl/init.yap b/pl/init.yap index 330bc76c4..950ff1049 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -97,9 +97,10 @@ set_prolog_flag(debug, false), % simple trick to find out if this is we are booting from Prolog. % boot from a saved state - '$init_from_saved_state_and_args', %start_low_level_trace, + writeln(ok), + '$init_from_saved_state_and_args', %start_low_level_trace, - '$db_clean_queues'(0), + '$db_clean_queues'(_), % this must be executed from C-code. % '$startup_saved_state', set_input(user_input), @@ -186,7 +187,7 @@ get_value('$consult_on_boot',X), X \= [], set_value('$consult_on_boot',[]), '$do_startup_reconsult'(X), - fail. + !. '$init_from_saved_state_and_args' :- recorded('$restore_flag', init_file(M:B), R), erase(R), diff --git a/pl/qly.yap b/pl/qly.yap index d562b31fc..ddcce2482 100755 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -82,8 +82,8 @@ Saves an image of the current state of the YAP database in file trying goal _G_. **/ qsave_program(File) :- - '$save_program_status'([], qsave_program(File)), -open(File, write, S, [type(binary)]), + '$save_program_status'([], qsave_program(File)), + open(File, write, S, [type(binary)]), '$qsave_program'(S), close(S). From c1dc6b7fb2c140d59010090447593dd7c04d4a18 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 31 Jan 2019 11:52:03 +0000 Subject: [PATCH 022/101] boot --- C/c_interface.c | 8 ++++++ C/errors.c | 3 +- C/exec.c | 9 ++++++ C/yap-args.c | 2 ++ H/YapLFlagInfo.h | 6 ++-- pl/absf.yap | 11 ++++---- pl/boot.yap | 72 +++++++++++++++++++++++++++++------------------- pl/top.yap | 11 ++++---- 8 files changed, 78 insertions(+), 44 deletions(-) diff --git a/C/c_interface.c b/C/c_interface.c index 7cded6b1f..a6e9d223a 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -2202,7 +2202,15 @@ X_API Term YAP_ReadFromStream(int sno) { Term o; BACKUP_MACHINE_REGS(); + + sigjmp_buf signew; + if (sigsetjmp(signew, 0)) { + Yap_syntax_error(LOCAL_toktide, sno, "ReadFromStream"); + RECOVER_MACHINE_REGS(); + return 0; + } else { o = Yap_read_term(sno, TermNil, false); + } RECOVER_MACHINE_REGS(); return o; } diff --git a/C/errors.c b/C/errors.c index dc5dc7c61..4e4648f1e 100755 --- a/C/errors.c +++ b/C/errors.c @@ -363,6 +363,7 @@ bool Yap_PrintWarning(Term twarning) { LOCAL_within_print_message = false; LOCAL_PrologMode &= ~InErrorMode; return rc; + } bool Yap_HandleError__(const char *file, const char *function, int lineno, @@ -415,7 +416,7 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno, return false; } default: - + if (LOCAL_PrologMode == UserMode) Yap_ThrowError__(file, function, lineno, err, LOCAL_RawTerm, serr); else diff --git a/C/exec.c b/C/exec.c index fa757cc39..951c24d7e 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1712,6 +1712,11 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { // should we catch the exception or pass it through? // We'll pass it through if (pass_ex && Yap_HasException()) { + if ((LOCAL_PrologMode & BootMode) || !CurrentModule ) { + Yap_ResetException(LOCAL_ActiveError); + return false; + } + Yap_RaiseException(); return false; } @@ -1734,6 +1739,10 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { // should we catch the exception or pass it through? // We'll pass it through if (pass_ex) { + if ((LOCAL_PrologMode & BootMode) || !CurrentModule ) { + Yap_ResetException(LOCAL_ActiveError); + return false; + } Yap_RaiseException(); } return false; diff --git a/C/yap-args.c b/C/yap-args.c index ccd7083fe..0d2ff1324 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -166,6 +166,7 @@ static bool load_file(const char *b_file USES_REGS) { /* consult in C */ int lvl = push_text_stack(); + char *full; /* the consult mode does not matter here, really */ if ((osno = Yap_CheckAlias(AtomLoopStream)) < 0) { @@ -191,6 +192,7 @@ static bool load_file(const char *b_file USES_REGS) { YAP_Reset(YAP_FULL_RESET, false); Yap_StartSlots(); Term vs = MkVarTerm(), pos = MkVarTerm(); + t = YAP_ReadClauseFromStream(c_stream, vs, pos); // Yap_GetNèwSlot(t); if (t == TermEof || t == TermNil) { diff --git a/H/YapLFlagInfo.h b/H/YapLFlagInfo.h index 643fbba46..5949bc5c9 100644 --- a/H/YapLFlagInfo.h +++ b/H/YapLFlagInfo.h @@ -117,9 +117,9 @@ Just fail /**< If `true` allow printing of informational messages when - searching for file names. If `false` disable printing these messages. It - is `false` by default except if YAP is booted with the `-L` - flag. + searching for file names. If `false` disable printing these + messages. It is `false` by default except if YAP is booted with + the `-L` flag. */ YAP_FLAG(VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, booleanFlag, "false", NULL), diff --git a/pl/absf.yap b/pl/absf.yap index 43bbe3aa9..c65880f87 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -30,14 +30,13 @@ add_to_path/1, add_to_path/2, path/1, - remove_from_path/1]). + remove_from_path/1], []). absolute_file_name__(File,LOpts,TrueFileName) :- % must_be_of_type( atom, File ), % look for solutions gated_call( - '$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ), '$find_in_path'(File, Opts,TrueFileName, HasSol, TakeFirst), Port, @@ -91,12 +90,12 @@ absolute_file_name__(File,LOpts,TrueFileName) :- '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). - -core_file_name(Name, Opts) --> +:- start_low_level_trace. +prolog:core_file_name(Name, Opts) --> '$file_name'(Name, Opts, E), '$suffix'(E, Opts), '$glob'(Opts). - +:- stop_low_level_trace. % % handle library(lists) or foreign(jpl) % @@ -416,7 +415,7 @@ remove_from_path(New) :- '$check_path'(New,Path), get_abs_file_parameter( access, Opts, Access ), get_abs_file_parameter( expand, Opts, Expand ), absf_trace('start with ~w', [Name]), - core_file_name(Name, Opts, CorePath, []), + prolog:core_file_name(Name, Opts, CorePath, []), absf_trace(' after name/library unfolding: ~w', [Name]), '$variable_expansion'(CorePath, Opts,ExpandedPath), absf_trace(' after environment variable expansion: ~s', [ExpandedPath]), diff --git a/pl/boot.yap b/pl/boot.yap index 420f0b3a5..b21c06a87 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -37,23 +37,17 @@ */ system_module(Mod, SysExps) :- system_module(Mod, SysExps, []). - - -use_system_module(_Module, _SysExps). system_module(_Mod, SysExps, _Decls) :- - % '$new_system_predicates'(SysExps), + '$new_system_predicates'(SysExps), + !, fail. - system_module(_Mod, _SysExps, _Decls) :- - ( - stream_property(loop_stream,file_name(File)) - -> - recordz(system_file, File, _ ) - ; - recordz(system_file, loop_stream, _ ) - ). - -private(_). +system_module(_Mod, _SysExps, _Decls) :- + stream_property(loop_stream,[file_name(File)]), + !, + recordz(system_file, File, _ ). +system_module(_Mod, _SysExps, _Decls) :- + recordz(system_file, loop_stream, _ ). '$new_system_predicates'([]). '$new_system_predicates'([N/Ar|_Ps]) :- @@ -61,6 +55,10 @@ private(_). '$new_system_predicates'([_P|Ps]) :- '$new_system_predicates'(Ps). +use_system_module(_Module, _SysExps). + +private(_). + % % boootstrap predicates. % @@ -82,22 +80,38 @@ private(_). % be careful here not to generate an undefined exception.. -print_message(L,E) :- - (L = informational - -> - '$query_exception'(prologPredFile, Desc, File), - '$query_exception'(prologPredLine, Desc, FilePos), - format(user_error,'~a:~d: error:', [File,FilePos]) - ; - - %throw(error(error, print_message(['while calling goal = ~w'-E,nl]))). +print_message(informational,_) :- + yap_flag(verbose, silent), + !. +print_message(informational,E) :- + format('informational message ~q.~n',[E]), + !. +%% +% boot:print_message( Type, Error ) +% +print_message(Type,error(_,exception(Desc))) :- '$get_exception'(Desc), + print_boot_message(Type,Error,Desc), + '$print_exception'(Desc), + !. +print_message(Type,Error) :- + format( user_error, '~w while bootstraping: event is ~q~n',[Type,Error]). + + + +print_boot_message(Type,Error,Desc) :- + '$query_exception'(parserFile, Desc, File), + '$query_exception'(parserLine, Desc, FilePos), + !, + format(user_error,'~a:~d: ~a: ~q~n', [File,FilePos,Type,Error]). +print_boot_message(Type,Error,Desc) :- '$query_exception'(prologPredFile, Desc, File), '$query_exception'(prologPredLine, Desc, FilePos), - format(user_error,'~a:~d: error:', [File,FilePos]), - '$print_exception'(Desc), - format( user_error, '~w from bootstrap: got ~w~n',[L,E]) - ). + format(user_error,'~a:~d: ~a: ~q~n', [File,FilePos,Type,Error]). +print_boot_message(Type,Error,Desc) :- + '$query_exception'(errorFile, Desc, File), + '$query_exception'(errorLine, Desc, FilePos), + format(user_error,'~a:~d: ~a: ~q~n', [File,FilePos,Type,Error]). '$undefp0'([M|G], _Action) :- functor(G,N,A), @@ -141,7 +155,7 @@ print_message(L,E) :- goal_expansion/3, otherwise/0, term_expansion/2, - version/2, + version/2], [ '$do_log_upd_clause'/6, '$do_log_upd_clause0'/6, @@ -249,7 +263,7 @@ initialize_prolog :- :- c_compile( 'preds.yap' ). :- c_compile( 'modules.yap' ). :- c_compile( 'grammar.yap' ). -%:- c_compile( 'protect.yap' ). +:- c_compile( 'protect.yap' ). :- ['absf.yap']. diff --git a/pl/top.yap b/pl/top.yap index bd76975b8..3d0b1772d 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -177,11 +177,11 @@ live :- catch( '$expand_term0'(T,Con,O), _,( '$disable_debugging', fail) ), !. - '$expand_term0'(T,consult,O) :- - expand_term( T, O). - '$expand_term0'(T,reconsult,O) :- - expand_term( T, O). - '$expand_term0'(T,top,O) :- +'$expand_term0'(T,consult,O) :- + expand_term( T, O). +'$expand_term0'(T,reconsult,O) :- + expand_term( T, O). +'$expand_term0'(T,top,O) :- expand_term( T, T1), !, '$expand_term1'(T1,O). @@ -243,6 +243,7 @@ live :- functor(NH,N,Ar), print_message(warning,redefine_imported(Mod,NM,Mod:N/Ar)), erase(RI), + clause(Mod:H,_,R), erase(R), fail. '$init_pred'(H, Mod, Where ) :- '$init_as_dynamic'(Where), From b71b4f6fca395616588eb32d0c316cba8a22141e Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 31 Jan 2019 11:54:17 +0000 Subject: [PATCH 023/101] boot --- C/cdmgr.c | 8 ++++++-- C/exec.c | 33 ++++++++++++++++++++++++++++----- C/yap-args.c | 2 ++ library/hacks.yap | 12 ++++++++++++ pl/boot.yap | 8 ++++---- pl/init.yap | 6 +++--- pl/top.yap | 13 ++++++------- pl/undefined.yap | 21 +++++++++++---------- 8 files changed, 72 insertions(+), 31 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index 6610616c6..f044e843d 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2852,10 +2852,14 @@ static Int undefp_handler(USES_REGS1) { /* '$undefp_handler'(P,Mod) */ PredEntry *pe; pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1"); - if (EndOfPAEntr(pe)) - return false; PELOCK(59, pe); + if (EndOfPAEntr(pe)) { + UndefCode = FAILCODE; + UNLOCKPE(59, pe); + return false; + } if (pe->OpcodeOfPred == UNDEF_OPCODE) { + UndefCode = FAILCODE; UNLOCKPE(59, pe); return false; } diff --git a/C/exec.c b/C/exec.c index fa757cc39..43751cbac 100755 --- a/C/exec.c +++ b/C/exec.c @@ -189,11 +189,10 @@ static bool CallError(yap_error_number err, Term t, Term mod USES_REGS) { /** @pred current_choice_point( -CP ) * - * unify the logic variable _CP_ with a number that gives the offset of the - * current choice-point. This number is only valid as long as we do not - *backtrack by or cut - * _CP_, and is safe in the presence of stack shifting and/or garbage - *collection. + * unify the logic variable _CP_ with a number that identifies the + * last alternative taken, or current choice-point. This number is + * only valid as long as we do not backtrack by or cut _CP_, and is + * safe in the presence of stack shifting and/or garbage collection. */ static Int current_choice_point(USES_REGS1) { Term t = Deref(ARG1); @@ -208,6 +207,29 @@ static Int current_choice_point(USES_REGS1) { return TRUE; } +/** @pred parent_choice_point( +CP, -PCP ) + * + * given that _CP_ identifies an + * alternative taken, or choice-point, _PCP_ identifies its parent. + * + * The call will fail if _CP_ is topmost in the search tree. + */ +static Int parent_choice_point(USES_REGS1) { + Term t = Deref(ARG1); + Term td; +#if SHADOW_HB + register CELL *HBREG = HB; +#endif + if (!IsVarTerm(t)) + return (FALSE); + choiceptr cp = cp_from_integer(t); + if (cp == NULL || cp->cp_b == NULL) + return false; + td = cp_as_integer(cp->cp_b PASS_REGS); + YapBind((CELL *)t, td); + return TRUE; +} + static Int save_env_b(USES_REGS1) { Term t = Deref(ARG1); Term td; @@ -2302,6 +2324,7 @@ void Yap_InitExecFs(void) { Yap_InitCPred("current_choice_point", 1, current_choice_point, 0); Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0); Yap_InitCPred("env_choice_point", 1, save_env_b, 0); + Yap_InitCPred("parent_choice_point", 1, parent_choice_point, 0); Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag); CurrentModule = cm; Yap_InitCPred("$restore_regs", 1, restore_regs, diff --git a/C/yap-args.c b/C/yap-args.c index ccd7083fe..864f46b2f 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -1206,6 +1206,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) { } LOCAL_consult_level = -1; } + Yap_do_low_level_trace=1; YAP_RunGoalOnce(TermInitProlog); if (yap_init->install && Yap_OUTPUT_STARTUP) { Term t = MkAtomTerm(Yap_LookupAtom(Yap_OUTPUT_STARTUP)); @@ -1214,6 +1215,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) { YAP_RunGoalOnce(g); } + Yap_do_low_level_trace=0; end_init(yap_init); } diff --git a/library/hacks.yap b/library/hacks.yap index 9759b3763..2f46e89b4 100644 --- a/library/hacks.yap +++ b/library/hacks.yap @@ -10,6 +10,8 @@ :- module(yap_hacks, [ current_choicepoint/1, + parent_choicepoint/1, + parent_choicepoint/2, cut_by/1, cut_at/1, current_choicepoints/1, @@ -66,6 +68,16 @@ run_formats([], _). run_formats([Com-Args|StackInfo], Stream) :- format(Stream, Com, Args), run_formats(StackInfo, user_error). +/** + * @pred parent_choicepoint(+_ChoicePoint_) + * + * _ChoicePoint_ is the parent of the current choice-point. + * + */ +parent_choicepoint(BP) :- + current_choicepoint(B), + parent_choicepoint(B, BP). + /** * @pred virtual_alarm(+Interval, 0:Goal, -Left) diff --git a/pl/boot.yap b/pl/boot.yap index 420f0b3a5..ca48d01b8 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -41,7 +41,7 @@ system_module(Mod, SysExps) :- use_system_module(_Module, _SysExps). -system_module(_Mod, SysExps, _Decls) :- +system_module(_Mod, _SysExps, _Decls) :- % '$new_system_predicates'(SysExps), fail. system_module(_Mod, _SysExps, _Decls) :- @@ -100,9 +100,9 @@ print_message(L,E) :- ). '$undefp0'([M|G], _Action) :- - functor(G,N,A), - print_message( error, error(error(unknown, M:N/A),M:G)), - fail. + functor(G,N,A), + print_message( error, error(error(unknown, M:N/A),M:G)), + fail. :- '$undefp_handler'('$undefp0'(_,_),prolog). diff --git a/pl/init.yap b/pl/init.yap index 950ff1049..d783a7dc7 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -113,8 +113,8 @@ '$startup_goals' :- module(user), fail. -'$startup_goals' :- - recorded('$startup_goal',G,_), +'$startup_goals' :- + recorded('$startup_goal',G,_), catch(once(user:G),Error,user:'$Error'(Error)), fail. '$startup_goals' :- @@ -187,7 +187,7 @@ get_value('$consult_on_boot',X), X \= [], set_value('$consult_on_boot',[]), '$do_startup_reconsult'(X), - !. + fail. '$init_from_saved_state_and_args' :- recorded('$restore_flag', init_file(M:B), R), erase(R), diff --git a/pl/top.yap b/pl/top.yap index bd76975b8..b41ae8e6e 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -177,11 +177,11 @@ live :- catch( '$expand_term0'(T,Con,O), _,( '$disable_debugging', fail) ), !. - '$expand_term0'(T,consult,O) :- - expand_term( T, O). - '$expand_term0'(T,reconsult,O) :- - expand_term( T, O). - '$expand_term0'(T,top,O) :- +'$expand_term0'(T,consult,O) :- + expand_term( T, O). +'$expand_term0'(T,reconsult,O) :- + expand_term( T, O). +'$expand_term0'(T,top,O) :- expand_term( T, T1), !, '$expand_term1'(T1,O). @@ -879,8 +879,7 @@ gated_call(Setup, Goal, Catcher, Cleanup) :- '$precompile_term'(Term, Term, Term). '$expand_clause'(InputCl, C1, CO) :- - source_module(SM), - '$yap_strip_clause'(SM:InputCl, M, ICl), + '$yap_strip_clause'(InputCl, M, ICl), '$expand_a_clause'( M:ICl, SM, C1, CO), !. '$expand_clause'(Cl, Cl, Cl). diff --git a/pl/undefined.yap b/pl/undefined.yap index 811891732..9b13b60dc 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -97,26 +97,27 @@ undefined_query(G0, M0, Cut) :- '$undefp'([M0|G0],MG) :- % make sure we do not loop on undefined predicates '$undef_setup'(M0:G0, Action,Debug,Current, MGI), - ('$get_undefined_predicates'( MGI, MG ) , MG) + ('$get_undefined_predicates'( MGI, MG ) -> true ; '$undef_error'(Current, M0:G0, MGI, MG) , - '$undef_cleanup'(Action,Debug,Current). + '$undef_cleanup'(Action,Debug,Current) + ). '$undef_error'(_, M0:G0, _, MG) :- '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), '$yap_strip_module'(M0:G0, EM0, GM0), user:unknown_predicate_handler(GM0,EM0,MG), !. -'$handle_error'(error, Mod:Goal, I,_) :- +'$undef_error'(error, Mod:Goal, I,_) :- '$do_error'(existence_error(procedure,I), Mod:Goal). -'$handle_error'(warning,Mod:Goal,I,_) :- +'$undef_error'(warning,Mod:Goal,I,_) :- 'program_continuation'(PMod,PName,PAr), print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))), fail. -'$handle_error'(fail,_Goal,_Mod) :- +'$undef_error'(fail,_Goal,_Mod) :- fail. '$undef_setup'(G0,Action,Debug,Current,GI) :- @@ -127,20 +128,20 @@ undefined_query(G0, M0, Cut) :- '$g2i'(user:G, Na/Ar ) :- !, -functor(G, Na, Ar). + functor(G, Na, Ar). '$g2i'(prolog:G, Na/Ar ) :- !, - functor(G, Na, Ar). + functor(G, Na, Ar). '$g2i'(M:G, M:Na/Ar ) :- !, -functor(G, Na, Ar). + functor(G, Na, Ar). '$undef_cleanup'(Action,Debug,_Current) :- yap_flag( unknown, _, Action), yap_flag( debug, _, Debug), '$start_creep'([prolog|true], creep). - :- '$undefp_handler'('$undefp'(_,_), prolog). +:- '$undefp_handler'('$undefp'(_,_), prolog). /** @pred unknown(- _O_,+ _N_) @@ -154,7 +155,7 @@ The unknown predicate, informs about what the user wants to be done */ unknown(P, NP) :- - prolog_flag( unknown, P, NP ). + yap_flag( unknown, P, NP ). /** @} From b382c060e3b7c5997987c2724805facccb44ce5e Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 31 Jan 2019 12:46:35 +0000 Subject: [PATCH 024/101] booting --- C/yap-args.c | 3 +-- pl/boot.yap | 46 ++++++++++++++++++++++++---------------------- 2 files changed, 25 insertions(+), 24 deletions(-) diff --git a/C/yap-args.c b/C/yap-args.c index fbf25935d..c640c4851 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -1208,7 +1208,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) { } LOCAL_consult_level = -1; } - Yap_do_low_level_trace=1; + YAP_RunGoalOnce(TermInitProlog); if (yap_init->install && Yap_OUTPUT_STARTUP) { Term t = MkAtomTerm(Yap_LookupAtom(Yap_OUTPUT_STARTUP)); @@ -1217,7 +1217,6 @@ X_API void YAP_Init(YAP_init_args *yap_init) { YAP_RunGoalOnce(g); } - Yap_do_low_level_trace=0; end_init(yap_init); } diff --git a/pl/boot.yap b/pl/boot.yap index 97c21a4da..49b5d1ae9 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -38,6 +38,7 @@ system_module(Mod, SysExps) :- system_module(Mod, SysExps, []). +system_module(_Mod, _SysExps, _Decls) :- !. system_module(_Mod, _SysExps, _Decls) :- % '$new_system_predicates'(SysExps), fail. @@ -75,7 +76,28 @@ private(_). (not)/1, repeat/0, throw/1, - true/0]). + true/0]). + +:- system_module( '$_init', [!/0, + ':-'/1, + '?-'/1, + []/0, + extensions_to_present_answer/1, + fail/0, + false/0, + goal_expansion/2, + goal_expansion/3, + otherwise/0, + term_expansion/2, + version/2], + [ + '$do_log_upd_clause'/6, + '$do_log_upd_clause0'/6, + '$do_log_upd_clause_erase'/6, + '$do_static_clause'/5], + '$system_module'/1]). + +:- use_system_module( '$_boot', ['$cut_by'/1]). % be careful here not to generate an undefined exception.. @@ -143,26 +165,6 @@ print_boot_message(Type,Error,Desc) :- :- '$new_multifile'('$full_clause_optimisation'(_H, _M, _B0, _BF), prolog). :- '$new_multifile'('$exec_directive'(_,_,_,_,_), prolog). -:- system_module( '$_init', [!/0, - ':-'/1, - '?-'/1, - []/0, - extensions_to_present_answer/1, - fail/0, - false/0, - goal_expansion/2, - goal_expansion/3, - otherwise/0, - term_expansion/2, - version/2], - [ - '$do_log_upd_clause'/6, - '$do_log_upd_clause0'/6, - '$do_log_upd_clause_erase'/6, - '$do_static_clause'/5], [ - '$system_module'/1]). - -:- use_system_module( '$_boot', ['$cut_by'/1]). %:- start_low_level_trace. @@ -216,7 +218,7 @@ print_boot_message(Type,Error,Desc) :- '$execute_command'(EG,EM,VL,Pos,Con,C) ; % do term expansion '$expand_term'(C, Con, EC), - ( var(EC) -> + ( nonvar(EC) -> '$yap_strip_module'(EC, EM2, EG2) ; '$yap_strip_module'(C, EM2, EG2) From ca2542c7984db1505b0e5064c035a273672c7491 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 31 Jan 2019 16:40:41 +0000 Subject: [PATCH 025/101] cou numbered vars --- C/terms.c | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 81 insertions(+), 8 deletions(-) diff --git a/C/terms.c b/C/terms.c index b6aa1768f..100c79a93 100644 --- a/C/terms.c +++ b/C/terms.c @@ -1366,7 +1366,6 @@ renumbervar(Term t, Int id USES_REGS) continue; \ } - static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) { @@ -1465,21 +1464,17 @@ Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* } } else if (IsPrimitiveTerm(t)) { return numbv; - } else if (IsPairTerm(t)) { - out = numbervars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, numbv, handle_singles PASS_REGS); } else { - Functor f = FunctorOfTerm(t); - out = numbervars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), numbv, handle_singles PASS_REGS); + out = numbervars_in_complex_term(&(t)-1, + &(t), numbv, handle_singles PASS_REGS); } if (out < numbv) { if (!expand_vts( 3 PASS_REGS )) return FALSE; goto restart; } + return true; } /** @pred numbervars( _T_,+ _N1_,- _Nn_) @@ -1509,6 +1504,84 @@ p_numbervars( USES_REGS1 ) return Yap_unify(ARG3, MkIntegerTerm(out)); } + +#define MAX_NUMBERED \ + if (FunctorOfTerm(d0) == FunctorDollarVar) {\ + Term t1 = ArgOfTerm(1, d0); \ + Int i; \ + if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) *maxp = i; \ + continue; \ + } + +static int +max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) +{ + + + int lvl = push_text_stack(); + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; + + to_visit0 = to_visit; + to_visit_max = to_visit0+1024; + restart: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, vars_in_term_unk); + vars_in_term_nvar: + { + WALK_COMPLEX_TERM__({},MAX_NUMBERED); + + continue; + } + + + derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; + } + + prune(B PASS_REGS); + pop_text_stack(lvl); + return 0; + + def_aux_overflow(); +} + + +static Int +MaxNumberedVar(Term inp, UInt arity_REGS) { + Term t = Deref(inp); + + if (IsPrimitiveTerm(t)) { + return MkIntegerTerm(0); + } else { + Int res; + Int max; + res = max_numbered_var(&t-1, &t, &max PASS_REGS)-1; + if (res < 0) return -1; + return MkIntegerTerm(max); + } +} + + + void Yap_InitTermCPreds(void) { Yap_InitCPred("term_variables", 2, p_term_variables, 0); From fa96ffa932efed5dd85d519bb6d0f74307122e29 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Fri, 1 Feb 2019 13:14:33 +0000 Subject: [PATCH 026/101] loops --- C/cdmgr.c | 4 +- C/terms.c | 1607 +++++++++++++++++++------------------------- C/write.c | 17 +- CMakeLists.txt | 3 + H/Yapproto.h | 4 + include/YapError.h | 4 + library/terms.yap | 9 +- 7 files changed, 710 insertions(+), 938 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index f044e843d..f32ec9cd9 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2854,12 +2854,12 @@ static Int undefp_handler(USES_REGS1) { /* '$undefp_handler'(P,Mod) */ pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1"); PELOCK(59, pe); if (EndOfPAEntr(pe)) { - UndefCode = FAILCODE; + UndefCode = Yap_get_pred(TermFail, MkIntTerm(0), "no def"); UNLOCKPE(59, pe); return false; } if (pe->OpcodeOfPred == UNDEF_OPCODE) { - UndefCode = FAILCODE; + UndefCode = Yap_get_pred(TermFail, MkIntTerm(0), "no def"); UNLOCKPE(59, pe); return false; } diff --git a/C/terms.c b/C/terms.c index 100c79a93..4eb9d937e 100644 --- a/C/terms.c +++ b/C/terms.c @@ -1,44 +1,40 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: utilpreds.c * -* Last rev: 4/03/88 * -* mods: * -* comments: new utility predicates for YAP * -* * -*************************************************************************/ -#ifdef SCCS -static char SccsId[] = "@(#)utilpreds.c 1.3"; -#endif + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: utilpreds.c * Last rev: 4/03/88 + ** mods: * comments: new utility predicates for YAP * + * * + *************************************************************************/ + /** * @file C/terms.c * * @brief applications of the tree walker pattern. * * @addtogroup Terms + * * @{ + * */ #include "absmi.h" + #include "YapHeap.h" -#include "yapio.h" + #include "attvar.h" +#include "yapio.h" #ifdef HAVE_STRING_H #include "string.h" #endif - - -static int -expand_vts( int args USES_REGS ) -{ +static int expand_vts(int args USES_REGS) { UInt expand = LOCAL_Error_Size; yap_error_number yap_errno = LOCAL_Error_TYPE; @@ -46,27 +42,26 @@ expand_vts( int args USES_REGS ) LOCAL_Error_TYPE = YAP_NO_ERROR; if (yap_errno == RESOURCE_ERROR_TRAIL) { /* Trail overflow */ - if (!Yap_growtrail(expand, FALSE)) { - return FALSE; + if (!Yap_growtrail(expand, false)) { + return false; } } else if (yap_errno == RESOURCE_ERROR_AUXILIARY_STACK) { /* Aux space overflow */ - if (expand > 4*1024*1024) - expand = 4*1024*1024; - if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, TRUE)) { - return FALSE; + if (expand > 4 * 1024 * 1024) + expand = 4 * 1024 * 1024; + if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, true)) { + return false; } } else { - if (!Yap_gcl(expand, 3, ENV, gc_P(P,CP))) { + if (!Yap_gcl(expand, 3, ENV, gc_P(P, CP))) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_variables"); - return FALSE; + return false; } } - return TRUE; + return true; } -static inline void -clean_tr(tr_fr_ptr TR0 USES_REGS) { +static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { if (TR != TR0) { do { Term p = TrailTerm(--TR); @@ -75,8 +70,7 @@ clean_tr(tr_fr_ptr TR0 USES_REGS) { } } -static inline void -clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { +static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { Term p = TrailTerm(--pt0); @@ -86,21 +80,20 @@ clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { pt[0] = TrailVal(pt0); #else pt[0] = TrailTerm(pt0 - 1); - pt0 --; + pt0--; #endif /* FROZEN_STACKS */ } else { RESET_VARIABLE(p); } - } + } TR = TR0; } /// @brief recover original term while fixing direct refs. /// -/// @param USES_REGS +/// @param USES_REGS /// -static inline void -clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { +static inline void clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { Term p = TrailTerm(--pt0); @@ -108,34 +101,33 @@ clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { /// pt: points to the address of the new term we may want to fix. CELL *pt = RepAppl(p); if (pt >= HB && pt < HR) { /// is it new? - Term v = pt[0]; - if (IsApplTerm(v)) { - /// yes, more than a single ref - *pt = (CELL)RepAppl(v); - } + Term v = pt[0]; + if (IsApplTerm(v)) { + /// yes, more than a single ref + *pt = (CELL)RepAppl(v); + } #ifndef FROZEN_STACKS - pt0 --; + pt0--; #endif /* FROZEN_STACKS */ - continue; - } + continue; + } #ifdef FROZEN_STACKS pt[0] = TrailVal(pt0); #else pt[0] = TrailTerm(pt0 - 1); - pt0 --; + pt0--; #endif /* FROZEN_STACKS */ } else { RESET_VARIABLE(p); } - } + } TR = TR0; } typedef struct { - Term old_var; - Term new_var; -} *vcell; - + Term old_var; + Term new_var; +} * vcell; typedef struct non_single_struct_t { CELL *ptd0; @@ -143,215 +135,212 @@ typedef struct non_single_struct_t { CELL *pt0, *pt0_end; } non_singletons_t; -#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ - if (IsPairTerm(d0)) { \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - LIST0; \ - ptd0 = RepPair(d0); \ - if (*ptd0 == TermFreeTerm) continue; \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ - to_visit->d0 = *ptd0; \ - to_visit ++; \ - d0 = ptd0[0]; \ - pt0 = ptd0; \ - *ptd0 = TermFreeTerm; \ - pt0_end = pt0 + 1; \ - if (pt0 <= pt0_end) \ - goto list_loop; \ - } else if (IsApplTerm(d0)) { \ - register Functor f; \ - register CELL *ap2; \ - /* store the terms to visit */ \ - ap2 = RepAppl(d0); \ - f = (Functor)(*ap2); \ - \ - if (IsExtensionFunctor(f) || \ - IsAtomTerm((CELL)f)) { \ - \ - continue; \ - } \ - STRUCT0; \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ap2; \ - to_visit->d0 = *ap2; \ - to_visit ++; \ - \ - *ap2 = TermNil; \ - d0 = ArityOfFunctor(f); \ - pt0 = ap2; \ - pt0_end = ap2 + d0; \ +#define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \ + int lvl = push_text_stack(); \ + \ + struct non_single_struct_t *to_visit = Malloc( \ + 1024 * sizeof(struct non_single_struct_t)), \ + *to_visit0 = to_visit, \ + *to_visit_max = to_visit + 1024; \ + \ + restart: \ + if (pt0 < pt0_end) { \ + register CELL d0; \ + register CELL *ptd0; \ + ++pt0; \ + ptd0 = pt0; \ + d0 = *ptd0; \ + list_loop: \ + deref_head(d0, var_in_term_unk); \ + var_in_term_nvar : { \ + if (IsPairTerm(d0)) { \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + LIST0; \ + ptd0 = RepPair(d0); \ + if (*ptd0 == TermFreeTerm) \ + goto restart; \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = *ptd0; \ + to_visit++; \ + d0 = ptd0[0]; \ + pt0 = ptd0; \ + *ptd0 = TermFreeTerm; \ + pt0_end = pt0 + 1; \ + if (pt0 <= pt0_end) \ + goto list_loop; \ + } else if (IsApplTerm(d0)) { \ + register Functor f; \ + register CELL *ap2; \ + /* store the terms to visit */ \ + ap2 = RepAppl(d0); \ + f = (Functor)(*ap2); \ + \ + if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \ + \ + goto restart; \ + } \ + STRUCT0; \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ap2; \ + to_visit->d0 = (CELL)f; \ + to_visit++; \ + \ + *ap2 = TermNil; \ + d0 = ArityOfFunctor(f); \ + pt0 = ap2; \ + pt0_end = ap2 + d0; \ + goto restart;\ + } else { \ + PRIMI0; \ + goto restart; } \ + } \ + derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); + +#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {}) + +#define END_WALK() \ +} + + +#define def_aux_overflow() \ + aux_overflow : { \ + size_t d1 = to_visit - to_visit0; \ + size_t d2 = to_visit_max - to_visit0; \ + to_visit0 = \ + Realloc(to_visit0, (d2 + 128) * sizeof(struct non_single_struct_t)); \ + to_visit = to_visit0 + d1; \ + to_visit_max = to_visit0 + (d2 + 128); \ + pt0--; \ + } \ + goto restart; + + +#define def_trail_overflow() \ + trail_overflow : { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ + LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + return 0L; \ } -#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}) - -#define def_trail_overflow() \ - trail_overflow:{ \ - while (to_visit > to_visit0) { \ - to_visit --; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - return 0L; \ +#define def_global_overflow() \ + global_overflow : { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ + LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); \ + return false; \ } -#define def_aux_overflow() \ - aux_overflow:{ \ - size_t d1 = to_visit-to_visit0; \ - size_t d2 = to_visit_max-to_visit0; \ - to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \ - to_visit = to_visit0+d1; \ - to_visit_max = to_visit0+(d2+128); \ - pt0--; \ - goto restart; \ - } +static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term v USES_REGS) { -#define def_global_overflow() \ - global_overflow:{ \ - while (to_visit > to_visit0) { \ - to_visit --; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); \ - return false; } + WALK_COMPLEX_TERM(); -static Int var_in_complex_term(register CELL *pt0, - register CELL *pt0_end, - Term v USES_REGS) -{ + if ((CELL)d0 == v) { /* we found it */ + /* Do we still have compound terms to visit */ + while (to_visit > to_visit0) { + to_visit--; - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; - - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - restart: - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, var_in_term_unk); - var_in_term_nvar: - { - WALK_COMPLEX_TERM(); - continue; - } - deref_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); - if ((CELL)ptd0 == v) { /* we found it */ - /* Do we still have compound terms to visit */ - while (to_visit > to_visit0) { - to_visit--; - - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } - pop_text_stack(lvl); - return true; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; } + pop_text_stack(lvl); + return true; } + END_WALK(); + if (to_visit > to_visit0) { + to_visit--; + + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + } pop_text_stack(lvl); - return false; + return false; def_aux_overflow(); + } -static Int -var_in_term(Term v, Term t USES_REGS) /* variables in term t */ +static Int var_in_term(Term v, + Term t USES_REGS) /* variables in term t */ { - + must_be_variable(v); + t = Deref(t); if (IsVarTerm(t)) { - return(v == t); + return (v == t); } else if (IsPrimitiveTerm(t)) { - return(FALSE); - } else if (IsPairTerm(t)) { - return(var_in_complex_term(RepPair(t)-1, - RepPair(t)+1,v PASS_REGS)); + return (false); } - else return(var_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(FunctorOfTerm(t)),v PASS_REGS)); + return (var_in_complex_term(&(t)-1, &(t), v PASS_REGS)); } -static Int -p_var_in_term( USES_REGS1 ) -{ - return(var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS)); +/** @pred variable_in_term(? _Term_,? _Var_) + + +Succeed if the second argument _Var_ is a variable and occurs in +term _Term_. + + +*/ +static Int variable_in_term(USES_REGS1) { + return var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS); } /** @brief routine to locate all variables in a term, and its applications */ -static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ +static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - restart: - - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - - WALK_COMPLEX_TERM(); - continue ; - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; + WALK_COMPLEX_TERM(); + /* do or pt2 are unbound */ + *ptd0 = TermNil; + /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { + goto global_overflow; } + HR[1] = AbsPair(HR + 2); + HR += 2; + HR[-2] = (CELL)ptd0; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; + + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -360,42 +349,40 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; - goto loop; + goto restart; } - clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); - + if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); if (IsVarTerm(t2)) { - RESET_VARIABLE(HR-1); - Yap_unify((CELL)(HR-1),inp); + RESET_VARIABLE(HR - 1); + Yap_unify((CELL)(HR - 1), inp); } else { - HR[-1] = t2; /* don't need to trail */ + HR[-1] = t2; /* don't need to trail */ } - return(output); + return (output); } else { - return(inp); + return (inp); } def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); + def_aux_overflow(); + + def_global_overflow(); } - static Int -p_variables_in_term( USES_REGS1 ) /* variables in term t */ +p_variables_in_term(USES_REGS1) /* variables in term t */ { Term out, inp; int count; - - restart: +restart: count = 0; inp = Deref(ARG2); while (!IsVarTerm(inp) && IsPairTerm(inp)) { @@ -406,30 +393,27 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ TrailTerm(TR++) = t; count++; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - clean_tr(TR-count PASS_REGS); - if (!Yap_growtrail(count*sizeof(tr_fr_ptr *), FALSE)) { - return FALSE; - } - goto restart; + clean_tr(TR - count PASS_REGS); + if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) { + return false; + } + goto restart; } } inp = TailOfTerm(inp); } do { Term t = Deref(ARG1); - out = vars_in_complex_term(&(t)-1, - &(t), - ARG2 PASS_REGS); + out = vars_in_complex_term(&(t)-1, &(t), ARG2 PASS_REGS); if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - clean_tr(TR-count PASS_REGS); - return Yap_unify(ARG3,out); + clean_tr(TR - count PASS_REGS); + return Yap_unify(ARG3, out); } - /** @pred term_variables(? _Term_, - _Variables_, +_ExternalVars_) is iso @@ -441,8 +425,7 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ */ -static Int -p_term_variables3( USES_REGS1 ) /* variables in term t */ +static Int p_term_variables3(USES_REGS1) /* variables in term t */ { Term out; @@ -450,33 +433,31 @@ p_term_variables3( USES_REGS1 ) /* variables in term t */ Term t = Deref(ARG1); if (IsVarTerm(t)) { Term out = Yap_MkNewPairTerm(); - return - Yap_unify(t,HeadOfTerm(out)) && - Yap_unify(ARG3, TailOfTerm(out)) && - Yap_unify(out, ARG2); - } else if (IsPrimitiveTerm(t)) { + return Yap_unify(t, HeadOfTerm(out)) && + Yap_unify(ARG3, TailOfTerm(out)) && Yap_unify(out, ARG2); + } else if (IsPrimitiveTerm(t)) { return Yap_unify(ARG2, ARG3); } else { - out = vars_in_complex_term(&(t)-1, - &(t), ARG3 PASS_REGS); + out = vars_in_complex_term(&(t)-1, &(t), ARG3 PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - return Yap_unify(ARG2,out); + return Yap_unify(ARG2, out); } /** * Exports a nil-terminated list with all the variables in a term. * @param[t] the term - * @param[arity] the arity of the calling predicate (required for exact garbage collection). + * @param[arity] the arity of the calling predicate (required for exact garbage + * collection). * @param[USES_REGS] threading */ -Term -Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ +Term Yap_TermVariables( + Term t, UInt arity USES_REGS) /* variables in term t */ { Term out; @@ -487,12 +468,11 @@ Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ } else if (IsPrimitiveTerm(t)) { return TermNil; } else { - out = vars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); } if (out == 0L) { - if (!expand_vts( arity PASS_REGS )) - return FALSE; + if (!expand_vts(arity PASS_REGS)) + return false; } } while (out == 0L); return out; @@ -508,91 +488,69 @@ Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ */ -static Int -p_term_variables( USES_REGS1 ) /* variables in term t */ +static Int p_term_variables(USES_REGS1) /* variables in term t */ { Term out; if (!Yap_IsListOrPartialListTerm(ARG2)) { - Yap_Error(TYPE_ERROR_LIST,ARG2,"term_variables/2"); - return FALSE; + Yap_Error(TYPE_ERROR_LIST, ARG2, "term_variables/2"); + return false; } do { Term t = Deref(ARG1); - - out = vars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + + out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - return Yap_unify(ARG2,out); + return Yap_unify(ARG2, out); } /** routine to locate attributed variables */ - typedef struct att_rec { CELL *beg, *end; CELL oval; } att_rec_t; -static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ - int lvl = push_text_stack(); - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; +static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, attvars_in_term_unk); - attvars_in_term_nvar: - { - WALK_COMPLEX_TERM(); - continue; - } + WALK_COMPLEX_TERM(); - - derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); - if (IsAttVar(ptd0)) { - /* do or pt2 are unbound */ - attvar_record *a0 = RepAttVar(ptd0); - if (a0->AttFunc ==(Functor) TermNil) continue; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)&(a0->Done); - /* store the terms to visit */ - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - ptd0 = (CELL*)a0; - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->d0 = *ptd0; - to_visit->ptd0 = ptd0; - to_visit ++; - *ptd0 = TermNil; - pt0_end = &RepAttVar(ptd0)->Atts; - pt0 = pt0_end-1; + if (IsAttVar(ptd0)) { + /* do or pt2 are unbound */ + attvar_record *a0 = RepAttVar(ptd0); + if (a0->AttFunc == (Functor)TermNil) + goto restart; + /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { + goto global_overflow; } + HR[1] = AbsPair(HR + 2); + HR += 2; + HR[-2] = (CELL) & (a0->Done); + /* store the terms to visit */ + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + ptd0 = (CELL *)a0; + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->d0 = *ptd0; + to_visit->ptd0 = ptd0; + to_visit++; + *ptd0 = TermNil; + pt0_end = &RepAttVar(ptd0)->Atts; + pt0 = pt0_end - 1; } + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -604,39 +562,36 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, goto restart; } - clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); if (IsVarTerm(t2)) { - RESET_VARIABLE(HR-1); - Yap_unify((CELL)(HR-1), t2); + RESET_VARIABLE(HR - 1); + Yap_unify((CELL)(HR - 1), t2); } else { - HR[-1] = t2; /* don't need to trail */ + HR[-1] = t2; /* don't need to trail */ } - return(output); + return (output); } else { - return(inp); + return (inp); } def_aux_overflow(); def_global_overflow(); - } - /** @pred term_attvars(+ _Term_,- _AttVars_) +/** @pred term_attvars(+ _Term_,- _AttVars_) - _AttVars_ is a list of all attributed variables in _Term_ and - its attributes. I.e., term_attvars/2 works recursively through - attributes. This predicate is Cycle-safe. + _AttVars_ is a list of all attributed variables in _Term_ and + its attributes. I.e., term_attvars/2 works recursively through + attributes. This predicate is Cycle-safe. - */ -static Int -p_term_attvars( USES_REGS1 ) /* variables in term t */ +*/ +static Int p_term_attvars(USES_REGS1) /* variables in term t */ { Term out; @@ -645,32 +600,25 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */ if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); } else { - out = attvars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + out = attvars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return false; - } + if (!expand_vts(3 PASS_REGS)) + return false; + } } while (out == 0L); - return Yap_unify(ARG2,out); + return Yap_unify(ARG2, out); } -/** @brief output the difference between variables in _T_ and variables in some list. +/** @brief output the difference between variables in _T_ and variables in some + * list. */ -static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; +static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - to_visit0 = to_visit; while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { @@ -678,48 +626,34 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, *ptr = TermFoundVar; TrailTerm(TR++) = t; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; + } } } inp = TailOfTerm(inp); } - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - WALK_COMPLEX_TERM(); - continue; - } + WALK_COMPLEX_TERM(); - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; + /* do or pt2 are unbound */ + *ptd0 = TermNil; + /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { + goto global_overflow; } + HR[1] = AbsPair(HR + 2); + HR += 2; + HR[-2] = (CELL)ptd0; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -740,58 +674,63 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, return TermNil; } - def_trail_overflow(); def_aux_overflow(); + + def_trail_overflow(); + def_global_overflow(); } - /** @pred new_variables_in_term(+_CurrentVariables_, ? _Term_, -_Variables_) Unify _Variables_ with the list of all variables of term - _Term_ that do not occur in _CurrentVariables_. The variables occur in the order of their first - appearance when traversing the term depth-first, left-to-right. + _Term_ that do not occur in _CurrentVariables_. The variables occur in the + order of their first appearance when traversing the term depth-first, + left-to-right. */ static Int -p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ +p_new_variables_in_term(USES_REGS1) /* variables within term t */ { Term out; do { Term t = Deref(ARG2); - if (IsPrimitiveTerm(t)) + if (IsPrimitiveTerm(t)) out = TermNil; - else { - out = new_vars_in_complex_term(&(t)-1, - &(t), Deref(ARG1) PASS_REGS); + else { + out = new_vars_in_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - return Yap_unify(ARG3,out); + return Yap_unify(ARG3, out); } +#define FOUND_VAR() \ + if (d0 == TermFoundVar) { \ + /* leave an empty slot to fill in later */ \ + if (HR + 1024 > ASP) { \ + goto global_overflow; \ + } \ + HR[1] = AbsPair(HR + 2); \ + HR += 2; \ + HR[-2] = (CELL)ptd0; \ + *ptd0 = TermNil; \ + } -static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ +static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; - register tr_fr_ptr TR0 = TR; + tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - to_visit0 = to_visit; while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { @@ -799,40 +738,15 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, *ptr = TermFoundVar; TrailTerm(TR++) = t; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } + Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true); } } inp = TailOfTerm(inp); } - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - WALK_COMPLEX_TERM() - else if (d0 == TermFoundVar) { - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - *ptd0 = TermNil; - } - } - continue; - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - } + WALK_COMPLEX_TERM__({}, {}, FOUND_VAR()); + + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -854,91 +768,67 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, } - def_trail_overflow(); def_aux_overflow(); + def_global_overflow(); } /** @pred variables_within_term(+_CurrentVariables_, ? _Term_, -_Variables_) + Unify _Variables_ with the list of all variables of term _Term_ + that *also* occur in _CurrentVariables_. The variables occur in + the order of their first appearance when traversing the term + depth-first, left-to-right. - - Unify _Variables_ with the list of all variables of term - _Term_ that *also* occur in _CurrentVariables_. The variables occur in the order of their first - appearance when traversing the term depth-first, left-to-right. - -This predicate performs the opposite of new_variables_in_term/3. + This predicate performs the opposite of new_variables_in_term/3. */ -static Int -p_variables_within_term( USES_REGS1 ) /* variables within term t */ +static Int p_variables_within_term(USES_REGS1) /* variables within term t */ { Term out; do { Term t = Deref(ARG2); - if (IsPrimitiveTerm(t)) + if (IsPrimitiveTerm(t)) out = TermNil; - else { - out = vars_within_complex_term(&(t)-1, - &(t), Deref(ARG1) PASS_REGS); + else { + out = vars_within_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - return Yap_unify(ARG3,out); + return Yap_unify(ARG3, out); } - -static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) -{ - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; +static Term free_vars_in_complex_term(CELL *pt0, CELL *pt0_end, + tr_fr_ptr TR0 USES_REGS) { Term o = TermNil; CELL *InitialH = HR; - to_visit0 = to_visit; - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - WALK_COMPLEX_TERM(); - continue; - } - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - o = TermNil; - goto global_overflow; - } - HR[0] = (CELL)ptd0; - HR[1] = o; - o = AbsPair(HR); - HR += 2; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; + WALK_COMPLEX_TERM(); + /* do or pt2 are unbound */ + *ptd0 = TermNil; + /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { + o = TermNil; + goto global_overflow; } + HR[0] = (CELL)ptd0; + HR[1] = o; + o = AbsPair(HR); + HR += 2; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; + END_WALK(); + /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -954,147 +844,49 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end pop_text_stack(lvl); return o; - - def_trail_overflow(); def_aux_overflow(); - def_global_overflow(); + def_trail_overflow(); + + def_global_overflow(); } -static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) -{ - register CELL **to_visit0, - **to_visit = (CELL **)Yap_PreAllocCodeSpace(); +static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, + tr_fr_ptr TR0 USES_REGS) { CELL *InitialH = HR; - to_visit0 = to_visit; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; + WALK_COMPLEX_TERM(); + /* do or pt2 are unbound */ + *ptd0 = TermFoundVar; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; } - - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; } + TrailTerm(TR++) = (CELL)ptd0; + END_WALK(); + /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; + to_visit--; + pt0 = to_visit->ptd0; + *pt0 = to_visit0->d0; + goto list_loop; } - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + pop_text_stack(lvl); return TermNil; - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; + def_aux_overflow(); - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; + def_trail_overflow(); } - static Int -p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ +p_free_variables_in_term(USES_REGS1) /* variables within term t */ { Term out; Term t, t0; @@ -1107,94 +899,65 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ while (!IsVarTerm(t) && IsApplTerm(t)) { Functor f = FunctorOfTerm(t); if (f == FunctorHat) { - out = bind_vars_in_complex_term(RepAppl(t), - RepAppl(t)+1, TR0 PASS_REGS); - if (out == 0L) { - goto trail_overflow; - } + out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1, + TR0 PASS_REGS); + if (out == 0L) { + goto trail_overflow; + } } else if (f == FunctorModule) { - found_module = ArgOfTerm(1, t); + found_module = ArgOfTerm(1, t); } else if (f == FunctorCall) { - t = ArgOfTerm(1, t); - continue; + t = ArgOfTerm(1, t); } else if (f == FunctorExecuteInMod) { - found_module = ArgOfTerm(2, t); - t = ArgOfTerm(1, t); - continue; + found_module = ArgOfTerm(2, t); + t = ArgOfTerm(1, t); } else { - break; + break; } - t = ArgOfTerm(2,t); + t = ArgOfTerm(2, t); } - if (IsPrimitiveTerm(t)) + if (IsPrimitiveTerm(t)) out = TermNil; else { - out = free_vars_in_complex_term(&(t)-1, - &(t), TR0 PASS_REGS); + out = free_vars_in_complex_term(&(t)-1, &(t), TR0 PASS_REGS); } if (out == 0L) { trail_overflow: - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - if (found_module && t!=t0) { + if (found_module && t != t0) { Term ts[2]; ts[0] = found_module; ts[1] = t; t = Yap_MkApplTerm(FunctorModule, 2, ts); } - return - Yap_unify(ARG2, t) && - Yap_unify(ARG3,out); + return Yap_unify(ARG2, t) && Yap_unify(ARG3, out); } +#define FOUND_VAR_AGAIN() \ + if (d0 == TermFoundVar) { \ + CELL *pt2 = pt0; \ + while (IsVarTerm(*pt2)) \ + pt2 = (CELL *)(*pt2); \ + HR[1] = AbsPair(HR + 2); \ + HR[0] = (CELL)pt2; \ + HR += 2; \ + *pt2 = TermRefoundVar; \ + } - -static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) -{ - int lvl = push_text_stack(); - - struct non_single_struct_t *to_visit0, - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit_max; - register tr_fr_ptr TR0 = TR; +static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { + tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - WALK_COMPLEX_TERM() - else if (d0 == TermFoundVar) { - CELL *pt2 = pt0; - while(IsVarTerm(*pt2)) - pt2 = (CELL *)(*pt2); - HR[1] = AbsPair(HR+2); - HR[0] = (CELL)pt2; - HR += 2; - *pt2 = TermRefoundVar; - } - continue; - } - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; - /* next make sure we can recover the variable again */ - TrailTerm(TR++) = (CELL)ptd0; - } + WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); + /* do or pt2 are unbound */ + *ptd0 = TermFoundVar; + /* next make sure we can recover the variable again */ + TrailTerm(TR++) = (CELL)ptd0; + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -1207,6 +970,7 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt } clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); if (HR != InitialH) { /* close the list */ @@ -1217,70 +981,43 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt } def_aux_overflow(); + } -static Int -p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ +static Int p_non_singletons_in_term( + USES_REGS1) /* non_singletons in term t */ { Term t; Term out; - while (TRUE) { + while (true) { t = Deref(ARG1); if (IsVarTerm(t)) { out = ARG2; - } else if (IsPrimitiveTerm(t)) { + } else if (IsPrimitiveTerm(t)) { out = ARG2; } else { - out = non_singletons_in_complex_term(&(t)-1, - &(t) PASS_REGS); + out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS); } if (out != 0L) { - return Yap_unify(ARG3,out); - } else { - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in singletons"); - return FALSE; - } + return Yap_unify(ARG3, out); } } } -static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) -{ - int lvl = push_text_stack(); +static Int ground_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { - struct non_single_struct_t *to_visit0, - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit_max; + WALK_COMPLEX_TERM(); - to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - - ++pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - WALK_COMPLEX_TERM(); - continue; - - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - while (to_visit > to_visit0) { - to_visit --; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } - pop_text_stack(lvl); - return false; + /* found a variable */ + while (to_visit > to_visit0) { + to_visit--; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; } + pop_text_stack(lvl); + return false; + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -1295,132 +1032,96 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R return true; def_aux_overflow(); + + } -bool Yap_IsGroundTerm(Term t) -{ +bool Yap_IsGroundTerm(Term t) { CACHE_REGS - while (TRUE) { - Int out; + while (true) { + Int out; - if (IsVarTerm(t)) { - return FALSE; - } else if (IsPrimitiveTerm(t)) { - return TRUE; - } else { - if ((out =ground_complex_term(&(t)-1, - &(t) PASS_REGS)) >= 0) { - return out != 0; - } + if (IsVarTerm(t)) { + return false; + } else if (IsPrimitiveTerm(t)) { + return true; + } else { + if ((out = ground_complex_term(&(t)-1, &(t)PASS_REGS)) >= 0) { + return out != 0; + } if (out < 0) { - *HR++ = t; - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); - return false; - } - t = *--HR; + *HR++ = t; + + t = *--HR; } } - } + } } - /** @pred ground( _T_) is iso +/** @pred ground( _T_) is iso - - Succeeds if there are no free variables in the term _T_. - - - */ -static Int -p_ground( USES_REGS1 ) /* ground(+T) */ + Succeeds if there are no free variables in the term _T_. +*/ +static Int p_ground(USES_REGS1) /* ground(+T) */ { return Yap_IsGroundTerm(Deref(ARG1)); } -static Term -numbervar(Int id USES_REGS) -{ +static Term numbervar(Int id USES_REGS) { Term ts[1]; ts[0] = MkIntegerTerm(id); return Yap_MkApplTerm(FunctorDollarVar, 1, ts); } -static Term -numbervar_singleton(USES_REGS1) -{ +static Term numbervar_singleton(USES_REGS1) { Term ts[1]; ts[0] = MkIntegerTerm(-1); return Yap_MkApplTerm(FunctorDollarVar, 1, ts); } -static void -renumbervar(Term t, Int id USES_REGS) -{ +static void renumbervar(Term t, Int id USES_REGS) { Term *ts = RepAppl(t); ts[1] = MkIntegerTerm(id); } -#define RENUMBER_SINGLES \ - if (singles && ap2 >= InitialH && ap2 < HR) { \ - renumbervar(d0, numbv++ PASS_REGS); \ - continue; \ +#define RENUMBER_SINGLES \ + if (singles && ap2 >= InitialH && ap2 < HR) { \ + renumbervar(d0, numbv++ PASS_REGS); \ + goto restart; \ } -static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) -{ +static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, + int singles USES_REGS) { - - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; - register tr_fr_ptr TR0 = TR; + tr_fr_ptr TR0 = TR; CELL *InitialH = HR; - to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - WALK_COMPLEX_TERM__({},RENUMBER_SINGLES); + WALK_COMPLEX_TERM__({}, RENUMBER_SINGLES, {}); - continue; - } - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - /* do or pt2 are unbound */ - if (singles) - *ptd0 = numbervar_singleton( PASS_REGS1 ); - else - *ptd0 = numbervar(numbv++ PASS_REGS); - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } + /* do or pt2 are unbound */ + if (singles) + *ptd0 = numbervar_singleton(PASS_REGS1); + else + *ptd0 = numbervar(numbv++ PASS_REGS); + /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { + goto global_overflow; + } + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; } + } #if defined(TABLING) || defined(YAPOR_SBA) - TrailVal(TR) = (CELL)ptd0; + TrailVal(TR) = (CELL)ptd0; #endif - TrailTerm(TR++) = (CELL)ptd0; - } + TrailTerm(TR++) = (CELL)ptd0; + + END_WALK(); + /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -1436,116 +1137,76 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end pop_text_stack(lvl); return numbv; - def_trail_overflow(); def_aux_overflow(); + def_global_overflow(); + def_trail_overflow(); + } - -Int -Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* - * numbervariables in term t */ +Int Yap_NumberVars(Term inp, Int numbv, + bool handle_singles) /* + * numbervariables in term t */ { CACHE_REGS - Int out; + Int out; Term t; - restart: +restart: t = Deref(inp); - if (IsVarTerm(t)) { - CELL *ptd0 = VarOfTerm(t); - TrailTerm(TR++) = (CELL)ptd0; - if (handle_singles) { - *ptd0 = numbervar_singleton( PASS_REGS1 ); - return numbv; - } else { - *ptd0 = numbervar(numbv PASS_REGS); - return numbv+1; - } - } else if (IsPrimitiveTerm(t)) { + if (IsPrimitiveTerm(t)) { return numbv; } else { - out = numbervars_in_complex_term(&(t)-1, - &(t), numbv, handle_singles PASS_REGS); + out = numbervars_in_complex_term(&(t)-1, &(t), numbv, + handle_singles PASS_REGS); } if (out < numbv) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; goto restart; } - return true; + return out; } - /** @pred numbervars( _T_,+ _N1_,- _Nn_) +/** @pred numbervars( _T_,+ _N1_,- _Nn_) - Instantiates each variable in term _T_ to a term of the form: - `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. + Instantiates each variable in term _T_ to a term of the form: + `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. - */ -static Int -p_numbervars( USES_REGS1 ) -{ +*/ +static Int p_numbervars(USES_REGS1) { Term t2 = Deref(ARG2); Int out; if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"numbervars/3"); - return FALSE; + Yap_Error(INSTANTIATION_ERROR, t2, "numbervars/3"); + return false; } if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER,t2,"numbervars/3"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, t2, "numbervars/3"); + return (false); } - if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), FALSE)) < 0) - return FALSE; + if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), false)) < 0) + return false; return Yap_unify(ARG3, MkIntegerTerm(out)); } - -#define MAX_NUMBERED \ - if (FunctorOfTerm(d0) == FunctorDollarVar) {\ - Term t1 = ArgOfTerm(1, d0); \ - Int i; \ - if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) *maxp = i; \ - continue; \ +#define MAX_NUMBERED \ + if (FunctorOfTerm(d0) == FunctorDollarVar) { \ + Term t1 = ArgOfTerm(1, d0); \ + Int i; \ + if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \ + *maxp = i; \ + goto restart; \ } -static int -max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) -{ +static int max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) { - - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; - - to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - WALK_COMPLEX_TERM__({},MAX_NUMBERED); - - continue; - } - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - } + WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {}); + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -1554,7 +1215,6 @@ max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; - goto restart; } prune(B PASS_REGS); @@ -1562,11 +1222,10 @@ max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) return 0; def_aux_overflow(); + } - -static Int -MaxNumberedVar(Term inp, UInt arity_REGS) { +static Int MaxNumberedVar(Term inp, UInt arity_REGS) { Term t = Deref(inp); if (IsPrimitiveTerm(t)) { @@ -1574,16 +1233,131 @@ MaxNumberedVar(Term inp, UInt arity_REGS) { } else { Int res; Int max; - res = max_numbered_var(&t-1, &t, &max PASS_REGS)-1; - if (res < 0) return -1; + res = max_numbered_var(&t - 1, &t, &max PASS_REGS) - 1; + if (res < 0) + return -1; return MkIntegerTerm(max); } } +#define BREAK_LOOP(BOTTOM, TOP) (AtomTag | (CELL)to_visit) + +#define WALK_CYCLES_IN_TERM(LIST0, STRUCT0) \ + if (IsPairTerm(d0)) { \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + CELL *headp = RepPair(d0); \ + if (IsAtomTerm(*headp) && \ + (CELL *)AtomOfTerm(*headp) >= (CELL *)to_visit0 && \ + (CELL *)AtomOfTerm(*headp) < (CELL *)to_visit_max) { \ + LIST0; \ + *headp = BREAK_LOOP(ptd0, headp); \ + goto restart; \ + } \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = headp; \ + to_visit->d0 = *headp; \ + to_visit++; \ + d0 = *headp; \ + pt0 = headp; \ + *pt0 = TermFreeTerm; \ + pt0_end = headp + 1; \ + if (pt0 <= pt0_end) \ + goto list_loop; \ + } else if (IsApplTerm(d0)) { \ + register Functor f; \ + register CELL *ap2; \ + /* store the terms to visit */ \ + ap2 = RepAppl(d0); \ + f = (Functor)(*ap2); \ + \ + if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \ + \ + *ap2 = BREAK_LOOP(ptd0, ap2); \ + goto restart; \ + } \ + STRUCT0; \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ap2; \ + to_visit->d0 = *ap2; \ + to_visit++; \ + \ + *ap2 = TermFoundVar; \ + d0 = ArityOfFunctor(f); \ + pt0 = ap2; \ + pt0_end = ap2 + d0; \ + goto restart;\ + } -void Yap_InitTermCPreds(void) -{ +static int loops_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { + int lvl = push_text_stack(); + + struct non_single_struct_t *to_visit = Malloc( + 1024 * sizeof(struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit + 1024; + + to_visit0 = to_visit; + to_visit_max = to_visit0 + 1024; +restart: + if (pt0 < pt0_end) { + CELL d0; + CELL *ptd0; + ++pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, vars_in_term_unk); + vars_in_term_nvar : { + WALK_CYCLES_IN_TERM({}, {}); + + goto restart; + } + + derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); + + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + CELL *headp = to_visit->ptd0; + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + if (IsAtomTerm(*headp) && + (CELL *)AtomOfTerm(*headp) >= (CELL *)to_visit0 && + (CELL *)AtomOfTerm(*headp) < (CELL *)to_visit_max) { + *to_visit->ptd0 = to_visit->d0; + } + } + goto restart; + } + pop_text_stack(lvl); + return 0; + def_aux_overflow(); +} + +Term Yap_CheckLoops(Term inp, UInt arity_REGS) { + Term t = Deref(inp); + return t; + if (IsPrimitiveTerm(t)) { + return t; + } else { + Int res; + + res = loops_in_complex_term(&t - 1, &t PASS_REGS) - 1; + if (res < 0) + return -1; + return t; + } +} + +void Yap_InitTermCPreds(void) { Yap_InitCPred("term_variables", 2, p_term_variables, 0); Yap_InitCPred("term_variables", 3, p_term_variables3, 0); Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); @@ -1593,15 +1367,14 @@ void Yap_InitTermCPreds(void) Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); CurrentModule = TERMS_MODULE; - Yap_InitCPred("variable_in_term", 2, p_var_in_term, 0); + Yap_InitCPred("variable_in_term", 2, variable_in_term, 0); Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0); Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0); CurrentModule = PROLOG_MODULE; - + Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); Yap_InitCPred("ground", 1, p_ground, SafePredFlag); Yap_InitCPred("numbervars", 3, p_numbervars, 0); } - diff --git a/C/write.c b/C/write.c index f7fd79969..ad28e1a0c 100644 --- a/C/write.c +++ b/C/write.c @@ -1107,17 +1107,11 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, rwt.parent = NULL; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; - if (!(flags & Ignore_cyclics_f) && false) { - Term ts[2]; - ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS); - // fprintf(stderr, "%lx %lx %lx\n", t, ts[0], ts[1]); - // Yap_DebugPlWriteln(ts[0]); - // ap_DebugPlWriteln(ts[1[); - if (ts[1] != TermNil) { - t = Yap_MkApplTerm(FunctorAtSymbol, 2, ts); - } + // if (!(flags & Ignore_cyclics_f) && false) + { + t = Yap_CheckLoops(t, 1); } - /* protect slots for portray */ +/* protect slots for portray */ writeTerm(t, priority, 1, FALSE, &wglb, &rwt); if (flags & New_Line_f) { if (flags & Fullstop_f) { @@ -1134,4 +1128,5 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, } Yap_CloseSlots(sls); pop_text_stack(lvl); -} + } + diff --git a/CMakeLists.txt b/CMakeLists.txt index 01576f7bf..1b6e814d6 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -482,6 +482,9 @@ set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS "_YAP_NOT_INSTALLED_= # Model Specific set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS $<$:DEBUG=1>) +# debug across macros +set_property(DIRECTORY APPEND PROPERTY COMPILE_OPTIONS $<$:-g3>) + #ensure cells are properly aligned in code set(ALIGN_LONGS 1) diff --git a/H/Yapproto.h b/H/Yapproto.h index 4750e4d5b..ff9b8f76e 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -444,6 +444,10 @@ extern bool Yap_ChDir(const char *path); bool Yap_isDirectory(const char *FileName); extern bool Yap_Exists(const char *f); +/* terms.c */ +extern Term Yap_CheckLoops(Term inp, UInt arity USES_REGS); +extern void Yap_InitTermCPreds(void); + /* threads.c */ extern void Yap_InitThreadPreds(void); extern void Yap_InitFirstWorkerThreadHandle(void); diff --git a/include/YapError.h b/include/YapError.h index 246e5c81f..b5d4d3135 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -285,4 +285,8 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line, yap_error_descriptor_t *new_error); extern yap_error_descriptor_t *Yap_popErrorContext(bool oerr, bool pass); +#define must_be_variable(t) if (!IsVarTerm(t)) Yap_ThrowError(UNINSTANTIATION_ERROR, v, NULL) + #endif + + diff --git a/library/terms.yap b/library/terms.yap index 64d5972ae..dcbd53383 100644 --- a/library/terms.yap +++ b/library/terms.yap @@ -104,14 +104,6 @@ Succeed if _Term1_ and _Term2_ are unifiable with substitution */ -/** @pred variable_in_term(? _Term_,? _Var_) - - -Succeed if the second argument _Var_ is a variable and occurs in -term _Term_. - - -*/ /** @pred variables_within_term(+ _Variables_,? _Term_, - _OutputVariables_) @@ -136,6 +128,7 @@ Succeed if _Term1_ and _Term2_ are variant terms. variant/2, unifiable/3, subsumes/2, + subsumes_chk/2, cyclic_term/1, variable_in_term/2, From 38610c0b0d77a9a01ac8666390d3a31a9197bab7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sat, 2 Feb 2019 22:33:18 +0000 Subject: [PATCH 027/101] rational trees --- C/terms.c | 212 ++++++++++++++++++++++++++++++++------------------ C/utilpreds.c | 13 ---- C/write.c | 6 +- H/Yapproto.h | 2 +- pl/absf.yap | 2 - 5 files changed, 139 insertions(+), 96 deletions(-) diff --git a/C/terms.c b/C/terms.c index 4eb9d937e..e9167f506 100644 --- a/C/terms.c +++ b/C/terms.c @@ -144,7 +144,7 @@ typedef struct non_single_struct_t { *to_visit_max = to_visit + 1024; \ \ restart: \ - if (pt0 < pt0_end) { \ + while (pt0 < pt0_end) { \ register CELL d0; \ register CELL *ptd0; \ ++pt0; \ @@ -1225,7 +1225,7 @@ static int max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) { } -static Int MaxNumberedVar(Term inp, UInt arity_REGS) { +static Int MaxNumberedVar(Term inp, UInt arity PASS_REGS) { Term t = Deref(inp); if (IsPrimitiveTerm(t)) { @@ -1240,74 +1240,53 @@ static Int MaxNumberedVar(Term inp, UInt arity_REGS) { } } -#define BREAK_LOOP(BOTTOM, TOP) (AtomTag | (CELL)to_visit) +/** + * @pred largest_numbervar( +_Term_, -Max) + * + * Unify _Max_ with the largest integer _I_ such that `$VAR(I)` is a + * sub-term of _Term_. + * + * This built-in predicate is useful if part of a term has been grounded, and + * now you want to ground the full term. + */ +static Int largest_numbervar(USES_REGS1) +{ + return Yap_unify(MaxNumberedVar(Deref(ARG1), 2 PASS_REGS), ARG2); +} -#define WALK_CYCLES_IN_TERM(LIST0, STRUCT0) \ - if (IsPairTerm(d0)) { \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - CELL *headp = RepPair(d0); \ - if (IsAtomTerm(*headp) && \ - (CELL *)AtomOfTerm(*headp) >= (CELL *)to_visit0 && \ - (CELL *)AtomOfTerm(*headp) < (CELL *)to_visit_max) { \ - LIST0; \ - *headp = BREAK_LOOP(ptd0, headp); \ - goto restart; \ - } \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = headp; \ - to_visit->d0 = *headp; \ - to_visit++; \ - d0 = *headp; \ - pt0 = headp; \ - *pt0 = TermFreeTerm; \ - pt0_end = headp + 1; \ - if (pt0 <= pt0_end) \ - goto list_loop; \ - } else if (IsApplTerm(d0)) { \ - register Functor f; \ - register CELL *ap2; \ - /* store the terms to visit */ \ - ap2 = RepAppl(d0); \ - f = (Functor)(*ap2); \ - \ - if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \ - \ - *ap2 = BREAK_LOOP(ptd0, ap2); \ - goto restart; \ - } \ - STRUCT0; \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ap2; \ - to_visit->d0 = *ap2; \ - to_visit++; \ - \ - *ap2 = TermFoundVar; \ - d0 = ArityOfFunctor(f); \ - pt0 = ap2; \ - pt0_end = ap2 + d0; \ - goto restart;\ - } +static Term BREAK_LOOP(int ddep ) { + Term t0 = MkIntegerTerm (ddep); + return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("@^"), 1), 1, &t0); +} + +static Term UNFOLD_LOOP( Term t, Term *b, Term *l) { + Term ti = Yap_MkNewApplTerm(FunctorEq, 2); + RepAppl(ti)[2] = t; + Term o = RepAppl(ti)[1]; + HR[0] = ti; + HR[1] = *l; + l[0] = AbsPair(HR); + if (b!=NULL && *b==TermNil) + b = l; + l = HR+1; + + HR+=2; + return o; +} -static int loops_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { +static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp, Term *endp USES_REGS) { int lvl = push_text_stack(); struct non_single_struct_t *to_visit = Malloc( - 1024 * sizeof(struct non_single_struct_t)), + 1024 * sizeof(struct non_single_struct_t)), *to_visit0 = to_visit, *to_visit_max = to_visit + 1024; to_visit0 = to_visit; to_visit_max = to_visit0 + 1024; restart: - if (pt0 < pt0_end) { + while (pt0 < pt0_end) { CELL d0; CELL *ptd0; ++pt0; @@ -1315,49 +1294,127 @@ restart: d0 = *ptd0; list_loop: deref_head(d0, vars_in_term_unk); - vars_in_term_nvar : { - WALK_CYCLES_IN_TERM({}, {}); + vars_in_term_nvar : + if (IsPairTerm(d0)) { + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + CELL *headp = RepPair(d0); - goto restart; + d0 = headp[0]; + if (IsAtomTerm(d0) && + (CELL *)AtomOfTerm(d0) >= (CELL *)to_visit0 && + (CELL *)AtomOfTerm(d0) < (CELL *)to_visit_max) { + // LIST0; + struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(d0); + if (listp) { + *ptd0 = UNFOLD_LOOP(AbsPair(headp), listp, endp); + } else { + *ptd0 = BREAK_LOOP(to_visit-v0); + } + + goto restart; + } + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->ptd0 = headp; + to_visit->d0 = d0; + *headp = MkAtomTerm((AtomEntry*)to_visit); + to_visit++; + pt0 = headp; + pt0_end = pt0 + 1; + ptd0 = pt0; + goto list_loop; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) continue; + if (IsAtomTerm((CELL)f)) { + + if (listp) { + *ptd0 = UNFOLD_LOOP(AbsAppl(ap2), listp, endp); + } else { + *ptd0 = BREAK_LOOP(to_visit-(struct non_single_struct_t *)AtomOfTerm(*ap2)); + } + goto restart; + } +// STRUCT0; + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->ptd0 = ap2; + to_visit->d0 = *ap2; + *ap2 = MkAtomTerm((AtomEntry*)to_visit); + to_visit++; + + pt0 = ap2; + pt0_end = ap2 + (ArityOfFunctor(f)); } + goto restart; + derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - CELL *headp = to_visit->ptd0; - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - if (IsAtomTerm(*headp) && - (CELL *)AtomOfTerm(*headp) >= (CELL *)to_visit0 && - (CELL *)AtomOfTerm(*headp) < (CELL *)to_visit_max) { - *to_visit->ptd0 = to_visit->d0; - } - } goto restart; } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + if (!IsVarTerm(*ptd0)) + *ptd0 = to_visit->d0; + goto restart; + } + pop_text_stack(lvl); return 0; def_aux_overflow(); } -Term Yap_CheckLoops(Term inp, UInt arity_REGS) { +Term Yap_CheckLoops(Term inp, UInt arity, Term *listp, Term *endp USES_REGS) { Term t = Deref(inp); - return t; - if (IsPrimitiveTerm(t)) { + + if (IsVarTerm(t) || IsPrimitiveTerm(t)) { return t; } else { Int res; - res = loops_in_complex_term(&t - 1, &t PASS_REGS) - 1; + res = loops_in_complex_term((&t) - 1, &t, listp, endp PASS_REGS); if (res < 0) return -1; return t; } } + + /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) + + + The term _TF_ is a forest representation (without cycles) for + the Prolog term _TI_. The term _TF_ is the main term. The + difference list _SubTerms_-_MoreSubterms_ stores terms of the + form _V=T_, where _V_ is a new variable occuring in _TF_, and + _T_ is a copy of a sub-term from _TI_. + + + */ +static Int p_break_rational(USES_REGS1) +{ + Term t = Yap_CopyTerm(Deref(ARG1)); + Term l = Deref(ARG4), k; + return Yap_unify(Yap_CheckLoops(t, 4, &k, &l PASS_REGS), ARG2) && Yap_unify(k, ARG3); +} + void Yap_InitTermCPreds(void) { + Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0); Yap_InitCPred("term_variables", 2, p_term_variables, 0); Yap_InitCPred("term_variables", 3, p_term_variables3, 0); Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); @@ -1377,4 +1434,5 @@ void Yap_InitTermCPreds(void) { Yap_InitCPred("ground", 1, p_ground, SafePredFlag); Yap_InitCPred("numbervars", 3, p_numbervars, 0); + Yap_InitCPred("largest_numbervar", 2, largest_numbervar, 0); } diff --git a/C/utilpreds.c b/C/utilpreds.c index d78470071..85a763466 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -3847,19 +3847,6 @@ void Yap_InitUtilCPreds(void) */ Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag|TestPredFlag); Yap_InitCPred("$is_list_or_partial_list", 1, p_is_list_or_partial_list, SafePredFlag|TestPredFlag); - Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0); - /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) - - - The term _TF_ is a forest representation (without cycles and repeated - terms) for the Prolog term _TI_. The term _TF_ is the main term. The - difference list _SubTerms_-_MoreSubterms_ stores terms of the form - _V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy - of a sub-term from _TI_. - - - */ - Yap_InitCPred("term_factorized", 3, p_break_rational3, 0); /** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) diff --git a/C/write.c b/C/write.c index ad28e1a0c..6f5323374 100644 --- a/C/write.c +++ b/C/write.c @@ -1084,7 +1084,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, struct rewind_term rwt; yhandle_t sls = Yap_CurrentSlot(); int lvl = push_text_stack(); - + if (t == 0) return; if (!mywrite) { @@ -1109,9 +1109,9 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, wglb.Write_strings = flags & BackQuote_String_f; // if (!(flags & Ignore_cyclics_f) && false) { - t = Yap_CheckLoops(t, 1); + t = Yap_CheckLoops(t, 1, NULL, NULL PASS_REGS); } -/* protect slots for portray */ + /* protect slots for portray */ writeTerm(t, priority, 1, FALSE, &wglb, &rwt); if (flags & New_Line_f) { if (flags & Fullstop_f) { diff --git a/H/Yapproto.h b/H/Yapproto.h index ff9b8f76e..6a2444a2f 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -445,7 +445,7 @@ bool Yap_isDirectory(const char *FileName); extern bool Yap_Exists(const char *f); /* terms.c */ -extern Term Yap_CheckLoops(Term inp, UInt arity USES_REGS); +extern Term Yap_CheckLoops(Term inp, UInt arity, Term *listp, Term *endp USES_REGS); extern void Yap_InitTermCPreds(void); /* threads.c */ diff --git a/pl/absf.yap b/pl/absf.yap index c65880f87..f9c809da6 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -90,12 +90,10 @@ absolute_file_name__(File,LOpts,TrueFileName) :- '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). -:- start_low_level_trace. prolog:core_file_name(Name, Opts) --> '$file_name'(Name, Opts, E), '$suffix'(E, Opts), '$glob'(Opts). -:- stop_low_level_trace. % % handle library(lists) or foreign(jpl) % From 208438f0d0437cf1db04f7e4f091c02a687bc624 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 3 Feb 2019 21:35:12 +0000 Subject: [PATCH 028/101] debugging rts --- C/c_interface.c | 4 +-- C/stack.c | 2 +- C/terms.c | 84 +++++++++++++++++++++++++++---------------------- C/write.c | 43 +++++++------------------ H/Yapproto.h | 2 +- os/iopreds.c | 2 +- os/readterm.c | 7 ++--- 7 files changed, 67 insertions(+), 77 deletions(-) diff --git a/C/c_interface.c b/C/c_interface.c index a6e9d223a..f2c7425cb 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -2206,8 +2206,8 @@ X_API Term YAP_ReadFromStream(int sno) { sigjmp_buf signew; if (sigsetjmp(signew, 0)) { Yap_syntax_error(LOCAL_toktide, sno, "ReadFromStream"); - RECOVER_MACHINE_REGS(); - return 0; + RECOVER_MACHINE_REGS(); + return 0; } else { o = Yap_read_term(sno, TermNil, false); } diff --git a/C/stack.c b/C/stack.c index 618aedf02..95bbac32b 100644 --- a/C/stack.c +++ b/C/stack.c @@ -2134,7 +2134,7 @@ static void shortstack( choiceptr b_ptr, CELL * env_ptr , buf_struct_t *bufp) { void DumpActiveGoals(USES_REGS1) { /* try to dump active goals */ void *ep = YENV; /* and current environment */ - void *cp ; + void *cp = B; PredEntry *pe; struct buf_struct_t buf0, *bufp = &buf0; diff --git a/C/terms.c b/C/terms.c index e9167f506..2dc49e363 100644 --- a/C/terms.c +++ b/C/terms.c @@ -69,7 +69,7 @@ static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { } while (TR != TR0); } } - +#if 0 static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { @@ -93,6 +93,7 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { /// /// @param USES_REGS /// + static inline void clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { @@ -123,7 +124,7 @@ static inline void clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { } TR = TR0; } - +#endif typedef struct { Term old_var; Term new_var; @@ -225,12 +226,7 @@ typedef struct non_single_struct_t { #define def_trail_overflow() \ trail_overflow : { \ - while (to_visit > to_visit0) { \ - to_visit--; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ + pop_text_stack(lvl); \ LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ clean_tr(TR0 PASS_REGS); \ @@ -619,20 +615,26 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *InitialH = HR; CELL output = AbsPair(HR); + { + int lvl = push_text_stack(); while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { CELL *ptr = VarOfTerm(t); *ptr = TermFoundVar; TrailTerm(TR++) = t; - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + if ((tr_fr_ptr)LOCAL_TrailTop-TR < 1024) { + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) + { + pop_text_stack(lvl); goto trail_overflow; } } } inp = TailOfTerm(inp); } + pop_text_stack(lvl); +} WALK_COMPLEX_TERM(); @@ -648,6 +650,12 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ + while (to_visit > to_visit0) + { + to_visit--; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + } if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; } @@ -862,6 +870,12 @@ static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + while (to_visit > to_visit0) + { + to_visit--; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + } goto trail_overflow; } } @@ -1259,23 +1273,20 @@ static Term BREAK_LOOP(int ddep ) { return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("@^"), 1), 1, &t0); } -static Term UNFOLD_LOOP( Term t, Term *b, Term *l) { +static Term UNFOLD_LOOP( Term t, Term *b, Term l) { Term ti = Yap_MkNewApplTerm(FunctorEq, 2); RepAppl(ti)[2] = t; Term o = RepAppl(ti)[1]; HR[0] = ti; - HR[1] = *l; - l[0] = AbsPair(HR); - if (b!=NULL && *b==TermNil) - b = l; - l = HR+1; - + HR[1] = l; + *b = AbsPair(HR); + b = HR+1; HR+=2; return o; } -static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp, Term *endp USES_REGS) { +static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp, Term tail USES_REGS) { int lvl = push_text_stack(); struct non_single_struct_t *to_visit = Malloc( @@ -1308,7 +1319,7 @@ restart: // LIST0; struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(d0); if (listp) { - *ptd0 = UNFOLD_LOOP(AbsPair(headp), listp, endp); + *ptd0 = UNFOLD_LOOP(AbsPair(headp), listp, tail); } else { *ptd0 = BREAK_LOOP(to_visit-v0); } @@ -1320,8 +1331,8 @@ restart: to_visit->ptd0 = headp; to_visit->d0 = d0; *headp = MkAtomTerm((AtomEntry*)to_visit); - to_visit++; - pt0 = headp; + to_visit++; + pt0 = headp; pt0_end = pt0 + 1; ptd0 = pt0; goto list_loop; @@ -1335,23 +1346,21 @@ restart: if (IsAtomTerm((CELL)f)) { if (listp) { - *ptd0 = UNFOLD_LOOP(AbsAppl(ap2), listp, endp); + *ptd0 = UNFOLD_LOOP(AbsAppl(ap2), listp, tail); } else { *ptd0 = BREAK_LOOP(to_visit-(struct non_single_struct_t *)AtomOfTerm(*ap2)); } - goto restart; - } -// STRUCT0; - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->ptd0 = ap2; - to_visit->d0 = *ap2; + goto restart; } +// STRUCT0; + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->ptd0 = ap2; + to_visit->d0 = *ap2; *ap2 = MkAtomTerm((AtomEntry*)to_visit); - to_visit++; - + to_visit++; pt0 = ap2; pt0_end = ap2 + (ArityOfFunctor(f)); } @@ -1379,7 +1388,7 @@ restart: def_aux_overflow(); } -Term Yap_CheckLoops(Term inp, UInt arity, Term *listp, Term *endp USES_REGS) { +Term Yap_CheckCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) { Term t = Deref(inp); if (IsVarTerm(t) || IsPrimitiveTerm(t)) { @@ -1387,7 +1396,7 @@ Term Yap_CheckLoops(Term inp, UInt arity, Term *listp, Term *endp USES_REGS) { } else { Int res; - res = loops_in_complex_term((&t) - 1, &t, listp, endp PASS_REGS); + res = loops_in_complex_term((&t) - 1, &t, listp, tail PASS_REGS); if (res < 0) return -1; return t; @@ -1410,7 +1419,8 @@ static Int p_break_rational(USES_REGS1) { Term t = Yap_CopyTerm(Deref(ARG1)); Term l = Deref(ARG4), k; - return Yap_unify(Yap_CheckLoops(t, 4, &k, &l PASS_REGS), ARG2) && Yap_unify(k, ARG3); + if (IsVarTerm(l)) Yap_unify(l, MkVarTerm()); + return Yap_unify(Yap_CheckCycles(t, 4, &k, l PASS_REGS), ARG2) && Yap_unify(k, ARG3); } void Yap_InitTermCPreds(void) { diff --git a/C/write.c b/C/write.c index 6f5323374..82583dc9e 100644 --- a/C/write.c +++ b/C/write.c @@ -1080,39 +1080,22 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, /* write options */ { CACHE_REGS + + yhandle_t lvl = push_text_stack(); struct write_globs wglb; struct rewind_term rwt; - yhandle_t sls = Yap_CurrentSlot(); - int lvl = push_text_stack(); - - if (t == 0) - return; - if (!mywrite) { - CACHE_REGS - wglb.stream = GLOBAL_Stream + LOCAL_c_error_stream; - } else - wglb.stream = mywrite; - wglb.lw = start; - wglb.last_atom_minus = FALSE; - wglb.Quote_illegal = flags & Quote_illegal_f; - wglb.Handle_vars = flags & Handle_vars_f; - wglb.Use_portray = flags & Use_portray_f; - wglb.Portray_delays = flags & AttVar_Portray_f; - wglb.MaxDepth = max_depth; - wglb.MaxArgs = max_depth; - /* notice: we must have ASP well set when using portray, otherwise - we cannot make recursive Prolog calls */ - wglb.Keep_terms = (flags & (Use_portray_f | To_heap_f)); - /* initialize wglb */ rwt.parent = NULL; + wglb.stream = mywrite; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; - // if (!(flags & Ignore_cyclics_f) && false) - { - t = Yap_CheckLoops(t, 1, NULL, NULL PASS_REGS); - } - /* protect slots for portray */ - writeTerm(t, priority, 1, FALSE, &wglb, &rwt); + if (!(flags & Ignore_cyclics_f)) { + Term t1 = Yap_CopyTerm(t); + t1 = Yap_CheckCycles(t1, 1, NULL, TermNil PASS_REGS); + writeTerm(t1, priority, 1, false, &wglb, &rwt); + } else { + /* protect slots for portray */ + writeTerm(t, priority, 1, false, &wglb, &rwt); + } if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); @@ -1126,7 +1109,5 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, wrputc(' ', wglb.stream); } } - Yap_CloseSlots(sls); pop_text_stack(lvl); - } - + } diff --git a/H/Yapproto.h b/H/Yapproto.h index 6a2444a2f..72fee8930 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -445,7 +445,7 @@ bool Yap_isDirectory(const char *FileName); extern bool Yap_Exists(const char *f); /* terms.c */ -extern Term Yap_CheckLoops(Term inp, UInt arity, Term *listp, Term *endp USES_REGS); +extern Term Yap_CheckCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS); extern void Yap_InitTermCPreds(void); /* threads.c */ diff --git a/os/iopreds.c b/os/iopreds.c index dae2ecfd4..90e4c6d23 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -592,7 +592,7 @@ void Yap_DebugPlWriteln(Term t) { CACHE_REGS if (t == 0) fprintf(stderr, "NULL"); - Yap_plwrite(t, NULL, 15, 0, GLOBAL_MaxPriority); + Yap_plwrite(t, GLOBAL_Stream+LOCAL_c_error_stream , 0, 0, GLOBAL_MaxPriority); Yap_DebugPutc(GLOBAL_Stream[LOCAL_c_error_stream].file, '.'); Yap_DebugPutc(GLOBAL_Stream[LOCAL_c_error_stream].file, 10); } diff --git a/os/readterm.c b/os/readterm.c index 06bc2774a..4193725ee 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -389,7 +389,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool Yap_local.ActiveError->parserFile = RepAtom(AtomOfTerm((GLOBAL_Stream + sno)->user_name))->StrOfAE; Yap_local.ActiveError->parserReadingCode = code; - int lvl = push_text_stack(); + if (GLOBAL_Stream[sno].status & Seekable_Stream_f) { char *o, *o2; @@ -415,7 +415,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool o = malloc(sza); char *p = o; { - size_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file); + ssize_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file); if (siz < 0) Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno)); o[sza - 1] = '\0'; @@ -432,7 +432,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool o2 = malloc(sza); char *p = o2; { - size_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file); + ssize_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file); if (siz < 0) Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno)); @@ -498,7 +498,6 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool { fprintf(stderr, "SYNTAX ERROR while booting: "); } - pop_text_stack(lvl); return Yap_MkFullError(); } From 7045b6ef36e4a55c11112fd3203500efdbf56298 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 4 Feb 2019 01:08:18 +0000 Subject: [PATCH 029/101] cyclic_term/1 --- C/terms.c | 463 +++++++++++++++++++++++------------------ C/utilpreds.c | 337 +----------------------------- C/write.c | 6 +- H/Yapproto.h | 3 +- regression/cyclics.yap | 81 +++++-- 5 files changed, 339 insertions(+), 551 deletions(-) diff --git a/C/terms.c b/C/terms.c index 2dc49e363..6c55cb21f 100644 --- a/C/terms.c +++ b/C/terms.c @@ -158,10 +158,10 @@ typedef struct non_single_struct_t { if (to_visit + 32 >= to_visit_max) { \ goto aux_overflow; \ } \ - LIST0; \ ptd0 = RepPair(d0); \ + LIST0; \ if (*ptd0 == TermFreeTerm) \ - goto restart; \ + goto restart; \ to_visit->pt0 = pt0; \ to_visit->pt0_end = pt0_end; \ to_visit->ptd0 = ptd0; \ @@ -180,39 +180,38 @@ typedef struct non_single_struct_t { ap2 = RepAppl(d0); \ f = (Functor)(*ap2); \ \ - if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \ - \ - goto restart; \ - } \ - STRUCT0; \ if (to_visit + 32 >= to_visit_max) { \ goto aux_overflow; \ } \ + STRUCT0; \ + if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \ + \ + goto restart; \ + } \ to_visit->pt0 = pt0; \ to_visit->pt0_end = pt0_end; \ to_visit->ptd0 = ap2; \ - to_visit->d0 = (CELL)f; \ + to_visit->d0 = (CELL)f; \ to_visit++; \ \ *ap2 = TermNil; \ d0 = ArityOfFunctor(f); \ pt0 = ap2; \ pt0_end = ap2 + d0; \ - goto restart;\ - } else { \ - PRIMI0; \ - goto restart; } \ + goto restart; \ + } else { \ + PRIMI0; \ + goto restart; \ + } \ } \ derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); #define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {}) -#define END_WALK() \ -} +#define END_WALK() } - -#define def_aux_overflow() \ - aux_overflow : { \ +#define def_aux_overflow() \ + aux_overflow : { \ size_t d1 = to_visit - to_visit0; \ size_t d2 = to_visit_max - to_visit0; \ to_visit0 = \ @@ -220,13 +219,12 @@ typedef struct non_single_struct_t { to_visit = to_visit0 + d1; \ to_visit_max = to_visit0 + (d2 + 128); \ pt0--; \ - } \ + } \ goto restart; - #define def_trail_overflow() \ trail_overflow : { \ - pop_text_stack(lvl); \ + pop_text_stack(lvl); \ LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ clean_tr(TR0 PASS_REGS); \ @@ -249,6 +247,139 @@ typedef struct non_single_struct_t { return false; \ } +#define CYC_LIST \ + if (*ptd0 == TermFreeTerm) { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + return true; \ + } + +#define CYC_APPL \ + if (IsAtomTerm((CELL)f)) { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + return true; \ + } + +/** + @brief routine to locate all variables in a term, and its applications */ + +static Term cyclic_complex_term(register CELL *pt0, + register CELL *pt0_end USES_REGS) { + + WALK_COMPLEX_TERM__(CYC_LIST, CYC_APPL, {}); + /* leave an empty slot to fill in later */ + + END_WALK(); + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; + } + pop_text_stack(lvl); + + return false; + + def_aux_overflow(); +} + +bool Yap_IsCyclicTerm(Term t USES_REGS) { + + if (IsVarTerm(t)) { + return false; + } else if (IsPrimitiveTerm(t)) { + return false; + } else { + return cyclic_complex_term(&(t)-1, &(t)PASS_REGS); + } +} + +/** @pred cyclic_term( + _T_ ) + + + Succeeds if the graph representation of the term has loops. Say, + the representation of a term `X` that obeys the equation `X=[X]` + term has a loop from the list to its head. + + +*/ +static Int cyclic_term(USES_REGS1) /* cyclic_term(+T) */ +{ + return Yap_IsCyclicTerm(Deref(ARG1)); +} + +/** + @brief routine to locate all variables in a term, and its applications */ + +static bool ground_complex_term(register CELL *pt0, + register CELL *pt0_end USES_REGS) { + + WALK_COMPLEX_TERM(); + /* leave an empty slot to fill in later */ + while (to_visit > to_visit0) { + to_visit--; + + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + } + pop_text_stack(lvl); + return false; + + END_WALK(); + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; + } + pop_text_stack(lvl); + + return true; + + def_aux_overflow(); +} + +bool Yap_IsGroundTerm(Term t) { + CACHE_REGS + + if (IsVarTerm(t)) { + return false; + } else if (IsPrimitiveTerm(t)) { + return true; + } else { + return ground_complex_term(&(t)-1, &(t)PASS_REGS); + } +} + +/** @pred ground( _T_) is iso + + + Succeeds if there are no free variables in the term _T_. + + +*/ +static Int ground(USES_REGS1) /* ground(+T) */ +{ + return Yap_IsGroundTerm(Deref(ARG1)); +} + static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term v USES_REGS) { @@ -279,7 +410,6 @@ static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end, return false; def_aux_overflow(); - } static Int var_in_term(Term v, @@ -308,8 +438,8 @@ static Int variable_in_term(USES_REGS1) { } /** - @brief routine to locate all variables in a term, and its applications */ - + * @brief routine to locate all variables in a term, and its applications. + */ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { @@ -364,7 +494,6 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } else { return (inp); } - def_trail_overflow(); def_aux_overflow(); @@ -372,8 +501,14 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, def_global_overflow(); } -static Int -p_variables_in_term(USES_REGS1) /* variables in term t */ +/** + * @pred variables_in_term( +_T_, +_SetOfVariables_, +_ExtendedSetOfVariables_ ) + * + * _SetOfVariables_ must be a list of unbound variables. If so, + * _ExtendedSetOfVariables_ will include all te variables in the union + * of `vars(_T_)` and _SetOfVariables_. + */ +static Int variables_in_term(USES_REGS1) /* variables in term t */ { Term out, inp; int count; @@ -617,24 +752,23 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, { int lvl = push_text_stack(); - while (!IsVarTerm(inp) && IsPairTerm(inp)) { - Term t = HeadOfTerm(inp); - if (IsVarTerm(t)) { - CELL *ptr = VarOfTerm(t); - *ptr = TermFoundVar; - TrailTerm(TR++) = t; - if ((tr_fr_ptr)LOCAL_TrailTop-TR < 1024) { - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) - { - pop_text_stack(lvl); - goto trail_overflow; + while (!IsVarTerm(inp) && IsPairTerm(inp)) { + Term t = HeadOfTerm(inp); + if (IsVarTerm(t)) { + CELL *ptr = VarOfTerm(t); + *ptr = TermFoundVar; + TrailTerm(TR++) = t; + if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + pop_text_stack(lvl); + goto trail_overflow; + } } } + inp = TailOfTerm(inp); } - inp = TailOfTerm(inp); + pop_text_stack(lvl); } - pop_text_stack(lvl); -} WALK_COMPLEX_TERM(); @@ -650,8 +784,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - while (to_visit > to_visit0) - { + while (to_visit > to_visit0) { to_visit--; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; @@ -775,7 +908,6 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, return TermNil; } - def_aux_overflow(); def_global_overflow(); @@ -870,8 +1002,7 @@ static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - while (to_visit > to_visit0) - { + while (to_visit > to_visit0) { to_visit--; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; @@ -896,7 +1027,6 @@ static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, def_aux_overflow(); def_trail_overflow(); - } static Int @@ -995,7 +1125,6 @@ static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { } def_aux_overflow(); - } static Int p_non_singletons_in_term( @@ -1019,68 +1148,6 @@ static Int p_non_singletons_in_term( } } -static Int ground_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { - - WALK_COMPLEX_TERM(); - - /* found a variable */ - while (to_visit > to_visit0) { - to_visit--; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } - pop_text_stack(lvl); - return false; - END_WALK(); - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; - } - pop_text_stack(lvl); - return true; - - def_aux_overflow(); - - -} - -bool Yap_IsGroundTerm(Term t) { - CACHE_REGS - while (true) { - Int out; - - if (IsVarTerm(t)) { - return false; - } else if (IsPrimitiveTerm(t)) { - return true; - } else { - if ((out = ground_complex_term(&(t)-1, &(t)PASS_REGS)) >= 0) { - return out != 0; - } - if (out < 0) { - *HR++ = t; - - t = *--HR; - } - } - } -} - -/** @pred ground( _T_) is iso - - Succeeds if there are no free variables in the term _T_. -*/ -static Int p_ground(USES_REGS1) /* ground(+T) */ -{ - return Yap_IsGroundTerm(Deref(ARG1)); -} - static Term numbervar(Int id USES_REGS) { Term ts[1]; ts[0] = MkIntegerTerm(id); @@ -1101,7 +1168,7 @@ static void renumbervar(Term t, Int id USES_REGS) { #define RENUMBER_SINGLES \ if (singles && ap2 >= InitialH && ap2 < HR) { \ renumbervar(d0, numbv++ PASS_REGS); \ - goto restart; \ + goto restart; \ } static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, @@ -1155,7 +1222,6 @@ static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, def_global_overflow(); def_trail_overflow(); - } Int Yap_NumberVars(Term inp, Int numbv, @@ -1214,7 +1280,7 @@ static Int p_numbervars(USES_REGS1) { Int i; \ if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \ *maxp = i; \ - goto restart; \ + goto restart; \ } static int max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) { @@ -1236,7 +1302,6 @@ static int max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) { return 0; def_aux_overflow(); - } static Int MaxNumberedVar(Term inp, UInt arity PASS_REGS) { @@ -1257,40 +1322,39 @@ static Int MaxNumberedVar(Term inp, UInt arity PASS_REGS) { /** * @pred largest_numbervar( +_Term_, -Max) * - * Unify _Max_ with the largest integer _I_ such that `$VAR(I)` is a + * Unify _Max_ with the largest integer _I_ such that `$VAR(I)` is a * sub-term of _Term_. * * This built-in predicate is useful if part of a term has been grounded, and * now you want to ground the full term. */ -static Int largest_numbervar(USES_REGS1) -{ +static Int largest_numbervar(USES_REGS1) { return Yap_unify(MaxNumberedVar(Deref(ARG1), 2 PASS_REGS), ARG2); } -static Term BREAK_LOOP(int ddep ) { - Term t0 = MkIntegerTerm (ddep); +static Term BREAK_LOOP(int ddep) { + Term t0 = MkIntegerTerm(ddep); return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("@^"), 1), 1, &t0); } -static Term UNFOLD_LOOP( Term t, Term *b, Term l) { +static Term UNFOLD_LOOP(Term t, Term *b, Term l) { Term ti = Yap_MkNewApplTerm(FunctorEq, 2); RepAppl(ti)[2] = t; Term o = RepAppl(ti)[1]; HR[0] = ti; HR[1] = l; *b = AbsPair(HR); - b = HR+1; - HR+=2; + b = HR + 1; + HR += 2; return o; } - -static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp, Term tail USES_REGS) { +static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp, + Term tail USES_REGS) { int lvl = push_text_stack(); struct non_single_struct_t *to_visit = Malloc( - 1024 * sizeof(struct non_single_struct_t)), + 1024 * sizeof(struct non_single_struct_t)), *to_visit0 = to_visit, *to_visit_max = to_visit + 1024; @@ -1305,68 +1369,70 @@ restart: d0 = *ptd0; list_loop: deref_head(d0, vars_in_term_unk); - vars_in_term_nvar : - if (IsPairTerm(d0)) { - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - CELL *headp = RepPair(d0); - - d0 = headp[0]; - if (IsAtomTerm(d0) && - (CELL *)AtomOfTerm(d0) >= (CELL *)to_visit0 && - (CELL *)AtomOfTerm(d0) < (CELL *)to_visit_max) { - // LIST0; - struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(d0); - if (listp) { - *ptd0 = UNFOLD_LOOP(AbsPair(headp), listp, tail); - } else { - *ptd0 = BREAK_LOOP(to_visit-v0); + vars_in_term_nvar: + if (IsPairTerm(d0)) { + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; } + CELL *headp = RepPair(d0); - goto restart; - } - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->ptd0 = headp; - to_visit->d0 = d0; - *headp = MkAtomTerm((AtomEntry*)to_visit); - to_visit++; - pt0 = headp; - pt0_end = pt0 + 1; - ptd0 = pt0; - goto list_loop; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) continue; - if (IsAtomTerm((CELL)f)) { - - if (listp) { - *ptd0 = UNFOLD_LOOP(AbsAppl(ap2), listp, tail); - } else { - *ptd0 = BREAK_LOOP(to_visit-(struct non_single_struct_t *)AtomOfTerm(*ap2)); + d0 = headp[0]; + if (IsAtomTerm(d0) && (CELL *)AtomOfTerm(d0) >= (CELL *)to_visit0 && + (CELL *)AtomOfTerm(d0) < (CELL *)to_visit_max) { + // LIST0; + struct non_single_struct_t *v0 = + (struct non_single_struct_t *)AtomOfTerm(d0); + if (listp) { + *ptd0 = UNFOLD_LOOP(AbsPair(headp), listp, tail); + } else { + *ptd0 = BREAK_LOOP(to_visit - v0); + } + + goto restart; } - goto restart; } -// STRUCT0; - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->ptd0 = ap2; - to_visit->d0 = *ap2; - *ap2 = MkAtomTerm((AtomEntry*)to_visit); - to_visit++; - pt0 = ap2; - pt0_end = ap2 + (ArityOfFunctor(f)); - } + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->ptd0 = headp; + to_visit->d0 = d0; + *headp = MkAtomTerm((AtomEntry *)to_visit); + to_visit++; + pt0 = headp; + pt0_end = pt0 + 1; + ptd0 = pt0; + goto list_loop; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) + continue; + if (IsAtomTerm((CELL)f)) { + + if (listp) { + *ptd0 = UNFOLD_LOOP(AbsAppl(ap2), listp, tail); + } else { + *ptd0 = BREAK_LOOP(to_visit - + (struct non_single_struct_t *)AtomOfTerm(*ap2)); + } + goto restart; + } + // STRUCT0; + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->ptd0 = ap2; + to_visit->d0 = *ap2; + *ap2 = MkAtomTerm((AtomEntry *)to_visit); + to_visit++; + pt0 = ap2; + pt0_end = ap2 + (ArityOfFunctor(f)); + } goto restart; - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); goto restart; @@ -1379,7 +1445,7 @@ restart: pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; if (!IsVarTerm(*ptd0)) - *ptd0 = to_visit->d0; + *ptd0 = to_visit->d0; goto restart; } @@ -1388,7 +1454,7 @@ restart: def_aux_overflow(); } -Term Yap_CheckCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) { +Term Yap_BreakCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) { Term t = Deref(inp); if (IsVarTerm(t) || IsPrimitiveTerm(t)) { @@ -1396,38 +1462,38 @@ Term Yap_CheckCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) { } else { Int res; - res = loops_in_complex_term((&t) - 1, &t, listp, tail PASS_REGS); + res = loops_in_complex_term((&t) - 1, &t, listp, tail PASS_REGS); if (res < 0) return -1; return t; } } - - /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) +/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) - The term _TF_ is a forest representation (without cycles) for - the Prolog term _TI_. The term _TF_ is the main term. The - difference list _SubTerms_-_MoreSubterms_ stores terms of the - form _V=T_, where _V_ is a new variable occuring in _TF_, and - _T_ is a copy of a sub-term from _TI_. + The term _TF_ is a forest representation (without cycles) for + the Prolog term _TI_. The term _TF_ is the main term. The + difference list _SubTerms_-_MoreSubterms_ stores terms of the + form _V=T_, where _V_ is a new variable occuring in _TF_, and + _T_ is a copy of a sub-term from _TI_. - */ -static Int p_break_rational(USES_REGS1) -{ +*/ +static Int p_break_rational(USES_REGS1) { Term t = Yap_CopyTerm(Deref(ARG1)); Term l = Deref(ARG4), k; - if (IsVarTerm(l)) Yap_unify(l, MkVarTerm()); - return Yap_unify(Yap_CheckCycles(t, 4, &k, l PASS_REGS), ARG2) && Yap_unify(k, ARG3); + if (IsVarTerm(l)) + Yap_unify(l, MkVarTerm()); + return Yap_unify(Yap_BreakCycles(t, 4, &k, l PASS_REGS), ARG2) && + Yap_unify(k, ARG3); } void Yap_InitTermCPreds(void) { Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0); Yap_InitCPred("term_variables", 2, p_term_variables, 0); Yap_InitCPred("term_variables", 3, p_term_variables3, 0); - Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); + Yap_InitCPred("$variables_in_term", 3, variables_in_term, 0); Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); @@ -1441,7 +1507,8 @@ void Yap_InitTermCPreds(void) { Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); - Yap_InitCPred("ground", 1, p_ground, SafePredFlag); + Yap_InitCPred("ground", 1, ground, SafePredFlag); + Yap_InitCPred("cyclic_term", 1, cyclic_term, SafePredFlag); Yap_InitCPred("numbervars", 3, p_numbervars, 0); Yap_InitCPred("largest_numbervar", 2, largest_numbervar, 0); diff --git a/C/utilpreds.c b/C/utilpreds.c index 85a763466..6da178022 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -376,7 +376,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { /* if unbound, call the standard copy term routine */ struct cp_frame *bp; - CELL new; bp = to_visit; if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, @@ -384,7 +383,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, goto overflow; } to_visit = bp; - new = *ptf; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { @@ -1019,23 +1017,6 @@ Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) { } -static Int -p_break_rational( USES_REGS1 ) -{ - Term tf; - return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, ARG4 PASS_REGS)) && - Yap_unify(tf, ARG3); -} - - -static Int -p_break_rational3( USES_REGS1 ) -{ - Term tf; - return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, TermNil PASS_REGS)) && - Yap_unify(tf, ARG3); -} - /* FAST EXPORT ROUTINE. Export a Prolog term to something like: @@ -1602,167 +1583,6 @@ p_kill_exported_term( USES_REGS1 ) -static int -expand_vts( int args USES_REGS ) -{ - UInt expand = LOCAL_Error_Size; - yap_error_number yap_errno = LOCAL_Error_TYPE; - - LOCAL_Error_Size = 0; - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (yap_errno == RESOURCE_ERROR_TRAIL) { - /* Trail overflow */ - if (!Yap_growtrail(expand, FALSE)) { - return FALSE; - } - } else if (yap_errno == RESOURCE_ERROR_AUXILIARY_STACK) { - /* Aux space overflow */ - if (expand > 4*1024*1024) - expand = 4*1024*1024; - if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, TRUE)) { - return FALSE; - } - } else { - if (!Yap_gcl(expand, 3, ENV, gc_P(P,CP))) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_variables"); - return FALSE; - } - } - return TRUE; -} - - -static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) -{ - register CELL **to_visit0, - **to_visit = (CELL **)Yap_PreAllocCodeSpace(); - CELL *InitialH = HR; - - to_visit0 = to_visit; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; - } - - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; - } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; - } - - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - return TermNil; - - trail_overflow: - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - -} - - - static int SizeOfExtension(Term t) { @@ -1935,157 +1755,6 @@ Yap_SizeGroundTerm(Term t, int ground) } } -static Int var_in_complex_term(register CELL *pt0, - register CELL *pt0_end, - Term v USES_REGS) -{ - - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); - register tr_fr_ptr TR0 = TR; - - to_visit0 = to_visit; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, var_in_term_unk); - var_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - continue; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - - continue; - } - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; - } - - - deref_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); - if ((CELL)ptd0 == v) { /* we found it */ -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - return(TRUE); - } - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* next make sure noone will see this as a variable again */ - TrailTerm(TR++) = (CELL)ptd0; - } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; - } -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - return FALSE; - - - aux_overflow: - /* unwind stack */ -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - return -1; -} - -static Int -var_in_term(Term v, Term t USES_REGS) /* variables in term t */ -{ - - if (IsVarTerm(t)) { - return(v == t); - } else if (IsPrimitiveTerm(t)) { - return(FALSE); - } else if (IsPairTerm(t)) { - return(var_in_complex_term(RepPair(t)-1, - RepPair(t)+1,v PASS_REGS)); - } - else return(var_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(FunctorOfTerm(t)),v PASS_REGS)); -} - -static Int -p_var_in_term( USES_REGS1 ) -{ - return(var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS)); -} /* The code for TermHash was originally contributed by Gertjen Van Noor */ @@ -3351,6 +3020,7 @@ numbervar(Int id USES_REGS) return Yap_MkApplTerm(FunctorDollarVar, 1, ts); } +#if 0 static Term numbervar_singleton(USES_REGS1) { @@ -3365,10 +3035,7 @@ renumbervar(Term t, Int id USES_REGS) Term *ts = RepAppl(t); ts[1] = MkIntegerTerm(id); } - -extern int vsc; - -int vsc; +#endif static int unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share USES_REGS) diff --git a/C/write.c b/C/write.c index 82583dc9e..3da73070b 100644 --- a/C/write.c +++ b/C/write.c @@ -1088,10 +1088,8 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, wglb.stream = mywrite; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; - if (!(flags & Ignore_cyclics_f)) { - Term t1 = Yap_CopyTerm(t); - t1 = Yap_CheckCycles(t1, 1, NULL, TermNil PASS_REGS); - writeTerm(t1, priority, 1, false, &wglb, &rwt); + if (!(flags & Ignore_cyclics_f) && Yap_IsCyclicTerm(t)) { + writeTerm(Yap_BreakCycles(t, 1, NULL, TermNil PASS_REGS), priority, 1, false, &wglb, &rwt); } else { /* protect slots for portray */ writeTerm(t, priority, 1, false, &wglb, &rwt); diff --git a/H/Yapproto.h b/H/Yapproto.h index 72fee8930..43293b0d2 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -445,7 +445,8 @@ bool Yap_isDirectory(const char *FileName); extern bool Yap_Exists(const char *f); /* terms.c */ -extern Term Yap_CheckCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS); +extern bool Yap_IsCyclicTerm(Term inp USES_REGS); +extern Term Yap_BreakCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS); extern void Yap_InitTermCPreds(void); /* threads.c */ diff --git a/regression/cyclics.yap b/regression/cyclics.yap index cc04e8eb2..800d66d4c 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -1,13 +1,68 @@ -:- X = [], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X = [_A], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X = [a,_A], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X = [X], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X = [_|X], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X= f(X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X= f(X,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X= f(_,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X= f(A,A,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X= f(A,g(X,[A|A]),X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X= f(X,[X,X]), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X= f(X,[X,g(X)]), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- X=f(_,X/[X]),copy_term(X,Y), writeln('....'),writeln(X),writeln(Y). \ No newline at end of file +%, copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). + +:- initialization(main). + +main :- + main( cyclic_term(X), X). +main :- + writeln('-----------------------'), + fail. +main :- + main( ground(X), X). +main :- + writeln('-----------------------'), + fail. +main :- + main( writeln(X), X). +main. + +main(G, X) :- + d(X), + m(G). + +m( G ) :- + G, + !, + writeln(yes), + end. +m( G ) :- + writeln(no), + end. + +d(X) :- X = [_A]. +d(X) :- X = [a,_A]. +d(X) :- X = [X]. +d(X) :- X = [_|X]. +d(X) :- X = [_,X]. +d(X) :- X = [_,x]. +d(X) :- X = [_,x(X)]. +d(X) :- X= f(X). +d(X) :- X= f(X,X). +d(X) :- X= f(_,X). +d(X) :- X= f(A,A,X). +d(X) :- X= f(A,A,g(A)). +d(X) :- X= f(A,g(X,[A|A]),X). +d(X) :- X= f(X,[X,X]). +d(X) :- X= f(X,[X,g(X)]). +d(X) :- X= f(_,X/[X]). +d(X) :- X= f(_,A/[A]), A= f(X,[X,g(X)]). + +end :- writeln('....'), fail. + +a(no, no). +a(no, no). +a(yes, yes). +a(yes, no). +a(yes, no). +a( no, no). +a(yes, no). +a(yes, yes). +a(yes, yes). +a(yes, no). +a(yes, no). +a( no, no). +a(yes, no). +a(yes, yes). +a(yes, yes). +a(yes, no). +a(yes, no). From d874dc5857362b7a20015f4814508d5e9432a5a2 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 4 Feb 2019 10:42:23 +0000 Subject: [PATCH 030/101] fixes --- C/terms.c | 61 +++--- C/utilpreds.c | 427 ----------------------------------------- C/write.c | 10 +- include/YapStreams.h | 2 +- os/writeterm.c | 5 +- regression/cyclics.yap | 5 + 6 files changed, 53 insertions(+), 457 deletions(-) diff --git a/C/terms.c b/C/terms.c index 6c55cb21f..6d20c3b0f 100644 --- a/C/terms.c +++ b/C/terms.c @@ -133,7 +133,7 @@ typedef struct { typedef struct non_single_struct_t { CELL *ptd0; CELL d0; - CELL *pt0, *pt0_end; + CELL *pt0, *pt0_end, *ptf; } non_singletons_t; #define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \ @@ -224,11 +224,11 @@ typedef struct non_single_struct_t { #define def_trail_overflow() \ trail_overflow : { \ - pop_text_stack(lvl); \ LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ clean_tr(TR0 PASS_REGS); \ HR = InitialH; \ + pop_text_stack(lvl); \ return 0L; \ } @@ -760,7 +760,6 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, TrailTerm(TR++) = t; if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - pop_text_stack(lvl); goto trail_overflow; } } @@ -812,7 +811,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, HR[-1] = TermNil; return output; } else { - return TermNil; + return 0; } def_aux_overflow(); @@ -1349,7 +1348,8 @@ static Term UNFOLD_LOOP(Term t, Term *b, Term l) { return o; } -static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp, +static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, + Term *listp, Term tail USES_REGS) { int lvl = push_text_stack(); @@ -1360,6 +1360,7 @@ static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp, to_visit0 = to_visit; to_visit_max = to_visit0 + 1024; + CELL *ptf = HR-1; restart: while (pt0 < pt0_end) { CELL d0; @@ -1375,7 +1376,6 @@ restart: goto aux_overflow; } CELL *headp = RepPair(d0); - d0 = headp[0]; if (IsAtomTerm(d0) && (CELL *)AtomOfTerm(d0) >= (CELL *)to_visit0 && (CELL *)AtomOfTerm(d0) < (CELL *)to_visit_max) { @@ -1383,22 +1383,26 @@ restart: struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(d0); if (listp) { - *ptd0 = UNFOLD_LOOP(AbsPair(headp), listp, tail); + *ptf = UNFOLD_LOOP(AbsPair(v0->ptf-1), listp, tail); + ptf++; } else { - *ptd0 = BREAK_LOOP(to_visit - v0); + *ptf++ = BREAK_LOOP(to_visit - v0); } - - goto restart; + continue; } + *ptf++ = AbsPair(HR); to_visit->pt0 = pt0; to_visit->pt0_end = pt0_end; to_visit->ptd0 = headp; + to_visit->ptf = ptf; to_visit->d0 = d0; *headp = MkAtomTerm((AtomEntry *)to_visit); to_visit++; pt0 = headp; pt0_end = pt0 + 1; ptd0 = pt0; + ptf = HR; + HR+=2; goto list_loop; } else if (IsApplTerm(d0)) { register Functor f; @@ -1406,35 +1410,44 @@ restart: /* store the terms to visit */ ap2 = RepAppl(d0); f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) + if (IsExtensionFunctor(f)) { + *ptf++ = d0; continue; + } if (IsAtomTerm((CELL)f)) { - + struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(*ap2); if (listp) { - *ptd0 = UNFOLD_LOOP(AbsAppl(ap2), listp, tail); + *ptf = UNFOLD_LOOP(AbsAppl(v0->ptf-1), listp, tail); + ptf++; } else { - *ptd0 = BREAK_LOOP(to_visit - - (struct non_single_struct_t *)AtomOfTerm(*ap2)); + *ptf++ = BREAK_LOOP(to_visit - v0); } - goto restart; + continue; } // STRUCT0; if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; to_visit->pt0 = pt0; to_visit->pt0_end = pt0_end; to_visit->ptd0 = ap2; to_visit->d0 = *ap2; + to_visit->ptf = ptf; *ap2 = MkAtomTerm((AtomEntry *)to_visit); to_visit++; pt0 = ap2; pt0_end = ap2 + (ArityOfFunctor(f)); + ptf = HR+1; + HR = ptf +ArityOfFunctor(f); + } else { + *ptf++ = d0; } goto restart; derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - + *ptf++ = d0; goto restart; } /* Do we still have compound terms to visit */ @@ -1442,10 +1455,10 @@ restart: to_visit--; pt0 = to_visit->pt0; + ptf = to_visit->ptf; pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; - if (!IsVarTerm(*ptd0)) - *ptd0 = to_visit->d0; + *ptd0 = to_visit->d0; goto restart; } @@ -1461,11 +1474,15 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) { return t; } else { Int res; - + CELL *op = HR; + HR++; res = loops_in_complex_term((&t) - 1, &t, listp, tail PASS_REGS); if (res < 0) return -1; - return t; + if (IsPairTerm(t)) + return AbsPair(op); + else + return AbsAppl(op); } } @@ -1481,7 +1498,7 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) { */ static Int p_break_rational(USES_REGS1) { - Term t = Yap_CopyTerm(Deref(ARG1)); + Term t = (ARG1); Term l = Deref(ARG4), k; if (IsVarTerm(l)) Yap_unify(l, MkVarTerm()); diff --git a/C/utilpreds.c b/C/utilpreds.c index 6da178022..092ea2ced 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -590,433 +590,6 @@ add_to_list( Term inp, Term v, Term t PASS_REGS) } -static int -break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Term vin,CELL *HLow USES_REGS) -{ - - struct bp_frame *to_visit0, *to_visit = (struct bp_frame *)Yap_PreAllocCodeSpace() ; - CELL *HB0 = HB; - tr_fr_ptr TR0 = TR; - - HB = HR; - to_visit0 = to_visit; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, copy_term_unk); - copy_term_nvar: - { - if (IsPairTerm(d0)) { - CELL *headp = RepPair(d0); - //fprintf(stderr, "%d \n", RepPair(headp[0])- ptf); - if (IsVarTerm(headp[0]) && IN_BETWEEN(HB, (headp[0]),HR)) { - Term v = MkVarTerm(); - *ptf = v; - vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) ); - ptf++; - continue; - } - if (to_visit+1 >= (struct bp_frame *)AuxSp) { - goto heap_overflow; - } - *ptf++ = (CELL)(HR); - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldp = headp; - d0 = to_visit->oldv = headp[0]; - /* fool the system into thinking we had a variable there */ - to_visit ++; - pt0 = headp; - pt0_end = headp + 1; - ptf = HR; - *headp = AbsPair(HR); - HR += 2; - if (HR > ASP - 2048) { - goto overflow; - } - if (IsVarTerm(d0) && d0 == (CELL)headp) { - RESET_VARIABLE(ptf); - ptf++; - continue; - } - d0 = Deref(d0); - if (!IsVarTerm(d0)) { - goto copy_term_nvar; - } else { - *ptf++ = d0; - } - continue; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *headp; - /* store the terms to visit */ - headp = RepAppl(d0)+1; - f = (Functor)(headp[-1]); - if (IsExtensionFunctor(f)) { - *ptf++ = d0; /* you can just copy other extensions. */ - continue; - } - if (IsApplTerm(headp[0]) && IN_BETWEEN(HB, RepAppl(headp[0]),HR)) { - RESET_VARIABLE(ptf); - vin = add_to_list(vin, (CELL)ptf, headp[0] ); - ptf++; - continue; - } - - arity_t arity = ArityOfFunctor(f); - if (to_visit+1 >= (struct bp_frame *)AuxSp) { - goto heap_overflow; - } - *ptf++ = AbsAppl(HR); - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldp = headp; - d0 = to_visit->oldv = headp[0]; - /* fool the system into thinking we had a variable there */ - to_visit ++; - pt0 = headp; - pt0_end = headp + (arity-1); - ptf = HR; - if (HR > ASP - 2048) { - goto overflow; - } - *ptf++ =(CELL)f; - *headp = AbsAppl(HR); - HR += (arity+1); - d0 = Deref(d0); - if (!IsVarTerm(d0)) { - goto copy_term_nvar; - } else { - *ptf++ = d0; - } - continue; - } else { - /* just copy atoms or integers */ - *ptf++ = d0; - } - continue; - } - - derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - *ptf++ = (CELL) ptd0; - } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit --; - *to_visit->oldp = to_visit->oldv; - ptf = to_visit->to; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - goto loop; - } - - /* restore our nice, friendly, term to its original state */ - HB = HB0; - *vout = vin; - return true; - - overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - *to_visit->oldp = to_visit->oldv; - } -#endif - reset_trail(TR0); - /* follow chain of multi-assigned variables */ - return -1; - - heap_overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - *to_visit->oldp = to_visit->oldv; - } -#endif - reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; - return -3; -} - - -Term -Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { - Term t = Deref(inp); - Term tii = ti; - tr_fr_ptr TR0 = TR; - - if (IsVarTerm(t)) { - *to = ti; - return t; - } else if (IsPrimitiveTerm(t)) { - *to = ti; - return t; - } else if (IsPairTerm(t)) { - CELL *ap; - CELL *Hi; - - restart_list: - ap = RepPair(t); - Hi = HR; - HR += 2; - { - Int res; - if ((res = break_rationals_complex_term(ap-1, ap+1, Hi, to, ti, Hi PASS_REGS)) < 0) { - HR = Hi; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_list; - } else if (*to == tii) { - HR = Hi; - return t; - } else { - return AbsPair(Hi); - } - } - } else { - Functor f; - CELL *HB0; - CELL *ap; - - restart_appl: - f = FunctorOfTerm(t); - if (IsExtensionFunctor(f)) { - *to = ti; - return t; - } - HB0 = HR; - ap = RepAppl(t); - HR[0] = (CELL)f; - arity = ArityOfFunctor(f); - HR += 1+arity; - - { - Int res; - if ((res = break_rationals_complex_term(ap, ap+(arity), HB0+1, to, ti, HB0 PASS_REGS)) < 0) { - HR = HB0; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_appl; - } else if (*to == ti) { - HR = HB0; - return t; - } else { - return AbsAppl(HB0); - } - } - } -} - -static int -break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS) -{ - - struct copy_frame *to_visit0, *to_visit = (struct copy_frame *)Yap_PreAllocCodeSpace(); - CELL *HB0 = HB; - tr_fr_ptr TR0 = TR; - CELL new = 0L; - - HB = HLow; - to_visit0 = to_visit; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - if (new) { - /* mark cell as pointing to new copy */ - /* we can only mark after reading the value of the first argument */ - TrailedMaBind(pt0, new); - new = 0L; - } - deref_head(d0, break_rationals_unk); - break_rationals_nvar: - { - CELL first; - CELL *newp; - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - - if (IsVarTerm(first = *ap2) && (newp = (CELL*)first) && newp >= HB && newp < HR) { - // found a marked term: - found_term: - if (!IsVarTerm(*newp)) { - Term v = (CELL)newp, t = *newp; - RESET_VARIABLE(newp); - oi = add_to_list( oi, v, t PASS_REGS); - } - *ptf++ = (CELL)newp; - continue; - } - new = (CELL)ptf; - *ptf++ = AbsPair(HR); - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct copy_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit ++; - } - pt0 = ap2 - 1; - pt0_end = ap2 + 1; - ptf = HR; - HR += 2; - if (HR > ASP - 2048) { - goto overflow; - } - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - *ptf++ = d0; /* you can just share extensions, what about DB? */ - continue; - } - if (IsVarTerm(first = ap2[1]) && (newp = (CELL*)first) && newp >= HB && newp < HR) { - goto found_term; - } - // new - /* store the terms to visit */ - new = (CELL)ptf; - *ptf++ = AbsAppl(HR); - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct copy_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit ++; - } - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - HR[0] = (CELL)f; - ptf = HR+1; - HR += 1+d0; - if (HR > ASP - 2048) { - goto overflow; - } - } else { - /* just copy atoms or integers */ - *ptf++ = d0; - } - continue; - } - - derefa_body(d0, ptd0, break_rationals_unk, break_rationals_nvar); - *ptf++ = d0; - } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - goto loop; - } - - /* restore our nice, friendly, term to its original state */ - HB = HB0; - reset_trail(TR0); - *of = oi; - return TRUE; - - overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - } - reset_trail(TR0); - /* follow chain of multi-assigned variables */ - return -1; - - heap_overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - } - reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; - return -3; -} - -Term -Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) { - Term t = Deref(inp); - tr_fr_ptr TR0 = TR; - - if (IsVarTerm(t)) { - *to = ti; - return t; - } else if (IsPrimitiveTerm(t)) { - *to = ti; - return t; - } else { - CELL *ap; - CELL *Hi = HR; - - restart_term: - ap = &t; - Hi = HR++; - { - int res; - - if ((res = break_complex_term(ap-1, ap, Hi, to, ti, Hi PASS_REGS)) < 0) { - HR = Hi; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_term; - } - } - return Hi[0]; - } -} - - /* FAST EXPORT ROUTINE. Export a Prolog term to something like: diff --git a/C/write.c b/C/write.c index 3da73070b..edd6a0717 100644 --- a/C/write.c +++ b/C/write.c @@ -1084,16 +1084,16 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, yhandle_t lvl = push_text_stack(); struct write_globs wglb; struct rewind_term rwt; + t = Deref(t); rwt.parent = NULL; wglb.stream = mywrite; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; - if (!(flags & Ignore_cyclics_f) && Yap_IsCyclicTerm(t)) { - writeTerm(Yap_BreakCycles(t, 1, NULL, TermNil PASS_REGS), priority, 1, false, &wglb, &rwt); - } else { - /* protect slots for portray */ - writeTerm(t, priority, 1, false, &wglb, &rwt); + if ((flags & Handle_cyclics_f) && Yap_IsCyclicTerm(t) ){ + t = Yap_BreakCycles(t, 3, NULL, TermNil PASS_REGS); } + /* protect slots for portray */ + writeTerm(t, priority, 1, false, &wglb, &rwt); if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); diff --git a/include/YapStreams.h b/include/YapStreams.h index 4eff718b6..2d69fc1a8 100644 --- a/include/YapStreams.h +++ b/include/YapStreams.h @@ -194,7 +194,7 @@ typedef enum { /* we accept two domains for the moment, IPV6 may follow */ #define Handle_vars_f 0x04 #define Use_portray_f 0x08 #define To_heap_f 0x10 -#define Ignore_cyclics_f 0x20 +#define Handle_cyclics_f 0x20 #define Use_SWI_Stream_f 0x40 #define BackQuote_String_f 0x80 #define AttVar_None_f 0x100 diff --git a/os/writeterm.c b/os/writeterm.c index b55b96c63..ce96bf572 100644 --- a/os/writeterm.c +++ b/os/writeterm.c @@ -231,8 +231,9 @@ static bool write_term(int output_stream, Term t, xarg *args USES_REGS) { goto end; } } - if (args[WRITE_CYCLES].used && args[WRITE_CYCLES].tvalue == TermFalse) { - flags |= Ignore_cyclics_f; + if (!args[WRITE_CYCLES].used || (args[WRITE_CYCLES].used + && args[WRITE_CYCLES].tvalue == TermTrue)) { + flags |= Handle_cyclics_f; } if (args[WRITE_QUOTED].used && args[WRITE_QUOTED].tvalue == TermTrue) { flags |= Quote_illegal_f; diff --git a/regression/cyclics.yap b/regression/cyclics.yap index 800d66d4c..4c2ba4d59 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -14,6 +14,11 @@ main :- fail. main :- main( writeln(X), X). +main :- + writeln('-----------------------'), + fail. +main :- + main((rational_term_to_tree(X,A,B,[]),writeln(A:B)), X). main. main(G, X) :- From cb4d17cb4f81d5918534660acb1ee0ff67de5281 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 4 Feb 2019 15:10:06 +0000 Subject: [PATCH 031/101] deb --- C/terms.c | 49 ++++++++++++++++++------------------------ pl/ground.yap | 30 +------------------------- regression/cyclics.yap | 5 ++++- 3 files changed, 26 insertions(+), 58 deletions(-) diff --git a/C/terms.c b/C/terms.c index 6d20c3b0f..ffce8443d 100644 --- a/C/terms.c +++ b/C/terms.c @@ -169,9 +169,8 @@ typedef struct non_single_struct_t { to_visit++; \ d0 = ptd0[0]; \ pt0 = ptd0; \ - *ptd0 = TermFreeTerm; \ + *pt0 = TermFreeTerm; \ pt0_end = pt0 + 1; \ - if (pt0 <= pt0_end) \ goto list_loop; \ } else if (IsApplTerm(d0)) { \ register Functor f; \ @@ -651,7 +650,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; - CELL output = AbsPair(HR); + CELL output = inp; WALK_COMPLEX_TERM(); @@ -664,9 +663,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, if (HR + 1024 > ASP) { goto global_overflow; } - HR[1] = AbsPair(HR + 2); - HR += 2; - HR[-2] = (CELL) & (a0->Done); + output = MkPairTerm( (CELL) & (a0->Done), output); /* store the terms to visit */ if (to_visit + 32 >= to_visit_max) { goto aux_overflow; @@ -704,10 +701,9 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } else { HR[-1] = t2; /* don't need to trail */ } - return (output); - } else { - return (inp); + } + return (output); def_aux_overflow(); def_global_overflow(); @@ -1179,7 +1175,7 @@ static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, WALK_COMPLEX_TERM__({}, RENUMBER_SINGLES, {}); /* do or pt2 are unbound */ - if (singles) + if (singles||false) *ptd0 = numbervar_singleton(PASS_REGS1); else *ptd0 = numbervar(numbv++ PASS_REGS); @@ -1336,15 +1332,13 @@ static Term BREAK_LOOP(int ddep) { return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("@^"), 1), 1, &t0); } -static Term UNFOLD_LOOP(Term t, Term *b, Term l) { - Term ti = Yap_MkNewApplTerm(FunctorEq, 2); - RepAppl(ti)[2] = t; - Term o = RepAppl(ti)[1]; - HR[0] = ti; - HR[1] = l; - *b = AbsPair(HR); - b = HR + 1; - HR += 2; +static Term UNFOLD_LOOP(Term t, Term *b) { + Term os[2], o; + os[0] = o = MkVarTerm(); + os[1] = t; + Term ti = Yap_MkApplTerm(FunctorEq, 2, os); + *b = MkPairTerm(ti, *b); + return o; } @@ -1358,13 +1352,13 @@ static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, *to_visit0 = to_visit, *to_visit_max = to_visit + 1024; - to_visit0 = to_visit; - to_visit_max = to_visit0 + 1024; - CELL *ptf = HR-1; + CELL *ptf = HR; + CELL *ptd0; + if (listp) + *listp = tail; restart: while (pt0 < pt0_end) { CELL d0; - CELL *ptd0; ++pt0; ptd0 = pt0; d0 = *ptd0; @@ -1383,7 +1377,7 @@ restart: struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(d0); if (listp) { - *ptf = UNFOLD_LOOP(AbsPair(v0->ptf-1), listp, tail); + *ptf = UNFOLD_LOOP(AbsPair(v0->ptf-1), listp); ptf++; } else { *ptf++ = BREAK_LOOP(to_visit - v0); @@ -1417,7 +1411,7 @@ restart: if (IsAtomTerm((CELL)f)) { struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(*ap2); if (listp) { - *ptf = UNFOLD_LOOP(AbsAppl(v0->ptf-1), listp, tail); + *ptf = UNFOLD_LOOP(AbsAppl(v0->ptf-1), listp); ptf++; } else { *ptf++ = BREAK_LOOP(to_visit - v0); @@ -1429,7 +1423,6 @@ restart: goto aux_overflow; } *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; to_visit->pt0 = pt0; to_visit->pt0_end = pt0_end; to_visit->ptd0 = ap2; @@ -1439,6 +1432,7 @@ restart: to_visit++; pt0 = ap2; pt0_end = ap2 + (ArityOfFunctor(f)); + HR[0] = (CELL)f; ptf = HR+1; HR = ptf +ArityOfFunctor(f); } else { @@ -1457,7 +1451,7 @@ restart: pt0 = to_visit->pt0; ptf = to_visit->ptf; pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; + ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; goto restart; } @@ -1475,7 +1469,6 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) { } else { Int res; CELL *op = HR; - HR++; res = loops_in_complex_term((&t) - 1, &t, listp, tail PASS_REGS); if (res < 0) return -1; diff --git a/pl/ground.yap b/pl/ground.yap index 43f40aa9a..05ece7469 100644 --- a/pl/ground.yap +++ b/pl/ground.yap @@ -33,35 +33,7 @@ /* % grounds all free variables % as terms of the form '$VAR'(N) - -numbervars('$VAR'(M), M, N) :- !, - succ(M, N). -numbervars(Atomic, M, M) :- - atomic(Atomic), !. -numbervars(Term, M, N) :- - functor(Term, _, Arity), - '$numbervars'(0,Arity, Term, M, N). - -'$numbervars'(A, A, _, N, N) :- !. -'$numbervars'(A,Arity, Term, M, N) :- - '$succ'(A,An), - arg(An, Term, Arg), - numbervars(Arg, M, K), !, - '$numbervars'(An, Arity, Term, K, N). - - -ground(Term) :- - nonvar(Term), % This term is not a variable, - functor(Term, _, Arity), - '$ground'(Arity, Term). % and none of its arguments are. - -'$ground'(0, _) :- !. -'$ground'(N, Term) :- - '$predc'(N,M), - arg(N, Term, ArgN), - ground(ArgN), - '$ground'(M, Term). - +*/ numbervars(Term, M, N) :- '$variables_in_term'(Term, [], L), '$numbermarked_vars'(L, M, N). diff --git a/regression/cyclics.yap b/regression/cyclics.yap index 4c2ba4d59..bd7baa290 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -18,7 +18,8 @@ main :- writeln('-----------------------'), fail. main :- - main((rational_term_to_tree(X,A,B,[]),writeln(A:B)), X). + main((rational_term_to_tree(X,A,B,[]), numbervars(A+B,1,_), + writeln((A->B))), X). main. main(G, X) :- @@ -51,6 +52,8 @@ d(X) :- X= f(X,[X,X]). d(X) :- X= f(X,[X,g(X)]). d(X) :- X= f(_,X/[X]). d(X) :- X= f(_,A/[A]), A= f(X,[X,g(X)]). +d(X) :- X= f(_,A/[A]), A= f(X,[A,g(X)]). +d(X) :- X= f(_,A/[A]), A= f(B,[X,g(A)]), B=[C|B], C=[X]. end :- writeln('....'), fail. From 3b8475f882022e09aca8ee351fe02afd3cc66d1a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 4 Feb 2019 22:10:30 +0000 Subject: [PATCH 032/101] ptd0 --- C/terms.c | 93 +++++++++++++++++++++------------------------ C/tracer.c | 2 +- H/YapCompoundTerm.h | 15 ++++++++ 3 files changed, 60 insertions(+), 50 deletions(-) diff --git a/C/terms.c b/C/terms.c index ffce8443d..a51af41c2 100644 --- a/C/terms.c +++ b/C/terms.c @@ -164,20 +164,20 @@ typedef struct non_single_struct_t { goto restart; \ to_visit->pt0 = pt0; \ to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ + to_visit->ptd0 = ptd0; \ to_visit->d0 = *ptd0; \ to_visit++; \ d0 = ptd0[0]; \ + *ptd0 = TermFreeTerm; \ pt0 = ptd0; \ - *pt0 = TermFreeTerm; \ pt0_end = pt0 + 1; \ goto list_loop; \ } else if (IsApplTerm(d0)) { \ register Functor f; \ register CELL *ap2; \ /* store the terms to visit */ \ - ap2 = RepAppl(d0); \ - f = (Functor)(*ap2); \ + ptd0 = RepAppl(d0); \ + f = (Functor)(d0 = *ptd0); \ \ if (to_visit + 32 >= to_visit_max) { \ goto aux_overflow; \ @@ -189,14 +189,14 @@ typedef struct non_single_struct_t { } \ to_visit->pt0 = pt0; \ to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ap2; \ - to_visit->d0 = (CELL)f; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = d0; \ to_visit++; \ \ - *ap2 = TermNil; \ - d0 = ArityOfFunctor(f); \ - pt0 = ap2; \ - pt0_end = ap2 + d0; \ + *ptd0 = TermNil; \ + Term d1 = ArityOfFunctor(f); \ + pt0 = ptd0; \ + pt0_end = ptd0 + d1; \ goto restart; \ } else { \ PRIMI0; \ @@ -468,9 +468,9 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->pt0; + to_visit--; + pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; @@ -1089,13 +1089,12 @@ p_free_variables_in_term(USES_REGS1) /* variables within term t */ static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { tr_fr_ptr TR0 = TR; CELL *InitialH = HR; + HB = (CELL *)ASP; CELL output = AbsPair(HR); WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; - /* next make sure we can recover the variable again */ - TrailTerm(TR++) = (CELL)ptd0; + YapBind(ptd0,TermFoundVar); END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { @@ -1111,6 +1110,7 @@ static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); + HB = (CELL*)B->cp_b; if (HR != InitialH) { /* close the list */ HR[-1] = Deref(ARG2); @@ -1161,7 +1161,7 @@ static void renumbervar(Term t, Int id USES_REGS) { } #define RENUMBER_SINGLES \ - if (singles && ap2 >= InitialH && ap2 < HR) { \ + if (singles ) { \ renumbervar(d0, numbv++ PASS_REGS); \ goto restart; \ } @@ -1174,42 +1174,37 @@ static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, WALK_COMPLEX_TERM__({}, RENUMBER_SINGLES, {}); + if (IsAttVar(pt0)) + continue; /* do or pt2 are unbound */ - if (singles||false) - *ptd0 = numbervar_singleton(PASS_REGS1); + if (singles) + d0 = numbervar_singleton(PASS_REGS1); else - *ptd0 = numbervar(numbv++ PASS_REGS); + d0 = numbervar(numbv++ PASS_REGS); /* leave an empty slot to fill in later */ if (HR + 1024 > ASP) { goto global_overflow; } /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - goto trail_overflow; - } - } - -#if defined(TABLING) || defined(YAPOR_SBA) - TrailVal(TR) = (CELL)ptd0; -#endif - TrailTerm(TR++) = (CELL)ptd0; + YapBind(ptd0, d0); + continue; + END_WALK(); /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { + while (to_visit > to_visit0) { to_visit--; pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; + if (pt0 >= pt0_end) + continue; goto restart; } - prune(B PASS_REGS); pop_text_stack(lvl); return numbv; @@ -1369,14 +1364,14 @@ restart: if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } - CELL *headp = RepPair(d0); - d0 = headp[0]; + CELL *ptd0 = RepPair(d0); + d0 = ptd0[0]; if (IsAtomTerm(d0) && (CELL *)AtomOfTerm(d0) >= (CELL *)to_visit0 && - (CELL *)AtomOfTerm(d0) < (CELL *)to_visit_max) { + (CELL *)AtomOfTerm(d0) < (CELL *)to_visit) { // LIST0; struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(d0); - if (listp) { + if (listp) { *ptf = UNFOLD_LOOP(AbsPair(v0->ptf-1), listp); ptf++; } else { @@ -1387,12 +1382,12 @@ restart: *ptf++ = AbsPair(HR); to_visit->pt0 = pt0; to_visit->pt0_end = pt0_end; - to_visit->ptd0 = headp; + to_visit->ptd0 = ptd0; to_visit->ptf = ptf; - to_visit->d0 = d0; - *headp = MkAtomTerm((AtomEntry *)to_visit); + to_visit->d0 = d0 = *ptd0; + *ptd0 = MkAtomTerm((AtomEntry *)to_visit); to_visit++; - pt0 = headp; + pt0 = ptd0; pt0_end = pt0 + 1; ptd0 = pt0; ptf = HR; @@ -1400,16 +1395,16 @@ restart: goto list_loop; } else if (IsApplTerm(d0)) { register Functor f; - register CELL *ap2; + /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); + ptd0 = RepAppl(d0); + f = (Functor)(*ptd0); if (IsExtensionFunctor(f)) { *ptf++ = d0; continue; } if (IsAtomTerm((CELL)f)) { - struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(*ap2); + struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(*ptd0); if (listp) { *ptf = UNFOLD_LOOP(AbsAppl(v0->ptf-1), listp); ptf++; @@ -1425,13 +1420,13 @@ restart: *ptf++ = AbsAppl(HR); to_visit->pt0 = pt0; to_visit->pt0_end = pt0_end; - to_visit->ptd0 = ap2; - to_visit->d0 = *ap2; + to_visit->ptd0 = ptd0; + to_visit->d0 = *ptd0; to_visit->ptf = ptf; - *ap2 = MkAtomTerm((AtomEntry *)to_visit); + *ptd0 = MkAtomTerm((AtomEntry *)to_visit); to_visit++; - pt0 = ap2; - pt0_end = ap2 + (ArityOfFunctor(f)); + pt0 = ptd0; + pt0_end = ptd0 + (ArityOfFunctor(f)); HR[0] = (CELL)f; ptf = HR+1; HR = ptf +ArityOfFunctor(f); diff --git a/C/tracer.c b/C/tracer.c index 31ac498a4..ec07e6b74 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -88,7 +88,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity, } } const char *sn = Yap_TermToBuffer(args[i], - Quote_illegal_f | Handle_vars_f); + Handle_cyclics_f|Quote_illegal_f | Handle_vars_f); size_t sz; if (sn == NULL) { sn = malloc(strlen("<* error *>")+1); diff --git a/H/YapCompoundTerm.h b/H/YapCompoundTerm.h index 6aaf2e9e1..919493045 100644 --- a/H/YapCompoundTerm.h +++ b/H/YapCompoundTerm.h @@ -54,6 +54,21 @@ restart: goto restart; } } +INLINE_ONLY Term *pDerefa(CELL *b); + +INLINE_ONLY Term *pDerefa(CELL *b) { + Term a = *b; +restart: + if (!IsVarTerm(a)) { + return b; + } else if (a == (CELL)b) { + return b; + } else { + b = (CELL *)a; + a = *b; + goto restart; + } +} INLINE_ONLY Term ArgOfTerm(int i, Term t); From 4bc0292ad6bec0ca49620bed234a9b8cad660b5f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 5 Feb 2019 10:31:17 +0000 Subject: [PATCH 033/101] fixes --- C/terms.c | 89 ++++++++++++++++++------------------------ pl/ground.yap | 2 +- regression/cyclics.yap | 20 +++++++++- 3 files changed, 58 insertions(+), 53 deletions(-) diff --git a/C/terms.c b/C/terms.c index a51af41c2..c99d1a1e3 100644 --- a/C/terms.c +++ b/C/terms.c @@ -34,6 +34,10 @@ #include "string.h" #endif +#define Malloc malloc +#define Realloc realloc + + static int expand_vts(int args USES_REGS) { UInt expand = LOCAL_Error_Size; yap_error_number yap_errno = LOCAL_Error_TYPE; @@ -149,7 +153,7 @@ typedef struct non_single_struct_t { register CELL d0; \ register CELL *ptd0; \ ++pt0; \ - ptd0 = pt0; \ + ptd0 = pt0; \ d0 = *ptd0; \ list_loop: \ deref_head(d0, var_in_term_unk); \ @@ -174,7 +178,6 @@ typedef struct non_single_struct_t { goto list_loop; \ } else if (IsApplTerm(d0)) { \ register Functor f; \ - register CELL *ap2; \ /* store the terms to visit */ \ ptd0 = RepAppl(d0); \ f = (Functor)(d0 = *ptd0); \ @@ -207,7 +210,7 @@ typedef struct non_single_struct_t { #define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {}) -#define END_WALK() } +#define END_WALK() goto restart;} #define def_aux_overflow() \ aux_overflow : { \ @@ -276,7 +279,7 @@ static Term cyclic_complex_term(register CELL *pt0, WALK_COMPLEX_TERM__(CYC_LIST, CYC_APPL, {}); /* leave an empty slot to fill in later */ - + goto restart; END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { @@ -395,6 +398,7 @@ static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end, pop_text_stack(lvl); return true; } + goto restart; END_WALK(); if (to_visit > to_visit0) { @@ -464,7 +468,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } } TrailTerm(TR++) = (CELL)ptd0; - + goto restart; END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { @@ -678,6 +682,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, pt0_end = &RepAttVar(ptd0)->Atts; pt0 = pt0_end - 1; } + goto restart; END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { @@ -744,51 +749,37 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; - CELL output = AbsPair(HR); + HB=ASP; + CELL output = TermNil; { - int lvl = push_text_stack(); while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { - CELL *ptr = VarOfTerm(t); - *ptr = TermFoundVar; - TrailTerm(TR++) = t; + YapBind( VarOfTerm(t), TermFoundVar ); + if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { + int lvl = push_text_stack(); + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; + } + pop_text_stack( lvl ); + } + } + inp = TailOfTerm(inp); + } + } + WALK_COMPLEX_TERM(); + output = MkPairTerm((CELL)ptd0,output); + YapBind( ptd0, TermFoundVar ); if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; } } - } - inp = TailOfTerm(inp); - } - pop_text_stack(lvl); - } - - WALK_COMPLEX_TERM(); - - /* do or pt2 are unbound */ - *ptd0 = TermNil; /* leave an empty slot to fill in later */ if (HR + 1024 > ASP) { goto global_overflow; } - HR[1] = AbsPair(HR + 2); - HR += 2; - HR[-2] = (CELL)ptd0; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - while (to_visit > to_visit0) { - to_visit--; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { @@ -798,18 +789,13 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; - goto restart; } clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); - if (HR != InitialH) { - HR[-1] = TermNil; - return output; - } else { - return 0; - } - + HB = B->cp_h; + return output; + def_aux_overflow(); def_trail_overflow(); @@ -881,7 +867,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, } WALK_COMPLEX_TERM__({}, {}, FOUND_VAR()); - + goto restart; END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { @@ -962,6 +948,7 @@ static Term free_vars_in_complex_term(CELL *pt0, CELL *pt0_end, } } TrailTerm(TR++) = (CELL)ptd0; + goto restart; END_WALK(); /* Do we still have compound terms to visit */ @@ -1006,6 +993,7 @@ static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, } } TrailTerm(TR++) = (CELL)ptd0; + goto restart; END_WALK(); /* Do we still have compound terms to visit */ @@ -1095,6 +1083,7 @@ static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); /* do or pt2 are unbound */ YapBind(ptd0,TermFoundVar); + goto restart; END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { @@ -1172,12 +1161,12 @@ static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, tr_fr_ptr TR0 = TR; CELL *InitialH = HR; - WALK_COMPLEX_TERM__({}, RENUMBER_SINGLES, {}); + WALK_COMPLEX_TERM__({}, {}, {}); if (IsAttVar(pt0)) continue; /* do or pt2 are unbound */ - if (singles) + if (singles || 0) d0 = numbervar_singleton(PASS_REGS1); else d0 = numbervar(numbv++ PASS_REGS); @@ -1211,7 +1200,7 @@ static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, def_aux_overflow(); def_global_overflow(); - def_trail_overflow(); + } Int Yap_NumberVars(Term inp, Int numbv, @@ -1436,7 +1425,7 @@ restart: goto restart; derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - *ptf++ = d0; + *ptf++ = (CELL)ptd0; goto restart; } /* Do we still have compound terms to visit */ @@ -1515,6 +1504,6 @@ void Yap_InitTermCPreds(void) { Yap_InitCPred("ground", 1, ground, SafePredFlag); Yap_InitCPred("cyclic_term", 1, cyclic_term, SafePredFlag); - Yap_InitCPred("numbervars", 3, p_numbervars, 0); + Yap_InitCPred("numbervars", 3, p_numbervars, 0); Yap_InitCPred("largest_numbervar", 2, largest_numbervar, 0); } diff --git a/pl/ground.yap b/pl/ground.yap index 05ece7469..e3df5c1d5 100644 --- a/pl/ground.yap +++ b/pl/ground.yap @@ -34,7 +34,7 @@ % grounds all free variables % as terms of the form '$VAR'(N) */ -numbervars(Term, M, N) :- +_numbervars(Term, M, N) :- '$variables_in_term'(Term, [], L), '$numbermarked_vars'(L, M, N). diff --git a/regression/cyclics.yap b/regression/cyclics.yap index bd7baa290..b1ba11c6e 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -1,6 +1,6 @@ %, copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). -:- initialization(main). +:- linitialization(main). main :- main( cyclic_term(X), X). @@ -13,7 +13,12 @@ main :- writeln('-----------------------'), fail. main :- - main( writeln(X), X). + main2( (terms:new_variables_in_term(L,X, O), writeln(X+L=O) ), X, L, O). +main :- + writeln('-----------------------'), + fail. +main :- + main( writeln(X), X). main :- writeln('-----------------------'), fail. @@ -26,6 +31,11 @@ main(G, X) :- d(X), m(G). + +main2(G, X, L, O) :- + e(X,L), + m(G). + m( G ) :- G, !, @@ -57,6 +67,12 @@ d(X) :- X= f(_,A/[A]), A= f(B,[X,g(A)]), B=[C|B], C=[X]. end :- writeln('....'), fail. +e(X,Y) :- X = t(_A,B,_C,D), Y = [B,E]. +e(X,Y) :- X = t(_A,_B,_C,_D), Y = [_,_E]. +e(X,Y) :- X = t(A,_B,C,_D), Y = [A,C]. +e(X,Y) :- X = t(A,X,_B,[X,C,_D]), Y = [A,C,E]. + + a(no, no). a(no, no). a(yes, yes). From e5945b8e8b78d4df5f85b83eb2d4eed29a7ad82a Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 5 Feb 2019 13:59:33 +0000 Subject: [PATCH 034/101] deb --- regression/cyclics.yap | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/regression/cyclics.yap b/regression/cyclics.yap index b1ba11c6e..799700e36 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -12,11 +12,21 @@ main :- main :- writeln('-----------------------'), fail. +main :- + main2( (terms:variables_in_term(X, O), writeln(X=O) ), X, L, O). +main :- + writeln('-----------------------'), + fail. main :- main2( (terms:new_variables_in_term(L,X, O), writeln(X+L=O) ), X, L, O). main :- writeln('-----------------------'), fail. +main :- + main2( (terms:variables_within_term(L,X, O), writeln(X+L=O) ), X, L, O). +main :- + writeln('-----------------------'), + fail. main :- main( writeln(X), X). main :- @@ -69,7 +79,9 @@ end :- writeln('....'), fail. e(X,Y) :- X = t(_A,B,_C,D), Y = [B,E]. e(X,Y) :- X = t(_A,_B,_C,_D), Y = [_,_E]. -e(X,Y) :- X = t(A,_B,C,_D), Y = [A,C]. +e(X,Y) :- X = t(A,_B,C,_D), Y = [ A,C]. +e(X,Y) :- X = t(A,[X,_D]), Y = [A,_C,_E]. +e(X,Y) :- X = t(A,[X,C]), Y = [A,C,_E]. e(X,Y) :- X = t(A,X,_B,[X,C,_D]), Y = [A,C,E]. From 4092003cd6b96fd42883d6fd1a8de949da3ca0e1 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 6 Feb 2019 00:08:15 +0000 Subject: [PATCH 035/101] deb --- C/terms.c | 72 +++++++++++++++++------------------ C/write.c | 25 ++++++++++--- H/Yapproto.h | 2 +- regression/cyclics.yap | 85 +++++++++++++++++++++++++++--------------- 4 files changed, 108 insertions(+), 76 deletions(-) diff --git a/C/terms.c b/C/terms.c index c99d1a1e3..cb4321043 100644 --- a/C/terms.c +++ b/C/terms.c @@ -28,6 +28,8 @@ #include "YapHeap.h" +#define debug_pop_text_stack(l) [ if (to_visit != to_visit0) printf("%d\n",__LINE__); pop_text_stack(l) } + #include "attvar.h" #include "yapio.h" #ifdef HAVE_STRING_H @@ -155,8 +157,9 @@ typedef struct non_single_struct_t { ++pt0; \ ptd0 = pt0; \ d0 = *ptd0; \ - list_loop: \ - deref_head(d0, var_in_term_unk); \ + list_loop: \ + fprintf(stderr,"%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\ + deref_head(d0, var_in_term_unk); \ var_in_term_nvar : { \ if (IsPairTerm(d0)) { \ if (to_visit + 32 >= to_visit_max) { \ @@ -256,19 +259,19 @@ typedef struct non_single_struct_t { CELL *ptd0 = to_visit->ptd0; \ *ptd0 = to_visit->d0; \ } \ - pop_text_stack(lvl); \ + pop_text_stack(lvl); fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\ return true; \ } #define CYC_APPL \ - if (IsAtomTerm((CELL)f)) { \ + if (IsAtomTerm((CELL)f)) { \ while (to_visit > to_visit0) { \ to_visit--; \ CELL *ptd0 = to_visit->ptd0; \ *ptd0 = to_visit->d0; \ } \ - pop_text_stack(lvl); \ - return true; \ + pop_text_stack(lvl); fprintf(stderr,"<%d at %s\n", to_visit-to_visit0, __FUNCTION__);\ + return true; \ } /** @@ -697,6 +700,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); + fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); @@ -1000,7 +1004,7 @@ static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, if (to_visit > to_visit0) { to_visit--; pt0 = to_visit->ptd0; - *pt0 = to_visit0->d0; + *pt0 = to_visit->d0; goto list_loop; } @@ -1311,7 +1315,7 @@ static Int largest_numbervar(USES_REGS1) { return Yap_unify(MaxNumberedVar(Deref(ARG1), 2 PASS_REGS), ARG2); } -static Term BREAK_LOOP(int ddep) { +static Term BREAK_LOOP(Int ddep) { Term t0 = MkIntegerTerm(ddep); return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("@^"), 1), 1, &t0); } @@ -1326,28 +1330,26 @@ static Term UNFOLD_LOOP(Term t, Term *b) { return o; } -static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, - Term *listp, - Term tail USES_REGS) { +static Term *loops_in_complex_term(CELL *pt0, CELL *pt0_end, + Term *listp USES_REGS) { int lvl = push_text_stack(); struct non_single_struct_t *to_visit = Malloc( 1024 * sizeof(struct non_single_struct_t)), *to_visit0 = to_visit, *to_visit_max = to_visit + 1024; - - CELL *ptf = HR; - CELL *ptd0; - if (listp) - *listp = tail; -restart: + CELL *ptd0; + CELL *ptf0 = HR, + *ptf = HR; + restart: while (pt0 < pt0_end) { CELL d0; ++pt0; ptd0 = pt0; d0 = *ptd0; list_loop: - deref_head(d0, vars_in_term_unk); + fprintf(stderr,"%d at %s\n", to_visit-to_visit0, __FUNCTION__); + deref_head(d0, vars_in_term_unk); vars_in_term_nvar: if (IsPairTerm(d0)) { if (to_visit + 32 >= to_visit_max) { @@ -1361,8 +1363,7 @@ restart: struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(d0); if (listp) { - *ptf = UNFOLD_LOOP(AbsPair(v0->ptf-1), listp); - ptf++; + *ptf++ = UNFOLD_LOOP(AbsPair(v0->ptf-1), listp); } else { *ptf++ = BREAK_LOOP(to_visit - v0); } @@ -1395,8 +1396,7 @@ restart: if (IsAtomTerm((CELL)f)) { struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(*ptd0); if (listp) { - *ptf = UNFOLD_LOOP(AbsAppl(v0->ptf-1), listp); - ptf++; + *ptf++ = UNFOLD_LOOP(AbsAppl(v0->ptf-1), listp); } else { *ptf++ = BREAK_LOOP(to_visit - v0); } @@ -1425,7 +1425,7 @@ restart: goto restart; derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - *ptf++ = (CELL)ptd0; + *ptf++ = *ptd0; goto restart; } /* Do we still have compound terms to visit */ @@ -1439,28 +1439,24 @@ restart: *ptd0 = to_visit->d0; goto restart; } + fprintf(stderr,"exit %d at %s\n", to_visit-to_visit0, __FUNCTION__); pop_text_stack(lvl); - return 0; + return ptf0; + def_aux_overflow(); } -Term Yap_BreakCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) { +Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) { Term t = Deref(inp); if (IsVarTerm(t) || IsPrimitiveTerm(t)) { return t; - } else { - Int res; - CELL *op = HR; - res = loops_in_complex_term((&t) - 1, &t, listp, tail PASS_REGS); - if (res < 0) - return -1; - if (IsPairTerm(t)) - return AbsPair(op); - else - return AbsAppl(op); + } else if (IsPairTerm(t)) { + return AbsPair(loops_in_complex_term((&t) - 1, &t, listp PASS_REGS)); } + return AbsAppl(loops_in_complex_term((&t) - 1, &t, listp PASS_REGS)); + } /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) @@ -1476,11 +1472,11 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) { */ static Int p_break_rational(USES_REGS1) { Term t = (ARG1); - Term l = Deref(ARG4), k; + Term l = Deref(ARG4); if (IsVarTerm(l)) Yap_unify(l, MkVarTerm()); - return Yap_unify(Yap_BreakCycles(t, 4, &k, l PASS_REGS), ARG2) && - Yap_unify(k, ARG3); + return Yap_unify(Yap_BreakCycles(t, 4, &l PASS_REGS), ARG2) && + Yap_unify(l, ARG3) ; } void Yap_InitTermCPreds(void) { diff --git a/C/write.c b/C/write.c index edd6a0717..d90855e77 100644 --- a/C/write.c +++ b/C/write.c @@ -70,11 +70,11 @@ typedef struct rewind_term { typedef struct write_globs { StreamDesc *stream; - int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays; - int Keep_terms; - int Write_Loops; - int Write_strings; - int last_atom_minus; + bool Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays; + bool Keep_terms; + bool Write_Loops; + bool Write_strings; + UInt last_atom_minus; UInt MaxDepth, MaxArgs; wtype lw; } wglbs; @@ -1089,8 +1089,21 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, wglb.stream = mywrite; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; + wglb.Use_portray = false; + wglb.Handle_vars = true; + wglb.Use_portray = false; + wglb.Portray_delays = false; + wglb.Keep_terms = false; + wglb.Write_Loops = false; + wglb.Write_strings = false; + wglb.Quote_illegal = false; + wglb.Ignore_ops = false; + wglb.MaxDepth = false; + wglb.MaxArgs = false; + wglb.lw = separator; + if ((flags & Handle_cyclics_f) && Yap_IsCyclicTerm(t) ){ - t = Yap_BreakCycles(t, 3, NULL, TermNil PASS_REGS); + t = Yap_BreakCycles(t, 3, NULL PASS_REGS); } /* protect slots for portray */ writeTerm(t, priority, 1, false, &wglb, &rwt); diff --git a/H/Yapproto.h b/H/Yapproto.h index 43293b0d2..06b24827a 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -446,7 +446,7 @@ extern bool Yap_Exists(const char *f); /* terms.c */ extern bool Yap_IsCyclicTerm(Term inp USES_REGS); -extern Term Yap_BreakCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS); +extern Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS); extern void Yap_InitTermCPreds(void); /* threads.c */ diff --git a/regression/cyclics.yap b/regression/cyclics.yap index 799700e36..7e1fee815 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -2,21 +2,24 @@ :- linitialization(main). +:- op(700, xfx, :=: ). + main :- main( cyclic_term(X), X). main :- - writeln('-----------------------'), + writeln('--- cyclic_term/1 --------------------'), fail. main :- main( ground(X), X). main :- - writeln('-----------------------'), + writeln('--- ground/1 ------------------'), fail. main :- - main2( (terms:variables_in_term(X, O), writeln(X=O) ), X, L, O). + main2( (terms:variables_in_term(X, O), writeln(X=O) ), X, L, O). main :- - writeln('-----------------------'), + writeln('--------variables_in_term/2, writeln/1 ---------------'), fail. + main :- main2( (terms:new_variables_in_term(L,X, O), writeln(X+L=O) ), X, L, O). main :- @@ -30,7 +33,22 @@ main :- main :- main( writeln(X), X). main :- - writeln('-----------------------'), + writeln('------rational_term_to_tree(X,A,B,[]),\ + writeln((A->B) -----------------'), + fail. +main :- + main((rational_term_to_tree(X,A,B,[]), + writeln((A->B))), X). +main :- + writeln('------ numbervars(A+B,1,_),\ + writeln((A->B) -----------------'), + fail. +main :- + main(( numbervars(A+B,1,_), + writeln((A->B))), X). +main :- + writeln('------rational_term_to_tree(X,A,B,[]), numbervars(A+B,1,_),\ + writeln((A->B) -----------------'), fail. main :- main((rational_term_to_tree(X,A,B,[]), numbervars(A+B,1,_), @@ -55,35 +73,36 @@ m( G ) :- writeln(no), end. -d(X) :- X = [_A]. -d(X) :- X = [a,_A]. -d(X) :- X = [X]. -d(X) :- X = [_|X]. -d(X) :- X = [_,X]. -d(X) :- X = [_,x]. -d(X) :- X = [_,x(X)]. -d(X) :- X= f(X). -d(X) :- X= f(X,X). -d(X) :- X= f(_,X). -d(X) :- X= f(A,A,X). -d(X) :- X= f(A,A,g(A)). -d(X) :- X= f(A,g(X,[A|A]),X). -d(X) :- X= f(X,[X,X]). -d(X) :- X= f(X,[X,g(X)]). -d(X) :- X= f(_,X/[X]). -d(X) :- X= f(_,A/[A]), A= f(X,[X,g(X)]). -d(X) :- X= f(_,A/[A]), A= f(X,[A,g(X)]). -d(X) :- X= f(_,A/[A]), A= f(B,[X,g(A)]), B=[C|B], C=[X]. +d(X) :- X :=: [_A]. +d(X) :- X :=: [a,_A]. +d(X) :- X :=: [X]. +d(X) :- X :=: [_|X]. +d(X) :- X :=: [_,X]. +d(X) :- X :=: [_,x]. +d(X) :- X :=: [_,x(X)]. +d(X) :- X:=: f(X). +d(X) :- X:=: f(X,X). +d(X) :- X:=: f(_,X). +d(X) :- X:=: f(A,A,X). +d(X) :- X:=: f(A,A,g(A)). +d(X) :- X:=: f(A,g(X,[A|A]),X). +d(X) :- X:=: f(X,[X,X]). +d(X) :- X:=: f(X,[X,g(X)]). +d(X) :- X:=: f(_,X/[X]). +d(X) :- X:=: f(_,A/[A]), A:=: f(X,[X,g(X)]). +d(X) :- X:=: f(_,A/[A]), A:=: f(X,[A,g(X)]). +d(X) :- X:=: f(_,A/[A]), A:=: f(B,[X,g(A)]), B:=:[C|B], C:=:[X]. end :- writeln('....'), fail. -e(X,Y) :- X = t(_A,B,_C,D), Y = [B,E]. -e(X,Y) :- X = t(_A,_B,_C,_D), Y = [_,_E]. -e(X,Y) :- X = t(A,_B,C,_D), Y = [ A,C]. -e(X,Y) :- X = t(A,[X,_D]), Y = [A,_C,_E]. -e(X,Y) :- X = t(A,[X,C]), Y = [A,C,_E]. -e(X,Y) :- X = t(A,X,_B,[X,C,_D]), Y = [A,C,E]. - + /* +e(X,Y) :- X :=: t(_A,B,_C,D), Y :=: [B,E]. +e(X,Y) :- X :=: t(_A,_B,_C,_D), Y :=: [_,_E]. +e(X,Y) :- X :=: t(A,_B,C,_D), Y :=: [ A,C]. +e(X,Y) :- X :=: t(A,[X,_D]), Y :=: [A,_C,_E]. +e(X,Y) :- X :=: t(A,[X,C]), Y :=: [A,C,_E]. +*/ +e(X,Y) :- X :=: t(A,X,_B,[X,C,_D]), Y :=: [A,C,_E]. a(no, no). a(no, no). @@ -102,3 +121,7 @@ a(yes, yes). a(yes, yes). a(yes, no). a(yes, no). + +X :-: Y :- writeln(X), fail. +X :=: X. + From 933db5bc7e26f7fd859f6fc3f52f1c8c24c29035 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 6 Feb 2019 15:08:25 +0000 Subject: [PATCH 036/101] deb --- C/terms.c | 405 ++++++++++++++++------------------------- regression/cyclics.yap | 2 - 2 files changed, 153 insertions(+), 254 deletions(-) diff --git a/C/terms.c b/C/terms.c index cb4321043..07be93eb1 100644 --- a/C/terms.c +++ b/C/terms.c @@ -68,15 +68,6 @@ static int expand_vts(int args USES_REGS) { } static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { - if (TR != TR0) { - do { - Term p = TrailTerm(--TR); - RESET_VARIABLE(p); - } while (TR != TR0); - } -} -#if 0 -static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { Term p = TrailTerm(--pt0); @@ -95,42 +86,7 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { TR = TR0; } -/// @brief recover original term while fixing direct refs. -/// -/// @param USES_REGS -/// -static inline void clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { - tr_fr_ptr pt0 = TR; - while (pt0 != TR0) { - Term p = TrailTerm(--pt0); - if (IsApplTerm(p)) { - /// pt: points to the address of the new term we may want to fix. - CELL *pt = RepAppl(p); - if (pt >= HB && pt < HR) { /// is it new? - Term v = pt[0]; - if (IsApplTerm(v)) { - /// yes, more than a single ref - *pt = (CELL)RepAppl(v); - } -#ifndef FROZEN_STACKS - pt0--; -#endif /* FROZEN_STACKS */ - continue; - } -#ifdef FROZEN_STACKS - pt[0] = TrailVal(pt0); -#else - pt[0] = TrailTerm(pt0 - 1); - pt0--; -#endif /* FROZEN_STACKS */ - } else { - RESET_VARIABLE(p); - } - } - TR = TR0; -} -#endif typedef struct { Term old_var; Term new_var; @@ -143,82 +99,93 @@ typedef struct non_single_struct_t { } non_singletons_t; #define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \ - int lvl = push_text_stack(); \ \ struct non_single_struct_t *to_visit = Malloc( \ 1024 * sizeof(struct non_single_struct_t)), \ *to_visit0 = to_visit, \ *to_visit_max = to_visit + 1024; \ \ - restart: \ - while (pt0 < pt0_end) { \ - register CELL d0; \ - register CELL *ptd0; \ + do{ \ + CELL d0; \ + CELL *ptd0; \ + restart:\ +while (pt0 < pt0_end) { \ ++pt0; \ - ptd0 = pt0; \ + ptd0 = pt0; \ d0 = *ptd0; \ - list_loop: \ - fprintf(stderr,"%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\ - deref_head(d0, var_in_term_unk); \ + list_loop: \ + fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__); \ + deref_head(d0, var_in_term_unk); \ var_in_term_nvar : { \ if (IsPairTerm(d0)) { \ if (to_visit + 32 >= to_visit_max) { \ goto aux_overflow; \ } \ ptd0 = RepPair(d0); \ + d0 = ptd0[0]; \ LIST0; \ - if (*ptd0 == TermFreeTerm) \ + if (d0 == TermFreeTerm) \ goto restart; \ to_visit->pt0 = pt0; \ to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ - to_visit->d0 = *ptd0; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = d0; \ to_visit++; \ - d0 = ptd0[0]; \ - *ptd0 = TermFreeTerm; \ + *ptd0 = TermFreeTerm; \ pt0 = ptd0; \ pt0_end = pt0 + 1; \ - goto list_loop; \ + goto list_loop; \ } else if (IsApplTerm(d0)) { \ register Functor f; \ /* store the terms to visit */ \ - ptd0 = RepAppl(d0); \ - f = (Functor)(d0 = *ptd0); \ + ptd0 = RepAppl(d0); \ + f = (Functor)(d0 = *ptd0); \ \ if (to_visit + 32 >= to_visit_max) { \ goto aux_overflow; \ } \ STRUCT0; \ - if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \ + if (IsExtensionFunctor(f) || f == FunctorDollarVar || IsAtomTerm((CELL)f)) { \ \ - goto restart; \ + continue; \ } \ to_visit->pt0 = pt0; \ to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ - to_visit->d0 = d0; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = d0; \ to_visit++; \ \ - *ptd0 = TermNil; \ - Term d1 = ArityOfFunctor(f); \ - pt0 = ptd0; \ - pt0_end = ptd0 + d1; \ - goto restart; \ + *ptd0 = TermNil; \ + Term d1 = ArityOfFunctor(f); \ + pt0 = ptd0; \ + pt0_end = ptd0 + d1; \ + continue; \ } else { \ PRIMI0; \ - goto restart; \ + continue; \ } \ - } \ derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); #define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {}) -#define END_WALK() goto restart;} +#define END_WALK() \ + }\ + }\ + /* Do we still have compound terms to visit */ \ + if (to_visit > to_visit0) {\ + to_visit--;\ +\ + pt0 = to_visit->pt0;\ + pt0_end = to_visit->pt0_end;\ + *to_visit->ptd0 = to_visit->d0;\ + } \ + } while (to_visit>to_visit0); \ + pop_text_stack(lvl); #define def_aux_overflow() \ aux_overflow : { \ size_t d1 = to_visit - to_visit0; \ - size_t d2 = to_visit_max - to_visit0; \ + size_t d2 = to_visit_max - to_visit0; \ to_visit0 = \ Realloc(to_visit0, (d2 + 128) * sizeof(struct non_single_struct_t)); \ to_visit = to_visit0 + d1; \ @@ -253,25 +220,26 @@ typedef struct non_single_struct_t { } #define CYC_LIST \ - if (*ptd0 == TermFreeTerm) { \ - while (to_visit > to_visit0) { \ + if (d0 == TermFreeTerm) { \ + fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\ +while (to_visit > to_visit0) { \ to_visit--; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ + to_visit->ptd0[0] = \ + to_visit->d0; \ } \ pop_text_stack(lvl); fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\ return true; \ } #define CYC_APPL \ - if (IsAtomTerm((CELL)f)) { \ + if (IsAtomTerm((CELL)f)) { \ while (to_visit > to_visit0) { \ - to_visit--; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); fprintf(stderr,"<%d at %s\n", to_visit-to_visit0, __FUNCTION__);\ - return true; \ + to_visit--; \ + to_visit->ptd0[0] = \ + to_visit->d0; \ + } \ + fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\ + return true; \ } /** @@ -280,21 +248,11 @@ typedef struct non_single_struct_t { static Term cyclic_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) { + int lvl = push_text_stack(); \ WALK_COMPLEX_TERM__(CYC_LIST, CYC_APPL, {}); /* leave an empty slot to fill in later */ - goto restart; END_WALK(); - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; - } - pop_text_stack(lvl); return false; @@ -332,6 +290,7 @@ static Int cyclic_term(USES_REGS1) /* cyclic_term(+T) */ static bool ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) { + int lvl = push_text_stack(); \ WALK_COMPLEX_TERM(); /* leave an empty slot to fill in later */ while (to_visit > to_visit0) { @@ -345,15 +304,7 @@ static bool ground_complex_term(register CELL *pt0, END_WALK(); /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; - } pop_text_stack(lvl); return true; @@ -388,9 +339,10 @@ static Int ground(USES_REGS1) /* ground(+T) */ static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term v USES_REGS) { + int lvl = push_text_stack(); \ WALK_COMPLEX_TERM(); - if ((CELL)d0 == v) { /* we found it */ + if ((CELL)ptd0 == v) { /* we found it */ /* Do we still have compound terms to visit */ while (to_visit > to_visit0) { to_visit--; @@ -452,7 +404,9 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - + int lvl = push_text_stack(); + + push_text_stack(); \ WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ *ptd0 = TermNil; @@ -471,18 +425,8 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } } TrailTerm(TR++) = (CELL)ptd0; - goto restart; - END_WALK(); - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; - } + END_WALK(); clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); @@ -658,9 +602,9 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = inp; - + int lvl = push_text_stack(); \ + WALK_COMPLEX_TERM(); - if (IsAttVar(ptd0)) { /* do or pt2 are unbound */ attvar_record *a0 = RepAttVar(ptd0); @@ -685,22 +629,11 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, pt0_end = &RepAttVar(ptd0)->Atts; pt0 = pt0_end - 1; } - goto restart; - END_WALK(); - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; - } + END_WALK(); clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); - fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); @@ -712,7 +645,8 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } } - return (output); + fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__); + return (output); def_aux_overflow(); def_global_overflow(); @@ -753,16 +687,16 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; + int lvl = push_text_stack(); \ HB=ASP; CELL output = TermNil; - { while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { YapBind( VarOfTerm(t), TermFoundVar ); if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { - int lvl = push_text_stack(); + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; } @@ -785,16 +719,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, goto global_overflow; } END_WALK(); - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } - + clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); HB = B->cp_h; @@ -856,7 +781,8 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - + int lvl = push_text_stack(); + while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { @@ -873,16 +799,6 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, WALK_COMPLEX_TERM__({}, {}, FOUND_VAR()); goto restart; END_WALK(); - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; - } clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); @@ -931,7 +847,7 @@ static Term free_vars_in_complex_term(CELL *pt0, CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) { Term o = TermNil; CELL *InitialH = HR; - + int lvl = push_text_stack(); WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ *ptd0 = TermNil; @@ -952,19 +868,8 @@ static Term free_vars_in_complex_term(CELL *pt0, CELL *pt0_end, } } TrailTerm(TR++) = (CELL)ptd0; - goto restart; END_WALK(); - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; - } clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); @@ -980,7 +885,7 @@ static Term free_vars_in_complex_term(CELL *pt0, CELL *pt0_end, static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) { CELL *InitialH = HR; - + int lvl = push_text_stack(); WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ *ptd0 = TermFoundVar; @@ -997,16 +902,8 @@ static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, } } TrailTerm(TR++) = (CELL)ptd0; - goto restart; - END_WALK(); - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->ptd0; - *pt0 = to_visit->d0; - goto list_loop; - } + END_WALK(); pop_text_stack(lvl); return TermNil; @@ -1083,22 +980,12 @@ static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { CELL *InitialH = HR; HB = (CELL *)ASP; CELL output = AbsPair(HR); - + int lvl = push_text_stack(); WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); /* do or pt2 are unbound */ YapBind(ptd0,TermFoundVar); goto restart; END_WALK(); - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; - } clean_tr(TR0 PASS_REGS); @@ -1164,7 +1051,8 @@ static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, tr_fr_ptr TR0 = TR; CELL *InitialH = HR; - + int lvl = push_text_stack(); + WALK_COMPLEX_TERM__({}, {}, {}); if (IsAttVar(pt0)) @@ -1181,23 +1069,8 @@ static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, /* next make sure noone will see this as a variable again */ YapBind(ptd0, d0); - continue; - END_WALK(); - /* Do we still have compound terms to visit */ - while (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - if (pt0 >= pt0_end) - continue; - goto restart; - } - pop_text_stack(lvl); return numbv; @@ -1267,7 +1140,7 @@ static Int p_numbervars(USES_REGS1) { } static int max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) { - + int lvl = push_text_stack(); WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {}); END_WALK(); /* Do we still have compound terms to visit */ @@ -1333,49 +1206,62 @@ static Term UNFOLD_LOOP(Term t, Term *b) { static Term *loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp USES_REGS) { int lvl = push_text_stack(); + CELL *ptf0 = HR; + tr_fr_ptr TR0 = TR; struct non_single_struct_t *to_visit = Malloc( 1024 * sizeof(struct non_single_struct_t)), *to_visit0 = to_visit, - *to_visit_max = to_visit + 1024; - CELL *ptd0; - CELL *ptf0 = HR, - *ptf = HR; - restart: - while (pt0 < pt0_end) { + *to_visit_max = to_visit + 1024; + do{ + CELL *ptd0, + *ptf = HR; CELL d0; + restart: + while (pt0 < pt0_end) { ++pt0; ptd0 = pt0; d0 = *ptd0; list_loop: - fprintf(stderr,"%d at %s\n", to_visit-to_visit0, __FUNCTION__); + { + fprintf(stderr,"%ld at %s\n", to_visit-to_visit0, __FUNCTION__); deref_head(d0, vars_in_term_unk); vars_in_term_nvar: if (IsPairTerm(d0)) { if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } - CELL *ptd0 = RepPair(d0); + ptd0 = RepPair(d0); d0 = ptd0[0]; - if (IsAtomTerm(d0) && (CELL *)AtomOfTerm(d0) >= (CELL *)to_visit0 && - (CELL *)AtomOfTerm(d0) < (CELL *)to_visit) { - // LIST0; - struct non_single_struct_t *v0 = + if (listp) { + CELL *pt = VarOfTerm(d0); + if (pt &&pt >= ptf && + pt < HR) { + // LIST0; + *ptf++ = UNFOLD_LOOP(AbsPair(pt), listp); + continue; + } else { + *ptf++ = AbsPair(HR); + MaBind( ptd0, AbsPair(ptf - 1)); + } + } else { + struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(d0); - if (listp) { - *ptf++ = UNFOLD_LOOP(AbsPair(v0->ptf-1), listp); - } else { - *ptf++ = BREAK_LOOP(to_visit - v0); - } + if (IsAtomTerm(d0) && v0 >= to_visit0 && + (CELL *)AtomOfTerm(d0) < (CELL *)to_visit) { + // LIST0; + *ptf++ = BREAK_LOOP(to_visit - v0); continue; - } - *ptf++ = AbsPair(HR); - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; + } else { + *ptf++ = AbsPair(HR); to_visit->ptd0 = ptd0; - to_visit->ptf = ptf; to_visit->d0 = d0 = *ptd0; *ptd0 = MkAtomTerm((AtomEntry *)to_visit); + } + } + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->ptf = ptf; to_visit++; pt0 = ptd0; pt0_end = pt0 + 1; @@ -1389,30 +1275,43 @@ static Term *loops_in_complex_term(CELL *pt0, CELL *pt0_end, /* store the terms to visit */ ptd0 = RepAppl(d0); f = (Functor)(*ptd0); - if (IsExtensionFunctor(f)) { + if (IsExtensionFunctor(f) || f == FunctorDollarVar) { *ptf++ = d0; continue; } - if (IsAtomTerm((CELL)f)) { - struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(*ptd0); - if (listp) { - *ptf++ = UNFOLD_LOOP(AbsAppl(v0->ptf-1), listp); + if (listp) { + CELL *pt = (CELL *)f; + if (IsVarTerm(d0) && pt >= ptf0 && + pt < HR) { + // LIST0; + *ptf++ = UNFOLD_LOOP(AbsAppl(pt), listp); + continue; + } else { + *ptf++ = AbsAppl(HR); + MaBind( pt, AbsAppl(ptf - 1)); + } + } else { + struct non_single_struct_t *v0 = + (struct non_single_struct_t *)AtomOfTerm(d0); + if (IsAtomTerm(d0) && v0 >= to_visit0 && + v0 < to_visit) { + // LIST0; + *ptf++ = BREAK_LOOP(to_visit - v0); + continue; } else { - *ptf++ = BREAK_LOOP(to_visit - v0); - } - continue; + *ptf++ = AbsAppl(HR); + to_visit->ptd0 = ptd0; + to_visit->d0 = d0; + *ptd0 = MkAtomTerm((AtomEntry *)to_visit); + } } // STRUCT0; if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } - *ptf++ = AbsAppl(HR); to_visit->pt0 = pt0; to_visit->pt0_end = pt0_end; - to_visit->ptd0 = ptd0; - to_visit->d0 = *ptd0; to_visit->ptf = ptf; - *ptd0 = MkAtomTerm((AtomEntry *)to_visit); to_visit++; pt0 = ptd0; pt0_end = ptd0 + (ArityOfFunctor(f)); @@ -1422,25 +1321,27 @@ static Term *loops_in_complex_term(CELL *pt0, CELL *pt0_end, } else { *ptf++ = d0; } - goto restart; + continue; + } derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); *ptf++ = *ptd0; - goto restart; - } + continue; + } /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; + while (to_visit > to_visit0) { + to_visit--; - pt0 = to_visit->pt0; - ptf = to_visit->ptf; - pt0_end = to_visit->pt0_end; - ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; + pt0 = to_visit->pt0; + ptf = to_visit->ptf; + pt0_end = to_visit->pt0_end; + to_visit->ptd0[0] = to_visit->d0; + } + } while (to_visit > to_visit0) ; + fprintf(stderr,"exit %ld at %s\n", to_visit-to_visit0, __FUNCTION__); + if (listp) { + clean_tr(TR0); } - fprintf(stderr,"exit %d at %s\n", to_visit-to_visit0, __FUNCTION__); - pop_text_stack(lvl); return ptf0; diff --git a/regression/cyclics.yap b/regression/cyclics.yap index 7e1fee815..fe0508aa3 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -95,13 +95,11 @@ d(X) :- X:=: f(_,A/[A]), A:=: f(B,[X,g(A)]), B:=:[C|B], C:=:[X]. end :- writeln('....'), fail. - /* e(X,Y) :- X :=: t(_A,B,_C,D), Y :=: [B,E]. e(X,Y) :- X :=: t(_A,_B,_C,_D), Y :=: [_,_E]. e(X,Y) :- X :=: t(A,_B,C,_D), Y :=: [ A,C]. e(X,Y) :- X :=: t(A,[X,_D]), Y :=: [A,_C,_E]. e(X,Y) :- X :=: t(A,[X,C]), Y :=: [A,C,_E]. -*/ e(X,Y) :- X :=: t(A,X,_B,[X,C,_D]), Y :=: [A,C,_E]. a(no, no). From 4678b2baee02664f6d9d9a12b21a788af71262bd Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 8 Feb 2019 09:33:07 +0000 Subject: [PATCH 037/101] dbg --- C/terms.c | 267 ++++++++++++++++------------------------- C/write.c | 4 +- os/format.c | 10 +- pl/undefined.yap | 4 +- regression/cyclics.yap | 197 ++++++++++++------------------ 5 files changed, 194 insertions(+), 288 deletions(-) diff --git a/C/terms.c b/C/terms.c index 07be93eb1..c7ee968e4 100644 --- a/C/terms.c +++ b/C/terms.c @@ -105,7 +105,7 @@ typedef struct non_single_struct_t { *to_visit0 = to_visit, \ *to_visit_max = to_visit + 1024; \ \ - do{ \ + while (to_visit >= to_visit0) { \ CELL d0; \ CELL *ptd0; \ restart:\ @@ -114,7 +114,7 @@ while (pt0 < pt0_end) { \ ptd0 = pt0; \ d0 = *ptd0; \ list_loop: \ - fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__); \ + /*fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__);*/ \ deref_head(d0, var_in_term_unk); \ var_in_term_nvar : { \ if (IsPairTerm(d0)) { \ @@ -172,14 +172,13 @@ while (pt0 < pt0_end) { \ }\ }\ /* Do we still have compound terms to visit */ \ - if (to_visit > to_visit0) {\ - to_visit--;\ -\ - pt0 = to_visit->pt0;\ + to_visit--; \ + if (to_visit >= to_visit0) {\ + pt0 = to_visit->pt0; \ pt0_end = to_visit->pt0_end;\ - *to_visit->ptd0 = to_visit->d0;\ - } \ - } while (to_visit>to_visit0); \ + *to_visit->ptd0 = to_visit->d0; \ + }\ + }\ pop_text_stack(lvl); #define def_aux_overflow() \ @@ -221,13 +220,13 @@ while (pt0 < pt0_end) { \ #define CYC_LIST \ if (d0 == TermFreeTerm) { \ - fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\ + /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ while (to_visit > to_visit0) { \ to_visit--; \ to_visit->ptd0[0] = \ to_visit->d0; \ } \ - pop_text_stack(lvl); fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\ + pop_text_stack(lvl); /*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ return true; \ } @@ -238,7 +237,7 @@ while (to_visit > to_visit0) { \ to_visit->ptd0[0] = \ to_visit->d0; \ } \ - fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\ + /*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ return true; \ } @@ -645,7 +644,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } } - fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__); + /*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__)*/; return (output); def_aux_overflow(); @@ -1189,8 +1188,9 @@ static Int largest_numbervar(USES_REGS1) { } static Term BREAK_LOOP(Int ddep) { - Term t0 = MkIntegerTerm(ddep); - return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("@^"), 1), 1, &t0); + char buf[64]; + snprintf(buf, 63, "@^[" Int_FORMAT "]", ddep); + return MkAtomTerm(Yap_LookupAtom(buf)); } static Term UNFOLD_LOOP(Term t, Term *b) { @@ -1203,161 +1203,106 @@ static Term UNFOLD_LOOP(Term t, Term *b) { return o; } -static Term *loops_in_complex_term(CELL *pt0, CELL *pt0_end, - Term *listp USES_REGS) { - int lvl = push_text_stack(); - CELL *ptf0 = HR; - tr_fr_ptr TR0 = TR; - struct non_single_struct_t *to_visit = Malloc( - 1024 * sizeof(struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit + 1024; - do{ - CELL *ptd0, - *ptf = HR; - CELL d0; - restart: - while (pt0 < pt0_end) { - ++pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - { - fprintf(stderr,"%ld at %s\n", to_visit-to_visit0, __FUNCTION__); - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - if (IsPairTerm(d0)) { - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - ptd0 = RepPair(d0); - d0 = ptd0[0]; - if (listp) { - CELL *pt = VarOfTerm(d0); - if (pt &&pt >= ptf && - pt < HR) { - // LIST0; - *ptf++ = UNFOLD_LOOP(AbsPair(pt), listp); - continue; - } else { - *ptf++ = AbsPair(HR); - MaBind( ptd0, AbsPair(ptf - 1)); - } - } else { - struct non_single_struct_t *v0 = - (struct non_single_struct_t *)AtomOfTerm(d0); - if (IsAtomTerm(d0) && v0 >= to_visit0 && - (CELL *)AtomOfTerm(d0) < (CELL *)to_visit) { - // LIST0; - *ptf++ = BREAK_LOOP(to_visit - v0); - continue; - } else { - *ptf++ = AbsPair(HR); - to_visit->ptd0 = ptd0; - to_visit->d0 = d0 = *ptd0; - *ptd0 = MkAtomTerm((AtomEntry *)to_visit); - } - } - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->ptf = ptf; - to_visit++; - pt0 = ptd0; - pt0_end = pt0 + 1; - ptd0 = pt0; - ptf = HR; - HR+=2; - goto list_loop; - } else if (IsApplTerm(d0)) { - register Functor f; +typedef struct block_connector { + Int id; //> index in the array; + Term source; //> source; + CELL *copy; //> copy; + CELL header; //> backup of first word of the source data; + CELL reference; //> term used to refer the copy. +} cl_connector; - /* store the terms to visit */ - ptd0 = RepAppl(d0); - f = (Functor)(*ptd0); - if (IsExtensionFunctor(f) || f == FunctorDollarVar) { - *ptf++ = d0; - continue; - } - if (listp) { - CELL *pt = (CELL *)f; - if (IsVarTerm(d0) && pt >= ptf0 && - pt < HR) { - // LIST0; - *ptf++ = UNFOLD_LOOP(AbsAppl(pt), listp); - continue; - } else { - *ptf++ = AbsAppl(HR); - MaBind( pt, AbsAppl(ptf - 1)); - } - } else { - struct non_single_struct_t *v0 = - (struct non_single_struct_t *)AtomOfTerm(d0); - if (IsAtomTerm(d0) && v0 >= to_visit0 && - v0 < to_visit) { - // LIST0; - *ptf++ = BREAK_LOOP(to_visit - v0); - continue; - } else { - *ptf++ = AbsAppl(HR); - to_visit->ptd0 = ptd0; - to_visit->d0 = d0; - *ptd0 = MkAtomTerm((AtomEntry *)to_visit); - } - } - // STRUCT0; - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->ptf = ptf; - to_visit++; - pt0 = ptd0; - pt0_end = ptd0 + (ArityOfFunctor(f)); - HR[0] = (CELL)f; - ptf = HR+1; - HR = ptf +ArityOfFunctor(f); - } else { - *ptf++ = d0; - } - continue; - } - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - *ptf++ = *ptd0; - continue; - } - /* Do we still have compound terms to visit */ - while (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - ptf = to_visit->ptf; - pt0_end = to_visit->pt0_end; - to_visit->ptd0[0] = to_visit->d0; - } - } while (to_visit > to_visit0) ; - fprintf(stderr,"exit %ld at %s\n", to_visit-to_visit0, __FUNCTION__); - if (listp) { - clean_tr(TR0); - } - pop_text_stack(lvl); - return ptf0; +Int cp_link(Term t,Int i, Int j, cl_connector *q, Int max, CELL *tailp) +{ + Term ref, h, *s, *ostart; + bool pair = false; + ssize_t n; - def_aux_overflow(); + if (IsVarTerm(t) || IsPrimitiveTerm(t)) { + q[i].copy[j] = t; + return max; + } + ostart = HR; + if (IsPairTerm(t)) { + h = HeadOfTerm(t); + s = RepPair(t); + n = 2; + pair = true; + ref = AbsPair(ostart); + } else { + h = (CELL)FunctorOfTerm(t); + s = RepAppl(t); + n = ArityOfFunctor(FunctorOfTerm(t)); + ref = AbsAppl(ostart); + *ostart++ = s[0]; + } + if (HR > s && H0 < s) { + // first time, create a new term + q[max].id = max; + q[max].source = t; + q[max].copy = ostart; + q[max].header = s[0]; + q[max].reference = ref; + s[0] = max*sizeof(CELL); + HR += n; + max++; + } else { + Int id = h/sizeof(CELL); + if (q[id].reference == ref) { + q[id].reference = UNFOLD_LOOP(t, tailp); + } + q[i].copy[j] = q[id].reference; + } + return max; } -Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) { - Term t = Deref(inp); +Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) { + + int lvl = push_text_stack(); + + Term t = Deref(inp); + ssize_t qsize = 2048, qlen=0; + cl_connector *q = Malloc(qsize * sizeof(cl_connector)), *q0 = q; + Term *s; + if (IsVarTerm(t) || IsPrimitiveTerm(t)) { return t; - } else if (IsPairTerm(t)) { - return AbsPair(loops_in_complex_term((&t) - 1, &t, listp PASS_REGS)); + } else { + Int i=0; + qlen = cp_link(t, 0, 0, q, qlen, listp); + while (i < qlen) { + arity_t n, j; + if (IsPairTerm( q[i].source )) { + s = RepPair( q[i].source ); + n = 2; + qlen = cp_link(q[i].header, i, 0, q, qlen, listp); + qlen = cp_link(s[1], i, 1, q, qlen, listp); + } else { + s = RepAppl( q[i].source )+1; + n = ArityOfFunctor((Functor)q[i].header); + for (j = 0; jB) -----------------'), - fail. -main :- - main((rational_term_to_tree(X,A,B,[]), - writeln((A->B))), X). -main :- - writeln('------ numbervars(A+B,1,_),\ - writeln((A->B) -----------------'), - fail. -main :- - main(( numbervars(A+B,1,_), - writeln((A->B))), X). -main :- - writeln('------rational_term_to_tree(X,A,B,[]), numbervars(A+B,1,_),\ - writeln((A->B) -----------------'), - fail. -main :- - main((rational_term_to_tree(X,A,B,[]), numbervars(A+B,1,_), - writeln((A->B))), X). -main. - -main(G, X) :- - d(X), - m(G). - - -main2(G, X, L, O) :- - e(X,L), - m(G). - -m( G ) :- - G, - !, - writeln(yes), - end. -m( G ) :- - writeln(no), - end. - -d(X) :- X :=: [_A]. -d(X) :- X :=: [a,_A]. -d(X) :- X :=: [X]. -d(X) :- X :=: [_|X]. -d(X) :- X :=: [_,X]. -d(X) :- X :=: [_,x]. -d(X) :- X :=: [_,x(X)]. -d(X) :- X:=: f(X). -d(X) :- X:=: f(X,X). -d(X) :- X:=: f(_,X). -d(X) :- X:=: f(A,A,X). -d(X) :- X:=: f(A,A,g(A)). -d(X) :- X:=: f(A,g(X,[A|A]),X). -d(X) :- X:=: f(X,[X,X]). -d(X) :- X:=: f(X,[X,g(X)]). -d(X) :- X:=: f(_,X/[X]). -d(X) :- X:=: f(_,A/[A]), A:=: f(X,[X,g(X)]). -d(X) :- X:=: f(_,A/[A]), A:=: f(X,[A,g(X)]). -d(X) :- X:=: f(_,A/[A]), A:=: f(B,[X,g(A)]), B:=:[C|B], C:=:[X]. - -end :- writeln('....'), fail. - -e(X,Y) :- X :=: t(_A,B,_C,D), Y :=: [B,E]. -e(X,Y) :- X :=: t(_A,_B,_C,_D), Y :=: [_,_E]. -e(X,Y) :- X :=: t(A,_B,C,_D), Y :=: [ A,C]. -e(X,Y) :- X :=: t(A,[X,_D]), Y :=: [A,_C,_E]. -e(X,Y) :- X :=: t(A,[X,C]), Y :=: [A,C,_E]. -e(X,Y) :- X :=: t(A,X,_B,[X,C,_D]), Y :=: [A,C,_E]. - -a(no, no). -a(no, no). -a(yes, yes). -a(yes, no). -a(yes, no). -a( no, no). -a(yes, no). -a(yes, yes). -a(yes, yes). -a(yes, no). -a(yes, no). -a( no, no). -a(yes, no). -a(yes, yes). -a(yes, yes). -a(yes, no). -a(yes, no). - -X :-: Y :- writeln(X), fail. X :=: X. +main :- + exec. + +test( cyclic_term(X), [X]). +test( ground(X), [X]). +test( (variables_in_term(X, O), writeln(X=O) ), [X, [], O]). +test( (new_variables_in_term(L,X, O), writeln(X+L=O) ), [X, L, O]). +test( (variables_within_term(L,X, O), writeln(X+L=O) ), [X, L, O]). +test( writeln(X), [X]). +test((rational_term_to_tree(X,A,B,[]), + writeln((A->B))), [X, A, B]). +test(( numbervars(A+B,1,_)), [A, B]). +test((rational_term_to_tree(X,A,B,[]), numbervars(A+B,1,_), + writeln((A->B))), [X,A,B]). + +:- dynamic i/1. +i(0). + +id(I) :- + retract(i(I)), + I1 is I+1, + assert(i(I1)). + +exec :- + test( G, [X|Ps] ), + functors(G, Fs), + format('**** ~w:~n',[Fs]), + d(X, GX), + id(I), + m(I, GX, G, [X|Ps]), + fail. +exec. + +functors((X,Y),(GX -> GY)) :- + !, + functors(X, GX), + functors(Y, GY). +functors(X, GX) :- + functor(X, GX, _). + +m( I, GX, G, Ps ) :- + %trace, + GX, + G, + !, + format( '~d. ~w: ~a.~n', [I, G,yes]). +m( I, GX, G, _Ps ) :- + GX, + format( '~d. ~w: ~a.~n',[I,G,no]). + +d(X, X = [_A] ). +d(X, ( X = [a,_A]) ). +d(X, ( X = [X]) ). +d(X, ( X = [_|X]) ). +d(X, ( X = [_,X]) ). +d(X, ( X = [_,x]) ). +d(X, ( X = [_,x(X)]) ). +d(X, ( X= f(X)) ). +d(X, ( X= f(X,X)) ). +d(X, ( X= f(_,X)) ). +d(X, ( X= f(A,A,X)) ). +d(X, ( X= f(A,A,g(A))) ). +d(X, ( X= f(A,g(X,[A|A]),X)) ). +d(X, ( X= f(X,[X,X])) ). +d(X, ( X= f(X,[X,g(X)])) ). +d(X, ( X= f(_,X/[X])) ). +d(X, ( X= f(_,A/[A]), A= f(X,[X,g(X)])) ). +d(X, ( X= f(_,A/[A]), A= f(X,[A,g(X)])) ). +d(X, ( X= f(_,A/[A]), A= f(B,[X,g(A)]), B=[C|B], C=[X]) ). + +e(X,Y, ( X = t(_A,B,_C,D), Y = [B,E]) ). +e(X,Y, ( X = t(_A,_B,_C,_D), Y = [_,_E]) ). +e(X,Y, ( X = t(A,_B,C,_D), Y = [ A,C]) ). +e(X,Y, ( X = t(A,[X,_D]), Y = [A,_C,_E]) ). +e(X,Y, ( X = t(A,[X,C]), Y = [A,C,_E]) ). +e(X,Y, ( X = t(A,X,_B,[X,C,_D]), Y = [A,C,_E]) ). From d0f05d3578f99bb366d758afd95681814740aa09 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 8 Feb 2019 15:01:12 +0000 Subject: [PATCH 038/101] new --- C/terms.c | 99 +++++++++++++++++++++++++++++++++---------------------- 1 file changed, 59 insertions(+), 40 deletions(-) diff --git a/C/terms.c b/C/terms.c index c7ee968e4..281567636 100644 --- a/C/terms.c +++ b/C/terms.c @@ -131,8 +131,8 @@ while (pt0 < pt0_end) { \ to_visit->ptd0 = ptd0; \ to_visit->d0 = d0; \ to_visit++; \ - *ptd0 = TermFreeTerm; \ - pt0 = ptd0; \ + *ptd0 = TermFreeTerm; \ + pt0 = ptd0; \ pt0_end = pt0 + 1; \ goto list_loop; \ } else if (IsApplTerm(d0)) { \ @@ -1022,9 +1022,9 @@ static Int p_non_singletons_in_term( } } -static Term numbervar(Int id USES_REGS) { +static Term numbervar(Int me USES_REGS) { Term ts[1]; - ts[0] = MkIntegerTerm(id); + ts[0] = MkIntegerTerm(me); return Yap_MkApplTerm(FunctorDollarVar, 1, ts); } @@ -1034,9 +1034,9 @@ static Term numbervar_singleton(USES_REGS1) { return Yap_MkApplTerm(FunctorDollarVar, 1, ts); } -static void renumbervar(Term t, Int id USES_REGS) { +static void renumbervar(Term t, Int me USES_REGS) { Term *ts = RepAppl(t); - ts[1] = MkIntegerTerm(id); + ts[1] = MkIntegerTerm(me); } #define RENUMBER_SINGLES \ @@ -1205,30 +1205,27 @@ static Term UNFOLD_LOOP(Term t, Term *b) { typedef struct block_connector { - Int id; //> index in the array; + Int me; //> index in the array; Term source; //> source; CELL *copy; //> copy; CELL header; //> backup of first word of the source data; CELL reference; //> term used to refer the copy. } cl_connector; -Int cp_link(Term t,Int i, Int j, cl_connector *q, Int max, CELL *tailp) + +static Int +create_entry(Term t, Int i, Int j, cl_connector *q, Int max) { Term ref, h, *s, *ostart; bool pair = false; ssize_t n; - - if (IsVarTerm(t) || IsPrimitiveTerm(t)) { - q[i].copy[j] = t; - return max; - } - ostart = HR; + // first time, create a new term + ostart = HR; if (IsPairTerm(t)) { - h = HeadOfTerm(t); - s = RepPair(t); + s = RepPair(t); n = 2; - pair = true; - ref = AbsPair(ostart); + pair = true; + ref = AbsPair(ostart); } else { h = (CELL)FunctorOfTerm(t); s = RepAppl(t); @@ -1236,47 +1233,69 @@ Int cp_link(Term t,Int i, Int j, cl_connector *q, Int max, CELL *tailp) ref = AbsAppl(ostart); *ostart++ = s[0]; } - if (HR > s && H0 < s) { - // first time, create a new term - q[max].id = max; - q[max].source = t; - q[max].copy = ostart; - q[max].header = s[0]; - q[max].reference = ref; - s[0] = max*sizeof(CELL); - HR += n; - max++; - } else { - Int id = h/sizeof(CELL); - if (q[id].reference == ref) { - q[id].reference = UNFOLD_LOOP(t, tailp); - } - q[i].copy[j] = q[id].reference; + if (H0 > s) { + return (s[0]-EndSpecials)/sizeof(CELL); } + q[max].me = max; + q[max].source = t; + q[max].copy = ostart; + q[max].header = s[0]; + q[max].reference = ref; + s[0] = max*sizeof(CELL)+EndSpecials; + HR += n; + max++; return max; } +Int cp_link(Term t,Int i, Int j, cl_connector *q, Int max, CELL *tailp) +{ + Int me; + + t = Deref(t); + if (IsVarTerm(t) || IsPrimitiveTerm(t)) { + q[i].copy[j] = t; + return max; + } + if ((me = create_entry(t, i, j, q, max)) < max) { + Term ref = Deref(q[me].reference); + + if (IsVarTerm(ref)) { + q[i].copy[j] = ref; + } else { + q[i].copy[j] = q[me].reference = UNFOLD_LOOP(ref, tailp); + } + return max; + } + return max+1; +} + + Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) { int lvl = push_text_stack(); Term t = Deref(inp); ssize_t qsize = 2048, qlen=0; - cl_connector *q = Malloc(qsize * sizeof(cl_connector)), *q0 = q; + cl_connector *q = Malloc(qsize * sizeof(cl_connector)); Term *s; + Int i=0; + qlen = 0; + HB=HR; if (IsVarTerm(t) || IsPrimitiveTerm(t)) { return t; } else { - Int i=0; - qlen = cp_link(t, 0, 0, q, qlen, listp); - while (i < qlen) { + // initialization + qlen = cp_link(t, i++, 1, q, qlen, listp); + while(i < qlen) { arity_t n, j; if (IsPairTerm( q[i].source )) { s = RepPair( q[i].source ); n = 2; + // fetch using header field. qlen = cp_link(q[i].header, i, 0, q, qlen, listp); + // fetch using standard access qlen = cp_link(s[1], i, 1, q, qlen, listp); } else { s = RepAppl( q[i].source )+1; @@ -1288,7 +1307,7 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) { i++; } } - Int i; + for (i =0; i < qlen; i++) { if (IsPairTerm(t)) { @@ -1296,12 +1315,12 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) { } else { RepAppl(q[i].source)[0] = q[i].header; - } } pop_text_stack(lvl); + HB = B->cp_h; return q[0].reference; } From 24b6908225a502567d6da54742fcc2acc7cd027e Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sat, 9 Feb 2019 09:43:26 +0000 Subject: [PATCH 039/101] write --- C/terms.c | 141 +++++++++++++++++++++++++++++++++++++++++------------- C/write.c | 9 ++-- 2 files changed, 113 insertions(+), 37 deletions(-) diff --git a/C/terms.c b/C/terms.c index 281567636..be54b2e2d 100644 --- a/C/terms.c +++ b/C/terms.c @@ -67,6 +67,8 @@ static int expand_vts(int args USES_REGS) { return true; } + + static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { @@ -86,18 +88,38 @@ static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { TR = TR0; } +//#define CELL *pt0, *pt0_end, *ptf; +//} non_singletons_t; + +#define IS_VISIT_MARKER \ + (IsPairTerm(d0) && RepPair(d0)>=(CELL*)to_visit0 && RepPair(d0) <= (CELL*)to_visit) + +#define VISIT_MARKER AbsPair((CELL*)to_visit) + +#define CYC_MARK_LIST \ + if (IsPairTerm(d0) && RepPair(d0)>=(CELL*)to_visit0 && RepPair(d0) <= (CELL*)to_visit) { \ + /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ + MaBind(ptd0, BREAK_LOOP(*RepPair(d0))); \ + } \ + +#define CYC_MARK_APPL \ + if (IsApplTerm(d0) && RepAppl(d0)>=(Term*)to_visit0 && RepAppl(d0) <= (Term*)to_visit) { \ + /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ + MaBind(ptd0, BREAK_LOOP(*RepAppl(d0))); \ + } \ + typedef struct { Term old_var; Term new_var; } * vcell; - + typedef struct non_single_struct_t { CELL *ptd0; CELL d0; CELL *pt0, *pt0_end, *ptf; } non_singletons_t; - + #define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \ \ struct non_single_struct_t *to_visit = Malloc( \ @@ -113,39 +135,39 @@ while (pt0 < pt0_end) { \ ++pt0; \ ptd0 = pt0; \ d0 = *ptd0; \ - list_loop: \ +list_loop: \ /*fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__);*/ \ deref_head(d0, var_in_term_unk); \ var_in_term_nvar : { \ - if (IsPairTerm(d0)) { \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ + if (IsPairTerm(d0)) { \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ } \ ptd0 = RepPair(d0); \ d0 = ptd0[0]; \ LIST0; \ - if (d0 == TermFreeTerm) \ + if (IS_VISIT_MARKER) \ goto restart; \ to_visit->pt0 = pt0; \ to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ + to_visit->ptd0 = ptd0; \ to_visit->d0 = d0; \ to_visit++; \ - *ptd0 = TermFreeTerm; \ + *ptd0 = VISIT_MARKER; \ pt0 = ptd0; \ pt0_end = pt0 + 1; \ goto list_loop; \ } else if (IsApplTerm(d0)) { \ register Functor f; \ /* store the terms to visit */ \ - ptd0 = RepAppl(d0); \ + ptd0 = RepAppl(d0); \ f = (Functor)(d0 = *ptd0); \ \ if (to_visit + 32 >= to_visit_max) { \ goto aux_overflow; \ } \ STRUCT0; \ - if (IsExtensionFunctor(f) || f == FunctorDollarVar || IsAtomTerm((CELL)f)) { \ + if (IS_VISIT_MARKER) { \ \ continue; \ } \ @@ -155,7 +177,7 @@ while (pt0 < pt0_end) { \ to_visit->d0 = d0; \ to_visit++; \ \ - *ptd0 = TermNil; \ + *ptd0 = VISIT_MARKER; \ Term d1 = ArityOfFunctor(f); \ pt0 = ptd0; \ pt0_end = ptd0 + d1; \ @@ -164,8 +186,8 @@ while (pt0 < pt0_end) { \ PRIMI0; \ continue; \ } \ - derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); - + derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar) + #define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {}) #define END_WALK() \ @@ -244,15 +266,13 @@ while (to_visit > to_visit0) { \ /** @brief routine to locate all variables in a term, and its applications */ -static Term cyclic_complex_term(register CELL *pt0, - register CELL *pt0_end USES_REGS) { - - int lvl = push_text_stack(); \ +static Term +cyclic_complex_term( CELL *pt0, CELL *pt0_end USES_REGS) { + int lvl = push_text_stack(); WALK_COMPLEX_TERM__(CYC_LIST, CYC_APPL, {}); /* leave an empty slot to fill in later */ END_WALK(); - return false; def_aux_overflow(); @@ -283,6 +303,56 @@ static Int cyclic_term(USES_REGS1) /* cyclic_term(+T) */ return Yap_IsCyclicTerm(Deref(ARG1)); } +static Term BREAK_LOOP(Int ddep) { + char buf[64]; + snprintf(buf, 63, "@^[" Int_FORMAT "]", ddep); + return MkAtomTerm(Yap_LookupAtom(buf)); +} + + + +/** + @brief routine to locate all variables in a term, and its applications */ + +static Term cycles_in_complex_term(register CELL *pt0, + register CELL *pt0_end USES_REGS) { + + int lvl = push_text_stack(); \ + WALK_COMPLEX_TERM__(CYC_MARK_LIST, CYC_MARK_APPL, {}); + /* leave an empty slot to fill in later */ + END_WALK(); + + + return false; + + def_aux_overflow(); +} + +bool Yap_CyclesInTerm(Term t USES_REGS) { + + if (IsVarTerm(t)) { + return false; + } else if (IsPrimitiveTerm(t)) { + return false; + } else { + return cycles_in_complex_term(&(t)-1, &(t) PASS_REGS); + } +} + +/** @pred cycles_in_term( + _T_ ) + + + Succeeds if the graph representation of the term has markers in every loop. Say, + the representation of a term `X` that obeys the equation `X=[X]` + term has a loop from the list to its head. + + +*/ +static Int cycles_in_term(USES_REGS1) /* cyclic_term(+T) */ +{ + return Yap_CyclesInTerm(Deref(ARG1)); +} + /** @brief routine to locate all variables in a term, and its applications */ @@ -1187,11 +1257,6 @@ static Int largest_numbervar(USES_REGS1) { return Yap_unify(MaxNumberedVar(Deref(ARG1), 2 PASS_REGS), ARG2); } -static Term BREAK_LOOP(Int ddep) { - char buf[64]; - snprintf(buf, 63, "@^[" Int_FORMAT "]", ddep); - return MkAtomTerm(Yap_LookupAtom(buf)); -} static Term UNFOLD_LOOP(Term t, Term *b) { Term os[2], o; @@ -1212,6 +1277,13 @@ typedef struct block_connector { CELL reference; //> term used to refer the copy. } cl_connector; +static bool +dataid(Term t, cl_connector *q) +{ + Int i = IntegerOfTerm(t); + cl_connector *d = q+i; + return d->me == i; //&& d->source == (void *; +} static Int create_entry(Term t, Int i, Int j, cl_connector *q, Int max) @@ -1233,17 +1305,17 @@ create_entry(Term t, Int i, Int j, cl_connector *q, Int max) ref = AbsAppl(ostart); *ostart++ = s[0]; } - if (H0 > s) { - return (s[0]-EndSpecials)/sizeof(CELL); + if (IsIntegerTerm(s[0]) && dataid(s[0], q)) { + return IntegerOfTerm(s[0]); } + q[max].me = max; q[max].source = t; q[max].copy = ostart; q[max].header = s[0]; q[max].reference = ref; - s[0] = max*sizeof(CELL)+EndSpecials; + s[0] = MkIntegerTerm(max); HR += n; - max++; return max; } @@ -1252,8 +1324,12 @@ Int cp_link(Term t,Int i, Int j, cl_connector *q, Int max, CELL *tailp) { Int me; + printf("%lx i=%ld,max=%ld,H=%p\n", t, i, max, HR), t = Deref(t); if (IsVarTerm(t) || IsPrimitiveTerm(t)) { + if (IsIntegerTerm(t) && dataid(t,q)) { + t = q[IntegerOfTerm(t)].header; + } q[i].copy[j] = t; return max; } @@ -1270,7 +1346,6 @@ Int cp_link(Term t,Int i, Int j, cl_connector *q, Int max, CELL *tailp) return max+1; } - Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) { int lvl = push_text_stack(); @@ -1279,15 +1354,14 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) { ssize_t qsize = 2048, qlen=0; cl_connector *q = Malloc(qsize * sizeof(cl_connector)); Term *s; - Int i=0; - qlen = 0; + Int i=0; HB=HR; - if (IsVarTerm(t) || IsPrimitiveTerm(t)) { + if (IsVarTerm(t) || (IsIntegerTerm(t) && !dataid(t,q))) { return t; } else { // initialization - qlen = cp_link(t, i++, 1, q, qlen, listp); + qlen = cp_link(t, 0, 0, q, qlen, listp); while(i < qlen) { arity_t n, j; if (IsPairTerm( q[i].source )) { @@ -1358,6 +1432,7 @@ void Yap_InitTermCPreds(void) { Yap_InitCPred("variable_in_term", 2, variable_in_term, 0); Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0); Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0); + Yap_InitCPred("cyles_in_term", 4, cycles_in_term, 0); CurrentModule = PROLOG_MODULE; Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); diff --git a/C/write.c b/C/write.c index 4d63c6d27..48e35f197 100644 --- a/C/write.c +++ b/C/write.c @@ -1099,13 +1099,14 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, wglb.Quote_illegal = false; wglb.Ignore_ops = false; wglb.MaxDepth = 0; - wglb.MaxArgs = 0; + wglb.MaxArgs = 0 ; wglb.lw = separator; - if ((flags & Handle_cyclics_f) && Yap_IsCyclicTerm(t) ){ - t = Yap_BreakCycles(t, 3, NULL PASS_REGS); + if ((flags & Handle_cyclics_f) ){ + t = Yap_CyclesInTerm(t, 3, NULL PASS_REGS); } - /* protect slots for portray */ + + /* protect slots for portray */ writeTerm(t, priority, 1, false, &wglb, &rwt); if (flags & New_Line_f) { if (flags & Fullstop_f) { From 3fdc260ee6dda5a2af4bdf6deba7f0331bb971c5 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 10 Feb 2019 00:18:08 +0000 Subject: [PATCH 040/101] fixes --- C/terms.c | 62 ++++++++++++++++++++++++++---------------------------- C/write.c | 9 +++++--- pl/top.yap | 7 ++---- 3 files changed, 38 insertions(+), 40 deletions(-) diff --git a/C/terms.c b/C/terms.c index be54b2e2d..529e122fd 100644 --- a/C/terms.c +++ b/C/terms.c @@ -88,26 +88,12 @@ static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { TR = TR0; } -//#define CELL *pt0, *pt0_end, *ptf; -//} non_singletons_t; - -#define IS_VISIT_MARKER \ - (IsPairTerm(d0) && RepPair(d0)>=(CELL*)to_visit0 && RepPair(d0) <= (CELL*)to_visit) +static inline bool IS_VISIT_MARKER(Term d0, void *to_visit, void *to_visit0) { + return IsPairTerm(d0) && RepPair(d0)>=(CELL*)to_visit0 && RepPair(d0) <= (CELL*)to_visit; +} #define VISIT_MARKER AbsPair((CELL*)to_visit) -#define CYC_MARK_LIST \ - if (IsPairTerm(d0) && RepPair(d0)>=(CELL*)to_visit0 && RepPair(d0) <= (CELL*)to_visit) { \ - /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ - MaBind(ptd0, BREAK_LOOP(*RepPair(d0))); \ - } \ - -#define CYC_MARK_APPL \ - if (IsApplTerm(d0) && RepAppl(d0)>=(Term*)to_visit0 && RepAppl(d0) <= (Term*)to_visit) { \ - /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ - MaBind(ptd0, BREAK_LOOP(*RepAppl(d0))); \ - } \ - typedef struct { Term old_var; @@ -127,6 +113,7 @@ typedef struct non_single_struct_t { *to_visit0 = to_visit, \ *to_visit_max = to_visit + 1024; \ \ + /*fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__);*/ \ while (to_visit >= to_visit0) { \ CELL d0; \ CELL *ptd0; \ @@ -136,7 +123,6 @@ while (pt0 < pt0_end) { \ ptd0 = pt0; \ d0 = *ptd0; \ list_loop: \ - /*fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__);*/ \ deref_head(d0, var_in_term_unk); \ var_in_term_nvar : { \ if (IsPairTerm(d0)) { \ @@ -146,7 +132,7 @@ list_loop: \ ptd0 = RepPair(d0); \ d0 = ptd0[0]; \ LIST0; \ - if (IS_VISIT_MARKER) \ + if (IS_VISIT_MARKER(d0,to_visit,to_visit0)) \ goto restart; \ to_visit->pt0 = pt0; \ to_visit->pt0_end = pt0_end; \ @@ -158,16 +144,16 @@ list_loop: \ pt0_end = pt0 + 1; \ goto list_loop; \ } else if (IsApplTerm(d0)) { \ - register Functor f; \ + Functor f; \ /* store the terms to visit */ \ ptd0 = RepAppl(d0); \ f = (Functor)(d0 = *ptd0); \ - \ - if (to_visit + 32 >= to_visit_max) { \ + if (IsExtensionFunctor(f)) continue; \ + if (to_visit + 32 >= to_visit_max) { \ goto aux_overflow; \ } \ STRUCT0; \ - if (IS_VISIT_MARKER) { \ + if ( IS_VISIT_MARKER(d0,to_visit,to_visit0)) { \ \ continue; \ } \ @@ -241,7 +227,7 @@ list_loop: \ } #define CYC_LIST \ - if (d0 == TermFreeTerm) { \ + if (IS_VISIT_MARKER(d0,to_visit,to_visit0)) { \ /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ while (to_visit > to_visit0) { \ to_visit--; \ @@ -253,7 +239,7 @@ while (to_visit > to_visit0) { \ } #define CYC_APPL \ - if (IsAtomTerm((CELL)f)) { \ + if (IS_VISIT_MARKER(d0,to_visit,to_visit0)) { \ while (to_visit > to_visit0) { \ to_visit--; \ to_visit->ptd0[0] = \ @@ -281,11 +267,11 @@ cyclic_complex_term( CELL *pt0, CELL *pt0_end USES_REGS) { bool Yap_IsCyclicTerm(Term t USES_REGS) { if (IsVarTerm(t)) { - return false; + return t; } else if (IsPrimitiveTerm(t)) { - return false; + return t; } else { - return cyclic_complex_term(&(t)-1, &(t)PASS_REGS); + return cyclic_complex_term(&(t)-1, &(t) PASS_REGS); } } @@ -314,11 +300,24 @@ static Term BREAK_LOOP(Int ddep) { /** @brief routine to locate all variables in a term, and its applications */ +#define CYC_MARK_LIST(d0) \ + if (IS_VISIT_MARKER(d0,to_visit,to_visit0)) { \ + /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ + MaBind(ptd0, BREAK_LOOP(d0)); \ + } \ + +#define CYC_MARK_APPL(d0) \ + if (IS_VISIT_MARKER(d0,to_visit,to_visit0)) { \ + /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ + MaBind(ptd0, BREAK_LOOP(d0)); \ +} \ + + static Term cycles_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) { int lvl = push_text_stack(); \ - WALK_COMPLEX_TERM__(CYC_MARK_LIST, CYC_MARK_APPL, {}); + WALK_COMPLEX_TERM__(CYC_MARK_LIST(d0), CYC_MARK_APPL(d0), {}); /* leave an empty slot to fill in later */ END_WALK(); @@ -331,9 +330,9 @@ static Term cycles_in_complex_term(register CELL *pt0, bool Yap_CyclesInTerm(Term t USES_REGS) { if (IsVarTerm(t)) { - return false; + return t; } else if (IsPrimitiveTerm(t)) { - return false; + return t; } else { return cycles_in_complex_term(&(t)-1, &(t) PASS_REGS); } @@ -1324,7 +1323,6 @@ Int cp_link(Term t,Int i, Int j, cl_connector *q, Int max, CELL *tailp) { Int me; - printf("%lx i=%ld,max=%ld,H=%p\n", t, i, max, HR), t = Deref(t); if (IsVarTerm(t) || IsPrimitiveTerm(t)) { if (IsIntegerTerm(t) && dataid(t,q)) { diff --git a/C/write.c b/C/write.c index 48e35f197..9e5b4a4a8 100644 --- a/C/write.c +++ b/C/write.c @@ -581,12 +581,14 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) { unsigned char *s; wtype atom_or_symbol; wrf stream = wglb->stream; - + if (atom == NULL) return; + s = RepAtom(atom)->UStrOfAE; + if (s[0] == '\0') + return; if (IsBlob(atom)) { wrputblob(RepAtom(atom), Quote_illegal, wglb); return; } - s = RepAtom(atom)->UStrOfAE; /* #define CRYPT_FOR_STEVE 1*/ #ifdef CRYPT_FOR_STEVE if (Yap_GetValue(AtomCryptAtoms) != TermNil && @@ -1103,7 +1105,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, wglb.lw = separator; if ((flags & Handle_cyclics_f) ){ - t = Yap_CyclesInTerm(t, 3, NULL PASS_REGS); + Yap_CyclesInTerm(t, 3, NULL PASS_REGS); } /* protect slots for portray */ @@ -1123,3 +1125,4 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, } pop_text_stack(lvl); } + diff --git a/pl/top.yap b/pl/top.yap index ec4c88d2a..fd2d9850f 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -378,11 +378,8 @@ live :- current_prolog_flag(break_level, BL ), ( BL \= 0 -> format(user_error, '[~p] ',[BL]) ; true ), - ( current_prolog_flag(toplevel_print_options, Opts) -> - write_term(user_error,Answ,Opts) ; - format(user_error,'~w',[Answ]) - ), - format(user_error,'.~n', []). + current_prolog_flag(toplevel_print_options, Opts), + write_term(user_error,Answ,Opts). '$another' :- format(user_error,' ? ',[]), From ac60bee30dc504bcb4f5218c34b94516e9bcf31a Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 11 Feb 2019 09:28:46 +0000 Subject: [PATCH 041/101] loops --- C/terms.c | 826 ++++++++++++++++++++++++++++----------------------- C/write.c | 2 +- H/Yapproto.h | 1 + 3 files changed, 460 insertions(+), 369 deletions(-) diff --git a/C/terms.c b/C/terms.c index 529e122fd..37fe30910 100644 --- a/C/terms.c +++ b/C/terms.c @@ -28,7 +28,8 @@ #include "YapHeap.h" -#define debug_pop_text_stack(l) [ if (to_visit != to_visit0) printf("%d\n",__LINE__); pop_text_stack(l) } +#define debug_pop_text_stack(l) [ if (to_visit != to_visit0) printf("%d\n",__LINE__); pop_text_stack(l) \ + } #include "attvar.h" #include "yapio.h" @@ -39,7 +40,6 @@ #define Malloc malloc #define Realloc realloc - static int expand_vts(int args USES_REGS) { UInt expand = LOCAL_Error_Size; yap_error_number yap_errno = LOCAL_Error_TYPE; @@ -67,8 +67,6 @@ static int expand_vts(int args USES_REGS) { return true; } - - static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { @@ -88,173 +86,189 @@ static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { TR = TR0; } -static inline bool IS_VISIT_MARKER(Term d0, void *to_visit, void *to_visit0) { - return IsPairTerm(d0) && RepPair(d0)>=(CELL*)to_visit0 && RepPair(d0) <= (CELL*)to_visit; -} +//#define CELL *pt0, *pt0_end, *ptf; +//} non_singletons_t; -#define VISIT_MARKER AbsPair((CELL*)to_visit) +#define IS_VISIT_MARKER \ + (IsPairTerm(d0) && RepPair(d0) >= (CELL *)to_visit0 && \ + RepPair(d0) <= (CELL *)to_visit) +#define VISIT_MARKER AbsPair((CELL *)to_visit) + +#define CYC_MARK_LIST \ + if (IsPairTerm(d0) && RepPair(d0) >= (CELL *)to_visit0 && \ + RepPair(d0) <= (CELL *)to_visit) { \ + /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ + *ptf++ = BREAK_LOOP(to_visit - to_visit0); \ + continue; \ + } + +#define CYC_MARK_APPL \ + if (IsApplTerm(d0) && RepAppl(d0) >= (Term *)to_visit0 && \ + RepAppl(d0) <= (Term *)to_visit) { \ + /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ + *ptf++ = BREAK_LOOP(to_visit - to_visit0); \ + continue; \ + } typedef struct { Term old_var; Term new_var; } * vcell; - + typedef struct non_single_struct_t { CELL *ptd0; CELL d0; CELL *pt0, *pt0_end, *ptf; } non_singletons_t; - -#define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \ - \ - struct non_single_struct_t *to_visit = Malloc( \ - 1024 * sizeof(struct non_single_struct_t)), \ - *to_visit0 = to_visit, \ - *to_visit_max = to_visit + 1024; \ - \ - /*fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__);*/ \ + +#define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \ + \ + struct non_single_struct_t *to_visit = Malloc( \ + 1024 * sizeof(struct non_single_struct_t)), \ + *to_visit0 = to_visit, \ + *to_visit_max = to_visit + 1024; \ + \ while (to_visit >= to_visit0) { \ - CELL d0; \ - CELL *ptd0; \ - restart:\ -while (pt0 < pt0_end) { \ - ++pt0; \ - ptd0 = pt0; \ - d0 = *ptd0; \ + CELL d0; \ + CELL *ptd0; \ +restart: \ + while (pt0 < pt0_end) { \ + ++pt0; \ + ptd0 = pt0; \ + d0 = *ptd0; \ list_loop: \ - deref_head(d0, var_in_term_unk); \ - var_in_term_nvar : { \ - if (IsPairTerm(d0)) { \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - ptd0 = RepPair(d0); \ - d0 = ptd0[0]; \ - LIST0; \ - if (IS_VISIT_MARKER(d0,to_visit,to_visit0)) \ - goto restart; \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ - to_visit->d0 = d0; \ - to_visit++; \ - *ptd0 = VISIT_MARKER; \ - pt0 = ptd0; \ - pt0_end = pt0 + 1; \ - goto list_loop; \ - } else if (IsApplTerm(d0)) { \ - Functor f; \ - /* store the terms to visit */ \ - ptd0 = RepAppl(d0); \ - f = (Functor)(d0 = *ptd0); \ - if (IsExtensionFunctor(f)) continue; \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - STRUCT0; \ - if ( IS_VISIT_MARKER(d0,to_visit,to_visit0)) { \ - \ - continue; \ - } \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ - to_visit->d0 = d0; \ - to_visit++; \ - \ - *ptd0 = VISIT_MARKER; \ - Term d1 = ArityOfFunctor(f); \ - pt0 = ptd0; \ - pt0_end = ptd0 + d1; \ - continue; \ - } else { \ - PRIMI0; \ - continue; \ - } \ - derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar) - + /*fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__);*/ \ + deref_head(d0, var_in_term_unk); \ +var_in_term_nvar : { \ + if (IsPairTerm(d0)) { \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + ptd0 = RepPair(d0); \ + d0 = ptd0[0]; \ + LIST0; \ + if (IS_VISIT_MARKER) \ + goto restart; \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = d0; \ + to_visit++; \ + *ptd0 = VISIT_MARKER; \ + pt0 = ptd0; \ + pt0_end = pt0 + 1; \ + goto list_loop; \ + } else if (IsApplTerm(d0)) { \ + register Functor f; \ + /* store the terms to visit */ \ + ptd0 = RepAppl(d0); \ + f = (Functor)(d0 = *ptd0); \ + \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + STRUCT0; \ + if (IS_VISIT_MARKER) { \ + \ + continue; \ + } \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = d0; \ + to_visit++; \ + \ + *ptd0 = VISIT_MARKER; \ + Term d1 = ArityOfFunctor(f); \ + pt0 = ptd0; \ + pt0_end = ptd0 + d1; \ + continue; \ + } else { \ + PRIMI0; \ + continue; \ + } \ + derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar) + #define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {}) -#define END_WALK() \ - }\ - }\ - /* Do we still have compound terms to visit */ \ - to_visit--; \ - if (to_visit >= to_visit0) {\ - pt0 = to_visit->pt0; \ - pt0_end = to_visit->pt0_end;\ - *to_visit->ptd0 = to_visit->d0; \ - }\ - }\ - pop_text_stack(lvl); +#define END_WALK() \ + } \ + } \ + /* Do we still have compound terms to visit */ \ + to_visit--; \ + if (to_visit >= to_visit0) { \ + pt0 = to_visit->pt0; \ + pt0_end = to_visit->pt0_end; \ + *to_visit->ptd0 = to_visit->d0; \ + } \ + } \ + pop_text_stack(lvl); -#define def_aux_overflow() \ - aux_overflow : { \ - size_t d1 = to_visit - to_visit0; \ +#define def_aux_overflow() \ + aux_overflow : { \ + size_t d1 = to_visit - to_visit0; \ size_t d2 = to_visit_max - to_visit0; \ - to_visit0 = \ - Realloc(to_visit0, (d2 + 128) * sizeof(struct non_single_struct_t)); \ - to_visit = to_visit0 + d1; \ - to_visit_max = to_visit0 + (d2 + 128); \ - pt0--; \ - } \ + to_visit0 = \ + Realloc(to_visit0, (d2 + 128) * sizeof(struct non_single_struct_t)); \ + to_visit = to_visit0 + d1; \ + to_visit_max = to_visit0 + (d2 + 128); \ + pt0--; \ + } \ goto restart; -#define def_trail_overflow() \ - trail_overflow : { \ - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ - LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - pop_text_stack(lvl); \ - return 0L; \ +#define def_trail_overflow() \ + trail_overflow : { \ + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ + LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + pop_text_stack(lvl); \ + return 0L; \ } -#define def_global_overflow() \ - global_overflow : { \ - while (to_visit > to_visit0) { \ - to_visit--; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ - LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); \ - return false; \ +#define def_global_overflow() \ + global_overflow : { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ + LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); \ + return false; \ } -#define CYC_LIST \ - if (IS_VISIT_MARKER(d0,to_visit,to_visit0)) { \ +#define CYC_LIST \ + if (d0 == TermFreeTerm) { \ /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ -while (to_visit > to_visit0) { \ - to_visit--; \ - to_visit->ptd0[0] = \ - to_visit->d0; \ - } \ - pop_text_stack(lvl); /*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ - return true; \ + while (to_visit > to_visit0) { \ + to_visit--; \ + to_visit->ptd0[0] = to_visit->d0; \ + } \ + pop_text_stack(lvl); /*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, \ + __FUNCTION__);*/ \ + return true; \ } -#define CYC_APPL \ - if (IS_VISIT_MARKER(d0,to_visit,to_visit0)) { \ - while (to_visit > to_visit0) { \ - to_visit--; \ - to_visit->ptd0[0] = \ - to_visit->d0; \ - } \ +#define CYC_APPL \ + if (IsAtomTerm((CELL)f)) { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + to_visit->ptd0[0] = to_visit->d0; \ + } \ /*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ - return true; \ + return true; \ } /** @brief routine to locate all variables in a term, and its applications */ -static Term -cyclic_complex_term( CELL *pt0, CELL *pt0_end USES_REGS) { - int lvl = push_text_stack(); +static Term cyclic_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { + int lvl = push_text_stack(); WALK_COMPLEX_TERM__(CYC_LIST, CYC_APPL, {}); /* leave an empty slot to fill in later */ END_WALK(); @@ -267,11 +281,11 @@ cyclic_complex_term( CELL *pt0, CELL *pt0_end USES_REGS) { bool Yap_IsCyclicTerm(Term t USES_REGS) { if (IsVarTerm(t)) { - return t; + return false; } else if (IsPrimitiveTerm(t)) { - return t; + return false; } else { - return cyclic_complex_term(&(t)-1, &(t) PASS_REGS); + return cyclic_complex_term(&(t)-1, &(t)PASS_REGS); } } @@ -295,54 +309,135 @@ static Term BREAK_LOOP(Int ddep) { return MkAtomTerm(Yap_LookupAtom(buf)); } - - /** @brief routine to locate all variables in a term, and its applications */ -#define CYC_MARK_LIST(d0) \ - if (IS_VISIT_MARKER(d0,to_visit,to_visit0)) { \ - /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ - MaBind(ptd0, BREAK_LOOP(d0)); \ - } \ +static int cycles_in_complex_term(register CELL *pt0, + register CELL *pt0_end USES_REGS) { -#define CYC_MARK_APPL(d0) \ - if (IS_VISIT_MARKER(d0,to_visit,to_visit0)) { \ - /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ - MaBind(ptd0, BREAK_LOOP(d0)); \ -} \ - + int lvl = push_text_stack(); + int rc = 0; + CELL *ptf; + struct non_single_struct_t *to_visit = Malloc( + 1024 * sizeof(struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit + 1024; + ptf = HR; + while (to_visit >= to_visit0) { + CELL d0; + CELL *ptd0; + restart: + while (pt0 < pt0_end) { + ++pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, var_in_term_unk); + var_in_term_nvar : { + if (IsPairTerm(d0)) { + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + ptd0 = RepPair(d0); + d0 = ptd0[0]; + if (IS_VISIT_MARKER) { + rc++; + *ptf++ = BREAK_LOOP(to_visit - to_visit0); + continue; + } + *ptf++ = AbsPair(HR); + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->ptd0 = ptd0; + to_visit->d0 = d0; + to_visit->ptf = ptf; + to_visit++; + ptf = HR; + HR += 2; + *ptd0 = VISIT_MARKER; + pt0 = ptd0; + pt0_end = pt0+1; + ptf = HR - 2; + goto list_loop; + } else if (IsApplTerm(d0)) { + register Functor f; + /* store the terms to visit */ + ptd0 = RepAppl(d0); + f = (Functor)(d0 = *ptd0); + if (IsExtensionFunctor(f)) { + *ptf++ = d0; + continue; + } + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + if (IS_VISIT_MARKER) { + rc++; + *ptf++ = BREAK_LOOP(to_visit - to_visit0); + continue; + } + *ptf++ = AbsAppl(HR); + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->ptd0 = ptd0; + to_visit->d0 = d0; + to_visit->ptf = ptf; + to_visit++; -static Term cycles_in_complex_term(register CELL *pt0, - register CELL *pt0_end USES_REGS) { + *ptd0 = VISIT_MARKER; + *HR++ = (CELL)f; + ptf = HR; + Term d1 = ArityOfFunctor(f); + pt0 = ptd0; + pt0_end = ptd0 + (d1); + HR+=d1; + continue; + } else { + *ptf++ = d0; + continue; + } + derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); + *ptf++ = d0; + } + } + /* Do we still have compound terms to visit */ + to_visit--; + if (to_visit >= to_visit0) { + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + *to_visit->ptd0 = to_visit->d0; + } + } + pop_text_stack(lvl); - int lvl = push_text_stack(); \ - WALK_COMPLEX_TERM__(CYC_MARK_LIST(d0), CYC_MARK_APPL(d0), {}); - /* leave an empty slot to fill in later */ - END_WALK(); - - - return false; + return rc; def_aux_overflow(); + return -1; } -bool Yap_CyclesInTerm(Term t USES_REGS) { +Term Yap_CyclesInTerm(Term t USES_REGS) { if (IsVarTerm(t)) { return t; } else if (IsPrimitiveTerm(t)) { return t; } else { - return cycles_in_complex_term(&(t)-1, &(t) PASS_REGS); + CELL *Hi = HR; + if ( cycles_in_complex_term(&(t)-1, &(t)PASS_REGS) >0) { + return IsPairTerm(t) ? AbsPair(Hi) : AbsAppl(Hi); + } else { + HR = Hi; + return t; + } } } /** @pred cycles_in_term( + _T_ ) - Succeeds if the graph representation of the term has markers in every loop. Say, - the representation of a term `X` that obeys the equation `X=[X]` + Succeeds if the graph representation of the term has markers in every + loop. Say, the representation of a term `X` that obeys the equation `X=[X]` term has a loop from the list to its head. @@ -355,10 +450,10 @@ static Int cycles_in_term(USES_REGS1) /* cyclic_term(+T) */ /** @brief routine to locate all variables in a term, and its applications */ -static bool ground_complex_term(register CELL *pt0, - register CELL *pt0_end USES_REGS) { +static bool ground_complex_term(register CELL * pt0, + register CELL * pt0_end USES_REGS) { - int lvl = push_text_stack(); \ + int lvl = push_text_stack(); WALK_COMPLEX_TERM(); /* leave an empty slot to fill in later */ while (to_visit > to_visit0) { @@ -383,13 +478,13 @@ static bool ground_complex_term(register CELL *pt0, bool Yap_IsGroundTerm(Term t) { CACHE_REGS - if (IsVarTerm(t)) { - return false; - } else if (IsPrimitiveTerm(t)) { - return true; - } else { - return ground_complex_term(&(t)-1, &(t)PASS_REGS); - } + if (IsVarTerm(t)) { + return false; + } else if (IsPrimitiveTerm(t)) { + return true; + } else { + return ground_complex_term(&(t)-1, &(t)PASS_REGS); + } } /** @pred ground( _T_) is iso @@ -404,14 +499,14 @@ static Int ground(USES_REGS1) /* ground(+T) */ return Yap_IsGroundTerm(Deref(ARG1)); } -static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end, - Term v USES_REGS) { +static Int var_in_complex_term(register CELL * pt0, register CELL * pt0_end, + Term v USES_REGS) { - int lvl = push_text_stack(); \ + int lvl = push_text_stack(); WALK_COMPLEX_TERM(); if ((CELL)ptd0 == v) { /* we found it */ - /* Do we still have compound terms to visit */ + /* Do we still have compound terms to visit */ while (to_visit > to_visit0) { to_visit--; @@ -438,8 +533,8 @@ static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end, def_aux_overflow(); } -static Int var_in_term(Term v, - Term t USES_REGS) /* variables in term t */ +static Int var_in_term( + Term v, Term t USES_REGS) /* variables in term t */ { must_be_variable(v); t = Deref(t); @@ -454,8 +549,8 @@ static Int var_in_term(Term v, /** @pred variable_in_term(? _Term_,? _Var_) -Succeed if the second argument _Var_ is a variable and occurs in -term _Term_. + Succeed if the second argument _Var_ is a variable and occurs in + term _Term_. */ @@ -466,15 +561,15 @@ static Int variable_in_term(USES_REGS1) { /** * @brief routine to locate all variables in a term, and its applications. */ -static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, - Term inp USES_REGS) { +static Term vars_in_complex_term(register CELL * pt0, register CELL * pt0_end, + Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - int lvl = push_text_stack(); - - push_text_stack(); \ + int lvl = push_text_stack(); + + push_text_stack(); WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ *ptd0 = TermNil; @@ -520,18 +615,20 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } /** - * @pred variables_in_term( +_T_, +_SetOfVariables_, +_ExtendedSetOfVariables_ ) + * @pred variables_in_term( +_T_, +_SetOfVariables_, +_ExtendedSetOfVariables_ + * ) * * _SetOfVariables_ must be a list of unbound variables. If so, * _ExtendedSetOfVariables_ will include all te variables in the union * of `vars(_T_)` and _SetOfVariables_. */ -static Int variables_in_term(USES_REGS1) /* variables in term t */ +static Int variables_in_term( + USES_REGS1) /* variables in term t */ { Term out, inp; int count; -restart: + restart: count = 0; inp = Deref(ARG2); while (!IsVarTerm(inp) && IsPairTerm(inp)) { @@ -542,11 +639,11 @@ restart: TrailTerm(TR++) = t; count++; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - clean_tr(TR - count PASS_REGS); - if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) { - return false; - } - goto restart; + clean_tr(TR - count PASS_REGS); + if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) { + return false; + } + goto restart; } } inp = TailOfTerm(inp); @@ -556,7 +653,7 @@ restart: out = vars_in_complex_term(&(t)-1, &(t), ARG2 PASS_REGS); if (out == 0L) { if (!expand_vts(3 PASS_REGS)) - return false; + return false; } } while (out == 0L); clean_tr(TR - count PASS_REGS); @@ -574,7 +671,8 @@ restart: */ -static Int p_term_variables3(USES_REGS1) /* variables in term t */ +static Int p_term_variables3( + USES_REGS1) /* variables in term t */ { Term out; @@ -583,7 +681,7 @@ static Int p_term_variables3(USES_REGS1) /* variables in term t */ if (IsVarTerm(t)) { Term out = Yap_MkNewPairTerm(); return Yap_unify(t, HeadOfTerm(out)) && - Yap_unify(ARG3, TailOfTerm(out)) && Yap_unify(out, ARG2); + Yap_unify(ARG3, TailOfTerm(out)) && Yap_unify(out, ARG2); } else if (IsPrimitiveTerm(t)) { return Yap_unify(ARG2, ARG3); } else { @@ -591,7 +689,7 @@ static Int p_term_variables3(USES_REGS1) /* variables in term t */ } if (out == 0L) { if (!expand_vts(3 PASS_REGS)) - return false; + return false; } } while (out == 0L); @@ -601,12 +699,12 @@ static Int p_term_variables3(USES_REGS1) /* variables in term t */ /** * Exports a nil-terminated list with all the variables in a term. * @param[t] the term - * @param[arity] the arity of the calling predicate (required for exact garbage - * collection). + * @param[arity] the arity of the calling predicate (required for exact + * garbage collection). * @param[USES_REGS] threading */ Term Yap_TermVariables( - Term t, UInt arity USES_REGS) /* variables in term t */ + Term t, UInt arity USES_REGS) /* variables in term t */ { Term out; @@ -621,7 +719,7 @@ Term Yap_TermVariables( } if (out == 0L) { if (!expand_vts(arity PASS_REGS)) - return false; + return false; } } while (out == 0L); return out; @@ -637,7 +735,8 @@ Term Yap_TermVariables( */ -static Int p_term_variables(USES_REGS1) /* variables in term t */ +static Int p_term_variables( + USES_REGS1) /* variables in term t */ { Term out; @@ -652,7 +751,7 @@ static Int p_term_variables(USES_REGS1) /* variables in term t */ out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); if (out == 0L) { if (!expand_vts(3 PASS_REGS)) - return false; + return false; } } while (out == 0L); return Yap_unify(ARG2, out); @@ -665,13 +764,13 @@ typedef struct att_rec { CELL oval; } att_rec_t; -static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, - Term inp USES_REGS) { +static Term attvars_in_complex_term( + register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = inp; - int lvl = push_text_stack(); \ - + int lvl = push_text_stack(); + WALK_COMPLEX_TERM(); if (IsAttVar(ptd0)) { /* do or pt2 are unbound */ @@ -682,7 +781,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, if (HR + 1024 > ASP) { goto global_overflow; } - output = MkPairTerm( (CELL) & (a0->Done), output); + output = MkPairTerm((CELL) & (a0->Done), output); /* store the terms to visit */ if (to_visit + 32 >= to_visit_max) { goto aux_overflow; @@ -714,7 +813,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } /*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__)*/; - return (output); + return (output); def_aux_overflow(); def_global_overflow(); @@ -742,57 +841,57 @@ static Int p_term_attvars(USES_REGS1) /* variables in term t */ } if (out == 0L) { if (!expand_vts(3 PASS_REGS)) - return false; + return false; } } while (out == 0L); return Yap_unify(ARG2, out); } -/** @brief output the difference between variables in _T_ and variables in some - * list. +/** @brief output the difference between variables in _T_ and variables in + * some list. */ -static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, - Term inp USES_REGS) { +static Term new_vars_in_complex_term( + register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; - int lvl = push_text_stack(); \ - HB=ASP; + int lvl = push_text_stack(); + HB = ASP; CELL output = TermNil; { while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { - YapBind( VarOfTerm(t), TermFoundVar ); - if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { + YapBind(VarOfTerm(t), TermFoundVar); + if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - goto trail_overflow; - } - pop_text_stack( lvl ); - } + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; + } + pop_text_stack(lvl); + } } inp = TailOfTerm(inp); } } WALK_COMPLEX_TERM(); - output = MkPairTerm((CELL)ptd0,output); - YapBind( ptd0, TermFoundVar ); - if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - goto trail_overflow; - } - } + output = MkPairTerm((CELL)ptd0, output); + YapBind(ptd0, TermFoundVar); + if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; + } + } /* leave an empty slot to fill in later */ if (HR + 1024 > ASP) { goto global_overflow; } END_WALK(); - + clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); HB = B->cp_h; return output; - + def_aux_overflow(); def_trail_overflow(); @@ -805,14 +904,14 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Unify _Variables_ with the list of all variables of term - _Term_ that do not occur in _CurrentVariables_. The variables occur in the - order of their first appearance when traversing the term depth-first, - left-to-right. + _Term_ that do not occur in _CurrentVariables_. The variables occur in + the order of their first appearance when traversing the term depth-first, + left-to-right. */ -static Int -p_new_variables_in_term(USES_REGS1) /* variables within term t */ +static Int p_new_variables_in_term( + USES_REGS1) /* variables within term t */ { Term out; @@ -825,32 +924,32 @@ p_new_variables_in_term(USES_REGS1) /* variables within term t */ } if (out == 0L) { if (!expand_vts(3 PASS_REGS)) - return false; + return false; } } while (out == 0L); return Yap_unify(ARG3, out); } -#define FOUND_VAR() \ - if (d0 == TermFoundVar) { \ - /* leave an empty slot to fill in later */ \ - if (HR + 1024 > ASP) { \ - goto global_overflow; \ - } \ - HR[1] = AbsPair(HR + 2); \ - HR += 2; \ - HR[-2] = (CELL)ptd0; \ - *ptd0 = TermNil; \ +#define FOUND_VAR() \ + if (d0 == TermFoundVar) { \ + /* leave an empty slot to fill in later */ \ + if (HR + 1024 > ASP) { \ + goto global_overflow; \ + } \ + HR[1] = AbsPair(HR + 2); \ + HR += 2; \ + HR[-2] = (CELL)ptd0; \ + *ptd0 = TermNil; \ } -static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, - Term inp USES_REGS) { +static Term vars_within_complex_term( + register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - int lvl = push_text_stack(); - + int lvl = push_text_stack(); + while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { @@ -858,7 +957,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, *ptr = TermFoundVar; TrailTerm(TR++) = t; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true); + Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true); } } inp = TailOfTerm(inp); @@ -905,14 +1004,14 @@ static Int p_variables_within_term(USES_REGS1) /* variables within term t */ } if (out == 0L) { if (!expand_vts(3 PASS_REGS)) - return false; + return false; } } while (out == 0L); return Yap_unify(ARG3, out); } -static Term free_vars_in_complex_term(CELL *pt0, CELL *pt0_end, - tr_fr_ptr TR0 USES_REGS) { +static Term free_vars_in_complex_term(CELL * pt0, CELL * pt0_end, + tr_fr_ptr TR0 USES_REGS) { Term o = TermNil; CELL *InitialH = HR; int lvl = push_text_stack(); @@ -938,7 +1037,6 @@ static Term free_vars_in_complex_term(CELL *pt0, CELL *pt0_end, TrailTerm(TR++) = (CELL)ptd0; END_WALK(); - clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); return o; @@ -950,10 +1048,10 @@ static Term free_vars_in_complex_term(CELL *pt0, CELL *pt0_end, def_global_overflow(); } -static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, - tr_fr_ptr TR0 USES_REGS) { +static Term bind_vars_in_complex_term(CELL * pt0, CELL * pt0_end, + tr_fr_ptr TR0 USES_REGS) { CELL *InitialH = HR; - int lvl = push_text_stack(); + int lvl = push_text_stack(); WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ *ptd0 = TermFoundVar; @@ -962,9 +1060,9 @@ static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, /* Trail overflow */ if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { while (to_visit > to_visit0) { - to_visit--; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; + to_visit--; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; } goto trail_overflow; } @@ -981,8 +1079,8 @@ static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, def_trail_overflow(); } -static Int -p_free_variables_in_term(USES_REGS1) /* variables within term t */ +static Int p_free_variables_in_term( + USES_REGS1) /* variables within term t */ { Term out; Term t, t0; @@ -995,20 +1093,20 @@ p_free_variables_in_term(USES_REGS1) /* variables within term t */ while (!IsVarTerm(t) && IsApplTerm(t)) { Functor f = FunctorOfTerm(t); if (f == FunctorHat) { - out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1, - TR0 PASS_REGS); - if (out == 0L) { - goto trail_overflow; - } + out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1, + TR0 PASS_REGS); + if (out == 0L) { + goto trail_overflow; + } } else if (f == FunctorModule) { - found_module = ArgOfTerm(1, t); + found_module = ArgOfTerm(1, t); } else if (f == FunctorCall) { - t = ArgOfTerm(1, t); + t = ArgOfTerm(1, t); } else if (f == FunctorExecuteInMod) { - found_module = ArgOfTerm(2, t); - t = ArgOfTerm(1, t); + found_module = ArgOfTerm(2, t); + t = ArgOfTerm(1, t); } else { - break; + break; } t = ArgOfTerm(2, t); } @@ -1020,7 +1118,7 @@ p_free_variables_in_term(USES_REGS1) /* variables within term t */ if (out == 0L) { trail_overflow: if (!expand_vts(3 PASS_REGS)) - return false; + return false; } } while (out == 0L); if (found_module && t != t0) { @@ -1032,18 +1130,19 @@ p_free_variables_in_term(USES_REGS1) /* variables within term t */ return Yap_unify(ARG2, t) && Yap_unify(ARG3, out); } -#define FOUND_VAR_AGAIN() \ - if (d0 == TermFoundVar) { \ - CELL *pt2 = pt0; \ - while (IsVarTerm(*pt2)) \ - pt2 = (CELL *)(*pt2); \ - HR[1] = AbsPair(HR + 2); \ - HR[0] = (CELL)pt2; \ - HR += 2; \ - *pt2 = TermRefoundVar; \ +#define FOUND_VAR_AGAIN() \ + if (d0 == TermFoundVar) { \ + CELL *pt2 = pt0; \ + while (IsVarTerm(*pt2)) \ + pt2 = (CELL *)(*pt2); \ + HR[1] = AbsPair(HR + 2); \ + HR[0] = (CELL)pt2; \ + HR += 2; \ + *pt2 = TermRefoundVar; \ } -static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { +static Term non_singletons_in_complex_term(CELL * pt0, + CELL * pt0_end USES_REGS) { tr_fr_ptr TR0 = TR; CELL *InitialH = HR; HB = (CELL *)ASP; @@ -1051,14 +1150,14 @@ static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { int lvl = push_text_stack(); WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); /* do or pt2 are unbound */ - YapBind(ptd0,TermFoundVar); - goto restart; + YapBind(ptd0, TermFoundVar); + goto restart; END_WALK(); clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); - HB = (CELL*)B->cp_b; + HB = (CELL *)B->cp_b; if (HR != InitialH) { /* close the list */ HR[-1] = Deref(ARG2); @@ -1071,7 +1170,7 @@ static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { } static Int p_non_singletons_in_term( - USES_REGS1) /* non_singletons in term t */ + USES_REGS1) /* non_singletons in term t */ { Term t; Term out; @@ -1108,23 +1207,23 @@ static void renumbervar(Term t, Int me USES_REGS) { ts[1] = MkIntegerTerm(me); } -#define RENUMBER_SINGLES \ - if (singles ) { \ - renumbervar(d0, numbv++ PASS_REGS); \ - goto restart; \ +#define RENUMBER_SINGLES \ + if (singles) { \ + renumbervar(d0, numbv++ PASS_REGS); \ + goto restart; \ } -static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, - int singles USES_REGS) { +static Int numbervars_in_complex_term(CELL * pt0, CELL * pt0_end, Int numbv, + int singles USES_REGS) { tr_fr_ptr TR0 = TR; CELL *InitialH = HR; - int lvl = push_text_stack(); - + int lvl = push_text_stack(); + WALK_COMPLEX_TERM__({}, {}, {}); if (IsAttVar(pt0)) - continue; + continue; /* do or pt2 are unbound */ if (singles || 0) d0 = numbervar_singleton(PASS_REGS1); @@ -1145,25 +1244,24 @@ static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, def_aux_overflow(); def_global_overflow(); - } Int Yap_NumberVars(Term inp, Int numbv, - bool handle_singles) /* - * numbervariables in term t */ + bool handle_singles) /* + * numbervariables in term t */ { CACHE_REGS - Int out; + Int out; Term t; -restart: + restart: t = Deref(inp); if (IsPrimitiveTerm(t)) { return numbv; } else { out = numbervars_in_complex_term(&(t)-1, &(t), numbv, - handle_singles PASS_REGS); + handle_singles PASS_REGS); } if (out < numbv) { if (!expand_vts(3 PASS_REGS)) @@ -1198,17 +1296,18 @@ static Int p_numbervars(USES_REGS1) { return Yap_unify(ARG3, MkIntegerTerm(out)); } -#define MAX_NUMBERED \ - if (FunctorOfTerm(d0) == FunctorDollarVar) { \ - Term t1 = ArgOfTerm(1, d0); \ - Int i; \ - if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \ - *maxp = i; \ - goto restart; \ +#define MAX_NUMBERED \ + if (FunctorOfTerm(d0) == FunctorDollarVar) { \ + Term t1 = ArgOfTerm(1, d0); \ + Int i; \ + if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \ + *maxp = i; \ + goto restart; \ } -static int max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) { - int lvl = push_text_stack(); +static int max_numbered_var(CELL * pt0, CELL * pt0_end, + Int * maxp USES_REGS) { + int lvl = push_text_stack(); WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {}); END_WALK(); /* Do we still have compound terms to visit */ @@ -1256,8 +1355,7 @@ static Int largest_numbervar(USES_REGS1) { return Yap_unify(MaxNumberedVar(Deref(ARG1), 2 PASS_REGS), ARG2); } - -static Term UNFOLD_LOOP(Term t, Term *b) { +static Term UNFOLD_LOOP(Term t, Term * b) { Term os[2], o; os[0] = o = MkVarTerm(); os[1] = t; @@ -1267,26 +1365,21 @@ static Term UNFOLD_LOOP(Term t, Term *b) { return o; } - typedef struct block_connector { - Int me; //> index in the array; - Term source; //> source; - CELL *copy; //> copy; - CELL header; //> backup of first word of the source data; - CELL reference; //> term used to refer the copy. + Int me; //> index in the array; + Term source; //> source; + CELL *copy; //> copy; + CELL header; //> backup of first word of the source data; + CELL reference; //> term used to refer the copy. } cl_connector; -static bool -dataid(Term t, cl_connector *q) -{ +static bool dataid(Term t, cl_connector * q) { Int i = IntegerOfTerm(t); - cl_connector *d = q+i; + cl_connector *d = q + i; return d->me == i; //&& d->source == (void *; } -static Int -create_entry(Term t, Int i, Int j, cl_connector *q, Int max) -{ +static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { Term ref, h, *s, *ostart; bool pair = false; ssize_t n; @@ -1294,7 +1387,7 @@ create_entry(Term t, Int i, Int j, cl_connector *q, Int max) ostart = HR; if (IsPairTerm(t)) { s = RepPair(t); - n = 2; + n = 2; pair = true; ref = AbsPair(ostart); } else { @@ -1318,21 +1411,19 @@ create_entry(Term t, Int i, Int j, cl_connector *q, Int max) return max; } - -Int cp_link(Term t,Int i, Int j, cl_connector *q, Int max, CELL *tailp) -{ +Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) { Int me; - t = Deref(t); + printf("%lx i=%ld,max=%ld,H=%p\n", t, i, max, HR), t = Deref(t); if (IsVarTerm(t) || IsPrimitiveTerm(t)) { - if (IsIntegerTerm(t) && dataid(t,q)) { + if (IsIntegerTerm(t) && dataid(t, q)) { t = q[IntegerOfTerm(t)].header; } q[i].copy[j] = t; return max; } if ((me = create_entry(t, i, j, q, max)) < max) { - Term ref = Deref(q[me].reference); + Term ref = Deref(q[me].reference); if (IsVarTerm(ref)) { q[i].copy[j] = ref; @@ -1341,59 +1432,58 @@ Int cp_link(Term t,Int i, Int j, cl_connector *q, Int max, CELL *tailp) } return max; } - return max+1; + return max + 1; } -Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) { +Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) { int lvl = push_text_stack(); Term t = Deref(inp); - ssize_t qsize = 2048, qlen=0; + ssize_t qsize = 2048, qlen = 0; cl_connector *q = Malloc(qsize * sizeof(cl_connector)); Term *s; - Int i=0; - - HB=HR; - if (IsVarTerm(t) || (IsIntegerTerm(t) && !dataid(t,q))) { + Int i = 0; + + HB = HR; + if (IsVarTerm(t) || (IsIntegerTerm(t) && !dataid(t, q))) { return t; } else { // initialization qlen = cp_link(t, 0, 0, q, qlen, listp); - while(i < qlen) { + while (i < qlen) { arity_t n, j; - if (IsPairTerm( q[i].source )) { - s = RepPair( q[i].source ); + if (IsPairTerm(q[i].source)) { + s = RepPair(q[i].source); n = 2; // fetch using header field. - qlen = cp_link(q[i].header, i, 0, q, qlen, listp); + qlen = cp_link(q[i].header, i, 0, q, qlen, listp); // fetch using standard access - qlen = cp_link(s[1], i, 1, q, qlen, listp); + qlen = cp_link(s[1], i, 1, q, qlen, listp); } else { - s = RepAppl( q[i].source )+1; + s = RepAppl(q[i].source) + 1; n = ArityOfFunctor((Functor)q[i].header); - for (j = 0; jcp_h; - return q[0].reference; + HB = B->cp_h; + return q[0].reference; } /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) @@ -1413,7 +1503,7 @@ static Int p_break_rational(USES_REGS1) { if (IsVarTerm(l)) Yap_unify(l, MkVarTerm()); return Yap_unify(Yap_BreakCycles(t, 4, &l PASS_REGS), ARG2) && - Yap_unify(l, ARG3) ; + Yap_unify(l, ARG3); } void Yap_InitTermCPreds(void) { @@ -1438,6 +1528,6 @@ void Yap_InitTermCPreds(void) { Yap_InitCPred("ground", 1, ground, SafePredFlag); Yap_InitCPred("cyclic_term", 1, cyclic_term, SafePredFlag); - Yap_InitCPred("numbervars", 3, p_numbervars, 0); + Yap_InitCPred("numbervars", 3, p_numbervars, 0); Yap_InitCPred("largest_numbervar", 2, largest_numbervar, 0); } diff --git a/C/write.c b/C/write.c index 9e5b4a4a8..7368165c1 100644 --- a/C/write.c +++ b/C/write.c @@ -1105,7 +1105,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, wglb.lw = separator; if ((flags & Handle_cyclics_f) ){ - Yap_CyclesInTerm(t, 3, NULL PASS_REGS); + t = Yap_CyclesInTerm(t PASS_REGS); } /* protect slots for portray */ diff --git a/H/Yapproto.h b/H/Yapproto.h index 06b24827a..8e5bc5c89 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -445,6 +445,7 @@ bool Yap_isDirectory(const char *FileName); extern bool Yap_Exists(const char *f); /* terms.c */ +extern Term Yap_CyclesInTerm(Term t USES_REGS); extern bool Yap_IsCyclicTerm(Term inp USES_REGS); extern Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS); extern void Yap_InitTermCPreds(void); From 2c80e33c6ae58a0c68eab892cf2291160d4aca10 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 11 Feb 2019 18:10:31 +0000 Subject: [PATCH 042/101] more fixes to threes, --- C/terms.c | 52 +++++++++++++++++++++++++--------------------------- C/write.c | 9 ++++++--- 2 files changed, 31 insertions(+), 30 deletions(-) diff --git a/C/terms.c b/C/terms.c index 37fe30910..dc40efa9c 100644 --- a/C/terms.c +++ b/C/terms.c @@ -243,24 +243,22 @@ var_in_term_nvar : { \ } #define CYC_LIST \ - if (d0 == TermFreeTerm) { \ - /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ + if (IS_VISIT_MARKER) { \ while (to_visit > to_visit0) { \ to_visit--; \ to_visit->ptd0[0] = to_visit->d0; \ } \ - pop_text_stack(lvl); /*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, \ - __FUNCTION__);*/ \ + pop_text_stack(lvl); \ return true; \ } #define CYC_APPL \ - if (IsAtomTerm((CELL)f)) { \ + if (IS_VISIT_MARKER) { \ while (to_visit > to_visit0) { \ to_visit--; \ to_visit->ptd0[0] = to_visit->d0; \ - } \ - /*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ + }\ +pop_text_stack(lvl); \ return true; \ } @@ -323,6 +321,7 @@ static int cycles_in_complex_term(register CELL *pt0, *to_visit0 = to_visit, *to_visit_max = to_visit + 1024; ptf = HR; + HR++; while (to_visit >= to_visit0) { CELL d0; CELL *ptd0; @@ -405,6 +404,7 @@ static int cycles_in_complex_term(register CELL *pt0, if (to_visit >= to_visit0) { pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; + ptf = to_visit->ptf; *to_visit->ptd0 = to_visit->d0; } } @@ -425,7 +425,7 @@ Term Yap_CyclesInTerm(Term t USES_REGS) { } else { CELL *Hi = HR; if ( cycles_in_complex_term(&(t)-1, &(t)PASS_REGS) >0) { - return IsPairTerm(t) ? AbsPair(Hi) : AbsAppl(Hi); + return Hi[0]; } else { HR = Hi; return t; @@ -1373,15 +1373,19 @@ typedef struct block_connector { CELL reference; //> term used to refer the copy. } cl_connector; -static bool dataid(Term t, cl_connector * q) { - Int i = IntegerOfTerm(t); - cl_connector *d = q + i; - return d->me == i; //&& d->source == (void *; +static bool dataid(Term t, cl_connector * q, int max) { + if (!IsPrimitiveTerm(t)) return 0; + if (!IsAtomTerm(t)) return max; + cl_connector *d = (cl_connector *)AtomOfTerm(t); + if (d > q && d < q+max) + return d-q; + return max; //&& d->source == (void *; } static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { Term ref, h, *s, *ostart; bool pair = false; + Int k; ssize_t n; // first time, create a new term ostart = HR; @@ -1390,23 +1394,25 @@ static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { n = 2; pair = true; ref = AbsPair(ostart); - } else { + } else if (IsApplTerm(t)) { h = (CELL)FunctorOfTerm(t); s = RepAppl(t); n = ArityOfFunctor(FunctorOfTerm(t)); ref = AbsAppl(ostart); *ostart++ = s[0]; + } else if ((k = dataid(t, q, max))) { + return k; + } else { + return max; } - if (IsIntegerTerm(s[0]) && dataid(s[0], q)) { - return IntegerOfTerm(s[0]); - } - + + q[max].me = max; q[max].source = t; q[max].copy = ostart; q[max].header = s[0]; q[max].reference = ref; - s[0] = MkIntegerTerm(max); + s[0] = MkAtomTerm((void*)q); HR += n; return max; } @@ -1414,14 +1420,6 @@ static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) { Int me; - printf("%lx i=%ld,max=%ld,H=%p\n", t, i, max, HR), t = Deref(t); - if (IsVarTerm(t) || IsPrimitiveTerm(t)) { - if (IsIntegerTerm(t) && dataid(t, q)) { - t = q[IntegerOfTerm(t)].header; - } - q[i].copy[j] = t; - return max; - } if ((me = create_entry(t, i, j, q, max)) < max) { Term ref = Deref(q[me].reference); @@ -1446,7 +1444,7 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) { Int i = 0; HB = HR; - if (IsVarTerm(t) || (IsIntegerTerm(t) && !dataid(t, q))) { + if (IsVarTerm(t) || dataid(t, q, qlen) == 0) { return t; } else { // initialization diff --git a/C/write.c b/C/write.c index 7368165c1..9c9e4af34 100644 --- a/C/write.c +++ b/C/write.c @@ -1103,13 +1103,16 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, wglb.MaxDepth = 0; wglb.MaxArgs = 0 ; wglb.lw = separator; - + Term tp; + if ((flags & Handle_cyclics_f) ){ - t = Yap_CyclesInTerm(t PASS_REGS); + tp = Yap_CyclesInTerm(t PASS_REGS); + } else { + tp = t; } /* protect slots for portray */ - writeTerm(t, priority, 1, false, &wglb, &rwt); + writeTerm(tp, priority, 1, false, &wglb, &rwt); if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); From c4b78e161bacf0b7d01a89bab620e9455d378e33 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 13 Feb 2019 09:44:24 +0000 Subject: [PATCH 043/101] moredeb --- C/cmppreds.c | 5 +- C/flags.c | 2 +- C/terms.c | 144 ++++++++++-------- docs/md/lib.md | 2 +- library/autoloader.yap | 2 +- library/charsio.yap | 7 +- library/coinduction.yap | 4 + library/ytest/preds.yap | 4 + packages/ProbLog/problog/flags.yap | 2 +- packages/gecode/gecode6_yap_hand_written.yap | 1 + .../yap_kernel/yap_ipython/prolog/jupyter.yap | 2 +- .../yap_kernel/yap_ipython/prolog/verify.yap | 2 +- pl/attributes.yap | 2 +- pl/boot.yap | 4 + pl/consult.yap | 1 - pl/imports.yap | 2 +- pl/os.yap | 2 +- pl/preds.yap | 2 +- swi/library/autoloader.yap | 2 +- 19 files changed, 107 insertions(+), 85 deletions(-) diff --git a/C/cmppreds.c b/C/cmppreds.c index 0e066d7a3..956a02836 100644 --- a/C/cmppreds.c +++ b/C/cmppreds.c @@ -728,7 +728,7 @@ static Int p_acomp(USES_REGS1) { /* $a_compare(?R,+X,+Y) */ The value of the expression _X_ is equal to the value of expression _Y_. */ -/// @memberof =:=/2 + static Int a_eq(Term t1, Term t2) { CACHE_REGS /* A =:= B */ @@ -769,7 +769,6 @@ static Int a_eq(Term t1, Term t2) { The value of the expression _X_ is different from the value of expression _Y_. */ -/// @memberof =\\=/2 static Int a_dif(Term t1, Term t2) { CACHE_REGS Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS); @@ -809,7 +808,6 @@ static Int a_ge(Term t1, Term t2) { /* A >= B */ The value of the expression _X_ is less than the value of expression _Y_. */ -/// @memberof to_visit0) { \ - to_visit--; \ - to_visit->ptd0[0] = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - return true; \ +#define CYC_LIST \ + if (IS_VISIT_MARKER) { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + to_visit->ptd0[0] = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + return true; \ } -#define CYC_APPL \ - if (IS_VISIT_MARKER) { \ - while (to_visit > to_visit0) { \ - to_visit--; \ - to_visit->ptd0[0] = to_visit->d0; \ - }\ -pop_text_stack(lvl); \ - return true; \ +#define CYC_APPL \ + if (IS_VISIT_MARKER) { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + to_visit->ptd0[0] = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + return true; \ } /** @@ -311,7 +311,7 @@ static Term BREAK_LOOP(Int ddep) { @brief routine to locate all variables in a term, and its applications */ static int cycles_in_complex_term(register CELL *pt0, - register CELL *pt0_end USES_REGS) { + register CELL *pt0_end USES_REGS) { int lvl = push_text_stack(); int rc = 0; @@ -320,8 +320,8 @@ static int cycles_in_complex_term(register CELL *pt0, 1024 * sizeof(struct non_single_struct_t)), *to_visit0 = to_visit, *to_visit_max = to_visit + 1024; - ptf = HR; - HR++; + ptf = HR; + HR++; while (to_visit >= to_visit0) { CELL d0; CELL *ptd0; @@ -363,6 +363,11 @@ static int cycles_in_complex_term(register CELL *pt0, /* store the terms to visit */ ptd0 = RepAppl(d0); f = (Functor)(d0 = *ptd0); + if (IS_VISIT_MARKER) { + rc++; + *ptf++ = BREAK_LOOP(to_visit - to_visit0); + continue; + } if (IsExtensionFunctor(f)) { *ptf++ = d0; continue; @@ -370,11 +375,6 @@ static int cycles_in_complex_term(register CELL *pt0, if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } - if (IS_VISIT_MARKER) { - rc++; - *ptf++ = BREAK_LOOP(to_visit - to_visit0); - continue; - } *ptf++ = AbsAppl(HR); to_visit->pt0 = pt0; to_visit->pt0_end = pt0_end; @@ -1359,78 +1359,95 @@ static Term UNFOLD_LOOP(Term t, Term * b) { Term os[2], o; os[0] = o = MkVarTerm(); os[1] = t; - Term ti = Yap_MkApplTerm(FunctorEq, 2, os); - *b = MkPairTerm(ti, *b); - + Term ti = Yap_MkApplTerm(FunctorEq, 2, os), t0 = *b; + *b = MkPairTerm(ti, t0); return o; } typedef struct block_connector { - Int me; //> index in the array; + CELL * parent; //> index in the array; Term source; //> source; CELL *copy; //> copy; CELL header; //> backup of first word of the source data; CELL reference; //> term used to refer the copy. } cl_connector; -static bool dataid(Term t, cl_connector * q, int max) { - if (!IsPrimitiveTerm(t)) return 0; - if (!IsAtomTerm(t)) return max; - cl_connector *d = (cl_connector *)AtomOfTerm(t); - if (d > q && d < q+max) +static Int t_ref(cl_connector *d, cl_connector * q, int max) { + if ( d >= q && d < q+max) return d-q; - return max; //&& d->source == (void *; + return -1; //&& d->source == (void *; } -static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { +static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { Term ref, h, *s, *ostart; bool pair = false; - Int k; ssize_t n; // first time, create a new term - ostart = HR; + if (IsVarTerm(t)) { + return -1; + } if (IsPairTerm(t)) { s = RepPair(t); + h = s[0]; + if (IsAtomTerm(h)) { + return t_ref((cl_connector*)AtomOfTerm(h),q,max); + } n = 2; pair = true; + ostart = HR; ref = AbsPair(ostart); + HR += 2; + q[max].header = Deref(s[0]); } else if (IsApplTerm(t)) { h = (CELL)FunctorOfTerm(t); + n = ArityOfFunctor((Functor)h); + if (IsExtensionFunctor((Functor)h)) { + return -1; + } + if (IsAtomTerm(h)) { + return t_ref((cl_connector*)AtomOfTerm(h),q,max); + } s = RepAppl(t); - n = ArityOfFunctor(FunctorOfTerm(t)); + q[max].header = s[0]; + ostart = HR; ref = AbsAppl(ostart); *ostart++ = s[0]; - } else if ((k = dataid(t, q, max))) { - return k; - } else { + HR=ostart+n; + } else if (IsAtomTerm(t) && + (max = t_ref((cl_connector*)AtomOfTerm(t),q,max)) >= 0) { return max; + } else { + return -1; } - - - q[max].me = max; + + q[max].parent = q[i].copy+j; q[max].source = t; q[max].copy = ostart; - q[max].header = s[0]; q[max].reference = ref; - s[0] = MkAtomTerm((void*)q); - HR += n; - return max; + s[0] = MkAtomTerm((void*)(q+max)); + return max+1; } Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) { Int me; - + t = Deref(t); if ((me = create_entry(t, i, j, q, max)) < max) { + if (me < 0) { + q[i].copy[j] = t; + return max; + } Term ref = Deref(q[me].reference); - if (IsVarTerm(ref)) { q[i].copy[j] = ref; } else { - q[i].copy[j] = q[me].reference = UNFOLD_LOOP(ref, tailp); + q[i].copy[j] = + q[me].parent[0] = + UNFOLD_LOOP(ref, tailp); } return max; } - return max + 1; + q[i].copy[j] = t; + return me; } Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) { @@ -1444,12 +1461,13 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) { Int i = 0; HB = HR; - if (IsVarTerm(t) || dataid(t, q, qlen) == 0) { + qlen = 0; + if (IsVarTerm(t) || IsPrimitiveTerm(t)) { return t; } else { // initialization - qlen = cp_link(t, 0, 0, q, qlen, listp); - while (i < qlen) { + qlen = create_entry(Deref(t), i, 0, q, qlen); + while(icp_h; @@ -1495,7 +1504,7 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) { */ -static Int p_break_rational(USES_REGS1) { +static Int rational_term_to_tree(USES_REGS1) { Term t = Deref(ARG1); Term l = Deref(ARG4); if (IsVarTerm(l)) @@ -1505,7 +1514,7 @@ static Int p_break_rational(USES_REGS1) { } void Yap_InitTermCPreds(void) { - Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0); + Yap_InitCPred("cycles_in_term", 2, cycles_in_term, 0); Yap_InitCPred("term_variables", 2, p_term_variables, 0); Yap_InitCPred("term_variables", 3, p_term_variables3, 0); Yap_InitCPred("$variables_in_term", 3, variables_in_term, 0); @@ -1518,8 +1527,8 @@ void Yap_InitTermCPreds(void) { Yap_InitCPred("variable_in_term", 2, variable_in_term, 0); Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0); Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0); - Yap_InitCPred("cyles_in_term", 4, cycles_in_term, 0); CurrentModule = PROLOG_MODULE; + Yap_InitCPred("rational_term_to_tree", 4, rational_term_to_tree, 0); Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); @@ -1529,3 +1538,4 @@ void Yap_InitTermCPreds(void) { Yap_InitCPred("numbervars", 3, p_numbervars, 0); Yap_InitCPred("largest_numbervar", 2, largest_numbervar, 0); } +//@} diff --git a/docs/md/lib.md b/docs/md/lib.md index a3e28e4e4..8a6a62155 100644 --- a/docs/md/lib.md +++ b/docs/md/lib.md @@ -1,5 +1,5 @@ -@file LIBRARY.md +@file lib.md @defgroup library YAP Prolog Library diff --git a/library/autoloader.yap b/library/autoloader.yap index 621ade734..486a38656 100644 --- a/library/autoloader.yap +++ b/library/autoloader.yap @@ -1,5 +1,5 @@ /** - * @file autoloader.yap + * */ :- module(autoloader,[make_library_index/0]). diff --git a/library/charsio.yap b/library/charsio.yap index 150e4b8e4..f6efc7ca8 100644 --- a/library/charsio.yap +++ b/library/charsio.yap @@ -24,7 +24,10 @@ * @{ * */ - +%% @file charsio.yap +%% +%% +%% @brief Input/Output to characters. :- module(system(charsio), [ format_to_chars/3, @@ -52,7 +55,7 @@ You can use the following directive to load the files. ~~~~~~~ -:- use_module(library(avl)). +:- use_module(library(charsio)). ~~~~~~~ It includes the following predicates: diff --git a/library/coinduction.yap b/library/coinduction.yap index 9552a72fd..c85d54c8d 100644 --- a/library/coinduction.yap +++ b/library/coinduction.yap @@ -154,6 +154,10 @@ co_term_expansion((H :- B), M, (NH :- B)) :- !, co_term_expansion(H, M, NH) :- coinductive(H, M, NH), !. +/** user:term_expansion(+M:Cl,-M:NCl ) + +rule preprocessor +*/ user:term_expansion(M:Cl,M:NCl ) :- !, co_term_expansion(Cl, M, NCl). diff --git a/library/ytest/preds.yap b/library/ytest/preds.yap index ef8f42949..c0d27e50a 100644 --- a/library/ytest/preds.yap +++ b/library/ytest/preds.yap @@ -52,6 +52,10 @@ functor(G, F, N), predicate_property(M:G, meta_predicate(P)). +/** user:term_expansion(+M:Cl,-M:NCl ) + +rule preprocessor +*/ user:term_expansion( ( :- '$meta_predicate'( _ ) ), [] ). user:goal_expansion(_:'_user_expand_goal'(A, M, B), user:user_expand_goal(A, M, B) ). diff --git a/packages/ProbLog/problog/flags.yap b/packages/ProbLog/problog/flags.yap index 975f4ae71..9564d7515 100644 --- a/packages/ProbLog/problog/flags.yap +++ b/packages/ProbLog/problog/flags.yap @@ -204,7 +204,7 @@ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% @file problog/flags +%% @file problog/flags.yap :-module(flags, [problog_define_flag/4, problog_define_flag/5, diff --git a/packages/gecode/gecode6_yap_hand_written.yap b/packages/gecode/gecode6_yap_hand_written.yap index 3eff8c69b..b61f5027a 100644 --- a/packages/gecode/gecode6_yap_hand_written.yap +++ b/packages/gecode/gecode6_yap_hand_written.yap @@ -1343,3 +1343,4 @@ keep_list_(_, X) :- (Space += keep(X)) :- !, keep_(Space,X). %! @} +%! @} diff --git a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap index 4e1eab760..67f411aed 100644 --- a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap +++ b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap @@ -1,6 +1,6 @@ /** - * @file jupyter.yap4py + * @file jupyter.yap * * @brief JUpyter support. */ diff --git a/packages/python/yap_kernel/yap_ipython/prolog/verify.yap b/packages/python/yap_kernel/yap_ipython/prolog/verify.yap index 4bf8330b0..93cad3f1b 100644 --- a/packages/python/yap_kernel/yap_ipython/prolog/verify.yap +++ b/packages/python/yap_kernel/yap_ipython/prolog/verify.yap @@ -1,5 +1,5 @@ /** - * @file jupyter.yap4py + * @file verify.yap * * @brief JUpyter support. */ diff --git a/pl/attributes.yap b/pl/attributes.yap index 1a1ff8aec..d81047d4a 100644 --- a/pl/attributes.yap +++ b/pl/attributes.yap @@ -18,7 +18,7 @@ /** @file attributes.yap -@defgroup New_Style_Attribute_Declarations SWI Compatible attributes +@defgroup New_Style_Attribute_Declarations hProlog and SWI-Prolog style Attribute Declarations @ingroup attributes @{ diff --git a/pl/boot.yap b/pl/boot.yap index 49b5d1ae9..3e6660197 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -114,6 +114,10 @@ print_message(Type,error(_,exception(Desc))) :- '$get_exception'(Desc), print_boot_message(Type,Error,Desc), '$print_exception'(Desc), +print_message(Type,warning(_,exception(Desc))) :- + '$get_exception'(Desc), + print_boot_message(Type,Error,Desc), + '$print_exception'(Desc), !. print_message(Type,Error) :- format( user_error, '~w while bootstraping: event is ~q~n',[Type,Error]). diff --git a/pl/consult.yap b/pl/consult.yap index 2d57cfb09..ef4654cbd 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'. diff --git a/pl/imports.yap b/pl/imports.yap index 606d9981a..6ed6b00c3 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -1,5 +1,5 @@ /** - ** @file imports.yapi + ** @file imports.yap * * @brief Module systemm code to import predicates * diff --git a/pl/os.yap b/pl/os.yap index c8fde94fc..6003f410c 100644 --- a/pl/os.yap +++ b/pl/os.yap @@ -9,7 +9,7 @@ *************************************************************************/ /** - * @file os.yap + * @file pl/os.yap */ :- system_module( '$os', [ cd/0, diff --git a/pl/preds.yap b/pl/preds.yap index 9cb45460b..379230edd 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -16,7 +16,7 @@ *************************************************************************/ /** - * @file preds.yap + * @file pl/preds.yap */ :- system_module( '$_preds', [abolish/1, abolish/2, diff --git a/swi/library/autoloader.yap b/swi/library/autoloader.yap index b37ac4102..7f8d4a9c0 100644 --- a/swi/library/autoloader.yap +++ b/swi/library/autoloader.yap @@ -1,5 +1,5 @@ /** - * @file autoloader.yap + * @file swi/library/autoloader.yap */ :- module(autoloader,[make_library_index/0]). From 76b4ddee9c00999dba1899120b7848991e6ebf66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 13 Feb 2019 14:31:29 +0000 Subject: [PATCH 044/101] fixes --- C/terms.c | 21 +++++++++++++------- pl/boot.yap | 54 +++++++++++++++++++++++--------------------------- pl/consult.yap | 2 -- pl/ground.yap | 1 - pl/init.yap | 1 - pl/top.yap | 2 +- 6 files changed, 40 insertions(+), 41 deletions(-) diff --git a/C/terms.c b/C/terms.c index a255881e7..ace0d9a6e 100644 --- a/C/terms.c +++ b/C/terms.c @@ -1380,9 +1380,10 @@ static Int t_ref(cl_connector *d, cl_connector * q, int max) { static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { Term ref, h, *s, *ostart; - bool pair = false; ssize_t n; // first time, create a new term + if (i==0) + return 0; if (IsVarTerm(t)) { return -1; } @@ -1393,7 +1394,6 @@ static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { return t_ref((cl_connector*)AtomOfTerm(h),q,max); } n = 2; - pair = true; ostart = HR; ref = AbsPair(ostart); HR += 2; @@ -1439,12 +1439,19 @@ Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) { Term ref = Deref(q[me].reference); if (IsVarTerm(ref)) { q[i].copy[j] = ref; - } else { - q[i].copy[j] = - q[me].parent[0] = - UNFOLD_LOOP(ref, tailp); + } else if (i == 0){ + Term p = TermNil; + Term v = UNFOLD_LOOP(ref,&p); + q[i].reference = HeadOfTerm(p); + q[i].copy[j] = v; } - return max; + else if (tailp && q[me].parent) { + Term v = UNFOLD_LOOP(ref, tailp); + q[i].copy[j] = v; + q[me].parent[0] = v; + q[i].reference = v; + } + return max; } q[i].copy[j] = t; return me; diff --git a/pl/boot.yap b/pl/boot.yap index 3e6660197..89188051e 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -28,6 +28,25 @@ */ +print_message(informational,_) :- + yap_flag(verbose, silent), + !. +print_message(informational,E) :- + format('informational message ~q.~n',[E]), + !. +%% +% boot:print_message( Type, Error ) +% +print_message(Type,error(error(_,_),exception(Desc))) :- + !, + '$print_exception'(Desc). +print_message(Type,error(warning(_,_),exception(Desc))) :- + !, + '$print_exception'(Desc). +print_message(Type,Error) :- + format( user_error, '~w while bootstraping: event is ~q~n',[Type,Error]). + + /** * @pred system_module( _Mod_, _ListOfPublicPredicates, ListOfPrivatePredicates * * Define a system module _Mod_. _ListOfPublicPredicates_ . Currentlt, all @@ -63,6 +82,10 @@ private(_). % boootstrap predicates. % :- system_module( '$_boot', [ + !/0, + ':-'/1, + '?-'/1, + []/0, bootstrap/1, call/1, catch/3, @@ -76,12 +99,7 @@ private(_). (not)/1, repeat/0, throw/1, - true/0]). - -:- system_module( '$_init', [!/0, - ':-'/1, - '?-'/1, - []/0, + true/0, extensions_to_present_answer/1, fail/0, false/0, @@ -94,34 +112,12 @@ private(_). '$do_log_upd_clause'/6, '$do_log_upd_clause0'/6, '$do_log_upd_clause_erase'/6, - '$do_static_clause'/5], + '$do_static_clause'/5, '$system_module'/1]). -:- use_system_module( '$_boot', ['$cut_by'/1]). % be careful here not to generate an undefined exception.. -print_message(informational,_) :- - yap_flag(verbose, silent), - !. -print_message(informational,E) :- - format('informational message ~q.~n',[E]), - !. -%% -% boot:print_message( Type, Error ) -% -print_message(Type,error(_,exception(Desc))) :- - '$get_exception'(Desc), - print_boot_message(Type,Error,Desc), - '$print_exception'(Desc), -print_message(Type,warning(_,exception(Desc))) :- - '$get_exception'(Desc), - print_boot_message(Type,Error,Desc), - '$print_exception'(Desc), - !. -print_message(Type,Error) :- - format( user_error, '~w while bootstraping: event is ~q~n',[Type,Error]). - print_boot_message(Type,Error,Desc) :- diff --git a/pl/consult.yap b/pl/consult.yap index ef4654cbd..b629500a4 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -1450,9 +1450,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/ground.yap b/pl/ground.yap index e3df5c1d5..e50b00990 100644 --- a/pl/ground.yap +++ b/pl/ground.yap @@ -33,7 +33,6 @@ /* % grounds all free variables % as terms of the form '$VAR'(N) -*/ _numbervars(Term, M, N) :- '$variables_in_term'(Term, [], L), '$numbermarked_vars'(L, M, N). diff --git a/pl/init.yap b/pl/init.yap index d783a7dc7..e88f2a0b1 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -97,7 +97,6 @@ set_prolog_flag(debug, false), % simple trick to find out if this is we are booting from Prolog. % boot from a saved state - writeln(ok), '$init_from_saved_state_and_args', %start_low_level_trace, '$db_clean_queues'(_), diff --git a/pl/top.yap b/pl/top.yap index fd2d9850f..12ea5db19 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -878,7 +878,7 @@ gated_call(Setup, Goal, Catcher, Cleanup) :- '$expand_clause'(InputCl, C1, CO) :- '$yap_strip_clause'(InputCl, M, ICl), - '$expand_a_clause'( M:ICl, SM, C1, CO), + '$expand_a_clause'( M:ICl, M, C1, CO), !. '$expand_clause'(Cl, Cl, Cl). From 394ecd4657616cb336609bc1da6830940f3eb981 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 13 Feb 2019 21:46:00 +0000 Subject: [PATCH 045/101] more PL fixes --- pl/boot.yap | 97 ++++++++++++++++++++++-------------------------- pl/top.yap | 2 +- pl/undefined.yap | 2 +- 3 files changed, 46 insertions(+), 55 deletions(-) diff --git a/pl/boot.yap b/pl/boot.yap index 3e6660197..5fac68177 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -28,6 +28,27 @@ */ +% be careful here not to generate an undefined exception.. + +print_message(informational,_) :- + yap_flag(verbose, silent), + !. +print_message(informational,E) :- + format('informational message ~q.~n',[E]), + !. +%% +% boot:print_message( Type, Error ) +% +print_message(Type,error(error(_,_),exception(Desc))) :- + !, + '$print_exception'(Desc). +print_message(Type,error(warning(_,_),exception(Desc))) :- + !, + '$print_exception'(Desc), + !. +print_message(Type,Error) :- + format( user_error, '~w while bootstraping: event is ~q~n',[Type,Error]). + /** * @pred system_module( _Mod_, _ListOfPublicPredicates, ListOfPrivatePredicates * * Define a system module _Mod_. _ListOfPublicPredicates_ . Currentlt, all @@ -62,26 +83,25 @@ private(_). % % boootstrap predicates. % -:- system_module( '$_boot', [ - bootstrap/1, - call/1, - catch/3, - catch_ball/2, - expand_term/2, - print_message/2, - import_system_module/2, - system_module/2, - private/1, - incore/1, - (not)/1, - repeat/0, - throw/1, - true/0]). - -:- system_module( '$_init', [!/0, - ':-'/1, - '?-'/1, - []/0, +:- system_module( '$_boot', + [ + !/0, + ':-'/1, + '?-'/1, + []/0, + bootstrap/1, + call/1, + catch/3, + catch_ball/2, + expand_term/2, + print_message/2, + import_system_module/2, + system_module/2, + private/1, + incore/1, + (not)/1, + repeat/0, + throw/1, extensions_to_present_answer/1, fail/0, false/0, @@ -89,39 +109,17 @@ private(_). goal_expansion/3, otherwise/0, term_expansion/2, - version/2], - [ + version/2, + true/0], + [ '$do_log_upd_clause'/6, '$do_log_upd_clause0'/6, '$do_log_upd_clause_erase'/6, - '$do_static_clause'/5], + '$do_static_clause'/5, '$system_module'/1]). :- use_system_module( '$_boot', ['$cut_by'/1]). -% be careful here not to generate an undefined exception.. - -print_message(informational,_) :- - yap_flag(verbose, silent), - !. -print_message(informational,E) :- - format('informational message ~q.~n',[E]), - !. -%% -% boot:print_message( Type, Error ) -% -print_message(Type,error(_,exception(Desc))) :- - '$get_exception'(Desc), - print_boot_message(Type,Error,Desc), - '$print_exception'(Desc), -print_message(Type,warning(_,exception(Desc))) :- - '$get_exception'(Desc), - print_boot_message(Type,Error,Desc), - '$print_exception'(Desc), - !. -print_message(Type,Error) :- - format( user_error, '~w while bootstraping: event is ~q~n',[Type,Error]). - print_boot_message(Type,Error,Desc) :- @@ -138,13 +136,6 @@ print_boot_message(Type,Error,Desc) :- '$query_exception'(errorLine, Desc, FilePos), format(user_error,'~a:~d: ~a: ~q~n', [File,FilePos,Type,Error]). -'$undefp0'([M|G], _Action) :- - functor(G,N,A), - print_message( error, error(error(unknown, M:N/A),M:G)), - fail. - -:- '$undefp_handler'('$undefp0'(_,_),prolog). - /** * @pred $system_meta_predicates'( +L ) * diff --git a/pl/top.yap b/pl/top.yap index fd2d9850f..01e2fe3aa 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -29,7 +29,7 @@ live :- ( Module==user -> true % '$compile_mode'(_,0) ; - format(user_error,'[~w]~n', [Module]) + format(user_error,'[~w]~n', [Module]) ), '$system_catch'('$enter_top_level',Module,Error,'$Error'(Error)). diff --git a/pl/undefined.yap b/pl/undefined.yap index 3852845f8..f7a85e999 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -94,7 +94,7 @@ undefined_query(G0, M0, Cut) :- '$get_undefined_predicates'(M0:G0, MG), !. % undef handler -'$undefp'([M0|G0],MG) :- +'$undefp_'([M0|G0],MG) :- % make sure we do not loop on undefined predicates '$undef_setup'(M0:G0, Action,Debug,Current, MGI), ('$get_undefined_predicates'( MGI, MG ) From 302519868f9bbf505f4ddb21f9cddb4805deacfc Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 14 Feb 2019 00:38:14 +0000 Subject: [PATCH 046/101] loops --- C/terms.c | 940 +++++++++++++++++----------------- packages/python/swig/setup.py | 4 +- pl/undefined.yap | 2 +- regression/cyclics.yap | 1 + 4 files changed, 480 insertions(+), 467 deletions(-) diff --git a/C/terms.c b/C/terms.c index ace0d9a6e..970e04b2a 100644 --- a/C/terms.c +++ b/C/terms.c @@ -29,7 +29,7 @@ #include "YapHeap.h" #define debug_pop_text_stack(l) [ if (to_visit != to_visit0) printf("%d\n",__LINE__); pop_text_stack(l) \ - } +} #include "attvar.h" #include "yapio.h" @@ -90,26 +90,26 @@ static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { //} non_singletons_t; #define IS_VISIT_MARKER \ - (IsPairTerm(d0) && RepPair(d0) >= (CELL *)to_visit0 && \ - RepPair(d0) <= (CELL *)to_visit) +(IsPairTerm(d0) && RepPair(d0) >= (CELL *)to_visit0 && \ + RepPair(d0) <= (CELL *)to_visit) #define VISIT_MARKER AbsPair((CELL *)to_visit) #define CYC_MARK_LIST \ - if (IsPairTerm(d0) && RepPair(d0) >= (CELL *)to_visit0 && \ - RepPair(d0) <= (CELL *)to_visit) { \ +if (IsPairTerm(d0) && RepPair(d0) >= (CELL *)to_visit0 && \ + RepPair(d0) <= (CELL *)to_visit) { \ /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ - *ptf++ = BREAK_LOOP(to_visit - to_visit0); \ - continue; \ - } + *ptf++ = BREAK_LOOP(to_visit - to_visit0); \ +continue; \ +} #define CYC_MARK_APPL \ - if (IsApplTerm(d0) && RepAppl(d0) >= (Term *)to_visit0 && \ - RepAppl(d0) <= (Term *)to_visit) { \ +if (IsApplTerm(d0) && RepAppl(d0) >= (Term *)to_visit0 && \ + RepAppl(d0) <= (Term *)to_visit) { \ /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ - *ptf++ = BREAK_LOOP(to_visit - to_visit0); \ - continue; \ - } + *ptf++ = BREAK_LOOP(to_visit - to_visit0); \ +continue; \ +} typedef struct { Term old_var; @@ -123,144 +123,147 @@ typedef struct non_single_struct_t { } non_singletons_t; #define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \ - \ - struct non_single_struct_t *to_visit = Malloc( \ - 1024 * sizeof(struct non_single_struct_t)), \ - *to_visit0 = to_visit, \ - *to_visit_max = to_visit + 1024; \ - \ - while (to_visit >= to_visit0) { \ +\ +struct non_single_struct_t *to_visit = Malloc( \ + 1024 * sizeof(struct non_single_struct_t)), \ +*to_visit0 = to_visit, \ +*to_visit_max = to_visit + 1024; \ +\ +while (to_visit >= to_visit0) { \ CELL d0; \ CELL *ptd0; \ -restart: \ - while (pt0 < pt0_end) { \ - ++pt0; \ - ptd0 = pt0; \ - d0 = *ptd0; \ -list_loop: \ + restart: \ + while (pt0 < pt0_end) { \ + ++pt0; \ + ptd0 = pt0; \ + d0 = *ptd0; \ + list_loop: \ /*fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__);*/ \ - deref_head(d0, var_in_term_unk); \ -var_in_term_nvar : { \ - if (IsPairTerm(d0)) { \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - ptd0 = RepPair(d0); \ - d0 = ptd0[0]; \ - LIST0; \ - if (IS_VISIT_MARKER) \ - goto restart; \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ - to_visit->d0 = d0; \ - to_visit++; \ - *ptd0 = VISIT_MARKER; \ - pt0 = ptd0; \ - pt0_end = pt0 + 1; \ - goto list_loop; \ - } else if (IsApplTerm(d0)) { \ - register Functor f; \ + deref_head(d0, var_in_term_unk); \ + var_in_term_nvar : { \ + if (IsPairTerm(d0)) { \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + ptd0 = RepPair(d0); \ + d0 = ptd0[0]; \ + LIST0; \ + if (IS_VISIT_MARKER) \ + goto restart; \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = d0; \ + to_visit++; \ + *ptd0 = VISIT_MARKER; \ + pt0 = ptd0; \ + pt0_end = pt0 + 1; \ + goto list_loop; \ + } else if (IsApplTerm(d0)) { \ + register Functor f; \ /* store the terms to visit */ \ - ptd0 = RepAppl(d0); \ - f = (Functor)(d0 = *ptd0); \ - \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - STRUCT0; \ - if (IS_VISIT_MARKER) { \ - \ - continue; \ - } \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ - to_visit->d0 = d0; \ - to_visit++; \ - \ - *ptd0 = VISIT_MARKER; \ - Term d1 = ArityOfFunctor(f); \ - pt0 = ptd0; \ - pt0_end = ptd0 + d1; \ - continue; \ - } else { \ - PRIMI0; \ - continue; \ - } \ - derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar) + ptd0 = RepAppl(d0); \ + f = (Functor)(d0 = *ptd0); \ + if (IsExtensionFunctor(f)) {\ + continue;\ + }\ + \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + STRUCT0; \ + if (IS_VISIT_MARKER) { \ + \ + continue; \ + } \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = d0; \ + to_visit++; \ + \ + *ptd0 = VISIT_MARKER; \ + Term d1 = ArityOfFunctor(f); \ + pt0 = ptd0; \ + pt0_end = ptd0 + d1; \ + continue; \ + } else { \ + PRIMI0; \ + continue; \ + } \ + derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar) #define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {}) #define END_WALK() \ } \ - } \ + } \ /* Do we still have compound terms to visit */ \ - to_visit--; \ - if (to_visit >= to_visit0) { \ - pt0 = to_visit->pt0; \ - pt0_end = to_visit->pt0_end; \ - *to_visit->ptd0 = to_visit->d0; \ - } \ - } \ - pop_text_stack(lvl); + to_visit--; \ + if (to_visit >= to_visit0) { \ + pt0 = to_visit->pt0; \ + pt0_end = to_visit->pt0_end; \ + *to_visit->ptd0 = to_visit->d0; \ + } \ +} \ +pop_text_stack(lvl); #define def_aux_overflow() \ - aux_overflow : { \ - size_t d1 = to_visit - to_visit0; \ - size_t d2 = to_visit_max - to_visit0; \ - to_visit0 = \ - Realloc(to_visit0, (d2 + 128) * sizeof(struct non_single_struct_t)); \ - to_visit = to_visit0 + d1; \ - to_visit_max = to_visit0 + (d2 + 128); \ - pt0--; \ - } \ - goto restart; +aux_overflow : { \ + size_t d1 = to_visit - to_visit0; \ + size_t d2 = to_visit_max - to_visit0; \ + to_visit0 = \ + Realloc(to_visit0, (d2 + 128) * sizeof(struct non_single_struct_t)); \ + to_visit = to_visit0 + d1; \ + to_visit_max = to_visit0 + (d2 + 128); \ + pt0--; \ +} \ +goto restart; #define def_trail_overflow() \ - trail_overflow : { \ - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ - LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - pop_text_stack(lvl); \ - return 0L; \ - } +trail_overflow : { \ + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ + LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + pop_text_stack(lvl); \ + return 0L; \ +} #define def_global_overflow() \ - global_overflow : { \ - while (to_visit > to_visit0) { \ - to_visit--; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ - LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); \ - return false; \ - } +global_overflow : { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ + LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); \ + return false; \ +} #define CYC_LIST \ - if (IS_VISIT_MARKER) { \ - while (to_visit > to_visit0) { \ - to_visit--; \ - to_visit->ptd0[0] = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - return true; \ - } +if (IS_VISIT_MARKER) { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + to_visit->ptd0[0] = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + return true; \ +} #define CYC_APPL \ - if (IS_VISIT_MARKER) { \ - while (to_visit > to_visit0) { \ - to_visit--; \ - to_visit->ptd0[0] = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - return true; \ - } +if (IS_VISIT_MARKER) { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + to_visit->ptd0[0] = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + return true; \ +} /** @brief routine to locate all variables in a term, and its applications */ @@ -311,109 +314,109 @@ static Term BREAK_LOOP(Int ddep) { @brief routine to locate all variables in a term, and its applications */ static int cycles_in_complex_term(register CELL *pt0, - register CELL *pt0_end USES_REGS) { + register CELL *pt0_end USES_REGS) { int lvl = push_text_stack(); int rc = 0; CELL *ptf; struct non_single_struct_t *to_visit = Malloc( - 1024 * sizeof(struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit + 1024; + 1024 * sizeof(struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit + 1024; ptf = HR; HR++; while (to_visit >= to_visit0) { CELL d0; CELL *ptd0; - restart: + restart: while (pt0 < pt0_end) { ++pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: + list_loop: deref_head(d0, var_in_term_unk); - var_in_term_nvar : { - if (IsPairTerm(d0)) { - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - ptd0 = RepPair(d0); - d0 = ptd0[0]; - if (IS_VISIT_MARKER) { - rc++; - *ptf++ = BREAK_LOOP(to_visit - to_visit0); - continue; - } - *ptf++ = AbsPair(HR); - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->ptd0 = ptd0; - to_visit->d0 = d0; - to_visit->ptf = ptf; - to_visit++; - ptf = HR; - HR += 2; - *ptd0 = VISIT_MARKER; - pt0 = ptd0; - pt0_end = pt0+1; - ptf = HR - 2; - goto list_loop; - } else if (IsApplTerm(d0)) { - register Functor f; + var_in_term_nvar : { + if (IsPairTerm(d0)) { + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + ptd0 = RepPair(d0); + d0 = ptd0[0]; + if (IS_VISIT_MARKER) { + rc++; + *ptf++ = BREAK_LOOP(to_visit - to_visit0); + continue; + } + *ptf++ = AbsPair(HR); + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->ptd0 = ptd0; + to_visit->d0 = d0; + to_visit->ptf = ptf; + to_visit++; + ptf = HR; + HR += 2; + *ptd0 = VISIT_MARKER; + pt0 = ptd0; + pt0_end = pt0+1; + ptf = HR - 2; + goto list_loop; + } else if (IsApplTerm(d0)) { + register Functor f; /* store the terms to visit */ - ptd0 = RepAppl(d0); - f = (Functor)(d0 = *ptd0); - if (IS_VISIT_MARKER) { - rc++; - *ptf++ = BREAK_LOOP(to_visit - to_visit0); - continue; - } - if (IsExtensionFunctor(f)) { - *ptf++ = d0; - continue; - } - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - *ptf++ = AbsAppl(HR); - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->ptd0 = ptd0; - to_visit->d0 = d0; - to_visit->ptf = ptf; - to_visit++; - - *ptd0 = VISIT_MARKER; - *HR++ = (CELL)f; - ptf = HR; - Term d1 = ArityOfFunctor(f); - pt0 = ptd0; - pt0_end = ptd0 + (d1); - HR+=d1; - continue; - } else { - *ptf++ = d0; - continue; - } - derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); - *ptf++ = d0; + ptd0 = RepAppl(d0); + f = (Functor)(d0 = *ptd0); + if (IsExtensionFunctor(f)) { + *ptf++ = d0; + continue; } - } + if (IS_VISIT_MARKER) { + rc++; + *ptf++ = BREAK_LOOP(to_visit - to_visit0); + continue; + } + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + *ptf++ = AbsAppl(HR); + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->ptd0 = ptd0; + to_visit->d0 = d0; + to_visit->ptf = ptf; + to_visit++; + + *ptd0 = VISIT_MARKER; + *HR++ = (CELL)f; + ptf = HR; + Term d1 = ArityOfFunctor(f); + pt0 = ptd0; + pt0_end = ptd0 + (d1); + HR+=d1; + continue; + } else { + *ptf++ = d0; + continue; + } + derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); + *ptf++ = d0; + } +} /* Do we still have compound terms to visit */ - to_visit--; - if (to_visit >= to_visit0) { - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - ptf = to_visit->ptf; - *to_visit->ptd0 = to_visit->d0; - } - } - pop_text_stack(lvl); +to_visit--; +if (to_visit >= to_visit0) { + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + ptf = to_visit->ptf; + *to_visit->ptd0 = to_visit->d0; +} +} +pop_text_stack(lvl); - return rc; +return rc; - def_aux_overflow(); - return -1; +def_aux_overflow(); +return -1; } Term Yap_CyclesInTerm(Term t USES_REGS) { @@ -451,7 +454,7 @@ static Int cycles_in_term(USES_REGS1) /* cyclic_term(+T) */ @brief routine to locate all variables in a term, and its applications */ static bool ground_complex_term(register CELL * pt0, - register CELL * pt0_end USES_REGS) { + register CELL * pt0_end USES_REGS) { int lvl = push_text_stack(); WALK_COMPLEX_TERM(); @@ -478,13 +481,13 @@ static bool ground_complex_term(register CELL * pt0, bool Yap_IsGroundTerm(Term t) { CACHE_REGS - if (IsVarTerm(t)) { - return false; - } else if (IsPrimitiveTerm(t)) { - return true; - } else { - return ground_complex_term(&(t)-1, &(t)PASS_REGS); - } + if (IsVarTerm(t)) { + return false; + } else if (IsPrimitiveTerm(t)) { + return true; + } else { + return ground_complex_term(&(t)-1, &(t)PASS_REGS); + } } /** @pred ground( _T_) is iso @@ -500,37 +503,37 @@ static Int ground(USES_REGS1) /* ground(+T) */ } static Int var_in_complex_term(register CELL * pt0, register CELL * pt0_end, - Term v USES_REGS) { + Term v USES_REGS) { int lvl = push_text_stack(); WALK_COMPLEX_TERM(); if ((CELL)ptd0 == v) { /* we found it */ /* Do we still have compound terms to visit */ - while (to_visit > to_visit0) { - to_visit--; - - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } - pop_text_stack(lvl); - return true; - } - goto restart; - END_WALK(); - - if (to_visit > to_visit0) { + while (to_visit > to_visit0) { to_visit--; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; } pop_text_stack(lvl); - return false; + return true; +} +goto restart; +END_WALK(); - def_aux_overflow(); +if (to_visit > to_visit0) { + to_visit--; + + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; +} +pop_text_stack(lvl); +return false; + +def_aux_overflow(); } static Int var_in_term( @@ -562,7 +565,7 @@ static Int variable_in_term(USES_REGS1) { * @brief routine to locate all variables in a term, and its applications. */ static Term vars_in_complex_term(register CELL * pt0, register CELL * pt0_end, - Term inp USES_REGS) { + Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; @@ -628,7 +631,7 @@ static Int variables_in_term( Term out, inp; int count; - restart: + restart: count = 0; inp = Deref(ARG2); while (!IsVarTerm(inp) && IsPairTerm(inp)) { @@ -639,25 +642,25 @@ static Int variables_in_term( TrailTerm(TR++) = t; count++; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - clean_tr(TR - count PASS_REGS); - if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) { - return false; - } - goto restart; - } - } - inp = TailOfTerm(inp); - } - do { - Term t = Deref(ARG1); - out = vars_in_complex_term(&(t)-1, &(t), ARG2 PASS_REGS); - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - clean_tr(TR - count PASS_REGS); - return Yap_unify(ARG3, out); + clean_tr(TR - count PASS_REGS); + if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) { + return false; + } + goto restart; + } + } + inp = TailOfTerm(inp); + } + do { + Term t = Deref(ARG1); + out = vars_in_complex_term(&(t)-1, &(t), ARG2 PASS_REGS); + if (out == 0L) { + if (!expand_vts(3 PASS_REGS)) + return false; + } +} while (out == 0L); +clean_tr(TR - count PASS_REGS); +return Yap_unify(ARG3, out); } /** @pred term_variables(? _Term_, - _Variables_, +_ExternalVars_) is iso @@ -681,7 +684,7 @@ static Int p_term_variables3( if (IsVarTerm(t)) { Term out = Yap_MkNewPairTerm(); return Yap_unify(t, HeadOfTerm(out)) && - Yap_unify(ARG3, TailOfTerm(out)) && Yap_unify(out, ARG2); + Yap_unify(ARG3, TailOfTerm(out)) && Yap_unify(out, ARG2); } else if (IsPrimitiveTerm(t)) { return Yap_unify(ARG2, ARG3); } else { @@ -689,11 +692,11 @@ static Int p_term_variables3( } if (out == 0L) { if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); + return false; + } + } while (out == 0L); - return Yap_unify(ARG2, out); + return Yap_unify(ARG2, out); } /** @@ -719,10 +722,10 @@ Term Yap_TermVariables( } if (out == 0L) { if (!expand_vts(arity PASS_REGS)) - return false; - } - } while (out == 0L); - return out; + return false; + } + } while (out == 0L); + return out; } /** @pred term_variables(? _Term_, - _Variables_) is iso @@ -751,10 +754,10 @@ static Int p_term_variables( out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); if (out == 0L) { if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG2, out); + return false; + } + } while (out == 0L); + return Yap_unify(ARG2, out); } /** routine to locate attributed variables */ @@ -765,7 +768,7 @@ typedef struct att_rec { } att_rec_t; static Term attvars_in_complex_term( - register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { + register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = inp; @@ -841,17 +844,17 @@ static Int p_term_attvars(USES_REGS1) /* variables in term t */ } if (out == 0L) { if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG2, out); + return false; + } + } while (out == 0L); + return Yap_unify(ARG2, out); } /** @brief output the difference between variables in _T_ and variables in * some list. */ static Term new_vars_in_complex_term( - register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { + register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; int lvl = push_text_stack(); @@ -861,42 +864,42 @@ static Term new_vars_in_complex_term( while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { - YapBind(VarOfTerm(t), TermFoundVar); - if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { + YapBind(VarOfTerm(t), TermFoundVar); + if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - goto trail_overflow; - } - pop_text_stack(lvl); - } - } - inp = TailOfTerm(inp); - } - } - WALK_COMPLEX_TERM(); - output = MkPairTerm((CELL)ptd0, output); - YapBind(ptd0, TermFoundVar); - if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - goto trail_overflow; - } + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; + } + pop_text_stack(lvl); + } + } + inp = TailOfTerm(inp); + } + } + WALK_COMPLEX_TERM(); + output = MkPairTerm((CELL)ptd0, output); + YapBind(ptd0, TermFoundVar); + if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; } +} /* leave an empty slot to fill in later */ - if (HR + 1024 > ASP) { - goto global_overflow; - } - END_WALK(); +if (HR + 1024 > ASP) { + goto global_overflow; +} +END_WALK(); - clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); - HB = B->cp_h; - return output; +clean_tr(TR0 PASS_REGS); +pop_text_stack(lvl); +HB = B->cp_h; +return output; - def_aux_overflow(); +def_aux_overflow(); - def_trail_overflow(); +def_trail_overflow(); - def_global_overflow(); +def_global_overflow(); } /** @pred new_variables_in_term(+_CurrentVariables_, ? _Term_, -_Variables_) @@ -924,26 +927,26 @@ static Int p_new_variables_in_term( } if (out == 0L) { if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG3, out); + return false; + } + } while (out == 0L); + return Yap_unify(ARG3, out); } #define FOUND_VAR() \ - if (d0 == TermFoundVar) { \ +if (d0 == TermFoundVar) { \ /* leave an empty slot to fill in later */ \ - if (HR + 1024 > ASP) { \ - goto global_overflow; \ - } \ - HR[1] = AbsPair(HR + 2); \ - HR += 2; \ - HR[-2] = (CELL)ptd0; \ - *ptd0 = TermNil; \ - } + if (HR + 1024 > ASP) { \ + goto global_overflow; \ + } \ + HR[1] = AbsPair(HR + 2); \ + HR += 2; \ + HR[-2] = (CELL)ptd0; \ + *ptd0 = TermNil; \ +} static Term vars_within_complex_term( - register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { + register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { tr_fr_ptr TR0 = TR; CELL *InitialH = HR; @@ -957,28 +960,28 @@ static Term vars_within_complex_term( *ptr = TermFoundVar; TrailTerm(TR++) = t; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true); - } - } - inp = TailOfTerm(inp); - } + Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true); + } + } + inp = TailOfTerm(inp); + } - WALK_COMPLEX_TERM__({}, {}, FOUND_VAR()); - goto restart; - END_WALK(); + WALK_COMPLEX_TERM__({}, {}, FOUND_VAR()); + goto restart; + END_WALK(); - clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); - if (HR != InitialH) { - HR[-1] = TermNil; - return output; - } else { - return TermNil; - } + clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); + if (HR != InitialH) { + HR[-1] = TermNil; + return output; +} else { + return TermNil; +} - def_aux_overflow(); +def_aux_overflow(); - def_global_overflow(); +def_global_overflow(); } /** @pred variables_within_term(+_CurrentVariables_, ? _Term_, -_Variables_) @@ -1004,14 +1007,14 @@ static Int p_variables_within_term(USES_REGS1) /* variables within term t */ } if (out == 0L) { if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG3, out); + return false; + } + } while (out == 0L); + return Yap_unify(ARG3, out); } static Term free_vars_in_complex_term(CELL * pt0, CELL * pt0_end, - tr_fr_ptr TR0 USES_REGS) { + tr_fr_ptr TR0 USES_REGS) { Term o = TermNil; CELL *InitialH = HR; int lvl = push_text_stack(); @@ -1049,7 +1052,7 @@ static Term free_vars_in_complex_term(CELL * pt0, CELL * pt0_end, } static Term bind_vars_in_complex_term(CELL * pt0, CELL * pt0_end, - tr_fr_ptr TR0 USES_REGS) { + tr_fr_ptr TR0 USES_REGS) { CELL *InitialH = HR; int lvl = push_text_stack(); WALK_COMPLEX_TERM(); @@ -1060,23 +1063,23 @@ static Term bind_vars_in_complex_term(CELL * pt0, CELL * pt0_end, /* Trail overflow */ if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { while (to_visit > to_visit0) { - to_visit--; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; + to_visit--; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + } + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; - END_WALK(); + END_WALK(); - pop_text_stack(lvl); - return TermNil; + pop_text_stack(lvl); + return TermNil; - def_aux_overflow(); + def_aux_overflow(); - def_trail_overflow(); + def_trail_overflow(); } static Int p_free_variables_in_term( @@ -1093,56 +1096,56 @@ static Int p_free_variables_in_term( while (!IsVarTerm(t) && IsApplTerm(t)) { Functor f = FunctorOfTerm(t); if (f == FunctorHat) { - out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1, - TR0 PASS_REGS); - if (out == 0L) { - goto trail_overflow; - } - } else if (f == FunctorModule) { - found_module = ArgOfTerm(1, t); - } else if (f == FunctorCall) { - t = ArgOfTerm(1, t); - } else if (f == FunctorExecuteInMod) { - found_module = ArgOfTerm(2, t); - t = ArgOfTerm(1, t); - } else { - break; - } - t = ArgOfTerm(2, t); - } - if (IsPrimitiveTerm(t)) - out = TermNil; - else { - out = free_vars_in_complex_term(&(t)-1, &(t), TR0 PASS_REGS); - } - if (out == 0L) { - trail_overflow: - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - if (found_module && t != t0) { - Term ts[2]; - ts[0] = found_module; - ts[1] = t; - t = Yap_MkApplTerm(FunctorModule, 2, ts); + out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1, + TR0 PASS_REGS); + if (out == 0L) { + goto trail_overflow; + } + } else if (f == FunctorModule) { + found_module = ArgOfTerm(1, t); + } else if (f == FunctorCall) { + t = ArgOfTerm(1, t); + } else if (f == FunctorExecuteInMod) { + found_module = ArgOfTerm(2, t); + t = ArgOfTerm(1, t); + } else { + break; + } + t = ArgOfTerm(2, t); + } + if (IsPrimitiveTerm(t)) + out = TermNil; + else { + out = free_vars_in_complex_term(&(t)-1, &(t), TR0 PASS_REGS); } - return Yap_unify(ARG2, t) && Yap_unify(ARG3, out); + if (out == 0L) { + trail_overflow: + if (!expand_vts(3 PASS_REGS)) + return false; + } +} while (out == 0L); +if (found_module && t != t0) { + Term ts[2]; + ts[0] = found_module; + ts[1] = t; + t = Yap_MkApplTerm(FunctorModule, 2, ts); +} +return Yap_unify(ARG2, t) && Yap_unify(ARG3, out); } #define FOUND_VAR_AGAIN() \ - if (d0 == TermFoundVar) { \ - CELL *pt2 = pt0; \ - while (IsVarTerm(*pt2)) \ - pt2 = (CELL *)(*pt2); \ - HR[1] = AbsPair(HR + 2); \ - HR[0] = (CELL)pt2; \ - HR += 2; \ - *pt2 = TermRefoundVar; \ - } +if (d0 == TermFoundVar) { \ + CELL *pt2 = pt0; \ + while (IsVarTerm(*pt2)) \ + pt2 = (CELL *)(*pt2); \ + HR[1] = AbsPair(HR + 2); \ + HR[0] = (CELL)pt2; \ + HR += 2; \ + *pt2 = TermRefoundVar; \ +} static Term non_singletons_in_complex_term(CELL * pt0, - CELL * pt0_end USES_REGS) { + CELL * pt0_end USES_REGS) { tr_fr_ptr TR0 = TR; CELL *InitialH = HR; HB = (CELL *)ASP; @@ -1208,13 +1211,13 @@ static void renumbervar(Term t, Int me USES_REGS) { } #define RENUMBER_SINGLES \ - if (singles) { \ - renumbervar(d0, numbv++ PASS_REGS); \ - goto restart; \ - } +if (singles) { \ + renumbervar(d0, numbv++ PASS_REGS); \ + goto restart; \ +} static Int numbervars_in_complex_term(CELL * pt0, CELL * pt0_end, Int numbv, - int singles USES_REGS) { + int singles USES_REGS) { tr_fr_ptr TR0 = TR; CELL *InitialH = HR; @@ -1251,17 +1254,17 @@ Int Yap_NumberVars(Term inp, Int numbv, * numbervariables in term t */ { CACHE_REGS - Int out; + Int out; Term t; - restart: + restart: t = Deref(inp); if (IsPrimitiveTerm(t)) { return numbv; } else { out = numbervars_in_complex_term(&(t)-1, &(t), numbv, - handle_singles PASS_REGS); + handle_singles PASS_REGS); } if (out < numbv) { if (!expand_vts(3 PASS_REGS)) @@ -1297,16 +1300,16 @@ static Int p_numbervars(USES_REGS1) { } #define MAX_NUMBERED \ - if (FunctorOfTerm(d0) == FunctorDollarVar) { \ - Term t1 = ArgOfTerm(1, d0); \ - Int i; \ - if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \ - *maxp = i; \ - goto restart; \ - } +if (FunctorOfTerm(d0) == FunctorDollarVar) { \ + Term t1 = ArgOfTerm(1, d0); \ + Int i; \ + if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \ + *maxp = i; \ + goto restart; \ +} static int max_numbered_var(CELL * pt0, CELL * pt0_end, - Int * maxp USES_REGS) { + Int * maxp USES_REGS) { int lvl = push_text_stack(); WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {}); END_WALK(); @@ -1382,44 +1385,48 @@ static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { Term ref, h, *s, *ostart; ssize_t n; // first time, create a new term - if (i==0) - return 0; if (IsVarTerm(t)) { return -1; } if (IsPairTerm(t)) { + Int me; s = RepPair(t); h = s[0]; - if (IsAtomTerm(h)) { - return t_ref((cl_connector*)AtomOfTerm(h),q,max); + if (IsAtomTerm(h) && + (me = t_ref((cl_connector*)AtomOfTerm(h),q,max)) >= 0 ) { + return me; } n = 2; ostart = HR; ref = AbsPair(ostart); HR += 2; - q[max].header = Deref(s[0]); } else if (IsApplTerm(t)) { + Int me; h = (CELL)FunctorOfTerm(t); n = ArityOfFunctor((Functor)h); if (IsExtensionFunctor((Functor)h)) { return -1; } - if (IsAtomTerm(h)) { - return t_ref((cl_connector*)AtomOfTerm(h),q,max); + if (IsAtomTerm(h) && + (me = t_ref((cl_connector*)AtomOfTerm(h),q,max)) >= 0) { + return me; } - s = RepAppl(t); + s = RepAppl(t); q[max].header = s[0]; ostart = HR; ref = AbsAppl(ostart); *ostart++ = s[0]; HR=ostart+n; - } else if (IsAtomTerm(t) && - (max = t_ref((cl_connector*)AtomOfTerm(t),q,max)) >= 0) { - return max; + } else { + Int me; + if (IsAtomTerm(t) && + (me = t_ref((cl_connector*)AtomOfTerm(t),q,max)) >= 0 ) { + return me; } else { return -1; } - +} + q[max].header = h; q[max].parent = q[i].copy+j; q[max].source = t; q[max].copy = ostart; @@ -1440,21 +1447,21 @@ Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) { if (IsVarTerm(ref)) { q[i].copy[j] = ref; } else if (i == 0){ - Term p = TermNil; - Term v = UNFOLD_LOOP(ref,&p); - q[i].reference = HeadOfTerm(p); - q[i].copy[j] = v; - } - else if (tailp && q[me].parent) { - Term v = UNFOLD_LOOP(ref, tailp); - q[i].copy[j] = v; - q[me].parent[0] = v; - q[i].reference = v; - } - return max; + Term p = TermNil; + Term v = UNFOLD_LOOP(ref,&p); + q[i].reference = HeadOfTerm(p); + q[i].copy[j] = v; + } + else if (tailp && q[me].parent) { + Term v = UNFOLD_LOOP(ref, tailp); + q[i].copy[j] = v; + q[me].parent[0] = v; + q[i].reference = v; } - q[i].copy[j] = t; - return me; + return max; +} +q[i].copy[j] = t; +return me; } Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) { @@ -1477,27 +1484,32 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) { while(icp_h; - return q[0].reference; +pop_text_stack(lvl); + +HB = B->cp_h; +return q[0].reference; } /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) @@ -1517,7 +1529,7 @@ static Int rational_term_to_tree(USES_REGS1) { if (IsVarTerm(l)) Yap_unify(l, MkVarTerm()); return Yap_unify(Yap_BreakCycles(t, 4, &l PASS_REGS), ARG2) && - Yap_unify(l, ARG3); + Yap_unify(l, ARG3); } void Yap_InitTermCPreds(void) { diff --git a/packages/python/swig/setup.py b/packages/python/swig/setup.py index 3082198f7..b5cd8eb28 100644 --- a/packages/python/swig/setup.py +++ b/packages/python/swig/setup.py @@ -85,7 +85,7 @@ native_sources = ["yap4py/yap_wrap.cxx","yap4py/yapi.cpp"] extensions = [Extension('_yap', native_sources, define_macros=[('MAJOR_VERSION', '6'), - ('MINOR_VERSION', '4'), + ('MINOR_VERSION', '5'), ('_YAP_NOT_INSTALLED_', '1'), ('YAP_PYTHON', '1'), ('PYTHONSWIG', '1'), @@ -115,7 +115,7 @@ package_data = { data_files=[] -version_ns = {'__version__': '6.4.1', 'major-version': '6', 'minor-version': '4', 'patch': '1'} +version_ns = {'__version__': '6.5.0', 'major-version': '6', 'minor-version': '5', 'patch': '0'} setup_args = dict( name=name, diff --git a/pl/undefined.yap b/pl/undefined.yap index f7a85e999..3852845f8 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -94,7 +94,7 @@ undefined_query(G0, M0, Cut) :- '$get_undefined_predicates'(M0:G0, MG), !. % undef handler -'$undefp_'([M0|G0],MG) :- +'$undefp'([M0|G0],MG) :- % make sure we do not loop on undefined predicates '$undef_setup'(M0:G0, Action,Debug,Current, MGI), ('$get_undefined_predicates'( MGI, MG ) diff --git a/regression/cyclics.yap b/regression/cyclics.yap index 1b8c63206..9efd361f8 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -72,6 +72,7 @@ d(X, ( X= f(A,A,X)) ). d(X, ( X= f(A,A,g(A))) ). d(X, ( X= f(A,g(X,[A|A]),X)) ). d(X, ( X= f(X,[X,X])) ). +d(X, ( X= f(3.14,[22.3,X])) ). d(X, ( X= f(X,[X,g(X)])) ). d(X, ( X= f(_,X/[X])) ). d(X, ( X= f(_,A/[A]), A= f(X,[X,g(X)])) ). From 593877f39d15fb3ce094eb17d90128ec252591fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 14 Feb 2019 07:44:31 +0000 Subject: [PATCH 047/101] fixes --- C/terms.c | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/C/terms.c b/C/terms.c index ace0d9a6e..5d3954fad 100644 --- a/C/terms.c +++ b/C/terms.c @@ -1443,14 +1443,14 @@ Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) { Term p = TermNil; Term v = UNFOLD_LOOP(ref,&p); q[i].reference = HeadOfTerm(p); - q[i].copy[j] = v; - } - else if (tailp && q[me].parent) { + q[i].copy[j] = v; + + } else if (tailp && q[me].parent) { Term v = UNFOLD_LOOP(ref, tailp); q[i].copy[j] = v; q[me].parent[0] = v; q[i].reference = v; - } + fprintf(stderr,"C i=%ld me=%ld %lx\n", i, me, q[i].copy[j]); } return max; } q[i].copy[j] = t; @@ -1473,7 +1473,8 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) { return t; } else { // initialization - qlen = create_entry(Deref(t), i, 0, q, qlen); + fprintf(stderr,"C i=%ld,%ld %lx\n", i, 0, q[i].copy[0]); } + qlen = create_entry(Deref(t), i, 0, q, qlen); while(icp_h; From 4b5ae9331f697984e7b119f1f43531b28c99f958 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 14 Feb 2019 09:08:15 +0000 Subject: [PATCH 048/101] clpbn --- C/terms.c | 2 +- packages/CLPBN/CMakeLists.txt | 2 -- packages/CLPBN/horus/CMakeLists.txt | 2 +- 3 files changed, 2 insertions(+), 4 deletions(-) diff --git a/C/terms.c b/C/terms.c index 970e04b2a..43204c5f1 100644 --- a/C/terms.c +++ b/C/terms.c @@ -1403,10 +1403,10 @@ static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { } else if (IsApplTerm(t)) { Int me; h = (CELL)FunctorOfTerm(t); - n = ArityOfFunctor((Functor)h); if (IsExtensionFunctor((Functor)h)) { return -1; } + n = ArityOfFunctor((Functor)h); if (IsAtomTerm(h) && (me = t_ref((cl_connector*)AtomOfTerm(h),q,max)) >= 0) { return me; diff --git a/packages/CLPBN/CMakeLists.txt b/packages/CLPBN/CMakeLists.txt index 2bf325029..0dd3e290b 100644 --- a/packages/CLPBN/CMakeLists.txt +++ b/packages/CLPBN/CMakeLists.txt @@ -89,14 +89,12 @@ set( ex/learning/train.yap ) -IF (WITH_HORUS) include(CheckCXXCompilerFlag) CHECK_CXX_COMPILER_FLAG("-std=c++11" COMPILER_SUPPORTS_CXX11) CHECK_CXX_COMPILER_FLAG("-std=c++0x" COMPILER_SUPPORTS_CXX0X) if(COMPILER_SUPPORTS_CXX11) add_subDIRECTORY (horus) endif() -ENDIF() install(FILES ${CLPBN_TOP} diff --git a/packages/CLPBN/horus/CMakeLists.txt b/packages/CLPBN/horus/CMakeLists.txt index 398582a5c..ff89b3c31 100644 --- a/packages/CLPBN/horus/CMakeLists.txt +++ b/packages/CLPBN/horus/CMakeLists.txt @@ -68,7 +68,7 @@ if (CMAKE_MAJOR_VERSION GREATER 2) install(TARGETS horus HorusCli - RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} + RUNTIME DESTINATION ${YAP_INSTALL_LIBDIR} LIBRARY DESTINATION ${YAP_INSTALL_LIBDIR} ARCHIVE DESTINATION ${YAP_INSTALL_LIBDIR} ) From 90f5720fb089df20d9b62f21d1c18dcc523a099e Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 15 Feb 2019 13:50:24 +0000 Subject: [PATCH 049/101] boot --- C/flags.c | 125 ++++++++++-------- C/write.c | 23 ++-- C/yap-args.c | 1 + H/YapFlags.h | 15 ++- H/YapGFlagInfo.h | 2 +- include/YapErrors.h | 1 + .../python/yap_kernel/yap_kernel/_version.py | 2 +- pl/consult.yap | 9 -- pl/init.yap | 123 +++++++++-------- pl/messages.yap | 5 +- pl/qly.yap | 2 +- 11 files changed, 166 insertions(+), 142 deletions(-) diff --git a/C/flags.c b/C/flags.c index 507921607..2fa06b596 100644 --- a/C/flags.c +++ b/C/flags.c @@ -77,6 +77,7 @@ static bool sqf(Term t2); static bool set_error_stream(Term inp); static bool set_input_stream(Term inp); static bool set_output_stream(Term inp); +static bool dollar_to_lc(Term inp); static void newFlag(Term fl, Term val); static Int current_prolog_flag(USES_REGS1); @@ -119,11 +120,11 @@ static Term indexer(Term inp) { return inp; if (IsAtomTerm(inp)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag index in {off,single,compact,multi,on,max}"); return TermZERO; } - Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom"); + Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom"); return TermZERO; } @@ -147,14 +148,14 @@ static bool dqf1(ModEntry *new, Term t2 USES_REGS) { return true; } /* bad argument, but still an atom */ - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted " "string flag, use one string, " "atom, codes or chars", RepAtom(AtomOfTerm(t2))->StrOfAE); return false; } else { - Yap_Error(TYPE_ERROR_ATOM, t2, + Yap_ThrowError(TYPE_ERROR_ATOM, t2, "set_prolog_flag(double_quotes, %s), should " "be {string,atom,codes,chars}", RepAtom(AtomOfTerm(t2))->StrOfAE); @@ -187,14 +188,14 @@ static bool bqf1(ModEntry *new, Term t2 USES_REGS) { new->flags |= BCKQ_CHARS; return true; } - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted " "string flag, use one string, " "atom, codes or chars", RepAtom(AtomOfTerm(t2))->StrOfAE); return false; } else { - Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped", + Yap_ThrowError(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped", RepAtom(AtomOfTerm(t2))->StrOfAE); return false; } @@ -225,14 +226,14 @@ static bool sqf1(ModEntry *new, Term t2 USES_REGS) { new->flags |= SNGQ_CHARS; return true; } - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted " "string flag, use one string, " "atom, codes or chars", RepAtom(AtomOfTerm(t2))->StrOfAE); return false; } else { - Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped", + Yap_ThrowError(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped", RepAtom(AtomOfTerm(t2))->StrOfAE); return false; } @@ -244,6 +245,20 @@ static bool sqf(Term t2) { return sqf1(new, t2 PASS_REGS); } +static bool dollar_to_lc(Term inp) { + if (inp == TermTrue || inp == TermOn) { + Yap_chtype0['$'+1] = LC; + return true; + } + if (inp == TermFalse || inp == TermOff) { + Yap_chtype0['$'+1] = CC; + return false; + } + Yap_ThrowError(TYPE_ERROR_BOOLEAN, inp, + "dollar_to_lower_case is a boolean flag"); + return TermZERO; + } + static Term isaccess(Term inp) { if (inp == TermReadWrite || inp == TermReadOnly) return inp; @@ -252,11 +267,11 @@ static Term isaccess(Term inp) { inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE); } if (IsAtomTerm(inp)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag access in {read_write,read_only}"); return TermZERO; } - Yap_Error(TYPE_ERROR_ATOM, inp, + Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag access in {read_write,read_only}"); return TermZERO; } @@ -302,11 +317,11 @@ static Term flagscope(Term inp) { inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE); } if (IsAtomTerm(inp)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag access in {global,module,thread}"); return TermZERO; } - Yap_Error(TYPE_ERROR_ATOM, inp, + Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag access in {global,module,thread}"); return TermZERO; } @@ -320,7 +335,7 @@ static bool mkprompt(Term inp) { inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE); } if (!IsAtomTerm(inp)) { - Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); + Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); return false; } strncpy(LOCAL_Prompt, (const char *)RepAtom(AtomOfTerm(inp))->StrOfAE, @@ -334,7 +349,7 @@ static bool getenc(Term inp) { inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE); } if (!IsVarTerm(inp) && !IsAtomTerm(inp)) { - Yap_Error(TYPE_ERROR_ATOM, inp, "get_encoding"); + Yap_ThrowError(TYPE_ERROR_ATOM, inp, "get_encoding"); return false; } return Yap_unify(inp, MkAtomTerm(Yap_LookupAtom(enc_name(LOCAL_encoding)))); @@ -348,7 +363,7 @@ return Yap_unify( inp, MkAtomTerm( Yap_LookupAtom( enc_name(LOCAL_encoding) )) ); } if (!IsAtomTerm(inp) ) { -Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); +Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); return false; } enc_id( RepAtom( AtomOfTerm( inp ) )->StrOfAE, ENC_OCTET ); @@ -368,7 +383,7 @@ static bool typein(Term inp) { inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE); } if (!IsAtomTerm(inp)) { - Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); + Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); return false; } CurrentModule = inp; @@ -466,7 +481,7 @@ static bool typein(Term inp) { static bool string( Term inp ) { if (IsVarTerm(inp)) { - Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); + Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); return false; } if (IsStringTerm( inp )) @@ -481,7 +496,7 @@ static bool typein(Term inp) { hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE); } if (!IsAtomTerm(hd)) { - Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); + Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); return false; } } while (IsPairTerm( inp ) ); @@ -489,21 +504,21 @@ static bool typein(Term inp) { do { Term hd = HeadOfTerm(inp); if (!IsIntTerm(hd)) { - Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); + Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); return false; } if (IntOfTerm(hd) < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp0, "set_prolog_flag in 0..."); + Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp0, "set_prolog_flag in 0..."); return false; } } while (IsPairTerm( inp ) ); } else { - Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); + Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); return false; } } if ( inp != TermNil ) { - Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); + Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); return false; } return true; @@ -511,7 +526,7 @@ static bool typein(Term inp) { x static bool list_atom( Term inp ) { if (IsVarTerm(inp)) { - Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); + Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); return false; } Term inp0 = inp; @@ -523,13 +538,13 @@ x static bool list_atom( Term inp ) { } if (!IsAtomTerm(hd)) { - Yap_Error(TYPE_ERROR_ATOM, inp0, "set_prolog_flag in \"...\""); + Yap_ThrowError(TYPE_ERROR_ATOM, inp0, "set_prolog_flag in \"...\""); return false; } } while (IsPairTerm( inp ) ); } if ( inp != TermNil ) { - Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]"); + Yap_ThrowError(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]"); return false; } return true; @@ -538,7 +553,7 @@ x static bool list_atom( Term inp ) { static Term list_option(Term inp) { if (IsVarTerm(inp)) { - Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); + Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); return inp; } Term inp0 = inp; @@ -559,14 +574,14 @@ static Term list_option(Term inp) { continue; } if (!Yap_IsGroundTerm(hd)) - Yap_Error(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\""); + Yap_ThrowError(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\""); return TermZERO; } } while (IsPairTerm(inp)); if (inp == TermNil) { return inp0; } - Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]"); + Yap_ThrowError(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]"); return TermZERO; } else /* lone option */ { if (IsStringTerm(inp)) { @@ -591,12 +606,12 @@ static bool agc_threshold(Term t) { CACHE_REGS return Yap_unify(t, MkIntegerTerm(GLOBAL_AGcThreshold)); } else if (!IsIntegerTerm(t)) { - Yap_Error(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin"); + Yap_ThrowError(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin"); return FALSE; } else { Int i = IntegerOfTerm(t); if (i < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 agc_margin"); + Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 agc_margin"); return FALSE; } else { GLOBAL_AGcThreshold = i; @@ -610,12 +625,12 @@ static bool gc_margin(Term t) { if (IsVarTerm(t)) { return Yap_unify(t, Yap_GetValue(AtomGcMargin)); } else if (!IsIntegerTerm(t)) { - Yap_Error(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin"); + Yap_ThrowError(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin"); return FALSE; } else { Int i = IntegerOfTerm(t); if (i < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 gc_margin"); + Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 gc_margin"); return FALSE; } else { CACHE_REGS @@ -710,7 +725,7 @@ static void initFlag(flag_info *f, int fnum, bool global) { fprop = (FlagEntry *)Yap_AllocAtomSpace(sizeof(FlagEntry)); if (fprop == NULL) { WRITE_UNLOCK(ae->ARWLock); - Yap_Error(RESOURCE_ERROR_HEAP, TermNil, + Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil, "not enough space for new Flag %s", ae->StrOfAE); return; } @@ -766,7 +781,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) { return false; fv = GetFlagProp(AtomOfTerm(tflag)); if (!fv && !fv->global) { - Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag, + Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag, "trying to set unknown module flag"); return false; } @@ -783,7 +798,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) { Term t; while ((t = Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT)) == 0) { if (!Yap_gc(2, ENV, gc_P(P, CP))) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); + Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return false; } } @@ -810,7 +825,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) { me->flags |= (UNKNOWN_FAST_FAIL); return true; } - Yap_Error( + Yap_ThrowError( DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for unknown flag, use one of error, fail or warning.", RepAtom(AtomOfTerm(tflag))->StrOfAE); @@ -825,7 +840,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) { me->flags &= ~(M_CHARESCAPE); return true; } - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for character_escapes flag, use true or false", RepAtom(AtomOfTerm(tflag))->StrOfAE); return false; @@ -845,7 +860,7 @@ static Term getYapFlagInModule(Term tflag, Term mod) { return false; fv = GetFlagProp(AtomOfTerm(tflag)); if (!fv && !fv->global) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag"); + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag"); return 0L; } // module specific stuff now @@ -884,7 +899,7 @@ static Term getYapFlagInModule(Term tflag, Term mod) { return TermAtom; return TermString; } - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped", + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped", RepAtom(AtomOfTerm(tflag))->StrOfAE); return 0L; } @@ -1081,7 +1096,7 @@ static Int current_prolog_flag2(USES_REGS1) { tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE); } if (!IsAtomTerm(tflag)) { - Yap_Error(TYPE_ERROR_ATOM, tflag, "current_prolog_flag/3"); + Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "current_prolog_flag/3"); return (FALSE); } fv = GetFlagProp(AtomOfTerm(tflag)); @@ -1126,7 +1141,7 @@ bool setYapFlag(Term tflag, Term t2) { FlagEntry *fv; flag_term *tarr; if (IsVarTerm(tflag)) { - Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2"); + Yap_ThrowError(INSTANTIATION_ERROR, tflag, "yap_flag/2"); return (FALSE); } if (IsStringTerm(tflag)) { @@ -1143,7 +1158,7 @@ bool setYapFlag(Term tflag, Term t2) { return setYapFlagInModule(tflag, t2, modt); } if (!IsAtomTerm(tflag)) { - Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); + Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); return (FALSE); } fv = GetFlagProp(AtomOfTerm(tflag)); @@ -1156,7 +1171,7 @@ bool setYapFlag(Term tflag, Term t2) { } else if (fl == TermWarning) { Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE); } else { - Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag, + Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag, "trying to set unknown flag \"%s\"", AtomName(AtomOfTerm(tflag))); } @@ -1212,7 +1227,7 @@ Term getYapFlag(Term tflag) { flag_term *tarr; tflag = Deref(tflag); if (IsVarTerm(tflag)) { - Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2"); + Yap_ThrowError(INSTANTIATION_ERROR, tflag, "yap_flag/2"); return (FALSE); } if (IsStringTerm(tflag)) { @@ -1234,7 +1249,7 @@ Term getYapFlag(Term tflag) { return getYapFlagInModule(tflag, modt); } if (!IsAtomTerm(tflag)) { - Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); + Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); return (FALSE); } if (tflag == TermSilent) @@ -1250,7 +1265,7 @@ Term getYapFlag(Term tflag) { Yap_Warning("Flag ~s does not exist", RepAtom(AtomOfTerm(tflag))->StrOfAE); } else { - Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag, + Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag, "trying to use unknown flag %s", RepAtom(AtomOfTerm(tflag))->StrOfAE); } @@ -1353,7 +1368,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, tarr->at = TermFalse; return true; } - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be either true (on) or false (off)", s); return false; } else if (f == nat) { @@ -1363,7 +1378,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, UInt r = strtoul(ss, NULL, 10); Term t; if (errno) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be a positive integer)", s); return false; } @@ -1399,7 +1414,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION)); return true; } - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be either true (on) or false (off)", s); return false; } else if (f == isatom) { @@ -1408,7 +1423,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, } Atom r = Yap_LookupAtom(s); if (errno) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, + Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be a positive integer)", s); tarr->at = TermNil; } @@ -1519,7 +1534,7 @@ do_prolog_flag_property(Term tflag, Yap_ArgList2ToVector(opts, prolog_flag_property_defs, PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG); if (args == NULL) { - Yap_Error(LOCAL_Error_TYPE, opts, NULL); + Yap_ThrowError(LOCAL_Error_TYPE, opts, NULL); return false; } if (IsStringTerm(tflag)) { @@ -1531,7 +1546,7 @@ do_prolog_flag_property(Term tflag, tflag = Yap_YapStripModule(tflag, &modt); } else { free(args); - Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); + Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); return (FALSE); } } @@ -1584,7 +1599,7 @@ do_prolog_flag_property(Term tflag, break; case PROLOG_FLAG_PROPERTY_END: /* break; */ - Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, opts, "Flag not supported by YAP"); + Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, opts, "Flag not supported by YAP"); } } } @@ -1660,7 +1675,7 @@ static Int prolog_flag_property(USES_REGS1) { /* Init current_prolog_flag */ do_cut(0); return do_prolog_flag_property(t1, Deref(ARG2) PASS_REGS); } else { - Yap_Error(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2"); + Yap_ThrowError(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2"); } } return false; @@ -1693,7 +1708,7 @@ static Int do_create_prolog_flag(USES_REGS1) { Yap_ArgList2ToVector(opts, prolog_flag_property_defs, PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG); if (args == NULL) { - Yap_Error(LOCAL_Error_TYPE, opts, NULL); + Yap_ThrowError(LOCAL_Error_TYPE, opts, NULL); return false; } fv = GetFlagProp(AtomOfTerm(tflag)); diff --git a/C/write.c b/C/write.c index 9c9e4af34..2a5ec14ff 100644 --- a/C/write.c +++ b/C/write.c @@ -583,8 +583,13 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) { wrf stream = wglb->stream; if (atom == NULL) return; s = RepAtom(atom)->UStrOfAE; - if (s[0] == '\0') + if (s[0] == '\0') { + if (Quote_illegal) { + wrputc('\'', stream); + wrputc('\'', stream); + } return; + } if (IsBlob(atom)) { wrputblob(RepAtom(atom), Quote_illegal, wglb); return; @@ -1091,16 +1096,12 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, wglb.stream = mywrite; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; - wglb.Use_portray = false; - wglb.Handle_vars = true; - wglb.Use_portray = false; - wglb.Portray_delays = false; - wglb.Keep_terms = false; - wglb.Write_Loops = false; - wglb.Write_strings = false; - wglb.Quote_illegal = false; - wglb.Ignore_ops = false; - wglb.MaxDepth = 0; + wglb.Use_portray = flags & Use_portray_f; + wglb.Handle_vars = flags & Handle_vars_f; + wglb.Portray_delays = flags & AttVar_Portray_f; + wglb.Keep_terms = flags & To_heap_f; + wglb.Write_Loops = flags & Handle_cyclics_f; + wglb.Quote_illegal = flags & Quote_illegal_f; wglb.MaxArgs = 0 ; wglb.lw = separator; Term tp; diff --git a/C/yap-args.c b/C/yap-args.c index c640c4851..dce1edeee 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -834,6 +834,7 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_a iap->HaltAfterBoot = true; case 'l': p++; + iap->QuietMode = TRUE; if (!*++argv) { fprintf(stderr, "%% YAP unrecoverable error: missing load file name\n"); diff --git a/H/YapFlags.h b/H/YapFlags.h index a3232f22c..5a31750bc 100644 --- a/H/YapFlags.h +++ b/H/YapFlags.h @@ -230,12 +230,15 @@ typedef struct struct_param2 { const char *scope; } param2_t; +/// @brief prolog_flag/2 support, notice flag is initialized as text. +/// +/// typedef struct { - char *name; - bool writable; - flag_func def; - const char *init; - flag_helper_func helper; + char *name; //< user visible name + bool writable; //< read-write or read-only + flag_func def; //< call on definition + const char *init; //< initial value as string + flag_helper_func helper; //< operations triggered by writing the flag. } flag_info; typedef struct { @@ -244,6 +247,8 @@ typedef struct { const char *init; } arg_info; +/// @brief +/// a flag is represented as a Prolog term. typedef union flagTerm { Term at; struct DB_TERM *DBT; diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index 85997466f..83d8d7aa3 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -222,7 +222,7 @@ Show their ancestors while debuggIng vxu `on` consider `$` a lower case character. */ YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true, - booleanFlag, "false", NULL), + booleanFlag, "false", dollar_to_lc), /**< iso diff --git a/include/YapErrors.h b/include/YapErrors.h index 50bccdc3a..b4f7d7e86 100644 --- a/include/YapErrors.h +++ b/include/YapErrors.h @@ -176,6 +176,7 @@ E(TYPE_ERROR_ARRAY, TYPE_ERROR, "array") E(TYPE_ERROR_ATOM, TYPE_ERROR, "atom") E(TYPE_ERROR_ATOMIC, TYPE_ERROR, "atomic") E(TYPE_ERROR_BIGNUM, TYPE_ERROR, "bignum") +E(TYPE_ERROR_BOOLEAN, TYPE_ERROR, "boolean") E(TYPE_ERROR_BYTE, TYPE_ERROR, "byte") E(TYPE_ERROR_CALLABLE, TYPE_ERROR, "callable") E(TYPE_ERROR_CHAR, TYPE_ERROR, "char") diff --git a/packages/python/yap_kernel/yap_kernel/_version.py b/packages/python/yap_kernel/yap_kernel/_version.py index 83fc27f53..b75eee0a4 100644 --- a/packages/python/yap_kernel/yap_kernel/_version.py +++ b/packages/python/yap_kernel/yap_kernel/_version.py @@ -1,4 +1,4 @@ -version_info = (6, 3, 4, 'dev0') +version_info = (6, 5, 0, 'dev0') __version__ = '.'.join(map(str, version_info)) kernel_protocol_version_info = (5, 1) diff --git a/pl/consult.yap b/pl/consult.yap index b629500a4..4581a3202 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -42,7 +42,6 @@ use_module/3], ['$add_multifile'/3, '$csult'/2, - '$do_startup_reconsult'/1, '$elif'/2, '$else'/1, '$endif'/1, @@ -928,14 +927,6 @@ nb_setval('$if_level',0). % % reconsult at startup... % -'$do_startup_reconsult'(_X) :- - '$init_win_graphics', - fail. -'$do_startup_reconsult'(X) :- - catch(load_files(user:X, [silent(true)]), Error, '$LoopError'(Error, consult)), - !, - ( current_prolog_flag(halt_after_consult, false) -> true ; halt). -'$do_startup_reconsult'(_). '$skip_unix_header'(Stream) :- peek_code(Stream, 0'#), !, % 35 is ASCII for '# diff --git a/pl/init.yap b/pl/init.yap index e88f2a0b1..8f0e729ae 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -75,7 +75,8 @@ current_prolog_flag(version_data, yap(Mj, Mi, Patch, _) ), current_prolog_flag(resource_database, Saved ), format(user_error, '% YAP ~d.~d.~d-~a (compiled ~a)~n', [Mj,Mi, Patch, VERSIONGIT, AT]), - format(user_error, '% database loaded from ~a~n', [Saved]). + format(user_error, '% database loaded from ~a~n', [Saved]), + fail. '$version'. /** @@ -84,24 +85,33 @@ * Must be called after restoring. */ '$init_prolog' :- - % do catch as early as possible - '$version', - yap_flag(file_name_variables, _OldF, true), - '$init_consult', - %set_prolog_flag(file_name_variables, OldF), - '$init_globals', - set_prolog_flag(fileerrors, true), - set_value('$gc',on), - ('$exit_undefp' -> true ; true), - prompt1(' ?- '), - set_prolog_flag(debug, false), - % simple trick to find out if this is we are booting from Prolog. - % boot from a saved state - '$init_from_saved_state_and_args', %start_low_level_trace, + '$init_step'(_), + fail. +'$init_prolog'. + % do catch as early as possible +'$init_step'(1) :- + '$version'. +'$init_step'(2) :- + set_prolog_flag(file_name_variables, _OldF, true), + '$init_consult'. + %set_prolog_flag(file_name_variables, OldF), +'$init_step'(3) :- + '$init_globals', + set_prolog_flag(fileerrors, true), + set_value('$gc',on), + ('$exit_undefp' -> true ; true), + prompt1(' ?- '), + set_prolog_flag(debug, false). + % simple trick to find out if this is we are booting from Prolog. + % boot from a saved state +'$init_step'(4) :- + '$init_from_saved_state_and_args'. - '$db_clean_queues'(_), +'$init_step'(5) :- + '$db_clean_queues'(_). % this must be executed from C-code. % '$startup_saved_state', +'$init_step'(6) :- set_input(user_input), set_output(user_output), '$init_or_threads', @@ -110,24 +120,24 @@ % then we can execute the programs. '$startup_goals' :- - module(user), - fail. -'$startup_goals' :- - recorded('$startup_goal',G,_), - catch(once(user:G),Error,user:'$Error'(Error)), - fail. -'$startup_goals' :- + '$startup_step', + fail. + +'$startup_step' :- + module(user). +'$startup_step' :- + recorded('$startup_goal',G,_), + catch(once(user:G),Error,user:'$Error'(Error)). +'$startup_step' :- get_value('$init_goal',GA), GA \= [], set_value('$init_goal',[]), - '$run_atom_goal'(GA), - fail. -'$startup_goals' :- - recorded('$restore_flag', goal(Module:GA), R), - erase(R), - catch(once(Module:GA),Error,user:'$Error'(Error)), - fail. -'$startup_goals' :- + '$run_atom_goal'(GA). +'$startup_step' :- + recorded('$restore_flag', goal(Module:GA), R), + erase(R), + catch(once(Module:GA),Error,user:'$Error'(Error)). +'$startup_step' :- get_value('$myddas_goal',GA), GA \= [], set_value('$myddas_goal',[]), get_value('$myddas_user',User), User \= [], @@ -150,9 +160,8 @@ ), use_module(library(myddas)), call(db_open(mysql,myddas,Host/Db,User,Pass)), - '$myddas_import_all', - fail. -'$startup_goals'. + '$myddas_import_all'. +'$startup_step'. % % MYDDAS: Import all the tables from one database @@ -166,46 +175,48 @@ % use if we come from a save_program and we have SWI's shlib '$init_from_saved_state_and_args' :- - current_prolog_flag(hwnd, _HWND), - load_files(library(win_menu), [silent(true)]), + '$rebuild', fail. -'$init_from_saved_state_and_args' :- +'$init_from_saved_state_and_args'. + +'$rebuild' :- + current_prolog_flag(hwnd, _HWND), + load_files(library(win_menu), [silent(true)]). +'$rebuild' :- recorded('$reload_foreign_libraries',_G,R), erase(R), - shlib:reload_foreign_libraries, - fail. + shlib:reload_foreign_libraries. % this should be done before -l kicks in. -'$init_from_saved_state_and_args' :- +'$rebuild' :- current_prolog_flag(fast_boot, false), ( exists('~/.yaprc') -> load_files('~/.yaprc', []) ; true ), ( exists('~/.prologrc') -> load_files('~/.prologrc', []) ; true ), ( exists('~/prolog.ini') -> load_files('~/prolog.ini', []) ; true ), fail. % use if we come from a save_program and we have a goal to execute -'$init_from_saved_state_and_args' :- +'$rebuild' :- get_value('$consult_on_boot',X), X \= [], - set_value('$consult_on_boot',[]), - '$do_startup_reconsult'(X), - fail. -'$init_from_saved_state_and_args' :- + load_files(X, [silent(true)]), + set_value('$consult_on_boot',[]). +'$rebuild' :- recorded('$restore_flag', init_file(M:B), R), erase(R), - '$do_startup_reconsult'(M:B), - fail. -'$init_from_saved_state_and_args' :- + load_files(M:B, [silent(true)]). +'$rebuild' :- recorded('$restore_flag', unknown(M:B), R), erase(R), - yap_flag(M:unknown,B), - fail. -'$init_from_saved_state_and_args' :- - '$startup_goals', - fail. -'$init_from_saved_state_and_args' :- + load_files(M:B, [silent(true)]), + yap_flag(M:unknown,B). +'$rebuild' :- + '$startup_step'. +'$rebuild' :- + current_prolog_flag(halt_after_consult, true), + halt. +'$rebuild' :- recorded('$restore_goal',G,R), erase(R), prompt(_,'| '), - catch(once(user:G),Error,user:'$Error'(Error)), - fail. + catch(once(user:G),Error,user:'$Error'(Error)). '$init_path_extensions' :- get_value('$extend_file_search_path',P), !, diff --git a/pl/messages.yap b/pl/messages.yap index a1fb3a93e..bd0f4f3f4 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -1042,9 +1042,8 @@ prolog:print_message(Severity, Msg) :- !. prolog:print_message(Level, _Msg) :- current_prolog_flag(verbose_load, false), - '$show_consult_level'(LC), - LC > 0, - Level = informational, + prolog_load_context(file, _FileName), + Level \= warning, !. prolog:print_message(Level, _Msg) :- current_prolog_flag(verbose, silent), diff --git a/pl/qly.yap b/pl/qly.yap index ddcce2482..65018ec27 100755 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -600,7 +600,7 @@ qload_file( F0 ) :- H is heapused-H0, '$cputime'(TF,_), T is TF-T0, '$current_module'(Mod, Mod ), print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)), - '$exec_initialization_goals'. + '$init_prolog'. '$qload_file'(_S, SourceModule, _F, FilePl, _F0, _ImportList, _TOpts) :- recorded('$source_file','$source_file'( FilePl, _Age, SourceModule), _), From 1ef3f738eed7b7178ad1b845298562a05eaac91a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Fri, 15 Feb 2019 21:09:58 +0000 Subject: [PATCH 050/101] more loops. --- C/terms.c | 7 ++++--- C/write.c | 1 + packages/bdd/bdd.yap | 2 ++ .../python/yap_kernel/yap_ipython/terminal/debugger.py | 8 ++++---- regression/cyclics.yap | 1 + 5 files changed, 12 insertions(+), 7 deletions(-) diff --git a/C/terms.c b/C/terms.c index bb7fedf24..9629ed11e 100644 --- a/C/terms.c +++ b/C/terms.c @@ -367,7 +367,7 @@ static int cycles_in_complex_term(register CELL *pt0, ptd0 = RepAppl(d0); f = (Functor)(d0 = *ptd0); if (IsExtensionFunctor(f)) { - *ptf++ = d0; + *ptf++ = AbsAppl(ptd0); continue; } if (IS_VISIT_MARKER) { @@ -1228,7 +1228,7 @@ static Int numbervars_in_complex_term(CELL * pt0, CELL * pt0_end, Int numbv, if (IsAttVar(pt0)) continue; /* do or pt2 are unbound */ - if (singles || 0) + if (singles) d0 = numbervar_singleton(PASS_REGS1); else d0 = numbervar(numbv++ PASS_REGS); @@ -1384,6 +1384,8 @@ static Int t_ref(cl_connector *d, cl_connector * q, int max) { static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { Term ref, h, *s, *ostart; ssize_t n; + // fprintf(stderr,"[%ld,%ld]/%ld, %lx\n",i,j,max,t); + // first time, create a new term if (IsVarTerm(t)) { return -1; @@ -1482,7 +1484,6 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) { return t; } else { // initialization - fprintf(stderr,"C i=%ld,%ld %lx\n", i, 0, q[i].copy[0]); } qlen = create_entry(Deref(t), i, 0, q, qlen); while(i Date: Fri, 15 Feb 2019 23:04:35 +0000 Subject: [PATCH 051/101] fixes --- C/terms.c | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/C/terms.c b/C/terms.c index 9629ed11e..ba9277099 100644 --- a/C/terms.c +++ b/C/terms.c @@ -1448,18 +1448,13 @@ Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) { Term ref = Deref(q[me].reference); if (IsVarTerm(ref)) { q[i].copy[j] = ref; - } else if (i == 0){ - - Term p = TermNil; - Term v = UNFOLD_LOOP(ref,&p); - q[i].reference = HeadOfTerm(p); - q[i].copy[j] = v; - } - else if (tailp && q[me].parent) { + } + else { Term v = UNFOLD_LOOP(ref, tailp); q[i].copy[j] = v; + if (me) q[me].parent[0] = v; - q[i].reference = v; + q[me].reference = v; } return max; From 2c1565ac0ed940d79015079c8aab87110cd67272 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sat, 16 Feb 2019 13:09:30 +0000 Subject: [PATCH 052/101] trees --- C/terms.c | 52 ++++++++++++++++++++++++++++------------------------ 1 file changed, 28 insertions(+), 24 deletions(-) diff --git a/C/terms.c b/C/terms.c index ba9277099..8a768aa96 100644 --- a/C/terms.c +++ b/C/terms.c @@ -1375,17 +1375,19 @@ typedef struct block_connector { CELL reference; //> term used to refer the copy. } cl_connector; -static Int t_ref(cl_connector *d, cl_connector * q, int max) { - if ( d >= q && d < q+max) - return d-q; - return -1; //&& d->source == (void *; +static Int t_ref(cl_connector *d, cl_connector * q, Int *mep, Int max) { + if ( d >= q && d < q+max) { + *mep = d-q; + return true; + } + return false; //&& d->source == (void *; } static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { Term ref, h, *s, *ostart; ssize_t n; // fprintf(stderr,"[%ld,%ld]/%ld, %lx\n",i,j,max,t); - + restart: // first time, create a new term if (IsVarTerm(t)) { return -1; @@ -1394,9 +1396,8 @@ static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { Int me; s = RepPair(t); h = s[0]; - if (IsAtomTerm(h) && - (me = t_ref((cl_connector*)AtomOfTerm(h),q,max)) >= 0 ) { - return me; + if (IsAtomTerm(h) && t_ref((cl_connector *)AtomOfTerm(h), q, &me, max)) { + return me; } n = 2; ostart = HR; @@ -1408,28 +1409,28 @@ static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { if (IsExtensionFunctor((Functor)h)) { return -1; } - n = ArityOfFunctor((Functor)h); if (IsAtomTerm(h) && - (me = t_ref((cl_connector*)AtomOfTerm(h),q,max)) >= 0) { + t_ref((cl_connector*)AtomOfTerm(h),q,&me,max)) { return me; } - s = RepAppl(t); - q[max].header = s[0]; + n = ArityOfFunctor((Functor)h); + s = RepAppl(t); ostart = HR; ref = AbsAppl(ostart); *ostart++ = s[0]; HR=ostart+n; } else { Int me; - if (IsAtomTerm(t) && - (me = t_ref((cl_connector*)AtomOfTerm(t),q,max)) >= 0 ) { - return me; - } else { + if (IsAtomTerm(t) && t_ref((cl_connector*)AtomOfTerm(t),q,&me,max)) { + t = q[me].source; + goto restart; + } else { return -1; - } -} + } + } q[max].header = h; q[max].parent = q[i].copy+j; + q[i].copy[j] = ref; q[max].source = t; q[max].copy = ostart; q[max].reference = ref; @@ -1445,9 +1446,10 @@ Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) { q[i].copy[j] = t; return max; } - Term ref = Deref(q[me].reference); + Term ref = q[me].reference; if (IsVarTerm(ref)) { q[i].copy[j] = ref; + // fprintf(stderr," - %p\n", ref); } else { Term v = UNFOLD_LOOP(ref, tailp); @@ -1455,11 +1457,10 @@ Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) { if (me) q[me].parent[0] = v; q[me].reference = v; - + fprintf(stderr," + %p\n", v); } return max; } -q[i].copy[j] = t; return me; } @@ -1475,11 +1476,14 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) { HB = HR; qlen = 0; + Term t0 = MkPairTerm(t, TermNil); + q[0].copy = HR; + HR+=2; if (IsVarTerm(t) || IsPrimitiveTerm(t)) { return t; } else { // initialization - qlen = create_entry(Deref(t), i, 0, q, qlen); + qlen = create_entry(Deref(t0), i, 0, q, qlen); while(icp_h; -return q[0].reference; + return HeadOfTerm( q[0].reference ); } /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) From 6a3c4bda791a8344c55dfc36a5c51b64b49129ce Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 17 Feb 2019 07:58:06 +0000 Subject: [PATCH 053/101] fix --- C/exec.c | 31 +++++++++++++++++++++++++++---- 1 file changed, 27 insertions(+), 4 deletions(-) diff --git a/C/exec.c b/C/exec.c index f614a5dc4..8abfbed69 100755 --- a/C/exec.c +++ b/C/exec.c @@ -135,7 +135,7 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) { * Transfer control to a meta-call in ARG1, cut up to B. * * @param g goal - * @param mod current module + * @param mod curre1nt module * @return su */ Term Yap_ExecuteCallMetaCall(Term g, Term mod) { @@ -214,14 +214,15 @@ static Int current_choice_point(USES_REGS1) { * * The call will fail if _CP_ is topmost in the search tree. */ -static Int parent_choice_point(USES_REGS1) { +static Int parent_choice_point2(USES_REGS1) { Term t = Deref(ARG1); Term td; #if SHADOW_HB register CELL *HBREG = HB; #endif - if (!IsVarTerm(t)) - return (FALSE); + if (!IsVarTerm(t)) { + Yap_ThrowError(INSTANTIATION_ERROR, t, "child choicr-point missing"); + } choiceptr cp = cp_from_integer(t); if (cp == NULL || cp->cp_b == NULL) return false; @@ -230,6 +231,27 @@ static Int parent_choice_point(USES_REGS1) { return TRUE; } +/** @pred parent_choice_point( -PB ) + * + * PB is a number identifying the parent of the current choice-point. + * It storing the offset of the current ch + * + * The call will fail if _CP_ is topmost in the search tree. + */ +static Int parent_choice_point(USES_REGS1) { + Term t = Deref(ARG1); + Term td; +#if SHADOW_HB + register CELL *HBREG = HB; +#endif + if (B == NULL || B->cp_b == NULL) + return false; + td = cp_as_integer(B->cp_b PASS_REGS); + YapBind((CELL *)t, td); + return true; +} + + static Int save_env_b(USES_REGS1) { Term t = Deref(ARG1); Term td; @@ -2334,6 +2356,7 @@ void Yap_InitExecFs(void) { Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0); Yap_InitCPred("env_choice_point", 1, save_env_b, 0); Yap_InitCPred("parent_choice_point", 1, parent_choice_point, 0); + Yap_InitCPred("parent_choice_point", 2, parent_choice_point2, 0); Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag); CurrentModule = cm; Yap_InitCPred("$restore_regs", 1, restore_regs, From 79d2330e71d0d142c9adbb8c941c386cb255deb4 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 17 Feb 2019 23:19:26 +0000 Subject: [PATCH 054/101] handle Z=[X,Z], X=y(X) --- C/exec.c | 8 +++--- C/terms.c | 62 +++++++++++++++++++++++------------------------ C/write.c | 3 ++- H/absmi.h | 2 +- library/hacks.yap | 9 ------- pl/top.yap | 4 +-- 6 files changed, 39 insertions(+), 49 deletions(-) diff --git a/C/exec.c b/C/exec.c index 8abfbed69..687c532b6 100755 --- a/C/exec.c +++ b/C/exec.c @@ -214,7 +214,7 @@ static Int current_choice_point(USES_REGS1) { * * The call will fail if _CP_ is topmost in the search tree. */ -static Int parent_choice_point2(USES_REGS1) { +static Int parent_choice_point(USES_REGS1) { Term t = Deref(ARG1); Term td; #if SHADOW_HB @@ -238,7 +238,7 @@ static Int parent_choice_point2(USES_REGS1) { * * The call will fail if _CP_ is topmost in the search tree. */ -static Int parent_choice_point(USES_REGS1) { +static Int parent_choice_point1(USES_REGS1) { Term t = Deref(ARG1); Term td; #if SHADOW_HB @@ -2355,8 +2355,8 @@ void Yap_InitExecFs(void) { Yap_InitCPred("current_choice_point", 1, current_choice_point, 0); Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0); Yap_InitCPred("env_choice_point", 1, save_env_b, 0); - Yap_InitCPred("parent_choice_point", 1, parent_choice_point, 0); - Yap_InitCPred("parent_choice_point", 2, parent_choice_point2, 0); + Yap_InitCPred("parent_choice_point", 1, parent_choice_point1, 0); + Yap_InitCPred("parent_choice_point", 2, parent_choice_point, 0); Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag); CurrentModule = cm; Yap_InitCPred("$restore_regs", 1, restore_regs, diff --git a/C/terms.c b/C/terms.c index 8a768aa96..f5dc8a3c0 100644 --- a/C/terms.c +++ b/C/terms.c @@ -40,6 +40,10 @@ #define Malloc malloc #define Realloc realloc +extern int cs[10]; + +int cs[10]; + static int expand_vts(int args USES_REGS) { UInt expand = LOCAL_Error_Size; yap_error_number yap_errno = LOCAL_Error_TYPE; @@ -90,26 +94,10 @@ static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { //} non_singletons_t; #define IS_VISIT_MARKER \ -(IsPairTerm(d0) && RepPair(d0) >= (CELL *)to_visit0 && \ - RepPair(d0) <= (CELL *)to_visit) +(IsAtomTerm(d0) && AtomOfTerm(d0) >= (Atom)to_visit0 && \ + AtomOfTerm(d0) <= (Atom)to_visit) -#define VISIT_MARKER AbsPair((CELL *)to_visit) - -#define CYC_MARK_LIST \ -if (IsPairTerm(d0) && RepPair(d0) >= (CELL *)to_visit0 && \ - RepPair(d0) <= (CELL *)to_visit) { \ - /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ - *ptf++ = BREAK_LOOP(to_visit - to_visit0); \ -continue; \ -} - -#define CYC_MARK_APPL \ -if (IsApplTerm(d0) && RepAppl(d0) >= (Term *)to_visit0 && \ - RepAppl(d0) <= (Term *)to_visit) { \ - /*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \ - *ptf++ = BREAK_LOOP(to_visit - to_visit0); \ -continue; \ -} +#define VISIT_MARKER MkAtomTerm((Atom)to_visit) typedef struct { Term old_var; @@ -188,6 +176,10 @@ while (to_visit >= to_visit0) { \ pt0_end = ptd0 + d1; \ continue; \ } else { \ + if (IS_VISIT_MARKER) { \ + \ + continue; \ + } \ PRIMI0; \ continue; \ } \ @@ -280,6 +272,7 @@ static Term cyclic_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { } bool Yap_IsCyclicTerm(Term t USES_REGS) { + cs[2]++; if (IsVarTerm(t)) { return false; @@ -304,9 +297,9 @@ static Int cyclic_term(USES_REGS1) /* cyclic_term(+T) */ return Yap_IsCyclicTerm(Deref(ARG1)); } -static Term BREAK_LOOP(Int ddep) { +static Term BREAK_LOOP(CELL d0,struct non_single_struct_t *to_visit ) { char buf[64]; - snprintf(buf, 63, "@^[" Int_FORMAT "]", ddep); + snprintf(buf, 63, "@^[" Int_FORMAT "]", to_visit-(struct non_single_struct_t*)AtomOfTerm(d0)); return MkAtomTerm(Yap_LookupAtom(buf)); } @@ -344,7 +337,7 @@ static int cycles_in_complex_term(register CELL *pt0, d0 = ptd0[0]; if (IS_VISIT_MARKER) { rc++; - *ptf++ = BREAK_LOOP(to_visit - to_visit0); + *ptf++ = BREAK_LOOP(d0, to_visit); continue; } *ptf++ = AbsPair(HR); @@ -372,7 +365,7 @@ static int cycles_in_complex_term(register CELL *pt0, } if (IS_VISIT_MARKER) { rc++; - *ptf++ = BREAK_LOOP(to_visit - to_visit0); + *ptf++ = BREAK_LOOP(d0, to_visit); continue; } if (to_visit + 32 >= to_visit_max) { @@ -395,6 +388,11 @@ static int cycles_in_complex_term(register CELL *pt0, HR+=d1; continue; } else { + if (IS_VISIT_MARKER) { + rc++; + *ptf++ = BREAK_LOOP(d0, to_visit); + continue; + } *ptf++ = d0; continue; } @@ -420,7 +418,8 @@ return -1; } Term Yap_CyclesInTerm(Term t USES_REGS) { - + cs[3]++; + t = Deref(t); if (IsVarTerm(t)) { return t; } else if (IsPrimitiveTerm(t)) { @@ -674,11 +673,11 @@ return Yap_unify(ARG3, out); */ -static Int p_term_variables3( +static Int term_variables3( USES_REGS1) /* variables in term t */ { Term out; - + cs[0]++; do { Term t = Deref(ARG1); if (IsVarTerm(t)) { @@ -738,11 +737,11 @@ Term Yap_TermVariables( */ -static Int p_term_variables( +static Int term_variables( USES_REGS1) /* variables in term t */ { Term out; - + cs[1]++; if (!Yap_IsListOrPartialListTerm(ARG2)) { Yap_Error(TYPE_ERROR_LIST, ARG2, "term_variables/2"); return false; @@ -815,7 +814,7 @@ static Term attvars_in_complex_term( } } - /*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__)*/; + /*fprintf(stderr,"<%ld at %s\n", d0, __FUNCTION__)*/; return (output); def_aux_overflow(); @@ -1457,7 +1456,6 @@ Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) { if (me) q[me].parent[0] = v; q[me].reference = v; - fprintf(stderr," + %p\n", v); } return max; } @@ -1537,8 +1535,8 @@ static Int rational_term_to_tree(USES_REGS1) { void Yap_InitTermCPreds(void) { Yap_InitCPred("cycles_in_term", 2, cycles_in_term, 0); - Yap_InitCPred("term_variables", 2, p_term_variables, 0); - Yap_InitCPred("term_variables", 3, p_term_variables3, 0); + Yap_InitCPred("term_variables", 2, term_variables, 0); + Yap_InitCPred("term_variables", 3, term_variables3, 0); Yap_InitCPred("$variables_in_term", 3, variables_in_term, 0); Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); diff --git a/C/write.c b/C/write.c index 61544ce99..79dca5220 100644 --- a/C/write.c +++ b/C/write.c @@ -1115,7 +1115,8 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, /* protect slots for portray */ writeTerm(tp, priority, 1, false, &wglb, &rwt); - if (flags & New_Line_f) { + tp = Yap_CyclesInTerm(t PASS_REGS); + if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); wrputc('\n', wglb.stream); diff --git a/H/absmi.h b/H/absmi.h index 2a3e9bacf..b05baa93a 100755 --- a/H/absmi.h +++ b/H/absmi.h @@ -965,7 +965,7 @@ INLINE_ONLY void restore_absmi_regs(REGSTORE *old_regs) { _##Label : { \ START_PREFETCH(Type) -#define OpW(Label, Type) \ +#define OpW(Label, Type) \ _##Label : { \ START_PREFETCH_W(Type) diff --git a/library/hacks.yap b/library/hacks.yap index 2f46e89b4..2a0f6fccb 100644 --- a/library/hacks.yap +++ b/library/hacks.yap @@ -68,15 +68,6 @@ run_formats([], _). run_formats([Com-Args|StackInfo], Stream) :- format(Stream, Com, Args), run_formats(StackInfo, user_error). -/** - * @pred parent_choicepoint(+_ChoicePoint_) - * - * _ChoicePoint_ is the parent of the current choice-point. - * - */ -parent_choicepoint(BP) :- - current_choicepoint(B), - parent_choicepoint(B, BP). /** diff --git a/pl/top.yap b/pl/top.yap index 6d214897a..4c85aa0c0 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -636,7 +636,7 @@ write_query_answer( Bindings ) :- '$call'(M:_,_,G0,_) :- var(M), !, '$do_error'(instantiation_error,call(G0)). '$call'(M:G,CP,G0,_M0) :- !, -'$expand_meta_call'(M:G, [], NG), + '$expand_meta_call'(M:G, [], NG), '$yap_strip_module'(NG,NM,NC), '$call'(NC,CP,G0,NM). '$call'((X,Y),CP,G0,M) :- !, @@ -704,7 +704,7 @@ write_query_answer( Bindings ) :- '$call'(not(X), _CP, G0, M) :- !, \+ ('$current_choice_point'(CP), '$call'(X,CP,G0,M) ). -'$call'(!, CP, CP,_G0) :- !, +'$call'(!, CP, _G0, _m) :- !, '$$cut_by'(CP). '$call'([X|Y], _, _, M) :- (Y == [] -> From c792db26be916703a04ca0ce2c8dfdd53726f667 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 18 Feb 2019 09:54:39 +0000 Subject: [PATCH 055/101] fix tracer calls --- C/prim_absmi_insts.h | 138 +++++++++++++++++++++---------------------- 1 file changed, 69 insertions(+), 69 deletions(-) diff --git a/C/prim_absmi_insts.h b/C/prim_absmi_insts.h index fc10ba1a4..679e9df4f 100644 --- a/C/prim_absmi_insts.h +++ b/C/prim_absmi_insts.h @@ -1949,11 +1949,12 @@ Op(p_arg_vv, xxx); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - HR[0] = XREG(PREG->y_u.xxx.x1); - HR[1] = XREG(PREG->y_u.xxx.x2); - RESET_VARIABLE(HR + 2); + CELL HRs[3]; + HRs[0] = XREG(PREG->y_u.xxx.x1); + HRs[1] = XREG(PREG->y_u.xxx.x2); + HRs[2] = TermNil; low_level_trace(enter_pred, - RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR); + RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs); } #endif /* LOW_LEVEL_TRACE */ BEGD(d0); @@ -2044,15 +2045,14 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); Op(p_arg_cv, xxn); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - CELL *Ho = HR; + CELL HRs[3]; Term t = MkIntegerTerm(PREG->y_u.xxn.c); - HR[0] = t; - HR[1] = XREG(PREG->y_u.xxn.xi); - RESET_VARIABLE(HR + 2); + HRs[0] = t; + HRs[1] = XREG(PREG->y_u.xxn.xi); + HRs[2] = TermFoundVar; low_level_trace(enter_pred, - RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR); - HR = Ho; - } + RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs); + } #endif /* LOW_LEVEL_TRACE */ BEGD(d0); d0 = PREG->y_u.xxn.c; @@ -2118,12 +2118,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); Op(p_arg_y_vv, yxx); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - HR[0] = XREG(PREG->y_u.yxx.x1); - HR[1] = XREG(PREG->y_u.yxx.x2); - HR[2] = YREG[PREG->y_u.yxx.y]; - RESET_VARIABLE(HR + 2); - low_level_trace(enter_pred, - RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR); + CELL HRs[3]; + + HRs[0] = XREG(PREG->y_u.yxx.x1); + HRs[1] = XREG(PREG->y_u.yxx.x2); + HRs[2] = TermFoundVar; + low_level_trace(enter_pred, + RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs); } #endif /* LOW_LEVEL_TRACE */ BEGD(d0); @@ -2215,15 +2216,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); Op(p_arg_y_cv, yxn); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - CELL *Ho = HR; + CELL HRs[3]; Term t = MkIntegerTerm(PREG->y_u.yxn.c); - HR[0] = t; - HR[1] = XREG(PREG->y_u.yxn.xi); - HR[2] = YREG[PREG->y_u.yxn.y]; - RESET_VARIABLE(HR + 2); + HRs[0] = t; + HRs[1] = XREG(PREG->y_u.yxn.xi); + HRs[2] = TermNil; low_level_trace(enter_pred, - RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR); - HR = Ho; + RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs); } #endif /* LOW_LEVEL_TRACE */ BEGD(d0); @@ -2295,12 +2294,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); restart_func2s: #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - RESET_VARIABLE(HR); - HR[1] = XREG(PREG->y_u.xxx.x1); - HR[2] = XREG(PREG->y_u.xxx.x2); + CELL HRs[3]; + HRs[0] = TermNil; + HRs[1] = XREG(PREG->y_u.xxx.x1); + HRs[2] = XREG(PREG->y_u.xxx.x2); low_level_trace(enter_pred, RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)), - HR); + HRs); } #endif /* LOW_LEVEL_TRACE */ /* We have to build the structure */ @@ -2412,12 +2412,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); restart_func2s_cv: #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - RESET_VARIABLE(HR); - HR[1] = PREG->y_u.xxc.c; - HR[2] = XREG(PREG->y_u.xxc.xi); + CELL HRs[3]; + HRs[0] = TermNil; + HRs[1] = PREG->y_u.xxc.c; + HRs[2] = XREG(PREG->y_u.xxc.xi); low_level_trace(enter_pred, RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)), - HR); + HRs); } #endif /* LOW_LEVEL_TRACE */ BEGD(d0); @@ -2517,16 +2518,14 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { Term ti; - CELL *hi = HR; - + CELL HRs[3]; + HRs[0] = TermNil; ti = MkIntegerTerm(PREG->y_u.xxn.c); - RESET_VARIABLE(HR); - HR[1] = XREG(PREG->y_u.xxn.xi); - HR[2] = ti; + HRs[1] = XREG(PREG->y_u.xxn.xi); + HRs[2] = ti; low_level_trace(enter_pred, RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)), - HR); - HR = hi; + HRs); } #endif /* LOW_LEVEL_TRACE */ /* We have to build the structure */ @@ -2611,12 +2610,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); restart_func2s_y: #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - RESET_VARIABLE(HR); - HR[1] = XREG(PREG->y_u.yxx.x1); - HR[2] = XREG(PREG->y_u.yxx.x2); + CELL HRs[3]; + HRs[0] = TermNil; + HRs[1] = XREG(PREG->y_u.yxx.x1); + HRs[2] = XREG(PREG->y_u.yxx.x2); low_level_trace(enter_pred, RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)), - HR); + HRs); } #endif /* LOW_LEVEL_TRACE */ /* We have to build the structure */ @@ -2735,12 +2735,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); restart_func2s_y_cv: #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - RESET_VARIABLE(HR); - HR[1] = PREG->y_u.yxc.c; - HR[2] = XREG(PREG->y_u.yxc.xi); + CELL HRs[3]; + HRs[0] = TermNil; + HRs[1] = PREG->y_u.yxc.c; + HRs[2] = XREG(PREG->y_u.yxc.xi); low_level_trace(enter_pred, RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)), - HR); + HRs); } #endif /* LOW_LEVEL_TRACE */ /* We have to build the structure */ @@ -2846,16 +2847,15 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { Term ti; - CELL *hi = HR; + CELL HRs[3]; ti = MkIntegerTerm((Int)(PREG->y_u.yxn.c)); - RESET_VARIABLE(HR); - HR[1] = XREG(PREG->y_u.yxn.xi); - HR[2] = ti; + HRs[0] = TermFoundVar; + HRs[1] = XREG(PREG->y_u.yxn.xi); + HRs[2] = ti; low_level_trace(enter_pred, RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)), - HR); - HR = hi; + HRs); } #endif /* LOW_LEVEL_TRACE */ /* We have to build the structure */ @@ -2952,12 +2952,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); Op(p_func2f_xx, xxx); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - HR[0] = XREG(PREG->y_u.xxx.x); - RESET_VARIABLE(HR + 1); - RESET_VARIABLE(HR + 2); + Term HRs[3]; + HRs[0] = XREG(PREG->y_u.xxx.x); + HRs[1] = HRs[2] = TermFoundVar; low_level_trace(enter_pred, RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)), - HR); + HRs); } #endif /* LOW_LEVEL_TRACE */ BEGD(d0); @@ -3000,12 +3000,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); Op(p_func2f_xy, xxy); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - HR[0] = XREG(PREG->y_u.xxy.x); - RESET_VARIABLE(HR + 1); - RESET_VARIABLE(HR + 2); + Term HRs[3]; + HRs[0] = XREG(PREG->y_u.xxy.x); + HRs[1] = HRs[2] = TermFoundVar; low_level_trace(enter_pred, RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)), - HR); + HRs); } #endif /* LOW_LEVEL_TRACE */ BEGD(d0); @@ -3051,12 +3051,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); Op(p_func2f_yx, yxx); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - HR[0] = XREG(PREG->y_u.yxx.x2); - RESET_VARIABLE(HR + 1); - RESET_VARIABLE(HR + 2); + Term HRs[3]; + HRs[0] = XREG(PREG->y_u.yxx.x2); + HRs[1] = HRs[2] = TermFoundVar; low_level_trace(enter_pred, RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)), - HR); + HRs); } #endif /* LOW_LEVEL_TRACE */ BEGD(d0); @@ -3102,12 +3102,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); Op(p_func2f_yy, yyx); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - HR[0] = XREG(PREG->y_u.yyx.x); - RESET_VARIABLE(HR + 1); - RESET_VARIABLE(HR + 2); + CELL HRs[3]; + HRs[0] = XREG(PREG->y_u.yyx.x); + HRs[1] = HRs[2] = TermFoundVar; low_level_trace(enter_pred, RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)), - HR); + HRs); } #endif /* LOW_LEVEL_TRACE */ BEGD(d0); From f4838386102219305bbca05406fbeeda916c9322 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 19 Feb 2019 15:53:36 +0000 Subject: [PATCH 056/101] overflows --- C/atomic.c | 3 +- C/errors.c | 11 +- C/exec.c | 4 + C/globals.c | 8 +- C/qlyr.c | 1 + C/stack.c | 4 + C/terms.c | 380 +++++++++++++++-------------------------- C/text.c | 11 +- H/YapText.h | 2 +- pl/boot2.yap | 1 - pl/directives.yap | 6 +- pl/init.yap | 2 +- pl/messages.yap | 2 +- pl/meta.yap | 15 +- pl/top.yap | 6 +- pl/undefined.yap | 59 ++++--- regression/cyclics.yap | 2 +- 17 files changed, 217 insertions(+), 300 deletions(-) diff --git a/C/atomic.c b/C/atomic.c index 96be7955b..c6e1bae85 100755 --- a/C/atomic.c +++ b/C/atomic.c @@ -950,7 +950,8 @@ restart_aux: ot = ARG1; } else if (g3) { Int len = Yap_AtomToUnicodeLength(t3 PASS_REGS); - if (len <= 0) { + if (len < 0) { + Yap_ThrowError(-len,ARG3,"atom_concat(-X,-Y,+atom:Z"); cut_fail(); } EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); diff --git a/C/errors.c b/C/errors.c index 4e4648f1e..ed1cbd6f2 100755 --- a/C/errors.c +++ b/C/errors.c @@ -296,10 +296,11 @@ void Yap_InitError__(const char *file, const char *function, int lineno, va_list ap; va_start(ap, t); const char *fmt; - char tmpbuf[MAXPATHLEN]; + char *tmpbuf=NULL; fmt = va_arg(ap, char *); if (fmt != NULL) { + tmpbuf = malloc(MAXPATHLEN); #if HAVE_VSNPRINTF vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap); #else @@ -318,7 +319,7 @@ void Yap_InitError__(const char *file, const char *function, int lineno, LOCAL_ActiveError->errorFile = NULL; LOCAL_ActiveError->errorFunction = NULL; LOCAL_ActiveError->errorLine = 0; - if (fmt) { + if (fmt && tmpbuf) { LOCAL_Error_Size = strlen(tmpbuf); LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1); strcpy((char *)LOCAL_ActiveError->errorMsg, tmpbuf); @@ -752,7 +753,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, CACHE_REGS va_list ap; char *fmt; - char s[MAXPATHLEN]; + char *s = NULL; + switch (type) { case SYSTEM_ERROR_INTERNAL: { @@ -828,6 +830,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, va_start(ap, where); fmt = va_arg(ap, char *); if (fmt != NULL) { + s = malloc(MAXPATHLEN); #if HAVE_VSNPRINTF (void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap); #else @@ -1000,7 +1003,7 @@ bool Yap_RaiseException(void) { bool Yap_ResetException(yap_error_descriptor_t *i) { // reset error descriptor if (!i) - return true; + i = LOCAL_ActiveError; yap_error_descriptor_t *bf = i->top_error; memset(i, 0, sizeof(*i)); i->top_error = bf; diff --git a/C/exec.c b/C/exec.c index 687c532b6..89fa21500 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1079,6 +1079,7 @@ static Int _user_expand_goal(USES_REGS1) { Yap_execute_pred(pe, NULL, false PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } + Yap_ResetException(NULL); ARG1 = Yap_GetFromSlot(h1); ARG2 = cmod; ARG3 = Yap_GetFromSlot(h2); @@ -1089,6 +1090,8 @@ static Int _user_expand_goal(USES_REGS1) { Yap_execute_pred(pe, NULL PASS_REGS, false)) { return complete_ge(true, omod, sl, creeping); } + Yap_ResetException(NULL); + mg_args[0] = cmod; mg_args[1] = Yap_GetFromSlot(h1); ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args); @@ -1101,6 +1104,7 @@ static Int _user_expand_goal(USES_REGS1) { Yap_execute_pred(pe, NULL PASS_REGS, false)) { return complete_ge(true, omod, sl, creeping); } + Yap_ResetException(NULL); return complete_ge(false, omod, sl, creeping); } diff --git a/C/globals.c b/C/globals.c index 59be2a42b..0a5031fe2 100644 --- a/C/globals.c +++ b/C/globals.c @@ -354,7 +354,7 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { #define expand_stack(S0,SP,SF,TYPE) \ { size_t sz = SF-S0, used = SP-S0; \ S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ - SP = S0+used; SF = S0+sz; } + SP = S0+used; SF = S0+(1024+sz); } static int copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int copy_att_vars, CELL *ptf, @@ -808,10 +808,8 @@ error_handler: } break; default: /* temporary space overflow */ - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage); - return 0L; - } + return 0; + } } oldH = HR; diff --git a/C/qlyr.c b/C/qlyr.c index c961dc7b9..cd67ce30a 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -663,6 +663,7 @@ static Atom do_header(FILE *stream) { char h1[] = "exec $exec_dir/yap $0 \"$@\"\nsaved "; Atom at; + memset(s,0,2049); if (!maybe_read_bytes( stream, s, 2048) ) return NIL; if (strstr(s, h0)!= s) diff --git a/C/stack.c b/C/stack.c index 95bbac32b..d393cde7e 100644 --- a/C/stack.c +++ b/C/stack.c @@ -72,6 +72,10 @@ static StaticIndex *find_owner_static_index(StaticIndex *, yamop *); #define IN_BLOCK(P, B, SZ) \ ((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ)) + + + + static PredEntry *get_pred(Term t, Term tmod, char *pname) { Term t0 = t; diff --git a/C/terms.c b/C/terms.c index f5dc8a3c0..e6230f90e 100644 --- a/C/terms.c +++ b/C/terms.c @@ -44,33 +44,6 @@ extern int cs[10]; int cs[10]; -static int expand_vts(int args USES_REGS) { - UInt expand = LOCAL_Error_Size; - yap_error_number yap_errno = LOCAL_Error_TYPE; - - LOCAL_Error_Size = 0; - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (yap_errno == RESOURCE_ERROR_TRAIL) { - /* Trail overflow */ - if (!Yap_growtrail(expand, false)) { - return false; - } - } else if (yap_errno == RESOURCE_ERROR_AUXILIARY_STACK) { - /* Aux space overflow */ - if (expand > 4 * 1024 * 1024) - expand = 4 * 1024 * 1024; - if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, true)) { - return false; - } - } else { - if (!Yap_gcl(expand, 3, ENV, gc_P(P, CP))) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_variables"); - return false; - } - } - return true; -} - static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { @@ -112,11 +85,18 @@ typedef struct non_single_struct_t { #define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \ \ -struct non_single_struct_t *to_visit = Malloc( \ - 1024 * sizeof(struct non_single_struct_t)), \ -*to_visit0 = to_visit, \ -*to_visit_max = to_visit + 1024; \ -\ + int lvl = push_text_stack();\ + CELL *pt0, *pt0_end; \ + size_t auxsz = 1024 * sizeof(struct non_single_struct_t);\ + struct non_single_struct_t *to_visit0=NULL, *to_visit,* to_visit_max;\ + CELL *InitialH = HR;\ + tr_fr_ptr TR0 = TR;\ +reset:\ +pt0 = pt0_; pt0_end = pt0_end_; \ + to_visit0 = Realloc(to_visit0,auxsz); \ +to_visit = to_visit0, \ + to_visit_max = to_visit + auxsz/sizeof(struct non_single_struct_t);\ + \ while (to_visit >= to_visit0) { \ CELL d0; \ CELL *ptd0; \ @@ -202,24 +182,31 @@ pop_text_stack(lvl); #define def_aux_overflow() \ aux_overflow : { \ - size_t d1 = to_visit - to_visit0; \ - size_t d2 = to_visit_max - to_visit0; \ - to_visit0 = \ - Realloc(to_visit0, (d2 + 128) * sizeof(struct non_single_struct_t)); \ - to_visit = to_visit0 + d1; \ - to_visit_max = to_visit0 + (d2 + 128); \ - pt0--; \ -} \ -goto restart; + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + clean_tr(TR0 PASS_REGS); \ + auxsz += auxsz;\ + goto reset; } #define def_trail_overflow() \ trail_overflow : { \ - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ - LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + size_t expand = (TR - TR0) * sizeof(tr_fr_ptr *); \ clean_tr(TR0 PASS_REGS); \ HR = InitialH; \ pop_text_stack(lvl); \ - return 0L; \ + /* Trail overflow */ \ + if (!Yap_growtrail(expand, false)) { \ + Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil, expand);\ + } \ +goto reset;\ } #define def_global_overflow() \ @@ -229,12 +216,15 @@ global_overflow : { \ CELL *ptd0 = to_visit->ptd0; \ *ptd0 = to_visit->d0; \ } \ - pop_text_stack(lvl); \ clean_tr(TR0 PASS_REGS); \ HR = InitialH; \ LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ - LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); \ - return false; \ + size_t expand = 0L; \ + if (!Yap_gcl(expand, 3, ENV, gc_P(P, CP))) { \ + Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, sizeof(CELL)*(HR-H0)); \ + return false;\ + }\ + goto reset;\ } #define CYC_LIST \ @@ -260,8 +250,7 @@ if (IS_VISIT_MARKER) { \ /** @brief routine to locate all variables in a term, and its applications */ -static Term cyclic_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { - int lvl = push_text_stack(); +static Term cyclic_complex_term(CELL *pt0_, CELL *pt0_end_ USES_REGS) { WALK_COMPLEX_TERM__(CYC_LIST, CYC_APPL, {}); /* leave an empty slot to fill in later */ END_WALK(); @@ -306,22 +295,28 @@ static Term BREAK_LOOP(CELL d0,struct non_single_struct_t *to_visit ) { /** @brief routine to locate all variables in a term, and its applications */ -static int cycles_in_complex_term(register CELL *pt0, - register CELL *pt0_end USES_REGS) { +static int cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) { + CELL *pt0, *pt0_end; int lvl = push_text_stack(); + size_t auxsz = 1024 * sizeof(struct non_single_struct_t); + struct non_single_struct_t *to_visit0=NULL, *to_visit, *to_visit_max; + CELL *InitialH = HR; + tr_fr_ptr TR0 = TR; + + reset: + pt0 = pt0_, pt0_end = pt0_end_; + to_visit0 = Realloc(to_visit0,auxsz); + to_visit= to_visit0, + to_visit_max = to_visit0 + auxsz/sizeof(struct non_single_struct_t); int rc = 0; CELL *ptf; - struct non_single_struct_t *to_visit = Malloc( - 1024 * sizeof(struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit + 1024; ptf = HR; HR++; while (to_visit >= to_visit0) { CELL d0; CELL *ptd0; - restart: + while (pt0 < pt0_end) { ++pt0; ptd0 = pt0; @@ -414,7 +409,8 @@ pop_text_stack(lvl); return rc; def_aux_overflow(); -return -1; + + } Term Yap_CyclesInTerm(Term t USES_REGS) { @@ -452,10 +448,8 @@ static Int cycles_in_term(USES_REGS1) /* cyclic_term(+T) */ /** @brief routine to locate all variables in a term, and its applications */ -static bool ground_complex_term(register CELL * pt0, - register CELL * pt0_end USES_REGS) { +static bool ground_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { - int lvl = push_text_stack(); WALK_COMPLEX_TERM(); /* leave an empty slot to fill in later */ while (to_visit > to_visit0) { @@ -501,11 +495,10 @@ static Int ground(USES_REGS1) /* ground(+T) */ return Yap_IsGroundTerm(Deref(ARG1)); } -static Int var_in_complex_term(register CELL * pt0, register CELL * pt0_end, +static Int var_in_complex_term(CELL *pt0_, CELL *pt0_end_ , Term v USES_REGS) { - int lvl = push_text_stack(); - WALK_COMPLEX_TERM(); + WALK_COMPLEX_TERM(); if ((CELL)ptd0 == v) { /* we found it */ /* Do we still have compound terms to visit */ @@ -563,16 +556,29 @@ static Int variable_in_term(USES_REGS1) { /** * @brief routine to locate all variables in a term, and its applications. */ -static Term vars_in_complex_term(register CELL * pt0, register CELL * pt0_end, +static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) { - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; + Int count=0; + while (!IsVarTerm(inp) && IsPairTerm(inp)) { + Term t = HeadOfTerm(inp); + if (IsVarTerm(t)) { + CELL *ptr = VarOfTerm(t); + *ptr = TermFoundVar; + TrailTerm(TR++) = t; + count++; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + clean_tr(TR - count PASS_REGS); + if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) { + return false; + } + } + } + inp = TailOfTerm(inp); + } + CELL output = AbsPair(HR); - int lvl = push_text_stack(); - - push_text_stack(); - WALK_COMPLEX_TERM(); + WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ *ptd0 = TermNil; /* leave an empty slot to fill in later */ @@ -593,7 +599,7 @@ static Term vars_in_complex_term(register CELL * pt0, register CELL * pt0_end, END_WALK(); - clean_tr(TR0 PASS_REGS); + clean_tr(TR0-count PASS_REGS); pop_text_stack(lvl); if (HR != InitialH) { @@ -628,37 +634,10 @@ static Int variables_in_term( USES_REGS1) /* variables in term t */ { Term out, inp; - int count; - restart: - count = 0; inp = Deref(ARG2); - while (!IsVarTerm(inp) && IsPairTerm(inp)) { - Term t = HeadOfTerm(inp); - if (IsVarTerm(t)) { - CELL *ptr = VarOfTerm(t); - *ptr = TermFoundVar; - TrailTerm(TR++) = t; - count++; - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - clean_tr(TR - count PASS_REGS); - if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) { - return false; - } - goto restart; - } - } - inp = TailOfTerm(inp); - } - do { Term t = Deref(ARG1); - out = vars_in_complex_term(&(t)-1, &(t), ARG2 PASS_REGS); - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } -} while (out == 0L); -clean_tr(TR - count PASS_REGS); + out = vars_in_complex_term(&(t)-1, &(t), inp PASS_REGS); return Yap_unify(ARG3, out); } @@ -678,7 +657,6 @@ static Int term_variables3( { Term out; cs[0]++; - do { Term t = Deref(ARG1); if (IsVarTerm(t)) { Term out = Yap_MkNewPairTerm(); @@ -689,11 +667,6 @@ static Int term_variables3( } else { out = vars_in_complex_term(&(t)-1, &(t), ARG3 PASS_REGS); } - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); return Yap_unify(ARG2, out); } @@ -710,8 +683,7 @@ Term Yap_TermVariables( { Term out; - do { - t = Deref(t); + t = Deref(t); if (IsVarTerm(t)) { return MkPairTerm(t, TermNil); } else if (IsPrimitiveTerm(t)) { @@ -719,11 +691,6 @@ Term Yap_TermVariables( } else { out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); } - if (out == 0L) { - if (!expand_vts(arity PASS_REGS)) - return false; - } - } while (out == 0L); return out; } @@ -741,22 +708,15 @@ static Int term_variables( USES_REGS1) /* variables in term t */ { Term out; - cs[1]++; if (!Yap_IsListOrPartialListTerm(ARG2)) { - Yap_Error(TYPE_ERROR_LIST, ARG2, "term_variables/2"); + Yap_ThrowError(TYPE_ERROR_LIST, ARG2, "term_variables/2"); return false; } - do { Term t = Deref(ARG1); out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG2, out); + return Yap_unify(ARG2, out); } /** routine to locate attributed variables */ @@ -767,18 +727,13 @@ typedef struct att_rec { } att_rec_t; static Term attvars_in_complex_term( - register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - CELL output = inp; - int lvl = push_text_stack(); - + CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) { + CELL output = inp; WALK_COMPLEX_TERM(); if (IsAttVar(ptd0)) { /* do or pt2 are unbound */ attvar_record *a0 = RepAttVar(ptd0); - if (a0->AttFunc == (Functor)TermNil) - goto restart; + d0 = *ptd0; /* leave an empty slot to fill in later */ if (HR + 1024 > ASP) { goto global_overflow; @@ -788,37 +743,29 @@ static Term attvars_in_complex_term( if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } - ptd0 = (CELL *)a0; - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->d0 = *ptd0; - to_visit->ptd0 = ptd0; - to_visit++; - *ptd0 = TermNil; - pt0_end = &RepAttVar(ptd0)->Atts; + TrailTerm(TR++) = a0->Done; + a0->Done=TermNil; + if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { + + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; + } + pop_text_stack(lvl); + } + + pt0_end = &a0->Atts; pt0 = pt0_end - 1; } - END_WALK(); clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); - if (HR != InitialH) { - /* close the list */ - Term t2 = Deref(inp); - if (IsVarTerm(t2)) { - RESET_VARIABLE(HR - 1); - Yap_unify((CELL)(HR - 1), t2); - } else { - HR[-1] = t2; /* don't need to trail */ - } - - } /*fprintf(stderr,"<%ld at %s\n", d0, __FUNCTION__)*/; - return (output); + return output; def_aux_overflow(); def_global_overflow(); + def_trail_overflow(); } /** @pred term_attvars(+ _Term_,- _AttVars_) @@ -830,46 +777,39 @@ static Term attvars_in_complex_term( */ -static Int p_term_attvars(USES_REGS1) /* variables in term t */ +static Int term_attvars(USES_REGS1) /* variables in term t */ { Term out; - do { Term t = Deref(ARG1); if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); } else { out = attvars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); } - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG2, out); + return Yap_unify(ARG2, out); } /** @brief output the difference between variables in _T_ and variables in * some list. */ static Term new_vars_in_complex_term( - register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - int lvl = push_text_stack(); - HB = ASP; + CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) { + Int n=0; CELL output = TermNil; { + tr_fr_ptr myTR0 = TR; while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { - YapBind(VarOfTerm(t), TermFoundVar); + n++; + TrailTerm(TR++) = t; + *VarOfTerm(t) = TermFoundVar; if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + if (!Yap_growtrail((TR - myTR0) * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; } - pop_text_stack(lvl); } } inp = TailOfTerm(inp); @@ -877,7 +817,8 @@ static Term new_vars_in_complex_term( } WALK_COMPLEX_TERM(); output = MkPairTerm((CELL)ptd0, output); - YapBind(ptd0, TermFoundVar); + TrailTerm(TR++) = *ptd0; + *ptd0 = TermFoundVar; if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; @@ -889,7 +830,7 @@ if (HR + 1024 > ASP) { } END_WALK(); -clean_tr(TR0 PASS_REGS); +clean_tr(TR0-n PASS_REGS); pop_text_stack(lvl); HB = B->cp_h; return output; @@ -917,19 +858,13 @@ static Int p_new_variables_in_term( { Term out; - do { Term t = Deref(ARG2); if (IsPrimitiveTerm(t)) out = TermNil; else { out = new_vars_in_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS); } - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG3, out); + return Yap_unify(ARG3, out); } #define FOUND_VAR() \ @@ -945,21 +880,19 @@ if (d0 == TermFoundVar) { \ } static Term vars_within_complex_term( - register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { - - tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; + CELL *pt0_, CELL *pt0_end_, Term inp USES_REGS) { + Int n=0; CELL output = AbsPair(HR); - int lvl = push_text_stack(); - + while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { CELL *ptr = VarOfTerm(t); *ptr = TermFoundVar; + n++; TrailTerm(TR++) = t; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true); + Yap_growtrail(2*n * sizeof(tr_fr_ptr *), true); } } inp = TailOfTerm(inp); @@ -969,7 +902,7 @@ static Term vars_within_complex_term( goto restart; END_WALK(); - clean_tr(TR0 PASS_REGS); + clean_tr(TR0-n PASS_REGS); pop_text_stack(lvl); if (HR != InitialH) { HR[-1] = TermNil; @@ -997,26 +930,18 @@ static Int p_variables_within_term(USES_REGS1) /* variables within term t */ { Term out; - do { Term t = Deref(ARG2); if (IsPrimitiveTerm(t)) out = TermNil; else { out = vars_within_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS); } - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG3, out); + return Yap_unify(ARG3, out); } -static Term free_vars_in_complex_term(CELL * pt0, CELL * pt0_end, - tr_fr_ptr TR0 USES_REGS) { +static Term free_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ + USES_REGS) { Term o = TermNil; - CELL *InitialH = HR; - int lvl = push_text_stack(); WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ *ptd0 = TermNil; @@ -1050,10 +975,7 @@ static Term free_vars_in_complex_term(CELL * pt0, CELL * pt0_end, def_global_overflow(); } -static Term bind_vars_in_complex_term(CELL * pt0, CELL * pt0_end, - tr_fr_ptr TR0 USES_REGS) { - CELL *InitialH = HR; - int lvl = push_text_stack(); +static Term bind_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ *ptd0 = TermFoundVar; @@ -1081,25 +1003,19 @@ static Term bind_vars_in_complex_term(CELL * pt0, CELL * pt0_end, def_trail_overflow(); } +/* variables within term t */ static Int p_free_variables_in_term( - USES_REGS1) /* variables within term t */ + USES_REGS1) { Term out; Term t, t0; Term found_module = 0L; - do { - tr_fr_ptr TR0 = TR; - - t = t0 = Deref(ARG1); + t = t0 = Deref(ARG1); while (!IsVarTerm(t) && IsApplTerm(t)) { Functor f = FunctorOfTerm(t); if (f == FunctorHat) { - out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1, - TR0 PASS_REGS); - if (out == 0L) { - goto trail_overflow; - } + out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1 PASS_REGS); } else if (f == FunctorModule) { found_module = ArgOfTerm(1, t); } else if (f == FunctorCall) { @@ -1115,14 +1031,9 @@ static Int p_free_variables_in_term( if (IsPrimitiveTerm(t)) out = TermNil; else { - out = free_vars_in_complex_term(&(t)-1, &(t), TR0 PASS_REGS); + out = free_vars_in_complex_term(&(t)-1, &(t) PASS_REGS); } - if (out == 0L) { - trail_overflow: - if (!expand_vts(3 PASS_REGS)) - return false; - } -} while (out == 0L); + if (found_module && t != t0) { Term ts[2]; ts[0] = found_module; @@ -1143,13 +1054,11 @@ if (d0 == TermFoundVar) { \ *pt2 = TermRefoundVar; \ } -static Term non_singletons_in_complex_term(CELL * pt0, - CELL * pt0_end USES_REGS) { - tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; +static Term non_singletons_in_complex_term(CELL * pt0_, + CELL * pt0_end_ USES_REGS) { HB = (CELL *)ASP; CELL output = AbsPair(HR); - int lvl = push_text_stack(); + WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); /* do or pt2 are unbound */ YapBind(ptd0, TermFoundVar); @@ -1177,8 +1086,7 @@ static Int p_non_singletons_in_term( Term t; Term out; - while (true) { - t = Deref(ARG1); + t = Deref(ARG1); if (IsVarTerm(t)) { out = ARG2; } else if (IsPrimitiveTerm(t)) { @@ -1186,11 +1094,8 @@ static Int p_non_singletons_in_term( } else { out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS); } - if (out != 0L) { - return Yap_unify(ARG3, out); - } - } -} + return out; + } static Term numbervar(Int me USES_REGS) { Term ts[1]; @@ -1215,13 +1120,9 @@ if (singles) { \ goto restart; \ } -static Int numbervars_in_complex_term(CELL * pt0, CELL * pt0_end, Int numbv, +static Int numbervars_in_complex_term(CELL * pt0_, CELL * pt0_end_, Int numbv, int singles USES_REGS) { - tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - int lvl = push_text_stack(); - WALK_COMPLEX_TERM__({}, {}, {}); if (IsAttVar(pt0)) @@ -1256,8 +1157,7 @@ Int Yap_NumberVars(Term inp, Int numbv, Int out; Term t; - restart: - t = Deref(inp); + t = Deref(inp); if (IsPrimitiveTerm(t)) { return numbv; } else { @@ -1265,11 +1165,7 @@ Int Yap_NumberVars(Term inp, Int numbv, out = numbervars_in_complex_term(&(t)-1, &(t), numbv, handle_singles PASS_REGS); } - if (out < numbv) { - if (!expand_vts(3 PASS_REGS)) - return false; - goto restart; - } + return out; } @@ -1307,9 +1203,9 @@ if (FunctorOfTerm(d0) == FunctorDollarVar) { \ goto restart; \ } -static int max_numbered_var(CELL * pt0, CELL * pt0_end, +static int max_numbered_var(CELL * pt0_, CELL * pt0_end_, Int * maxp USES_REGS) { - int lvl = push_text_stack(); + WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {}); END_WALK(); /* Do we still have compound terms to visit */ @@ -1541,7 +1437,7 @@ void Yap_InitTermCPreds(void) { Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); - Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); + Yap_InitCPred("term_attvars", 2, term_attvars, 0); CurrentModule = TERMS_MODULE; Yap_InitCPred("variable_in_term", 2, variable_in_term, 0); diff --git a/C/text.c b/C/text.c index e64e41bf3..ddb1ba01d 100644 --- a/C/text.c +++ b/C/text.c @@ -192,7 +192,7 @@ void *MallocAtLevel(size_t sz, int atL USES_REGS) { void *Realloc(void *pt, size_t sz USES_REGS) { struct mblock *old = pt, *o; old--; - sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL); + sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), Yap_Max(CELLSIZE,sizeof(struct mblock))); o = realloc(old, sz); if (o->next) { o->next->prev = o; @@ -447,15 +447,16 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { yap_error_number err0 = LOCAL_Error_TYPE; /* we know what the term is */ if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) { - if (!(inp->type & YAP_STRING_TERM)) { + seq_type_t inpt = inp->type & (YAP_STRING_TERM|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES); + if (!(inpt & YAP_STRING_TERM)) { if (IsVarTerm(inp->val.t)) { LOCAL_Error_TYPE = INSTANTIATION_ERROR; - } else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) { + } else if (!IsAtomTerm(inp->val.t) && inpt == YAP_STRING_ATOM) { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; - } else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) { + } else if (!IsStringTerm(inp->val.t) && inpt == YAP_STRING_STRING) { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && - inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) { + inpt == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) { LOCAL_ActiveError->errorRawTerm = inp->val.t; } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && !IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) { diff --git a/H/YapText.h b/H/YapText.h index 7f76514f3..822bd8bec 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -1447,7 +1447,7 @@ static inline Term Yap_WCharsToString(const wchar_t *s USES_REGS) { static inline Atom Yap_ConcatAtoms(Term t1, Term t2 USES_REGS) { seq_tv_t inpv[2], out; inpv[0].val.t = t1; - inpv[0].type = YAP_STRING_ATOM | YAP_STRING_TERM; + inpv[0].type = YAP_STRING_ATOM ; inpv[1].val.t = t2; inpv[1].type = YAP_STRING_ATOM; out.type = YAP_STRING_ATOM; diff --git a/pl/boot2.yap b/pl/boot2.yap index 7b0bef42f..27ad68501 100644 --- a/pl/boot2.yap +++ b/pl/boot2.yap @@ -41,7 +41,6 @@ :- '$opdec'(1150,fx,(mode),prolog). :- dynamic 'extensions_to_present_answer'/1. - :- ['arrays.yap']. :- multifile user:portray_message/2. diff --git a/pl/directives.yap b/pl/directives.yap index 38540758b..1af3b202d 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -272,12 +272,14 @@ user_defined_directive(Dir,Action) :- '$process_directive'(D, _, M, _VL, _Pos) :- current_prolog_flag(language_mode, iso), !, % ISO Prolog mode, go in and do it, - '$do_error'(context_error((:- M:D),query),directive). + + '$do_error'(context_error((:- M:D),query),directive). % % but YAP and SICStus do. % '$process_directive'(G, _Mode, M, _VL, _Pos) :- - '$execute'(M:G), + '$yap_strip_module'(M:G,M1,G1), + '$execute'(M1:G1), !. '$process_directive'(G, _Mode, M, _VL, _Pos) :- format(user_error,':- ~w:~w failed.~n',[M,G]). diff --git a/pl/init.yap b/pl/init.yap index 8f0e729ae..008b7be68 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -92,7 +92,7 @@ '$init_step'(1) :- '$version'. '$init_step'(2) :- - set_prolog_flag(file_name_variables, _OldF, true), + set_prolog_flag(file_name_variables, true), '$init_consult'. %set_prolog_flag(file_name_variables, OldF), '$init_step'(3) :- diff --git a/pl/messages.yap b/pl/messages.yap index bd0f4f3f4..cc0124eb7 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -261,7 +261,7 @@ compose_message(Throw, _Level) --> location( error(_,Info), Level, _LC ) --> { '$error_descriptor'(Info, Desc) }, { query_exception(prologConsulting, Desc, true) }, - { query_exception(parserReadingCode, Desc, true)}, +% { query_exception(parserReadingCode, Desc, true)}, !, { query_exception(parserFile, Desc, FileName), diff --git a/pl/meta.yap b/pl/meta.yap index 56054217e..93b4a5e12 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -477,10 +477,15 @@ meta_predicate(P) :- expand_goal(Input, Output) :- '$expand_meta_call'(Input, none, Output ). -'$expand_meta_call'(G, HVars, MF:GF ) :- - source_module(SM), - '$yap_strip_module'(SM:G, M, IG), - '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G), - '$yap_strip_module'(M:GF0, MF, GF). +'$expand_meta_call'(G, HVars, MF:GF ) :- + source_module(SM), + '$yap_strip_module'(SM:G, M, IG), + '$is_metapredicate'(IG, M), + '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G), + !, + '$yap_strip_module'(M:GF0, MF, GF). +'$expand_meta_call'(G, _HVars, M:IG ) :- + source_module(SM), + '$yap_strip_module'(SM:G, M, IG). %% @} diff --git a/pl/top.yap b/pl/top.yap index 4c85aa0c0..13197f25c 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -188,9 +188,7 @@ live :- '$expand_term0'(T,_,T). '$expand_term1'(T,O) :- - '$expand_meta_call'(T, [], O), - !. -'$expand_term1'(O,O). + '$expand_meta_call'(T, none, O). '$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- !, @@ -637,7 +635,7 @@ write_query_answer( Bindings ) :- '$do_error'(instantiation_error,call(G0)). '$call'(M:G,CP,G0,_M0) :- !, '$expand_meta_call'(M:G, [], NG), -'$yap_strip_module'(NG,NM,NC), + '$yap_strip_module'(NG,NM,NC), '$call'(NC,CP,G0,NM). '$call'((X,Y),CP,G0,M) :- !, '$call'(X,CP,G0,M), diff --git a/pl/undefined.yap b/pl/undefined.yap index 3852845f8..980259645 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -95,30 +95,13 @@ undefined_query(G0, M0, Cut) :- % undef handler '$undefp'([M0|G0],MG) :- - % make sure we do not loop on undefined predicates - '$undef_setup'(M0:G0, Action,Debug,Current, MGI), - ('$get_undefined_predicates'( MGI, MG ) - -> - true - ; - '$undef_error'(Current, M0:G0, MGI, MG) - ), - '$undef_cleanup'(Action,Debug,Current) - . - -'$undef_error'(_, M0:G0, _, MG) :- - '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), - '$yap_strip_module'(M0:G0, EM0, GM0), - user:unknown_predicate_handler(GM0,EM0,MG), - !. -'$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), - print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))), - fail. -'$undef_error'(fail,_Goal,_Mod) :- - fail. + % 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 )), + '$undef_cleanup'(Action,Debug,Current) + ), + '$undef_error'(Action, M0:G0, MGI, MG). '$undef_setup'(G0,Action,Debug,Current,GI) :- yap_flag( unknown, Action, fail), @@ -136,11 +119,11 @@ undefined_query(G0, M0, Cut) :- !, functor(G, Na, Ar). -'$undef_cleanup'(Action,Debug,_Current) :- +'$undef_cleanup'(Action,Debug, _Current) :- yap_flag( unknown, _, Action), - yap_flag( debug, _, Debug), - '$start_creep'([prolog|true], creep). + yap_flag( debug, _, Debug). +:- abolish(prolog:'$undefp0'/2). :- '$undefp_handler'('$undefp'(_,_), prolog). /** @pred unknown(- _O_,+ _N_) @@ -154,6 +137,28 @@ The unknown predicate, informs about what the user wants to be done */ +'$undef_error'(_, _, _, M:G) :- + nonvar(M), + nonvar(G), + !, + '$start_creep'([prolog|true], creep). +'$undef_error'(_, M0:G0, _, MG) :- + '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), + '$yap_strip_module'(M0:G0, EM0, GM0), + user:unknown_predicate_handler(GM0,EM0,MG), + !, + '$start_creep'([prolog|true], creep). +'$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), + print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))), + '$start_creep'([fail|true], creep), + fail. +'$undef_error'(fail,_Goal,_,_Mod) :- + '$start_creep'([fail|true], creep), + fail. + unknown(P, NP) :- yap_flag( unknown, P, NP ). diff --git a/regression/cyclics.yap b/regression/cyclics.yap index 120568cd4..19c19ef9b 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -13,7 +13,7 @@ main :- test( cyclic_term(X), [X]). test( ground(X), [X]). -test( (variables_in_term(X, O), writeln(X=O) ), [X, [], O]). +test( (term_variables(X, O), writeln(X=O) ), [X, [], O]). test( (new_variables_in_term(L,X, O), writeln(X+L=O) ), [X, L, O]). test( (variables_within_term(L,X, O), writeln(X+L=O) ), [X, L, O]). test( writeln(X), [X]). From cb0f5ec4dbbe98efe442f1ca2e8d54a2dce45948 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 19 Feb 2019 15:56:22 +0000 Subject: [PATCH 057/101] errors --- C/exec.c | 47 ++++++++++++++++++++--------------------------- 1 file changed, 20 insertions(+), 27 deletions(-) diff --git a/C/exec.c b/C/exec.c index 687c532b6..cb35bcb5b 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1065,7 +1065,7 @@ static Int _user_expand_goal(USES_REGS1) { ARG1 = g; if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL, false PASS_REGS)) { + Yap_execute_pred(pe, NULL, true PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } /* system:goal_expansion(A,B) */ @@ -1076,7 +1076,7 @@ static Int _user_expand_goal(USES_REGS1) { if ((pe = RepPredProp( Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL, false PASS_REGS)) { + Yap_execute_pred(pe, NULL, true PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } ARG1 = Yap_GetFromSlot(h1); @@ -1086,7 +1086,7 @@ static Int _user_expand_goal(USES_REGS1) { if ((pe = RepPredProp( Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS, false)) { + Yap_execute_pred(pe, NULL, true PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } mg_args[0] = cmod; @@ -1098,7 +1098,7 @@ static Int _user_expand_goal(USES_REGS1) { (pe = RepPredProp( Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS, false)) { + Yap_execute_pred(pe, NULL, true PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } return complete_ge(false, omod, sl, creeping); @@ -1719,13 +1719,6 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { /* restore the old environment */ /* get to previous environment */ cut_B = (choiceptr)ENV[E_CB]; - { - /* Note that - cut_B == (choiceptr)ENV[E_CB] */ - while (POP_CHOICE_POINT(ENV[E_CB])) { - POP_EXECUTE(); - } - } #ifdef YAPOR CUT_prune_to(cut_B); #endif /* YAPOR */ @@ -1750,21 +1743,20 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { /* we have failed, and usually we would backtrack to this B, trouble is, we may also have a delayed cut to do */ if (B != NULL) - HB = B->cp_h; YENV = ENV; // should we catch the exception or pass it through? - // We'll pass it through - if (pass_ex && Yap_HasException()) { - if ((LOCAL_PrologMode & BootMode) || !CurrentModule ) { - Yap_ResetException(LOCAL_ActiveError); + // We'll pass it through + if ( Yap_HasException()) { + if (pass_ex && + ((LOCAL_PrologMode & BootMode) || !CurrentModule )) { + Yap_ResetException(LOCAL_ActiveError); + } else { + Yap_RaiseException(); + } return false; } - - Yap_RaiseException(); - return false; - } - return true; + return true; } else if (out == 0) { P = saved_p; CP = saved_cp; @@ -1782,12 +1774,13 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { HB = PROTECT_FROZEN_H(B); // should we catch the exception or pass it through? // We'll pass it through - if (pass_ex) { - if ((LOCAL_PrologMode & BootMode) || !CurrentModule ) { - Yap_ResetException(LOCAL_ActiveError); - return false; - } - Yap_RaiseException(); + if ( Yap_HasException()) { + if (pass_ex && + ((LOCAL_PrologMode & BootMode) || !CurrentModule )) { + Yap_ResetException(LOCAL_ActiveError); + } else { + Yap_RaiseException(); + } } return false; } else { From 84721e1005caa38a727a86c27b0581456b869500 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 20 Feb 2019 10:45:21 +0000 Subject: [PATCH 058/101] copy --- C/terms.c | 43 +++++++++++------------- C/utilpreds.c | 8 ++--- pl/debug.yap | 90 +++++++++++++++++++++++++++++---------------------- pl/top.yap | 2 +- 4 files changed, 74 insertions(+), 69 deletions(-) diff --git a/C/terms.c b/C/terms.c index e6230f90e..3e325f01e 100644 --- a/C/terms.c +++ b/C/terms.c @@ -981,16 +981,8 @@ static Term bind_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { *ptd0 = TermFoundVar; /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - while (to_visit > to_visit0) { - to_visit--; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } goto trail_overflow; } - } TrailTerm(TR++) = (CELL)ptd0; END_WALK(); @@ -1043,41 +1035,42 @@ if (found_module && t != t0) { return Yap_unify(ARG2, t) && Yap_unify(ARG3, out); } -#define FOUND_VAR_AGAIN() \ -if (d0 == TermFoundVar) { \ - CELL *pt2 = pt0; \ - while (IsVarTerm(*pt2)) \ - pt2 = (CELL *)(*pt2); \ - HR[1] = AbsPair(HR + 2); \ - HR[0] = (CELL)pt2; \ - HR += 2; \ - *pt2 = TermRefoundVar; \ -} +#define FOUND_VAR_AGAIN() \ + if (d0 == TermFoundVar) \ + { \ + HR[0] = (CELL)ptd0; \ + HR[1] = AbsPair(HR + 2); \ + HR += 2; \ + *ptd0 = TermRefoundVar; \ + } static Term non_singletons_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { - HB = (CELL *)ASP; - CELL output = AbsPair(HR); WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); /* do or pt2 are unbound */ - YapBind(ptd0, TermFoundVar); - goto restart; + *ptd0 = TermFoundVar; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) + { + goto trail_overflow; + } + TrailTerm(TR++) = (CELL)ptd0; END_WALK(); clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); - HB = (CELL *)B->cp_b; if (HR != InitialH) { /* close the list */ HR[-1] = Deref(ARG2); - return output; + return AbsPair(InitialH); } else { return ARG2; } def_aux_overflow(); + def_trail_overflow(); } static Int p_non_singletons_in_term( @@ -1094,7 +1087,7 @@ static Int p_non_singletons_in_term( } else { out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS); } - return out; + return Yap_unify(ARG3,out); } static Term numbervar(Int me USES_REGS) { diff --git a/C/utilpreds.c b/C/utilpreds.c index 092ea2ced..89d18adff 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -395,9 +395,9 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, RESET_VARIABLE(ptf); *ptd0 = (CELL)ptf; ptf++; - if ((ADDR)TR > LOCAL_TrailTop - 16) + TrailTerm(TR++) = (CELL)ptd0; + if ((ADDR)TR > LOCAL_TrailTop - 16) goto trail_overflow; - } } @@ -521,7 +521,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { Term Yap_CopyTerm(Term inp) { CACHE_REGS - return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); + return CopyTerm(inp, 0, false, TRUE PASS_REGS); } Term @@ -533,7 +533,7 @@ Yap_CopyTermNoShare(Term inp) { static Int p_copy_term( USES_REGS1 ) /* copy term t to a new instance */ { - Term t = CopyTerm(ARG1, 2, TRUE, TRUE PASS_REGS); + Term t = CopyTerm(ARG1, 2, false, TRUE PASS_REGS); if (t == 0L) return FALSE; /* be careful, there may be a stack shift here */ diff --git a/pl/debug.yap b/pl/debug.yap index ca648226f..cc6abede9 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -16,7 +16,7 @@ *************************************************************************/ -:- system_module( '$_debug', [], ['$trace_query'/4, +:- system_module( '$_debug', [], ['$trace_plan'/4, '$init_debugger'/0, '$skipeol'/1]). @@ -254,7 +254,7 @@ be lost. * * The debugger is an interpreter. with main predicates: * - $trace: this is the API - * - $trace_query: reduce a query to a goal + * - $trace_plan: reduce a query to a goal * - $trace_goal: execute: * + using the source, Luke * + hooking into the WAM procedure call mechanism @@ -308,7 +308,7 @@ be lost. '$execute_nonstop'(G,Mod). '$trace'(Mod:G) :- '$$save_by'(CP), - '$trace_query'(G, Mod, CP, G, EG), + '$trace_plan'(G, Mod, CP, G, EG), gated_call( '$debugger_io', EG, @@ -415,42 +415,54 @@ be lost. '$trace_meta_call'( G, M, CP ) :- - '$trace_query'(G, M, CP, G, EG ), + '$trace_plan'(G, M, CP, G, EG ), call(EG). -%% @pred '$trace_query'( +G, +M, +CP, +Expanded) +%% @pred '$trace_plan'( +G, +M, +CP, +Expanded) % % debug a complex query % -'$trace_query'(V, M, _CP, _, call(M:V)) :- +'$trace_plan'(V, M, _CP, _, call(M:V)) :- var(V), !. -'$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :- +'$trace_plan'(!, _, CP, _, '$$cut_by'(CP)) :- !. -'$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- +'$trace_plan'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- !. -'$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- +'$trace_plan'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- !. -'$trace_query'(true, _, _, _, true) :- !. -'$trace_query'(fail, _, _, _, '$trace'(fail)) :- !. -'$trace_query'(M:G, _, CP,S, Expanded) :- - !, - '$yap_strip_module'(M:G, M0, G0), - '$trace_query'(G0, M0, CP,S, Expanded ). -'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A|B), M, CP, S, (EA|EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((\+ A), M, CP, S, (\+ EA)) :- !, - '$trace_query'(A, M, CP, S, EA). -'$trace_query'(G, M, _CP, _, ( +'$trace_plan'(true, _, _, _, true) :- !. +'$trace_plan'(fail, _, _, _, '$trace'(fail)) :- !. +'$trace_plan'((A,B), M, CP, S, (EA,EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A->B), M, CP, S, (EA->EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A;B), M, CP, S, (EA;EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A|B), M, CP, S, (EA|EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). + '$trace_plan'(C, M, CP, S, EC), +'$trace_plan'((A->*B), M, CP, S, (EA->EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A->*B;C), M, CP, S, (EA->EB;EC)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB), + '$trace_plan'(C, M, CP, S, EC). +'$trace_plan'(if(A,B,C), M, CP, S, (EA->EB;EC)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB), + '$trace_plan'(C, M, CP, S, EC). +'$trace_plan'((\+ A), M, CP, S, ( EA -> fail ; true)) :- !, + '$trace_plan'(A, M, CP, S, EA). +'$trace_plan'(once(A), M, CP, S, ( EA -> true)) :- !, + '$trace_plan'(A, M, CP, S, EA). +'$trace_plan'(ignore(A), M, CP, S, ( EA -> true; true)) :- !, + '$trace_plan'(A, M, CP, S, EA). +'$trace_plan'(G, M, _CP, _, ( % spy a literal '$id_goal'(L), catch( @@ -487,9 +499,9 @@ be lost. ). % meta system '$trace_goal'(G, M, GoalNumber, H) :- - '$is_metapredicate'(G, prolog), - !, - '$debugger_expand_meta_call'(M:G, [], G1), + '$is_metapredicate'(G, prolog), + !, + '$debugger_expand_meta_call'(M:G, [], G1), strip_module(G1, MF, NG), gated_call( '$enter_trace'(GoalNumber, G, M, H), @@ -604,7 +616,7 @@ be lost. '$$save_by'(CP), clause(M:G, Cl, _), '$retry_clause'(GoalNumber, G, M, Info, X), - '$trace_query'(Cl, M, CP, Cl, ECl), + '$trace_plan'(Cl, M, CP, Cl, ECl), '$execute0'(ECl,M). '$creep_step'(GoalNumber, G, M, Info) :- @@ -654,7 +666,7 @@ be lost. %%% - abort: forward throw while the call is newer than goal -%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID ) +%% @pred '$re_trace_plan'( Exception, +Goal, +Mod, +GoalID ) % % debugger code for exceptions. Recognised cases are: % - abort always forwarded @@ -1046,10 +1058,10 @@ be lost. '$cps'([]). -'$debugger_skip_trace_query'([CP|CPs],CPs1) :- - yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_), !, - '$debugger_skip_trace_query'(CPs,CPs1). -'$debugger_skip_trace_query'(CPs,CPs). +'$debugger_skip_trace_plan'([CP|CPs],CPs1) :- + yap_hacks:choicepoint(CP,_,prolog,'$trace_plan',4,(_;_),_), !, + '$debugger_skip_trace_plan'(CPs,CPs1). +'$debugger_skip_trace_plan'(CPs,CPs). '$debugger_skip_traces'([CP|CPs],CPs1) :- yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_), !, diff --git a/pl/top.yap b/pl/top.yap index 13197f25c..3f84a9c56 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -295,7 +295,7 @@ live :- '$write_answer'(Vs, LGs, Written), '$write_query_answer_true'(Written), ( - '$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0 + yap_flag(prompt_alternatives_on,determinism), CP == NCP, DCP = 0 -> format(user_error, '.~n', []), ! From 7dca1f13900a98bb6d85faa1f6f88815ce7c8eb0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 21 Feb 2019 20:19:31 +0000 Subject: [PATCH 059/101] fixes --- C/terms.c | 129 +++++++++++++++++---------------------------------- pl/setof.yap | 1 + 2 files changed, 44 insertions(+), 86 deletions(-) diff --git a/C/terms.c b/C/terms.c index 3e325f01e..1a8ea4118 100644 --- a/C/terms.c +++ b/C/terms.c @@ -580,8 +580,7 @@ static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ , CELL output = AbsPair(HR); WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { goto global_overflow; } @@ -591,12 +590,10 @@ static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ , /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; - } } TrailTerm(TR++) = (CELL)ptd0; - + *ptd0 = TermFoundVar; END_WALK(); clean_tr(TR0-count PASS_REGS); @@ -607,7 +604,7 @@ static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ , Term t2 = Deref(inp); if (IsVarTerm(t2)) { RESET_VARIABLE(HR - 1); - Yap_unify((CELL)(HR - 1), inp); + Yap_unify((CELL)(HR - 1), t2); } else { HR[-1] = t2; /* don't need to trail */ } @@ -694,6 +691,22 @@ Term Yap_TermVariables( return out; } +static Term Yap_TermAddVariables( + Term t, Term vs USES_REGS) /* variables in term t */ +{ + Term out; + + t = Deref(t); + if (IsVarTerm(t)) { + return MkPairTerm(t, TermNil); + } else if (IsPrimitiveTerm(t)) { + return TermNil; + } else { + out = vars_in_complex_term(&(t)-1, &(t), vs PASS_REGS); + } + return out; +} + /** @pred term_variables(? _Term_, - _Variables_) is iso @@ -798,7 +811,6 @@ static Term new_vars_in_complex_term( Int n=0; CELL output = TermNil; { - tr_fr_ptr myTR0 = TR; while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { @@ -807,7 +819,7 @@ static Term new_vars_in_complex_term( *VarOfTerm(t) = TermFoundVar; if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { - if (!Yap_growtrail((TR - myTR0) * sizeof(tr_fr_ptr *), true)) { + if (!Yap_growtrail(n * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; } } @@ -820,9 +832,7 @@ static Term new_vars_in_complex_term( TrailTerm(TR++) = *ptd0; *ptd0 = TermFoundVar; if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; - } } /* leave an empty slot to fill in later */ if (HR + 1024 > ASP) { @@ -832,7 +842,7 @@ END_WALK(); clean_tr(TR0-n PASS_REGS); pop_text_stack(lvl); -HB = B->cp_h; + return output; def_aux_overflow(); @@ -939,91 +949,37 @@ static Int p_variables_within_term(USES_REGS1) /* variables within term t */ return Yap_unify(ARG3, out); } -static Term free_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ - USES_REGS) { - Term o = TermNil; - WALK_COMPLEX_TERM(); - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ - if (HR + 1024 > ASP) { - o = TermNil; - goto global_overflow; - } - HR[0] = (CELL)ptd0; - HR[1] = o; - o = AbsPair(HR); - HR += 2; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; - END_WALK(); - - clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); - return o; - - def_aux_overflow(); - - def_trail_overflow(); - - def_global_overflow(); -} - -static Term bind_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { - WALK_COMPLEX_TERM(); - /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - goto trail_overflow; - } - TrailTerm(TR++) = (CELL)ptd0; - - END_WALK(); - - pop_text_stack(lvl); - return TermNil; - - def_aux_overflow(); - - def_trail_overflow(); -} - /* variables within term t */ -static Int p_free_variables_in_term( +static Int free_variables_in_term( USES_REGS1) { Term out; Term t, t0; Term found_module = 0L; + Term vlist = TermNil; - t = t0 = Deref(ARG1); - while (!IsVarTerm(t) && IsApplTerm(t)) { - Functor f = FunctorOfTerm(t); - if (f == FunctorHat) { - out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1 PASS_REGS); - } else if (f == FunctorModule) { - found_module = ArgOfTerm(1, t); - } else if (f == FunctorCall) { - t = ArgOfTerm(1, t); - } else if (f == FunctorExecuteInMod) { - found_module = ArgOfTerm(2, t); - t = ArgOfTerm(1, t); - } else { - break; - } - t = ArgOfTerm(2, t); + t = t0 = Deref(ARG1); + Int delta = 0; + while (!IsVarTerm(t) && IsApplTerm(t)) { + Functor f = FunctorOfTerm(t); + if (f == FunctorHat) { + vlist = Yap_TermAddVariables(ArgOfTerm(1,t), vlist PASS_REGS); + } else if (f == FunctorModule) { + found_module = ArgOfTerm(1, t); + } else if (f == FunctorCall) { + t = ArgOfTerm(1, t); + } else if (f == FunctorExecuteInMod) { + found_module = ArgOfTerm(2, t); + t = ArgOfTerm(1, t); + } else { + break; + } + t = ArgOfTerm(2, t); } if (IsPrimitiveTerm(t)) out = TermNil; else { - out = free_vars_in_complex_term(&(t)-1, &(t) PASS_REGS); + out = new_vars_in_complex_term(&(t)-1, &(t), vlist PASS_REGS); } if (found_module && t != t0) { @@ -1428,7 +1384,8 @@ void Yap_InitTermCPreds(void) { Yap_InitCPred("term_variables", 3, term_variables3, 0); Yap_InitCPred("$variables_in_term", 3, variables_in_term, 0); - Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); + Yap_InitCPred("$free_variables_in_term", 3, free_variables_in_term, 0); + Yap_InitCPred("free_variables_in_term", 3, free_variables_in_term, 0); Yap_InitCPred("term_attvars", 2, term_attvars, 0); diff --git a/pl/setof.yap b/pl/setof.yap index 5ad05131c..118c65a2e 100644 --- a/pl/setof.yap +++ b/pl/setof.yap @@ -230,6 +230,7 @@ bagof(Template, Generator, Bag) :- '$bagof'(Template, Generator, Bag) :- '$free_variables_in_term'(Template^Generator, StrippedGenerator, Key), %format('TemplateV=~w v=~w ~w~n',[TemplateV,Key, StrippedGenerator]), + ( Key \== '$' -> '$findall_with_common_vars'(Key-Template, StrippedGenerator, Bags0), '$keysort'(Bags0, Bags), From ccfbe3f80916781b21d19b72c4b1964a03948360 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 21 Feb 2019 21:03:44 +0000 Subject: [PATCH 060/101] various fixes --- C/atomic.c | 3 +- C/errors.c | 11 +- C/exec.c | 4 + C/qlyr.c | 1 + C/stack.c | 4 + C/terms.c | 305 ++++++++++++++++------------------------------ C/text.c | 11 +- C/utilpreds.c | 2 +- H/YapText.h | 2 +- pl/boot2.yap | 1 - pl/directives.yap | 6 +- pl/init.yap | 2 +- pl/messages.yap | 2 +- pl/meta.yap | 15 ++- pl/top.yap | 6 +- pl/undefined.yap | 59 +++++---- 16 files changed, 183 insertions(+), 251 deletions(-) diff --git a/C/atomic.c b/C/atomic.c index 96be7955b..c6e1bae85 100755 --- a/C/atomic.c +++ b/C/atomic.c @@ -950,7 +950,8 @@ restart_aux: ot = ARG1; } else if (g3) { Int len = Yap_AtomToUnicodeLength(t3 PASS_REGS); - if (len <= 0) { + if (len < 0) { + Yap_ThrowError(-len,ARG3,"atom_concat(-X,-Y,+atom:Z"); cut_fail(); } EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); diff --git a/C/errors.c b/C/errors.c index 4e4648f1e..ed1cbd6f2 100755 --- a/C/errors.c +++ b/C/errors.c @@ -296,10 +296,11 @@ void Yap_InitError__(const char *file, const char *function, int lineno, va_list ap; va_start(ap, t); const char *fmt; - char tmpbuf[MAXPATHLEN]; + char *tmpbuf=NULL; fmt = va_arg(ap, char *); if (fmt != NULL) { + tmpbuf = malloc(MAXPATHLEN); #if HAVE_VSNPRINTF vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap); #else @@ -318,7 +319,7 @@ void Yap_InitError__(const char *file, const char *function, int lineno, LOCAL_ActiveError->errorFile = NULL; LOCAL_ActiveError->errorFunction = NULL; LOCAL_ActiveError->errorLine = 0; - if (fmt) { + if (fmt && tmpbuf) { LOCAL_Error_Size = strlen(tmpbuf); LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1); strcpy((char *)LOCAL_ActiveError->errorMsg, tmpbuf); @@ -752,7 +753,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, CACHE_REGS va_list ap; char *fmt; - char s[MAXPATHLEN]; + char *s = NULL; + switch (type) { case SYSTEM_ERROR_INTERNAL: { @@ -828,6 +830,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, va_start(ap, where); fmt = va_arg(ap, char *); if (fmt != NULL) { + s = malloc(MAXPATHLEN); #if HAVE_VSNPRINTF (void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap); #else @@ -1000,7 +1003,7 @@ bool Yap_RaiseException(void) { bool Yap_ResetException(yap_error_descriptor_t *i) { // reset error descriptor if (!i) - return true; + i = LOCAL_ActiveError; yap_error_descriptor_t *bf = i->top_error; memset(i, 0, sizeof(*i)); i->top_error = bf; diff --git a/C/exec.c b/C/exec.c index 687c532b6..89fa21500 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1079,6 +1079,7 @@ static Int _user_expand_goal(USES_REGS1) { Yap_execute_pred(pe, NULL, false PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } + Yap_ResetException(NULL); ARG1 = Yap_GetFromSlot(h1); ARG2 = cmod; ARG3 = Yap_GetFromSlot(h2); @@ -1089,6 +1090,8 @@ static Int _user_expand_goal(USES_REGS1) { Yap_execute_pred(pe, NULL PASS_REGS, false)) { return complete_ge(true, omod, sl, creeping); } + Yap_ResetException(NULL); + mg_args[0] = cmod; mg_args[1] = Yap_GetFromSlot(h1); ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args); @@ -1101,6 +1104,7 @@ static Int _user_expand_goal(USES_REGS1) { Yap_execute_pred(pe, NULL PASS_REGS, false)) { return complete_ge(true, omod, sl, creeping); } + Yap_ResetException(NULL); return complete_ge(false, omod, sl, creeping); } diff --git a/C/qlyr.c b/C/qlyr.c index c961dc7b9..cd67ce30a 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -663,6 +663,7 @@ static Atom do_header(FILE *stream) { char h1[] = "exec $exec_dir/yap $0 \"$@\"\nsaved "; Atom at; + memset(s,0,2049); if (!maybe_read_bytes( stream, s, 2048) ) return NIL; if (strstr(s, h0)!= s) diff --git a/C/stack.c b/C/stack.c index 95bbac32b..d393cde7e 100644 --- a/C/stack.c +++ b/C/stack.c @@ -72,6 +72,10 @@ static StaticIndex *find_owner_static_index(StaticIndex *, yamop *); #define IN_BLOCK(P, B, SZ) \ ((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ)) + + + + static PredEntry *get_pred(Term t, Term tmod, char *pname) { Term t0 = t; diff --git a/C/terms.c b/C/terms.c index f5dc8a3c0..1229aad3f 100644 --- a/C/terms.c +++ b/C/terms.c @@ -44,33 +44,6 @@ extern int cs[10]; int cs[10]; -static int expand_vts(int args USES_REGS) { - UInt expand = LOCAL_Error_Size; - yap_error_number yap_errno = LOCAL_Error_TYPE; - - LOCAL_Error_Size = 0; - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (yap_errno == RESOURCE_ERROR_TRAIL) { - /* Trail overflow */ - if (!Yap_growtrail(expand, false)) { - return false; - } - } else if (yap_errno == RESOURCE_ERROR_AUXILIARY_STACK) { - /* Aux space overflow */ - if (expand > 4 * 1024 * 1024) - expand = 4 * 1024 * 1024; - if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, true)) { - return false; - } - } else { - if (!Yap_gcl(expand, 3, ENV, gc_P(P, CP))) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_variables"); - return false; - } - } - return true; -} - static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { @@ -112,11 +85,18 @@ typedef struct non_single_struct_t { #define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \ \ -struct non_single_struct_t *to_visit = Malloc( \ - 1024 * sizeof(struct non_single_struct_t)), \ -*to_visit0 = to_visit, \ -*to_visit_max = to_visit + 1024; \ -\ + int lvl = push_text_stack();\ + CELL *pt0, *pt0_end; \ + size_t auxsz = 1024 * sizeof(struct non_single_struct_t);\ + struct non_single_struct_t *to_visit0=NULL, *to_visit,* to_visit_max;\ + to_visit0 = Realloc(to_visit0,auxsz); \ + CELL *InitialH = HR;\ + tr_fr_ptr TR0 = TR;\ +reset:\ +pt0 = pt0_; pt0_end = pt0_end_; \ +to_visit = to_visit0, \ + to_visit_max = to_visit + auxsz/sizeof(struct non_single_struct_t);\ + \ while (to_visit >= to_visit0) { \ CELL d0; \ CELL *ptd0; \ @@ -202,24 +182,36 @@ pop_text_stack(lvl); #define def_aux_overflow() \ aux_overflow : { \ - size_t d1 = to_visit - to_visit0; \ - size_t d2 = to_visit_max - to_visit0; \ - to_visit0 = \ - Realloc(to_visit0, (d2 + 128) * sizeof(struct non_single_struct_t)); \ - to_visit = to_visit0 + d1; \ - to_visit_max = to_visit0 + (d2 + 128); \ - pt0--; \ -} \ -goto restart; - -#define def_trail_overflow() \ -trail_overflow : { \ - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \ LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ clean_tr(TR0 PASS_REGS); \ HR = InitialH; \ pop_text_stack(lvl); \ return 0L; \ +} \ +goto reset; + +#define def_trail_overflow() \ +trail_overflow : { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + size_t expand = (TR - TR0) * sizeof(tr_fr_ptr *); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + pop_text_stack(lvl); \ + /* Trail overflow */ \ + if (!Yap_growtrail(expand, false)) { \ + Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil, expand);\ + } \ +goto reset;\ } #define def_global_overflow() \ @@ -229,12 +221,15 @@ global_overflow : { \ CELL *ptd0 = to_visit->ptd0; \ *ptd0 = to_visit->d0; \ } \ - pop_text_stack(lvl); \ clean_tr(TR0 PASS_REGS); \ HR = InitialH; \ LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ - LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); \ - return false; \ + size_t expand = 0L; \ + if (!Yap_gcl(expand, 3, ENV, gc_P(P, CP))) { \ + Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, sizeof(CELL)*(HR-H0)); \ + return false;\ + }\ + goto reset;\ } #define CYC_LIST \ @@ -260,8 +255,7 @@ if (IS_VISIT_MARKER) { \ /** @brief routine to locate all variables in a term, and its applications */ -static Term cyclic_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { - int lvl = push_text_stack(); +static Term cyclic_complex_term(CELL *pt0_, CELL *pt0_end_ USES_REGS) { WALK_COMPLEX_TERM__(CYC_LIST, CYC_APPL, {}); /* leave an empty slot to fill in later */ END_WALK(); @@ -306,22 +300,28 @@ static Term BREAK_LOOP(CELL d0,struct non_single_struct_t *to_visit ) { /** @brief routine to locate all variables in a term, and its applications */ -static int cycles_in_complex_term(register CELL *pt0, - register CELL *pt0_end USES_REGS) { +static int cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) { + CELL *pt0, *pt0_end; int lvl = push_text_stack(); + size_t auxsz = 1024 * sizeof(struct non_single_struct_t);\ + struct non_single_struct_t *to_visit0=NULL, *to_visit, *to_visit_max;\ + to_visit0 = Malloc(auxsz); + CELL *InitialH = HR; + tr_fr_ptr TR0 = TR; + + reset: + pt0 = pt0_, pt0_end = pt0_end_; + to_visit= to_visit0, + to_visit_max = to_visit0 + auxsz/sizeof(struct non_single_struct_t); int rc = 0; CELL *ptf; - struct non_single_struct_t *to_visit = Malloc( - 1024 * sizeof(struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit + 1024; ptf = HR; HR++; while (to_visit >= to_visit0) { CELL d0; CELL *ptd0; - restart: + while (pt0 < pt0_end) { ++pt0; ptd0 = pt0; @@ -414,7 +414,8 @@ pop_text_stack(lvl); return rc; def_aux_overflow(); -return -1; + + } Term Yap_CyclesInTerm(Term t USES_REGS) { @@ -452,10 +453,8 @@ static Int cycles_in_term(USES_REGS1) /* cyclic_term(+T) */ /** @brief routine to locate all variables in a term, and its applications */ -static bool ground_complex_term(register CELL * pt0, - register CELL * pt0_end USES_REGS) { +static bool ground_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { - int lvl = push_text_stack(); WALK_COMPLEX_TERM(); /* leave an empty slot to fill in later */ while (to_visit > to_visit0) { @@ -501,11 +500,10 @@ static Int ground(USES_REGS1) /* ground(+T) */ return Yap_IsGroundTerm(Deref(ARG1)); } -static Int var_in_complex_term(register CELL * pt0, register CELL * pt0_end, +static Int var_in_complex_term(CELL *pt0_, CELL *pt0_end_ , Term v USES_REGS) { - int lvl = push_text_stack(); - WALK_COMPLEX_TERM(); + WALK_COMPLEX_TERM(); if ((CELL)ptd0 == v) { /* we found it */ /* Do we still have compound terms to visit */ @@ -563,16 +561,11 @@ static Int variable_in_term(USES_REGS1) { /** * @brief routine to locate all variables in a term, and its applications. */ -static Term vars_in_complex_term(register CELL * pt0, register CELL * pt0_end, +static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) { - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - CELL output = AbsPair(HR); - int lvl = push_text_stack(); - - push_text_stack(); - WALK_COMPLEX_TERM(); + CELL output = AbsPair(HR); + WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ *ptd0 = TermNil; /* leave an empty slot to fill in later */ @@ -650,15 +643,8 @@ static Int variables_in_term( } inp = TailOfTerm(inp); } - do { Term t = Deref(ARG1); out = vars_in_complex_term(&(t)-1, &(t), ARG2 PASS_REGS); - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } -} while (out == 0L); -clean_tr(TR - count PASS_REGS); return Yap_unify(ARG3, out); } @@ -678,7 +664,6 @@ static Int term_variables3( { Term out; cs[0]++; - do { Term t = Deref(ARG1); if (IsVarTerm(t)) { Term out = Yap_MkNewPairTerm(); @@ -689,11 +674,6 @@ static Int term_variables3( } else { out = vars_in_complex_term(&(t)-1, &(t), ARG3 PASS_REGS); } - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); return Yap_unify(ARG2, out); } @@ -710,8 +690,7 @@ Term Yap_TermVariables( { Term out; - do { - t = Deref(t); + t = Deref(t); if (IsVarTerm(t)) { return MkPairTerm(t, TermNil); } else if (IsPrimitiveTerm(t)) { @@ -719,11 +698,6 @@ Term Yap_TermVariables( } else { out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); } - if (out == 0L) { - if (!expand_vts(arity PASS_REGS)) - return false; - } - } while (out == 0L); return out; } @@ -743,20 +717,14 @@ static Int term_variables( Term out; cs[1]++; if (!Yap_IsListOrPartialListTerm(ARG2)) { - Yap_Error(TYPE_ERROR_LIST, ARG2, "term_variables/2"); + Yap_ThrowError(TYPE_ERROR_LIST, ARG2, "term_variables/2"); return false; } - do { Term t = Deref(ARG1); out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG2, out); + return Yap_unify(ARG2, out); } /** routine to locate attributed variables */ @@ -767,18 +735,13 @@ typedef struct att_rec { } att_rec_t; static Term attvars_in_complex_term( - register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - CELL output = inp; - int lvl = push_text_stack(); - + CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) { + CELL output = inp; WALK_COMPLEX_TERM(); if (IsAttVar(ptd0)) { /* do or pt2 are unbound */ attvar_record *a0 = RepAttVar(ptd0); - if (a0->AttFunc == (Functor)TermNil) - goto restart; + d0 = *ptd0; /* leave an empty slot to fill in later */ if (HR + 1024 > ASP) { goto global_overflow; @@ -788,37 +751,29 @@ static Term attvars_in_complex_term( if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } - ptd0 = (CELL *)a0; - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->d0 = *ptd0; - to_visit->ptd0 = ptd0; - to_visit++; - *ptd0 = TermNil; - pt0_end = &RepAttVar(ptd0)->Atts; + TrailTerm(TR++) = a0->Done; + a0->Done=TermNil; + if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { + + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; + } + pop_text_stack(lvl); + } + + pt0_end = &a0->Atts; pt0 = pt0_end - 1; } - END_WALK(); clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); - if (HR != InitialH) { - /* close the list */ - Term t2 = Deref(inp); - if (IsVarTerm(t2)) { - RESET_VARIABLE(HR - 1); - Yap_unify((CELL)(HR - 1), t2); - } else { - HR[-1] = t2; /* don't need to trail */ - } - - } /*fprintf(stderr,"<%ld at %s\n", d0, __FUNCTION__)*/; - return (output); + return output; def_aux_overflow(); def_global_overflow(); + def_trail_overflow(); } /** @pred term_attvars(+ _Term_,- _AttVars_) @@ -830,43 +785,36 @@ static Term attvars_in_complex_term( */ -static Int p_term_attvars(USES_REGS1) /* variables in term t */ +static Int term_attvars(USES_REGS1) /* variables in term t */ { Term out; - do { Term t = Deref(ARG1); if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); } else { out = attvars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); } - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG2, out); + return Yap_unify(ARG2, out); } /** @brief output the difference between variables in _T_ and variables in * some list. */ static Term new_vars_in_complex_term( - register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { - register tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - int lvl = push_text_stack(); + CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) { HB = ASP; CELL output = TermNil; { + tr_fr_ptr myTR0 = TR; while (!IsVarTerm(inp) && IsPairTerm(inp)) { + int lvl = push_text_stack(); Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { YapBind(VarOfTerm(t), TermFoundVar); if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + if (!Yap_growtrail((TR - myTR0) * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; } pop_text_stack(lvl); @@ -917,19 +865,13 @@ static Int p_new_variables_in_term( { Term out; - do { Term t = Deref(ARG2); if (IsPrimitiveTerm(t)) out = TermNil; else { out = new_vars_in_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS); } - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG3, out); + return Yap_unify(ARG3, out); } #define FOUND_VAR() \ @@ -945,21 +887,19 @@ if (d0 == TermFoundVar) { \ } static Term vars_within_complex_term( - register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) { + CELL *pt0_, CELL *pt0_end_, Term inp USES_REGS) { - tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; CELL output = AbsPair(HR); - int lvl = push_text_stack(); - + while (!IsVarTerm(inp) && IsPairTerm(inp)) { + tr_fr_ptr myTR0; Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { CELL *ptr = VarOfTerm(t); *ptr = TermFoundVar; TrailTerm(TR++) = t; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true); + Yap_growtrail((TR - myTR0) * sizeof(tr_fr_ptr *), true); } } inp = TailOfTerm(inp); @@ -997,26 +937,18 @@ static Int p_variables_within_term(USES_REGS1) /* variables within term t */ { Term out; - do { Term t = Deref(ARG2); if (IsPrimitiveTerm(t)) out = TermNil; else { out = vars_within_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS); } - if (out == 0L) { - if (!expand_vts(3 PASS_REGS)) - return false; - } - } while (out == 0L); - return Yap_unify(ARG3, out); + return Yap_unify(ARG3, out); } -static Term free_vars_in_complex_term(CELL * pt0, CELL * pt0_end, - tr_fr_ptr TR0 USES_REGS) { +static Term free_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ + USES_REGS) { Term o = TermNil; - CELL *InitialH = HR; - int lvl = push_text_stack(); WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ *ptd0 = TermNil; @@ -1050,10 +982,7 @@ static Term free_vars_in_complex_term(CELL * pt0, CELL * pt0_end, def_global_overflow(); } -static Term bind_vars_in_complex_term(CELL * pt0, CELL * pt0_end, - tr_fr_ptr TR0 USES_REGS) { - CELL *InitialH = HR; - int lvl = push_text_stack(); +static Term bind_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ *ptd0 = TermFoundVar; @@ -1088,8 +1017,7 @@ static Int p_free_variables_in_term( Term t, t0; Term found_module = 0L; - do { - tr_fr_ptr TR0 = TR; + tr_fr_ptr TR0 = TR; t = t0 = Deref(ARG1); while (!IsVarTerm(t) && IsApplTerm(t)) { @@ -1117,12 +1045,7 @@ static Int p_free_variables_in_term( else { out = free_vars_in_complex_term(&(t)-1, &(t), TR0 PASS_REGS); } - if (out == 0L) { - trail_overflow: - if (!expand_vts(3 PASS_REGS)) - return false; - } -} while (out == 0L); + if (found_module && t != t0) { Term ts[2]; ts[0] = found_module; @@ -1177,8 +1100,7 @@ static Int p_non_singletons_in_term( Term t; Term out; - while (true) { - t = Deref(ARG1); + t = Deref(ARG1); if (IsVarTerm(t)) { out = ARG2; } else if (IsPrimitiveTerm(t)) { @@ -1186,11 +1108,7 @@ static Int p_non_singletons_in_term( } else { out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS); } - if (out != 0L) { - return Yap_unify(ARG3, out); - } - } -} + } static Term numbervar(Int me USES_REGS) { Term ts[1]; @@ -1218,10 +1136,6 @@ if (singles) { \ static Int numbervars_in_complex_term(CELL * pt0, CELL * pt0_end, Int numbv, int singles USES_REGS) { - tr_fr_ptr TR0 = TR; - CELL *InitialH = HR; - int lvl = push_text_stack(); - WALK_COMPLEX_TERM__({}, {}, {}); if (IsAttVar(pt0)) @@ -1256,8 +1170,7 @@ Int Yap_NumberVars(Term inp, Int numbv, Int out; Term t; - restart: - t = Deref(inp); + t = Deref(inp); if (IsPrimitiveTerm(t)) { return numbv; } else { @@ -1265,11 +1178,7 @@ Int Yap_NumberVars(Term inp, Int numbv, out = numbervars_in_complex_term(&(t)-1, &(t), numbv, handle_singles PASS_REGS); } - if (out < numbv) { - if (!expand_vts(3 PASS_REGS)) - return false; - goto restart; - } + return out; } @@ -1309,7 +1218,7 @@ if (FunctorOfTerm(d0) == FunctorDollarVar) { \ static int max_numbered_var(CELL * pt0, CELL * pt0_end, Int * maxp USES_REGS) { - int lvl = push_text_stack(); + WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {}); END_WALK(); /* Do we still have compound terms to visit */ @@ -1541,7 +1450,7 @@ void Yap_InitTermCPreds(void) { Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); - Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); + Yap_InitCPred("term_attvars", 2, term_attvars, 0); CurrentModule = TERMS_MODULE; Yap_InitCPred("variable_in_term", 2, variable_in_term, 0); diff --git a/C/text.c b/C/text.c index e64e41bf3..ddb1ba01d 100644 --- a/C/text.c +++ b/C/text.c @@ -192,7 +192,7 @@ void *MallocAtLevel(size_t sz, int atL USES_REGS) { void *Realloc(void *pt, size_t sz USES_REGS) { struct mblock *old = pt, *o; old--; - sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL); + sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), Yap_Max(CELLSIZE,sizeof(struct mblock))); o = realloc(old, sz); if (o->next) { o->next->prev = o; @@ -447,15 +447,16 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { yap_error_number err0 = LOCAL_Error_TYPE; /* we know what the term is */ if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) { - if (!(inp->type & YAP_STRING_TERM)) { + seq_type_t inpt = inp->type & (YAP_STRING_TERM|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES); + if (!(inpt & YAP_STRING_TERM)) { if (IsVarTerm(inp->val.t)) { LOCAL_Error_TYPE = INSTANTIATION_ERROR; - } else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) { + } else if (!IsAtomTerm(inp->val.t) && inpt == YAP_STRING_ATOM) { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; - } else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) { + } else if (!IsStringTerm(inp->val.t) && inpt == YAP_STRING_STRING) { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && - inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) { + inpt == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) { LOCAL_ActiveError->errorRawTerm = inp->val.t; } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && !IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) { diff --git a/C/utilpreds.c b/C/utilpreds.c index 092ea2ced..4ebf53655 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -152,7 +152,7 @@ clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { #define expand_stack(S0,SP,SF,TYPE) \ { size_t sz = SF-S0, used = SP-S0; \ - S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ + S0 = Realxbloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ SP = S0+used; SF = S0+sz; } #define MIN_ARENA_SIZE (1048L) diff --git a/H/YapText.h b/H/YapText.h index 7f76514f3..822bd8bec 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -1447,7 +1447,7 @@ static inline Term Yap_WCharsToString(const wchar_t *s USES_REGS) { static inline Atom Yap_ConcatAtoms(Term t1, Term t2 USES_REGS) { seq_tv_t inpv[2], out; inpv[0].val.t = t1; - inpv[0].type = YAP_STRING_ATOM | YAP_STRING_TERM; + inpv[0].type = YAP_STRING_ATOM ; inpv[1].val.t = t2; inpv[1].type = YAP_STRING_ATOM; out.type = YAP_STRING_ATOM; diff --git a/pl/boot2.yap b/pl/boot2.yap index 7b0bef42f..27ad68501 100644 --- a/pl/boot2.yap +++ b/pl/boot2.yap @@ -41,7 +41,6 @@ :- '$opdec'(1150,fx,(mode),prolog). :- dynamic 'extensions_to_present_answer'/1. - :- ['arrays.yap']. :- multifile user:portray_message/2. diff --git a/pl/directives.yap b/pl/directives.yap index 38540758b..1af3b202d 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -272,12 +272,14 @@ user_defined_directive(Dir,Action) :- '$process_directive'(D, _, M, _VL, _Pos) :- current_prolog_flag(language_mode, iso), !, % ISO Prolog mode, go in and do it, - '$do_error'(context_error((:- M:D),query),directive). + + '$do_error'(context_error((:- M:D),query),directive). % % but YAP and SICStus do. % '$process_directive'(G, _Mode, M, _VL, _Pos) :- - '$execute'(M:G), + '$yap_strip_module'(M:G,M1,G1), + '$execute'(M1:G1), !. '$process_directive'(G, _Mode, M, _VL, _Pos) :- format(user_error,':- ~w:~w failed.~n',[M,G]). diff --git a/pl/init.yap b/pl/init.yap index 8f0e729ae..008b7be68 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -92,7 +92,7 @@ '$init_step'(1) :- '$version'. '$init_step'(2) :- - set_prolog_flag(file_name_variables, _OldF, true), + set_prolog_flag(file_name_variables, true), '$init_consult'. %set_prolog_flag(file_name_variables, OldF), '$init_step'(3) :- diff --git a/pl/messages.yap b/pl/messages.yap index bd0f4f3f4..cc0124eb7 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -261,7 +261,7 @@ compose_message(Throw, _Level) --> location( error(_,Info), Level, _LC ) --> { '$error_descriptor'(Info, Desc) }, { query_exception(prologConsulting, Desc, true) }, - { query_exception(parserReadingCode, Desc, true)}, +% { query_exception(parserReadingCode, Desc, true)}, !, { query_exception(parserFile, Desc, FileName), diff --git a/pl/meta.yap b/pl/meta.yap index 56054217e..93b4a5e12 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -477,10 +477,15 @@ meta_predicate(P) :- expand_goal(Input, Output) :- '$expand_meta_call'(Input, none, Output ). -'$expand_meta_call'(G, HVars, MF:GF ) :- - source_module(SM), - '$yap_strip_module'(SM:G, M, IG), - '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G), - '$yap_strip_module'(M:GF0, MF, GF). +'$expand_meta_call'(G, HVars, MF:GF ) :- + source_module(SM), + '$yap_strip_module'(SM:G, M, IG), + '$is_metapredicate'(IG, M), + '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G), + !, + '$yap_strip_module'(M:GF0, MF, GF). +'$expand_meta_call'(G, _HVars, M:IG ) :- + source_module(SM), + '$yap_strip_module'(SM:G, M, IG). %% @} diff --git a/pl/top.yap b/pl/top.yap index 4c85aa0c0..13197f25c 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -188,9 +188,7 @@ live :- '$expand_term0'(T,_,T). '$expand_term1'(T,O) :- - '$expand_meta_call'(T, [], O), - !. -'$expand_term1'(O,O). + '$expand_meta_call'(T, none, O). '$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- !, @@ -637,7 +635,7 @@ write_query_answer( Bindings ) :- '$do_error'(instantiation_error,call(G0)). '$call'(M:G,CP,G0,_M0) :- !, '$expand_meta_call'(M:G, [], NG), -'$yap_strip_module'(NG,NM,NC), + '$yap_strip_module'(NG,NM,NC), '$call'(NC,CP,G0,NM). '$call'((X,Y),CP,G0,M) :- !, '$call'(X,CP,G0,M), diff --git a/pl/undefined.yap b/pl/undefined.yap index 3852845f8..980259645 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -95,30 +95,13 @@ undefined_query(G0, M0, Cut) :- % undef handler '$undefp'([M0|G0],MG) :- - % make sure we do not loop on undefined predicates - '$undef_setup'(M0:G0, Action,Debug,Current, MGI), - ('$get_undefined_predicates'( MGI, MG ) - -> - true - ; - '$undef_error'(Current, M0:G0, MGI, MG) - ), - '$undef_cleanup'(Action,Debug,Current) - . - -'$undef_error'(_, M0:G0, _, MG) :- - '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), - '$yap_strip_module'(M0:G0, EM0, GM0), - user:unknown_predicate_handler(GM0,EM0,MG), - !. -'$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), - print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))), - fail. -'$undef_error'(fail,_Goal,_Mod) :- - fail. + % 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 )), + '$undef_cleanup'(Action,Debug,Current) + ), + '$undef_error'(Action, M0:G0, MGI, MG). '$undef_setup'(G0,Action,Debug,Current,GI) :- yap_flag( unknown, Action, fail), @@ -136,11 +119,11 @@ undefined_query(G0, M0, Cut) :- !, functor(G, Na, Ar). -'$undef_cleanup'(Action,Debug,_Current) :- +'$undef_cleanup'(Action,Debug, _Current) :- yap_flag( unknown, _, Action), - yap_flag( debug, _, Debug), - '$start_creep'([prolog|true], creep). + yap_flag( debug, _, Debug). +:- abolish(prolog:'$undefp0'/2). :- '$undefp_handler'('$undefp'(_,_), prolog). /** @pred unknown(- _O_,+ _N_) @@ -154,6 +137,28 @@ The unknown predicate, informs about what the user wants to be done */ +'$undef_error'(_, _, _, M:G) :- + nonvar(M), + nonvar(G), + !, + '$start_creep'([prolog|true], creep). +'$undef_error'(_, M0:G0, _, MG) :- + '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), + '$yap_strip_module'(M0:G0, EM0, GM0), + user:unknown_predicate_handler(GM0,EM0,MG), + !, + '$start_creep'([prolog|true], creep). +'$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), + print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))), + '$start_creep'([fail|true], creep), + fail. +'$undef_error'(fail,_Goal,_,_Mod) :- + '$start_creep'([fail|true], creep), + fail. + unknown(P, NP) :- yap_flag( unknown, P, NP ). From 2d65d0463cb7caef1ddd6cc668598fe33c45328e Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 27 Feb 2019 04:23:21 +0000 Subject: [PATCH 061/101] jupyter --- C/cdmgr.c | 2 +- C/errors.c | 26 ++- C/exec.c | 24 +- C/terms.c | 17 +- C/utilpreds.c | 210 +++++++----------- CXX/yapq.hh | 61 +++-- H/Yapproto.h | 2 +- configure | 3 +- library/charsio.yap | 2 +- os/readterm.c | 10 +- packages/python/pypreds.c | 52 ++--- packages/python/python.pl | 51 +++-- packages/python/swig/prolog/yapi.yap | 78 ++++--- packages/python/swig/setup.py.in | 2 +- .../yap_kernel/yap_ipython/prolog/jupyter.yap | 67 ++++-- .../yap_kernel/yap_ipython/prolog/verify.yap | 4 +- .../yap_ipython/terminal/console.py | 12 +- .../yap_ipython/terminal/debugger.py | 15 +- .../yap_kernel/yap_ipython/terminal/embed.py | 58 ++--- .../yap_ipython/terminal/interactiveshell.py | 43 ++-- .../yap_kernel/yap_ipython/terminal/ipapp.py | 104 ++++----- .../yap_kernel/yap_ipython/terminal/magics.py | 16 +- .../yap_ipython/terminal/prompts.py | 7 +- .../yap_ipython/terminal/ptutils.py | 20 +- .../python/yap_kernel/yap_ipython/yapi.py | 19 +- pl/debug.yap | 7 +- pl/imports.yap | 8 +- pl/messages.yap | 7 +- pl/protect.yap | 12 +- pl/top.yap | 12 +- 30 files changed, 527 insertions(+), 424 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index f32ec9cd9..89534376d 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2539,7 +2539,7 @@ static Int // if (!pe) pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate"); if (EndOfPAEntr(pe)) return FALSE; - return (pe->ModuleOfPred == 0); + return (pe->ModuleOfPred == 0 || pe-> PredFlags & UserCPredFlag); // return true; // PELOCK(27, pe); // out = (pe->PredFlags & SystemPredFlags); diff --git a/C/errors.c b/C/errors.c index ed1cbd6f2..8c5dd6a72 100755 --- a/C/errors.c +++ b/C/errors.c @@ -107,6 +107,9 @@ if (strcmp(ks, q) == 0 ) \ if (i->k == NULL) return TermNil; \ Term t; if((t = Yap_BufferToTerm(i->k, TermNil) ) == 0 ) return TermNil; return t; } +static yap_error_descriptor_t *CopyException(yap_error_descriptor_t *t); + + static Term queryErr(const char *q, yap_error_descriptor_t *i) { query_key_i(errorNo, "errorNo", q, i); query_key_i(errorClass, "errorClass", q, i); @@ -332,15 +335,17 @@ bool Yap_PrintWarning(Term twarning) { CACHE_REGS PredEntry *pred = RepPredProp(PredPropByFunc( FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2; + if (twarning) __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " warning(%s)", Yap_TermToBuffer(twarning, Quote_illegal_f | Ignore_ops_f | Ignore_cyclics_f)); Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule); bool rc; Term ts[2], err; - if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError && + + if (twarning && LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError->errorClass != WARNING && - (err = LOCAL_ActiveError->errorNo)) { + (err = LOCAL_ActiveError->errorNo) ) { fprintf(stderr, "%% Warning %s while processing error: %s %s\n", Yap_TermToBuffer(twarning, Quote_illegal_f | Ignore_ops_f), @@ -352,12 +357,16 @@ bool Yap_PrintWarning(Term twarning) { fprintf(stderr, "%s:%ld/* d:%d warning */:\n", LOCAL_ActiveError->errorFile, LOCAL_ActiveError->errorLine, 0 ); + if (!twarning) + twarning = Yap_MkFullError(); Yap_DebugPlWriteln(twarning); LOCAL_DoingUndefp = false; LOCAL_PrologMode &= ~InErrorMode; CurrentModule = cmod; return false; } + if (!twarning) + twarning = Yap_MkFullError(); ts[1] = twarning; ts[0] = MkAtomTerm(AtomWarning); rc = Yap_execute_pred(pred, ts, true PASS_REGS); @@ -656,7 +665,7 @@ void Yap_ThrowExistingError(void) { Term Yap_MkFullError(void) { - yap_error_descriptor_t *i = Yap_local.ActiveError; + yap_error_descriptor_t *i = CopyException(Yap_local.ActiveError); i->errorAsText = Yap_errorName( i->errorNo ); i->errorClass = Yap_errorClass( i-> errorNo ); i->classAsText = Yap_errorClassName(i->errorClass); @@ -880,7 +889,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, if (LOCAL_DoingUndefp) { LOCAL_DoingUndefp = false; LOCAL_Signals = 0; - Yap_PrintWarning(MkErrorTerm(Yap_GetException(LOCAL_ActiveError))); + yap_error_descriptor_t *co = CopyException( LOCAL_ActiveError ); + Yap_PrintWarning(MkErrorTerm(Yap_GetException( co ))); return P; } // LOCAL_ActiveError = Yap_GetException(); @@ -1012,6 +1022,7 @@ bool Yap_ResetException(yap_error_descriptor_t *i) { static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); } + Term MkErrorTerm(yap_error_descriptor_t *t) { if (t->errorClass == EVENT) return t->errorRawTerm; @@ -1023,6 +1034,13 @@ Term MkErrorTerm(yap_error_descriptor_t *t) { err2list(t)); } + +static yap_error_descriptor_t *CopyException(yap_error_descriptor_t *t) { + yap_error_descriptor_t *n = malloc( sizeof( yap_error_descriptor_t )); + memcpy(n, t, sizeof( yap_error_descriptor_t ) ); + return n; +} + static Int read_exception(USES_REGS1) { yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1)); Term rc = MkErrorTerm(t); diff --git a/C/exec.c b/C/exec.c index f21b95cf9..38caee798 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1065,8 +1065,8 @@ static Int _user_expand_goal(USES_REGS1) { ARG1 = g; if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL, true PASS_REGS)) { - return complete_ge(true, omod, sl, creeping); + Yap_execute_pred(pe, NULL, false PASS_REGS)) { + return complete_ge(true , omod, sl, creeping); } /* system:goal_expansion(A,B) */ mg_args[0] = cmod; @@ -1076,7 +1076,7 @@ static Int _user_expand_goal(USES_REGS1) { if ((pe = RepPredProp( Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL, true PASS_REGS)) { + Yap_execute_pred(pe, NULL, false PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } Yap_ResetException(NULL); @@ -1087,7 +1087,7 @@ static Int _user_expand_goal(USES_REGS1) { if ((pe = RepPredProp( Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL, true PASS_REGS)) { + Yap_execute_pred(pe, NULL, false PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } Yap_ResetException(NULL); @@ -1101,7 +1101,7 @@ static Int _user_expand_goal(USES_REGS1) { (pe = RepPredProp( Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL, true PASS_REGS)) { + Yap_execute_pred(pe, NULL, false PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } Yap_ResetException(NULL); @@ -1164,6 +1164,12 @@ restart_exec: } else if (IsAtomTerm(t)) { Atom a = AtomOfTerm(t); pe = PredPropByAtom(a, mod); + } else if (IsPairTerm(t)) { + Term ts[2]; + ts[0] = t; + ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule); + t = Yap_MkApplTerm(FunctorCsult, 2, ts); + goto restart_exec; } else if (IsApplTerm(t)) { register Functor f = FunctorOfTerm(t); register unsigned int i; @@ -1207,8 +1213,9 @@ restart_exec: #endif } } else { - Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); - return false; + //Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); + //return false; + return CallMetaCall(t, mod); } /* N = arity; */ /* call may not define new system predicates!! */ @@ -1264,8 +1271,7 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod) #endif } } else { - Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); - return FALSE; + return CallMetaCall(t, mod); } /* N = arity; */ /* call may not define new system predicates!! */ diff --git a/C/terms.c b/C/terms.c index 8d30e9aae..ebce29029 100644 --- a/C/terms.c +++ b/C/terms.c @@ -89,10 +89,10 @@ typedef struct non_single_struct_t { CELL *pt0, *pt0_end; \ size_t auxsz = 1024 * sizeof(struct non_single_struct_t);\ struct non_single_struct_t *to_visit0=NULL, *to_visit,* to_visit_max;\ - to_visit0 = Realloc(to_visit0,auxsz); \ CELL *InitialH = HR;\ tr_fr_ptr TR0 = TR;\ reset:\ + to_visit0 = Realloc(to_visit0,auxsz); \ pt0 = pt0_; pt0_end = pt0_end_; \ to_visit = to_visit0, \ to_visit_max = to_visit + auxsz/sizeof(struct non_single_struct_t);\ @@ -306,8 +306,10 @@ static int cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) { reset: pt0 = pt0_, pt0_end = pt0_end_; - to_visit= to_visit0, - to_visit_max = to_visit0 + auxsz/sizeof(struct non_single_struct_t); + to_visit0 = Realloc(to_visit0,auxsz); + to_visit= to_visit0; + to_visit_max = to_visit0 + auxsz/sizeof(struct non_single_struct_t); + auxsz *= 2; int rc = 0; CELL *ptf; ptf = HR; @@ -811,8 +813,8 @@ static Term new_vars_in_complex_term( CELL output = TermNil; { tr_fr_ptr myTR0 = TR; - while (!IsVarTerm(inp) && IsPairTerm(inp)) { int lvl = push_text_stack(); + while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { n++; @@ -827,6 +829,7 @@ static Term new_vars_in_complex_term( } inp = TailOfTerm(inp); } + pop_text_stack(lvl); } WALK_COMPLEX_TERM(); output = MkPairTerm((CELL)ptd0, output); @@ -958,14 +961,14 @@ static Int free_variables_in_term( Term out; Term t, t0; Term found_module = 0L; - Term vlist = TermNil; + Term bounds = TermNil; t = t0 = Deref(ARG1); Int delta = 0; while (!IsVarTerm(t) && IsApplTerm(t)) { Functor f = FunctorOfTerm(t); if (f == FunctorHat) { - vlist = Yap_TermAddVariables(ArgOfTerm(1,t), vlist PASS_REGS); + bounds = MkPairTerm(ArgOfTerm(1,t),bounds); } else if (f == FunctorModule) { found_module = ArgOfTerm(1, t); } else if (f == FunctorCall) { @@ -981,7 +984,7 @@ static Int free_variables_in_term( if (IsPrimitiveTerm(t)) out = TermNil; else { - out = new_vars_in_complex_term(&(t)-1, &(t), vlist PASS_REGS); + out = new_vars_in_complex_term(&(t)-1, &(t), Yap_TermVariables(bounds, 3) PASS_REGS); } if (found_module && t != t0) { diff --git a/C/utilpreds.c b/C/utilpreds.c index 85633d85b..2247f9344 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -152,19 +152,20 @@ clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { #define expand_stack(S0,SP,SF,TYPE) \ { size_t sz = SF-S0, used = SP-S0; \ - S0 = Realxbloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ + S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ SP = S0+used; SF = S0+sz; } #define MIN_ARENA_SIZE (1048L) + int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, - bool share, Term *split, bool copy_att_vars, CELL *ptf, + bool share, bool copy_att_vars, CELL *ptf, CELL *HLow USES_REGS) { // fprintf(stderr,"+++++++++\n"); //CELL *x = pt0; while(x != pt0_end) Yap_DebugPlWriteln(*++ x); int lvl = push_text_stack(); - Term o = TermNil; + struct cp_frame *to_visit0, *to_visit = Malloc(1024*sizeof(struct cp_frame)); struct cp_frame *to_visit_max; @@ -188,42 +189,25 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, copy_term_nvar : { if (IsPairTerm(d0)) { CELL *headp = RepPair(d0); - Term head = *headp; - if (IsPairTerm(head) && RepPair(head) >= HB && RepPair(head) < HR) { - if (split) { - Term v = Yap_MkNewApplTerm(FunctorEq, 2); - RepAppl(v)[1] = AbsPair(ptf); - *headp = *ptf++ = RepAppl(v)[0]; - o = MkPairTerm( v, o ); - } else { - *ptf++ = RepPair(head)[0];; - } - continue; - } else if (IsApplTerm(head) && RepAppl(head) >= HB && RepAppl(head) < HR) { - *ptf++ = RepAppl(head)[0]; + if (//(share && headp < HB) || + (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR)) { + /* If this is newer than the current term, just reuse */ + *ptf++ = *headp; continue; } - *ptf++ = AbsPair(HR); if (to_visit >= to_visit_max-32) { expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); } + *ptf = AbsPair(HR); + ptf++; to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->curp = headp; - d0 = to_visit->oldv = head; to_visit->ground = ground; to_visit++; // move to new list - if (share) { - TrailedMaBind(headp,AbsPair(HR)); - } else { - /* If this is newer than the current term, just reuse */ - *headp = AbsPair(HR); - } - if (split) { - TrailedMaBind(ptf,AbsPair(HR)); - } + d0 = *headp; + TrailedMaBind(headp, AbsPair(HR)); pt0 = headp; pt0_end = headp + 1; ptf = HR; @@ -232,47 +216,21 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, if (HR > ASP - MIN_ARENA_SIZE) { goto overflow; } - d0 = head; + ptd0 = pt0; goto deref; } else if (IsApplTerm(d0)) { - Functor f; - CELL *headp, head; + register Functor f; + register CELL *headp; /* store the terms to visit */ headp = RepAppl(d0); - head = *headp; - - if (IsPairTerm(head)) { - if (split) { - Term v = Yap_MkNewApplTerm(FunctorEq, 2); - RepAppl(v)[1] = AbsPair(ptf); - *headp = *ptf++ = RepAppl(v)[0]; - o = MkPairTerm( v, o ); - } else { - *ptf++ = RepPair(head)[0];; - } - continue; - } else if (IsApplTerm(head)) { - *ptf++ = RepAppl(head)[0]; + if (IsApplTerm(*headp)//(share && headp < HB) || + ) { + /* If this is newer than the current term, just reuse */ + *ptf++ = *headp; continue; } - f = (Functor)(head); - if (share && (ground || IsExtensionFunctor(f))) { - *ptf++ = d0; - continue; - } - /* store the terms to visit */ - *ptf = AbsAppl(HR); - ptf++; - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->curp = headp; - to_visit->oldv = head; - to_visit->ground = ground; - if (++to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - + f = (Functor)(*headp); + if (IsExtensionFunctor(f)) { switch ((CELL)f) { case (CELL) FunctorDBRef: @@ -321,42 +279,44 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, /* big int */ size_t sz = (sizeof(MP_INT) + 3 * CellSize + ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / - CellSize; + CellSize, + i; if (HR > ASP - (MIN_ARENA_SIZE + sz)) { goto overflow; } *ptf++ = AbsAppl(HR); - memmove(HR, headp, sz*sizeof(CELL)); - MP_INT *new = (MP_INT *)(HR + 2); - new->_mp_d = (mp_limb_t *)(new + 1); - + HR[0] = (CELL)f; + for (i = 1; i < sz; i++) { + HR[i] = headp[i]; + + } HR += sz; } } continue; + } + *ptf = AbsAppl(HR); + ptf++; + /* store the terms to visit */ + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + if (++to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); } - if (share) { - TrailedMaBind(headp,AbsPair(HR)); - } else { - *headp = AbsPair(HR); - } - if (split) { - // must be after trailing source term, so that we can check the source - // term and confirm it is still ok. - TrailedMaBind(ptf,AbsAppl(HR)); - } + TrailedMaBind(headp,AbsAppl(HR)); ptf = HR; - ptf[0] = (CELL)f; + *ptf++ = (CELL)f; ground = true; arity_t a = ArityOfFunctor(f); - if (HR > ASP - MIN_ARENA_SIZE) { + HR = ptf+a; + if (HR > ASP - MIN_ARENA_SIZE) { goto overflow; } - ptf++; - HR = ptf+a; - pt0_end = headp+(a); - pt0 = headp; + pt0 = headp; + pt0_end = headp+a; ground = (f != FunctorMutable); } else { /* just copy atoms or integers */ @@ -369,43 +329,44 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, ground = false; /* don't need to copy variables if we want to share the global term */ if (//(share && ptd0 < HB && ptd0 > H0) || - (ptd0 >= HB && ptd0 < HR)) { + (ptd0 >= HLow && ptd0 < HR)) { /* we have already found this cell */ *ptf++ = (CELL)ptd0; - } else - if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { - /* if unbound, call the standard copy term routine */ - struct cp_frame *bp; - - bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, - ptf PASS_REGS)) { - goto overflow; - } - to_visit = bp; - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - } else { - /* first time we met this term */ - RESET_VARIABLE(ptf); - *ptd0 = (CELL)ptf; - ptf++; - TrailTerm(TR++) = (CELL)ptd0; - if ((ADDR)TR > LOCAL_TrailTop - 16) - goto trail_overflow; + if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { + /* if unbound, call the standard copy term routine */ + struct cp_frame *bp; + CELL new; + + bp = to_visit; + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, + ptf PASS_REGS)) { + goto overflow; + } + to_visit = bp; + new = *ptf; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailedMaBind(ptd0, new); + ptf++; + } else { + /* first time we met this term */ + RESET_VARIABLE(ptf); + if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) + goto trail_overflow; + TrailedMaBind(ptd0, (CELL)ptf); + ptf++; + } } } - + /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; - if (!share) - *to_visit->curp = to_visit->oldv; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -414,7 +375,7 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, } /* restore our nice, friendly, term to its original state */ - clean_complex_tr(TR0 PASS_REGS); + clean_dirty_tr(TR0 PASS_REGS); /* follow chain of multi-assigned variables */ pop_text_stack(lvl); return 0; @@ -491,6 +452,7 @@ handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) } } + static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { Term t = Deref(inp); @@ -505,7 +467,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { Hi = HR; HR ++; - if ((res = Yap_copy_complex_term((&t)-1, &t, share, NULL, newattvs, Hi, HR PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term((&t)-1, &t, share, newattvs, Hi, HR PASS_REGS)) < 0) { HR = Hi; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -579,16 +541,6 @@ typedef struct copy_frame { CELL *to; } copy_frame_t; -static Term -add_to_list( Term inp, Term v, Term t PASS_REGS) -{ - Term ta[2]; - - ta[0] = v; - ta[1] = t; - return MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), inp); -} - /* @@ -2585,14 +2537,6 @@ p_is_list_or_partial_list( USES_REGS1 ) return Yap_IsListOrPartialListTerm(Deref(ARG1)); } -static Term -numbervar(Int id USES_REGS) -{ - Term ts[1]; - ts[0] = MkIntegerTerm(id); - return Yap_MkApplTerm(FunctorDollarVar, 1, ts); -} - #if 0 static Term numbervar_singleton(USES_REGS1) diff --git a/CXX/yapq.hh b/CXX/yapq.hh index 2616bcfdb..35474603b 100644 --- a/CXX/yapq.hh +++ b/CXX/yapq.hh @@ -158,7 +158,8 @@ public: }; }; -// Java support + + /// This class implements a callback Prolog-side. It will be inherited by the /// Java or Python @@ -211,46 +212,56 @@ public: inline bool creatingSavedState() { return install; }; inline void setPLDIR(const char *fl) { - LIBDIR = (const char *)malloc(strlen(fl) + 1); - strcpy((char *)LIBDIR, fl); + std::string *s = new std::string(fl); + LIBDIR = s->c_str(); }; inline const char *getPLDIR() { return PLDIR; }; inline void setINPUT_STARTUP(const char *fl) { - INPUT_STARTUP = (const char *)malloc(strlen(fl) + 1); - strcpy((char *)INPUT_STARTUP, fl); + std::string *s = new std::string(fl); + INPUT_STARTUP = s->c_str(); }; inline const char *getINPUT_STARTUP() { return INPUT_STARTUP; }; + inline void setOUTPUT_STARTUP(const char *fl) { + std::string *s = new std::string(fl); + OUTPUT_STARTUP = s->c_str(); + }; + inline void setOUTPUT_RESTORE(const char *fl) { - OUTPUT_STARTUP = (const char *)malloc(strlen(fl) + 1); - strcpy((char *)OUTPUT_STARTUP, fl); + std::string *s = new std::string(fl); + OUTPUT_STARTUP = s->c_str(); }; inline const char *getOUTPUT_STARTUP() { return OUTPUT_STARTUP; }; inline void setSOURCEBOOT(const char *fl) { - SOURCEBOOT = (const char *)malloc(strlen(fl) + 1); - strcpy((char *)SOURCEBOOT, fl); + std::string *s = new std::string(fl); + SOURCEBOOT = s->c_str(); }; inline const char *getSOURCEBOOT() { return SOURCEBOOT; }; inline void setPrologBOOTSTRAP(const char *fl) { - BOOTSTRAP = (const char *)malloc(strlen(fl) + 1); - strcpy((char *)BOOTSTRAP, fl); + std::string *s = new std::string(fl); + BOOTSTRAP = s->c_str(); }; inline const char *getBOOTSTRAP() { return BOOTSTRAP; }; - inline void setPrologGoal(const char *fl) { PrologGoal = fl; }; + inline void setPrologGoal(const char *fl) { + std::string *s = new std::string(fl); + PrologGoal = s->c_str(); + + } inline const char *getPrologGoal() { return PrologGoal; }; inline void setPrologTopLevelGoal(const char *fl) { - PrologTopLevelGoal = fl; + std::string *s = new std::string(fl); + PrologTopLevelGoal = s->c_str() ; }; inline const char *getPrologTopLevelGoal() { return PrologTopLevelGoal; }; @@ -271,7 +282,27 @@ public: inline char **getArgv() { return Argv; }; - inline void setROOTDIR(char *fl) { ROOTDIR = fl; }; + inline void setBOOTDIR(const char *fl) { + std::string *s = new std::string(fl); + BOOTDIR = s->c_str() ; + } + + inline const char *getBOOTDIR() { return BOOTDIR; }; + + inline const char *getBOOTFILE() { return BOOTSTRAP; }; + + inline void setBOOTFILE(const char *fl) { + std::string *s = new std::string(fl); + BOOTSTRAP = s->c_str() ; + + } + + inline void setROOTDIR(const char *fl) { + std::string *s = new std::string(fl); + ROOTDIR = s->c_str() ; + + } + }; /** @@ -295,7 +326,7 @@ public: YAPEngine(YAPEngineArgs *cargs) { engine_args = cargs; // doInit(cargs->boot_file_type); - __android_log_print( + __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "start engine "); #ifdef __ANDROID__ doInit(YAP_PL, cargs); diff --git a/H/Yapproto.h b/H/Yapproto.h index 8e5bc5c89..309e9eaa7 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -484,7 +484,7 @@ extern void Yap_InitUserBacks(void); /* utilpreds.c */ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, - bool share, Term *split, bool copy_att_vars, CELL *ptf, + bool share, bool copy_att_vars, CELL *ptf, CELL *HLow USES_REGS); extern Term Yap_CopyTerm(Term); extern bool Yap_Variant(Term, Term); diff --git a/configure b/configure index 64511cd43..984b496c4 100755 --- a/configure +++ b/configure @@ -358,6 +358,7 @@ while [ $# != 0 ]; do esac; shift done +_LIBDIR=${LIBDIR} ${CMAKE_ARGS} if [ "x${LIBDIR}" = "x" ]; then LIBDIR="${PREFIX}/lib" @@ -373,4 +374,4 @@ fi CMAKE_CMD="${CMAKE} ${TOP_SRCDIR}" -${CMAKE_CMD} "${GENERATOR}" ${TOP_SRCDIR} -DCMAKE_BUILD_TYPE=${BUILD_TYPE} -DCMAKE_INSTALL_PREFIX=${PREFIX} -DCMAKE_INSTALL_LIBDIR=${LIBDIR} ${CMAKE_ARGS} +${CMAKE_CMD} "${GENERATOR}" ${TOP_SRCDIR} -DCMAKE_BUILD_TYPE=${BUILD_TYPE} -DCMAKE_INSTALL_PREFIX=${PREFIX} ${CMAKE_ARGS} diff --git a/library/charsio.yap b/library/charsio.yap index f6efc7ca8..8e39fbf6d 100644 --- a/library/charsio.yap +++ b/library/charsio.yap @@ -29,7 +29,7 @@ %% %% @brief Input/Output to characters. -:- module(system(charsio), [ +:- module(charsio, [ format_to_chars/3, format_to_chars/4, write_to_chars/3, diff --git a/os/readterm.c b/os/readterm.c index 4193725ee..aeef31efe 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -1,3 +1,4 @@ + /************************************************************************* * * * YAP Prolog * @@ -381,10 +382,12 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool Int end_line = GetCurInpLine(GLOBAL_Stream + sno); Int endpos = GetCurInpPos(GLOBAL_Stream + sno); - Yap_local.ActiveError->errorNo = SYNTAX_ERROR; + Yap_local.ActiveError->prologConsulting = Yap_Consulting(); Yap_local.ActiveError->parserFirstLine = start_line; + Yap_local.ActiveError->parserLine = err_line; Yap_local.ActiveError->parserLastLine = end_line; Yap_local.ActiveError->parserFirstPos = startpos; + Yap_local.ActiveError->parserPos = errpos; Yap_local.ActiveError->parserLastPos = endpos; Yap_local.ActiveError->parserFile = RepAtom(AtomOfTerm((GLOBAL_Stream + sno)->user_name))->StrOfAE; @@ -811,7 +814,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool else singls[1] = TermTrue; Term t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, singls); - Yap_PrintWarning(t); + Yap_PrintWarning(t); } } @@ -1155,8 +1158,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool re->cpos = GLOBAL_Stream[inp_stream].charcount; } LOCAL_Error_TYPE = WARNING_SYNTAX_ERROR; - t = Yap_MkFullError(); - Yap_PrintWarning(t); + Yap_PrintWarning(0); LOCAL_Error_TYPE = YAP_NO_ERROR; if (ParserErrorStyle == TermDec10) { diff --git a/packages/python/pypreds.c b/packages/python/pypreds.c index c51fe48a7..ec043c20e 100644 --- a/packages/python/pypreds.c +++ b/packages/python/pypreds.c @@ -761,31 +761,33 @@ bool python_release_GIL(term_t curBlock) { } install_t install_pypreds(void) { - PL_register_foreign("python_builtin_eval", 3, python_builtin_eval, 0); - PL_register_foreign("python_builtin", 1, python_builtin, 0); - PL_register_foreign("python_import", 2, python_import, 0); - PL_register_foreign("python_to_rhs", 2, python_to_rhs, 0); - PL_register_foreign("python_len", 2, python_len, 0); - PL_register_foreign("python_is", 2, python_is, 0); - PL_register_foreign("python_dir", 2, python_dir, 0); - PL_register_foreign("python_apply", 4, python_apply, 0); - PL_register_foreign("python_index", 3, python_index, 0); - PL_register_foreign("python_field", 3, python_field, 0); - PL_register_foreign("python_assign", 2, assign_python, 0); - PL_register_foreign("python_represents", 2, python_represent, 0); - PL_register_foreign("python_export", 2, python_export, 0); - PL_register_foreign("python_function", 1, python_function, 0); - PL_register_foreign("python_slice", 4, python_slice, 0); - PL_register_foreign("python_run_file", 1, python_run_file, 0); - PL_register_foreign("python_proc", 1, python_proc, 0); - PL_register_foreign("python_run_command", 1, python_run_command, 0); - PL_register_foreign("python_run_script", 2, python_run_script, 0); - PL_register_foreign("python_main_module", 1, python_main_module, 0); - PL_register_foreign("python_import", 2, python_import, 0); - PL_register_foreign("python_access", 3, python_access, 0); - PL_register_foreign("python_threaded", 0, p_python_threaded, 0); - PL_register_foreign("python_clear_errors", 0, python_clear_errors, 0); - PL_register_foreign("python_string_to", 1, python_string_to, 0); + PL_register_foreign_in_module("python", "python_builtin_eval", 3, python_builtin_eval, 0); + PL_register_foreign_in_module("python", "python_builtin", 1, python_builtin, 0); + PL_register_foreign_in_module("python", "python_import", 2, python_import, 0); + PL_register_foreign_in_module("python", "python_to_rhs", 2, python_to_rhs, 0); + PL_register_foreign_in_module("python", "python_len", 2, python_len, 0); + PL_register_foreign_in_module("python", "python_is", 2, python_is, 0); + PL_register_foreign_in_module("python", "python_dir", 2, python_dir, 0); + PL_register_foreign_in_module("python", "python_apply", 4, python_apply, 0); + PL_register_foreign_in_module("python", "python_index", 3, python_index, 0); + PL_register_foreign_in_module("python", "python_field", 3, python_field, 0); + PL_register_foreign_in_module("python", "python_assign", 2, assign_python, 0); + PL_register_foreign_in_module("python", "python_represents", 2, python_represent, 0); + PL_register_foreign_in_module("python", "python_export", 2, python_export, 0); + PL_register_foreign_in_module("python", "python_function", 1, python_function, 0); + PL_register_foreign_in_module("python", "python_slice", 4, python_slice, 0); + PL_register_foreign_in_module("python", "python_run_file", 1, python_run_file, 0); + PL_register_foreign_in_module("python", "python_proc", 1, python_proc, 0); + PL_register_foreign_in_module("python", "python_run_command", 1, python_run_command, 0); + PL_register_foreign_in_module("python", "python_run_script", 2, python_run_script, 0); + PL_register_foreign_in_module("python", "python_main_module", 1, python_main_module, 0); + PL_register_foreign_in_module("python", "python_import", 2, python_import, 0); + PL_register_foreign_in_module("python", "python_access", 3, python_access, 0); + PL_register_foreign_in_module("python", "python_threaded", 0, p_python_threaded, 0); + PL_register_foreign_in_module("python", "python_clear_errors", 0, python_clear_errors, 0); + PL_register_foreign_in_module("python", "python_string_to", 1, python_string_to, 0); + + init_python_vfs(); } diff --git a/packages/python/python.pl b/packages/python/python.pl index 85c94ef69..d1ee6d370 100644 --- a/packages/python/python.pl +++ b/packages/python/python.pl @@ -43,13 +43,18 @@ op(50, yf, []), op(50, yf, '()'), op(100, xfy, '.'), - op(100, fy, '.') + op(100, fy, '.'), + (:=)/2, + (:=)/1, + % (<-)/1, + % (<-)/2, + '()'/1, '{}'/1, dot_qualified_goal/1, import_arg/1 ]). /** @defgroup Py4YAP A C-based Prolog interface to python. @ingroup python - +b @{ @author Vitor Santos Costa @@ -96,7 +101,7 @@ similar as possible. Python interface -Data types are +Data types arebb Python Prolog string atoms @@ -115,34 +120,38 @@ Data types are :- use_module(library(charsio)). :- dynamic python_mref_cache/2, python_obj_cache/2. -:- multifile user:(:=)/2, - user:(:=)/1, - % user:(<-)/1, - % user:(<-)/2, - user:'()'/1, user:'{}'/1, user:dot_qualified_goal/1, user:import_arg/1. +:- op(100,fy,'$'), + op(950,fy,:=), + op(950,yfx,:=), +% op(950,fx,<-), +% op(950,yfx,<-), + op(50, yf, []), + op(50, yf, '()'), + op(100, xfy, '.'), + op(100, fy, '.'). + + :- multifile (<-)/1, (<-)/2, + '()'/1, '{}'/1, + dot_qualified_goal/1, + import_arg/1. import( F ) :- catch( python:python_import(F), _, fail ). -user:dot_qualified_goal(Fs) :- catch( python:python_proc(Fs), _, fail ). +dot_qualified_goal(Fs) :- catch( python:python_proc(Fs), _, fail ). -user:F() :- - catch( python:python_proc(F() ), _, fail ). +'()'(F) :- + catch( python_proc(()(F) ), _, fail ). -user(P1,P2) :- !, + := (P1,P2) :- !, := P1, := P2. := F :- catch( python:python_proc(F), _, fail ). -:= (P1,P2) :- !, - := P1, - := P2. -user:(:= F) :- catch( python:python_proc(F), _, fail ). - -user:( V := F ) :- + V := F :- python:python_assign(F, V). /* @@ -153,15 +162,15 @@ user:(V <- F) :- V := F. */ -python:python_import(Module) :- - python:python_import(Module, _). +python_import(Module) :- + python_import(Module, _). python(Exp, Out) :- Out := Exp. python_command(Cmd) :- - python:python_run_command(Cmd). + python_run_command(Cmd). start_python :- python:python_import('inspect', _), diff --git a/packages/python/swig/prolog/yapi.yap b/packages/python/swig/prolog/yapi.yap index a125f02e6..1ad5649d1 100644 --- a/packages/python/swig/prolog/yapi.yap +++ b/packages/python/swig/prolog/yapi.yap @@ -2,27 +2,27 @@ %% @file yapi.yap %% @brief support yap shell %% -%:- start_low_level_trace. - %% :- module(yapi, [ - %% python_ouput/0, - %% show_answer/2, - %% show_answer/3, - %% yap_query/4, - %% python_query/2, - %% python_query/3, - %% python_import/1, - %% yapi_query/2 - %% ]). -:- yap_flag(verbose, silent). + :- module(yapi, [ + python_ouput/0, + show_answer/2, + show_answer/3, + yap_query/4, + python_query/2, + python_query/3, + python_import/1, + yapi_query/2 + ]). - :- use_module(library(python)). +%:- yap_flag(verbose, silent). + + :- reexport(library(python)). :- use_module( library(lists) ). :- use_module( library(maplist) ). :- use_module( library(rbtrees) ). :- use_module( library(terms) ). - + :- python_import(yap4py.yapi). :- python_import(json). @@ -46,9 +46,6 @@ yapi_query( VarNames, Self ) :- set_preds :- fail, - current_predicate(P, Q), - functor(Q,P,A), - current_predicate(P, Q), functor(Q,P,A), atom_string(P,S), @@ -69,36 +66,55 @@ fail, set_preds. argi(N,I,I1) :- - atomic_concat(`A`,I,N), + atomic_concat('A',I,N), I1 is I+1. -python_query( Caller, String ) :- +python_query( Caller, String ) :- + python_query( Caller, String, _Bindings). + +python_query( Caller, String, Bindings ) :- atomic_to_term( String, Goal, VarNames ), - query_to_answer( Goal, _, Status, VarNames, Bindings), + query_to_answer( Goal, VarNames, Status, Bindings), Caller.port := Status, output(Caller, Bindings). -output( _, Bindings ) :- - write_query_answer( Bindings ), - fail. output( Caller, Bindings ) :- - answer := {}, + Answer := {}, + % start_low_level_trace, foldl(ground_dict(answer), Bindings, [], Ts), term_variables( Ts, Hidden), foldl(bv, Hidden , 0, _), - maplist(into_dict(answer),Ts), - Caller.answer := json.dumps(answer), - S := Caller.answer, - format(user_error, '~nor ~s~n~n',S), - fail. + maplist(into_dict(Answer),Ts), + Caller.answer := Answer, + fail. + + +output( _, Bindings ) :- + write_query_answer( Bindings ), + fail. output(_Caller, _Bindings). - + bv(V,I,I1) :- atomic_concat(['__',I],V), I1 is I+1. into_dict(D,V0=T) :- - python_represents(D[V0], T). + atom(T), + !, + D[V0] := T. +into_dict(D,V0=T) :- + integer(T), +writeln((D[V0]:=T)), +!, + D[V0] := T, + := print(D). +into_dict(D,V0=T) :- + string(T), + !, + D[V0] := T. +into_dict(D,V0=T) :- + python_represents(T1,T), + D[V0] := T1. /** * diff --git a/packages/python/swig/setup.py.in b/packages/python/swig/setup.py.in index a37bbaeea..6b9edb9a7 100644 --- a/packages/python/swig/setup.py.in +++ b/packages/python/swig/setup.py.in @@ -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,@CMAKE_INSTALL_FULL_LIBDIR@','-Wl,-rpath,'+join('@CMAKE_INSTALL_FULL_LIBDIR@','..'),'-Wl,-rpath,../yap4py'] + my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-L','@CMAKE_INSTALL_FULL_LIBDIR@','-Wl,-rpath,@CMAKE_INSTALL_FULL_LIBDIR@','-Wl,-rpath,'+join('@CMAKE_INSTALL_FULL_LIBDIR@','..'),'-Wl,-rpath,../yap4py'] win_libs = [] local_libs = ['Py4YAP'] diff --git a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap index 67f411aed..806caf705 100644 --- a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap +++ b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap @@ -5,44 +5,75 @@ * @brief JUpyter support. */ -:- yap_flag(gc_trace,verbose). -/* +%:- yap_flag(gc_trace,verbose). :- module( jupyter, - [jupyter_queryl/3, + [jupyter_query/3, + jupyter_query/4, + op(100,fy,('$')), + op(950,fy,:=), + op(950,yfx,:=), +% op(950,fx,<-), +% op(950,yfx,<-), + op(50, yf, []), + op(50, yf, '()'), + op(100, xfy, '.'), + op(100, fy, '.'), blank/1, - streams/2 + streams/1 ] ). -*/ + :- use_module(library(hacks)). :- use_module(library(lists)). :- use_module(library(maplist)). -%% :- reexport(library(python)). -%% :- reexport(library(yapi)). -%% :- reexport(library(complete)). -%% :- reexport(library(verify)). + + :- use_module(library(python)). + :- use_module(library(yapi)). + :- use_module(library(complete)). + :- use_module(library(verify)). :- python_import(sys). +jupyter_query(Caller, Cell, Line, Bindings ) :- + gated_call( + streams(true), + jupyter_cell(Caller, Cell, Line, Bindings), + Port, + next_streams( Caller, Port, Bindings ) + ). jupyter_query(Caller, Cell, Line ) :- - jupyter_cell(Caller, Cell, Line). + jupyter_query( Caller, Cell, Line, _Bindings ). -jupyter_cell(_Caller, Cell, _Line) :- - jupyter_consult(Cell), %stack_dump, +next_streams( _Caller, exit, _Bindings ) :- +% Caller.answer := Bindings, + !. +next_streams( _Caller, answer, _Bindings ) :- +% Caller.answer := Bindings, + !. +next_streams(_, redo, _ ) :- + streams(true), + !. +next_streams( _, _, _ ) :- + streams(false). + + + +jupyter_cell(_Caller, Cell, _Line, _) :- + jupyter_consult(Cell), %stack_dump, fail. -jupyter_cell( _Caller, _, ¨¨ ) :- !. -jupyter_cell( _Caller, _, Line ) :- +jupyter_cell( _Caller, _, ¨¨ , _) :- !. +jupyter_cell( _Caller, _, Line , _) :- blank( Line ), !. -jupyter_cell(Caller, _, Line ) :- +jupyter_cell(Caller, _, Line, Bindings ) :- Query = Caller, catch( - python_query(Query,Line), + python_query(Query,Line, Bindings), error(A,B), system_error(A,B) ). @@ -58,6 +89,8 @@ restreams(!). restreams(external_exception(_)). restreams(exception). +%:- meta_predicate + jupyter_consult(Text) :- blank( Text ), !. @@ -89,7 +122,7 @@ blank(Text) :- maplist( code_type(space), L). - streams(false) :- +streams(false) :- close(user_input), close(user_output), close(user_error). diff --git a/packages/python/yap_kernel/yap_ipython/prolog/verify.yap b/packages/python/yap_kernel/yap_ipython/prolog/verify.yap index 93cad3f1b..164d236bf 100644 --- a/packages/python/yap_kernel/yap_ipython/prolog/verify.yap +++ b/packages/python/yap_kernel/yap_ipython/prolog/verify.yap @@ -16,7 +16,7 @@ :- use_module(library(lists)). :- use_module(library(maplist)). - :- use_module(library(python)). +%% :- use_module(library(python)). %% :- use_module(library(yapi)). :- dynamic jupyter/1. @@ -25,7 +25,7 @@ jupyter( []). ready( Engine, Query) :- errors( Engine , Query ), Es := Engine.errors, - not Es == []. + Es \== []. diff --git a/packages/python/yap_kernel/yap_ipython/terminal/console.py b/packages/python/yap_kernel/yap_ipython/terminal/console.py index a23337495..65571a757 100644 --- a/packages/python/yap_kernel/yap_ipython/terminal/console.py +++ b/packages/python/yap_kernel/yap_ipython/terminal/console.py @@ -1,19 +1,19 @@ """ -Shim to maintain backwards compatibility with old yap_ipython.terminal.console imports. +Shim to maintain backwards compatibility with old IPython.terminal.console imports. """ -# Copyright (c) yap_ipython Development Team. +# Copyright (c) IPython Development Team. # Distributed under the terms of the Modified BSD License. import sys from warnings import warn -from yap_ipython.utils.shimmodule import ShimModule, ShimWarning +from IPython.utils.shimmodule import ShimModule, ShimWarning -warn("The `yap_ipython.terminal.console` package has been deprecated since yap_ipython 4.0. " +warn("The `IPython.terminal.console` package has been deprecated since IPython 4.0. " "You should import from jupyter_console instead.", ShimWarning) # Unconditionally insert the shim into sys.modules so that further import calls # trigger the custom attribute access above -sys.modules['yap_ipython.terminal.console'] = ShimModule( - src='yap_ipython.terminal.console', mirror='jupyter_console') +sys.modules['IPython.terminal.console'] = ShimModule( + src='IPython.terminal.console', mirror='jupyter_console') diff --git a/packages/python/yap_kernel/yap_ipython/terminal/debugger.py b/packages/python/yap_kernel/yap_ipython/terminal/debugger.py index f3947aec2..45f509684 100644 --- a/packages/python/yap_kernel/yap_ipython/terminal/debugger.py +++ b/packages/python/yap_kernel/yap_ipython/terminal/debugger.py @@ -1,18 +1,18 @@ import signal import sys -from yap_ipython.core.debugger import Pdb +from IPython.core.debugger import Pdb -from yap_ipython.core.completer import IPCompleter +from IPython.core.completer import IPCompleter from .ptutils import IPythonPTCompleter from .shortcuts import suspend_to_bg, cursor_in_leading_ws from prompt_toolkit.enums import DEFAULT_BUFFER -from prompt_toolkit.filters import (Condition, HasFocus, HasSelection, - ViInsertMode, EmacsInsertMode) -from prompt_toolkit.keys import Keys -from prompt_toolkit.key_binding.manager import KeyBindingManager +from prompt_toolkit.filters import (Condition, has_focus, has_selection, + vi_insert_mode, emacs_insert_mode) +from prompt_toolkit.key_binding import KeyBindings from prompt_toolkit.key_binding.bindings.completion import display_completions_like_readline +from pygments.token import Token from prompt_toolkit.shortcuts.prompt import PromptSession from prompt_toolkit.enums import EditingMode from prompt_toolkit.formatted_text import PygmentsTokens @@ -58,6 +58,7 @@ class TerminalPdb(Pdb): complete_style=self.shell.pt_complete_style, style=self.shell.style, inputhook=self.shell.inputhook, + color_depth=self.shell.color_depth, ) def cmdloop(self, intro=None): @@ -107,7 +108,7 @@ def set_trace(frame=None): if __name__ == '__main__': import pdb - # yap_ipython.core.debugger.Pdb.trace_dispatch shall not catch + # IPython.core.debugger.Pdb.trace_dispatch shall not catch # bdb.BdbQuit. When started through __main__ and an exception # happened after hitting "c", this is needed in order to # be able to quit the debugging session (see #9950). diff --git a/packages/python/yap_kernel/yap_ipython/terminal/embed.py b/packages/python/yap_kernel/yap_ipython/terminal/embed.py index f9b8f575c..188844fad 100644 --- a/packages/python/yap_kernel/yap_ipython/terminal/embed.py +++ b/packages/python/yap_kernel/yap_ipython/terminal/embed.py @@ -1,27 +1,27 @@ # encoding: utf-8 """ -An embedded yap_ipython shell. +An embedded IPython shell. """ -# Copyright (c) yap_ipython Development Team. +# Copyright (c) IPython Development Team. # Distributed under the terms of the Modified BSD License. import sys import warnings -from yap_ipython.core import ultratb, compilerop -from yap_ipython.core import magic_arguments -from yap_ipython.core.magic import Magics, magics_class, line_magic -from yap_ipython.core.interactiveshell import DummyMod, InteractiveShell -from yap_ipython.terminal.interactiveshell import TerminalInteractiveShell -from yap_ipython.terminal.ipapp import load_default_config +from IPython.core import ultratb, compilerop +from IPython.core import magic_arguments +from IPython.core.magic import Magics, magics_class, line_magic +from IPython.core.interactiveshell import DummyMod, InteractiveShell +from IPython.terminal.interactiveshell import TerminalInteractiveShell +from IPython.terminal.ipapp import load_default_config from traitlets import Bool, CBool, Unicode -from yap_ipython.utils.io import ask_yes_no +from IPython.utils.io import ask_yes_no class KillEmbedded(Exception):pass -# kept for backward compatibility as yap_ipython 6 was released with +# kept for backward compatibility as IPython 6 was released with # the typo. See https://github.com/ipython/ipython/pull/10706 KillEmbeded = KillEmbedded @@ -38,10 +38,10 @@ class EmbeddedMagics(Magics): @magic_arguments.argument('-y', '--yes', action='store_true', help='Do not ask confirmation') def kill_embedded(self, parameter_s=''): - """%kill_embedded : deactivate for good the current embedded yap_ipython + """%kill_embedded : deactivate for good the current embedded IPython This function (after asking for confirmation) sets an internal flag so - that an embedded yap_ipython will never activate again for the given call + that an embedded IPython will never activate again for the given call location. This is useful to permanently disable a shell that is being called inside a loop: once you've figured out what you needed from it, you may then kill it and the program will then continue to run without @@ -59,7 +59,7 @@ class EmbeddedMagics(Magics): .. note:: - This was the default behavior before yap_ipython 5.2 + This was the default behavior before IPython 5.2 """ @@ -74,7 +74,7 @@ class EmbeddedMagics(Magics): kill = True if kill: self.shell._disable_init_location() - print("This embedded yap_ipython instance will not reactivate anymore " + print("This embedded IPython instance will not reactivate anymore " "once you exit.") else: if not args.yes: @@ -84,7 +84,7 @@ class EmbeddedMagics(Magics): kill = True if kill: self.shell.embedded_active = False - print("This embedded yap_ipython call location will not reactivate anymore " + print("This embedded IPython call location will not reactivate anymore " "once you exit.") if args.exit: @@ -97,9 +97,9 @@ class EmbeddedMagics(Magics): def exit_raise(self, parameter_s=''): """%exit_raise Make the current embedded kernel exit and raise and exception. - This function sets an internal flag so that an embedded yap_ipython will - raise a `yap_ipython.terminal.embed.KillEmbedded` Exception on exit, and then exit the current I. This is - useful to permanently exit a loop that create yap_ipython embed instance. + This function sets an internal flag so that an embedded IPython will + raise a `IPython.terminal.embed.KillEmbedded` Exception on exit, and then exit the current I. This is + useful to permanently exit a loop that create IPython embed instance. """ self.shell.should_raise = True @@ -148,7 +148,7 @@ class InteractiveShellEmbed(TerminalInteractiveShell): def __init__(self, **kw): if kw.get('user_global_ns', None) is not None: raise DeprecationWarning( - "Key word argument `user_global_ns` has been replaced by `user_module` since yap_ipython 4.0.") + "Key word argument `user_global_ns` has been replaced by `user_module` since IPython 4.0.") clid = kw.pop('_init_location_id', None) if not clid: @@ -166,7 +166,7 @@ class InteractiveShellEmbed(TerminalInteractiveShell): def init_sys_modules(self): """ - Explicitly overwrite :mod:`yap_ipython.core.interactiveshell` to do nothing. + Explicitly overwrite :mod:`IPython.core.interactiveshell` to do nothing. """ pass @@ -234,12 +234,12 @@ class InteractiveShellEmbed(TerminalInteractiveShell): print(self.exit_msg) if self.should_raise: - raise KillEmbedded('Embedded yap_ipython raising error, as user requested.') + raise KillEmbedded('Embedded IPython raising error, as user requested.') def mainloop(self, local_ns=None, module=None, stack_depth=0, display_banner=None, global_ns=None, compile_flags=None): - """Embeds yap_ipython into a running python program. + """Embeds IPython into a running python program. Parameters ---------- @@ -265,10 +265,10 @@ class InteractiveShellEmbed(TerminalInteractiveShell): """ if (global_ns is not None) and (module is None): - raise DeprecationWarning("'global_ns' keyword argument is deprecated, and has been removed in yap_ipython 5.0 use `module` keyword argument instead.") + raise DeprecationWarning("'global_ns' keyword argument is deprecated, and has been removed in IPython 5.0 use `module` keyword argument instead.") if (display_banner is not None): - warnings.warn("The display_banner parameter is deprecated since yap_ipython 4.0", DeprecationWarning) + warnings.warn("The display_banner parameter is deprecated since IPython 4.0", DeprecationWarning) # Get locals and globals from caller if ((local_ns is None or module is None or compile_flags is None) @@ -323,7 +323,7 @@ class InteractiveShellEmbed(TerminalInteractiveShell): with self.builtin_trap, self.display_trap: self.interact() - # now, purge out the local namespace of yap_ipython's hidden variables. + # now, purge out the local namespace of IPython's hidden variables. if local_ns is not None: local_ns.update({k: v for (k, v) in self.user_ns.items() if k not in self.user_ns_hidden.keys()}) @@ -335,7 +335,7 @@ class InteractiveShellEmbed(TerminalInteractiveShell): def embed(**kwargs): - """Call this to embed yap_ipython at the current point in your program. + """Call this to embed IPython at the current point in your program. The first invocation of this will create an :class:`InteractiveShellEmbed` instance and then call it. Consecutive calls just call the already @@ -343,12 +343,12 @@ def embed(**kwargs): If you don't want the kernel to initialize the namespace from the scope of the surrounding function, - and/or you want to load full yap_ipython configuration, - you probably want `yap_ipython.start_ipython()` instead. + and/or you want to load full IPython configuration, + you probably want `IPython.start_ipython()` instead. Here is a simple example:: - from yap_ipython import embed + from IPython import embed a = 10 b = 20 embed(header='First time') diff --git a/packages/python/yap_kernel/yap_ipython/terminal/interactiveshell.py b/packages/python/yap_kernel/yap_ipython/terminal/interactiveshell.py index 0b91f9555..be738f8f4 100644 --- a/packages/python/yap_kernel/yap_ipython/terminal/interactiveshell.py +++ b/packages/python/yap_kernel/yap_ipython/terminal/interactiveshell.py @@ -1,15 +1,15 @@ -"""yap_ipython terminal interface using prompt_toolkit""" +"""IPython terminal interface using prompt_toolkit""" import os import sys import warnings from warnings import warn -from yap_ipython.core.interactiveshell import InteractiveShell, InteractiveShellABC -from yap_ipython.utils import io -from yap_ipython.utils.py3compat import input -from yap_ipython.utils.terminal import toggle_set_term_title, set_term_title -from yap_ipython.utils.process import abbrev_cwd +from IPython.core.interactiveshell import InteractiveShell, InteractiveShellABC +from IPython.utils import io +from IPython.utils.py3compat import input +from IPython.utils.terminal import toggle_set_term_title, set_term_title +from IPython.utils.process import abbrev_cwd from traitlets import ( Bool, Unicode, Dict, Integer, observe, Instance, Type, default, Enum, Union, Any, validate @@ -98,8 +98,8 @@ class TerminalInteractiveShell(InteractiveShell): simple_prompt = Bool(_use_simple_prompt, help="""Use `raw_input` for the REPL, without completion and prompt colors. - Useful when controlling yap_ipython as a subprocess, and piping STDIN/OUT/ERR. Known usage are: - yap_ipython own testing machinery, and emacs inferior-shell integration through elpy. + Useful when controlling IPython as a subprocess, and piping STDIN/OUT/ERR. Known usage are: + IPython own testing machinery, and emacs inferior-shell integration through elpy. This mode default to `True` if the `IPY_TEST_SIMPLE_PROMPT` environment variable is set, or the current terminal is not a tty.""" @@ -111,7 +111,7 @@ class TerminalInteractiveShell(InteractiveShell): confirm_exit = Bool(True, help=""" - Set to confirm when you try to exit yap_ipython with an EOF (Control-D + Set to confirm when you try to exit IPython with an EOF (Control-D in Unix, Control-Z/Enter in Windows). By typing 'exit' or 'quit', you can force a direct exit without any confirmation.""", ).tag(config=True) @@ -147,7 +147,8 @@ class TerminalInteractiveShell(InteractiveShell): @observe('editing_mode') def _editing_mode(self, change): u_mode = change.new.upper() - self.pt_app.editing_mode = u_mode + if self.pt_app: + self.pt_app.editing_mode = u_mode @observe('highlighting_style') @observe('colors') @@ -170,7 +171,7 @@ class TerminalInteractiveShell(InteractiveShell): ).tag(config=True) editor = Unicode(get_default_editor(), - help="Set the editor used by yap_ipython (default to $EDITOR/vi/notepad)." + help="Set the editor used by IPython (default to $EDITOR/vi/notepad)." ).tag(config=True) prompts_class = Type(Prompts, help='Class used to generate Prompt token for prompt_toolkit').tag(config=True) @@ -193,7 +194,7 @@ class TerminalInteractiveShell(InteractiveShell): help="Automatically set the terminal title" ).tag(config=True) - term_title_format = Unicode("yap_ipython: {cwd}", + term_title_format = Unicode("IPython: {cwd}", help="Customize the terminal title format. This is a python format string. " + "Available substitutions are: {cwd}." ).tag(config=True) @@ -224,6 +225,10 @@ class TerminalInteractiveShell(InteractiveShell): help="Allows to enable/disable the prompt toolkit history search" ).tag(config=True) + prompt_includes_vi_mode = Bool(True, + help="Display the current vi mode (when using vi editing mode)." + ).tag(config=True) + @observe('term_title') def init_term_title(self, change=None): # Enable or disable the terminal title. @@ -257,7 +262,7 @@ class TerminalInteractiveShell(InteractiveShell): # Set up keyboard shortcuts key_bindings = create_ipython_shortcuts(self) - # Pre-populate history from yap_ipython's history database + # Pre-populate history from IPython's history database history = InMemoryHistory() last_cell = u"" for __, ___, cell in self.history_manager.get_tail(self.history_load_length, @@ -283,12 +288,12 @@ class TerminalInteractiveShell(InteractiveShell): include_default_pygments_style=False, mouse_support=self.mouse_support, enable_open_in_editor=self.extra_open_editor_shortcuts, - color_depth=(ColorDepth.TRUE_COLOR if self.true_color else None), + color_depth=self.color_depth, **self._extra_prompt_options()) def _make_style_from_name_or_cls(self, name_or_cls): """ - Small wrapper that make an yap_ipython compatible style from a style name + Small wrapper that make an IPython compatible style from a style name We need that to add style for prompt ... etc. """ @@ -360,6 +365,10 @@ class TerminalInteractiveShell(InteractiveShell): 'readlinelike': CompleteStyle.READLINE_LIKE, }[self.display_completions] + @property + def color_depth(self): + return (ColorDepth.TRUE_COLOR if self.true_color else None) + def _extra_prompt_options(self): """ Return the current layout option for the current Terminal InteractiveShell @@ -442,7 +451,7 @@ class TerminalInteractiveShell(InteractiveShell): # need direct access to the console in a way that we can't emulate in # GUI or web frontend if os.name == 'posix': - for cmd in ['clear', 'more', 'less', 'man']: + for cmd in ('clear', 'more', 'less', 'man'): self.alias_manager.soft_define_alias(cmd, cmd) @@ -462,7 +471,7 @@ class TerminalInteractiveShell(InteractiveShell): def interact(self, display_banner=DISPLAY_BANNER_DEPRECATED): if display_banner is not DISPLAY_BANNER_DEPRECATED: - warn('interact `display_banner` argument is deprecated since yap_ipython 5.0. Call `show_banner()` if needed.', DeprecationWarning, stacklevel=2) + warn('interact `display_banner` argument is deprecated since IPython 5.0. Call `show_banner()` if needed.', DeprecationWarning, stacklevel=2) self.keep_running = True while self.keep_running: diff --git a/packages/python/yap_kernel/yap_ipython/terminal/ipapp.py b/packages/python/yap_kernel/yap_ipython/terminal/ipapp.py index 1fa0b434a..defe3e79f 100755 --- a/packages/python/yap_kernel/yap_ipython/terminal/ipapp.py +++ b/packages/python/yap_kernel/yap_ipython/terminal/ipapp.py @@ -1,11 +1,11 @@ #!/usr/bin/env python # encoding: utf-8 """ -The :class:`~yap_ipython.core.application.Application` object for the command +The :class:`~IPython.core.application.Application` object for the command line :command:`ipython` program. """ -# Copyright (c) yap_ipython Development Team. +# Copyright (c) IPython Development Team. # Distributed under the terms of the Modified BSD License. @@ -16,24 +16,24 @@ import warnings from traitlets.config.loader import Config from traitlets.config.application import boolean_flag, catch_config_error -from yap_ipython.core import release -from yap_ipython.core import usage -from yap_ipython.core.completer import IPCompleter -from yap_ipython.core.crashhandler import CrashHandler -from yap_ipython.core.formatters import PlainTextFormatter -from yap_ipython.core.history import HistoryManager -from yap_ipython.core.application import ( - ProfileDir, BaseYAPApplication, base_flags, base_aliases +from IPython.core import release +from IPython.core import usage +from IPython.core.completer import IPCompleter +from IPython.core.crashhandler import CrashHandler +from IPython.core.formatters import PlainTextFormatter +from IPython.core.history import HistoryManager +from IPython.core.application import ( + ProfileDir, BaseIPythonApplication, base_flags, base_aliases ) -from yap_ipython.core.magics import ( +from IPython.core.magics import ( ScriptMagics, LoggingMagics ) -from yap_ipython.core.shellapp import ( +from IPython.core.shellapp import ( InteractiveShellApp, shell_flags, shell_aliases ) -from yap_ipython.extensions.storemagic import StoreMagics +from IPython.extensions.storemagic import StoreMagics from .interactiveshell import TerminalInteractiveShell -from yap_ipython.paths import get_ipython_dir +from IPython.paths import get_ipython_dir from traitlets import ( Bool, List, default, observe, Type ) @@ -52,7 +52,7 @@ ipython --profile=foo # start with profile foo ipython profile create foo # create profile foo w/ default config files ipython help profile # show the help for the profile subcmd -ipython locate # print the path to the yap_ipython directory +ipython locate # print the path to the IPython directory ipython locate profile foo # print the path to the directory for profile `foo` """ @@ -61,7 +61,7 @@ ipython locate profile foo # print the path to the directory for profile `foo` #----------------------------------------------------------------------------- class IPAppCrashHandler(CrashHandler): - """sys.excepthook for yap_ipython itself, leaves a detailed report on disk.""" + """sys.excepthook for IPython itself, leaves a detailed report on disk.""" def __init__(self, app): contact_name = release.author @@ -106,12 +106,12 @@ addflag('simple-prompt', 'TerminalInteractiveShell.simple_prompt', "Use a rich interactive prompt with prompt_toolkit", ) -addflag('banner', 'Terminalyap_ipythonApp.display_banner', - "Display a banner upon starting yap_ipython.", - "Don't display a banner upon starting yap_ipython." +addflag('banner', 'TerminalIPythonApp.display_banner', + "Display a banner upon starting IPython.", + "Don't display a banner upon starting IPython." ) addflag('confirm-exit', 'TerminalInteractiveShell.confirm_exit', - """Set to confirm when you try to exit yap_ipython with an EOF (Control-D + """Set to confirm when you try to exit IPython with an EOF (Control-D in Unix, Control-Z/Enter in Windows). By typing 'exit' or 'quit', you can force a direct exit without any confirmation.""", "Don't prompt the user when exiting." @@ -123,7 +123,7 @@ addflag('term-title', 'TerminalInteractiveShell.term_title', classic_config = Config() classic_config.InteractiveShell.cache_size = 0 classic_config.PlainTextFormatter.pprint = False -classic_config.TerminalInteractiveShell.prompts_class='yap_ipython.terminal.prompts.ClassicPrompts' +classic_config.TerminalInteractiveShell.prompts_class='IPython.terminal.prompts.ClassicPrompts' classic_config.InteractiveShell.separate_in = '' classic_config.InteractiveShell.separate_out = '' classic_config.InteractiveShell.separate_out2 = '' @@ -132,7 +132,7 @@ classic_config.InteractiveShell.xmode = 'Plain' frontend_flags['classic']=( classic_config, - "Gives yap_ipython a similar feel to the classic Python prompt." + "Gives IPython a similar feel to the classic Python prompt." ) # # log doesn't make so much sense this way anymore # paa('--log','-l', @@ -141,12 +141,12 @@ frontend_flags['classic']=( # # # quick is harder to implement frontend_flags['quick']=( - {'Terminalyap_ipythonApp' : {'quick' : True}}, + {'TerminalIPythonApp' : {'quick' : True}}, "Enable quick startup with no config files." ) frontend_flags['i'] = ( - {'Terminalyap_ipythonApp' : {'force_interact' : True}}, + {'TerminalIPythonApp' : {'force_interact' : True}}, """If running code from the command line, become interactive afterwards. It is often useful to follow this with `--` to treat remaining flags as script arguments. @@ -162,11 +162,11 @@ aliases.update(shell_aliases) #----------------------------------------------------------------------------- -class Locateyap_ipythonApp(BaseYAPApplication): - description = """print the path to the yap_ipython dir""" +class LocateIPythonApp(BaseIPythonApplication): + description = """print the path to the IPython dir""" subcommands = dict( - profile=('yap_ipython.core.profileapp.ProfileLocate', - "print the path to an yap_ipython profile directory", + profile=('IPython.core.profileapp.ProfileLocate', + "print the path to an IPython profile directory", ), ) def start(self): @@ -176,7 +176,7 @@ class Locateyap_ipythonApp(BaseYAPApplication): print(self.ipython_dir) -class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp): +class TerminalIPythonApp(BaseIPythonApplication, InteractiveShellApp): name = u'ipython' description = usage.cl_usage crash_handler_class = IPAppCrashHandler @@ -194,7 +194,7 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp): @default('classes') def _classes_default(self): - """This has to be in a method, for Terminalyap_ipythonApp to be available.""" + """This has to be in a method, for TerminalIPythonApp to be available.""" return [ InteractiveShellApp, # ShellApp comes before TerminalApp, because self.__class__, # it will also affect subclasses (e.g. QtConsole) @@ -210,41 +210,41 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp): deprecated_subcommands = dict( qtconsole=('qtconsole.qtconsoleapp.JupyterQtConsoleApp', - """DEPRECATED, Will be removed in yap_ipython 6.0 : Launch the Jupyter Qt Console.""" + """DEPRECATED, Will be removed in IPython 6.0 : Launch the Jupyter Qt Console.""" ), notebook=('notebook.notebookapp.NotebookApp', - """DEPRECATED, Will be removed in yap_ipython 6.0 : Launch the Jupyter HTML Notebook Server.""" + """DEPRECATED, Will be removed in IPython 6.0 : Launch the Jupyter HTML Notebook Server.""" ), - console=('jupyter_console.app.ZMQTerminalyap_ipythonApp', - """DEPRECATED, Will be removed in yap_ipython 6.0 : Launch the Jupyter terminal-based Console.""" + console=('jupyter_console.app.ZMQTerminalIPythonApp', + """DEPRECATED, Will be removed in IPython 6.0 : Launch the Jupyter terminal-based Console.""" ), nbconvert=('nbconvert.nbconvertapp.NbConvertApp', - "DEPRECATED, Will be removed in yap_ipython 6.0 : Convert notebooks to/from other formats." + "DEPRECATED, Will be removed in IPython 6.0 : Convert notebooks to/from other formats." ), trust=('nbformat.sign.TrustNotebookApp', - "DEPRECATED, Will be removed in yap_ipython 6.0 : Sign notebooks to trust their potentially unsafe contents at load." + "DEPRECATED, Will be removed in IPython 6.0 : Sign notebooks to trust their potentially unsafe contents at load." ), kernelspec=('jupyter_client.kernelspecapp.KernelSpecApp', - "DEPRECATED, Will be removed in yap_ipython 6.0 : Manage Jupyter kernel specifications." + "DEPRECATED, Will be removed in IPython 6.0 : Manage Jupyter kernel specifications." ), ) subcommands = dict( - profile = ("yap_ipython.core.profileapp.ProfileApp", - "Create and manage yap_ipython profiles." + profile = ("IPython.core.profileapp.ProfileApp", + "Create and manage IPython profiles." ), kernel = ("ipykernel.kernelapp.IPKernelApp", "Start a kernel without an attached frontend." ), - locate=('yap_ipython.terminal.ipapp.Locateyap_ipythonApp', - Locateyap_ipythonApp.description + locate=('IPython.terminal.ipapp.LocateIPythonApp', + LocateIPythonApp.description ), - history=('yap_ipython.core.historyapp.HistoryApp', - "Manage the yap_ipython history database." + history=('IPython.core.historyapp.HistoryApp', + "Manage the IPython history database." ), ) deprecated_subcommands['install-nbextension'] = ( "notebook.nbextensions.InstallNBExtensionApp", - "DEPRECATED, Will be removed in yap_ipython 6.0 : Install Jupyter notebook extension files" + "DEPRECATED, Will be removed in IPython 6.0 : Install Jupyter notebook extension files" ) subcommands.update(deprecated_subcommands) @@ -252,7 +252,7 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp): auto_create=Bool(True) # configurables quick = Bool(False, - help="""Start yap_ipython quickly by skipping the loading of config files.""" + help="""Start IPython quickly by skipping the loading of config files.""" ).tag(config=True) @observe('quick') def _quick_changed(self, change): @@ -260,7 +260,7 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp): self.load_config_file = lambda *a, **kw: None display_banner = Bool(True, - help="Whether to display a banner upon starting yap_ipython." + help="Whether to display a banner upon starting IPython." ).tag(config=True) # if there is code of files to run from the cmd line, don't interact @@ -300,12 +300,12 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp): " Use `--matplotlib ` and import pylab manually.") argv[idx] = '--pylab' - return super(Terminalyap_ipythonApp, self).parse_command_line(argv) + return super(TerminalIPythonApp, self).parse_command_line(argv) @catch_config_error def initialize(self, argv=None): """Do actions after construct, but before starting the app.""" - super(Terminalyap_ipythonApp, self).initialize(argv) + super(TerminalIPythonApp, self).initialize(argv) if self.subapp is not None: # don't bother initializing further, starting subapp return @@ -352,10 +352,10 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp): return self.subapp.start() # perform any prexec steps: if self.interact: - self.log.debug("Starting yap_ipython's mainloop...") + self.log.debug("Starting IPython's mainloop...") self.shell.mainloop() else: - self.log.debug("yap_ipython not interactive...") + self.log.debug("IPython not interactive...") if not self.shell.last_execution_succeeded: sys.exit(1) @@ -368,12 +368,12 @@ def load_default_config(ipython_dir=None): ipython_dir = get_ipython_dir() profile_dir = os.path.join(ipython_dir, 'profile_default') - app = Terminalyap_ipythonApp() + app = TerminalIPythonApp() app.config_file_paths.append(profile_dir) app.load_config_file() return app.config -launch_new_instance = Terminalyap_ipythonApp.launch_instance +launch_new_instance = TerminalIPythonApp.launch_instance if __name__ == '__main__': diff --git a/packages/python/yap_kernel/yap_ipython/terminal/magics.py b/packages/python/yap_kernel/yap_ipython/terminal/magics.py index dd8dfea8f..3c7e82b45 100644 --- a/packages/python/yap_kernel/yap_ipython/terminal/magics.py +++ b/packages/python/yap_kernel/yap_ipython/terminal/magics.py @@ -1,6 +1,6 @@ """Extra magics for terminal use.""" -# Copyright (c) yap_ipython Development Team. +# Copyright (c) IPython Development Team. # Distributed under the terms of the Modified BSD License. @@ -8,11 +8,11 @@ from logging import error import os import sys -from yap_ipython.core.error import TryNext, UsageError -from yap_ipython.core.magic import Magics, magics_class, line_magic -from yap_ipython.lib.clipboard import ClipboardEmpty -from yap_ipython.utils.text import SList, strip_email_quotes -from yap_ipython.utils import py3compat +from IPython.core.error import TryNext, UsageError +from IPython.core.magic import Magics, magics_class, line_magic +from IPython.lib.clipboard import ClipboardEmpty +from IPython.utils.text import SList, strip_email_quotes +from IPython.utils import py3compat def get_pasted_lines(sentinel, l_input=py3compat.input, quiet=False): """ Yield pasted lines until the user enters the given sentinel value. @@ -109,7 +109,7 @@ class TerminalMagics(Magics): Just press enter and type -- (and press enter again) and the block will be what was just pasted. - yap_ipython statements (magics, shell escapes) are not supported (yet). + IPython statements (magics, shell escapes) are not supported (yet). See also -------- @@ -162,7 +162,7 @@ class TerminalMagics(Magics): -q: quiet mode: do not echo the pasted text back to the terminal. - yap_ipython statements (magics, shell escapes) are not supported (yet). + IPython statements (magics, shell escapes) are not supported (yet). See also -------- diff --git a/packages/python/yap_kernel/yap_ipython/terminal/prompts.py b/packages/python/yap_kernel/yap_ipython/terminal/prompts.py index 35fb7a427..1a7563bda 100644 --- a/packages/python/yap_kernel/yap_ipython/terminal/prompts.py +++ b/packages/python/yap_kernel/yap_ipython/terminal/prompts.py @@ -3,7 +3,7 @@ from pygments.token import Token import sys -from yap_ipython.core.displayhook import DisplayHook +from IPython.core.displayhook import DisplayHook from prompt_toolkit.formatted_text import fragment_list_width, PygmentsTokens from prompt_toolkit.shortcuts import print_formatted_text @@ -14,9 +14,8 @@ class Prompts(object): self.shell = shell def vi_mode(self): - if not hasattr(self.shell.pt_app, 'editing_mode'): - return '' - if self.shell.pt_app.editing_mode == 'VI': + if (getattr(self.shell.pt_app, 'editing_mode', None) == 'VI' + and self.shell.prompt_includes_vi_mode): return '['+str(self.shell.pt_app.app.vi_state.input_mode)[3:6]+'] ' return '' diff --git a/packages/python/yap_kernel/yap_ipython/terminal/ptutils.py b/packages/python/yap_kernel/yap_ipython/terminal/ptutils.py index f7367526b..4f21cb04e 100644 --- a/packages/python/yap_kernel/yap_ipython/terminal/ptutils.py +++ b/packages/python/yap_kernel/yap_ipython/terminal/ptutils.py @@ -19,12 +19,16 @@ from prompt_toolkit.lexers import PygmentsLexer from prompt_toolkit.patch_stdout import patch_stdout import pygments.lexers as pygments_lexers +import os _completion_sentinel = object() def _elide(string, *, min_elide=30): """ - If a string is long enough, and has at least 2 dots, + If a string is long enough, and has at least 3 dots, + replace the middle part with ellipses. + + If a string naming a file is long enough, and has at least 3 slashes, replace the middle part with ellipses. If three consecutive dots, or two consecutive dots are encountered these are @@ -36,16 +40,20 @@ def _elide(string, *, min_elide=30): if len(string) < min_elide: return string - parts = string.split('.') + object_parts = string.split('.') + file_parts = string.split(os.sep) - if len(parts) <= 3: - return string + if len(object_parts) > 3: + return '{}.{}\N{HORIZONTAL ELLIPSIS}{}.{}'.format(object_parts[0], object_parts[1][0], object_parts[-2][-1], object_parts[-1]) - return '{}.{}\N{HORIZONTAL ELLIPSIS}{}.{}'.format(parts[0], parts[1][0], parts[-2][-1], parts[-1]) + elif len(file_parts) > 3: + return ('{}' + os.sep + '{}\N{HORIZONTAL ELLIPSIS}{}' + os.sep + '{}').format(file_parts[0], file_parts[1][0], file_parts[-2][-1], file_parts[-1]) + + return string def _adjust_completion_text_based_on_context(text, body, offset): - if text.endswith('=') and len(body) > offset and body[offset] is '=': + if text.endswith('=') and len(body) > offset and body[offset] == '=': return text[:-1] else: return text diff --git a/packages/python/yap_kernel/yap_ipython/yapi.py b/packages/python/yap_kernel/yap_ipython/yapi.py index bfd9af7e9..8623a54e2 100644 --- a/packages/python/yap_kernel/yap_ipython/yapi.py +++ b/packages/python/yap_kernel/yap_ipython/yapi.py @@ -17,6 +17,9 @@ from IPython.core.inputtransformer import * from IPython.core.interactiveshell import * from ipython_genutils.py3compat import builtin_mod +import copy +import json + from yap_kernel.displayhook import ZMQShellDisplayHook import traceback @@ -229,6 +232,7 @@ class YAPInputSplitter(InputSplitter): transformed_lines_list.append(transformed) if transformed_lines_list: transformed_lines = '\n'.join(transformed_lines_list) + else: # Got nothing back from transformers - they must be waiting for # more input. @@ -542,7 +546,7 @@ class YAPRun(InteractiveShell): # construct a self.queryuery from a one-line string # self.query is opaque to Python try: - program,squery,_ ,howmany = self.prolog_cell(s) + program,squery,_ ,howmany = self.prolog_cell(s) # sys.settrace(tracefunc) if self.query and self.os == (program,squery): howmany += self.iterations @@ -551,22 +555,29 @@ class YAPRun(InteractiveShell): self.query.close() self.query = None self.answers = [] + result.result = [] self.os = (program,squery) self.iterations = 0 pg = jupyter_query(self.engine,program,squery) self.query = Query(self.engine, pg) self.answers = [] for answer in self.query: - self.answers += [answer] + print( answer ) + self.answers += [copy.deepcopy(answer)] self.iterations += 1 self.os = None self.query.close() self.query = None if self.answers: - sys.stderr.write('Completed, with '+str(self.answers)+'\n') - result.result = self.answers + sys.stderr.write('\n'+'[ ' +str(len(self.answers))+' answer(s): ]\n[ ') + print( self.answers ) + result.result = json.dumps(self.answers) + sys.stderr.write(result.result+' ]\n\n') + else: + result.result = [] return result.result + except Exception as e: sys.stderr.write('Exception '+str(e)+'in query '+ str(self.query)+ diff --git a/pl/debug.yap b/pl/debug.yap index cc6abede9..e66816119 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -444,11 +444,10 @@ be lost. '$trace_plan'((A|B), M, CP, S, (EA|EB)) :- !, '$trace_plan'(A, M, CP, S, EA), '$trace_plan'(B, M, CP, S, EB). - '$trace_plan'(C, M, CP, S, EC), -'$trace_plan'((A->*B), M, CP, S, (EA->EB)) :- !, +'$trace_plan'((A*->B), M, CP, S, (EA->EB)) :- !, '$trace_plan'(A, M, CP, S, EA), '$trace_plan'(B, M, CP, S, EB). -'$trace_plan'((A->*B;C), M, CP, S, (EA->EB;EC)) :- !, +'$trace_plan'((A*->B;C), M, CP, S, (EA->EB;EC)) :- !, '$trace_plan'(A, M, CP, S, EA), '$trace_plan'(B, M, CP, S, EB), '$trace_plan'(C, M, CP, S, EC). @@ -473,7 +472,7 @@ be lost. %% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo) %% -%% Actuallb sy debugs a +%% Actually debugs a %% goal! '$trace_goal'(G, M, GoalNumber, _H) :- ( diff --git a/pl/imports.yap b/pl/imports.yap index 6ed6b00c3..9dc3433d3 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -26,7 +26,7 @@ debug import table mimp :- recorded('$import',I,_), %'$import'(ExportingMod,ImportingMod,G0,G,_,_),_), -writeln(I), + writeln(I), %(ImportingMod:G :- ExportingMod:G0)), fail. @@ -39,7 +39,7 @@ fail. true ; %% this should have been caught before - '$is_system_predicate'(G, prolog) + '$is_system_predicate'(G, ImportingMod) -> true ; @@ -113,7 +113,7 @@ fail. '$autoloader_find_predicate'(G0,ExportingMod), ExportingMod \= ImportingMod, (recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_), - \+ '$system_predicate'(G0,prolog) + \+ '$is_system_predicate'(G0, ExportingMod) -> '$compile'((G:-ExportingMod:G0), reconsult ,(ImportingMod:G:-ExportingMod:G0), ImportingMod, _) ; @@ -133,7 +133,7 @@ fail. yap_flag(autoload, _, true), yap_flag( unknown, _, Unknown), yap_flag( debug, _, Debug), - autoloader:find_predicate(G,ExportingMod). + setup_autoloader:find_predicate(G,ExportingMod). diff --git a/pl/messages.yap b/pl/messages.yap index cc0124eb7..d14f2524f 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -133,7 +133,7 @@ prolog:message_to_string(Event, Message) :- % to source-location. Note that syntax errors have their own % source-location and should therefore not be handled this way. compose_message( Term, _Level ) --> - message(Term), !. + message(Term), !. compose_message( query(_QueryResult,_), _Level) --> []. compose_message( absolute_file_path(File), _Level) --> @@ -426,14 +426,17 @@ extra_info( error(_,Info), _ ) --> { '$error_descriptor'(Info, Desc) }, { query_exception(errorMsg, Desc, Msg), + Msg \= '', + Msg \= "", Msg \= [] - }, + }, !, ['~*|user provided data is: ~q' - [10,Msg]], [nl]. extra_info( _, _ ) --> []. +stack_info( _, _ ) --> !. stack_info( error(_,Info), _ ) --> { '$error_descriptor'(Info, Desc) }, { diff --git a/pl/protect.yap b/pl/protect.yap index 2522dc6bd..e0b111467 100755 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -1,4 +1,4 @@ -/************************************************************************* + /************************************************************************* * * * YAP Prolog * * * @@ -57,9 +57,17 @@ prolog:'$protect' :- \+ '$visible'(Name), hide_atom(Name), fail. + +prolog:'$protect' :- + recorded('$module','$module'(_F,_DonorM,_SourceF, _AllExports, _Line), R),erase(R), fail. +prolog:'$protect' :- + recorded('$source_file','$source_file'( _F, _Age, _M), R),erase(R), fail. +prolog:'$protect' :- + recorded('$lf_loaded','$lf_loaded'( _F, _M, _Reconsult, _UserFile, _OldF, _Line, _Opts), R),erase(R), fail. + prolog:'$protect'. - +/* % hide all atoms who start by '$' '$visible'('$'). /* not $VAR */ '$visible'('$VAR'). /* not $VAR */ diff --git a/pl/top.yap b/pl/top.yap index 3f84a9c56..a318890c5 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -743,13 +743,13 @@ write_query_answer( Bindings ) :- prolog_flag(agc_margin,_,Old), !. '$loop'(Stream,Status) :- - repeat, - '$current_module'( OldModule, OldModule ), - '$system_catch'( '$enter_command'(Stream,OldModule,Status), + repeat, + '$current_module'( OldModule, OldModule ), + '$system_catch'( '$enter_command'(Stream,OldModule,Status), OldModule, Error, - user:'$LoopError'(Error, Status) + user:'$LoopError'(Error, Status) ), - !. + !. '$boot_loop'(Stream,Where) :- repeat, @@ -806,7 +806,7 @@ Command = (H --> B) -> ; read_clause(Stream, Command, Options) ), - '$command'(Command,Vars,Pos, Status). + '$command'(Command,Vars,Pos, Status) . /** @pred user:expand_term( _T_,- _X_) is dynamic,multifile. From facf7ae8cda0185af7fbed99752cbbafdcc3c9ab Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 27 Feb 2019 11:04:32 +0000 Subject: [PATCH 062/101] small patches --- C/adtdefs.c | 4 +++ C/cdmgr.c | 40 +++++++++++++--------------- os/alias.c | 5 ++-- os/streams.c | 1 + packages/python/swig/prolog/yapi.yap | 1 + pl/messages.yap | 4 ++- 6 files changed, 30 insertions(+), 25 deletions(-) diff --git a/C/adtdefs.c b/C/adtdefs.c index 87ea9c6b4..064f02421 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -1296,6 +1296,10 @@ Atom Yap_LookupAtomWithLength(const char *atom, at = NameOfFunctor(pe->FunctorOfPred); } } + if (mods == PROLOG_MODULE || mods == USER_MODULE) + snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "%s/" UInt_FORMAT, + RepAtom(at)->StrOfAE, arity); + else snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "%s:%s/" UInt_FORMAT, mods, RepAtom(at)->StrOfAE, arity); return LOCAL_FileNameBuf; diff --git a/C/cdmgr.c b/C/cdmgr.c index 89534376d..d7cefa454 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -349,7 +349,7 @@ static void split_megaclause(PredEntry *ap) { mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause); if (mcl->ClFlags & ExoMask) { - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, TermNil, + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule,ap), "while deleting clause from exo predicate %s/%d\n", RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE); @@ -1465,34 +1465,30 @@ static int not_was_reconsulted(PredEntry *p, Term t, int mode) { } static yamop *addcl_permission_error(const char *file, const char *function, - int lineno, AtomEntry *ap, Int Arity, + int lineno, PredEntry *ap, int in_use) { CACHE_REGS - Term culprit; - if (Arity == 0) - culprit = MkAtomTerm(AbsAtom(ap)); - else - culprit = Yap_MkNewApplTerm(Yap_MkFunctor(AbsAtom(ap), Arity), Arity); - return (in_use - ? (Arity == 0 + Term culprit = Yap_PredicateIndicator(CurrentModule, ap); + return in_use + ? (ap->ArityOfPE == 0 ? Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit, "static predicate %s is in use", - ap->StrOfAE) + NameOfPred(ap)->StrOfAE) : Yap_Error__( false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit, "static predicate %s/" Int_FORMAT " is in use", - ap->StrOfAE, Arity)) - : (Arity == 0 + NameOfPred(ap), ap->ArityOfPE)) + : (ap->ArityOfPE == 0 ? Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit, "system predicate %s is in use", - ap->StrOfAE) + NameOfPred(ap)->StrOfAE) : Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit, "system predicate %s/" Int_FORMAT, - ap->StrOfAE, Arity))); + NameOfPred(ap)->StrOfAE, ap->ArityOfPE)); } PredEntry *Yap_PredFromClause(Term t USES_REGS) { @@ -1752,7 +1748,7 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref) PELOCK(20, p); /* we are redefining a prolog module predicate */ if (Yap_constPred(p)) { - addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), Arity, + addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, p, FALSE); UNLOCKPE(30, p); return false; @@ -2189,7 +2185,7 @@ static Int p_purge_clauses(USES_REGS1) { /* '$purge_clauses'(+Func) */ PELOCK(21, pred); if (pred->PredFlags & StandardPredFlag) { UNLOCKPE(33, pred); - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, t, "assert/1"); + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, pred), "assert/1"); return (FALSE); } purge_clauses(pred); @@ -2452,13 +2448,13 @@ static Int new_multifile(USES_REGS1) { } if (pe->PredFlags & (TabledPredFlag | ForeignPredFlags)) { UNLOCKPE(26, pe); - addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, + addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe, FALSE); return false; } if (pe->cs.p_code.NOfClauses) { UNLOCKPE(26, pe); - addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, + addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe, FALSE); return false; } @@ -2693,7 +2689,7 @@ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */ (UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag | TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) { UNLOCKPE(30, pe); - addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, + addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe, FALSE); return false; } @@ -2707,7 +2703,7 @@ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */ } if (pe->cs.p_code.NOfClauses != 0) { UNLOCKPE(26, pe); - addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, + addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe, FALSE); return false; } @@ -2758,7 +2754,7 @@ static Int new_meta_pred(USES_REGS1) { } if (pe->cs.p_code.NOfClauses) { UNLOCKPE(26, pe); - addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, + addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe, FALSE); return false; } @@ -4106,7 +4102,7 @@ static Int | TabledPredFlag #endif /* TABLING */ )) { - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, t, + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, ap), "dbload_get_space/4"); return FALSE; } diff --git a/os/alias.c b/os/alias.c index b03f86fd4..d3d72f31e 100644 --- a/os/alias.c +++ b/os/alias.c @@ -346,11 +346,12 @@ Yap_FindStreamForAlias (Atom al) while (aliasp < aliasp_max) { if (aliasp->name == al) { - return aliasp->alias_stream; + return aliasp->alias_stream > 0; } aliasp++; } - return true; + LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM; + return false; } /* create a new alias arg for stream sno */ diff --git a/os/streams.c b/os/streams.c index dff198cbe..1173e66c6 100644 --- a/os/streams.c +++ b/os/streams.c @@ -783,6 +783,7 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */ "current_stream/3"); if (i < 0) { UNLOCK(GLOBAL_Stream[i].streamlock); + Yap_ThrowError(LOCAL_Error_TYPE, t1, "bad stream descriptor"); return false; // error... } EXTRA_CBACK_ARG(2, 1) = MkIntTerm(i); diff --git a/packages/python/swig/prolog/yapi.yap b/packages/python/swig/prolog/yapi.yap index 1ad5649d1..baf97b55a 100644 --- a/packages/python/swig/prolog/yapi.yap +++ b/packages/python/swig/prolog/yapi.yap @@ -79,6 +79,7 @@ python_query( Caller, String, Bindings ) :- output(Caller, Bindings). output( Caller, Bindings ) :- +fail, Answer := {}, % start_low_level_trace, foldl(ground_dict(answer), Bindings, [], Ts), diff --git a/pl/messages.yap b/pl/messages.yap index d14f2524f..6d5418555 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -1045,7 +1045,9 @@ prolog:print_message(Severity, Msg) :- !. prolog:print_message(Level, _Msg) :- current_prolog_flag(verbose_load, false), - prolog_load_context(file, _FileName), + '$show_consult_level'(LC), + LC > 0, + Level \= error, Level \= warning, !. prolog:print_message(Level, _Msg) :- From 8d30742d8f6ac194867aaf858df105e3239ca500 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 27 Feb 2019 15:54:20 +0000 Subject: [PATCH 063/101] warnings --- C/cdmgr.c | 53 ++++++------------------------------------------ C/exec.c | 29 ++++++++++++++++++++++---- C/index.c | 2 +- H/YapGFlagInfo.h | 2 +- H/Yapproto.h | 3 ++- 5 files changed, 35 insertions(+), 54 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index d7cefa454..f0165550d 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -120,48 +120,7 @@ bool Yap_Consulting(USES_REGS1) { * assertz are supported for static predicates no database predicates are * supportted for fast predicates */ -PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) { - Term t0 = t; - -restart: - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t0, pname); - return NULL; - } else if (IsAtomTerm(t)) { - PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod)); - return ap; - } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { - return Yap_FindLUIntKey(IntegerOfTerm(t)); - } else if (IsPairTerm(t)) { - t = Yap_MkApplTerm(FunctorCsult, 1, &t); - goto restart; - } else if (IsApplTerm(t)) { - Functor fun = FunctorOfTerm(t); - if (IsExtensionFunctor(fun)) { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); - return NULL; - } - if (fun == FunctorModule) { - Term tmod = ArgOfTerm(1, t); - if (IsVarTerm(tmod)) { - Yap_Error(INSTANTIATION_ERROR, t0, pname); - return NULL; - } - if (!IsAtomTerm(tmod)) { - Yap_Error(TYPE_ERROR_ATOM, t0, pname); - return NULL; - } - t = ArgOfTerm(2, t); - goto restart; - } - PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod)); - return ap; - } else { - Yap_Error(TYPE_ERROR_CALLABLE, t0, pname); - } - return NULL; -} - +1 /** Look for a predicate with same functor as t, create a new one of it cannot find it. */ @@ -179,7 +138,7 @@ restart: } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); + Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname); return NULL; } if (fun == FunctorModule) { @@ -349,7 +308,7 @@ static void split_megaclause(PredEntry *ap) { mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause); if (mcl->ClFlags & ExoMask) { - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule,ap), + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap), "while deleting clause from exo predicate %s/%d\n", RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE); @@ -1468,7 +1427,7 @@ static yamop *addcl_permission_error(const char *file, const char *function, int lineno, PredEntry *ap, int in_use) { CACHE_REGS - Term culprit = Yap_PredicateIndicator(CurrentModule, ap); + Term culprit = Yap_PredicateToIndicator( ap); return in_use ? (ap->ArityOfPE == 0 ? Yap_Error__(false, file, function, lineno, @@ -2185,7 +2144,7 @@ static Int p_purge_clauses(USES_REGS1) { /* '$purge_clauses'(+Func) */ PELOCK(21, pred); if (pred->PredFlags & StandardPredFlag) { UNLOCKPE(33, pred); - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, pred), "assert/1"); + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(pred), "assert/1"); return (FALSE); } purge_clauses(pred); @@ -4102,7 +4061,7 @@ static Int | TabledPredFlag #endif /* TABLING */ )) { - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, ap), + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap), "dbload_get_space/4"); return FALSE; } diff --git a/C/exec.c b/C/exec.c index 38caee798..de5cc31b0 100755 --- a/C/exec.c +++ b/C/exec.c @@ -151,7 +151,7 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) { return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts); } -Term Yap_PredicateIndicator(Term t, Term mod) { +Term Yap_TermToIndicator(Term t, Term mod) { CACHE_REGS // generate predicate indicator in this case Term ti[2]; @@ -175,6 +175,27 @@ Term Yap_PredicateIndicator(Term t, Term mod) { return t; } +Term Yap_PredicateToIndicator(PredEntry *pe) { + CACHE_REGS + // generate predicate indicator in this case + Term ti[2]; + if (pe->ArityOfPE) { + ti[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred)); + ti[1] = MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred)); + } else { + ti[0] = t; + ti[1] = MkIntTerm(0); + } + t = Yap_MkApplTerm(FunctorSlash, 2, ti); + Term mod + if (mod != TermUser and mod!= TermProlog) { + ti[0] = mod; + ti[1] = t; + return Yap_MkApplTerm(FunctorModule, 2, ti); + } + return t; +} + static bool CallError(yap_error_number err, Term t, Term mod USES_REGS) { if (isoLanguageFlag()) { return (CallMetaCall(t, mod PASS_REGS)); @@ -280,9 +301,9 @@ restart: } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { return Yap_FindLUIntKey(IntegerOfTerm(t)); } else if (IsApplTerm(t)) { - Functor fun = FunctorOfTerm(t); + Functor fun = pe->FunctorOfPred; if (IsExtensionFunctor(fun)) { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); + Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname); return NULL; } if (fun == FunctorModule) { @@ -1897,7 +1918,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) { pt = RepAppl(t) + 1; arity = ArityOfFunctor(f); } else { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), "call/1"); + Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), "call/1"); LOCAL_PrologMode &= ~TopGoalMode; return (FALSE); } diff --git a/C/index.c b/C/index.c index 03e9d41b0..0ae420a6f 100755 --- a/C/index.c +++ b/C/index.c @@ -4152,7 +4152,7 @@ restart_index: } #if DEBUG if (GLOBAL_Option['i' - 'a' + 1]) { - Yap_DebugWriteIndicator(ap); + Yap_DebugWritexozoIndicator(ap); } #endif if ((labp = expand_index(&cint)) == NULL) { diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index 83d8d7aa3..73cc33054 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -434,7 +434,7 @@ vxu `on` consider `$` a lower case character. */ YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false", NULL), - /**< `prompt_alternatives_on(atom, + /**< ` pt_alternatives_on(atom, changeable) ` SWI-Compatible option, determines prompting for alternatives in the Prolog diff --git a/H/Yapproto.h b/H/Yapproto.h index 309e9eaa7..1d2a87302 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -212,7 +212,8 @@ extern void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS); extern bool Yap_execute_pred(struct pred_entry *ppe, CELL *pt, bool pass_exception USES_REGS); extern int Yap_dogc(int extra_args, Term *tp USES_REGS); -extern Term Yap_PredicateIndicator(Term t, Term mod); +extern Term Yap_PredicateToIndicator(struct pred_entry *pe); +extern Term Yap_TermToIndicator(Term t, Term mod); extern bool Yap_Execute(Term t USES_REGS); /* exo.c */ From 5ff09fbf2690958c19252cba6924c1a3090d8894 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 28 Feb 2019 21:57:48 +0000 Subject: [PATCH 064/101] indicators --- C/cdmgr.c | 2 +- C/exec.c | 53 +++++++++++++++++++++++++++++++++++++++++++++++----- C/index.c | 2 +- C/stack.c | 2 +- CXX/yapi.cpp | 2 +- 5 files changed, 52 insertions(+), 9 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index f0165550d..c14a69ab0 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -120,7 +120,7 @@ bool Yap_Consulting(USES_REGS1) { * assertz are supported for static predicates no database predicates are * supportted for fast predicates */ -1 + /** Look for a predicate with same functor as t, create a new one of it cannot find it. */ diff --git a/C/exec.c b/C/exec.c index de5cc31b0..cfba1c0c7 100755 --- a/C/exec.c +++ b/C/exec.c @@ -151,6 +151,49 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) { return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts); } +PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) { + Term t0 = t; + +restart: + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR, t0, pname); + return NULL; + } else if (IsAtomTerm(t)) { + PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod)); + return ap; + } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { + return Yap_FindLUIntKey(IntegerOfTerm(t)); + } else if (IsPairTerm(t)) { + t = Yap_MkApplTerm(FunctorCsult, 1, &t); + goto restart; + } else if (IsApplTerm(t)) { + Functor fun = FunctorOfTerm(t); + if (IsExtensionFunctor(fun)) { + Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname); + return NULL; + } + if (fun == FunctorModule) { + Term tmod = ArgOfTerm(1, t); + if (IsVarTerm(tmod)) { + Yap_Error(INSTANTIATION_ERROR, t0, pname); + return NULL; + } + if (!IsAtomTerm(tmod)) { + Yap_Error(TYPE_ERROR_ATOM, t0, pname); + return NULL; + } + t = ArgOfTerm(2, t); + goto restart; + } + PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod)); + return ap; + } else { + Yap_Error(TYPE_ERROR_CALLABLE, t0, pname); + } + return NULL; +} + + Term Yap_TermToIndicator(Term t, Term mod) { CACHE_REGS // generate predicate indicator in this case @@ -183,12 +226,12 @@ Term Yap_PredicateToIndicator(PredEntry *pe) { ti[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred)); ti[1] = MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred)); } else { - ti[0] = t; + ti[0] = MkAtomTerm((Atom)(pe->FunctorOfPred)); ti[1] = MkIntTerm(0); } - t = Yap_MkApplTerm(FunctorSlash, 2, ti); - Term mod - if (mod != TermUser and mod!= TermProlog) { + Term t = Yap_MkApplTerm(FunctorSlash, 2, ti); + Term mod = pe->ModuleOfPred; + if (mod != TermUser && mod!= PROLOG_MODULE) { ti[0] = mod; ti[1] = t; return Yap_MkApplTerm(FunctorModule, 2, ti); @@ -301,7 +344,7 @@ restart: } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { return Yap_FindLUIntKey(IntegerOfTerm(t)); } else if (IsApplTerm(t)) { - Functor fun = pe->FunctorOfPred; + Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) { Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname); return NULL; diff --git a/C/index.c b/C/index.c index 0ae420a6f..03e9d41b0 100755 --- a/C/index.c +++ b/C/index.c @@ -4152,7 +4152,7 @@ restart_index: } #if DEBUG if (GLOBAL_Option['i' - 'a' + 1]) { - Yap_DebugWritexozoIndicator(ap); + Yap_DebugWriteIndicator(ap); } #endif if ((labp = expand_index(&cint)) == NULL) { diff --git a/C/stack.c b/C/stack.c index d393cde7e..3418c0ef1 100644 --- a/C/stack.c +++ b/C/stack.c @@ -90,7 +90,7 @@ static PredEntry *get_pred(Term t, Term tmod, char *pname) { } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); + Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname); return NULL; } if (fun == FunctorModule) { diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index 076c88054..fe3a3789c 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -82,7 +82,7 @@ restart: Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) { throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, - Yap_PredicateIndicator(t, tmod), pname); + Yap_TermToIndicator(t, tmod), pname); } if (fun == FunctorModule) { tmod = ArgOfTerm(1, t); From 908cfe3b7768de1f925df90f7706021df6cce025 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 3 Mar 2019 02:01:39 +0000 Subject: [PATCH 065/101] smallStuff --- C/errors.c | 1 - C/exec.c | 16 +++- C/write.c | 1 - library/tries.yap | 128 +---------------------------- library/tries/tries.c | 128 ++++++++++++++++++++++++++++- os/readterm.c | 44 +++++----- packages/ProbLog/CMakeLists.txt | 1 + packages/ProbLog/problog.yap | 4 +- packages/ProbLog/problog/flags.yap | 2 +- packages/ProbLog/problog/ptree.yap | 4 +- packages/ProbLog/problog_lbfgs.yap | 26 +++--- 11 files changed, 188 insertions(+), 167 deletions(-) diff --git a/C/errors.c b/C/errors.c index 8c5dd6a72..d64e1210c 100755 --- a/C/errors.c +++ b/C/errors.c @@ -616,7 +616,6 @@ yap_error_descriptor_t *Yap_popErrorContext(bool mdnew, bool pass) { memmove(ep, e, sizeof(*e)); ep->top_error = epp; } - free(e); return LOCAL_ActiveError; } /** diff --git a/C/exec.c b/C/exec.c index cfba1c0c7..86819dc97 100755 --- a/C/exec.c +++ b/C/exec.c @@ -115,14 +115,18 @@ static inline bool CallPredicate(PredEntry *pen, choiceptr cut_pt, inline static bool CallMetaCall(Term t, Term mod USES_REGS) { // we have a creep requesr waiting - ARG1 = t; + if (IsVarTerm(t)) + Yap_ThrowError(INSTANTIATION_ERROR, t, "meta-call"); + if (IsIntTerm(t) || (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t)))) + Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, mod), "meta-call"); +ARG1 = t; ARG2 = cp_as_integer(B PASS_REGS); /* p_current_choice_point */ ARG3 = t; if (mod) { ARG4 = mod; } else { ARG4 = TermProlog; - } +} if (Yap_GetGlobal(AtomDebugMeta) == TermOn) { return CallPredicate(PredTraceMetaCall, B, PredTraceMetaCall->CodeOfPred PASS_REGS); @@ -141,6 +145,10 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) { Term Yap_ExecuteCallMetaCall(Term g, Term mod) { CACHE_REGS Term ts[4]; + if (IsVarTerm(g)) + Yap_ThrowError(INSTANTIATION_ERROR, g, "meta-call"); + if (IsIntTerm(g) || (IsApplTerm(g) && IsExtensionFunctor(FunctorOfTerm(g)))) + Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(g, mod), "meta-call"); ts[0] = g; ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */ ts[2] = g; @@ -210,7 +218,7 @@ Term Yap_TermToIndicator(Term t, Term mod) { ti[1] = MkIntTerm(0); } t = Yap_MkApplTerm(FunctorSlash, 2, ti); - if (mod != CurrentModule) { + if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) { ti[0] = mod; ti[1] = t; return Yap_MkApplTerm(FunctorModule, 2, ti); @@ -231,7 +239,7 @@ Term Yap_PredicateToIndicator(PredEntry *pe) { } Term t = Yap_MkApplTerm(FunctorSlash, 2, ti); Term mod = pe->ModuleOfPred; - if (mod != TermUser && mod!= PROLOG_MODULE) { + if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) { ti[0] = mod; ti[1] = t; return Yap_MkApplTerm(FunctorModule, 2, ti); diff --git a/C/write.c b/C/write.c index 79dca5220..b171942da 100644 --- a/C/write.c +++ b/C/write.c @@ -1115,7 +1115,6 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, /* protect slots for portray */ writeTerm(tp, priority, 1, false, &wglb, &rwt); - tp = Yap_CyclesInTerm(t PASS_REGS); if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); diff --git a/library/tries.yap b/library/tries.yap index 8153bd249..46cbb7284 100644 --- a/library/tries.yap +++ b/library/tries.yap @@ -2,7 +2,7 @@ * @file tries.yap * @author Ricardo Rocha * - * @brief + * @brief YAP tries interface * * */ @@ -63,6 +63,8 @@ @ingroup library @{ +@brief Engine Independent trie library + The next routines provide a set of utilities to create and manipulate prefix trees of Prolog terms. Tries were originally proposed to implement tabling in Logic Programming, but can be used for other @@ -76,130 +78,6 @@ for efficiency. They are available through the */ -/** @pred trie_check_entry(+ _Trie_,+ _Term_,- _Ref_) - - - -Succeeds if a variant of term _Term_ is in trie _Trie_. An handle - _Ref_ gives a reference to the term. - - -*/ -/** @pred trie_close(+ _Id_) - - - -Close trie with identifier _Id_. - - -*/ -/** @pred trie_close_all - - - -Close all available tries. - - -*/ -/** @pred trie_get_entry(+ _Ref_,- _Term_) - - -Unify _Term_ with the entry for handle _Ref_. - - -*/ -/** @pred trie_load(+ _Trie_,+ _FileName_) - - -Load trie _Trie_ from the contents of file _FileName_. - - -*/ -/** @pred trie_max_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_) - - -Give maximal statistics on tries, including the amount of memory, - _Memory_, the number of tries, _Tries_, the number of entries, - _Entries_, and the total number of nodes, _Nodes_. - - -*/ -/** @pred trie_mode(? _Mode_) - - - -Unify _Mode_ with trie operation mode. Allowed values are either -`std` (default) or `rev`. - - -*/ -/** @pred trie_open(- _Id_) - - - -Open a new trie with identifier _Id_. - - -*/ -/** @pred trie_print(+ _Trie_) - - -Print trie _Trie_ on standard output. - - - - - */ -/** @pred trie_put_entry(+ _Trie_,+ _Term_,- _Ref_) - - - -Add term _Term_ to trie _Trie_. The handle _Ref_ gives -a reference to the term. - - -*/ -/** @pred trie_remove_entry(+ _Ref_) - - - -Remove entry for handle _Ref_. - - -*/ -/** @pred trie_remove_subtree(+ _Ref_) - - - -Remove subtree rooted at handle _Ref_. - - -*/ -/** @pred trie_save(+ _Trie_,+ _FileName_) - - -Dump trie _Trie_ into file _FileName_. - - -*/ -/** @pred trie_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_) - - -Give generic statistics on tries, including the amount of memory, - _Memory_, the number of tries, _Tries_, the number of entries, - _Entries_, and the total number of nodes, _Nodes_. - - -*/ -/** @pred trie_usage(+ _Trie_,- _Entries_,- _Nodes_,- _VirtualNodes_) - - -Give statistics on trie _Trie_, the number of entries, - _Entries_, and the total number of nodes, _Nodes_, and the -number of _VirtualNodes_. - - -*/ :- load_foreign_files([tries], [], init_tries). diff --git a/library/tries/tries.c b/library/tries/tries.c index f0f28e2e3..698576567 100644 --- a/library/tries/tries.c +++ b/library/tries/tries.c @@ -4,8 +4,17 @@ Comments: Tries module for Yap Prolog version: $ID$ ****************************************/ +/** + @file tries.c + @brief yap-C wrapper for tries. +*/ +/** +@addtogroup tries + +@{ +*/ /* -------------------------- */ /* Includes */ @@ -164,6 +173,15 @@ static YAP_Bool p_close_all_tries(void) { /* put_trie_entry(+Mode,+Trie,+Entry,-Ref) */ +/** @pred trie_put_entry(+Mode,+ _Trie_,+ _Term_,- _Ref_) + + + +Add term _Term_ to trie _Trie_. The handle _Ref_ gives +a reference to the term. + + +*/ #define arg_mode YAP_ARG1 #define arg_trie YAP_ARG2 #define arg_entry YAP_ARG3 @@ -198,6 +216,13 @@ static YAP_Bool p_put_trie_entry(void) { /* get_trie_entry(+Mode,+Ref,-Entry) */ +/** @pred trie_get_entry(+ _Ref_,- _Term_) + + +Unify _Term_ with the entry for handle _Ref_. + + +*/ #define arg_mode YAP_ARG1 #define arg_ref YAP_ARG2 #define arg_entry YAP_ARG3 @@ -228,7 +253,6 @@ static YAP_Bool p_get_trie_entry(void) { #undef arg_ref #undef arg_entry - /* remove_trie_entry(+Ref) */ static YAP_Bool p_remove_trie_entry(void) { return p_trie_remove_entry(); @@ -263,6 +287,14 @@ static YAP_Bool p_trie_open(void) { /* trie_close(+Trie) */ +/** @pred trie_close(+ _Id_) + + + +Close trie with identifier _Id_. + + +*/ #define arg_trie YAP_ARG1 static YAP_Bool p_trie_close(void) { /* check arg */ @@ -277,6 +309,14 @@ static YAP_Bool p_trie_close(void) { /* trie_close_all() */ +/** @pred trie_close_all + + + +Close all available tries. + + +*/ static YAP_Bool p_trie_close_all(void) { trie_close_all(); return TRUE; @@ -284,6 +324,15 @@ static YAP_Bool p_trie_close_all(void) { /* trie_mode(?Mode) */ +/** @pred trie_mode(? _Mode_) + + + +Unify _Mode_ with trie operation mode. Allowed values are either +`std` (default) or `rev`. + + +*/ #define arg_mode YAP_ARG1 static YAP_Bool p_trie_mode(void) { YAP_Term mode_term; @@ -337,6 +386,15 @@ static YAP_Bool p_trie_put_entry(void) { /* trie_check_entry(+Trie,+Entry,-Ref) */ +/** @pred trie_check_entry(+ _Trie_,+ _Term_,- _Ref_) + + + +Succeeds if a variant of term _Term_ is in trie _Trie_. An handle + _Ref_ gives a reference to the term. + + +*/ #define arg_trie YAP_ARG1 #define arg_entry YAP_ARG2 #define arg_ref YAP_ARG3 @@ -458,6 +516,14 @@ static YAP_Bool p_trie_traverse_cont(void) { /* trie_remove_entry(+Ref) */ +/** @pred trie_remove_entry(+ _Ref_) + + + +Remove entry for handle _Ref_. + + +*/ #define arg_ref YAP_ARG1 static YAP_Bool p_trie_remove_entry(void) { /* check arg */ @@ -472,6 +538,14 @@ static YAP_Bool p_trie_remove_entry(void) { /* trie_remove_subtree(+Ref) */ +/** @pred trie_remove_subtree(+ _Ref_) + + + +Remove subtree rooted at handle _Ref_. + + +*/ #define arg_ref YAP_ARG1 static YAP_Bool p_trie_remove_subtree(void) { /* check arg */ @@ -564,8 +638,13 @@ static YAP_Bool p_trie_count_intersect(void) { #undef arg_trie2 #undef arg_entries +/** @pred trie_save(+ _Trie_,+ _FileName_) -/* trie_save(+Trie,+FileName) */ + +Dump trie _Trie_ into file _FileName_. + + +*/ #define arg_trie YAP_ARG1 #define arg_file YAP_ARG2 static YAP_Bool p_trie_save(void) { @@ -594,6 +673,13 @@ static YAP_Bool p_trie_save(void) { /* trie_load(-Trie,+FileName) */ +/** @pred trie_load(- _Trie_,+ _FileName_) + + +Load trie _Trie_ from the contents of file _FileName_. + + +*/ #define arg_trie YAP_ARG1 #define arg_file YAP_ARG2 static YAP_Bool p_trie_load(void) { @@ -622,6 +708,15 @@ static YAP_Bool p_trie_load(void) { #undef arg_trie #undef arg_file +/** @pred trie_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_) + + +Give generic statistics on tries, including the amount of memory, + _Memory_, the number of tries, _Tries_, the number of entries, + _Entries_, and the total number of nodes, _Nodes_. + + +*/ /* trie_stats(-Memory,-Tries,-Entries,-Nodes) */ #define arg_memory YAP_ARG1 @@ -650,6 +745,15 @@ static YAP_Bool p_trie_stats(void) { /* trie_max_stats(-Memory,-Tries,-Entries,-Nodes) */ +/** @pred trie_max_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_) + + +Give maximal statistics on tries, including the amount of memory, + _Memory_, the number of tries, _Tries_, the number of entries, + _Entries_, and the total number of nodes, _Nodes_. + + +*/ #define arg_memory YAP_ARG1 #define arg_tries YAP_ARG2 #define arg_entries YAP_ARG3 @@ -675,6 +779,15 @@ static YAP_Bool p_trie_max_stats(void) { #undef arg_nodes +/** @pred trie_usage(+ _Trie_,- _Entries_,- _Nodes_,- _VirtualNodes_) + + +Give statistics on trie _Trie_, the number of entries, + _Entries_, and the total number of nodes, _Nodes_, and the +number of _VirtualNodes_. + + +*/ /* trie_usage(+Trie,-Entries,-Nodes,-VirtualNodes) */ #define arg_trie YAP_ARG1 #define arg_entries YAP_ARG2 @@ -704,6 +817,15 @@ static YAP_Bool p_trie_usage(void) { /* trie_print(+Trie) */ +/** @pred trie_print(+ _Trie_) + + +Print trie _Trie_ on standard output. + + + + + */ #define arg_trie YAP_ARG1 static YAP_Bool p_trie_print(void) { /* check arg */ @@ -979,3 +1101,5 @@ int WINAPI win_tries(HANDLE hinst, DWORD reason, LPVOID reserved) return 1; } #endif + +/// @} diff --git a/os/readterm.c b/os/readterm.c index aeef31efe..a9709f55d 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -1144,7 +1144,8 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool LOCAL_Error_TYPE = YAP_NO_ERROR; return YAP_PARSING_FINISHED; } - Term t = syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos, fe->reading_clause, fe->msg); + + syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos, fe->reading_clause, fe->msg); if (ParserErrorStyle == TermException) { if (LOCAL_RestartEnv && !LOCAL_delay) @@ -1162,7 +1163,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool LOCAL_Error_TYPE = YAP_NO_ERROR; if (ParserErrorStyle == TermDec10) { - return YAP_SCANNING; + return YAP_START_PARSING; } return YAP_PARSING_FINISHED; } @@ -1184,6 +1185,8 @@ 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 * @@ -1201,58 +1204,59 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool */ Term Yap_read_term(int sno, Term opts, bool clause) { - FEnv fe; - REnv re; - #if EMACS int emacs_cares = FALSE; #endif - - yap_error_descriptor_t *new = malloc(sizeof *new); - bool err = Yap_pushErrorContext(true, new); int lvl = push_text_stack(); + yap_error_descriptor_t *new = malloc(sizeof *new); + FEnv *fe = Malloc(sizeof *fe); + REnv *re = Malloc(sizeof *re); + bool err = Yap_pushErrorContext(true, new); parser_state_t state = YAP_START_PARSING; + yhandle_t yopts = Yap_InitHandle(opts); while (true) { switch (state) { case YAP_START_PARSING: - state = initParser(opts, &fe, &re, sno, clause); + opts = Yap_GetFromHandle(yopts); + state = initParser(opts, fe, re, sno, clause); if (state == YAP_PARSING_FINISHED) { - pop_text_stack(lvl); + Yap_PopHandle(yopts); + pop_text_stack(lvl); Yap_popErrorContext(err, true); return 0; } break; case YAP_SCANNING: - state = scan(&re, &fe, sno); + state = scan(re, fe, sno); break; case YAP_SCANNING_ERROR: - state = scanError(&re, &fe, sno); + state = scanError(re, fe, sno); break; case YAP_PARSING: - state = parse(&re, &fe, sno); + state = parse(re, fe, sno); break; case YAP_PARSING_ERROR: - state = parseError(&re, &fe, sno); + state = parseError(re, fe, sno); break; case YAP_PARSING_FINISHED: { CACHE_REGS bool done; - if (fe.reading_clause) - done = complete_clause_processing(&fe, LOCAL_tokptr); + if (fe->reading_clause) + done = complete_clause_processing(fe, LOCAL_tokptr); else - done = complete_processing(&fe, LOCAL_tokptr); + done = complete_processing(fe, LOCAL_tokptr); if (!done) { state = YAP_PARSING_ERROR; - fe.t = 0; + fe->t = 0; break; } #if EMACS @@ -1260,10 +1264,12 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool #endif /* EMACS */ pop_text_stack(lvl); Yap_popErrorContext(err, true); - return fe.t; + Yap_PopHandle(yopts); + return fe->t; } } } + Yap_PopHandle(yopts); Yap_popErrorContext(err, true); pop_text_stack(lvl); return 0; diff --git a/packages/ProbLog/CMakeLists.txt b/packages/ProbLog/CMakeLists.txt index 0a397543c..448ee798e 100644 --- a/packages/ProbLog/CMakeLists.txt +++ b/packages/ProbLog/CMakeLists.txt @@ -4,6 +4,7 @@ set (PROGRAMS problog_lfi.yap dtproblog.yap aproblog.yap + problog_lbfgs.yap problog_learning.yap problog_learning_lbdd.yap ) diff --git a/packages/ProbLog/problog.yap b/packages/ProbLog/problog.yap index 199b6e752..abc8769b9 100644 --- a/packages/ProbLog/problog.yap +++ b/packages/ProbLog/problog.yap @@ -517,13 +517,14 @@ every 5th iteration only. % directory where simplecudd executable is located % automatically set during loading -- assumes it is in /usr/local/bin or same place where YAP has % been installed.) + :- getcwd(PD0), atom_concat(PD0, '../../bin', PD), set_problog_path(PD). :- PD = '/usr/local/bin', set_problog_path(PD). - +%:- stop_low_level_trace. %%%%%%%%%%%% @@ -626,6 +627,7 @@ every 5th iteration only. + problog_dir(PD):- problog_path(PD). %%%%%%%%%%%%%%%%%%%%%%%% diff --git a/packages/ProbLog/problog/flags.yap b/packages/ProbLog/problog/flags.yap index 9564d7515..70859bdc3 100644 --- a/packages/ProbLog/problog/flags.yap +++ b/packages/ProbLog/problog/flags.yap @@ -218,7 +218,7 @@ :- use_module(gflags). :- use_module(os). :- use_module(logger). -:- use_module(library(system), [file_exists/1, delete_file/1]). +:- use_module(library(system), [file_exists/1, delete_file/1,file_property/2]). /** @defgroup ProbLogMiscellaneous ProbLog Miscellaneous Predicates diff --git a/packages/ProbLog/problog/ptree.yap b/packages/ProbLog/problog/ptree.yap index bb64f5800..845f1d5da 100644 --- a/packages/ProbLog/problog/ptree.yap +++ b/packages/ProbLog/problog/ptree.yap @@ -265,7 +265,7 @@ :- initialization( ( predicate_property(trie_disable_hash, imported_from(_M)) -> trie_disable_hash - ; print_message(warning,'The predicate tries:trie_disable_hash/0 does not exist. Please update trie library.') + ; true % stop_low_level_trace, print_message(warning,'The predicate trie_disable_hash/0 does not exist. Please update trie library.') ) ). @@ -276,7 +276,7 @@ :- initialization(( problog_define_flag(use_db_trie, problog_flag_validate_boolean, 'use the builtin trie 2 trie transformation', false), problog_define_flag(db_trie_opt_lvl, problog_flag_validate_integer, 'optimization level for the trie 2 trie transformation', 0), - problog_define_flag(compare_opt_lvl, problog_flag_validate_boolean, 'comparison mode for optimization level', false), + problog_define_flag(compare_opt_lvl, problog_flag_validate_boolean, 'comparison mode for optimizatione level', false), problog_define_flag(db_min_prefix, problog_flag_validate_integer, 'minimum size of prefix for dbtrie to optimize', 2), problog_define_flag(use_naive_trie, problog_flag_validate_boolean, 'use the naive algorithm to generate bdd scripts', false), problog_define_flag(use_old_trie, problog_flag_validate_boolean, 'use the old trie 2 trie transformation no nested', true), diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index a07140187..9d7e5aa33 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -581,7 +581,8 @@ bdd_input_file(Filename) :- concat_path_with_filename(Dir,'input.txt',Filename). init_one_query(QueryID,Query,_Type) :- -% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), +writeln(init_one_query(QueryID,Query,_Type)), + % format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % if BDD file does not exist, call ProbLog @@ -592,13 +593,15 @@ init_one_query(QueryID,Query,_Type) :- format_learning(3,' Reuse existing BDD ~q~n~n',[QueryID]) ; b_setval(problog_required_keep_ground_ids,false), + (QueryID mod 100 =:= 0 -> writeln(QueryID) ; true), - problog_flag(init_method,(Query,N,Bdd,graph2bdd(X,Y,N,Bdd))), + + problog_flag(init_method,(Query,N,Bdd,G)), Query =.. [_,X,Y] -> Bdd = bdd(Dir, Tree, MapList), ( - graph2bdd(X,Y,N,Bdd) + G -> rb_new(H0), maplist_to_hash(MapList, H0, Hash), @@ -608,8 +611,9 @@ init_one_query(QueryID,Query,_Type) :- % Grad=[] ), write('.'), - recordz(QueryID,bdd(Dir, Grad, MapList),_) - ; + recordz(QueryID,bdd(Dir, Grad, MapList),_) + ). +/* ; problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,NOf,Bdd))) -> b_setval(problog_required_keep_ground_ids,false), rb_new(H0), @@ -624,20 +628,20 @@ init_one_query(QueryID,Query,_Type) :- tree_to_grad(Tree, Hash, [], Grad), recordz(QueryID,bdd(Dir, Grad, MapList),_) ; - problog_flag(init_method,(Query,NOf,Bdd,Call)) -> + + problog_flag(init_method,(Query,NOf,Bdd,_Call)) , + Query = gene(X,Y), b_setval(problog_required_keep_ground_ids,false), rb_new(H0), Bdd = bdd(Dir, Tree, MapList), -% trace, - problog:Call, + user:graph2bdd(X,Y,1,Bdd), maplist_to_hash(MapList, H0, Hash), Tree \= [], %put_code(0'.), tree_to_grad(Tree, Hash, [], Grad), - recordz(QueryID,bdd(Dir, Grad, MapList),_) - ). - + recordz(QueryID,bdd(Dir, Grad, MapList),_). +*/ %======================================================================== From ff61ab995359fd3cec3455c0eb70a4ccdbac02ec Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 3 Mar 2019 02:13:51 +0000 Subject: [PATCH 066/101] debugger emulation --- pl/debug.yap | 91 +++++++++++++++++++++++----------------------------- 1 file changed, 40 insertions(+), 51 deletions(-) diff --git a/pl/debug.yap b/pl/debug.yap index e66816119..ca648226f 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -16,7 +16,7 @@ *************************************************************************/ -:- system_module( '$_debug', [], ['$trace_plan'/4, +:- system_module( '$_debug', [], ['$trace_query'/4, '$init_debugger'/0, '$skipeol'/1]). @@ -254,7 +254,7 @@ be lost. * * The debugger is an interpreter. with main predicates: * - $trace: this is the API - * - $trace_plan: reduce a query to a goal + * - $trace_query: reduce a query to a goal * - $trace_goal: execute: * + using the source, Luke * + hooking into the WAM procedure call mechanism @@ -308,7 +308,7 @@ be lost. '$execute_nonstop'(G,Mod). '$trace'(Mod:G) :- '$$save_by'(CP), - '$trace_plan'(G, Mod, CP, G, EG), + '$trace_query'(G, Mod, CP, G, EG), gated_call( '$debugger_io', EG, @@ -415,53 +415,42 @@ be lost. '$trace_meta_call'( G, M, CP ) :- - '$trace_plan'(G, M, CP, G, EG ), + '$trace_query'(G, M, CP, G, EG ), call(EG). -%% @pred '$trace_plan'( +G, +M, +CP, +Expanded) +%% @pred '$trace_query'( +G, +M, +CP, +Expanded) % % debug a complex query % -'$trace_plan'(V, M, _CP, _, call(M:V)) :- +'$trace_query'(V, M, _CP, _, call(M:V)) :- var(V), !. -'$trace_plan'(!, _, CP, _, '$$cut_by'(CP)) :- +'$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :- !. -'$trace_plan'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- +'$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- !. -'$trace_plan'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- +'$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- !. -'$trace_plan'(true, _, _, _, true) :- !. -'$trace_plan'(fail, _, _, _, '$trace'(fail)) :- !. -'$trace_plan'((A,B), M, CP, S, (EA,EB)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB). -'$trace_plan'((A->B), M, CP, S, (EA->EB)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB). -'$trace_plan'((A;B), M, CP, S, (EA;EB)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB). -'$trace_plan'((A|B), M, CP, S, (EA|EB)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB). -'$trace_plan'((A*->B), M, CP, S, (EA->EB)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB). -'$trace_plan'((A*->B;C), M, CP, S, (EA->EB;EC)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB), - '$trace_plan'(C, M, CP, S, EC). -'$trace_plan'(if(A,B,C), M, CP, S, (EA->EB;EC)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB), - '$trace_plan'(C, M, CP, S, EC). -'$trace_plan'((\+ A), M, CP, S, ( EA -> fail ; true)) :- !, - '$trace_plan'(A, M, CP, S, EA). -'$trace_plan'(once(A), M, CP, S, ( EA -> true)) :- !, - '$trace_plan'(A, M, CP, S, EA). -'$trace_plan'(ignore(A), M, CP, S, ( EA -> true; true)) :- !, - '$trace_plan'(A, M, CP, S, EA). -'$trace_plan'(G, M, _CP, _, ( +'$trace_query'(true, _, _, _, true) :- !. +'$trace_query'(fail, _, _, _, '$trace'(fail)) :- !. +'$trace_query'(M:G, _, CP,S, Expanded) :- + !, + '$yap_strip_module'(M:G, M0, G0), + '$trace_query'(G0, M0, CP,S, Expanded ). +'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !, + '$trace_query'(A, M, CP, S, EA), + '$trace_query'(B, M, CP, S, EB). +'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !, + '$trace_query'(A, M, CP, S, EA), + '$trace_query'(B, M, CP, S, EB). +'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !, + '$trace_query'(A, M, CP, S, EA), + '$trace_query'(B, M, CP, S, EB). +'$trace_query'((A|B), M, CP, S, (EA|EB)) :- !, + '$trace_query'(A, M, CP, S, EA), + '$trace_query'(B, M, CP, S, EB). +'$trace_query'((\+ A), M, CP, S, (\+ EA)) :- !, + '$trace_query'(A, M, CP, S, EA). +'$trace_query'(G, M, _CP, _, ( % spy a literal '$id_goal'(L), catch( @@ -472,7 +461,7 @@ be lost. %% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo) %% -%% Actually debugs a +%% Actuallb sy debugs a %% goal! '$trace_goal'(G, M, GoalNumber, _H) :- ( @@ -498,9 +487,9 @@ be lost. ). % meta system '$trace_goal'(G, M, GoalNumber, H) :- - '$is_metapredicate'(G, prolog), - !, - '$debugger_expand_meta_call'(M:G, [], G1), + '$is_metapredicate'(G, prolog), + !, + '$debugger_expand_meta_call'(M:G, [], G1), strip_module(G1, MF, NG), gated_call( '$enter_trace'(GoalNumber, G, M, H), @@ -615,7 +604,7 @@ be lost. '$$save_by'(CP), clause(M:G, Cl, _), '$retry_clause'(GoalNumber, G, M, Info, X), - '$trace_plan'(Cl, M, CP, Cl, ECl), + '$trace_query'(Cl, M, CP, Cl, ECl), '$execute0'(ECl,M). '$creep_step'(GoalNumber, G, M, Info) :- @@ -665,7 +654,7 @@ be lost. %%% - abort: forward throw while the call is newer than goal -%% @pred '$re_trace_plan'( Exception, +Goal, +Mod, +GoalID ) +%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID ) % % debugger code for exceptions. Recognised cases are: % - abort always forwarded @@ -1057,10 +1046,10 @@ be lost. '$cps'([]). -'$debugger_skip_trace_plan'([CP|CPs],CPs1) :- - yap_hacks:choicepoint(CP,_,prolog,'$trace_plan',4,(_;_),_), !, - '$debugger_skip_trace_plan'(CPs,CPs1). -'$debugger_skip_trace_plan'(CPs,CPs). +'$debugger_skip_trace_query'([CP|CPs],CPs1) :- + yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_), !, + '$debugger_skip_trace_query'(CPs,CPs1). +'$debugger_skip_trace_query'(CPs,CPs). '$debugger_skip_traces'([CP|CPs],CPs1) :- yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_), !, From 3f4fd7d7a32ae2cb3499151aee0976e410173fc2 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 3 Mar 2019 02:19:34 +0000 Subject: [PATCH 067/101] silent --- pl/consult.yap | 34 ++++++++++++++++++++++------------ 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/pl/consult.yap b/pl/consult.yap index 4581a3202..59c57672a 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -42,6 +42,7 @@ use_module/3], ['$add_multifile'/3, '$csult'/2, + '$do_startup_reconsult'/1, '$elif'/2, '$else'/1, '$endif'/1, @@ -515,8 +516,8 @@ load_files(Files0,Opts) :- '$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :- % check if there is a qly file % start_low_level_trace, - '$pred_exists'(absolute_file_name__(File,[],F),prolog), - absolute_file_name__(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F), + '$pred_exists'('$absolute_file_name'(File,[],F),prolog), + '$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F), open( F, read, Stream , [type(binary)] ), ( '$q_header'( Stream, Type ), @@ -803,7 +804,7 @@ db_files(Fs) :- '$lf_opt'('$source_pos', TOpts, Pos), '$lf_opt'('$from_stream', TOpts, false), ( QComp == auto ; QComp == large, Pos > 100*1024), - absolute_file_name__(UserF,[file_type(qly),solutions(first),expand(true)],F), + '$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F), !, '$qsave_file_'( File, UserF, F ). '$q_do_save_file'(_File, _, _TOpts ). @@ -861,6 +862,7 @@ 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'. @@ -927,6 +929,14 @@ nb_setval('$if_level',0). % % reconsult at startup... % +'$do_startup_reconsult'(_X) :- + '$init_win_graphics', + fail. +'$do_startup_reconsult'(X) :- + catch(load_files(user:X, [silent(true)]), Error, '$LoopError'(Error, consult)), + !, + ( current_prolog_flag(halt_after_consult, false) -> true ; halt). +'$do_startup_reconsult'(_). '$skip_unix_header'(Stream) :- peek_code(Stream, 0'#), !, % 35 is ASCII for '# @@ -1033,7 +1043,7 @@ prolog_load_context(stream, Stream) :- %format( 'L=~w~n', [(F0)] ), ( atom_concat(Prefix, '.qly', F0 ), - absolute_file_name__(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F) + '$absolute_file_name'(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F) ; F0 = F ), @@ -1140,11 +1150,11 @@ exists_source(File) :- '$full_filename'(F0, F) :- - '$undefined'(absolute_file_name__(F0,[],F),prolog_complete), + '$undefined'('$absolute_file_name'(F0,[],F),prolog_complete), !, 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), @@ -1263,7 +1273,6 @@ module(Mod, Decls) :- % prevent modules within the kernel module... - /** @pred use_module(? _M_,? _F_,+ _L_) is directive SICStus compatible way of using a module @@ -1441,7 +1450,9 @@ 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'(_). @@ -1493,6 +1504,9 @@ initialization(_G,_OPT). @} */ +%% @{ + + /** @@ -1500,9 +1514,6 @@ initialization(_G,_OPT). @ingroup YAPCompilerSettings -%% @{ - - Conditional compilation builds on the same principle as term_expansion/2, goal_expansion/2 and the expansion of grammar rules to compile sections of the source-code @@ -1625,7 +1636,6 @@ no test succeeds the else branch is processed. '$elif'(_,_). /** @pred endif - End of conditional compilation. */ @@ -1678,7 +1688,7 @@ End of conditional compilation. current_prolog_flag(source, true), !. '$fetch_comp_status'(compact). -/** @pred consult_depth(-int:_LV_) +/** consult_depth(-int:_LV_) * * Unify _LV_ with the number of files being consulted. */ From 5ec424645d579c61969f2ebcfcd99b9406ed2c9b Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 3 Mar 2019 04:31:10 +0000 Subject: [PATCH 068/101] typos --- packages/ProbLog/problog_examples/learn_graph.pl | 2 +- packages/ProbLog/problog_learning.yap | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/packages/ProbLog/problog_examples/learn_graph.pl b/packages/ProbLog/problog_examples/learn_graph.pl index 4e15cfedf..1970599d4 100644 --- a/packages/ProbLog/problog_examples/learn_graph.pl +++ b/packages/ProbLog/problog_examples/learn_graph.pl @@ -15,7 +15,7 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :- use_module(library(matrix)). -:- use_module(('../problog_lbfgs')). +:- use_module('../problog_learning'). %%%% % background knowledge diff --git a/packages/ProbLog/problog_learning.yap b/packages/ProbLog/problog_learning.yap index 5d60bf244..a9f3993db 100644 --- a/packages/ProbLog/problog_learning.yap +++ b/packages/ProbLog/problog_learning.yap @@ -220,7 +220,7 @@ :- use_module(library(system), [file_exists/1, shell/2]). % load our own modules -:- use_module(problog). +:- reexport(problog). :- use_module('problog/logger'). :- use_module('problog/flags'). :- use_module('problog/os'). @@ -1335,7 +1335,7 @@ lineSearch(Final_X,Final_Value) :- line_search_evaluate_point(InitLeft,Value_InitLeft), -i Parameters=ls(A,B,InitLeft,InitRight,Value_A,Value_B,Value_InitLeft,Value_InitRight,1), + Parameters=ls(A,B,InitLeft,InitRight,Value_A,Value_B,Value_InitLeft,Value_InitRight,1), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% BEGIN BACK TRACKING From ae426a3b2787f3bc4d62417a0b58801c66f51f4f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 3 Mar 2019 04:31:23 +0000 Subject: [PATCH 069/101] typos --- C/parser.c | 2 -- os/readterm.c | 4 ++-- pl/debug.yap | 2 +- 3 files changed, 3 insertions(+), 5 deletions(-) diff --git a/C/parser.c b/C/parser.c index 85a2ddb2b..85ee7aa88 100755 --- a/C/parser.c +++ b/C/parser.c @@ -64,8 +64,6 @@ static void syntax_msg(const char *msg, ...) { if (!LOCAL_ErrorMessage) { LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1); } - LOCAL_ActiveError->parserLine = LOCAL_toktide->TokLine; - LOCAL_ActiveError->parserPos = LOCAL_toktide->TokPos; va_start(ap, msg); vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, msg, ap); va_end(ap); diff --git a/os/readterm.c b/os/readterm.c index a9709f55d..5b247f4b6 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -376,9 +376,9 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool Yap_MkErrorRecord(LOCAL_ActiveError, __FILE__, __FUNCTION__, __LINE__, SYNTAX_ERROR, 0, NULL); TokEntry *tok = LOCAL_tokptr; Int start_line = tok->TokLine; - Int err_line = errtok->TokLine; + Int err_line = LOCAL_toktide->TokLine; Int startpos = tok->TokPos; - Int errpos = errtok->TokPos; + Int errpos = LOCAL_toktide->TokPos; Int end_line = GetCurInpLine(GLOBAL_Stream + sno); Int endpos = GetCurInpPos(GLOBAL_Stream + sno); diff --git a/pl/debug.yap b/pl/debug.yap index e66816119..984dedacc 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -488,7 +488,7 @@ be lost. '$trace_goal'(G, M, GoalNumber, H) :- '$undefined'(G, M), !, - '$get_undefined_pred'(M:G, NM:Goal), + '$get_undefined_predicates'(M:G, NM:Goal), ( ( M == NM ; NM == prolog), G == Goal -> yap_flag( unknown, Action ), From 21ff73dd7011d4de1b9800af4bc2c7371811503f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 4 Mar 2019 15:49:53 +0000 Subject: [PATCH 070/101] modules --- C/atomic.c | 11 ++- C/exec.c | 4 +- C/flags.c | 15 +++- C/scanner.c | 2 + C/terms.c | 3 - C/text.c | 15 +++- os/readterm.c | 8 +- packages/ProbLog/problog.yap | 11 ++- packages/ProbLog/problog/nestedtries.yap | 3 +- packages/python/swig/setup.py | 2 +- pl/consult.yap | 7 +- pl/corout.yap | 12 ++- pl/dbload.yap | 2 - pl/debug.yap | 2 +- pl/imports.yap | 109 +++++++++++++---------- pl/meta.yap | 2 +- pl/modules.yap | 46 ++++------ pl/preddyns.yap | 5 +- pl/preds.yap | 10 +-- pl/top.yap | 16 ++-- pl/undefined.yap | 20 ++--- 21 files changed, 157 insertions(+), 148 deletions(-) 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) :- From 32a5158c6bbb009c13710a0e4a34bb76f49a2510 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 6 Mar 2019 10:49:55 +0000 Subject: [PATCH 071/101] problog --- C/dbase.c | 1 + H/clause.h | 3 +- packages/ProbLog/CMakeLists.txt | 2 +- packages/ProbLog/problog.yap | 17 ++++--- packages/ProbLog/problog/flags.yap | 4 +- packages/ProbLog/problog/nestedtries.yap | 3 +- packages/ProbLog/problog/ptree.yap | 4 +- .../ProbLog/problog_examples/learn_graph.pl | 27 +++++------ .../problog_examples/learn_graph_lbdd.pl | 3 +- packages/ProbLog/problog_lbfgs.yap | 26 +++++------ packages/ProbLog/problog_learning.yap | 3 ++ pl/consult.yap | 1 + pl/corout.yap | 3 +- pl/meta.yap | 5 ++- pl/modules.yap | 45 ++++++++++--------- pl/preddyns.yap | 4 +- pl/preds.yap | 9 +--- pl/top.yap | 21 ++++----- pl/undefined.yap | 35 +++++---------- 19 files changed, 101 insertions(+), 115 deletions(-) diff --git a/C/dbase.c b/C/dbase.c index 70c6deea2..aa7b973a3 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -3977,6 +3977,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) { ap->cs.p_code.LastClause = clau->ClPrev->ClCode; } } + clau->ClTimeEnd = ap->TimeStampOfPred; ap->cs.p_code.NOfClauses--; } #ifndef THREADS diff --git a/H/clause.h b/H/clause.h index 1b2d55903..0889798d6 100644 --- a/H/clause.h +++ b/H/clause.h @@ -95,8 +95,9 @@ INLINE_ONLY int VALID_TIMESTAMP(UInt, struct logic_upd_clause *); INLINE_ONLY int VALID_TIMESTAMP(UInt timestamp, struct logic_upd_clause *cl) { + // printf("%lu %lu %lu\n",cl->ClTimeStart, timestamp, cl->ClTimeEnd); return IN_BETWEEN(cl->ClTimeStart, timestamp, cl->ClTimeEnd); -} + } typedef struct dynamic_clause { /* A set of flags describing info on the clause */ diff --git a/packages/ProbLog/CMakeLists.txt b/packages/ProbLog/CMakeLists.txt index 448ee798e..1a5e419fb 100644 --- a/packages/ProbLog/CMakeLists.txt +++ b/packages/ProbLog/CMakeLists.txt @@ -4,8 +4,8 @@ set (PROGRAMS problog_lfi.yap dtproblog.yap aproblog.yap - problog_lbfgs.yap problog_learning.yap + problog_lbfgs.yap problog_learning_lbdd.yap ) diff --git a/packages/ProbLog/problog.yap b/packages/ProbLog/problog.yap index 6bd6a0996..b2756df63 100644 --- a/packages/ProbLog/problog.yap +++ b/packages/ProbLog/problog.yap @@ -517,15 +517,12 @@ every 5th iteration only. % directory where simplecudd executable is located % automatically set during loading -- assumes it is in /usr/local/bin or same place where YAP has % been installed.) - :- getcwd(PD0), atom_concat(PD0, '../../bin', PD), set_problog_path(PD). :- PD = '/usr/local/bin', set_problog_path(PD). -:- PD = '$HOME/,local/bin', - set_problog_path(PD). @@ -554,7 +551,10 @@ 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 @@ -626,7 +626,6 @@ every 5th iteration only. - problog_dir(PD):- problog_path(PD). %%%%%%%%%%%%%%%%%%%%%%%% @@ -1825,7 +1824,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), @@ -2445,7 +2444,7 @@ and the facts used in achieving this explanation. explanation probability - returns list of facts used or constant 'unprovable' as third argument problog_max(+Goal,-Prob,-Facts) -uses iterative deepening with samw parameters as bounding algorithm +uses iterative deepening with same parameters as bounding algorithm threshold gets adapted whenever better proof is found uses local dynamic predicates max_probability/1 and max_proof/1 @@ -2454,8 +2453,8 @@ uses local dynamic predicates max_probability/1 and max_proof/1 problog_max(Goal, Prob, Facts) :- problog_flag(first_threshold,InitT), init_problog_max(InitT), - problog_control(off,up), % - problog_max_id(Goal, Prob, FactIDs), %theo todo + problog_control(off,up), + problog_max_id(Goal, Prob, FactIDs),% theo todo ( FactIDs = [_|_] -> get_fact_list(FactIDs, Facts); Facts = FactIDs). diff --git a/packages/ProbLog/problog/flags.yap b/packages/ProbLog/problog/flags.yap index 70859bdc3..975f4ae71 100644 --- a/packages/ProbLog/problog/flags.yap +++ b/packages/ProbLog/problog/flags.yap @@ -204,7 +204,7 @@ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% @file problog/flags.yap +%% @file problog/flags :-module(flags, [problog_define_flag/4, problog_define_flag/5, @@ -218,7 +218,7 @@ :- use_module(gflags). :- use_module(os). :- use_module(logger). -:- use_module(library(system), [file_exists/1, delete_file/1,file_property/2]). +:- use_module(library(system), [file_exists/1, delete_file/1]). /** @defgroup ProbLogMiscellaneous ProbLog Miscellaneous Predicates diff --git a/packages/ProbLog/problog/nestedtries.yap b/packages/ProbLog/problog/nestedtries.yap index 1b39c15a9..d3c245bae 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,4 +486,3 @@ get_trie(Trie, Label, Ancestors):- set_trie(Trie, Label, Ancestors):- recordz(problog_trie_table, store(Trie, Ancestors, Label), _). - diff --git a/packages/ProbLog/problog/ptree.yap b/packages/ProbLog/problog/ptree.yap index 845f1d5da..bb64f5800 100644 --- a/packages/ProbLog/problog/ptree.yap +++ b/packages/ProbLog/problog/ptree.yap @@ -265,7 +265,7 @@ :- initialization( ( predicate_property(trie_disable_hash, imported_from(_M)) -> trie_disable_hash - ; true % stop_low_level_trace, print_message(warning,'The predicate trie_disable_hash/0 does not exist. Please update trie library.') + ; print_message(warning,'The predicate tries:trie_disable_hash/0 does not exist. Please update trie library.') ) ). @@ -276,7 +276,7 @@ :- initialization(( problog_define_flag(use_db_trie, problog_flag_validate_boolean, 'use the builtin trie 2 trie transformation', false), problog_define_flag(db_trie_opt_lvl, problog_flag_validate_integer, 'optimization level for the trie 2 trie transformation', 0), - problog_define_flag(compare_opt_lvl, problog_flag_validate_boolean, 'comparison mode for optimizatione level', false), + problog_define_flag(compare_opt_lvl, problog_flag_validate_boolean, 'comparison mode for optimization level', false), problog_define_flag(db_min_prefix, problog_flag_validate_integer, 'minimum size of prefix for dbtrie to optimize', 2), problog_define_flag(use_naive_trie, problog_flag_validate_boolean, 'use the naive algorithm to generate bdd scripts', false), problog_define_flag(use_old_trie, problog_flag_validate_boolean, 'use the old trie 2 trie transformation no nested', true), diff --git a/packages/ProbLog/problog_examples/learn_graph.pl b/packages/ProbLog/problog_examples/learn_graph.pl index 1970599d4..5f29b8062 100644 --- a/packages/ProbLog/problog_examples/learn_graph.pl +++ b/packages/ProbLog/problog_examples/learn_graph.pl @@ -15,31 +15,32 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :- use_module(library(matrix)). -:- use_module('../problog_learning'). +:- use_module(('../problog_learning')). +:- stop_low_level_trace. %%%% % background knowledge -%%%% +%%%% % definition of acyclic path using list of visited nodes path(X,Y) :- path(X,Y,[X],_). path(X,X,A,A). -path(X,Y,A,R) :- - X\==Y, - edge(X,Z), - absent(Z,A), +path(X,Y,A,R) :- + X\==Y, + edge(X,Z), + absent(Z,A), path(Z,Y,[Z|A],R). % using directed edges in both directions -edge(X,Y) :- dir_edge(Y,X). -edge(X,Y) :- dir_edge(X,Y). +edge(X,Y) :- problog:dir_edge(Y,X). +edge(X,Y) :- problog:dir_edge(X,Y). % checking whether node hasn't been visited before absent(_,[]). absent(X,[Y|Z]):-X \= Y, absent(X,Z). %%%% -% probabilistic facts +% probabilistic facts % - probability represented by t/1 term means learnable parameter % - argument of t/1 is real value (used to compare against in evaluation when known), use t(_) if unknown %%%% @@ -53,7 +54,7 @@ t(0.7)::dir_edge(5,3). t(0.2)::dir_edge(5,4). %%%%%%%%%%%%%% -% training examples of form example(ID,Query,DesiredProbability) +% training examples of form example(ID,Query,DesiredProbability) %%%%%%%%%%%%%% example(1,path(1,2),0.94). @@ -79,7 +80,7 @@ example(19,(dir_edge(2,6),dir_edge(6,5)),0.2). example(20,(dir_edge(1,2),dir_edge(2,3),dir_edge(3,4)),0.432). %%%%%%%%%%%%%% -% test examples of form test_example(ID,Query,DesiredProbability) +% test examples of form test_example(ID,Query,DesiredProbability) % note: ID namespace is shared with training example IDs %%%%%%%%%%%%%% @@ -99,7 +100,7 @@ test_example(33,path(5,4),0.57). test_example(34,path(6,4),0.51). test_example(35,path(6,5),0.69). -:- set_problog_flag(init_method,(Query,_,BDD, - problog_exact_lbdd(user:Query,BDD))). +%:- set_problog_flag(init_method,(Query,_,BDD, +% problog_exact(user:Query,_,BDD))). diff --git a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl index b495c9b17..19b9b5373 100644 --- a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl +++ b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl @@ -14,8 +14,7 @@ % will run 20 iterations of learning with default settings %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -:- use_module(library(problog)). -:- use_module(library(problog_learning_lbdd)). +:- use_module(library(problog_learning)). %%%% % background knowledge diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index 9d7e5aa33..a07140187 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -581,8 +581,7 @@ bdd_input_file(Filename) :- concat_path_with_filename(Dir,'input.txt',Filename). init_one_query(QueryID,Query,_Type) :- -writeln(init_one_query(QueryID,Query,_Type)), - % format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), +% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % if BDD file does not exist, call ProbLog @@ -593,15 +592,13 @@ writeln(init_one_query(QueryID,Query,_Type)), format_learning(3,' Reuse existing BDD ~q~n~n',[QueryID]) ; b_setval(problog_required_keep_ground_ids,false), - (QueryID mod 100 =:= 0 -> writeln(QueryID) ; true), - - problog_flag(init_method,(Query,N,Bdd,G)), + problog_flag(init_method,(Query,N,Bdd,graph2bdd(X,Y,N,Bdd))), Query =.. [_,X,Y] -> Bdd = bdd(Dir, Tree, MapList), ( - G + graph2bdd(X,Y,N,Bdd) -> rb_new(H0), maplist_to_hash(MapList, H0, Hash), @@ -611,9 +608,8 @@ writeln(init_one_query(QueryID,Query,_Type)), % Grad=[] ), write('.'), - recordz(QueryID,bdd(Dir, Grad, MapList),_) - ). -/* ; + recordz(QueryID,bdd(Dir, Grad, MapList),_) + ; problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,NOf,Bdd))) -> b_setval(problog_required_keep_ground_ids,false), rb_new(H0), @@ -628,20 +624,20 @@ writeln(init_one_query(QueryID,Query,_Type)), tree_to_grad(Tree, Hash, [], Grad), recordz(QueryID,bdd(Dir, Grad, MapList),_) ; - - problog_flag(init_method,(Query,NOf,Bdd,_Call)) , - Query = gene(X,Y), + problog_flag(init_method,(Query,NOf,Bdd,Call)) -> b_setval(problog_required_keep_ground_ids,false), rb_new(H0), Bdd = bdd(Dir, Tree, MapList), - user:graph2bdd(X,Y,1,Bdd), +% trace, + problog:Call, maplist_to_hash(MapList, H0, Hash), Tree \= [], %put_code(0'.), tree_to_grad(Tree, Hash, [], Grad), - recordz(QueryID,bdd(Dir, Grad, MapList),_). + recordz(QueryID,bdd(Dir, Grad, MapList),_) + ). + -*/ %======================================================================== diff --git a/packages/ProbLog/problog_learning.yap b/packages/ProbLog/problog_learning.yap index a9f3993db..857f3580c 100644 --- a/packages/ProbLog/problog_learning.yap +++ b/packages/ProbLog/problog_learning.yap @@ -1487,10 +1487,12 @@ my_5_min(V1,V2,V3,V4,V5,F1,F2,F3,F4,F5,VMin,FMin) :- %======================================================================== init_flags :- + writeln(10), prolog_file_name('queries',Queries_Folder), % get absolute file name for './queries' prolog_file_name('output',Output_Folder), % get absolute file name for './output' problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general), problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler), + writeln(10), problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general), problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general), problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general), @@ -1529,3 +1531,4 @@ init_logger :- :- initialization(init_flags). :- initialization(init_logger). + diff --git a/pl/consult.yap b/pl/consult.yap index 61c05716c..b5c09eb82 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -770,6 +770,7 @@ db_files(Fs) :- '$lf_opt'(imports, TOpts, Imports), '$import_to_current_module'(File, ContextModule, Imports, _, TOpts), '$current_module'(Mod, SourceModule), + %`writeln(( ContextModule/Mod )), set_prolog_flag(verbose_load, VerboseLoad), H is heapused-H0, '$cputime'(TF,_), T is TF-T0, print_message(informational, loaded(EndMsg, File, Mod, T, H)), diff --git a/pl/corout.yap b/pl/corout.yap index 69c93da07..e62bad6cb 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -305,7 +305,7 @@ prolog:when(_,Goal) :- % '$declare_when'(Cond, G) :- generate_code_for_when(Cond, G, Code), - '$$compile'(Code, Module, assertz, Code, _), fail. + '$$compile'(Code, assertz, Code, _), fail. '$declare_when'(_,_). % @@ -433,7 +433,6 @@ suspend_when_goals([_|_], _). % prolog:'$block'(Conds) :- generate_blocking_code(Conds, _, Code), - '$yap_strip_module'(Code, Module, NCode), '$$compile'(Code, assertz, Code, _), fail. prolog:'$block'(_). diff --git a/pl/meta.yap b/pl/meta.yap index 7e54109d4..fc6e91444 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -463,8 +463,9 @@ meta_predicate(P) :- % A4: module for body of clause (this is the one used in looking up predicates) % % has to be last!!! -'$expand_a_clause'(MHB, SM0, Cl1, ClO) :- % MHB is the original clause, SM0 the current source, Cl1 and ClO output clauses - '$yap_strip_module'(SM0:MHB, SM, HB), % remove layers of modules over the clause. SM is the source module. +'$expand_a_clause'(MHB, Cl1, ClO) :- % MHB is the original clause, SM0 the current source, Cl1 and ClO output clauses + source_module(SM0), + '$yap_strip_module'(MHB, SM, HB), % remove layers of modules over the clause. SM is the head module. '$head_and_body'(HB, H, B), % HB is H :- B. '$yap_strip_module'(SM:H, HM, NH), % further module expansion '$not_imported'(NH, HM), diff --git a/pl/modules.yap b/pl/modules.yap index b4193a6df..2f4a4166a 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -450,25 +450,29 @@ export_list(Module, List) :- !. '$do_import'(N0/K0-N0/K0, Mod, Mod) :- !. '$do_import'(N0/K0-N0/K0, _Mod, prolog) :- !. -'$do_import'(_N/K-N1/K, _Mod, ContextMod) :- - 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. - \+ '$undefined'(S,ContextMod), !. -'$do_import'( N/K-N1/K, Mod, ContextMod) :- - functor(G,N,K), - '$one_predicate_definition'(Mod:G,M0:G0), - M0\=prolog, - (Mod\=M0->N\=N1;true), - G0=..[_N0|Args], +% '$do_import'(_N/K-N1/K, _Mod, ContextMod) :- +% 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. +% \+ '$undefined'(S,ContextMod), !. +'$do_import'( N0/K-N1/K, M0, ContextMod) :- + %'$one_predicate_definition'(Mod:G,M0:G0), +% M0\=prolog, + (M0==ContextMod->N0\=N1;true), + functor(G1,N1,K), + (N0 == N1 + -> + G0=G1 + ; G1=..[N1|Args], - 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'(_,_,_). + G0=..[N0|Args] + ), + %writeln((ContextMod:G1:-M0:G0)), + recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_), + !. +'$do_import'( _,_,_ ). + '$follow_import_chain'(M,G,M0,G0) :- recorded('$import','$import'(M1,M,G1,G,_,_),_), M \= M1, !, @@ -480,7 +484,7 @@ export_list(Module, List) :- recorded('$import','$import'(MI, ContextM, _, _, N,K),_R), % dereference MI to M1, in order to find who % is actually generating - ( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ), + ( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ), ( '$module_produced by'(M2, Mod, N, K) -> true ; Mod = M2 ), M2 \= M1, !, '$redefine_import'( M1, M2, Mod, ContextM, N/K). @@ -727,4 +731,5 @@ module_state :- fail. module_state. -%% @} +%% @}imports + diff --git a/pl/preddyns.yap b/pl/preddyns.yap index a09f37e9e..3a0292d46 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -50,8 +50,8 @@ assert(Clause) :- '$assert'(Clause, assertz, _). '$assert'(Clause, Where, R) :- - '$expand_clause'(Clause0,C0,C), - '$$compile'(CC, Where, C0, R). + '$expand_clause'(Clause,C0,C), + '$$compile'(C, Where, C0, R). /** @pred asserta(+ _C_,- _R_) diff --git a/pl/preds.yap b/pl/preds.yap index 5be04dd24..ecc359224 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -388,13 +388,8 @@ or built-in. */ predicate_property(Pred,Prop) :- - ( - current_predicate(_,Pred), - '$yap_strip_module'(Pred, Mod, TruePred) - ; - '$current_predicate'(_,M,Pred,system), - '$yap_strip_module'(M:Pred, Mod, TruePred) - ), + '$yap_strip_module'(Pred, Mod, TruePred), + (var(Mod) -> current_module(Mod) ; true ), '$predicate_definition'(Mod:TruePred, M:NPred), '$predicate_property'(NPred,M,Mod,Prop). diff --git a/pl/top.yap b/pl/top.yap index 41f544686..157730be2 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -218,23 +218,22 @@ live :- '$go_compile_clause'(G, _Vs, _Pos, Where, Source) :- '$precompile_term'(G, Source, G1), !, - '$$compile'(G1, M, Where, Source, _). + '$$compile'(G1, Where, Source, _). '$go_compile_clause'(G,_Vs,_Pos, _Where, _Source) :- throw(error(system, compilation_failed(G))). '$$compile'(C, Where, C0, R) :- - '$head_and_body'( M0:C, MH, B ), - '$yap_strip_module'( MH, Mod, H), - '$yap_strip_module'( MB, ModB, BF), + '$head_and_body'( C, H, B ), + '$yap_strip_module'(H,Mod,H0), ( - '$undefined'(H, Mod) + '$undefined'(H0, Mod) -> - '$init_pred'(H, Mod, Where) + '$init_pred'(H0, Mod, Where) ; - trueq + true ), % writeln(Mod:((H:-B))), - '$compile'((H:-ModB:BF), Where, C0, Mod, R). + '$compile'((H0:-B), Where, C0, Mod, R). '$init_pred'(H, Mod, _Where ) :- recorded('$import','$import'(NM,Mod,NH,H,_,_),RI), @@ -784,8 +783,7 @@ Command = (H --> B) -> '$boot_dcg'( H, B, Where ) :- '$translate_rule'((H --> B), (NH :- NB) ), - '$yap_strip_module'((NH :- NB), M, G), - '$$compile'(G, M, Where, ( H --> B), _R), + '$$compile'((NH :- NB), Where, ( H --> B), _R), !. '$boot_dcg'( H, B, _ ) :- format(user_error, ' ~w --> ~w failed.~n', [H,B]). @@ -877,8 +875,7 @@ gated_call(Setup, Goal, Catcher, Cleanup) :- '$precompile_term'(Term, Term, Term). '$expand_clause'(InputCl, C1, CO) :- - '$yap_strip_module'(InputCl, M, ICl), - '$expand_a_clause'( M:ICl, M, C1, CO), + '$expand_a_clause'( InputCl, C1, CO), !. '$expand_clause'(Cl, Cl, Cl). diff --git a/pl/undefined.yap b/pl/undefined.yap index 37b8fb4c3..b93b9dd77 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -97,28 +97,17 @@ undefined_query(G0, M0, Cut) :- '$undefp'([M0|G0],true) :- % make sure we do not loop on undefined predicates setup_call_cleanup( - '$undef_setup'(M0:G0, Action,Debug,Current, MGI), - '$get_undefined_predicate'( MGI, MG ), + '$undef_setup'(Action,Debug,Current), + '$get_undefined_predicate'( M0:G0, MG ), '$undef_cleanup'(Action,Debug,Current) ), - '$undef_error'(Action, M0:G0, MGI, MG). + '$undef_error'(Action, M0:G0, MG). -'$undef_setup'(G0,Action,Debug,Current,G0) :- +'$undef_setup'(Action,Debug,Current) :- yap_flag( unknown, Action, fail), yap_flag( debug, Debug, false), '$stop_creeping'(Current). - -'$g2i'(user:G, Na/Ar ) :- - !, - functor(G, Na, Ar). -'$g2i'(prolog:G, Na/Ar ) :- - !, - functor(G, Na, Ar). -'$g2i'(M:G, M:Na/Ar ) :- - !, - functor(G, Na, Ar). - '$undef_cleanup'(Action,Debug, _Current) :- yap_flag( unknown, _, Action), yap_flag( debug, _, Debug). @@ -137,22 +126,22 @@ The unknown predicate, informs about what the user wants to be done */ -'$undef_error'(_, _, _, M:G) :- +'$undef_error'(_, _, M:G) :- nonvar(M), nonvar(G), !, '$start_creep'([M|G], creep). -'$undef_error'(_, M0:G0, _, MG) :- +'$undef_error'(_, M0:G0, M:G) :- '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), '$yap_strip_module'(M0:G0, EM0, GM0), - user:unknown_predicate_handler(GM0,EM0,MG), + user:unknown_predicate_handler(GM0,EM0,M:G), !, - '$start_creep'([prolog|true], creep). -'$undef_error'(error, Mod:Goal, I,_) :- - '$do_error'(existence_error(procedure,I), Mod:Goal). -'$undef_error'(warning,Mod:Goal,I,_) :- + '$start_creep'([M|G], creep). +'$undef_error'(error, Mod:Goal,_) :- + '$do_error'(existence_error(procedure,Mod:Goal), Mod:Goal). +'$undef_error'(warning,Mod:Goal,_) :- '$program_continuation'(PMod,PName,PAr), - print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))), + print_message(warning,error(existence_error(procedure,Mod:Goal), context(Mod:Goal,PMod:PName/PAr))), %'$start_creep'([prolog|fail], creep), fail. '$undef_error'(fail,_Goal,_,_Mod) :- From 9378622d4257f12242379786d81a611168ff4940 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sat, 9 Mar 2019 06:50:09 +0000 Subject: [PATCH 072/101] current_prdicate/2 r Please enter the commit message for your changes. Lines starting --- packages/ProbLog/problog.yap | 7 +- packages/ProbLog/problog_lbfgs.yap | 105 +++++++++++++++-------------- pl/preds.yap | 33 +++++---- 3 files changed, 77 insertions(+), 68 deletions(-) diff --git a/packages/ProbLog/problog.yap b/packages/ProbLog/problog.yap index b2756df63..23e527daa 100644 --- a/packages/ProbLog/problog.yap +++ b/packages/ProbLog/problog.yap @@ -521,7 +521,12 @@ every 5th iteration only. atom_concat(PD0, '../../bin', PD), set_problog_path(PD). -:- PD = '/usr/local/bin', +:- yap_flag(executable, Bin), + file_directory_name(Bin, PD), + set_problog_path(PD). + + +:- PD = '/usxor/local/bin', set_problog_path(PD). diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index a07140187..3dc2f541a 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -507,7 +507,7 @@ init_learning :- %======================================================================== %= Updates all values of query_probability/2 and query_gradient/4 %= should be called always before these predicates are accessed -%= if the old values are still valid, nothing happens +%= if the old values are still valid, nothing happensv %======================================================================== update_values :- @@ -518,8 +518,6 @@ update_values :- retractall(query_gradient_intern(_,_,_,_)). - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check, if continuous facts are used. % if yes, switch to problog_exact @@ -573,7 +571,7 @@ empty_bdd_directory. init_queries :- empty_bdd_directory, format_learning(2,'Build BDDs for examples~n',[]), - forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)), + forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)), forall(user:example(ID,Query,_Prob,_),init_one_query(ID,Query,training)). bdd_input_file(Filename) :- @@ -581,63 +579,70 @@ bdd_input_file(Filename) :- concat_path_with_filename(Dir,'input.txt',Filename). init_one_query(QueryID,Query,_Type) :- -% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), + % format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % if BDD file does not exist, call ProbLog %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ( - recorded(QueryID, _, _) - -> - format_learning(3,' Reuse existing BDD ~q~n~n',[QueryID]) - ; b_setval(problog_required_keep_ground_ids,false), (QueryID mod 100 =:= 0 -> writeln(QueryID) ; true), - problog_flag(init_method,(Query,N,Bdd,graph2bdd(X,Y,N,Bdd))), - Query =.. [_,X,Y] - -> - Bdd = bdd(Dir, Tree, MapList), - ( - graph2bdd(X,Y,N,Bdd) - -> + Query =.. [_|Args], + % problog_flag(init_method,(Query,N,Bdd,M:graph2bdd(Args,N,Bdd))), + Bdd = bdd(Dir, Tree, + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + u3777777777/....777;;;;;;;;;;;;;;;;;;;666666666MapList), + user:graph2bdd(Args,N,Bdd), rb_new(H0), maplist_to_hash(MapList, H0, Hash), - tree_to_grad(Tree, Hash, [], Grad) + tree_to_grad(Tree, Hash, [], Grad), % ; % Bdd = bdd(-1,[],[]), % Grad=[] - ), write('.'), - recordz(QueryID,bdd(Dir, Grad, MapList),_) - ; - problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,NOf,Bdd))) -> - b_setval(problog_required_keep_ground_ids,false), - rb_new(H0), - strip_module(Call,_,Goal), - !, - Bdd = bdd(Dir, Tree, MapList), -% trace, - problog:problog_kbest_as_bdd(Goal,NOf,Bdd), - maplist_to_hash(MapList, H0, Hash), - Tree \= [], - %put_code(0'.), - tree_to_grad(Tree, Hash, [], Grad), - recordz(QueryID,bdd(Dir, Grad, MapList),_) - ; - problog_flag(init_method,(Query,NOf,Bdd,Call)) -> - b_setval(problog_required_keep_ground_ids,false), - rb_new(H0), - Bdd = bdd(Dir, Tree, MapList), -% trace, - problog:Call, - maplist_to_hash(MapList, H0, Hash), - Tree \= [], - %put_code(0'.), - tree_to_grad(Tree, Hash, [], Grad), - recordz(QueryID,bdd(Dir, Grad, MapList),_) - ). - - + recordz(QueryID,bdd(Dir, Grad, MapList),_). %======================================================================== @@ -1010,7 +1015,7 @@ user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :- %======================================================================== init_flags :- - prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries' +% prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries' prolog_file_name(output,Output_Folder), % get absolute file name for './output' problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general), problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler), diff --git a/pl/preds.yap b/pl/preds.yap index ecc359224..dae99f594 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -473,27 +473,26 @@ predicate_erased_statistics(P0,NCls,Sz,ISz) :- Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_. */ -current_predicate(A,T0) :- - '$yap_strip_module'(T0, M, T), - ( var(M) - -> - '$all_current_modules'(M) - ; - true - ), - (nonvar(T) -> functor(T, A, _) ; true ), +current_predicate(A0,T0) :- + + ( nonvar(T0) -> '$yap_strip_module'(T0, M, T) ; T0 = T ), + ( nonvar(A0) -> '$yap_strip_module'(A0, MA0, A) ; A0 = A ), + M = MA0, ( - '$current_predicate'(A,M, T, user) - ; - (nonvar(T) + var(M) -> - '$imported_predicate'(M:T, M1:T1) + true ; - '$imported_predicate'(M:T, M1:T1) + '$all_current_modules'(M) ), - functor(T1, A, _), - \+ '$is_system_predicate'(T1,M1) - ). + % M is bound + ( + '$current_predicate'(A,M,T,user) + ; + '$imported_predicate'(M:T, M1T1), M1T1 \= M:T + ), + functor(T, A, _). + /** @pred system_predicate( ?_P_ ) From ab56074bb1a1f428c5c0c2a1781e00b02bb58f03 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sat, 9 Mar 2019 11:23:30 +0000 Subject: [PATCH 073/101] assert(3) --- C/cdmgr.c | 43 +++++++++++++++++++ C/exec.c | 42 ------------------ C/lu_absmi_insts.h | 2 +- .../ProbLog/problog_examples/learn_graph.pl | 4 +- .../problog_examples/learn_graph_lbdd.pl | 1 + packages/ProbLog/problog_learning.yap | 23 +++++----- 6 files changed, 58 insertions(+), 57 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index c14a69ab0..c7fd23566 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -74,6 +74,49 @@ static void kill_first_log_iblock(LogUpdIndex *, LogUpdIndex *, PredEntry *); #define PredArity(p) (p->ArityOfPE) #define TRYCODE(G, F, N) ((N) < 5 ? (op_numbers)((int)F + (N)*3) : G) +PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) { + Term t0 = t; + +restart: + if (IsVarTerm(t)) { + Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); + return NULL; + } else if (IsAtomTerm(t)) { + PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod)); + return ap; + } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { + return Yap_FindLUIntKey(IntegerOfTerm(t)); + } else if (IsPairTerm(t)) { + t = Yap_MkApplTerm(FunctorCsult, 1, &t); + goto restart; + } else if (IsApplTerm(t)) { + Functor fun = FunctorOfTerm(t); + if (IsExtensionFunctor(fun)) { + Yap_ThrowError(TYPE_ERROR_CALLABLE, t, pname); + return NULL; + } + if (fun == FunctorModule) { + Term tmod = ArgOfTerm(1, t); + if (IsVarTerm(tmod)) { + Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); + return NULL; + } + if (!IsAtomTerm(tmod)) { + Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname); + return NULL; + } + t = ArgOfTerm(2, t); + goto restart; + } + PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod)); + return ap; + } else { + Yap_ThrowError(TYPE_ERROR_CALLABLE, t0, pname); + } + return NULL; +} + + static void InitConsultStack(void) { CACHE_REGS LOCAL_ConsultLow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj) * diff --git a/C/exec.c b/C/exec.c index 58f9788c4..3d9aae042 100755 --- a/C/exec.c +++ b/C/exec.c @@ -159,48 +159,6 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) { return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts); } -PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) { - Term t0 = t; - -restart: - if (IsVarTerm(t)) { - Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); - return NULL; - } else if (IsAtomTerm(t)) { - PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod)); - return ap; - } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { - return Yap_FindLUIntKey(IntegerOfTerm(t)); - } else if (IsPairTerm(t)) { - t = Yap_MkApplTerm(FunctorCsult, 1, &t); - goto restart; - } else if (IsApplTerm(t)) { - Functor fun = FunctorOfTerm(t); - if (IsExtensionFunctor(fun)) { - Yap_ThrowError(TYPE_ERROR_CALLABLE, t, pname); - return NULL; - } - if (fun == FunctorModule) { - Term tmod = ArgOfTerm(1, t); - if (IsVarTerm(tmod)) { - Yap_Error(INSTANTIATION_ERROR, t0, pname); - return NULL; - } - if (!IsAtomTerm(tmod)) { - Yap_Error(TYPE_ERROR_ATOM, t0, pname); - return NULL; - } - t = ArgOfTerm(2, t); - goto restart; - } - PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod)); - return ap; - } else { - Yap_Error(TYPE_ERROR_CALLABLE, t0, pname); - } - return NULL; -} - Term Yap_TermToIndicator(Term t, Term mod) { CACHE_REGS diff --git a/C/lu_absmi_insts.h b/C/lu_absmi_insts.h index bc67bebdf..96b25f44b 100644 --- a/C/lu_absmi_insts.h +++ b/C/lu_absmi_insts.h @@ -470,7 +470,7 @@ LogUpdClause *lcl = PREG->y_u.OtILl.d; UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]); - /* fprintf(stderr,"- %p/%p %d %d %p\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->y_u.OtILl.d->ClCode);*/ + fprintf(stderr,"- %p/%p %lu/%lu %lu-%lu\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->y_u.OtILl.d->ClTimeStart,PREG->y_u.OtILl.d->ClTimeEnd); #if defined(YAPOR) || defined(THREADS) if (PP != ap) { if (PP) UNLOCKPE(16,PP); diff --git a/packages/ProbLog/problog_examples/learn_graph.pl b/packages/ProbLog/problog_examples/learn_graph.pl index 5f29b8062..c8f391a5f 100644 --- a/packages/ProbLog/problog_examples/learn_graph.pl +++ b/packages/ProbLog/problog_examples/learn_graph.pl @@ -32,8 +32,8 @@ path(X,Y,A,R) :- path(Z,Y,[Z|A],R). % using directed edges in both directions -edge(X,Y) :- problog:dir_edge(Y,X). -edge(X,Y) :- problog:dir_edge(X,Y). +edge(X,Y) :- dir_edge(Y,X). +edge(X,Y) :- dir_edge(X,Y). % checking whether node hasn't been visited before absent(_,[]). diff --git a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl index 19b9b5373..1e30c9285 100644 --- a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl +++ b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl @@ -98,3 +98,4 @@ test_example(33,path(5,4),0.57). test_example(34,path(6,4),0.51). test_example(35,path(6,5),0.69). +:- set_problog_flag(init_method,([Query,X,Y],N,Bdd,graph2bdd(X,Y,N,Bdd))). diff --git a/packages/ProbLog/problog_learning.yap b/packages/ProbLog/problog_learning.yap index 857f3580c..019463a57 100644 --- a/packages/ProbLog/problog_learning.yap +++ b/packages/ProbLog/problog_learning.yap @@ -363,7 +363,7 @@ reset_learning :- retractall(current_iteration(_)), retractall(example_count(_)), retractall(query_probability_intern(_,_)), - retractall(query_gradient_intern(_,_,_)), + retractall(query_gradient_intern(_,_,_,_)), retractall(last_mse(_)), retractall(query_is_similar(_,_)), retractall(query_md5(_,_,_)), @@ -392,7 +392,7 @@ do_learning(Iterations,Epsilon) :- Iterations>0, do_learning_intern(Iterations,Epsilon). do_learning(_,_) :- - format(user_error,'~n~Error: No training examples specified.~n~n',[]). + format(user_error,'~n~Error: Not raining examples specified.~n~n',[]). do_learning_intern(0,_) :- @@ -430,6 +430,7 @@ do_learning_intern(Iterations,Epsilon) :- ( retractall(last_mse(_)), logger_get_variable(mse_trainingset,Current_MSE), + writeln(Current_MSE:Last_MSE), assertz(last_mse(Current_MSE)), !, MSE_Diff is abs(Last_MSE-Current_MSE) @@ -444,7 +445,6 @@ do_learning_intern(Iterations,Epsilon) :- (problog_flag(rebuild_bdds,BDDFreq),BDDFreq>0,0 =:= CurrentIteration mod BDDFreq) -> ( - retractall(values_correct), retractall(query_is_similar(_,_)), retractall(query_md5(_,_,_)), empty_bdd_directory, @@ -627,12 +627,13 @@ init_one_query(QueryID,Query,Type) :- % check wether this BDD is similar to another BDD %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ( - problog_flag(check_duplicate_bdds,true) +listing(query_md5), + problog_flag(check_duplicate_bdds,true) -> ( - calc_md5(Filename,Query_MD5), + calc_md5(Filename,Query_MD5), ( - query_md5(OtherQueryID,Query_MD5,Type) + query_md5(OtherQueryID,Query_MD5,Type) -> ( assertz(query_is_similar(QueryID,OtherQueryID)), @@ -682,7 +683,7 @@ update_values :- problog:dynamic_probability_fact_extract(Term, Prob2), inv_sigmoid(Prob2,Value), format(Handle, '@x~q_~q~n~10f~n', [ID,GID, Value]))) - ; non_ground_fact(ID) -> + ; non_ground_fact(ID) -> inv_sigmoid(Prob,Value), format(Handle,'@x~q_*~n~10f~n',[ID,Value]) ; @@ -699,7 +700,6 @@ update_values :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % stop write current probabilities to file %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - assertz(values_correct). @@ -710,7 +710,7 @@ update_values :- %= %======================================================================== -update_query_cleanup(QueryID) :- + listing( ( (query_is_similar(QueryID,_) ; query_is_similar(_,QueryID)) -> @@ -734,7 +734,7 @@ update_query(QueryID,Symbol,What_To_Update) :- ( problog_flag(sigmoid_slope,Slope), ((What_To_Update=all;query_is_similar(_,QueryID)) -> Method='g' ; Method='l'), - convert_filename_to_problog_path('simplecudd', Simplecudd), + convert_filename_to_problog_path('simplecudd', Simplecudd), atomic_concat([Simplecudd, ' -i "', Probabilities_File, '"', ' -l "', Query_Directory,'/query_',QueryID, '"', @@ -744,7 +744,6 @@ update_query(QueryID,Symbol,What_To_Update) :- ' > "', Output_Directory, 'values.pl"'],Command), - shell(Command,Error), %shell('cat /home/vsc/Yap/bins/devel/outputvalues.pl',_), @@ -816,7 +815,7 @@ my_load_intern(query_gradient(QueryID,XFactID,Type,Value),Handle,QueryID) :- !, atomic_concat(x,FactID,XFactID), % atom_number(StringFactID,FactID), - assertz(query_gradient_intern(QueryID,FactID,Type,Value)), + assertz(query_gradient_intern(QueryID,XFactID,Type,Value)), read(Handle,X), my_load_intern(X,Handle,QueryID). my_load_intern(X,Handle,QueryID) :- From 4d2b18908deebe89ea9689aa5ae4ae5d545b4496 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 11 Mar 2019 19:05:39 +0000 Subject: [PATCH 074/101] fixes --- C/cdmgr.c | 8 ++++---- CMakeLists.txt | 7 ++++++- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index d7cefa454..3d578ddb4 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1461,7 +1461,7 @@ static int not_was_reconsulted(PredEntry *p, Term t, int mode) { // p->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1); } LOCAL_LastAssertedPred = p; - return TRUE; /* careful */ + ret>urn TRUE; /* careful */ } static yamop *addcl_permission_error(const char *file, const char *function, @@ -1748,7 +1748,7 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref) PELOCK(20, p); /* we are redefining a prolog module predicate */ if (Yap_constPred(p)) { - addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, p, + addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, tf, FALSE); UNLOCKPE(30, p); return false; @@ -2185,7 +2185,7 @@ static Int p_purge_clauses(USES_REGS1) { /* '$purge_clauses'(+Func) */ PELOCK(21, pred); if (pred->PredFlags & StandardPredFlag) { UNLOCKPE(33, pred); - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, pred), "assert/1"); + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, t), "assert/1"); return (FALSE); } purge_clauses(pred); @@ -4102,7 +4102,7 @@ static Int | TabledPredFlag #endif /* TABLING */ )) { - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, ap), + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, t), "dbload_get_space/4"); return FALSE; } diff --git a/CMakeLists.txt b/CMakeLists.txt index 1b6e814d6..d96b4c0d0 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -384,6 +384,10 @@ if (GMP_INCLUDE_DIRS) # READLINE_readline_LIBRARY, where to find the READLINE library. # READLINE_ncurses_LIBRARY, where to find the ncurses library [might not be defined] +if (ANDROID) + option (WITH_READLINE "use Readline" OFF) + else() + include(FindReadline) option (WITH_READLINE "use Readline" ON) @@ -392,13 +396,14 @@ if (GMP_INCLUDE_DIRS) # # ADD_SUBDIRECTORY(console/terminal) - if (READLINE_FOUND) + if (READLINE_FOUND AND READLINE_INCLUDE_DIR) List(APPEND YAP_SYSTEM_OPTIONS readline) # required for configure include_directories( ${READLINE_INCLUDE_DIR} ${READLINE_INCLUDE_DIR}/readline ) endif () +endif() include_directories( ${CMAKE_SOURCE_DIR}/H From 4afbc4461c5b249cab4ca0148516e309cd42eba0 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 12 Mar 2019 10:51:39 +0000 Subject: [PATCH 075/101] problog --- C/arrays.c | 1 + C/c_interface.c | 19 +- C/cdmgr.c | 25 +-- C/exec.c | 65 ++++--- C/qlyr.c | 10 +- C/yap-args.c | 2 +- H/YapLFlagInfo.h | 31 +-- library/CMakeLists.txt | 1 + library/INDEX.yap | 1 + library/autoloader.yap | 3 +- library/lists.yap | 19 +- library/matrix.yap | 33 +++- .../ProbLog/problog_examples/learn_graph.pl | 2 +- .../problog_examples/learn_graph_lbdd.pl | 24 ++- packages/ProbLog/problog_lbfgs.yap | 183 +++++++----------- packages/ProbLog/problog_learning_lbdd.yap | 57 +++--- pl/consult.yap | 2 + pl/imports.yap | 10 +- pl/messages.yap | 3 +- pl/meta.yap | 17 +- pl/preds.yap | 15 +- pl/qly.yap | 6 +- pl/top.yap | 8 +- pl/undefined.yap | 67 ++++--- 24 files changed, 324 insertions(+), 280 deletions(-) create mode 100644 library/INDEX.yap diff --git a/C/arrays.c b/C/arrays.c index f0fa0fb11..4fbcd3da7 100644 --- a/C/arrays.c +++ b/C/arrays.c @@ -1066,6 +1066,7 @@ static Int create_static_array(USES_REGS1) { Int size; static_array_types props; void *address = NULL; + if (IsVarTerm(ti)) { Yap_Error(INSTANTIATION_ERROR, ti, "create static array"); diff --git a/C/c_interface.c b/C/c_interface.c index f2c7425cb..82da72fdf 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -421,8 +421,25 @@ X_API void *YAP_BlobOfTerm(Term t) { if (IsVarTerm(t)) return NULL; - if (!IsBigIntTerm(t)) + if (!IsBigIntTerm(t)) { + if (IsAtomTerm(t)) { + AtomEntry *ae = RepAtom(AtomOfTerm(t)); + StaticArrayEntry *pp; + + READ_LOCK(ae->ARWLock); + pp = RepStaticArrayProp(ae->PropsOfAE); + while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty) + pp = RepStaticArrayProp(pp->NextOfPE); + if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) { + READ_UNLOCK(ae->ARWLock); + return NULL; + } else { + READ_UNLOCK(ae->ARWLock); + return pp->ValueOfVE.ints; + } + } return NULL; + } src = (MP_INT *)(RepAppl(t) + 2); return (void *)(src + 1); } diff --git a/C/cdmgr.c b/C/cdmgr.c index c14a69ab0..f01008abf 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2069,6 +2069,7 @@ static Int p_startconsult(USES_REGS1) { /* '$start_consult'(+Mode) */ char *smode = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE; int mode; + setBooleanLocalPrologFlag(COMPILING_FLAG, AtomTrue); mode = strcmp("consult", (char *)smode); Yap_init_consult(mode, RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE); t = MkIntTerm(LOCAL_consult_level); @@ -2092,6 +2093,7 @@ static void end_consult(USES_REGS1) { /* if (LOCAL_consult_level == 0) do_toggle_static_predicates_in_use(FALSE);*/ #endif + setBooleanLocalPrologFlag(COMPILING_FLAG, AtomFalse); } void Yap_end_consult(void) { @@ -2388,19 +2390,12 @@ static Int * */ static Int new_multifile(USES_REGS1) { PredEntry *pe; - Atom at; - arity_t arity; pe = new_pred(Deref(ARG1), Deref(ARG2), "multifile"); if (EndOfPAEntr(pe)) return FALSE; PELOCK(30, pe); - arity = pe->ArityOfPE; - if (arity == 0) - at = (Atom)pe->FunctorOfPred; - else - at = NameOfFunctor(pe->FunctorOfPred); - + if (pe->PredFlags & MultiFileFlag) { UNLOCKPE(26, pe); return true; @@ -2631,18 +2626,11 @@ static Int p_set_owner_file(USES_REGS1) { /* '$owner_file'(+P,M,F) */ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */ PredEntry *pe; - Atom at; - arity_t arity; pe = new_pred(Deref(ARG1), Deref(ARG2), "dynamic"); if (EndOfPAEntr(pe)) return FALSE; PELOCK(30, pe); - arity = pe->ArityOfPE; - if (arity == 0) - at = (Atom)pe->FunctorOfPred; - else - at = NameOfFunctor(pe->FunctorOfPred); if (pe->PredFlags & (UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag | @@ -2694,18 +2682,11 @@ static Int p_is_dynamic(USES_REGS1) { /* '$is_dynamic'(+P) */ * */ static Int new_meta_pred(USES_REGS1) { PredEntry *pe; - Atom at; - arity_t arity; pe = new_pred(Deref(ARG1), Deref(ARG2), "meta_predicate"); if (EndOfPAEntr(pe)) return false; PELOCK(30, pe); - arity = pe->ArityOfPE; - if (arity == 0) - at = (Atom)pe->FunctorOfPred; - else - at = NameOfFunctor(pe->FunctorOfPred); if (pe->PredFlags & MetaPredFlag) { UNLOCKPE(26, pe); diff --git a/C/exec.c b/C/exec.c index 58f9788c4..e2dcc8879 100755 --- a/C/exec.c +++ b/C/exec.c @@ -183,11 +183,11 @@ restart: if (fun == FunctorModule) { Term tmod = ArgOfTerm(1, t); if (IsVarTerm(tmod)) { - Yap_Error(INSTANTIATION_ERROR, t0, pname); + Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); return NULL; } if (!IsAtomTerm(tmod)) { - Yap_Error(TYPE_ERROR_ATOM, t0, pname); + Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname); return NULL; } t = ArgOfTerm(2, t); @@ -196,7 +196,7 @@ restart: PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod)); return ap; } else { - Yap_Error(TYPE_ERROR_CALLABLE, t0, pname); + Yap_ThrowError(TYPE_ERROR_CALLABLE, t0, pname); } return NULL; } @@ -214,8 +214,7 @@ Term Yap_TermToIndicator(Term t, Term mod) { ti[0] = MkAtomTerm(AtomDot); ti[1] = MkIntTerm(2); } else { - ti[0] = t; - ti[1] = MkIntTerm(0); + return t; } t = Yap_MkApplTerm(FunctorSlash, 2, ti); if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) { @@ -254,7 +253,7 @@ static bool CallError(yap_error_number err, Term t, Term mod USES_REGS) { if (err == TYPE_ERROR_CALLABLE) { t = Yap_YapStripModule(t, &mod); } - Yap_Error(err, t, "call/1"); + Yap_ThrowError(err, t, "call/1"); return false; } } @@ -345,7 +344,7 @@ static PredEntry *new_pred(Term t, Term tmod, char *pname) { restart: if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t0, pname); + Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); return NULL; } else if (IsAtomTerm(t)) { return RepPredProp(PredPropByAtom(AtomOfTerm(t), tmod)); @@ -354,17 +353,17 @@ 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, Yap_TermToIndicator(t, tmod), pname); return NULL; } if (fun == FunctorModule) { Term tmod = ArgOfTerm(1, t); if (IsVarTerm(tmod)) { - Yap_Error(INSTANTIATION_ERROR, t0, pname); + Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); return NULL; } if (!IsAtomTerm(tmod)) { - Yap_Error(TYPE_ERROR_ATOM, t0, pname); + Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname); return NULL; } t = ArgOfTerm(2, t); @@ -601,7 +600,7 @@ static bool EnterCreepMode(Term t, Term mod USES_REGS) { if (Yap_get_signal(YAP_CDOVF_SIGNAL)) { ARG1 = t; if (!Yap_locked_growheap(FALSE, 0, NULL)) { - Yap_Error(RESOURCE_ERROR_HEAP, TermNil, + Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap at meta-call"); } if (!Yap_has_a_signal()) { @@ -780,7 +779,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */ restart_exec: if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1"); + Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1"); return FALSE; } else if (IsAtomTerm(t)) { Atom a = AtomOfTerm(t); @@ -852,9 +851,11 @@ static void prune_inner_computation(choiceptr parent) { Int oENV = LCL0 - ENV; cut_pt = B; - while (cut_pt->cp_b < parent) { + while (cut_pt && cut_pt->cp_b < parent) { cut_pt = cut_pt->cp_b; } + if (!cut_pt) + return; #ifdef YAPOR CUT_prune_to(cut_pt); #endif @@ -1231,7 +1232,7 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */ t = Yap_YapStripModule(t, &mod); restart_exec: if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1"); + Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1"); return false; } else if (IsAtomTerm(t)) { Atom a = AtomOfTerm(t); @@ -1285,7 +1286,7 @@ restart_exec: #endif } } else { - //Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); + //Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1"); //return false; return CallMetaCall(t, mod); } @@ -1306,11 +1307,11 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod) if (IsVarTerm(mod)) { mod = CurrentModule; } else if (!IsAtomTerm(mod)) { - Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1"); + Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1"); return FALSE; } if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1"); + Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "call/1"); return FALSE; } else if (IsAtomTerm(t)) { Atom a = AtomOfTerm(t); @@ -1388,11 +1389,11 @@ static Int execute_nonstop(USES_REGS1) { if (IsVarTerm(mod)) { mod = CurrentModule; } else if (!IsAtomTerm(mod)) { - Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1"); + Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1"); return FALSE; } if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1"); + Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "call/1"); return FALSE; } else if (IsAtomTerm(t)) { Atom a = AtomOfTerm(t); @@ -1425,7 +1426,7 @@ static Int execute_nonstop(USES_REGS1) { #endif } } else { - Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); + Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1"); return FALSE; } /* N = arity; */ @@ -1528,13 +1529,13 @@ static Int execute_10(USES_REGS1) { /* '$execute_10'(Goal) */ static Int execute_depth_limit(USES_REGS1) { Term d = Deref(ARG2); if (IsVarTerm(d)) { - Yap_Error(INSTANTIATION_ERROR, d, "depth_bound_call/2"); + Yap_ThrowError(INSTANTIATION_ERROR, d, "depth_bound_call/2"); return false; } else if (!IsIntegerTerm(d)) { if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) { DEPTH = RESET_DEPTH(); } else { - Yap_Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2"); + Yap_ThrowError(TYPE_ERROR_INTEGER, d, "depth_bound_call/2"); return false; } } else { @@ -1866,7 +1867,7 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { } return false; } else { - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed"); + Yap_ThrowError(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed"); return false; } } @@ -1889,7 +1890,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) { Functor f = FunctorOfTerm(t); if (IsBlobFunctor(f)) { - Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); + Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1"); return false; } /* I cannot use the standard macro here because @@ -1898,7 +1899,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) { pt = RepAppl(t) + 1; pe = PredPropByFunc(f, mod); } else { - Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); + Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1"); return false; } ppe = RepPredProp(pe); @@ -1939,7 +1940,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) { t = Yap_YapStripModule(t, &tmod); if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t, "call/1"); + Yap_ThrowError(INSTANTIATION_ERROR, t, "call/1"); LOCAL_PrologMode &= ~TopGoalMode; return (FALSE); } @@ -1958,7 +1959,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) { Functor f = FunctorOfTerm(t); if (IsBlobFunctor(f)) { - Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); + Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1"); LOCAL_PrologMode &= ~TopGoalMode; return (FALSE); } @@ -1969,7 +1970,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) { pt = RepAppl(t) + 1; arity = ArityOfFunctor(f); } else { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), "call/1"); + Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), "call/1"); LOCAL_PrologMode &= ~TopGoalMode; return (FALSE); } @@ -2001,7 +2002,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) { #if !USE_SYSTEM_MALLOC if (LOCAL_TrailTop - HeapTop < 2048) { - Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, + Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil, "unable to boot because of too little Trail space"); } #endif @@ -2031,7 +2032,7 @@ static void do_restore_regs(Term t, int restore_all USES_REGS) { static Int restore_regs(USES_REGS1) { Term t = Deref(ARG1); if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining"); + Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining"); return (FALSE); } if (IsAtomTerm(t)) @@ -2050,7 +2051,7 @@ static Int restore_regs2(USES_REGS1) { Int d; if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining"); + Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining"); return (FALSE); } d0 = Deref(ARG2); @@ -2058,7 +2059,7 @@ static Int restore_regs2(USES_REGS1) { do_restore_regs(t, TRUE PASS_REGS); } if (IsVarTerm(d0)) { - Yap_Error(INSTANTIATION_ERROR, d0, "support for coroutining"); + Yap_ThrowError(INSTANTIATION_ERROR, d0, "support for coroutining"); return (FALSE); } if (!IsIntegerTerm(d0)) { diff --git a/C/qlyr.c b/C/qlyr.c index cd67ce30a..2a59eb349 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -1113,17 +1113,23 @@ static Int qload_program(USES_REGS1) { YAP_file_type_t Yap_Restore(const char *s) { CACHE_REGS - FILE *stream = Yap_OpenRestore(s); + int lvl = push_text_stack(); + const char *tmp = Yap_AbsoluteFile(s, true); + + FILE *stream = Yap_OpenRestore(tmp); if (!stream) return -1; GLOBAL_RestoreFile = s; - if (do_header(stream) == NIL) + if (do_header(stream) == NIL) { + pop_text_stack(lvl); return YAP_PL; + } read_module(stream); setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true); fclose(stream); GLOBAL_RestoreFile = NULL; LOCAL_SourceModule = CurrentModule = USER_MODULE; + pop_text_stack(lvl); return YAP_QLY; } diff --git a/C/yap-args.c b/C/yap-args.c index dce1edeee..880d6da3c 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -142,7 +142,7 @@ static void init_globals(YAP_init_args *yap_init) { } if (yap_init->QuietMode) { - setVerbosity(TermSilent); + setBooleanLocalPrologFlag(VERBOSE_LOAD_FLAG, TermFalse); } } diff --git a/H/YapLFlagInfo.h b/H/YapLFlagInfo.h index 5949bc5c9..0269c16e2 100644 --- a/H/YapLFlagInfo.h +++ b/H/YapLFlagInfo.h @@ -52,6 +52,9 @@ YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL), YAP_FLAG(CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true", NULL), +/**< Indicates YAP is running within the compiler. */ + YAP_FLAG(COMPILING_FLAG, "compiling", false, booleanFlag, + "true", NULL), /**< support for coding systens, YAP relies on UTF-8 internally. */ YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc), @@ -69,9 +72,10 @@ YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL), */ YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap", NULL), - YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag, +/**< Show the execution stack in exceptions. */ + YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", false, booleanFlag, "true", NULL), - /**<` + /**< If `true` show a stack dump when YAP finds an error. The default is `off`. @@ -91,19 +95,20 @@ Report the syntax error and generate an error (default). + `quiet` Just fail */ - YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error", - NULL), - /**< - If bound, set the current working or type-in module to the argument, - which must be an atom. If unbound, unify the argument with the current - working module. - - */ - YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user", + YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error", + NULL), +/**< + If bound, set the current working or type-in module to the argument, + which must be an atom. If unbound, unify the argument with the current + working module. + +*/ + YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user", typein), + /**< If `normal` allow printing of informational and banner messages, @@ -131,8 +136,8 @@ Just fail is `true` by default except if YAP is booted with the `-L` flag. */ - YAP_FLAG(VERBOSE_LOAD_FLAG, "verbose_load", true, booleanFlag, "true", NULL), - /**< + YAP_FLAG(VERBOSE_LOAD_FLAG, "verbose_load", true, booleanFlag, "true", NULL), +/**< If the second argument is bound to a stream, set user_error to this stream. If the second argument is unbound, unify the argument with diff --git a/library/CMakeLists.txt b/library/CMakeLists.txt index 219c2b7f0..dfceaa6ee 100644 --- a/library/CMakeLists.txt +++ b/library/CMakeLists.txt @@ -1,4 +1,5 @@ set (LIBRARY_PL +INDEX.yap apply.yap apply_macros.yap arg.yap diff --git a/library/INDEX.yap b/library/INDEX.yap new file mode 100644 index 000000000..b0881a922 --- /dev/null +++ b/library/INDEX.yap @@ -0,0 +1 @@ +%% auto-loading is not really supported in YAP. diff --git a/library/autoloader.yap b/library/autoloader.yap index 486a38656..7b0cebe9f 100644 --- a/library/autoloader.yap +++ b/library/autoloader.yap @@ -122,5 +122,6 @@ find_predicate(G,ExportingModI) :- functor(G, Name, Arity), ensure_loaded(File). -:- ensure_loaded('INDEX'). + +:- ensure_loaded('INDEX'). diff --git a/library/lists.yap b/library/lists.yap index e1c85f902..a9aa9061f 100644 --- a/library/lists.yap +++ b/library/lists.yap @@ -360,7 +360,7 @@ prefix([], _). prefix([Elem | Rest_of_part], [Elem | Rest_of_whole]) :- prefix(Rest_of_part, Rest_of_whole). -% remove_duplicates(List, Pruned) +%% remove_duplicates(+List, Pruned) % removes duplicated elements from List. Beware: if the List has % non-ground elements, the result may surprise you. @@ -369,6 +369,23 @@ remove_duplicates([Elem|L], [Elem|NL]) :- delete(L, Elem, Temp), remove_duplicates(Temp, NL). +%% remove_identical_duplicates(List, Pruned) +% removes duplicated elements from List. +remove_identical_duplicates([], []). +remove_identical_duplicates([Elem|L], [Elem|NL]) :- + delete_identical(L, Elem, Temp), + remove_identical_duplicates(Temp, NL). + + +delete_identical([],_, []). +delete_identical([H|L],Elem,Temp) :- + H == Elem, + !, + delete_identical(L, Elem, Temp). +delete_identical([H|L], Elem, [H|Temp]) :- + delete_identical(L, Elem, Temp). + + % same_length(?List1, ?List2) % is true when List1 and List2 are both lists and have the same number diff --git a/library/matrix.yap b/library/matrix.yap index 806a9e5e5..4053121cc 100644 --- a/library/matrix.yap +++ b/library/matrix.yap @@ -667,6 +667,10 @@ Unify _NElems_ with the type of the elements in _Matrix_. foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ), matrix_new( floats , Dims, X ), matrix_base(X, Bases). +( X <== '[]'(Dims0, static.array) of floats ) :- + atom(X), !, + foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ), + static_array( Size, floats, X ). ( X <== '[]'(Dims0, array) of (I:J) ) :- !, foldl( norm_dim, Dims0, Dims, Bases, 1, Size ), matrix_seq(I, J, Dims, X), @@ -762,6 +766,23 @@ rhs('[]'(Args, RHS), Val) :- ; matrix_get_range( X1, NArgs, Val ) ). +rhs('[]'([Args], floats(RHS)), Val) :- + atom(RHS), + integer(Args), + !, + array_element(RHS,Args,Val). +rhs('[]'(Args, RHS), Val) :- + !, + rhs(RHS, X1), + matrix_dims( X1, Dims, Bases), + maplist( index(Range), Args, Dims, Bases, NArgs), + ( + var(Range) + -> + array_element( X1, NArgs, Val ) + ; + matrix_get_range( X1, NArgs, Val ) + ). rhs('..'(I, J), [I1|Is]) :- !, rhs(I, I1), rhs(J, J1), @@ -952,19 +973,25 @@ mtimes(I1, I2, V) :- % three types of matrix: integers, floats and general terms. % -matrix_new(terms,Dims, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :- +matrix_new(terms.terms,Dims, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :- length(Dims,NDims), foldl(size, Dims, 1, Size), maplist(zero, Dims, Offsets), functor( Matrix, c, Size). -matrix_new(ints,Dims,Matrix) :- +matrix_new(opaque.ints,Dims,Matrix) :- length(Dims,NDims), new_ints_matrix_set(NDims, Dims, 0, Matrix). -matrix_new(floats,Dims,Matrix) :- +matrix_new(opaque.floats,Dims,Matrix) :- length(Dims,NDims), new_floats_matrix_set(NDims, Dims, 0.0, Matrix). +matrix_new(array.Type(Size), Dims, Data, '$array'(Id) ) :- + length(Dims,NDims), + foldl(size, Dims, 1, Size), + maplist(zero, Dims, Offsets), + functor( Matrix, c, Size), + new_array(Size,Type,Dims,Data), matrix_new(terms, Dims, Data, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :- length(Dims,NDims), foldl(size, Dims, 1, Size), diff --git a/packages/ProbLog/problog_examples/learn_graph.pl b/packages/ProbLog/problog_examples/learn_graph.pl index 5f29b8062..35f439ed3 100644 --- a/packages/ProbLog/problog_examples/learn_graph.pl +++ b/packages/ProbLog/problog_examples/learn_graph.pl @@ -17,7 +17,7 @@ :- use_module(library(matrix)). :- use_module(('../problog_learning')). -:- stop_low_level_trace. + %%%% % background knowledge %%%% diff --git a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl index 19b9b5373..458a504ed 100644 --- a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl +++ b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl @@ -14,12 +14,21 @@ % will run 20 iterations of learning with default settings %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -:- use_module(library(problog_learning)). +:- use_module('../problog_lbfgs'). + + +%:- set_problog_flag(init_method,(Query,K,Bdd,problog:problog_exact_lbdd(Query,Bdd))). + +%:- if(true). +:- use_module('kbgraph'). %%%% % background knowledge %%%% % definition of acyclic path using list of visited nodes + +/*:- else. + path(X,Y) :- path(X,Y,[X],_). path(X,X,A,A). @@ -37,6 +46,8 @@ edge(X,Y) :- dir_edge(X,Y). absent(_,[]). absent(X,[Y|Z]):-X \= Y, absent(X,Z). +:- endif. +*/ %%%% % probabilistic facts % - probability represented by t/1 term means learnable parameter @@ -71,11 +82,11 @@ example(13,path(4,5),0.57). example(14,path(4,6),0.51). example(15,path(5,6),0.69). % some examples for learning from proofs: -example(16,(dir_edge(2,3),dir_edge(2,6),dir_edge(6,5),dir_edge(5,4)),0.032). -example(17,(dir_edge(1,6),dir_edge(2,6),dir_edge(2,3),dir_edge(3,4)),0.168). -example(18,(dir_edge(5,3),dir_edge(5,4)),0.14). -example(19,(dir_edge(2,6),dir_edge(6,5)),0.2). -example(20,(dir_edge(1,2),dir_edge(2,3),dir_edge(3,4)),0.432). +%example(16,(dir_edge(2,3),dir_edge(2,6),dir_edge(6,5),dir_edge(5,4)),0.032). +%example(17,(dir_edge(1,6),dir_edge(2,6),dir_edge(2,3),dir_edge(3,4)),0.168). +%example(18,(dir_edge(5,3),dir_edge(5,4)),0.14). +%example(19,(dir_edge(2,6),dir_edge(6,5)),0.2). +%example(20,(dir_edge(1,2),dir_edge(2,3),dir_edge(3,4)),0.432). %%%%%%%%%%%%%% % test examples of form test_example(ID,Query,DesiredProbability) @@ -98,3 +109,4 @@ test_example(33,path(5,4),0.57). test_example(34,path(6,4),0.51). test_example(35,path(6,5),0.69). + diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index 3dc2f541a..79f0cac37 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -221,6 +221,7 @@ :- use_module(library(system), [file_exists/1, shell/2]). :- use_module(library(rbtrees)). :- use_module(library(lbfgs)). +:- reexport(library(matrix)). % load our own modules :- reexport(problog). @@ -485,6 +486,8 @@ init_learning :- succeeds_n_times(user:example(_,_,_,_),TrainingExampleCount), assertz(example_count(TrainingExampleCount)), format_learning(3,'~q training examples~n',[TrainingExampleCount]), + current_probs <== array[TrainingExampleCount ] of floats, + current_lls <== array[TrainingExampleCount ] of floats, forall(tunable_fact(FactID,_GroundTruth), set_fact_probability(FactID,0.5) ), @@ -514,9 +517,7 @@ update_values :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % delete old values %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - retractall(query_probability_intern(_,_)), - retractall(query_gradient_intern(_,_,_,_)). - + qp <== current_probs. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check, if continuous facts are used. @@ -579,71 +580,40 @@ bdd_input_file(Filename) :- concat_path_with_filename(Dir,'input.txt',Filename). init_one_query(QueryID,Query,_Type) :- - % format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % if BDD file does not exist, call ProbLog - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - b_setval(problog_required_keep_ground_ids,false), + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % if BDD file does not exist, call ProbLog + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + problog_flag(init_method,(Query,N,Bdd,user:graph2bdd(Query,N,Bdd))), + !, + b_setval(problog_required_keep_ground_ids,false), (QueryID mod 100 =:= 0 -> writeln(QueryID) ; true), - Query =.. [_|Args], - % problog_flag(init_method,(Query,N,Bdd,M:graph2bdd(Args,N,Bdd))), - Bdd = bdd(Dir, Tree, - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - u3777777777/....777;;;;;;;;;;;;;;;;;;;666666666MapList), - user:graph2bdd(Args,N,Bdd), - rb_new(H0), + Bdd = bdd(Dir, Tree,MapList), + user:graph2bdd(Query,N,Bdd), + rb_new(H0), maplist_to_hash(MapList, H0, Hash), tree_to_grad(Tree, Hash, [], Grad), % ; % Bdd = bdd(-1,[],[]), % Grad=[] - write('.'), + write('.'), recordz(QueryID,bdd(Dir, Grad, MapList),_). - +init_one_query(QueryID,Query,_Type) :- + % format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % if BDD file does not exist, call ProbLog + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + b_setval(problog_required_keep_ground_ids,false), + problog_flag(init_method,(Query,_K,Bdd,Call)), + !, + Bdd = bdd(Dir, Tree, MapList), + % trace, + once(Call), + rb_new(H0), + maplist_to_hash(MapList, H0, Hash), + %Tree \= [], +% writeln(Dir:Tree:MapList), + tree_to_grad(Tree, Hash, [], Grads), + recordz(QueryID,bdd(Dir, Grads, MapList),_). %======================================================================== %= @@ -738,6 +708,7 @@ mse_trainingset :- logger_set_variable(mse_min_trainingset,MinError), logger_set_variable(mse_max_trainingset,MaxError), logger_set_variable(llh_training_queries,LLH_Training_Queries), +%%%%% format(' (~8f)~n',[MSE]). format_learning(2,' (~8f)~n',[MSE]). tuple(t(X,Y),X,Y). @@ -831,7 +802,6 @@ gradient_descent :- % current_iteration(Iteration), findall(FactID,tunable_fact(FactID,_GroundTruth),L), length(L,N), -% leash(0),trace, lbfgs_initialize(N,X,0,Solver), forall(tunable_fact(FactID,_GroundTruth), set_fact( FactID, Slope, X) @@ -861,59 +831,55 @@ set_tunable(I,Slope,P) :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % start calculate gradient %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :- - %Handle = user_error, - example_count(TrainingExampleCount), - LLs <== array[TrainingExampleCount ] of floats, - Probs <== array[N] of floats, +user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :- + %Handle = user_error, + LLs = current_lls, + Probs = current_probs, problog_flag(sigmoid_slope,Slope), N1 is N-1, forall(between(0,N1,I), (Grad[I] <== 0.0, S <== X[I], sigmoid(S,Slope, P), Probs[I] <== P) ), + writeln(e0), + leash(0),trace, forall( - full_example(QueryID,QueryProb,BDD), - compute_grad(QueryID, BDD, QueryProb,Grad, Probs, Slope,LLs) + user:example(QueryID,_Query,QueryProb), + compute_grad(QueryID, QueryProb,Grad, Probs, Slope,LLs) ), +writeln(Grad), LLH_Training_Queries <== sum(LLs). -full_example(QueryID,QueryProb,BDD) :- - user:example(QueryID,_Query,QueryProb,_), - recorded(QueryID,BDD,_), - BDD = bdd(_Dir, _GradTree, MapList), - MapList = [_|_]. -compute_grad(QueryID,BDD,QueryProb, Grad, Probs, Slope, LLs) :- + +compute_grad(QueryID,QueryProb, Grad, Probs, Slope, LLs) :- + recorded(QueryID,BDD,_), BDD = bdd(_Dir, _GradTree, MapList), bind_maplist(MapList, Slope, Probs), - recorded(QueryID,BDD,_), qprobability(BDD,Slope,BDDProb), LL is (BDDProb-QueryProb)*(BDDProb-QueryProb), LLs[QueryID] <== LL, -%writeln( qprobability(BDD,Slope,BDDProb) ), forall( - member(I-_, MapList), - gradientpair(I, BDD,Slope,BDDProb, QueryProb, Grad, Probs) - ). + member(I-_,MapList), + gradientpair(Slope,BDDProb, QueryProb,Grad,Probs,BDD,I) + ), +writeln(LL). -gradientpair(I, BDD,Slope,BDDProb, QueryProb, Grad, Probs) :- - qgradient(I, BDD, Slope, FactID, GradValue), - % writeln(FactID), + +gradientpair(Slope,BDDProb, QueryProb, Grad, Probs,BDD,I) :- + qgradient(I, BDD, Slope, FactID, GradValue), G0 <== Grad[FactID], Prob <== Probs[FactID], -%writeln( GN is G0-GradValue*(QueryProb-BDDProb)), - GN is G0-GradValue*2*Prob*(1-Prob)*(QueryProb-BDDProb), - %writeln(FactID:(G0->GN)), -Grad[FactID] <== GN. + GN is G0-GradValue*2*Prob*(1-Prob)*(QueryProb-BDDProb), + Grad[FactID] <== GN. qprobability(bdd(Dir, Tree, _MapList), Slope, Prob) :- /* query_probability(21,6.775948e-01). */ - run_sp(Tree, Slope, 1.0, Prob0), + run_sp(Tree, Slope, 1, Prob0), (Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0). -qgradient(I, bdd(Dir, Tree, _MapList), Slope, I, Grad) :- - run_grad(Tree, I, Slope, 0.0, Grad0), +qgradient(I, bdd(Dir,Tree,_), Slope, I, Grad) :- + run_grad(Tree, I, Slope, 1.0, 0.0, Grad0), ( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0). wrap( X, Grad, GradCount) :- @@ -954,25 +920,25 @@ node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :- (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). run_sp([], _, P0, P0). -run_sp(gnodep(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- +run_sp(gnodep(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, PL, PF) :- P is EP*PL+ (1.0-EP)*PR, run_sp(Tree, Slope, P, PF). -run_sp(gnoden(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- - P is EP*PL + (1.0-EP)*(1.0 - PR), +run_sp(gnoden(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, PL, PF) :- + P is EP*PL + (1.0-EP)*(1.0 - PR), run_sp(Tree, Slope, P, PF). -run_grad([], _I, _, G0, G0). -run_grad([gnodep(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :- +run_grad([], _I, _, _, G0, G0). +run_grad([gnodep(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, PL, GL, GF) :- P is EP*PL+ (1.0-EP)*PR, G0 is EP*GL + (1.0-EP)*GR, % don' t forget the -X ( I == Id -> G is PL-PR ; G = G0 ), - run_grad(Tree, I, Slope, G, GF). -run_grad([gnoden(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :- + run_grad(Tree, I, Slope, P, G, GF). +run_grad([gnoden(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, PL, GL, GF) :- P is EP*PL + (1.0-EP)*(1.0 - PR), G0 is EP*GL - (1.0 - EP) * GR, ( I == Id -> G is PL-(1.0-PR) ; G = G0 ), - run_grad(Tree, I, Slope, G, GF). + run_grad(Tree, I, Slope, P, G, GF). @@ -986,7 +952,7 @@ log2prob(X,Slope,FactID,V) :- bind_maplist([], _Slope, _X). bind_maplist([Node-Pr|MapList], Slope, X) :- - Pr <== X[Node], + Pr <== X[Node], bind_maplist(MapList, Slope, X). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -996,7 +962,7 @@ user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_Iteration,_Ls,-1) :- FX < 0, !, format('stopped on bad FX=~4f~n',[FX]). user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :- - problog_flag(sigmoid_slope,Slope), + roblog_flag(sigmoid_slope,Slope), forall(tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)), current_iteration(CurrentIteration), retractall(current_iteration(_)), @@ -1015,14 +981,14 @@ user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :- %======================================================================== init_flags :- -% prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries' - prolog_file_name(output,Output_Folder), % get absolute file name for './output' - problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general), - problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler), - problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general), - problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general), - problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general), - problog_define_flag(check_duplicate_bdds,problog_flag_validate_boolean,'Store intermediate results in hash table',true,learning_general), + % prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries' + prolog_file_name(output,Output_Folder), % get absolute file name for './output' + % problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general), + problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler), + problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general), +% problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general), +% problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general), +% problog_define_flag(check_duplicate_bdds,problog_flag_validate_boolean,'Store intermediate results in hash table',true,learning_general), problog_define_flag(init_method,problog_flag_validate_dummy,'ProbLog predicate to search proofs',(Query,Tree,problog:problog_kbest_as_bdd(Query,100,Tree)),learning_general,flags:learning_libdd_init_handler), problog_define_flag(alpha,problog_flag_validate_number,'weight of negative examples (auto=n_p/n_n)',auto,learning_general,flags:auto_handler), problog_define_flag(sigmoid_slope,problog_flag_validate_posnumber,'slope of sigmoid function',1.0,learning_general), @@ -1057,3 +1023,4 @@ init_logger :- :- initialization(init_flags). :- initialization(init_logger). + diff --git a/packages/ProbLog/problog_learning_lbdd.yap b/packages/ProbLog/problog_learning_lbdd.yap index cc11b6559..3a0f00aef 100644 --- a/packages/ProbLog/problog_learning_lbdd.yap +++ b/packages/ProbLog/problog_learning_lbdd.yap @@ -70,7 +70,7 @@ % "Original License" means this Artistic License as Distributed with the % Standard Version of the Package, in its current version or as it may % be modified by The Perl Foundation in the future. -% + % "Source" form means the source code, documentation source, and % configuration files for the Package. % @@ -587,7 +587,7 @@ empty_bdd_directory. set_default_gradient_method :- problog_flag(continuous_facts, true), !, - problog_flag(init_method,OldMethod), + problog_flag(init_method,_OldMethod), format_learning(2,'Theory uses continuous facts.~nWill use problog_exact/3 as initalization method.~2n',[]), set_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))). set_default_gradient_method :- @@ -595,9 +595,10 @@ set_default_gradient_method :- !, format_learning(2,'Theory uses tabling.~nWill use problog_exact/3 as initalization method.~2n',[]), set_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))). -set_default_gradient_method :- - problog_flag(init_method,(gene(X,Y),N,Bdd,graph2bdd(X,Y,N,Bdd))), +/*set_default_gradient_method :- + problog_flag(init_method,(Goal,N,Bdd,graph2bdd(X,Y,N,Bdd))), !. +*/ set_default_gradient_method :- set_problog_flag(init_method,(Query,1,BDD, problog_kbest_as_bdd(user:Query,1,BDD))). @@ -618,24 +619,36 @@ bdd_input_file(Filename) :- problog_flag(output_directory,Dir), concat_path_with_filename(Dir,'input.txt',Filename). +init_one_query(QueryID,Query,_Type) :- + % format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % if BDD file does not exist, call ProbLog + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + b_setval(problog_required_keep_ground_ids,false), + problog_flag(libbdd_init_method,(Query,Bdd,Call)), + !, + Bdd = bdd(Dir, Tree, MapList), +% trace, + once(Call), + rb_new(H0), + maplist_to_hash(MapList, H0, Hash), + Tree \= [], +% writeln(Dir:Tree:MapList), + tree_to_grad(Tree, Hash, [], Grad). + init_one_query(QueryID,Query,Type) :- % format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % if BDD file does not exist, call ProbLog %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ( - recorded(QueryID, _, _) - -> - format_learning(3,' Reuse existing BDD ~q~n~n',[QueryID]) - ; b_setval(problog_required_keep_ground_ids,false), - problog_flag(init_method,(Query,N,Bdd,graph2bdd(X,Y,N,Bdd))), - Query =.. [_,X,Y] - -> + problog_flag(init_method,(Query,N,Bdd,_)), + !, Bdd = bdd(Dir, Tree, MapList), ( - graph2bdd(X,Y,N,Bdd) + user:graph2bdd(Query,N,Bdd) -> rb_new(H0), maplist_to_hash(MapList, H0, Hash), @@ -645,22 +658,7 @@ init_one_query(QueryID,Query,Type) :- Bdd = bdd(-1,[],[]), Grad=[] ), - recordz(QueryID,bdd(Dir, Grad, MapList),_) - ; - b_setval(problog_required_keep_ground_ids,false), - rb_new(H0), - problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,1,Bdd))), - strip_module(Call,_,gene(X,Y)), - !, - Bdd = bdd(Dir, Tree, MapList), -% trace, - problog:problog_kbest_as_bdd(user:gene(X,Y),1,Bdd), - maplist_to_hash(MapList, H0, Hash), - Tree \= [], - %put_code(0'.), - tree_to_grad(Tree, Hash, [], Grad), - recordz(QueryID,bdd(Dir, Grad, MapList),_) - ). + recordz(QueryID,bdd(Dir, Grad, MapList),_). init_one_query(_QueryID,_Query,_Type) :- throw(unsupported_init_method). @@ -1568,6 +1566,7 @@ init_flags :- problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general), problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general), problog_define_flag(check_duplicate_bdds,problog_flag_validate_boolean,'Store intermediate results in hash table',true,learning_general), + problog_define_flag(libbdd_init_method,problog_flag_validate_dummy,'ProbLog predicate to search proofs',(Query,Tree,problog:problog_kbest_as_bdd(Query,100,Tree)),learning_general,flags:learning_libdd_init_handler), problog_define_flag(init_method,problog_flag_validate_dummy,'ProbLog predicate to search proofs',(Query,Tree,problog:problog_kbest_as_bdd(Query,100,Tree)),learning_general,flags:learning_libdd_init_handler), problog_define_flag(alpha,problog_flag_validate_number,'weight of negative examples (auto=n_p/n_n)',auto,learning_general,flags:auto_handler), problog_define_flag(sigmoid_slope,problog_flag_validate_posnumber,'slope of sigmoid function',1.0,learning_general), diff --git a/pl/consult.yap b/pl/consult.yap index b5c09eb82..c15b050dc 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -309,6 +309,7 @@ load_files(Files0,Opts) :- '$load_files__'(user_input, M, [consult(reconsult),stream(S)|Opts], Call). '$load_files'(Files, M, Opts, Call) :- '$load_files__'(Files, M, Opts, Call). + '$load_files__'(Files, M, Opts, Call) :- '$lf_option'(last_opt, LastOpt), '$show_consult_level'(LC), @@ -545,6 +546,7 @@ load_files(Files0,Opts) :- '$reexport'( TOpts, ParentF, Reexport, ImportList, File ), print_message(informational, loaded( loaded, F, M, T, H)), working_directory( _, OldD), + set_prolog_flag(compiling,false), '$exec_initialization_goals', '$current_module'(_M, Mod). '$start_lf'(_, Mod, Stream, TOpts, UserFile, File, _Reexport, _Imports) :- diff --git a/pl/imports.yap b/pl/imports.yap index 31856c77a..416799689 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -35,9 +35,11 @@ fail. % parent module mechanism %% system has priority '$get_predicate_definition'(_ImportingMod:G,prolog:G) :- + nonvar(G), '$pred_exists'(G,prolog). %% I am there, no need to import '$get_predicate_definition'(Mod:Pred,Mod:Pred) :- + nonvar(Pred), '$pred_exists'(Pred, Mod). %% export table '$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :- @@ -45,13 +47,13 @@ fail. %% parent/user '$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :- ( '$parent_module'(ImportingMod, PMod) ), %; PMod = user), - ('$pred_exists'(PMod,G0), PMod:G0 = ExportingMod:G; + (nonvar(G0),'$pred_exists'(G0,PMod), 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). +%'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :- +% current_prolog_flag(autoload, true), +% '$autoload'(G, ImportingMod, ExportingMod, swi). '$predicate_definition'(Imp:Pred,Exp:NPred) :- diff --git a/pl/messages.yap b/pl/messages.yap index 6d5418555..3cae1b7d9 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -1044,9 +1044,8 @@ prolog:print_message(Severity, Msg) :- ), !. prolog:print_message(Level, _Msg) :- + current_prolog_flag(compiling, true), current_prolog_flag(verbose_load, false), - '$show_consult_level'(LC), - LC > 0, Level \= error, Level \= warning, !. diff --git a/pl/meta.yap b/pl/meta.yap index fc6e91444..6168d5ffe 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -478,15 +478,14 @@ meta_predicate(P) :- expand_goal(Input, Output) :- '$expand_meta_call'(Input, none, Output ). -'$expand_meta_call'(G, HVars, MF:GF ) :- - source_module(SM), - '$yap_strip_module'(SM:G, M, IG), - '$is_metapredicate'(IG, M), - '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G), - !, - '$yap_strip_module'(M:GF0, MF, GF). +'$expand_meta_call'(G, HVars, MF:GF ) :- + source_module(SM), + '$yap_strip_module'(G, M, IG), + '$is_metapredicate'(IG, M), + '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G), + !, + '$yap_strip_module'(M:GF0, MF, GF). '$expand_meta_call'(G, _HVars, M:IG ) :- - source_module(SM), - '$yap_strip_module'(SM:G, M, IG). + '$yap_strip_module'(G, M, IG). %% @} diff --git a/pl/preds.yap b/pl/preds.yap index dae99f594..2e37b45dd 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -474,12 +474,11 @@ predicate_erased_statistics(P0,NCls,Sz,ISz) :- Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_. */ current_predicate(A0,T0) :- - ( nonvar(T0) -> '$yap_strip_module'(T0, M, T) ; T0 = T ), - ( nonvar(A0) -> '$yap_strip_module'(A0, MA0, A) ; A0 = A ), + ( nonvar(A0) -> '$yap_strip_module'(M:A0, MA0, A) ; A0 = A ), M = MA0, ( - var(M) + nonvar(M) -> true ; @@ -487,11 +486,13 @@ current_predicate(A0,T0) :- ), % M is bound ( - '$current_predicate'(A,M,T,user) + '$current_predicate'(A,M,T,user), + functor(T, A, _) ; - '$imported_predicate'(M:T, M1T1), M1T1 \= M:T - ), - functor(T, A, _). + '$get_predicate_definition'(M:T,M1:_T1), + M\=M1, + functor(T, A, _) + ). /** @pred system_predicate( ?_P_ ) diff --git a/pl/qly.yap b/pl/qly.yap index 65018ec27..132d00e36 100755 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -229,9 +229,9 @@ qend_program :- % there is some ordering between flags. 'x_yap_flag'(language, V) :- yap_flag(language, V). - %if silent keep silent, otherwise use the saved state. - 'x_yap_flag'(verbose, _) :- !. - 'x_yap_flag'(verbose_load, _) :- !. +%if silent keep silent, otherwise use the saved state. +'x_yap_flag'(verbose, _) :- !. +'x_yap_flag'(verbose_load, _) :- !. 'x_yap_flag'(M:P, V) :- current_module(M), yap_flag(M:P, V). diff --git a/pl/top.yap b/pl/top.yap index 157730be2..1f05b24d9 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -602,16 +602,18 @@ write_query_answer( Bindings ) :- '$enable_debugging':- current_prolog_flag(debug, false), !. '$enable_debugging' :- - '__NB_setval__'('$debug_status', state(creep, 0, stop)), + nb_setval('$debug_status', state(false,creep, 0, stop)), '$trace_on', !, '$creep'. '$enable_debugging'. '$trace_on' :- - '__NB_getval__'('$trace', on, fail). + '__NB_getval__'('$debug_status', state(_,Creep, GN, Spy), fail), + nb_setval('$debug_status', state(true,Creep, GN, Spy)). '$trace_off' :- - '__NB_getval__'('$trace', off, fail). + '__NB_getval__'('$debug_status', state(_,Creep, GN, Spy), fail), + nb_setval('$debug_status', state(false,Creep, GN, Spy)). '$cut_by'(CP) :- '$$cut_by'(CP). diff --git a/pl/undefined.yap b/pl/undefined.yap index b93b9dd77..ff751dc69 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -93,16 +93,13 @@ undefined_query(G0, M0, Cut) :- '$undefp_search'(M0:G0, MG) :- '$predicate_definition'(M0:G0, MG), !. -% undef handler -'$undefp'([M0|G0],true) :- - % make sure we do not loop on undefined predicates - setup_call_cleanup( - '$undef_setup'(Action,Debug,Current), - '$get_undefined_predicate'( M0:G0, MG ), - '$undef_cleanup'(Action,Debug,Current) - ), - '$undef_error'(Action, M0:G0, MG). - +'$undef_error'(error, Mod:Goal) :- + '$do_error'(existence_error(procedure,Mod:Goal), Mod:Goal). +'$undef_error'(warning,Mod:Goal) :- + '$program_continuation'(PMod,PName,PAr), + print_message(warning,error(existence_error(procedure,Mod:Goal), context(Mod:Goal,PMod:PName/PAr))). +'$undef_error'(fail,_). + '$undef_setup'(Action,Debug,Current) :- yap_flag( unknown, Action, fail), yap_flag( debug, Debug, false), @@ -112,6 +109,34 @@ undefined_query(G0, M0, Cut) :- yap_flag( unknown, _, Action), yap_flag( debug, _, Debug). +'$found_undefined_predicate'( M0:G0, M:G ) :- + '$pred_exists'(unknown_predicate_handler(_,_,_), user), + '$yap_strip_module'(M0:G0, EM0, GM0), + user:unknown_predicate_handler(GM0,EM0,M:G), + !. +'$found_undefined_predicate'( M0:G0, _ ) :- + yap_flag( unknown, _, Action), + '$undef_error'(Action, M0:G0 ). + +'$search_undef'(M0:G0, M:G) :- +% make sure we do not loop on undefined predicates + setup_call_cleanup( + '$undef_setup'(Action,Debug,Current), + '$get_undefined_predicate'( M0:G0, M:G ), + '$undef_cleanup'(Action,Debug,Current) + ), + !. +'$search_undef'(M0:G0, M:G) :- + '$found_undefined_predicate'( M0:G0, M:G ). + +%% undef handler: +% we found an import, and call again +% we have user code in the unknown_predicate +% we fail, output a message, and just generate an exception. +'$undefp'([M0|G0],ok) :- + '$search_undef'(M0:G0, M:G), + '$trace'(M:G). + :- abolish(prolog:'$undefp0'/2). :- '$undefp_handler'('$undefp'(_,_), prolog). @@ -126,28 +151,6 @@ The unknown predicate, informs about what the user wants to be done */ -'$undef_error'(_, _, M:G) :- - nonvar(M), - nonvar(G), - !, - '$start_creep'([M|G], creep). -'$undef_error'(_, M0:G0, M:G) :- - '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), - '$yap_strip_module'(M0:G0, EM0, GM0), - user:unknown_predicate_handler(GM0,EM0,M:G), - !, - '$start_creep'([M|G], creep). -'$undef_error'(error, Mod:Goal,_) :- - '$do_error'(existence_error(procedure,Mod:Goal), Mod:Goal). -'$undef_error'(warning,Mod:Goal,_) :- - '$program_continuation'(PMod,PName,PAr), - print_message(warning,error(existence_error(procedure,Mod:Goal), context(Mod:Goal,PMod:PName/PAr))), - %'$start_creep'([prolog|fail], creep), - fail. -'$undef_error'(fail,_Goal,_,_Mod) :- - % '$start_creep'([prolog|fail], creep), - fail. - unknown(P, NP) :- yap_flag( unknown, P, NP ). From e5e38551e0ca9447a5e4eb09c659b669fe9b0ab6 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 14 Mar 2019 02:11:50 +0000 Subject: [PATCH 076/101] missing file --- packages/ProbLog/problog_examples/kbgraph.yap | 134 ++++++++++++++++++ 1 file changed, 134 insertions(+) create mode 100644 packages/ProbLog/problog_examples/kbgraph.yap diff --git a/packages/ProbLog/problog_examples/kbgraph.yap b/packages/ProbLog/problog_examples/kbgraph.yap new file mode 100644 index 000000000..cf6884b34 --- /dev/null +++ b/packages/ProbLog/problog_examples/kbgraph.yap @@ -0,0 +1,134 @@ + +:- ensure_loaded(library(lists)). +:- ensure_loaded(library(rbtrees)). +:- ensure_loaded(library(tries)). +:- ensure_loaded(('../problog/ptree')). +:- ensure_loaded(library(trie_sp)). +:- ensure_loaded(library(bdd)). +:- ensure_loaded(library(bhash)). +:- ensure_loaded(library(nb)). + +%:- [inter]. + +:- dynamic best/4. + +%:- ['../AlephUW/vsc_aleph_extensions']. +%vsc_check_mem(on). + +:- ensure_loaded(library(dbusage)). + + +graph2bdd(Query,1,bdd(D,T,Vs)) :- + Query =.. [_,X,Y], + !, + retractall(best(_,_,_,_)), + graph(X,Y, TrieList, Vs), + bdd_new(TrieList, C), + bdd_tree(C, BDD), + BDD = bdd(D,T,_Vs0), + writeln(BDD). + + +:- set_problog_flag(init_method,(Q,N,Bdd,user:graph2bdd(Q,N,Bdd))). + + +%:- leash(0), spy graph2bdd. + +cvt_to_id([E0,E1], VId*true, [Id-VId]) :- + problog:problog_dir_edge(Id,E0,E1,_Pr), + !. +cvt_to_id([E0,E1],VId*true, [Id-VId]) :- + problog:problog_dir_edge(Id,E1,E0,_Pr), + !. +cvt_to_id([E0,E1|Es], VId*Ids, [Id-VId|VIds]) :- + problog:problog_dir_edge(Id,E0,E1,_Pr), + !, + cvt_to_id([E1|Es],Id*Ids, VIds). +cvt_to_id([E0,E1|Es], VId*Ids, [Id-VId|VIds]) :- + problog:problog_dir_edge(Id,E1,E0,_Pr), + !, + cvt_to_id([E1|Es], Ids, VIds). + +export_answer(Final, FinalIDs, Vs) :- + cvt_to_id(Final,FinalIDs, Vs). + %writeln(FinalIDs), + + +graph(X,Y,Trie_Completed_Proofs,Vs) :- + best(X,Y,_Pr,Final), + %writeln(_Pr), + !, + export_answer([Y|Final], Trie_Completed_Proofs,Vs). +graph(X,Y,Trie_Completed_Proofs, Vs) :- + nb_heap(100000,Q), + path(X,Y,X,[X],Final, 0, _Pr, Q), + !, + export_answer(Final, Trie_Completed_Proofs, Vs). +graph(_X,_Y,Trie_Completed_Proofs,Vs) :- + export_answer([], Trie_Completed_Proofs,Vs). + +path(X,X,_,P,P,Pr,Pr,_Q). +path(X,Y,X0,P,_,Pr0,_Pr,Q) :- + X \= Y, + edge(X,Z,PrD), + absent(Z,P), + Pr is Pr0+PrD, + check_best(X0, Z, Pr, P), + NPr is -Pr, + nb_heap_add(Q,NPr,[Z|P]), + % nb_heap_size(Q,S), S mod 10000 =:= 0, gc_heap(Q), writeln(S), + fail. +path(_,Y,X0,_,F,_,FPr,Q) :- + nb_heap_del(Q,NPr,P), + P=[Z|_], + % b_getval(problog_threshold, LT), + Prf is -NPr, +% Prf >= LT, + path(Z,Y,X0,P,F,Prf,FPr,Q). + +check_best(X, Z, _Pr, _P) :- + best(X, Z, _Pr1, _P0), + !, +% Pr1 >= Pr, !, + fail. +check_best(X, Z, Pr, P) :- + retract(best(X, Z,_, _)), + !, + assert(best(X, Z,Pr,P)). +check_best(X, Z, Pr, P) :- + assert(best(X, Z,Pr,P)). + +d([H|L],H,L). +d([H|L], X, [H|Nl]) :- + d(L,X,Nl). + +% using directed edges in both directions +edge(X,Y,Pr) :- problog:problog_dir_edge(_,Y,X,Pr). +edge(X,Y,Pr) :- problog:problog_dir_edge(_,X,Y,Pr). + +% checking whether node hasn't been visited before +absent(_,[]). +absent(X,[Y|Z]):- X \= Y, absent(X,Z). + +% get rid of garbage elements +gc_heap(Q) :- + heap_all(Q, [], L), + sort(L, S), + rebuild(S, Q), + nb_heap_size(Q,Sz), writeln(done:Sz). + + +heap_all(Q, L, L) :- + nb_heap_empty(Q), !. +heap_all(Q, Els, L) :- + nb_heap_del(Q, Key, Val), + Val = p(_,Z,_), + heap_all(Q, f(Z,Key,Val).Els, L). + +rebuild([], _). +rebuild([f(Z,Pr0,_), f(Z,NPr,V)|Zs], Q) :- Pr0 < NPr, !, + rebuild([f(Z,NPr,V)|Zs], Q). +rebuild([f(_,NPr,V)|Els], Q) :- + nb_heap_add(Q, NPr, V), + rebuild(Els, Q). + From 6825c3e2acf28b1e4c39e93ab222444752330acd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 14 Mar 2019 03:11:06 +0000 Subject: [PATCH 077/101] missing file --- packages/ProbLog/problog_examples/kbgraph.yap | 134 ++++++++++++++++++ packages/swig/android/CMakeLists.txt | 4 +- 2 files changed, 136 insertions(+), 2 deletions(-) create mode 100644 packages/ProbLog/problog_examples/kbgraph.yap diff --git a/packages/ProbLog/problog_examples/kbgraph.yap b/packages/ProbLog/problog_examples/kbgraph.yap new file mode 100644 index 000000000..cf6884b34 --- /dev/null +++ b/packages/ProbLog/problog_examples/kbgraph.yap @@ -0,0 +1,134 @@ + +:- ensure_loaded(library(lists)). +:- ensure_loaded(library(rbtrees)). +:- ensure_loaded(library(tries)). +:- ensure_loaded(('../problog/ptree')). +:- ensure_loaded(library(trie_sp)). +:- ensure_loaded(library(bdd)). +:- ensure_loaded(library(bhash)). +:- ensure_loaded(library(nb)). + +%:- [inter]. + +:- dynamic best/4. + +%:- ['../AlephUW/vsc_aleph_extensions']. +%vsc_check_mem(on). + +:- ensure_loaded(library(dbusage)). + + +graph2bdd(Query,1,bdd(D,T,Vs)) :- + Query =.. [_,X,Y], + !, + retractall(best(_,_,_,_)), + graph(X,Y, TrieList, Vs), + bdd_new(TrieList, C), + bdd_tree(C, BDD), + BDD = bdd(D,T,_Vs0), + writeln(BDD). + + +:- set_problog_flag(init_method,(Q,N,Bdd,user:graph2bdd(Q,N,Bdd))). + + +%:- leash(0), spy graph2bdd. + +cvt_to_id([E0,E1], VId*true, [Id-VId]) :- + problog:problog_dir_edge(Id,E0,E1,_Pr), + !. +cvt_to_id([E0,E1],VId*true, [Id-VId]) :- + problog:problog_dir_edge(Id,E1,E0,_Pr), + !. +cvt_to_id([E0,E1|Es], VId*Ids, [Id-VId|VIds]) :- + problog:problog_dir_edge(Id,E0,E1,_Pr), + !, + cvt_to_id([E1|Es],Id*Ids, VIds). +cvt_to_id([E0,E1|Es], VId*Ids, [Id-VId|VIds]) :- + problog:problog_dir_edge(Id,E1,E0,_Pr), + !, + cvt_to_id([E1|Es], Ids, VIds). + +export_answer(Final, FinalIDs, Vs) :- + cvt_to_id(Final,FinalIDs, Vs). + %writeln(FinalIDs), + + +graph(X,Y,Trie_Completed_Proofs,Vs) :- + best(X,Y,_Pr,Final), + %writeln(_Pr), + !, + export_answer([Y|Final], Trie_Completed_Proofs,Vs). +graph(X,Y,Trie_Completed_Proofs, Vs) :- + nb_heap(100000,Q), + path(X,Y,X,[X],Final, 0, _Pr, Q), + !, + export_answer(Final, Trie_Completed_Proofs, Vs). +graph(_X,_Y,Trie_Completed_Proofs,Vs) :- + export_answer([], Trie_Completed_Proofs,Vs). + +path(X,X,_,P,P,Pr,Pr,_Q). +path(X,Y,X0,P,_,Pr0,_Pr,Q) :- + X \= Y, + edge(X,Z,PrD), + absent(Z,P), + Pr is Pr0+PrD, + check_best(X0, Z, Pr, P), + NPr is -Pr, + nb_heap_add(Q,NPr,[Z|P]), + % nb_heap_size(Q,S), S mod 10000 =:= 0, gc_heap(Q), writeln(S), + fail. +path(_,Y,X0,_,F,_,FPr,Q) :- + nb_heap_del(Q,NPr,P), + P=[Z|_], + % b_getval(problog_threshold, LT), + Prf is -NPr, +% Prf >= LT, + path(Z,Y,X0,P,F,Prf,FPr,Q). + +check_best(X, Z, _Pr, _P) :- + best(X, Z, _Pr1, _P0), + !, +% Pr1 >= Pr, !, + fail. +check_best(X, Z, Pr, P) :- + retract(best(X, Z,_, _)), + !, + assert(best(X, Z,Pr,P)). +check_best(X, Z, Pr, P) :- + assert(best(X, Z,Pr,P)). + +d([H|L],H,L). +d([H|L], X, [H|Nl]) :- + d(L,X,Nl). + +% using directed edges in both directions +edge(X,Y,Pr) :- problog:problog_dir_edge(_,Y,X,Pr). +edge(X,Y,Pr) :- problog:problog_dir_edge(_,X,Y,Pr). + +% checking whether node hasn't been visited before +absent(_,[]). +absent(X,[Y|Z]):- X \= Y, absent(X,Z). + +% get rid of garbage elements +gc_heap(Q) :- + heap_all(Q, [], L), + sort(L, S), + rebuild(S, Q), + nb_heap_size(Q,Sz), writeln(done:Sz). + + +heap_all(Q, L, L) :- + nb_heap_empty(Q), !. +heap_all(Q, Els, L) :- + nb_heap_del(Q, Key, Val), + Val = p(_,Z,_), + heap_all(Q, f(Z,Key,Val).Els, L). + +rebuild([], _). +rebuild([f(Z,Pr0,_), f(Z,NPr,V)|Zs], Q) :- Pr0 < NPr, !, + rebuild([f(Z,NPr,V)|Zs], Q). +rebuild([f(_,NPr,V)|Els], Q) :- + nb_heap_add(Q, NPr, V), + rebuild(Els, Q). + diff --git a/packages/swig/android/CMakeLists.txt b/packages/swig/android/CMakeLists.txt index 5acb124a2..48bdd7c33 100644 --- a/packages/swig/android/CMakeLists.txt +++ b/packages/swig/android/CMakeLists.txt @@ -24,7 +24,7 @@ ) add_custom_command( OUTPUT yapi_swig.cxx yapi_swig.hh - COMMAND swig -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR} + COMMAND ${SWIG_EXECUTABLE} -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR} -addextern -I${CMAKE_SOURCE_DIR}/CXX -I${CMAKE_SOURCE_DIR}/include -I${CMAKE_SOURCE_DIR}/H -I${CMAKE_SOURCE_DIR}/os -I${CMAKE_SOURCE_DIR}/OPTYap -I${CMAKE_BINARY_DIR} @@ -33,7 +33,7 @@ ) add_custom_command( OUTPUT streamer_swig.cxx streamer_swig.hh - COMMAND swig -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR} -addextern -I${CMAKE_CURRENT_SOURCE_DIR} -o streamer_swig.cxx streamer.i + COMMAND ${SWIG_EXECUTABLE} -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR} -addextern -I${CMAKE_CURRENT_SOURCE_DIR} -o streamer_swig.cxx streamer.i DEPENDS ${CMAKE_SOURCE_DIR}/CXX/yapi.hh ${CMAKE_CURRENT_SOURCE_DIR}/streamer.i ) From 044329d1152c150690e9d8bb6c3d4e325fb416f9 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 15 Mar 2019 12:38:09 +0000 Subject: [PATCH 078/101] bbdd --- C/arrays.c | 10 +- C/cdmgr.c | 10 +- C/exec.c | 42 ----- C/lu_absmi_insts.h | 1 - C/terms.c | 66 ++++---- library/matrix.yap | 37 ++--- library/matrix/matrix.c | 9 +- packages/ProbLog/problog/lbdd.yap | 146 ++++++++++++++++++ packages/ProbLog/problog_examples/kbgraph.yap | 3 +- packages/ProbLog/problog_lbfgs.yap | 136 +++++----------- packages/ProbLog/problog_learning_lbdd.yap | 132 ---------------- packages/gecode/examples/queens.yap | 2 +- 12 files changed, 250 insertions(+), 344 deletions(-) create mode 100644 packages/ProbLog/problog/lbdd.yap diff --git a/C/arrays.c b/C/arrays.c index 4fbcd3da7..77d544755 100644 --- a/C/arrays.c +++ b/C/arrays.c @@ -1135,7 +1135,15 @@ static Int create_static_array(USES_REGS1) { props = array_of_terms; if (args[CREATE_ARRAY_NB_TERM].used) props = array_of_nb_terms; - + /* if (args[CREATE_ARRAY_MATRIX].used) { + tprops = args[CREATE_ARRAY_TYPE].tvalue; + + if (tprops == TermTrue) { + in_matrix = true; + size += sizeof(MP_INT)/sizeof(CELL); + } + } + */ StaticArrayEntry *pp; if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t, "create static array"); diff --git a/C/cdmgr.c b/C/cdmgr.c index 8f1cde38d..43d2ea05c 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1463,7 +1463,7 @@ static int not_was_reconsulted(PredEntry *p, Term t, int mode) { // p->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1); } LOCAL_LastAssertedPred = p; - ret>urn TRUE; /* careful */ + return TRUE; /* careful */ } static yamop *addcl_permission_error(const char *file, const char *function, @@ -1750,7 +1750,7 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref) PELOCK(20, p); /* we are redefining a prolog module predicate */ if (Yap_constPred(p)) { - addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, tf, + addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, p, FALSE); UNLOCKPE(30, p); return false; @@ -2189,7 +2189,7 @@ static Int p_purge_clauses(USES_REGS1) { /* '$purge_clauses'(+Func) */ PELOCK(21, pred); if (pred->PredFlags & StandardPredFlag) { UNLOCKPE(33, pred); - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, t), "assert/1"); + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_TermToIndicator(CurrentModule, t), "assert/1"); return (FALSE); } purge_clauses(pred); @@ -4085,11 +4085,7 @@ static Int | TabledPredFlag #endif /* TABLING */ )) { -<<<<<<< HEAD - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, t), -======= Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap), ->>>>>>> ab56074bb1a1f428c5c0c2a1781e00b02bb58f03 "dbload_get_space/4"); return FALSE; } diff --git a/C/exec.c b/C/exec.c index 21311b8a6..f332fd307 100755 --- a/C/exec.c +++ b/C/exec.c @@ -159,48 +159,6 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) { return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts); } -PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) { - Term t0 = t; - -restart: - if (IsVarTerm(t)) { - Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); - return NULL; - } else if (IsAtomTerm(t)) { - PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod)); - return ap; - } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { - return Yap_FindLUIntKey(IntegerOfTerm(t)); - } else if (IsPairTerm(t)) { - t = Yap_MkApplTerm(FunctorCsult, 1, &t); - goto restart; - } else if (IsApplTerm(t)) { - Functor fun = FunctorOfTerm(t); - if (IsExtensionFunctor(fun)) { - Yap_ThrowError(TYPE_ERROR_CALLABLE, t, pname); - return NULL; - } - if (fun == FunctorModule) { - Term tmod = ArgOfTerm(1, t); - if (IsVarTerm(tmod)) { - Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); - return NULL; - } - if (!IsAtomTerm(tmod)) { - Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname); - return NULL; - } - t = ArgOfTerm(2, t); - goto restart; - } - PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod)); - return ap; - } else { - Yap_ThrowError(TYPE_ERROR_CALLABLE, t0, pname); - } - return NULL; -} - Term Yap_TermToIndicator(Term t, Term mod) { CACHE_REGS // generate predicate indicator in this case diff --git a/C/lu_absmi_insts.h b/C/lu_absmi_insts.h index 96b25f44b..3d57b09e4 100644 --- a/C/lu_absmi_insts.h +++ b/C/lu_absmi_insts.h @@ -470,7 +470,6 @@ LogUpdClause *lcl = PREG->y_u.OtILl.d; UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]); - fprintf(stderr,"- %p/%p %lu/%lu %lu-%lu\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->y_u.OtILl.d->ClTimeStart,PREG->y_u.OtILl.d->ClTimeEnd); #if defined(YAPOR) || defined(THREADS) if (PP != ap) { if (PP) UNLOCKPE(16,PP); diff --git a/C/terms.c b/C/terms.c index 92f91b17f..4927b0df0 100644 --- a/C/terms.c +++ b/C/terms.c @@ -88,7 +88,14 @@ typedef struct non_single_struct_t { struct non_single_struct_t *to_visit0=NULL, *to_visit,* to_visit_max;\ CELL *InitialH = HR;\ tr_fr_ptr TR0 = TR;\ -reset:\ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { \ + /* Trail overflow */\ + goto trail_overflow;\ + }\ + if (HR + 1024 > ASP) { \ + goto global_overflow;\ + }\ + reset:\ to_visit0 = Realloc(to_visit0,auxsz); \ pt0 = pt0_; pt0_end = pt0_end_; \ to_visit = to_visit0, \ @@ -189,7 +196,7 @@ aux_overflow : { \ goto reset; } #define def_trail_overflow() \ -trail_overflow : { \ + trail_overflow: { \ while (to_visit > to_visit0) { \ to_visit--; \ CELL *ptd0 = to_visit->ptd0; \ @@ -234,6 +241,12 @@ if (IS_VISIT_MARKER) { \ return true; \ } +#define def_overflow() \ + def_aux_overflow(); \ + def_global_overflow(); \ + def_trail_overflow() + + #define CYC_APPL \ if (IS_VISIT_MARKER) { \ while (to_visit > to_visit0) { \ @@ -254,7 +267,7 @@ static Term cyclic_complex_term(CELL *pt0_, CELL *pt0_end_ USES_REGS) { return false; - def_aux_overflow(); + def_overflow(); } bool Yap_IsCyclicTerm(Term t USES_REGS) { @@ -300,6 +313,10 @@ static int cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) { struct non_single_struct_t *to_visit0=NULL, *to_visit, *to_visit_max; CELL *InitialH = HR; tr_fr_ptr TR0 = TR; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { \ + /* Trail overflow */\ + goto trail_overflow;\ + }\ reset: pt0 = pt0_, pt0_end = pt0_end_; @@ -341,6 +358,9 @@ static int cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) { to_visit->ptf = ptf; to_visit++; ptf = HR; + if (HR + 1024 > ASP) { \ + goto global_overflow;\ + }\ HR += 2; *ptd0 = VISIT_MARKER; pt0 = ptd0; @@ -406,7 +426,7 @@ pop_text_stack(lvl); return rc; -def_aux_overflow(); +def_overflow(); } @@ -466,7 +486,7 @@ static bool ground_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { return true; - def_aux_overflow(); + def_overflow(); } bool Yap_IsGroundTerm(Term t) { @@ -523,7 +543,7 @@ if (to_visit > to_visit0) { pop_text_stack(lvl); return false; -def_aux_overflow(); +def_overflow(); } static Int var_in_term( @@ -610,11 +630,8 @@ static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ , } else { return (inp); } - def_trail_overflow(); + def_overflow(); - def_aux_overflow(); - - def_global_overflow(); } /** @@ -774,9 +791,7 @@ static Term attvars_in_complex_term( /*fprintf(stderr,"<%ld at %s\n", d0, __FUNCTION__)*/; return output; - def_aux_overflow(); - def_global_overflow(); - def_trail_overflow(); + def_overflow(); } /** @pred term_attvars(+ _Term_,- _AttVars_) @@ -809,7 +824,6 @@ static Term new_vars_in_complex_term( Int n=0; CELL output = TermNil; { - tr_fr_ptr myTR0 = TR; int lvl = push_text_stack(); while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); @@ -830,8 +844,8 @@ static Term new_vars_in_complex_term( } WALK_COMPLEX_TERM(); output = MkPairTerm((CELL)ptd0, output); - TrailTerm(TR++) = *ptd0; - *ptd0 = TermFoundVar; + TrailTerm(TR++) = *ptd0; + *ptd0 = TermFoundVar; if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { goto trail_overflow; } @@ -846,11 +860,7 @@ pop_text_stack(lvl); return output; -def_aux_overflow(); - -def_trail_overflow(); - -def_global_overflow(); +def_overflow(); } /** @pred new_variables_in_term(+_CurrentVariables_, ? _Term_, -_Variables_) @@ -896,7 +906,6 @@ static Term vars_within_complex_term( CELL output = AbsPair(HR); while (!IsVarTerm(inp) && IsPairTerm(inp)) { - tr_fr_ptr myTR0; Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { CELL *ptr = VarOfTerm(t); @@ -923,9 +932,8 @@ static Term vars_within_complex_term( return TermNil; } -def_aux_overflow(); +def_overflow(); -def_global_overflow(); } /** @pred variables_within_term(+_CurrentVariables_, ? _Term_, -_Variables_) @@ -961,7 +969,7 @@ static Int free_variables_in_term( Term bounds = TermNil; t = t0 = Deref(ARG1); - Int delta = 0; + while (!IsVarTerm(t) && IsApplTerm(t)) { Functor f = FunctorOfTerm(t); if (f == FunctorHat) { @@ -1027,8 +1035,7 @@ static Term non_singletons_in_complex_term(CELL * pt0_, return ARG2; } - def_aux_overflow(); - def_trail_overflow(); + def_overflow(); } static Int p_non_singletons_in_term( @@ -1095,9 +1102,8 @@ static Int numbervars_in_complex_term(CELL * pt0_, CELL * pt0_end_, Int numbv, pop_text_stack(lvl); return numbv; - def_aux_overflow(); + def_overflow(); - def_global_overflow(); } Int Yap_NumberVars(Term inp, Int numbv, @@ -1173,7 +1179,7 @@ static int max_numbered_var(CELL * pt0_, CELL * pt0_end_, pop_text_stack(lvl); return 0; - def_aux_overflow(); + def_overflow(); } static Int MaxNumberedVar(Term inp, UInt arity PASS_REGS) { diff --git a/library/matrix.yap b/library/matrix.yap index 4053121cc..c1cf69b75 100644 --- a/library/matrix.yap +++ b/library/matrix.yap @@ -661,16 +661,16 @@ Unify _NElems_ with the type of the elements in _Matrix_. X <== matrix( L, [dim=Dims,base=Bases] ). ( X <== '[]'(Dims0, array) of ints ) :- !, foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ), - matrix_new( ints , Dims, X ), + matrix_new( ints , Dims, _, X ), matrix_base(X, Bases). +( X <== '[]'(Dims0, array) of floats ) :- + atom(X), !, + foldl( norm_dim, Dims0, _Dims, _Bases, 1, Size ), + static_array( X, Size, [float] ). ( X <== '[]'(Dims0, array) of floats ) :- !, foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ), - matrix_new( floats , Dims, X ), + matrix_new( floats , Dims,_, X ), matrix_base(X, Bases). -( X <== '[]'(Dims0, static.array) of floats ) :- - atom(X), !, - foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ), - static_array( Size, floats, X ). ( X <== '[]'(Dims0, array) of (I:J) ) :- !, foldl( norm_dim, Dims0, Dims, Bases, 1, Size ), matrix_seq(I, J, Dims, X), @@ -817,6 +817,10 @@ rhs(S, NS) :- set_lhs(V, R) :- var(V), !, V = R. set_lhs(V, R) :- number(V), !, V = R. +set_lhs(V, R) :- atom(V), !, + static_array_properties(V, N, _), + N1 is N-1, + foreach(I in 0..N1, V[I] <== R[I]). set_lhs('[]'([Args], floats(RHS)), Val) :- !, integer(RHS), @@ -973,25 +977,6 @@ mtimes(I1, I2, V) :- % three types of matrix: integers, floats and general terms. % -matrix_new(terms.terms,Dims, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :- - length(Dims,NDims), - foldl(size, Dims, 1, Size), - maplist(zero, Dims, Offsets), - functor( Matrix, c, Size). -matrix_new(opaque.ints,Dims,Matrix) :- - length(Dims,NDims), - new_ints_matrix_set(NDims, Dims, 0, Matrix). -matrix_new(opaque.floats,Dims,Matrix) :- - length(Dims,NDims), - new_floats_matrix_set(NDims, Dims, 0.0, Matrix). - - -matrix_new(array.Type(Size), Dims, Data, '$array'(Id) ) :- - length(Dims,NDims), - foldl(size, Dims, 1, Size), - maplist(zero, Dims, Offsets), - functor( Matrix, c, Size), - new_array(Size,Type,Dims,Data), matrix_new(terms, Dims, Data, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :- length(Dims,NDims), foldl(size, Dims, 1, Size), @@ -1058,7 +1043,7 @@ add_index_prefix( [L|Els0] , H ) --> [[H|L]], add_index_prefix( Els0 , H ). -matrix_set_range( Mat, Pos, Els) :- +matrix_set( Mat, Pos, Els) :- slice(Pos, Keys), maplist( matrix_set(Mat), Keys, Els). diff --git a/library/matrix/matrix.c b/library/matrix/matrix.c index cce7527c1..3be990298 100644 --- a/library/matrix/matrix.c +++ b/library/matrix/matrix.c @@ -320,13 +320,15 @@ static YAP_Bool new_ints_matrix(void) { int ndims = YAP_IntOfTerm(YAP_ARG1); YAP_Term tl = YAP_ARG2, out; int dims[MAX_DIMS]; + YAP_Term data; if (!scan_dims(ndims, tl, dims)) return FALSE; out = new_int_matrix(ndims, dims, NULL); if (out == YAP_TermNil()) return FALSE; - if (!cp_int_matrix(YAP_ARG3, out)) + data = YAP_ARG3; + if (!YAP_IsVarTerm(data) && !cp_int_matrix(data, out)) return FALSE; return YAP_Unify(YAP_ARG4, out); } @@ -351,14 +353,15 @@ static YAP_Bool new_ints_matrix_set(void) { static YAP_Bool new_floats_matrix(void) { int ndims = YAP_IntOfTerm(YAP_ARG1); - YAP_Term tl = YAP_ARG2, out; + YAP_Term tl = YAP_ARG2, out, data; int dims[MAX_DIMS]; if (!scan_dims(ndims, tl, dims)) return FALSE; out = new_float_matrix(ndims, dims, NULL); if (out == YAP_TermNil()) return FALSE; - if (!cp_float_matrix(YAP_ARG3, out)) + data = YAP_ARG3; + if (!YAP_IsVarTerm(data) && !cp_float_matrix(data, out)) return FALSE; return YAP_Unify(YAP_ARG4, out); } diff --git a/packages/ProbLog/problog/lbdd.yap b/packages/ProbLog/problog/lbdd.yap new file mode 100644 index 000000000..ea2984497 --- /dev/null +++ b/packages/ProbLog/problog/lbdd.yap @@ -0,0 +1,146 @@ + +%======================================================================== +%= +%= +%= +%======================================================================== + +/** + * @file problog/lbdd.yap + * support routines for BDD evaluation. + * +*/ + + +%======================================================================== +%= Updates all values of query_probability/2 and query_gradient/4 +%= should be called always before these predicates are accessed +%= if the old values are still valid, nothing happens +%======================================================================== + +update_values :- + values_correct, + !. +update_values :- + \+ values_correct, + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % delete old values + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + retractall(query_probability_intern(_,_)), + retractall(query_gradient_intern(_,_,_,_)), + + + assertz(values_correct). + +update_query_cleanup(QueryID) :- + ( + (query_is_similar(QueryID,_) ; query_is_similar(_,QueryID)) + -> + % either this query is similar to another or vice versa, + % therefore we don't delete anything + true; + retractall(query_gradient_intern(QueryID,_,_,_)) + ). + + +update_query(QueryID,Symbol,What_To_Update) :- + ( + query_is_similar(QueryID,_) + -> + % we don't have to evaluate the BDD + format_learning(4,'#',[]); + ( + problog_flag(sigmoid_slope,Slope), + ((What_To_Update=all;query_is_similar(_,QueryID)) -> Method='g' ; Method='l'), + gradient(QueryID, Method, Slope), + format_learning(4,'~w',[Symbol]) + ) + ). + +maplist_to_hash([], H0, H0). +maplist_to_hash([I-V|MapList], H0, Hash) :- + rb_insert(H0, V, I, H1), + maplist_to_hash(MapList, H1, Hash). + +bind_maplist([]). +bind_maplist([Node-Theta|MapList]) :- + get_prob(Node, ProbFact), + inv_sigmoid(ProbFact, Theta), + bind_maplist(MapList). + +tree_to_grad([], _, Grad, Grad). +tree_to_grad([Node|Tree], H, Grad0, Grad) :- + node_to_gradient_node(Node, H, GNode), + tree_to_grad(Tree, H, [GNode|Grad0], Grad). + +%get_prob(Node, Prob) :- +% query_probability(Node,Prob), !. +get_prob(Node, Prob) :- + get_fact_probability(Node,Prob). + +gradient(QueryID, l, Slope) :- + probability( QueryID, Slope, Prob), + assert(query_probability_intern(QueryID,Prob)), + fail. +gradient(_QueryID, l, _). + +/* query_probability(21,6.775948e-01). */ +gradient(QueryID, g, Slope) :- + recorded(QueryID, BDD, _), + query_gradients(BDD,Slope,I,Grad), +% writeln(grad(QueryID:I:Grad)), + assert(query_gradient_intern(QueryID,I,p,Grad)), + fail. +gradient(QueryID, g, Slope) :- + gradient(QueryID, l, Slope). + +query_probability( DBDD, Slope, Prob) :- + DBDD = bdd(Dir, Tree, MapList), + bind_maplist(MapList), + run_sp(Tree, Slope, 1.0, Prob0), + (Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0). + + +query_gradients(bdd(Dir, Tree, MapList),Slope,I,Grad) :- + bind_maplist(MapList), + member(I-_, MapList), + run_grad(Tree, I, Slope, 0.0, Grad0), + ( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0). + + +node_to_gradient_node(pp(P-G,X,L,R), H, gnodep(P,G,X,Id,PL,GL,PR,GR)) :- + rb_lookup(X,Id,H), + (L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL), + (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). +node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :- + rb_lookup(X,Id,H), + (L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL), + (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). + +run_sp([], _, P0, P0). +run_sp(gnodep(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- + EP = 1.0 / (1.0 + exp(-X * Slope) ), + P is EP*PL+ (1.0-EP)*PR, + run_sp(Tree, Slope, P, PF). +run_sp(gnoden(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- + EP is 1.0 / (1.0 + exp(-X * Slope) ), + P is EP*PL + (1.0-EP)*(1.0 - PR), + run_sp(Tree, Slope, P, PF). + +run_grad([], _I, _, G0, G0). +run_grad([gnodep(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :- + EP is 1.0/(1.0 + exp(-X * Slope)), + P is EP*PL+ (1.0-EP)*PR, + G0 is EP*GL + (1.0-EP)*GR, + % don' t forget the -X + ( I == Id -> G is G0+(PL-PR)* EP*(1-EP)*Slope ; G = G0 ), + run_grad(Tree, I, Slope, G, GF). +run_grad([gnoden(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :- + EP is 1.0 / (1.0 + exp(-X * Slope) ), + P is EP*PL + (1.0-EP)*(1.0 - PR), + G0 is EP*GL - (1.0 - EP) * GR, + ( I == Id -> G is G0+(PL+PR-1)*EP*(1-EP)*Slope ; G = G0 ), + run_grad(Tree, I, Slope, G, GF). + + diff --git a/packages/ProbLog/problog_examples/kbgraph.yap b/packages/ProbLog/problog_examples/kbgraph.yap index cf6884b34..0e08ac951 100644 --- a/packages/ProbLog/problog_examples/kbgraph.yap +++ b/packages/ProbLog/problog_examples/kbgraph.yap @@ -25,8 +25,7 @@ graph2bdd(Query,1,bdd(D,T,Vs)) :- graph(X,Y, TrieList, Vs), bdd_new(TrieList, C), bdd_tree(C, BDD), - BDD = bdd(D,T,_Vs0), - writeln(BDD). + BDD = bdd(D,T,_Vs0). :- set_problog_flag(init_method,(Q,N,Bdd,user:graph2bdd(Q,N,Bdd))). diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index 79f0cac37..e2db915fa 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -421,6 +421,7 @@ do_learning_intern(Iterations,Epsilon) :- logger_start_timer(duration), % mse_testset, % ground_truth_difference, + %leash(0),trace, gradient_descent, once(save_model), @@ -486,8 +487,8 @@ init_learning :- succeeds_n_times(user:example(_,_,_,_),TrainingExampleCount), assertz(example_count(TrainingExampleCount)), format_learning(3,'~q training examples~n',[TrainingExampleCount]), - current_probs <== array[TrainingExampleCount ] of floats, - current_lls <== array[TrainingExampleCount ] of floats, + %current_probs <== array[TrainingExampleCount ] of floats, + %current_lls <== array[TrainingExampleCount ] of floats, forall(tunable_fact(FactID,_GroundTruth), set_fact_probability(FactID,0.5) ), @@ -507,18 +508,6 @@ init_learning :- format_learning(1,'~n',[]). -%======================================================================== -%= Updates all values of query_probability/2 and query_gradient/4 -%= should be called always before these predicates are accessed -%= if the old values are still valid, nothing happensv -%======================================================================== - -update_values :- - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % delete old values - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - qp <== current_probs. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check, if continuous facts are used. % if yes, switch to problog_exact @@ -586,7 +575,7 @@ init_one_query(QueryID,Query,_Type) :- problog_flag(init_method,(Query,N,Bdd,user:graph2bdd(Query,N,Bdd))), !, b_setval(problog_required_keep_ground_ids,false), - (QueryID mod 100 =:= 0 -> writeln(QueryID) ; true), + (QueryID mod 100 =:= 0 ->writeln(QueryID) ; true), Bdd = bdd(Dir, Tree,MapList), user:graph2bdd(Query,N,Bdd), rb_new(H0), @@ -792,8 +781,7 @@ inv_sigmoid(T,Slope,InvSig) :- %= probabilities of the examples have to be recalculated %======================================================================== -save_old_probabilities :- - old_prob <== p. +save_old_probabilities. % vsc: avoid silly search @@ -828,59 +816,56 @@ set_tunable(I,Slope,P) :- sigmoid(X,Slope,Pr), set_fact_probability(I,Pr). +:- include(problog/lbdd). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % start calculate gradient %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :- - %Handle = user_error, - LLs = current_lls, - Probs = current_probs, + %Handle = user_error, + example_count(TrainingExampleCount), +ExProbs <== array[TrainingExampleCount] of floats, + LLs <== array[N] of floats, + Probs <== array[N] of floats, problog_flag(sigmoid_slope,Slope), N1 is N-1, forall(between(0,N1,I), (Grad[I] <== 0.0, S <== X[I], sigmoid(S,Slope, P), Probs[I] <== P) ), - writeln(e0), - leash(0),trace, forall( - user:example(QueryID,_Query,QueryProb), - compute_grad(QueryID, QueryProb,Grad, Probs, Slope,LLs) + recorded(QueryID,BDD,_), + compute_probability(BDD,Slope,QueryID,ExProbs) ), -writeln(Grad), + forall( + user:example(QueryID,_Query,QueryProb), + compute_gradient(QueryID, QueryProb,Grad, Probs, Slope,LLs) + ), + trace, LLH_Training_Queries <== sum(LLs). +compute_probability( BDD, Slope, Id, Probs) :- + query_probability( BDD, Slope, Prob), + Probs[Id] <== Prob. + -compute_grad(QueryID,QueryProb, Grad, Probs, Slope, LLs) :- - recorded(QueryID,BDD,_), - BDD = bdd(_Dir, _GradTree, MapList), - bind_maplist(MapList, Slope, Probs), - qprobability(BDD,Slope,BDDProb), +compute_gradient(QueryID,QueryProb, Grad, Probs, ExProbs, Slope, LLs) :- + recorded(QueryID,BDD,_), + BDDProb <== ExProbs[QueryID], + forall( + query_gradients(BDD,Slope,I,GradValue), + gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, Probs) + ), LL is (BDDProb-QueryProb)*(BDDProb-QueryProb), - LLs[QueryID] <== LL, - forall( - member(I-_,MapList), - gradientpair(Slope,BDDProb, QueryProb,Grad,Probs,BDD,I) - ), -writeln(LL). + writeln(LL), + LLs[QueryID] <== LL. - -gradientpair(Slope,BDDProb, QueryProb, Grad, Probs,BDD,I) :- - qgradient(I, BDD, Slope, FactID, GradValue), - G0 <== Grad[FactID], - Prob <== Probs[FactID], +gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, Probs) :- + G0 <== Grad[I], + Prob <== Probs[I], GN is G0-GradValue*2*Prob*(1-Prob)*(QueryProb-BDDProb), - Grad[FactID] <== GN. - -qprobability(bdd(Dir, Tree, _MapList), Slope, Prob) :- -/* query_probability(21,6.775948e-01). */ - run_sp(Tree, Slope, 1, Prob0), - (Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0). - - -qgradient(I, bdd(Dir,Tree,_), Slope, I, Grad) :- - run_grad(Tree, I, Slope, 1.0, 0.0, Grad0), - ( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0). + writeln(G0), + Grad[I] <== GN. wrap( X, Grad, GradCount) :- tunable_fact(FactID,GroundTruth), @@ -894,52 +879,6 @@ wrap( X, Grad, GradCount) :- wrap( _X, _Grad, _GradCount). -% writeln(grad(QueryID:I:Grad)), -% assert(query_gradient_intern(QueryID,I,p,Grad)), -% fail. -%gradient(QueryID, g, Slope) :- -% gradient(QueryID, l, Slope). - -maplist_to_hash([], H0, H0). -maplist_to_hash([I-V|MapList], H0, Hash) :- - rb_insert(H0, V, I, H1), - maplist_to_hash(MapList, H1, Hash). - -tree_to_grad([], _, Grad, Grad). -tree_to_grad([Node|Tree], H, Grad0, Grad) :- - node_to_gradient_node(Node, H, GNode), - tree_to_grad(Tree, H, [GNode|Grad0], Grad). - -node_to_gradient_node(pp(P-G,X,L,R), H, gnodep(P,G,X,Id,PL,GL,PR,GR)) :- - rb_lookup(X,Id,H), - (L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL), - (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). -node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :- - rb_lookup(X,Id,H), - (L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL), - (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). - -run_sp([], _, P0, P0). -run_sp(gnodep(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, PL, PF) :- - P is EP*PL+ (1.0-EP)*PR, - run_sp(Tree, Slope, P, PF). -run_sp(gnoden(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, PL, PF) :- - P is EP*PL + (1.0-EP)*(1.0 - PR), - run_sp(Tree, Slope, P, PF). - -run_grad([], _I, _, _, G0, G0). -run_grad([gnodep(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, PL, GL, GF) :- - P is EP*PL+ (1.0-EP)*PR, - G0 is EP*GL + (1.0-EP)*GR, - % don' t forget the -X - ( I == Id -> G is PL-PR ; G = G0 ), - run_grad(Tree, I, Slope, P, G, GF). -run_grad([gnoden(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, PL, GL, GF) :- - P is EP*PL + (1.0-EP)*(1.0 - PR), - G0 is EP*GL - (1.0 - EP) * GR, - ( I == Id -> G is PL-(1.0-PR) ; G = G0 ), - run_grad(Tree, I, Slope, P, G, GF). - prob2log(_X,Slope,FactID,V) :- @@ -1023,4 +962,3 @@ init_logger :- :- initialization(init_flags). :- initialization(init_logger). - diff --git a/packages/ProbLog/problog_learning_lbdd.yap b/packages/ProbLog/problog_learning_lbdd.yap index 3a0f00aef..fdf342e5a 100644 --- a/packages/ProbLog/problog_learning_lbdd.yap +++ b/packages/ProbLog/problog_learning_lbdd.yap @@ -664,138 +664,6 @@ init_one_query(_QueryID,_Query,_Type) :- -%======================================================================== -%= Updates all values of query_probability/2 and query_gradient/4 -%= should be called always before these predicates are accessed -%= if the old values are still valid, nothing happens -%======================================================================== - -update_values :- - values_correct, - !. -update_values :- - \+ values_correct, - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % delete old values - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - retractall(query_probability_intern(_,_)), - retractall(query_gradient_intern(_,_,_,_)), - - - assertz(values_correct). - - - -%======================================================================== -%= -%= -%= -%======================================================================== - -update_query_cleanup(QueryID) :- - ( - (query_is_similar(QueryID,_) ; query_is_similar(_,QueryID)) - -> - % either this query is similar to another or vice versa, - % therefore we don't delete anything - true; - retractall(query_gradient_intern(QueryID,_,_,_)) - ). - - -update_query(QueryID,Symbol,What_To_Update) :- - ( - query_is_similar(QueryID,_) - -> - % we don't have to evaluate the BDD - format_learning(4,'#',[]); - ( - problog_flag(sigmoid_slope,Slope), - ((What_To_Update=all;query_is_similar(_,QueryID)) -> Method='g' ; Method='l'), - gradient(QueryID, Method, Slope), - format_learning(4,'~w',[Symbol]) - ) - ). - -bind_maplist([]). -bind_maplist([Node-Theta|MapList]) :- - get_prob(Node, ProbFact), - inv_sigmoid(ProbFact, Theta), - bind_maplist(MapList). - -%get_prob(Node, Prob) :- -% query_probability(Node,Prob), !. -get_prob(Node, Prob) :- - get_fact_probability(Node,Prob). - -gradient(QueryID, l, Slope) :- -/* query_probability(21,6.775948e-01). */ - recorded(QueryID, bdd(Dir, Tree, MapList), _), - bind_maplist(MapList), - run_sp(Tree, Slope, 1.0, Prob0), - (Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0), - assert(query_probability_intern(QueryID,Prob)), - fail. -gradient(_QueryID, l, _). -gradient(QueryID, g, Slope) :- - recorded(QueryID, bdd(Dir, Tree, MapList), _), - bind_maplist(MapList), - member(I-_, MapList), - run_grad(Tree, I, Slope, 0.0, Grad0), - ( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0), -% writeln(grad(QueryID:I:Grad)), - assert(query_gradient_intern(QueryID,I,p,Grad)), - fail. -gradient(QueryID, g, Slope) :- - gradient(QueryID, l, Slope). - -maplist_to_hash([], H0, H0). -maplist_to_hash([I-V|MapList], H0, Hash) :- - rb_insert(H0, V, I, H1), - maplist_to_hash(MapList, H1, Hash). - -tree_to_grad([], _, Grad, Grad). -tree_to_grad([Node|Tree], H, Grad0, Grad) :- - node_to_gradient_node(Node, H, GNode), - tree_to_grad(Tree, H, [GNode|Grad0], Grad). - -node_to_gradient_node(pp(P-G,X,L,R), H, gnodep(P,G,X,Id,PL,GL,PR,GR)) :- - rb_lookup(X,Id,H), - (L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL), - (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). -node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :- - rb_lookup(X,Id,H), - (L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL), - (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). - -run_sp([], _, P0, P0). -run_sp(gnodep(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- - EP = 1.0 / (1.0 + exp(-X * Slope) ), - P is EP*PL+ (1.0-EP)*PR, - run_sp(Tree, Slope, P, PF). -run_sp(gnoden(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- - EP is 1.0 / (1.0 + exp(-X * Slope) ), - P is EP*PL + (1.0-EP)*(1.0 - PR), - run_sp(Tree, Slope, P, PF). - -run_grad([], _I, _, G0, G0). -run_grad([gnodep(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :- - EP is 1.0/(1.0 + exp(-X * Slope)), - P is EP*PL+ (1.0-EP)*PR, - G0 is EP*GL + (1.0-EP)*GR, - % don' t forget the -X - ( I == Id -> G is G0+(PL-PR)* EP*(1-EP)*Slope ; G = G0 ), - run_grad(Tree, I, Slope, G, GF). -run_grad([gnoden(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :- - EP is 1.0 / (1.0 + exp(-X * Slope) ), - P is EP*PL + (1.0-EP)*(1.0 - PR), - G0 is EP*GL - (1.0 - EP) * GR, - ( I == Id -> G is G0+(PL+PR-1)*EP*(1-EP)*Slope ; G = G0 ), - run_grad(Tree, I, Slope, G, GF). - - - %======================================================================== %= This predicate reads probability and gradient values from the file diff --git a/packages/gecode/examples/queens.yap b/packages/gecode/examples/queens.yap index 3167babbf..74704c7f3 100644 --- a/packages/gecode/examples/queens.yap +++ b/packages/gecode/examples/queens.yap @@ -64,4 +64,4 @@ constrain(Q, I, Space, R, J, J1) :- Sum is I-J, Diff is J-I, Space += linear([1,-1], [Q,R], 'IRT_NQ', Diff), - Space += linear([1,-1], [Q,R], 'IRT_NQ', Sum). \ No newline at end of file + Space += linear([1,-1], [Q,R], 'IRT_NQ', Sum). From e8d9e71a4eedd7dbe99d3eeff442b2902dede915 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 17 Mar 2019 23:01:48 +0000 Subject: [PATCH 079/101] lbfgs --- library/matrix.yap | 64 +++++++------- packages/ProbLog/problog/lbdd.yap | 26 ++++-- packages/ProbLog/problog_examples/kbgraph.yap | 3 - packages/ProbLog/problog_lbfgs.yap | 86 ++++++------------- 4 files changed, 78 insertions(+), 101 deletions(-) diff --git a/library/matrix.yap b/library/matrix.yap index c1cf69b75..d0617f474 100644 --- a/library/matrix.yap +++ b/library/matrix.yap @@ -654,40 +654,44 @@ Unify _NElems_ with the type of the elements in _Matrix_. :- use_module(library(mapargs)). :- use_module(library(lists)). -( X <== '[]'(Dims0, array) of V ) :- - var(V), !, - foldl( norm_dim, Dims0, Dims, Bases, 1, Size ), - length( L, Size ), - X <== matrix( L, [dim=Dims,base=Bases] ). -( X <== '[]'(Dims0, array) of ints ) :- !, - foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ), - matrix_new( ints , Dims, _, X ), - matrix_base(X, Bases). -( X <== '[]'(Dims0, array) of floats ) :- - atom(X), !, - foldl( norm_dim, Dims0, _Dims, _Bases, 1, Size ), - static_array( X, Size, [float] ). -( X <== '[]'(Dims0, array) of floats ) :- !, - foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ), - matrix_new( floats , Dims,_, X ), - matrix_base(X, Bases). -( X <== '[]'(Dims0, array) of (I:J) ) :- !, - foldl( norm_dim, Dims0, Dims, Bases, 1, Size ), - matrix_seq(I, J, Dims, X), - matrixn_size(X, Size), - matrix_base(X, Bases). +( X <== '[]'(Dims0, array) of T ) :- + var(X), + ( T== ints -> true ; T== floats), + !, + foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ), + matrix_new( T , Dims, _, X ), + matrix_base(X, Bases). +( X <== '[]'(Dims0, array) of T ) :- + atom(X), + ( T== ints -> true ; T== floats), + !, + foldl( norm_dim, Dims0, _Dims, _Bases, 1, Size ), + static_array( X, Size, [float] ). +( X <== '[]'(Dims0, array) of (I:J) ) :- + var(X), + integer(I), + integer(J), + !, + foldl( norm_dim, Dims0, Dims, Bases, 1, Size ), + matrix_seq(I, J, Dims, X), + matrixn_size(X, Size), + matrix_base(X, Bases). + ( X <== '[]'(Dims0, array) of L ) :- - length( L, Size ), !, + is_list(L), + !, + length( L, Size ), !, foldl( norm_dim, Dims0, Dims, Bases, 1, Size ), X <== matrix( L, [dim=Dims,base=Bases] ). -( X <== '[]'(Dims0, array) of Pattern ) :- !, - array_extension(Pattern, Goal), - foldl( norm_dim, Dims0, Dims, Bases, 1, Size ), - call(Goal, Pattern, Dims, Size, L), - X <== matrix( L, [dim=Dims,base=Bases] ). +( X <== '[]'(Dims0, array) of Pattern ) :- + array_extension(Pattern, Goal), + !, + foldl( norm_dim, Dims0, Dims, Bases, 1, Size ), + call(Goal, Pattern, Dims, Size, L), + X <== matrix( L, [dim=Dims,base=Bases] ). ( LHS <== RHS ) :- - rhs(RHS, R), - set_lhs( LHS, R). + rhs(RHS, R), + set_lhs( LHS, R). diff --git a/packages/ProbLog/problog/lbdd.yap b/packages/ProbLog/problog/lbdd.yap index ea2984497..6a3cefd1e 100644 --- a/packages/ProbLog/problog/lbdd.yap +++ b/packages/ProbLog/problog/lbdd.yap @@ -63,11 +63,19 @@ maplist_to_hash([I-V|MapList], H0, Hash) :- rb_insert(H0, V, I, H1), maplist_to_hash(MapList, H1, Hash). -bind_maplist([]). -bind_maplist([Node-Theta|MapList]) :- - get_prob(Node, ProbFact), - inv_sigmoid(ProbFact, Theta), - bind_maplist(MapList). + +prob2log(_X,Slope,FactID,V) :- + get_fact_probability(FactID, V0), + inv_sigmoid(V0, Slope, V). + +log2prob(X,Slope,FactID,V) :- + V0 <== X[FactID], + sigmoid(V0, Slope, V). + +bind_maplist([], _Slope, _X). +bind_maplist([Node-Pr|MapList], Slope, X) :- + Pr <== X[Node], + bind_maplist(MapList, Slope, X). tree_to_grad([], _, Grad, Grad). tree_to_grad([Node|Tree], H, Grad0, Grad) :- @@ -95,15 +103,15 @@ gradient(QueryID, g, Slope) :- gradient(QueryID, g, Slope) :- gradient(QueryID, l, Slope). -query_probability( DBDD, Slope, Prob) :- +query_probability( DBDD, Slope, X, Prob) :- DBDD = bdd(Dir, Tree, MapList), - bind_maplist(MapList), + bind_maplist(MapList, Slope, X), run_sp(Tree, Slope, 1.0, Prob0), (Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0). -query_gradients(bdd(Dir, Tree, MapList),Slope,I,Grad) :- - bind_maplist(MapList), +query_gradients(bdd(Dir, Tree, MapList),Slope,X,I,Grad) :- + bind_maplist(MapList, Slope, X), member(I-_, MapList), run_grad(Tree, I, Slope, 0.0, Grad0), ( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0). diff --git a/packages/ProbLog/problog_examples/kbgraph.yap b/packages/ProbLog/problog_examples/kbgraph.yap index ac6520f3f..a9bded8d9 100644 --- a/packages/ProbLog/problog_examples/kbgraph.yap +++ b/packages/ProbLog/problog_examples/kbgraph.yap @@ -26,9 +26,6 @@ graph2bdd(Query,1,bdd(D,T,Vs)) :- bdd_new(TrieList, C), bdd_tree(C, BDD), BDD = bdd(D,T,_Vs0). - BDD = bdd(D,T,_Vs0), - writeln(BDD). - :- set_problog_flag(init_method,(Q,N,Bdd,user:graph2bdd(Q,N,Bdd))). diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index e2db915fa..515a56245 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -797,8 +797,9 @@ gradient_descent :- lbfgs_run(Solver,_BestF), lbfgs_finalize(Solver). -set_fact(FactID, Slope, X ) :- - get_fact_probability(FactID,Pr), +set_fact(FactID, Slope, P ) :- + X <== P[FactID], + sigmoid(X, Slope, Pr), (Pr > 0.99 -> NPr = 0.99 @@ -806,9 +807,8 @@ set_fact(FactID, Slope, X ) :- Pr < 0.01 -> NPr = 0.01 ; - Pr = NPr ), - inv_sigmoid(NPr, Slope, XZ), - X[FactID] <== XZ. + Pr = NPr ), + set_fact_probability(FactID, NPr). set_tunable(I,Slope,P) :- @@ -823,49 +823,33 @@ set_tunable(I,Slope,P) :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :- %Handle = user_error, - example_count(TrainingExampleCount), -ExProbs <== array[TrainingExampleCount] of floats, - LLs <== array[N] of floats, - Probs <== array[N] of floats, + go( X,Grad, LLs), + sum_list( LLs, LLH_Training_Queries). + +go( X,Grad, LLs) :- problog_flag(sigmoid_slope,Slope), - N1 is N-1, - forall(between(0,N1,I), - (Grad[I] <== 0.0, S <== X[I], sigmoid(S,Slope, P), Probs[I] <== P) - ), - forall( + findall( + LL, + compute_gradient(Grad, X, Slope,LL), + LLs + ). + + +compute_gradient( Grad, X, Slope, LL) :- + user:example(QueryID,_Query,QueryProb), recorded(QueryID,BDD,_), - compute_probability(BDD,Slope,QueryID,ExProbs) - ), - forall( - user:example(QueryID,_Query,QueryProb), - compute_gradient(QueryID, QueryProb,Grad, Probs, Slope,LLs) - ), - trace, - LLH_Training_Queries <== sum(LLs). - -compute_probability( BDD, Slope, Id, Probs) :- - query_probability( BDD, Slope, Prob), - Probs[Id] <== Prob. - - - -compute_gradient(QueryID,QueryProb, Grad, Probs, ExProbs, Slope, LLs) :- - recorded(QueryID,BDD,_), - BDDProb <== ExProbs[QueryID], - forall( - query_gradients(BDD,Slope,I,GradValue), - gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, Probs) - ), + query_probability( BDD, Slope, X, BDDProb), LL is (BDDProb-QueryProb)*(BDDProb-QueryProb), - writeln(LL), - LLs[QueryID] <== LL. + forall( + query_gradients(BDD,Slope,X,I,GradValue), + gradient_pair(BDDProb, QueryProb, Grad, GradValue, Slope, X, I) + ). -gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, Probs) :- +gradient_pair(BDDProb, QueryProb, Grad, GradValue, Slope, X, I) :- G0 <== Grad[I], - Prob <== Probs[I], + log2prob(X,Slope,I,Prob), GN is G0-GradValue*2*Prob*(1-Prob)*(QueryProb-BDDProb), - writeln(G0), - Grad[I] <== GN. + Grad[I] <== GN. wrap( X, Grad, GradCount) :- tunable_fact(FactID,GroundTruth), @@ -878,22 +862,6 @@ wrap( X, Grad, GradCount) :- fail. wrap( _X, _Grad, _GradCount). - - - -prob2log(_X,Slope,FactID,V) :- - get_fact_probability(FactID, V0), - inv_sigmoid(V0, Slope, V). - -log2prob(X,Slope,FactID,V) :- - V0 <== X[FactID], - sigmoid(V0, Slope, V). - -bind_maplist([], _Slope, _X). -bind_maplist([Node-Pr|MapList], Slope, X) :- - Pr <== X[Node], - bind_maplist(MapList, Slope, X). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % stop calculate gradient %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -901,7 +869,7 @@ user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_Iteration,_Ls,-1) :- FX < 0, !, format('stopped on bad FX=~4f~n',[FX]). user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :- - roblog_flag(sigmoid_slope,Slope), + problog_flag(sigmoid_slope,Slope), forall(tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)), current_iteration(CurrentIteration), retractall(current_iteration(_)), From 70a43ece1d8629b34a10820a665512641bbd1596 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 18 Mar 2019 14:47:29 +0000 Subject: [PATCH 080/101] jupyter --- CMakeLists.txt | 4 +- CXX/yapa.hh | 48 +++++++++++++++++ CXX/yapi.cpp | 17 ++++++ CXX/yapt.hh | 53 ++----------------- info/meta.yaml | 2 +- packages/gecode/dev/code-generator.py | 2 +- packages/gecode/dev/extractor/Makefile | 2 +- packages/gecode/gecode6-common.icc | 12 ++--- packages/gecode/gecode6_yap.cc | 22 ++++---- packages/python/swig/prolog/yapi.yap | 12 ++--- packages/python/swig/yap4py/yapi.py | 4 +- .../yap_kernel/yap_ipython/core/usage.py | 4 +- .../python/yap_kernel/yap_ipython/yapi.py | 3 +- packages/swig/CMakeLists.txt | 3 +- 14 files changed, 105 insertions(+), 83 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index d96b4c0d0..9d7fbeed1 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -590,7 +590,7 @@ ENDIF (WITH_PYTHON) IF (WITH_R) find_host_package(LibR) add_subDIRECTORY(packages/real) -ENDIF (WITH_R) + ENDIF (WITH_R) include(Sources) @@ -811,7 +811,7 @@ endif () if (WITH_JAVA) #detect java setup, as it is shared between different installations. - find_package(Java COMPONENTS Runtime Development) + find_package(Java COMPONENTS Development Runtime) # find_package(Java COMPONENTS Development) # find_package(Java COMPONENTS Runtime) #find_package(JavaLibs) diff --git a/CXX/yapa.hh b/CXX/yapa.hh index 8d0454326..c4f76e465 100644 --- a/CXX/yapa.hh +++ b/CXX/yapa.hh @@ -118,6 +118,54 @@ public: }; +/** + * @brief YAPFunctor represents Prolog functors Name/Arity + */ +class X_API YAPFunctor : public YAPProp { + friend class YAPApplTerm; + friend class YAPTerm; + friend class YAPPredicate; + friend class YAPQuery; + Functor f; + /// Constructor: receives Prolog functor and casts it to YAPFunctor + /// + /// Notice that this is designed for internal use only. + inline YAPFunctor(Functor ff) { f = ff; } + +public: + /// Constructor: receives name as an atom, plus arity + /// + /// This is the default method, and the most popular + YAPFunctor(YAPAtom at, uintptr_t arity) { f = Yap_MkFunctor(at.a, arity); } + + /// Constructor: receives name as a string plus arity + /// + /// Notice that this is designed for ISO-LATIN-1 right now + /// Note: Python confuses the 3 constructors, + /// use YAPFunctorFromString + inline YAPFunctor(const char *s, uintptr_t arity, bool isutf8 = true) { + f = Yap_MkFunctor(Yap_LookupAtom(s), arity); + } + /// Constructor: receives name as a wide string plus arity + /// + /// Notice that this is designed for UNICODE right now + /// + /// Note: Python confuses the 3 constructors, + /// use YAPFunctorFromWideString + inline YAPFunctor(const wchar_t *s, uintptr_t arity) { + CACHE_REGS f = Yap_MkFunctor(UTF32ToAtom(s PASS_REGS), arity); + } + /// Getter: extract name of functor as an atom + /// + /// this is for external usage. + YAPAtom name(void) { return YAPAtom(NameOfFunctor(f)); } + + /// Getter: extract arity of functor as an unsigned integer + /// + /// this is for external usage. + uintptr_t arity(void) { return ArityOfFunctor(f); } +}; + #endif /* YAPA_HH */ /// @} diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index fe3a3789c..df03d1e4b 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -411,6 +411,23 @@ std::vector YAPPairTerm::listToArray() { return o; } +std::vector YAPPairTerm::listToVector() { + Term *tailp; + Term t1 = gt(); + Int l = Yap_SkipList(&t1, &tailp); + if (l < 0) { + throw YAPError(SOURCE(), TYPE_ERROR_LIST, (t), nullptr); + } + std::vector o = *new std::vector(l); + int i = 0; + Term t = gt(); + while (t != TermNil) { + o[i++] = YAPTerm(HeadOfTerm(t)); + t = TailOfTerm(t); + } + return o; +} + YAP_tag_t YAPTerm::tag() { Term tt = gt(); if (IsVarTerm(tt)) { diff --git a/CXX/yapt.hh b/CXX/yapt.hh index bf8abb188..c5eecaa5e 100644 --- a/CXX/yapt.hh +++ b/CXX/yapt.hh @@ -2,6 +2,10 @@ * @file yapt.hh */ +#ifndef X_API +#define X_API +#endif + /** * @defgroup yap-cplus-term-handling Term Handling in the YAP interface. * @@ -240,54 +244,6 @@ public: inline bool initialized() { return t != 0; }; }; -/** - * @brief YAPFunctor represents Prolog functors Name/Arity - */ -class X_API YAPFunctor : public YAPProp { - friend class YAPApplTerm; - friend class YAPTerm; - friend class YAPPredicate; - friend class YAPQuery; - Functor f; - /// Constructor: receives Prolog functor and casts it to YAPFunctor - /// - /// Notice that this is designed for internal use only. - inline YAPFunctor(Functor ff) { f = ff; } - -public: - /// Constructor: receives name as an atom, plus arity - /// - /// This is the default method, and the most popular - YAPFunctor(YAPAtom at, uintptr_t arity) { f = Yap_MkFunctor(at.a, arity); } - - /// Constructor: receives name as a string plus arity - /// - /// Notice that this is designed for ISO-LATIN-1 right now - /// Note: Python confuses the 3 constructors, - /// use YAPFunctorFromString - inline YAPFunctor(const char *s, uintptr_t arity, bool isutf8 = true) { - f = Yap_MkFunctor(Yap_LookupAtom(s), arity); - } - /// Constructor: receives name as a wide string plus arity - /// - /// Notice that this is designed for UNICODE right now - /// - /// Note: Python confuses the 3 constructors, - /// use YAPFunctorFromWideString - inline YAPFunctor(const wchar_t *s, uintptr_t arity) { - CACHE_REGS f = Yap_MkFunctor(UTF32ToAtom(s PASS_REGS), arity); - } - /// Getter: extract name of functor as an atom - /// - /// this is for external usage. - YAPAtom name(void) { return YAPAtom(NameOfFunctor(f)); } - - /// Getter: extract arity of functor as an unsigned integer - /// - /// this is for external usage. - uintptr_t arity(void) { return ArityOfFunctor(f); } -}; - /** * @brief Compound Term */ @@ -371,6 +327,7 @@ public: bool nil() { return gt() == TermNil; } YAPPairTerm cdr() { return YAPPairTerm(TailOfTerm(gt())); } std::vector listToArray(); + std::vector listToVector(); }; /** diff --git a/info/meta.yaml b/info/meta.yaml index d75d2ba34..8a51f5bbd 100644 --- a/info/meta.yaml +++ b/info/meta.yaml @@ -1,6 +1,6 @@ package: name: yap4py - version: 6.4.0 + version: 6.5.0 requirements: ignore_prefix_files: diff --git a/packages/gecode/dev/code-generator.py b/packages/gecode/dev/code-generator.py index 0e9f463ae..31925dce8 100755 --- a/packages/gecode/dev/code-generator.py +++ b/packages/gecode/dev/code-generator.py @@ -694,7 +694,7 @@ class CCDescriptor(object): print('YAP_UserCPredicate("gecode_constraint_%s", gecode_constraint_%s, %d);' \ % (self.api, self.api, len(self.argtypes))) -GECODE_VERSION = None +GECODE_VERSION = "6.1.1" def gecode_version(): #import pdb; pdb.set_trace() diff --git a/packages/gecode/dev/extractor/Makefile b/packages/gecode/dev/extractor/Makefile index 1f73ba27a..0221be9e2 100644 --- a/packages/gecode/dev/extractor/Makefile +++ b/packages/gecode/dev/extractor/Makefile @@ -1,5 +1,5 @@ GECODEDIR := $(shell g++ $(CPPFLAGS) $(CXXFLAGS) -H -E gecodedir.hh 2>&1 >/dev/null | grep gecode/kernel.hh | awk '{print $$2}' | sed 's|/kernel.hh||') -GECODEDIR=/usr/local/opt/gecode/include/gecode +GECODEDIR=/usr/include/gecode GECODECONFIG := $(GECODEDIR)/support/config.hpp GECODEVERSION := $(shell cat $(GECODECONFIG) | egrep '\' | awk '{print $$3}' | sed 's/"//g') PROTOTYPES = ../gecode-prototypes-$(GECODEVERSION).hh diff --git a/packages/gecode/gecode6-common.icc b/packages/gecode/gecode6-common.icc index 19a257192..50df988f7 100644 --- a/packages/gecode/gecode6-common.icc +++ b/packages/gecode/gecode6-common.icc @@ -353,27 +353,27 @@ namespace generic_gecode else return ikaboom("too late to create vars"); } - int new_svar(int glbMin, int glbMax, int lubMin, int lubMax, + int new_svar(int glbMin, int glbMax, int lub, unsigned int cardMin=0, unsigned int cardMax=Set::Limits::card) { - SetVar v(*this, glbMin, glbMax, lubMin, lubMax, cardMin, cardMax); + SetVar v(*this, glbMin, glbMax, lub, cardMin, cardMax); return _new_svar(v); } - int new_ssvar(int glbMin, int glbMax, IntSet lubMin, IntSet lubMax, + int new_ssvar(int glbMin, int glbMax, IntSet lub, unsigned int cardMin=0, unsigned int cardMax=Set::Limits::card) { - SetVar v(*this, glbMin, glbMax, lubMin, lubMax, cardMin, cardMax); + SetVar v(*this, glbMin, glbMax, lub, cardMin, cardMax); return _new_svar(v); } - int new_ssvar(IntSet glb, int lubMin, int lubMax, + int new_ssvar(IntSet glb, int lub, unsigned int cardMin=0, unsigned int cardMax=Set::Limits::card) { - SetVar v(*this, glb, lubMin, lubMax, cardMin, cardMax); + SetVar v(*this, glb, lub, cardMin, cardMax); return _new_svar(v); } diff --git a/packages/gecode/gecode6_yap.cc b/packages/gecode/gecode6_yap.cc index a58ddfd3e..dd1937481 100644 --- a/packages/gecode/gecode6_yap.cc +++ b/packages/gecode/gecode6_yap.cc @@ -825,10 +825,10 @@ return BOOL_VAL_RND(Rnd()); int GlbMin = YAP_IntOfTerm(YAP_ARG3); int GlbMax = YAP_IntOfTerm(YAP_ARG4); int LubMin = YAP_IntOfTerm(YAP_ARG5); - int LubMax = YAP_IntOfTerm(YAP_ARG6); + int LubMax = YAP_IntOfTerm(YAP_ARG6); //ignore int CardMin= YAP_IntOfTerm(YAP_ARG7); int CardMax= YAP_IntOfTerm(YAP_ARG8); - int idx = space->new_svar(GlbMin,GlbMax,LubMin,LubMax,CardMin,CardMax); + int idx = space->new_svar(GlbMin,GlbMax,LubMin,CardMin,CardMax); return YAP_Unify(result, YAP_MkIntTerm(idx)); } @@ -839,9 +839,9 @@ return BOOL_VAL_RND(Rnd()); int GlbMin = YAP_IntOfTerm(YAP_ARG3); int GlbMax = YAP_IntOfTerm(YAP_ARG4); int LubMin = YAP_IntOfTerm(YAP_ARG5); - int LubMax = YAP_IntOfTerm(YAP_ARG6); + int LubMax = YAP_IntOfTerm(YAP_ARG6); //ignore int CardMin= YAP_IntOfTerm(YAP_ARG7); - int idx = space->new_svar(GlbMin,GlbMax,LubMin,LubMax,CardMin); + int idx = space->new_svar(GlbMin,GlbMax,LubMin,CardMin); return YAP_Unify(result, YAP_MkIntTerm(idx)); } @@ -852,8 +852,8 @@ return BOOL_VAL_RND(Rnd()); int GlbMin = YAP_IntOfTerm(YAP_ARG3); int GlbMax = YAP_IntOfTerm(YAP_ARG4); int LubMin = YAP_IntOfTerm(YAP_ARG5); - int LubMax = YAP_IntOfTerm(YAP_ARG6); - int idx = space->new_svar(GlbMin,GlbMax,LubMin,LubMax); + int LubMax = YAP_IntOfTerm(YAP_ARG6); //ignore? + int idx = space->new_svar(GlbMin,GlbMax,LubMin); return YAP_Unify(result, YAP_MkIntTerm(idx)); } @@ -863,10 +863,10 @@ return BOOL_VAL_RND(Rnd()); GenericSpace* space = gecode_Space_from_term(YAP_ARG2); IntSet Glb = gecode_IntSet_from_term(YAP_ARG3); int LubMin = YAP_IntOfTerm(YAP_ARG4); - int LubMax = YAP_IntOfTerm(YAP_ARG5); + int LubMax = YAP_IntOfTerm(YAP_ARG5);// int CardMin = YAP_IntOfTerm(YAP_ARG6); int CardMax = YAP_IntOfTerm(YAP_ARG7); - int idx = space->new_ssvar(Glb,LubMin,LubMax,CardMin,CardMax); + int idx = space->new_ssvar(Glb,LubMin/* ,lubmax */,CardMin,CardMax); return YAP_Unify(result, YAP_MkIntTerm(idx)); } @@ -890,7 +890,7 @@ return BOOL_VAL_RND(Rnd()); IntSet Glb = gecode_IntSet_from_term(YAP_ARG3); int LubMin = YAP_IntOfTerm(YAP_ARG4); int LubMax = YAP_IntOfTerm(YAP_ARG5); - int idx = space->new_ssvar(Glb,LubMin,LubMax); + int idx = space->new_ssvar(Glb,LubMin/* ,lubmax */); return YAP_Unify(result, YAP_MkIntTerm(idx)); } @@ -903,7 +903,7 @@ return BOOL_VAL_RND(Rnd()); IntSet Lub = gecode_IntSet_from_term(YAP_ARG5); int CardMin = YAP_IntOfTerm(YAP_ARG6); int CardMax = YAP_IntOfTerm(YAP_ARG7); - int idx = space->new_ssvar(GlbMin,GlbMax,Lub,Lub,CardMin,CardMax); + int idx = space->new_ssvar(GlbMin,GlbMax,Lub,CardMin,CardMax); return YAP_Unify(result, YAP_MkIntTerm(idx)); } @@ -915,7 +915,7 @@ return BOOL_VAL_RND(Rnd()); int GlbMax = YAP_IntOfTerm(YAP_ARG4); IntSet Lub = gecode_IntSet_from_term(YAP_ARG5); int CardMin = YAP_IntOfTerm(YAP_ARG6); - int idx = space->new_ssvar(GlbMin,GlbMax,Lub,Lub,CardMin); + int idx = space->new_ssvar(GlbMin,GlbMax,Lub,CardMin); return YAP_Unify(result, YAP_MkIntTerm(idx)); } diff --git a/packages/python/swig/prolog/yapi.yap b/packages/python/swig/prolog/yapi.yap index baf97b55a..167b12773 100644 --- a/packages/python/swig/prolog/yapi.yap +++ b/packages/python/swig/prolog/yapi.yap @@ -79,16 +79,14 @@ python_query( Caller, String, Bindings ) :- output(Caller, Bindings). output( Caller, Bindings ) :- -fail, - Answer := {}, - % start_low_level_trace, + Caller.answer := {}, + /* % start_low_level_trace, foldl(ground_dict(answer), Bindings, [], Ts), term_variables( Ts, Hidden), foldl(bv, Hidden , 0, _), - maplist(into_dict(Answer),Ts), - Caller.answer := Answer, - fail. - + */ maplist(into_dict(answer),Bindings), + := print(answer)}, + Caller.answer := answer. output( _, Bindings ) :- write_query_answer( Bindings ), diff --git a/packages/python/swig/yap4py/yapi.py b/packages/python/swig/yap4py/yapi.py index c25157075..11fcdb724 100644 --- a/packages/python/swig/yap4py/yapi.py +++ b/packages/python/swig/yap4py/yapi.py @@ -1,4 +1,5 @@ import readline +import copy from yap4py.yap import * from yap4py.systuples import * from os.path import join, dirname @@ -76,11 +77,10 @@ class Query (YAPQuery): return self.port == "fail" or self.port == "exit" def __next__(self): - self.answer = {} if self.port == "fail" or self.port == "exit": raise StopIteration() if self.next(): - return self.answer + return copy.deepcopy(self.answer) raise StopIteration() def name( name, arity): diff --git a/packages/python/yap_kernel/yap_ipython/core/usage.py b/packages/python/yap_kernel/yap_ipython/core/usage.py index 5b010188f..287b47429 100644 --- a/packages/python/yap_kernel/yap_ipython/core/usage.py +++ b/packages/python/yap_kernel/yap_ipython/core/usage.py @@ -333,9 +333,9 @@ The following magic functions are currently available: """ -default_banner_parts = ["Python %s\n"%sys.version.split("\n")[0], +default_banner_parts = ["YAP %s\n"%sys.version.split("\n")[0], "Type 'copyright', 'credits' or 'license' for more information\n" , - "yap_ipython {version} -- An enhanced Interactive Python. Type '?' for help.\n".format(version=release.version), + "yap_ipython {version} -- An enhanced Interactive Prolog for Jupyter. Type '?' for help.\n".format(version=release.version), ] default_banner = ''.join(default_banner_parts) diff --git a/packages/python/yap_kernel/yap_ipython/yapi.py b/packages/python/yap_kernel/yap_ipython/yapi.py index 8623a54e2..5ebf94fa5 100644 --- a/packages/python/yap_kernel/yap_ipython/yapi.py +++ b/packages/python/yap_kernel/yap_ipython/yapi.py @@ -563,7 +563,8 @@ class YAPRun(InteractiveShell): self.answers = [] for answer in self.query: print( answer ) - self.answers += [copy.deepcopy(answer)] + self.answers += [answer] + print( self.answers) self.iterations += 1 self.os = None diff --git a/packages/swig/CMakeLists.txt b/packages/swig/CMakeLists.txt index 5d116096d..44d5ec390 100644 --- a/packages/swig/CMakeLists.txt +++ b/packages/swig/CMakeLists.txt @@ -13,7 +13,8 @@ set (SOURCES yap.i) if (ANDROID) add_subdirectory(android) else(ANDROID) -# add_subdirectory(java) + add_subdirectory(R) + add_subdirectory(java) endif(ANDROID) set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS SWIGYAP=1) From 96a40f1d5068442a69299577cfde07ff46e6f3e5 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 19 Mar 2019 18:42:17 +0000 Subject: [PATCH 081/101] jupyter --- packages/python/pypreds.c | 9 --- packages/python/swig/prolog/yapi.yap | 46 ++++--------- packages/python/swig/yap4py/yapi.py | 66 ++++++++++-------- .../yap_kernel/yap_ipython/prolog/jupyter.yap | 6 +- .../python/yap_kernel/yap_ipython/yapi.py | 69 +++++++++---------- pl/debug.yap | 9 +-- pl/top.yap | 1 - 7 files changed, 90 insertions(+), 116 deletions(-) diff --git a/packages/python/pypreds.c b/packages/python/pypreds.c index ec043c20e..4c5cfc381 100644 --- a/packages/python/pypreds.c +++ b/packages/python/pypreds.c @@ -1,15 +1,6 @@ - - - - - - - - - #include "Yap.h" #include "py4yap.h" diff --git a/packages/python/swig/prolog/yapi.yap b/packages/python/swig/prolog/yapi.yap index 167b12773..6d9bb6ef8 100644 --- a/packages/python/swig/prolog/yapi.yap +++ b/packages/python/swig/prolog/yapi.yap @@ -42,6 +42,8 @@ yapi_query( VarNames, Self ) :- Self.bindings := Dict. + + %:- initialization set_preds. set_preds :- @@ -70,51 +72,31 @@ argi(N,I,I1) :- I1 is I+1. python_query( Caller, String ) :- - python_query( Caller, String, _Bindings). + python_query( Caller, String, _Bindings). + +user:user_python_query( Caller, String, Bindings ) :- + python_query( Caller, String, _Bindings). python_query( Caller, String, Bindings ) :- atomic_to_term( String, Goal, VarNames ), query_to_answer( Goal, VarNames, Status, Bindings), - Caller.port := Status, - output(Caller, Bindings). + Caller.q.port := Status, + output(Caller, Bindings). -output( Caller, Bindings ) :- - Caller.answer := {}, - /* % start_low_level_trace, - foldl(ground_dict(answer), Bindings, [], Ts), - term_variables( Ts, Hidden), - foldl(bv, Hidden , 0, _), - */ maplist(into_dict(answer),Bindings), - := print(answer)}, - Caller.answer := answer. - output( _, Bindings ) :- write_query_answer( Bindings ), fail. -output(_Caller, _Bindings). - +output( Caller, Bindings) :- + maplist(into_dict(Caller),Bindings). + bv(V,I,I1) :- atomic_concat(['__',I],V), I1 is I+1. into_dict(D,V0=T) :- - atom(T), - !, - D[V0] := T. -into_dict(D,V0=T) :- - integer(T), -writeln((D[V0]:=T)), -!, - D[V0] := T, - := print(D). -into_dict(D,V0=T) :- - string(T), - !, - D[V0] := T. -into_dict(D,V0=T) :- - python_represents(T1,T), - D[V0] := T1. - + D.q.answer[V0] := T. + + /** * */ diff --git a/packages/python/swig/yap4py/yapi.py b/packages/python/swig/yap4py/yapi.py index 11fcdb724..460d3a30f 100644 --- a/packages/python/swig/yap4py/yapi.py +++ b/packages/python/swig/yap4py/yapi.py @@ -1,7 +1,7 @@ import readline import copy from yap4py.yap import * -from yap4py.systuples import * +from yap4py.systuples import python_query, show_answer, library, prolog_library, v0, compile, namedtuple from os.path import join, dirname import sys @@ -52,7 +52,7 @@ class JupyterEngine( Engine ): pass class EngineArgs( YAPEngineArgs ): - """ Interface to Engine Options class""" + """ Interface to EngneOptions class""" def __init__(self, args=None,**kwargs): super().__init__() @@ -69,6 +69,7 @@ class Query (YAPQuery): super().__init__(g) self.engine = engine self.port = "call" + self.answer = {} def __iter__(self): return self @@ -80,7 +81,7 @@ class Query (YAPQuery): if self.port == "fail" or self.port == "exit": raise StopIteration() if self.next(): - return copy.deepcopy(self.answer) + return True raise StopIteration() def name( name, arity): @@ -125,7 +126,7 @@ class YAPShell: def query_prolog(self, query): g = None - #import pdb; pdb.set_trace() + import pdb; pdb.set_trace() # # construct a query from a one-line string # q is opaque to Python @@ -147,9 +148,11 @@ class YAPShell: engine = self.engine bindings = [] loop = False - q = Query( engine, python_query( engine, query) ) + self.q = Query( engine, python_query( self, query) ) + q = self.q for answer in q: - bindings += [answer] + bindings += [q.answer] + print(q.answer) if q.done(): return bindings if loop: @@ -170,7 +173,7 @@ class YAPShell: if self.q: self.q.close() self.q = None - print("No (more) answers") + print("No (more) answers, found", bindings) return bindings except Exception as e: if not self.q: @@ -182,34 +185,41 @@ class YAPShell: raise def live(self, engine, **kwargs): - loop = True - self.q = None - while loop: - try: - s = input("?- ") - if not s: + try: + loop = True + self.q = None + while loop: + try: + s = input("?- ") + if not s: + continue + else: + self.query_prolog(s) + except SyntaxError as err: + print("Syntax Error error: {0}".format(err)) continue - else: - self.query_prolog(s) - except SyntaxError as err: - print("Syntax Error error: {0}".format(err)) - continue - except EOFError: - return - except RuntimeError as err: - print("YAP Execution Error: {0}".format(err)) - except ValueError: - print("Could not convert data to an integer.") - except: - print("Unexpected error:", sys.exc_info()[0]) - raise - engine.close() + except EOFError: + return + except RuntimeError as err: + print("YAP Execution Error: {0}".format(err)) + except ValueError: + print("Could not convert data to an integer.") + except: + print("Unexpected error:", sys.exc_info()[0]) + raise + engine.close() + except Exception as e: + print("Exception",e) + e.errorNo = 0 + raise + # # initialize engine # engine = yap.YAPEngine(); # engine = yap.YAPEngine(yap.YAPParams()); # def __init__(self, engine, **kwargs): + #import pdb; pdb.set_trace() self.engine = engine self.live(engine) diff --git a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap index 806caf705..7f5686fee 100644 --- a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap +++ b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap @@ -1,4 +1,4 @@ - +u /** * @file jupyter.yap * @@ -30,7 +30,7 @@ :- use_module(library(python)). - :- use_module(library(yapi)). +:- use_module(library(yapi)). :- use_module(library(complete)). :- use_module(library(verify)). @@ -73,7 +73,7 @@ jupyter_cell( _Caller, _, Line , _) :- jupyter_cell(Caller, _, Line, Bindings ) :- Query = Caller, catch( - python_query(Query,Line, Bindings), + user:user_python_query(Query,Line, Bindings), error(A,B), system_error(A,B) ). diff --git a/packages/python/yap_kernel/yap_ipython/yapi.py b/packages/python/yap_kernel/yap_ipython/yapi.py index 5ebf94fa5..fbf2f82e1 100644 --- a/packages/python/yap_kernel/yap_ipython/yapi.py +++ b/packages/python/yap_kernel/yap_ipython/yapi.py @@ -1,6 +1,5 @@ import sys - from typing import List from traitlets import Bool @@ -509,7 +508,7 @@ class YAPRun(InteractiveShell): global engine engine = self.engine self.errors = [] - self.query = None + self.q = None self.os = None self.it = None self.port = "None" @@ -542,51 +541,53 @@ class YAPRun(InteractiveShell): return self.errors def prolog(self, s, result): + # - # construct a self.queryuery from a one-line string - # self.query is opaque to Python + # construct a self.query from a one-line string + # self.q is opaque to Python try: - program,squery,_ ,howmany = self.prolog_cell(s) + program,squery,_ ,howmany = self.prolog_cell(s) # sys.settrace(tracefunc) - if self.query and self.os == (program,squery): + if self.q and self.os == (program,squery): howmany += self.iterations else: - if self.query: - self.query.close() - self.query = None - self.answers = [] - result.result = [] + if self.q: + self.q.close() + self.q = None + self.answers = [] + result.result = [] self.os = (program,squery) self.iterations = 0 - pg = jupyter_query(self.engine,program,squery) - self.query = Query(self.engine, pg) - self.answers = [] - for answer in self.query: - print( answer ) - self.answers += [answer] - print( self.answers) + pg = jupyter_query(self,program,squery) + self.q = Query(self.engine, pg) + while self.q.next(): self.iterations += 1 - - self.os = None - self.query.close() - self.query = None + o = '[ ' + o += str(self.iterations ) + o += ' ' + o += json.dumps(self.q.answer) + o += ' ]\n\n' + sys.stderr.write( o ) + self.answers += [self.q.answer] + if self.q.port == "exit": + break + if self.iterations == howmany: + break + if self.q.port != "answer" and self.iterations == howmany: + self.q.close() + self.q = None if self.answers: - sys.stderr.write('\n'+'[ ' +str(len(self.answers))+' answer(s): ]\n[ ') - print( self.answers ) - result.result = json.dumps(self.answers) - sys.stderr.write(result.result+' ]\n\n') + return self.answers else: - result.result = [] - return result.result + return None except Exception as e: - sys.stderr.write('Exception '+str(e)+'in query '+ str(self.query)+ - '\n '+str( self.bindings)+ '\n') - has_raised = True - result.result = [] - return result.result + sys.stderr.write('Exception '+str(e)+' in query '+ str(self.q)+ + '\n Answers'+ json.dumps( self.answers)+ '\n') + has_raised = True + return result.result def _yrun_cell(self, raw_cell, result, store_history=True, silent=False, @@ -728,10 +729,8 @@ class YAPRun(InteractiveShell): # state = tracer.runfunc(hist # er_query( self, cell ) ) self.shell.last_execution_succeeded = True - result.result = answers except Exception as e: has_raised = True - result.result = [] try: (etype, value, tb) = e traceback.print_exception(etype, value, tb) diff --git a/pl/debug.yap b/pl/debug.yap index 5889ebe90..1550a3bb8 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -477,14 +477,7 @@ be lost. '$trace_goal'(G, M, GoalNumber, H) :- '$undefined'(G, M), !, - '$get_predicate_definition'(M:G, NM:Goal), - ( ( M == NM ; NM == prolog), G == Goal - -> - yap_flag( unknown, Action ), - '$undefp'([M|G], Action ) - ; - '$trace_goal'(Goal, NM, GoalNumber, H) - ). + '$undefp'([M|G], _ ). % meta system '$trace_goal'(G, M, GoalNumber, H) :- '$is_metapredicate'(G, prolog), diff --git a/pl/top.yap b/pl/top.yap index 1f05b24d9..74ee6b29f 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -741,7 +741,6 @@ write_query_answer( Bindings ) :- '$current_module'(OldModule), repeat, '$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error, - user:'$LoopError'(Error, top)), prolog_flag(agc_margin,_,Old), !. '$loop'(Stream,Status) :- From 044d455597f293a18916e546ba02add50e740ce2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 19 Mar 2019 20:13:21 +0000 Subject: [PATCH 082/101] doc --- packages/python/yap_kernel/README.md | 55 ++++++++++++++++------------ 1 file changed, 32 insertions(+), 23 deletions(-) diff --git a/packages/python/yap_kernel/README.md b/packages/python/yap_kernel/README.md index 9744da286..1878553e9 100644 --- a/packages/python/yap_kernel/README.md +++ b/packages/python/yap_kernel/README.md @@ -1,39 +1,48 @@ -# IPython Kernel for Jupyter +#YAP Kernel for Jupyter This package provides the IPython kernel for Jupyter. ## Installation from source -1. `git clone` -2. `cd ipykernel` -3. `pip install -e .` +This should install as part of the YAP system -After that, all normal `ipython` commands will use this newly-installed version of the kernel. +## Jupyter Lab -## Running tests +CodeMirror does not support highlighting for Prolog. YAP includes a +port based on one that is used in SWISH. To use this mode from +jupyter lab, do as follows: -Ensure you have `nosetests` and the `nose-warnings-filters` plugin installed with +1. run `jupyter lab build` (you may need root permission). Search the +output for a aline such as: -```bash -pip install nose nose-warnings-filters -``` +~~~~ +[LabBuildApp] > node /usr/local/lib/python3.7/site-packages/jupyterlab/staging/yarn.js install +~~~~ -and then from the root directory +2, Add the following 3 lines below to the webpack.config.js file: -```bash -nosetests ipykernel -``` +~~~~~~~ +fs.ensureDirSync('node_modules/codemirror/mode/prolog'); +fs.copySync(path.join(path.resolve(jlab.buildDir),'../../../kernels/yap_kernel/prolog.js'), 'node_modules/codemirror/mode/prolog/prolog.js'); +fs.copySync(path.join(path.resolve(jlab.buildDir),'../../../kernels/yap_kernel/meta.js'), 'node_modules/codemirror/mode/meta.js'); +~~~~~~~~ +These lines should copy YAP's prolog.js and a new version of the mode directory, meta.js. whenever you rebuild jlab, eg, if you add a new plugin. -## Running tests with coverage +Next, please check the lines in context. -Follow the instructions from `Running tests`. Ensure you have the `coverage` module installed with +be at around line 24: -```bash -pip install coverage -``` +~~~~~~~ + output: jlab.outputDir +}); -and then from the root directory +fs.ensureDirSync('node_modules/codemirror/mode/prolog'); +fs.copySync(path.join(path.resolve(jlab.buildDir),'../../../kernels/yap_kernel/prolog.js'), 'node_modules/codemirror/mode/prolog/prolog.js'); +fs.copySync(path.join(path.resolve(jlab.buildDir),'../../../kernels/yap_kernel/meta.js'), 'node_modules/codemirror/mode/meta.js'); + +// Create the entry point file. +var source = fs.readFileSync('index.js').toString(); +~~~~~~~~ + +3: Rerun "jupyter lab build" -```bash -nosetests --with-coverage --cover-package ipykernel ipykernel -``` From e626847e9377c5faf67f2de9e2d93607cde11b50 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 19 Mar 2019 20:51:11 +0000 Subject: [PATCH 083/101] synch --- misc/editors/prolog.js | 216 ++++++++++++++++++----------------------- 1 file changed, 94 insertions(+), 122 deletions(-) diff --git a/misc/editors/prolog.js b/misc/editors/prolog.js index 7f5d4efc3..8245ba492 100644 --- a/misc/editors/prolog.js +++ b/misc/editors/prolog.js @@ -2,14 +2,14 @@ // Distributed under an MIT license: http://codemirror.net/LICENSE (function(mod) { - if (typeof exports == "object" && typeof module == "object") // CommonJS - mod(require("../../lib/codemirror")); - else if (typeof define == "function" && define.amd) // AMD - define(["../../lib/codemirror"], mod); - else // Plain browser env - mod(CodeMirror); +if (typeof exports == "object" && typeof module == "object") // CommonJS + mod(require(["codemirror/lib/codemirror","codemirror/addon/lint/lint"])); +else if (typeof define == "function" && define.amd) // AMD + define([ "codemirror/lib/codemirror","codemirror/addon/lint/lint" ], mod); +else // Plain browser env + mod(CodeMirror); })(function(CodeMirror) { - "use strict"; +"use strict"; CodeMirror.defineMode("prolog", function(conf, parserConfig) { function chain(stream, state, f) { @@ -17,8 +17,7 @@ CodeMirror.defineMode("prolog", function(conf, parserConfig) { return f(stream, state); } - var cm_ = null; -var document = CodeMirror.doc; + var cm_; var curLine; /******************************* @@ -35,25 +34,9 @@ var document = CodeMirror.doc; parserConfig.groupedIntegers || false; /* tag{k:v, ...} */ var unicodeEscape = parserConfig.unicodeEscape || true; /* \uXXXX and \UXXXXXXXX */ - var multiLineQuoted = parserConfig.multiLineQuotedd || true; - var singleQuoted = "atom"; - if (parserConfig.singleQuote === "string" || -parserConfig.singleQuote === "codes" || -parserConfig.singleQuote === "chars") - singleQuoted = parserConfig.singleQuote; - var doubleQuoted = "string"; - if (parserConfig.doubleQuote === "atom" || -parserConfig.doubleQuote === "codes" || -parserConfig.doubleQuote === "chars") - doubleQuoted = parserConfig.doubleQuote; - var backQuoted = "atom"; - if (parserConfig.backQuote === "string" || -parserConfig.backQuote === "codes" || -parserConfig.backQuote === "chars") - backQuoted = parserConfig.backQuote; - - var quoteType = {"\"" : doubleQuoted, "`" : backQuoted, "'" : singleQuoted}; - + var multiLineQuoted = parserConfig.multiLineQuoted || true; /* "...\n..." */ + var quoteType = parserConfig.quoteType || + {'"' : "string", "'" : "qatom", "`" : "bqstring"}; var singletonVars = new Map(); var isSingleEscChar = /[abref\\'"nrtsv]/; @@ -73,20 +56,21 @@ parserConfig.backQuote === "chars") var exportedMsgs = []; function getLine(stream) { -if (stream) return stream.lineOracle.line; - if (document == null) - return 0; - return document.getCursor().line; + // return cm_.getDoc().getCursor().line; } // var ed = // window.document.getElementsByClassName("CodeMirror")[0].CodeMirror.doc.getEditor(); - function rmError(document,stream) { + function rmError(stream) { + if (cm_ == null) + return; + var doc = cm_.getDoc(); var l = getLine(stream); + // stream.lineOracle.line; for (var i = 0; i < errorFound.length; i++) { - var elLine = errorFound[i].document.getLineNumber(errorFound[i].line); + var elLine = doc.getLineNumber(errorFound[i].line); if (elLine == null || l === elLine) { errorFound.splice(i, 1); i -= 1; @@ -97,29 +81,30 @@ if (stream) function mkError(stream, severity, msg) { if (stream.pos == 0) return; - var l = getLine(stream); + var l = cm_.getDoc().getLineHandle(getLine(stream)); var found = errorFound.find(function( element) { return element.line === l && element.to == stream.pos; }); if (!found) { - //console.log(getLine(stream)); - errorFound.push({ + console.log( getLine(stream) ); + errorFound.push({ "line" : l, "from" : stream.start, "to" : stream.pos, severity : severity, - message : msg, -document: document + message : msg }); } } function exportErrors(text) { - if (document == null) + if (cm_ == null) return; + var doc = cm_.getDoc(); + exportedMsgs.length = 0; for (var i = 0; i < errorFound.length; i += 1) { var e = errorFound[i]; - var l = document.getLineNumber(e.line); + var l = doc.getLineNumber(e.line); if (l == null) { errorFound.splice(i, 1); i -= 1; @@ -135,28 +120,29 @@ document: document return exportedMsgs; } - function maybeSingleton(stream, key) { - //console.log(key); + function maybeSingleton( stream, key ) { + console.log(key); var v = singletonVars.get(key); - if (v != undefined) { - v.singleton = false; - } else { - singletonVars.set( - key, {'singleton' : true, 'from' : stream.start, to : stream.pos}); - } - //console.log(singletonVars); - } - - function outputSingletonVars(stream) { - var key, v; - for (var key in singletonVars.keys()) { - var v = singletonVars[key]; - if (v != undefined && v.singleton) { - mkError(stream, "warning", key + " singleton variable"); + if (v!= undefined) { + v.singleton = false; + + } else { + singletonVars.set(key, { 'singleton': true, + 'from': stream.start, to: stream.pos } ); + } + console.log(singletonVars); + } + + function outputSingletonVars(stream) { +var key,v; +for ( [key,v] of singletonVars.entries()) { + if (v!=undefined && v.singleton) { + mkError(stream,"warning", key+" singleton variable"); + } } singletonVars.clear(); - // console.log("reset"); + console.log("reset"); } CodeMirror.registerHelper("lint", "prolog", exportErrors); @@ -323,7 +309,6 @@ document: document if (ch == "{" && state.lastType == "tag") { state.nesting.push({ - marker: ch, tag : state.tagName, column : stream.column(), leftCol : state.tagColumn, @@ -334,12 +319,8 @@ document: document return ret("dict_open", "bracket"); } - if (ch == "/") { -var next = stream.peek(); -if (next == '*') { - return chain(stream, state, plTokenComment); - } - } + if (ch == "/" && stream.eat("*")) + return chain(stream, state, plTokenComment); if (ch == "%") { stream.skipToEnd(); @@ -351,60 +332,53 @@ if (next == '*') { if (isSoloChar.test(ch)) { switch (ch) { case ")": { -if (state.nesting.marker != "(") { - mkError(stream, "error", state.nesting.marker + " closed by )"); -} state.nesting.pop(); } break; case "]": -if (state.nesting.marker != "[") { - mkError(stream, "error", state.nesting.marker + " closed by ]"); -} + state.nesting.pop(); return ret("list_close", "bracket"); case "}": { - if (state.nesting.marker != "{") { - mkError(stream, "error", state.nesting.marker + " closed by }"); -} - var nest = nesting(state); + var nest = nesting(state); var type = (nest && nest.tag) ? "dict_close" : "brace_term_close"; state.nesting.pop(); return ret(type, null); } break; - case ",": { + case ",": + { if (stream.eol()) state.commaAtEOL = true; nextArg(state); /*FALLTHROUGH*/ - if (!state.commaAtEOL) - stream.eatSpace(); - var nch = stream.peek(); - if (nch == ';' || nch == ',') { - mkError(stream, "error", "\",\" followed by " + stream.peek()); - return ret("solo", "error", ","); - } - if (isControl(state)) { - if ("[" != ch) { - if (state.inBody) { + if (!state.commaAtEOL) + stream.eatSpace(); + var nch = stream.peek(); + if ( nch == ';' || nch == ',') { + mkError(stream, "error", "\",\" followed by "+stream.peek()); + return ret("solo", "error", ","); + } + if (isControl(state)) { + if ("[" != ch ) { + if (state.inBody ) { state.goalStart = true; } else { - mkError(stream, "error", "\",\" followed by " + stream.peek()); + mkError(stream, "error", "\",\" followed by "+stream.peek()); return ret("solo", "error", ","); } } } - return ret('solo', 'tag', ","); + return ret('solo','tag', ","); } break; case ";": - if (!state.commaAtEOL) - stream.eatSpace(); - ch = stream.peek(); - if (ch == ';' || ch == ',') { - mkError(stream, "error", "\",\" followed by " + stream.peek()); - return ret("solo", "error", ";"); - } - if (isControl(state)) { + if (!state.commaAtEOL) + stream.eatSpace(); + ch = stream.peek(); + if ( ch == ';' || ch == ',') { + mkError(stream, "error", "\",\" followed by "+stream.peek()); + return ret("solo", "error", ";"); + } + if (isControl(state)) { if (!state.inBody) { mkError(stream, "error", "unexpected ;"); return ret("solo", "error", ";"); @@ -495,27 +469,25 @@ if (state.nesting.marker != "[") { mkError(stream, "error", "Clause over before closing all brackets"); state.nesting = []; } - // var start = cm_.getCursor("end"); - // cm_.setBookmark(start, {"widget" : - // document.createTextNode("•")}); + // var start = cm_.getCursor("end"); + //cm_.setBookmark(start, {"widget" : document.createTextNode("•")}); state.inBody = false; state.goalStart = true; outputSingletonVars(stream); stream.eat(ch); -state.headStart = true; return ret("fullstop", "def", atom); } else { if (atom === ":-" && state.headStart) { - state.headStart = false; - state.inBody = true; + state.headStart = false; + state.inBody = true; state.goalStart = true; return ret("directive", "attribute", atom); } else if (isNeck.test(atom)) { state.inBody = true; state.goalStart = true; - return ret("neck", "def", atom); + return ret("neck", "property", atom); } else if (isControl(state) && isControlOp.test(atom)) { state.goalStart = true; return ret("symbol", "meta", atom); @@ -523,7 +495,7 @@ state.headStart = true; return ret("symbol", "meta", atom); } } - stream.eatWhile(/\w/); + stream.eatWhile(/[\w_]/); if (composeGoalWithDots) { while (stream.peek() == ".") { stream.eat('.'); @@ -532,8 +504,8 @@ state.headStart = true; stream.backUp(1); break; - } else if (/\w/.test(ch)) { - stream.eatWhile(/\w/); + } else if (/[\w_]/.test(ch)) { + stream.eatWhile(/[\w_]/); } else if (ch == "'") { stream.eat(); @@ -557,26 +529,23 @@ state.headStart = true; if (word.length == 1) { return ret("var", "variable-2", word); } else { - return ret("var", "variable-2", word); + return ret("var", "variable-2", word); } - } else if (ch.match(/[A-Z]/)) { - maybeSingleton(stream, word); + } else if (ch.match(/[A-Z]/) ) { + maybeSingleton(stream,word); return ret("var", "variable-1", word); } -if (state.headStart) { + if (stream.peek() == "(") { + state.functorName = word; /* tmp state extension */ + state.functorColumn = stream.column(); + if (state.headStart) { state.headStart = false; - if (state.headFunctor !== word) { + if (state.headFunctor != word) { state.headFunctor = word; return ret("functor", "def", word); } -return ret("functor", "atom", word); - } - - if (stream.peek() == "(") { - state.functorName = word; /* tmp state extension */ - state.functorColumn = stream.column(); - if (builtins[word] && isControl(state)) + if (builtins[word] && isControl(state)) return ret("functor", "keyword", word); return ret("functor", "atom", word); } else if ((extra = stream.eatSpace())) { @@ -604,6 +573,7 @@ return ret("functor", "atom", word); return ret("atom", "keyword", word); } return ret("atom", "atom", word); + } function plTokenString(quote) { @@ -748,7 +718,7 @@ IfTrue CodeMirror.defineOption( "prologKeys", true, function(cm, editor, prev) { - document = cm.getDoc(); + cm_ = cm; if (prev && prev != CodeMirror.Init) cm.removeKeyMap("prolog"); if (true) { @@ -1418,9 +1388,11 @@ IfTrue setArgAlignment(state); return null; } + if (state.curLine == null || state.pos == 0) + rmError(stream); var style = state.tokenize(stream, state); - //console.log(state.curToken); + console.log(state.curToken); if (stream.eol()) { if (stream.pos > 0) @@ -1467,7 +1439,7 @@ IfTrue blockCommentEnd : "*/", blockCommentContinue : " * ", comment : "%", - matchBrackets : true + matchBrackets: true }; return external; }); From 9980dd49a7c9a1b32c364008362cf3559bdb3e68 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 20 Mar 2019 10:52:38 +0000 Subject: [PATCH 084/101] deb --- misc/editors/{ => codemirror}/meta.js | 0 misc/editors/{ => codemirror}/mode.js | 0 misc/editors/{ => codemirror}/prolog.js | 0 .../{ => codemirror}/webpack.config.js | 0 misc/{ => editors/emacs}/prolog.el | 0 misc/editors/prolog.js.in | 1237 ---------------- misc/editors/yap.js | 1255 ----------------- packages/python/swig/prolog/yapi.yap | 24 +- packages/python/yap_kernel/CMakeLists.txt | 9 +- packages/python/yap_kernel/README.md | 2 +- pl/debug.yap | 15 +- pl/spy.yap | 42 + pl/top.yap | 50 +- 13 files changed, 68 insertions(+), 2566 deletions(-) rename misc/editors/{ => codemirror}/meta.js (100%) rename misc/editors/{ => codemirror}/mode.js (100%) rename misc/editors/{ => codemirror}/prolog.js (100%) rename misc/editors/{ => codemirror}/webpack.config.js (100%) rename misc/{ => editors/emacs}/prolog.el (100%) delete mode 100644 misc/editors/prolog.js.in delete mode 100644 misc/editors/yap.js diff --git a/misc/editors/meta.js b/misc/editors/codemirror/meta.js similarity index 100% rename from misc/editors/meta.js rename to misc/editors/codemirror/meta.js diff --git a/misc/editors/mode.js b/misc/editors/codemirror/mode.js similarity index 100% rename from misc/editors/mode.js rename to misc/editors/codemirror/mode.js diff --git a/misc/editors/prolog.js b/misc/editors/codemirror/prolog.js similarity index 100% rename from misc/editors/prolog.js rename to misc/editors/codemirror/prolog.js diff --git a/misc/editors/webpack.config.js b/misc/editors/codemirror/webpack.config.js similarity index 100% rename from misc/editors/webpack.config.js rename to misc/editors/codemirror/webpack.config.js diff --git a/misc/prolog.el b/misc/editors/emacs/prolog.el similarity index 100% rename from misc/prolog.el rename to misc/editors/emacs/prolog.el diff --git a/misc/editors/prolog.js.in b/misc/editors/prolog.js.in deleted file mode 100644 index 961d9c45e..000000000 --- a/misc/editors/prolog.js.in +++ /dev/null @@ -1,1237 +0,0 @@ -// CodeMirror, copyright (c) by Marijn Haverbeke and others -// Distributed under an MIT license: http://codemirror.net/LICENSE - -(function(mod) { -if (typeof exports == "object" && typeof module == "object") // CommonJS - mod(require("codemirror/lib/codemirror")); -else if (typeof define == "function" && define.amd) // AMD - define([ "codemirror/lib/codemirror" ], mod); -else // Plain browser env - mod(CodeMirror); -})(function(CodeMirror) { -"use strict"; - -CodeMirror.defineMode("prolog", function(cm_config, parserConfig) { - - function chain(stream, state, f) { - state.tokenize = f; - return f(stream, state); - } - - /******************************* - * CONFIG DATA * - *******************************/ - - var config = { - quasiQuotations : false, /* {|Syntax||Quotation|} */ - dicts : false, /* tag{k:v, ...} */ - unicodeEscape : true, /* \uXXXX and \UXXXXXXXX */ - multiLineQuoted : true, /* "...\n..." */ - groupedIntegers : false /* 10 000 or 10_000 */ - }; - - var quoteType = {'"' : "string", "'" : "qatom", "`" : "bqstring"}; - - var isSingleEscChar = /[abref\\'"nrtsv]/; - var isOctalDigit = /[0-7]/; - var isHexDigit = /[0-9a-fA-F]/; - - var isSymbolChar = /[-#$&*+./:<=>?@\\^~]/; /* Prolog glueing symbols chars */ - var isSoloChar = /[[\]{}(),;|!]/; /* Prolog solo chars */ - var isNeck = /^(:-|-->)$/; - var isControlOp = /^(,|;|->|\*->|\\+|\|)$/; - - /******************************* - * CHARACTER ESCAPES * - *******************************/ - - function readDigits(stream, re, count) { - if (count > 0) { - while (count-- > 0) { - if (!re.test(stream.next())) - return false; - } - } else { - while (re.test(stream.peek())) - stream.next(); - } - return true; - } - - function readEsc(stream) { - var next = stream.next(); - if (isSingleEscChar.test(next)) - return true; - switch (next) { - case "u": - if (config.unicodeEscape) - return readDigits(stream, isHexDigit, 4); /* SWI */ - return false; - case "U": - if (config.unicodeEscape) - return readDigits(stream, isHexDigit, 8); /* SWI */ - return false; - case null: - return true; /* end of line */ - case "c": - stream.eatSpace(); - return true; - case "x": - return readDigits(stream, isHexDigit, 2); - } - if (isOctalDigit.test(next)) { - if (!readDigits(stream, isOctalDigit, -1)) - return false; - if (stream.peek() == "\\") /* SWI: optional closing \ */ - stream.next(); - return true; - } - return false; - } - - function nextUntilUnescaped(stream, state, end) { - var next; - while ((next = stream.next()) != null) { - if (next == end && end != stream.peek()) { - state.nesting.pop(); - return false; - } - if (next == "\\") { - if (!readEsc(stream)) - return false; - } - } - return config.multiLineQuoted; - } - - /******************************* - * CONTEXT NESTING * - *******************************/ - - function nesting(state) { return state.nesting.slice(-1)[0]; } - - /* Called on every non-comment token */ - function setArg1(state) { - var nest = nesting(state); - if (nest) { - if (nest.arg == 0) /* nested in a compound */ - nest.arg = 1; - else if (nest.type == "control") - state.goalStart = false; - } else - state.goalStart = false; - } - - function setArgAlignment(state) { - var nest = nesting(state); - if (nest && !nest.alignment && nest.arg != undefined) { - if (nest.arg == 0) - nest.alignment = nest.leftCol ? nest.leftCol + 4 : nest.column + 4; - else - nest.alignment = nest.column + 1; - } - } - - function nextArg(state) { - var nest = nesting(state); - if (nest) { - if (nest.arg) /* nested in a compound */ - nest.arg++; - else if (nest.type == "control") - state.goalStart = true; /* FIXME: also needed for ; and -> */ - } else - state.goalStart = true; - } - - function isControl(state) { /* our terms are goals */ - var nest = nesting(state); - if (nest) { - if (nest.type == "control") { - return true; - } - return false; - } else - return state.inBody; - } - - // Used as scratch variables to communicate multiple values without - // consing up tons of objects. - var type, content; - function ret(tp, style, cont) { - type = tp; - content = cont; - return style; - } - - function peekSpace(stream) { /* TBD: handle block comment as space */ - if (stream.eol() || /[\s%]/.test(stream.peek())) - return true; - return false; - } - - /******************************* - * SUB TOKENISERS * - *******************************/ - - function plTokenBase(stream, state) { - var ch = stream.next(); - - if (ch == "(") { - if (state.lastType == "functor") { - state.nesting.push({ - functor : state.functorName, - column : stream.column(), - leftCol : state.functorColumn, - arg : 0 - }); - delete state.functorName; - delete state.functorColumn; - } else { - state.nesting.push({ - type : "control", - closeColumn : stream.column(), - alignment : stream.column() + 4 - }); - } - return ret("solo", null, "("); - } - - if (ch == "{" && state.lastType == "tag") { - state.nesting.push({ - tag : state.tagName, - column : stream.column(), - leftCol : state.tagColumn, - arg : 0 - }); - delete state.tagName; - delete state.tagColumn; - return ret("dict_open", "bracket"); - } - - if (ch == "/" && stream.eat("*")) - return chain(stream, state, plTokenComment); - - if (ch == "%") { - stream.skipToEnd(); - return ret("comment", "comment"); - } - - setArg1(state); - - if (isSoloChar.test(ch)) { - switch (ch) { - case ")": - state.nesting.pop(); - break; - case "]": - state.nesting.pop(); - return ret("list_close", "bracket"); - case "}": { - var nest = nesting(state); - var type = (nest && nest.tag) ? "dict_close" : "brace_term_close"; - - state.nesting.pop(); - return ret(type, null); - }; break; - case ",": - if (stream.eol()) - state.commaAtEOL = true; - nextArg(state); - /*FALLTHROUGH*/ - if (isControl(state)) - state.goalStart = true; - break; - case ";": - if (isControl(state)) - state.goalStart = true; - break; - case "[": - state.nesting.push({ - type : "list", - closeColumn : stream.column(), - alignment : stream.column() + 2 - }); - return ret("list_open", "bracket"); - break; - case "{": - if (config.quasiQuotations && stream.eat("|")) { - state.nesting.push( - {type : "quasi-quotation", alignment : stream.column() + 1}); - return ret("qq_open", "bracket"); - } else { - state.nesting.push({ - type : "curly", - closeColumn : stream.column(), - alignment : stream.column() + 2 - }); - return ret("brace_term_open", "bracket"); - } - break; - case "|": - if (config.quasiQuotations) { - if (stream.eat("|")) { - state.tokenize = plTokenQuasiQuotation; - return ret("qq_sep", "bracket"); - } else if (stream.eat("}")) { - state.nesting.pop(); - return ret("qq_close", "bracket"); - } - } - if (isControl(state)) - state.goalStart = true; - break; - } - return ret("solo", null, ch); - } - - if (ch == '"' || ch == "'" || ch == "`") { - state.nesting.push({type : "quoted", alignment : stream.column() + 1}); - return chain(stream, state, plTokenString(ch)); - } - - if (ch == "0") { - if (stream.eat(/x/i)) { - stream.eatWhile(/[\da-f]/i); - return ret("number", "number"); - } - if (stream.eat(/o/i)) { - stream.eatWhile(/[0-7]/i); - return ret("number", "number"); - } - if (stream.eat(/'/)) { /* 0' */ - var next = stream.next(); - if (next == "\\") { - if (!readEsc(stream)) - return ret("error", "error"); - } - return ret("code", "number"); - } - } - - if (/\d/.test(ch) || /[+-]/.test(ch) && stream.eat(/\d/)) { - if (config.groupedIntegers) - stream.match(/^\d*((_|\s+)\d+)*(?:\.\d+)?(?:[eE][+\-]?\d+)?/); - else - stream.match(/^\d*(?:\.\d+)?(?:[eE][+\-]?\d+)?/); - return ret(ch == "-" ? "neg-number" - : ch == "+" ? "pos-number" : "number"); - } - - if (isSymbolChar.test(ch)) { - stream.eatWhile(isSymbolChar); - var atom = stream.current(); - if (atom == "." && peekSpace(stream)) { - if (nesting(state)) { - return ret("fullstop", "error", atom); - } else { - } - return ret("fullstop", null, atom); - } else if (isNeck.test(atom)) { - return ret("neck", "property", atom); - } else if (isControl(state) && isControlOp.test(atom)) { - state.goalStart = true; - return ret("symbol", "meta", atom); - } else - return ret("symbol", "meta", atom); - } - - stream.eatWhile(/[\w_]/); - var word = stream.current(), extra = ""; - if (stream.peek() == "{" && config.dicts) { - state.tagName = word; /* tmp state extension */ - state.tagColumn = stream.column(); - return ret("tag", "tag", word); - } else if (ch == "_") { - if (word.length == 1) { - return ret("var", "variable-3", word); - } else { - var sec = word.charAt(1); - if (sec == sec.toUpperCase()) - return ret("var", "variable-3", word); - } - return ret("var", "variable-3", word); - } else if (ch == ch.toUpperCase()) { - return ret("var", "Variable-2", word); - } else if (stream.peek() == "(") { - state.functorName = word; /* tmp state extension */ - state.functorColumn = stream.column(); - return ret("functor", "atom", word); - } else if ((extra = stream.eat(/\/\/?\d+/))) { - state.functorName = word; /* tmp state extension */ - state.functorColumn = stream.column(); - return ret("functor", "atom", word); - } else - return ret("atom", "atom", word); - } - - function plTokenString(quote) { - return function(stream, state) { - if (!nextUntilUnescaped(stream, state, quote)) { - state.tokenize = plTokenBase; - if (stream.peek() == "(") { /* 'quoted functor'() */ - var word = stream.current(); - state.functorName = word; /* tmp state extension */ - return ret("functor", "atom", word); - } - if (stream.peek() == "{" && config.dicts) { /* 'quoted tag'{} */ - var word = stream.current(); - state.tagName = word; /* tmp state extension */ - return ret("tag", "tag", word); - } - } - return ret(quoteType[quote], quoteType[quote]); - }; - } - - function plTokenQuasiQuotation(stream, state) { - var maybeEnd = false, ch; - while (ch = stream.next()) { - if (ch == "}" && maybeEnd) { - state.tokenize = plTokenBase; - stream.backUp(2); - break; - } - maybeEnd = (ch == "|"); - } - return ret("qq_content", "string"); - } - - function plTokenComment(stream, state) { - var maybeEnd = false, ch; - while (ch = stream.next()) { - if (ch == "/" && maybeEnd) { - state.tokenize = plTokenBase; - break; - } - maybeEnd = (ch == "*"); - } - return ret("comment", "comment"); - } - - // /******************************* - // * ACTIVE KEYS * - // *******************************/ - - // /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - // - - - // Support if-then-else layout like this: - - // goal :- - // ( Condition - // -> IfTrue - // ; IfFalse - // ). - // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - // - - */ - - // CodeMirror.commands.prologStartIfThenElse = function(cm) { - // var start = cm.getCursor("start"); - // var token = cm.getTokenAt(start, true); - - // if ( token.state.goalStart == true ) - // { cm.replaceSelection("( ", "end"); - // return; - // } - - // return CodeMirror.Pass; - // } - - // CodeMirror.commands.prologStartThen = function(cm) { - // var start = cm.getCursor("start"); - // var token = cm.getTokenAt(start, true); - - // /* FIXME: These functions are copied from prolog.js. How - // can we reuse these? - // */ - // function nesting(state) { - // var len = state.nesting.length; - // if ( len > 0 ) - // return state.nesting[len-1]; - // return null; - // } - - // function isControl(state) { /* our terms are goals */ - // var nest = nesting(state); - // if ( nest ) { - // if ( nest.type == "control" ) { - // return true; - // } - // return false; - // } else - // return state.inBody; - // } - - // if ( start.ch == token.end && - // token.type == "operator" && - // token.string == "-" && - // isControl(token.state) ) - // { cm.replaceSelection("> ", "end"); - // return; - // } - - // return CodeMirror.Pass; - // } - - // CodeMirror.commands.prologStartElse = function(cm) { - // var start = cm.getCursor("start"); - // var token = cm.getTokenAt(start, true); - - // if ( token.start == 0 && start.ch == token.end && - // !/\S/.test(token.string) ) - // { cm.replaceSelection("; ", "end"); - // return; - // } - - // return CodeMirror.Pass; - // } - - // CodeMirror.defineOption("prologKeys", null, function(cm, val, prev) { - // if (prev && prev != CodeMirror.Init) - // cm.removeKeyMap("prolog"); - // if ( val ) { - // var map = { name: "prolog", - // "'('": "prologStartIfThenElse", - // "'>'": "prologStartThen", - // "';'": "prologStartElse", - // "Ctrl-L": "refreshHighlight" - // }; - // cm.addKeyMap(map); - // } - // }); - - // }); - // Default (SWI-)Prolog operator table. To be used later to enhance the - // offline experience. - - var ops = { - "-->" : {p : 1200, t : "xfx"}, - ":-" : [ {p : 1200, t : "xfx"}, {p : 1200, t : "fx"} ], - "?-" : {p : 1200, t : "fx"}, - - "dynamic" : {p : 1150, t : "fx"}, - "discontiguous" : {p : 1150, t : "fx"}, - "initialization" : {p : 1150, t : "fx"}, - "meta_predicate" : {p : 1150, t : "fx"}, - "module_transparent" : {p : 1150, t : "fx"}, - "multifile" : {p : 1150, t : "fx"}, - "thread_local" : {p : 1150, t : "fx"}, - "volatile" : {p : 1150, t : "fx"}, - - ";" : {p : 1100, t : "xfy"}, - "|" : {p : 1100, t : "xfy"}, - - "->" : {p : 1050, t : "xfy"}, - "*->" : {p : 1050, t : "xfy"}, - - "," : {p : 1000, t : "xfy"}, - - "\\+" : {p : 900, t : "fy"}, - - "~" : {p : 900, t : "fx"}, - - "<" : {p : 700, t : "xfx"}, - "=" : {p : 700, t : "xfx"}, - "=.." : {p : 700, t : "xfx"}, - "=@=" : {p : 700, t : "xfx"}, - "=:=" : {p : 700, t : "xfx"}, - "=<" : {p : 700, t : "xfx"}, - "==" : {p : 700, t : "xfx"}, - "=\\=" : {p : 700, t : "xfx"}, - ">" : {p : 700, t : "xfx"}, - ">=" : {p : 700, t : "xfx"}, - "@<" : {p : 700, t : "xfx"}, - "@=<" : {p : 700, t : "xfx"}, - "@>" : {p : 700, t : "xfx"}, - "@>=" : {p : 700, t : "xfx"}, - "\\=" : {p : 700, t : "xfx"}, - "\\==" : {p : 700, t : "xfx"}, - "is" : {p : 700, t : "xfx"}, - - ":" : {p : 600, t : "xfy"}, - - "+" : [ {p : 500, t : "yfx"}, {p : 200, t : "fy"} ], - "-" : [ {p : 500, t : "yfx"}, {p : 200, t : "fy"} ], - "/\\" : {p : 500, t : "yfx"}, - "\\/" : {p : 500, t : "yfx"}, - "xor" : {p : 500, t : "yfx"}, - - "?" : {p : 500, t : "fx"}, - - "*" : {p : 400, t : "yfx"}, - "/" : {p : 400, t : "yfx"}, - "//" : {p : 400, t : "yfx"}, - "rdiv" : {p : 400, t : "yfx"}, - "<<" : {p : 400, t : "yfx"}, - ">>" : {p : 400, t : "yfx"}, - "mod" : {p : 400, t : "yfx"}, - "rem" : {p : 400, t : "yfx"}, - - "**" : {p : 200, t : "xfx"}, - "^" : {p : 200, t : "xfy"}, - - "\\" : {p : 200, t : "fy"} - }; - - var translType = { - "comment" : "comment", - "var" : "variable-2", /* JavaScript Types */ - "atom" : "atom", - "qatom" : "atom", - "bqstring" : "string", - "symbol" : "keyword", - "functor" : "keyword", - "tag" : "tag", - "number" : "number", - "string" : "string", - "code" : "number", - "neg-number" : "number", - "pos-number" : "number", - "list_open" : "bracket", - "list_close" : "bracket", - "qq_open" : "bracket", - "qq_sep" : "operator", - "qq_close" : "bracket", - "dict_open" : "bracket", - "dict_close" : "bracket", - "brace_term_open" : "bracket", - "brace_term_close" : "bracket", - "neck" : "keyword", - "fullstop" : "keyword" - }; - - var builtins = { - "C" : "prolog", - "abolish" : "prolog", - "abolish_all_tables" : "prolog", - "abolish_frozen_choice_points" : "prolog", - "abolish_module" : "prolog", - "abolish_table" : "prolog", - "abort" : "prolog", - "absolute_file_name" : "prolog", - "absolute_file_system_path" : "prolog", - "access" : "prolog", - "access_file" : "prolog", - "acyclic_term" : "prolog", - "add_import_module" : "prolog", - "add_to_array_element" : "prolog", - "add_to_path" : "prolog", - "alarm" : "prolog", - "all" : "prolog", - "always_prompt_user" : "prolog", - "arena_size" : "prolog", - "arg" : "prolog", - "array" : "prolog", - "array_element" : "prolog", - "assert" : "prolog", - "assert_static" : "prolog", - "asserta" : "prolog", - "asserta_static" : "prolog", - "assertz" : "prolog", - "assertz_static" : "prolog", - "at_end_of_line" : "prolog", - "at_end_of_stream" : "prolog", - "at_end_of_stream_0" : "prolog", - "at_halt" : "prolog", - "atom" : "prolog", - "atom_chars" : "prolog", - "atom_codes" : "prolog", - "atom_concat" : "prolog", - "atom_length" : "prolog", - "atom_number" : "prolog", - "atom_string" : "prolog", - "atom_to_term" : "prolog", - "atomic_concat" : "prolog", - "atomic_length" : "prolog", - "atomic_list_concat" : "prolog", - "atomics_to_string" : "prolog", - "attvar" : "prolog", - "b_getval" : "prolog", - "b_setval" : "prolog", - "bagof" : "prolog", - "bb_delete" : "prolog", - "bb_get" : "prolog", - "bb_put" : "prolog", - "bb_update" : "prolog", - "between" : "prolog", - "bootstrap" : "prolog", - "break" : "prolog", - "call" : "prolog", - "call_cleanup" : "prolog", - "call_count" : "prolog", - "call_count_data" : "prolog", - "call_count_reset" : "prolog", - "call_residue" : "prolog", - "call_residue_vars" : "prolog", - "call_shared_object_function" : "prolog", - "call_with_args" : "prolog", - "callable" : "prolog", - "catch" : "prolog", - "catch_ball" : "prolog", - "cd" : "prolog", - "cfile_search_path" : "prolog", - "char_code" : "prolog", - "char_conversion" : "prolog", - "char_type" : "prolog", - "clause" : "prolog", - "clause_property" : "prolog", - "close" : "prolog", - "close_shared_object" : "prolog", - "close_static_array" : "prolog", - "code_type" : "prolog", - "commons_directory" : "prolog", - "commons_library" : "prolog", - "compare" : "prolog", - "compile" : "prolog", - "compile_expressions" : "prolog", - "compile_predicates" : "prolog", - "compound" : "prolog", - "consult" : "prolog", - "consult_depth" : "prolog", - "context_module" : "prolog", - "copy_term" : "prolog", - "copy_term_nat" : "prolog", - "create_mutable" : "prolog", - "create_prolog_flag" : "prolog", - "creep_allowed" : "prolog", - "current_atom" : "prolog", - "current_char_conversion" : "prolog", - "current_host" : "prolog", - "current_input" : "prolog", - "current_key" : "prolog", - "current_line_number" : "prolog", - "current_module" : "prolog", - "current_mutex" : "prolog", - "current_op" : "prolog", - "current_predicate" : "prolog", - "current_prolog_flag" : "prolog", - "current_reference_count" : "prolog", - "current_stream" : "prolog", - "current_thread" : "prolog", - "db_files" : "prolog", - "db_reference" : "prolog", - "debug" : "prolog", - "debugging" : "prolog", - "decrease_reference_count" : "prolog", - "del_attr" : "prolog", - "del_attrs" : "prolog", - "delete_import_module" : "prolog", - "depth_bound_call" : "prolog", - "dif" : "prolog", - "discontiguous" : "prolog", - "display" : "prolog", - "do_c_built_in" : "prolog", - "do_c_built_metacall" : "prolog", - "do_not_compile_expressions" : "prolog", - "dule" : "prolog", - "dum" : "prolog", - "dump_active_goals" : "prolog", - "duplicate_term" : "prolog", - "dynamic" : "prolog", - "dynamic_predicate" : "prolog", - "dynamic_update_array" : "prolog", - "eamconsult" : "prolog", - "eamtrans" : "prolog", - "end_of_file" : "prolog", - "ensure_loaded" : "prolog", - "erase" : "prolog", - "eraseall" : "prolog", - "erased" : "prolog", - "exists" : "prolog", - "exists_directory" : "prolog", - "exists_file" : "prolog", - "exists_source" : "prolog", - "exo_files" : "prolog", - "expand_expr" : "prolog", - "expand_exprs" : "prolog", - "expand_file_name" : "prolog", - "expand_goal" : "prolog", - "expand_term" : "prolog", - "expects_dialect" : "prolog", - "export" : "prolog", - "export_list" : "prolog", - "export_resource" : "prolog", - "extend" : "prolog", - "fail" : "prolog", - "false" : "prolog", - "file_base_name" : "prolog", - "file_directory_name" : "prolog", - "file_exists" : "prolog", - "file_name_extension" : "prolog", - "file_search_path" : "prolog", - "file_size" : "prolog", - "fileerrors" : "prolog", - "findall" : "prolog", - "float" : "prolog", - "flush_output" : "prolog", - "forall" : "prolog", - "foreign_directory" : "prolog", - "format" : "prolog", - "freeze" : "prolog", - "freeze_choice_point" : "prolog", - "frozen" : "prolog", - "functor" : "prolog", - "garbage_collect" : "prolog", - "garbage_collect_atoms" : "prolog", - "gc" : "prolog", - "get" : "prolog", - "get0" : "prolog", - "get_attr" : "prolog", - "get_attrs" : "prolog", - "get_byte" : "prolog", - "get_char" : "prolog", - "get_code" : "prolog", - "get_depth_limit" : "prolog", - "get_mutable" : "prolog", - "get_string_code" : "prolog", - "get_value" : "prolog", - "getcwd" : "prolog", - "getenv" : "prolog", - "global_trie_statistics" : "prolog", - "ground" : "prolog", - "grow_heap" : "prolog", - "grow_stack" : "prolog", - "halt" : "prolog", - "heap_space_info" : "prolog", - "hide_atom" : "prolog", - "hide_predicate" : "prolog", - "hostname_address" : "prolog", - "hread_get_message" : "prolog", - "hread_signal" : "prolog", - "if" : "prolog", - "ignore" : "prolog", - "import_module" : "prolog", - "incore" : "prolog", - "increase_reference_count" : "prolog", - "init_random_state" : "prolog", - "initialization" : "prolog", - "instance" : "prolog", - "instance_property" : "prolog", - "int_message" : "prolog", - "integer" : "prolog", - "is" : "prolog", - "is_absolute_file_name" : "prolog", - "is_list" : "prolog", - "is_mutable" : "prolog", - "is_tabled" : "prolog", - "isinf" : "prolog", - "isnan" : "prolog", - "key_erased_statistics" : "prolog", - "key_statistics" : "prolog", - "keysort" : "prolog", - "leash" : "prolog", - "length" : "prolog", - "libraries_directories" : "prolog", - "line_count" : "prolog", - "listing" : "prolog", - "load_absolute_foreign_files" : "prolog", - "load_db" : "prolog", - "load_files" : "prolog", - "load_foreign_files" : "prolog", - "log_event" : "prolog", - "logsum" : "prolog", - "ls" : "prolog", - "ls_imports" : "prolog", - "make" : "prolog", - "make_directory" : "prolog", - "make_library_index" : "prolog", - "message_queue_create" : "prolog", - "message_queue_destroy" : "prolog", - "message_queue_property" : "prolog", - "message_to_string" : "prolog", - "mmapped_array" : "prolog", - "module" : "prolog", - "module_property" : "prolog", - "module_state" : "prolog", - "msort" : "prolog", - "multifile" : "prolog", - "must_be_of_type" : "prolog", - "mutex_create" : "prolog", - "mutex_property" : "prolog", - "mutex_unlock_all" : "prolog", - "name" : "prolog", - "nb_create" : "prolog", - "nb_current" : "prolog", - "nb_delete" : "prolog", - "nb_getval" : "prolog", - "nb_linkarg" : "prolog", - "nb_linkval" : "prolog", - "nb_set_bit" : "prolog", - "nb_set_shared_arg" : "prolog", - "nb_set_shared_val" : "prolog", - "nb_setarg" : "prolog", - "nb_setval" : "prolog", - "new_system_module" : "prolog", - "nl" : "prolog", - "no_source" : "prolog", - "no_style_check" : "prolog", - "nodebug" : "prolog", - "nofileeleerrors" : "prolog", - "nogc" : "prolog", - "nonvar" : "prolog", - "nospy" : "prolog", - "nospyall" : "prolog", - "not" : "prolog", - "notrace" : "prolog", - "nth_clause" : "prolog", - "nth_instance" : "prolog", - "number" : "prolog", - "number_atom" : "prolog", - "number_chars" : "prolog", - "number_codes" : "prolog", - "number_string" : "prolog", - "numbervars" : "prolog", - "on_exception" : "prolog", - "on_signal" : "prolog", - "once" : "prolog", - "op" : "prolog", - "opaque" : "prolog", - "open" : "prolog", - "open_pipe_stream" : "prolog", - "open_shared_object" : "prolog", - "opt_statistics" : "prolog", - "or_statistics" : "prolog", - "ortray_clause" : "prolog", - "otherwise" : "prolog", - "parallel" : "prolog", - "parallel_findall" : "prolog", - "parallel_findfirst" : "prolog", - "parallel_once" : "prolog", - "path" : "prolog", - "peek" : "prolog", - "peek_byte" : "prolog", - "peek_char" : "prolog", - "peek_code" : "prolog", - "phrase" : "prolog", - "plus" : "prolog", - "portray_clause" : "prolog", - "predicate_erased_statistics" : "prolog", - "predicate_property" : "prolog", - "predicate_statistics" : "prolog", - "predmerge" : "prolog", - "predsort" : "prolog", - "primitive" : "prolog", - "print" : "prolog", - "print_message" : "prolog", - "print_message_lines" : "prolog", - "private" : "prolog", - "profalt" : "prolog", - "profend" : "prolog", - "profile_data" : "prolog", - "profile_reset" : "prolog", - "profinit" : "prolog", - "profoff" : "prolog", - "profon" : "prolog", - "prolog" : "prolog", - "prolog_current_frame" : "prolog", - "prolog_file_name" : "prolog", - "prolog_file_type" : "prolog", - "prolog_flag" : "prolog", - "prolog_flag_property" : "prolog", - "prolog_initialization" : "prolog", - "prolog_load_context" : "prolog", - "prolog_to_os_filename" : "prolog", - "prompt" : "prolog", - "prompt1" : "prolog", - "put" : "prolog", - "put_attr" : "prolog", - "put_attrs" : "prolog", - "put_byte" : "prolog", - "put_char" : "prolog", - "put_char1" : "prolog", - "put_code" : "prolog", - "putenv" : "prolog", - "pwd" : "prolog", - "qend_program" : "prolog", - "qload_file" : "prolog", - "qload_module" : "prolog", - "qpack_clean_up_to_disjunction" : "prolog", - "qsave_file" : "prolog", - "qsave_module" : "prolog", - "qsave_program" : "prolog", - "raise_exception" : "prolog", - "rational" : "prolog", - "rational_term_to_tree" : "prolog", - "read" : "prolog", - "read_clause" : "prolog", - "read_sig" : "prolog", - "read_term" : "prolog", - "read_term_from_atom" : "prolog", - "read_term_from_atomic" : "prolog", - "read_term_from_string" : "prolog", - "real_path" : "prolog", - "reconsult" : "prolog", - "recorda" : "prolog", - "recorda_at" : "prolog", - "recordaifnot" : "prolog", - "recorded" : "prolog", - "recordz" : "prolog", - "recordz_at" : "prolog", - "recordzifnot" : "prolog", - "release_random_state" : "prolog", - "remove_from_path" : "prolog", - "rename" : "prolog", - "repeat" : "prolog", - "reset_static_array" : "prolog", - "reset_total_choicepoints" : "prolog", - "resize_static_array" : "prolog", - "restore" : "prolog", - "retract" : "prolog", - "retractall" : "prolog", - "rmdir" : "prolog", - "same_file" : "prolog", - "save_program" : "prolog", - "see" : "prolog", - "seeing" : "prolog", - "seen" : "prolog", - "set_base_module" : "prolog", - "set_input" : "prolog", - "set_output" : "prolog", - "set_prolog_flag" : "prolog", - "set_random_state" : "prolog", - "set_stream" : "prolog", - "set_stream_position" : "prolog", - "set_value" : "prolog", - "setarg" : "prolog", - "setenv" : "prolog", - "setof" : "prolog", - "setup_call_catcher_cleanup" : "prolog", - "setup_call_cleanup" : "prolog", - "sformat" : "prolog", - "sh" : "prolog", - "show_all_local_tables" : "prolog", - "show_all_tables" : "prolog", - "show_global_trie" : "prolog", - "show_global_trieshow_tabled_predicates" : "prolog", - "show_low_level_trace" : "prolog", - "show_table" : "prolog", - "show_tabled_predicates" : "prolog", - "showprofres" : "prolog", - "simple" : "prolog", - "skip" : "prolog", - "skip1" : "prolog", - "socket" : "prolog", - "socket_accept" : "prolog", - "socket_bind" : "prolog", - "socket_close" : "prolog", - "socket_connect" : "prolog", - "socket_listen" : "prolog", - "sort" : "prolog", - "sort2" : "prolog", - "source" : "prolog", - "source_file" : "prolog", - "source_file_property" : "prolog", - "source_location" : "prolog", - "source_mode" : "prolog", - "source_module" : "prolog", - "split_path_file" : "prolog", - "spy" : "prolog", - "srandom" : "prolog", - "start_low_level_trace" : "prolog", - "stash_predicate" : "prolog", - "static_array" : "prolog", - "static_array_location" : "prolog", - "static_array_properties" : "prolog", - "static_array_to_term" : "prolog", - "statistics" : "prolog", - "stop_low_level_trace" : "prolog", - "stream_position" : "prolog", - "stream_position_data" : "prolog", - "stream_property" : "prolog", - "stream_select" : "prolog", - "string" : "prolog", - "string_chars" : "prolog", - "string_code" : "prolog", - "string_codes" : "prolog", - "string_concat" : "prolog", - "string_length" : "prolog", - "string_number" : "prolog", - "string_to_atom" : "prolog", - "string_to_atomic" : "prolog", - "string_to_list" : "prolog", - "strip_module" : "prolog", - "style_check" : "prolog", - "sub_atom" : "prolog", - "sub_string" : "prolog", - "subsumes_term" : "prolog", - "succ" : "prolog", - "sys_debug" : "prolog", - "system" : "prolog", - "system_error" : "prolog", - "system_library" : "prolog", - "system_module" : "prolog", - "system_predicate" : "prolog", - "t_body" : "prolog", - "t_head" : "prolog", - "t_hgoal" : "prolog", - "t_hlist" : "prolog", - "t_tidy" : "prolog", - "tab" : "prolog", - "tab1" : "prolog", - "table" : "prolog", - "table_statistics" : "prolog", - "tabling_mode" : "prolog", - "tabling_statistics" : "prolog", - "tell" : "prolog", - "telling" : "prolog", - "term_attvars" : "prolog", - "term_factorized" : "prolog", - "term_to_atom" : "prolog", - "term_to_string" : "prolog", - "term_variables" : "prolog", - "thread_at_exit" : "prolog", - "thread_cancel" : "prolog", - "thread_create" : "prolog", - "thread_default" : "prolog", - "thread_defaults" : "prolog", - "thread_detach" : "prolog", - "thread_exit" : "prolog", - "thread_get_message" : "prolog", - "thread_join" : "prolog", - "thread_local" : "prolog", - "thread_peek_message" : "prolog", - "thread_property" : "prolog", - "thread_self" : "prolog", - "thread_send_message" : "prolog", - "thread_set_default" : "prolog", - "thread_set_defaults" : "prolog", - "thread_signal" : "prolog", - "thread_sleep" : "prolog", - "thread_statistics" : "prolog", - "threads" : "prolog", - "throw" : "prolog", - "time" : "prolog", - "time_file" : "prolog", - "time_file64" : "prolog", - "told" : "prolog", - "tolower" : "prolog", - "total_choicepoints" : "prolog", - "total_erased" : "prolog", - "toupper" : "prolog", - "trace" : "prolog", - "true" : "prolog", - "true_file_name" : "prolog", - "tthread_peek_message" : "prolog", - "ttyget" : "prolog", - "ttyget0" : "prolog", - "ttynl" : "prolog", - "ttyput" : "prolog", - "ttyskip" : "prolog", - "udi" : "prolog", - "unhide_atom" : "prolog", - "unify_with_occurs_check" : "prolog", - "unix" : "prolog", - "unknown" : "prolog", - "unload_file" : "prolog", - "unload_module" : "prolog", - "unnumbervars" : "prolog", - "update_array" : "prolog", - "update_mutable" : "prolog", - "use_module" : "prolog", - "use_system_module" : "prolog", - "user_defined_directive" : "prolog", - "var" : "prolog", - "version" : "prolog", - "volatile" : "prolog", - "wake_choice_point" : "prolog", - "when" : "prolog", - "with_mutex" : "prolog", - "with_output_to" : "prolog", - "working_directory" : "prolog", - "write" : "prolog", - "write_canonical" : "prolog", - "write_depth" : "prolog", - "write_term" : "prolog", - "writeln" : "prolog", - "writeq" : "prolog", - "yap_flag" : "prolog" - }; - - /******************************* - * RETURN OBJECT * - *******************************/ - - return { - startState : function() { - return { - tokenize : plTokenBase, - inBody : false, - goalStart : false, - lastType : null, - nesting : new Array(), /* ([{}]) nesting FIXME: copy this */ - curTerm : null, /* term index in metainfo */ - curToken : null /* token in term */ - }; - }, - token : function(stream, state) { - // var nest; - - if (state.curTerm == null && parserConfig.metainfo) { - state.curTerm = 0; - state.curToken = 0; - } - - if (stream.sol()) - delete state.commaAtEOL; - - if (state.tokenize == plTokenBase && stream.eatSpace()) { - if (stream.eol()) - setArgAlignment(state); - return null; - } - - var style = state.tokenize(stream, state); - - if (stream.eol()) - setArgAlignment(state); - - if (type == "neck") { - state.inBody = true; - state.goalStart = true; - } else if (type == "fullstop") { - state.inBody = false; - state.goalStart = false; - } - - state.lastType = type; - - if (builtins[state.curToken] == "prolog") - return "builtin"; - //if (ops[state.curToken]) - // return "operator"; - - //if (typeof(parserConfig.enrich) == "function") - // style = parserConfig.enrich(stream, state, type, content, style); - - return style; - - }, - - indent : function(state, textAfter) { - if (state.tokenize == plTokenComment) - return CodeMirror.Pass; - - var nest; - if ((nest = nesting(state))) { - if (nest.closeColumn && !state.commaAtEOL) - return nest.closeColumn; -y return nest.alignment; - } - if (!state.inBody) - return 0; - - return 4; - }, - - // theme: "prolog", - - blockCommentStart : "/*", /* continuecomment.js support */ - blockCommentEnd : "*/", - blockCommentContinue : " * ", - lineComment : "%", - }; - -}); - -CodeMirror.defineMIME("text/x-prolog", "prolog"); - -}); diff --git a/misc/editors/yap.js b/misc/editors/yap.js deleted file mode 100644 index 0f4fc999e..000000000 --- a/misc/editors/yap.js +++ /dev/null @@ -1,1255 +0,0 @@ - - - -// CodeMirror, copyright (c) by Marijn Haverbeke and others -// Distributed under an MIT license: http://codemirror.net/LICENSE - -(function(mod) { -if (typeof exports == "object" && typeof module == "object") // CommonJS - mod(require("codemirror/lib/codemirror")); -else if (typeof define == "function" && define.amd) // AMD - define([ "codemirror/lib/codemirror" ], mod); -else // Plain browser env - mod(CodeMirror); -})(function(CodeMirror) { -"use strict"; - - CodeMirror.defineMode("prolog", function(conf, parserConfig) { - - function chain(stream, state, f) { - state.tokenize = f; - return f(stream, state); - } - - /******************************* - * CONFIG DATA * - *******************************/ - - var quasiQuotations = - parserConfig.quasiQuotations || false; /* {|Syntax||Quotation|} */ - var dicts = parserConfig.dicts || false; /* tag{k:v, ...} */ - var groupedIntegers = parserConfig.groupedIntegers || false; /* tag{k:v, ...} */ - var unicodeEscape = - parserConfig.unicodeEscape || true; /* \uXXXX and \UXXXXXXXX */ - var multiLineQuoted = parserConfig.multiLineQuoted || true; /* "...\n..." */ - var quoteType = parserConfig.quoteType || - {'"' : "string", "'" : "qatom", "`" : "bqstring"}; - - var isSingleEscChar = /[abref\\'"nrtsv]/; - var isOctalDigit = /[0-7]/; - var isHexDigit = /[0-9a-fA-F]/; - - var isSymbolChar = /[-#$&*+./:<=>?@\\^~]/; /* Prolog glueing symbols chars */ - var isSoloChar = /[[\]{}(),;|!]/; /* Prolog solo chars */ - var isNeck = /^(:-|-->)$/; - var isControlOp = /^(,|;|->|\*->|\\+|\|)$/; - - /******************************* - * CHARACTER ESCAPES * - *******************************/ - - function readDigits(stream, re, count) { - if (count > 0) { - while (count-- > 0) { - if (!re.test(stream.next())) - return false; - } - } else { - while (re.test(stream.peek())) - stream.next(); - } - return true; - } - - function readEsc(stream) { - var next = stream.next(); - if (isSingleEscChar.test(next)) - return true; - switch (next) { - case "u": - if (unicodeEscape) - return readDigits(stream, isHexDigit, conf.indentUnit); /* SWI */ - return false; - case "U": - if (unicodeEscape) - return readDigits(stream, isHexDigit, 8); /* SWI */ - return false; - case null: - return true; /* end of line */ - case "c": - stream.eatSpace(); - return true; - case "x": - return readDigits(stream, isHexDigit, 2); - } - if (isOctalDigit.test(next)) { - if (!readDigits(stream, isOctalDigit, -1)) - return false; - if (stream.peek() == "\\") /* SWI: optional closing \ */ - stream.next(); - return true; - } - return false; - } - - function nextUntilUnescaped(stream, state, end) { - var next; - while ((next = stream.next()) != null) { - if (next == end && end != stream.peek()) { - state.nesting.pop(); - return false; - } - if (next == "\\") { - if (!readEsc(stream)) - return false; - } - } - return multiLineQuoted; - } - - /******************************* - * CONTEXT NESTING * - *******************************/ - - function nesting(state) { return state.nesting.slice(-1)[0]; } - - /* Called on every non-comment token */ - function setArg1(state) { - var nest = nesting(state); - if (nest) { - if (nest.arg == 0) /* nested in a compound */ - nest.arg = 1; - else if (nest.type == "control") - state.goalStart = false; - } else - state.goalStart = false; - } - - function setArgAlignment(state) { - var nest = nesting(state); - if (nest && !nest.alignment && nest.arg != undefined) { - if (nest.arg == 0) - nest.alignment = nest.leftCol ? nest.leftCol + conf.indentUnit : nest.column + conf.indentUnit; - else - nest.alignment = nest.column + 1; - } - } - - function nextArg(state) { - var nest = nesting(state); - if (nest) { - if (nest.arg) /* nested in a compound */ - nest.arg++; - else if (nest.type == "control") { - state.goalStart = true; /* FIXME: also needed for ; and -> */ - } - } else { - state.goalStart = true; - } - } - - function isControl(state) { /* our terms are goals */ - var nest = nesting(state); - if (nest) { - if (nest.type == "control") { - return true; - } - return false; - } else - return state.inBody; - } - - // Used as scratch variables to communicate multiple values without - // consing up tons of objects. - var type;//, content; - function ret(tp, style, cont) { - type = tp; - // content = cont; - return style; - } - - function peekSpace(stream) { /* TBD: handle block comment as space */ - if (stream.eol() || /[\s%]/.test(stream.peek())) - return true; - return false; - } - - /******************************* - * SUB TOKENISERS * - *******************************/ - - function plTokenBase(stream, state) { - var ch = stream.next(); - - if (ch == "(") { - if (state.lastType == "functor") { - state.nesting.push({ - functor : state.functorName, - column : stream.column(), - leftCol : state.functorColumn, - arg : 0 - }); - delete state.functorName; - delete state.functorColumn; - } else { - state.nesting.push({ - type : "control", - closeColumn : stream.column(), - alignment : stream.column() + conf.indentUnit - }); - } - return ret("solo", null, "("); - } - - if (ch == "{" && state.lastType == "tag") { - state.nesting.push({ - tag : state.tagName, - column : stream.column(), - leftCol : state.tagColumn, - arg : 0 - }); - delete state.tagName; - delete state.tagColumn; - return ret("dict_open", "bracket"); - } - - if (ch == "/" && stream.eat("*")) - return chain(stream, state, plTokenComment); - - if (ch == "%") { - stream.skipToEnd(); - return ret("comment", "comment"); - } - - setArg1(state); - - if (isSoloChar.test(ch)) { - switch (ch) { - case ")": - state.nesting.pop(); - break; - case "]": - state.nesting.pop(); - return ret("list_close", "bracket"); - case "}": { - var nest = nesting(state); - var type = (nest && nest.tag) ? "dict_close" : "brace_term_close"; - - state.nesting.pop(); - return ret(type, null); - }; break; - case ",": - if (stream.eol()) - state.commaAtEOL = true; - nextArg(state); - /*FALLTHROUGH*/ - if (isControl(state)) { - state.goalStart = true; - } - break; - case ";": - if (isControl(state)) { - state.goalStart = true; - } - break; - case "[": - state.nesting.push({ - type : "list", - closeColumn : stream.column(), - alignment : stream.column() + 2 - }); - return ret("list_open", "bracket"); - break; - case "{": - if (quasiQuotations && stream.eat("|")) { - state.nesting.push( - {type : "quasi-quotation", alignment : stream.column() + 1}); - return ret("qq_open", "bracket"); - } else { - state.nesting.push({ - type : "curly", - closeColumn : stream.column(), - alignment : stream.column() + 2 - }); - return ret("brace_term_open", "bracket"); - } - break; - case "|": - if (quasiQuotations) { - if (stream.eat("|")) { - state.tokenize = plTokenQuasiQuotation; - return ret("qq_sep", "bracket"); - } else if (stream.eat("}")) { - state.nesting.pop(); - return ret("qq_close", "bracket"); - } - } - if (isControl(state)) { - state.goalStart = true; - } - break; - } - return ret("solo", null, ch); - } - - if (ch == '"' || ch == "'" || ch == "`") { - state.nesting.push({type : "quoted", alignment : stream.column() + 1}); - return chain(stream, state, plTokenString(ch)); - } - - if (ch == "0") { - if (stream.eat(/x/i)) { - stream.eatWhile(/[\da-f]/i); - return ret("number", "number"); - } - if (stream.eat(/o/i)) { - stream.eatWhile(/[0-7]/i); - return ret("number", "number"); - } - if (stream.eat(/'/)) { /* 0' */ - var next = stream.next(); - if (next == "\\") { - if (!readEsc(stream)) - return ret("error", "error"); - } - return ret("code", "number"); - } - } - - if (/\d/.test(ch) || /[+-]/.test(ch) && stream.eat(/\d/)) { - if (groupedIntegers) - stream.match(/^\d*((_|\s+)\d+)*(?:\.\d+)?(?:[eE][+\-]?\d+)?/); - else - stream.match(/^\d*(?:\.\d+)?(?:[eE][+\-]?\d+)?/); - return ret(ch == "-" ? "neg-number" - : ch == "+" ? "pos-number" : "number"); - } - - if (isSymbolChar.test(ch)) { - stream.eatWhile(isSymbolChar); - var atom = stream.current(); - if (atom == "." && peekSpace(stream)) { - if (nesting(state)) { - return ret("fullstop", "meta", atom); - } else { - state.headStart = true; - } - return ret("fullstop", null, atom); - } else if (isNeck.test(atom)) { - return ret("neck", "property", atom); - } else if (isControl(state) && isControlOp.test(atom)) { - state.goalStart = true; - return ret("symbol", "meta", atom); - } else - return ret("symbol", "meta", atom); - } - - stream.eatWhile(/[\w_]/); - var word = stream.current(); - var extra = ""; - if (stream.peek() == "{" && dicts) { - state.tagName = word; /* tmp state extension */ - state.tagColumn = stream.column(); - return ret("tag", "tag", word); - } else if (ch == "_") { - if (word.length == 1) { - return ret("var", "variable-3", word); - } else { - var sec = word.charAt(1); - if (sec == sec.toUpperCase()) - return ret("var", "variable-3", word); - } - return ret("var", "variable-3", word); - } else if (ch == ch.toUpperCase()) { - return ret("var", "variable-2", word); - } else if (stream.peek() == "(") { - state.functorName = word; /* tmp state extension */ - state.functorColumn = stream.column(); - if (state.headStart) { - state.headStart = false; - if (state.headFunctor != word) { - state.headFunctor = word; - return ret("functor", "def", word); - } - } - if (builtins[word]) - return ret("functor", "keyword", word); - return ret("functor", "atom", word); - } else if ((extra = stream.eat(/\/(\/)?\d\d?/)!="")) { - state.functorName = word; /* tmp state extension */ - state.functorColumn = stream.column(); - var w = stream.current(); - if (builtins[word]) - return ret("functor", "keyword", w); - return ret("functor", "atom", w); - } else - if (state.headStart) { - state.headStart = false; - if (state.headFunctor != word) { - state.headFunctor = word; - return ret("functor", "def", word); - } - } - if (builtins[word]) - return ret("functor", "keyword", word); - return ret("atom", "atom", word); - } - - function plTokenString(quote) { - return function(stream, state) { - if (!nextUntilUnescaped(stream, state, quote)) { - state.tokenize = plTokenBase; - if (stream.peek() == "(") { /* 'quoted functor'() */ - var word = stream.current(); - state.functorName = word; /* tmp state extension */ - if (state.headStart) { - state.headStart = false; - if (state.headFunctor != word) { - state.headFunctor = word; - return ret("functor", "def", word); - } - } - return ret("functor", "atom", word); - } - if (stream.peek() == "{" && dicts) { /* 'quoted tag'{} */ - var word = stream.current(); - state.tagName = word; /* tmp state extension */ - return ret("tag", "tag", word); - } - } - return ret(quoteType[quote], "string"); - }; - } - - function plTokenQuasiQuotation(stream, state) { - var maybeEnd = false, ch; - while (ch = stream.next()) { - if (ch == "}" && maybeEnd) { - state.tokenize = plTokenBase; - stream.backUp(2); - break; - } - maybeEnd = (ch == "|"); - } - return ret("qq_content", "string"); - } - - function plTokenComment(stream, state) { - var maybeEnd = false, ch; - while (ch = stream.next()) { - if (ch == "/" && maybeEnd) { - state.tokenize = plTokenBase; - break; - } - maybeEnd = (ch == "*"); - } - return ret("comment", "comment"); - } - - // /******************************* - // * ACTIVE KEYS * - // *******************************/ - - // /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - // - - - // Support if-then-else layout like this: - - // goal :- - // ( Condition - // -> IfTrue - // ; IfFalse - // ). - // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - // - - */ - - // CodeMirror.commands.prologStartIfThenElse = function(cm) { - // var start = cm.getCursor("start"); - // var token = cm.getTokenAt(start, true); - - // if ( token.state.goalStart == true ) - // { cm.replaceSelection("( ", "end"); - // return; - // } - - // return CodeMirror.Pass; - // } - - // CodeMirror.commands.prologStartThen = function(cm) { - // var start = cm.getCursor("start"); - // var token = cm.getTokenAt(start, true); - - // /* FIXME: These functions are copied from prolog.js. How - // can we reuse these? - // */ - // function nesting(state) { - // var len = state.nesting.length; - // if ( len > 0 ) - // return state.nesting[len-1]; - // return null; - // } - - // function isControl(state) { /* our terms are goals */ - // var nest = nesting(state); - // if ( nest ) { - // if ( nest.type == "control" ) { - // return true; - // } - // return false; - // } else - // return state.inBody; - // } - - // if ( start.ch == token.end && - // token.type == "operator" && - // token.string == "-" && - // isControl(token.state) ) - // { cm.replaceSelection("> ", "end"); - // return; - // } - - // return CodeMirror.Pass; - // } - - // CodeMirror.commands.prologStartElse = function(cm) { - // var start = cm.getCursor("start"); - // var token = cm.getTokenAt(start, true); - - // if ( token.start == 0 && start.ch == token.end && - // !/\S/.test(token.string) ) - // { cm.replaceSelection("; ", "end"); - // return; - // } - - // return CodeMirror.Pass; - // } - - // CodeMirror.defineOption("prologKeys", null, function(cm, val, prev) { - // if (prev && prev != CodeMirror.Init) - // cm.removeKeyMap("prolog"); - // if ( val ) { - // var map = { name: "prolog", - // "'('": "prologStartIfThenElse", - // "'>'": "prologStartThen", - // "';'": "prologStartElse", - // "Ctrl-L": "refreshHighlight" - // }; - // cm.addKeyMap(map); - // } - // }); - - // }); - // Default (SWI-)Prolog operator table. To be used later to enhance the - // offline experience. - - var ops = { - "-->" : {p : 1200, t : "xfx"}, - ":-" : [ {p : 1200, t : "xfx"}, {p : 1200, t : "fx"} ], - "?-" : {p : 1200, t : "fx"}, - - "dynamic" : {p : 1150, t : "fx"}, - "discontiguous" : {p : 1150, t : "fx"}, - "initialization" : {p : 1150, t : "fx"}, - "meta_predicate" : {p : 1150, t : "fx"}, - "module_transparent" : {p : 1150, t : "fx"}, - "multifile" : {p : 1150, t : "fx"}, - "thread_local" : {p : 1150, t : "fx"}, - "volatile" : {p : 1150, t : "fx"}, - - ";" : {p : 1100, t : "xfy"}, - "|" : {p : 1100, t : "xfy"}, - - "->" : {p : 1050, t : "xfy"}, - "*->" : {p : 1050, t : "xfy"}, - - "," : {p : 1000, t : "xfy"}, - - "\\+" : {p : 900, t : "fy"}, - - "~" : {p : 900, t : "fx"}, - - "<" : {p : 700, t : "xfx"}, - "=" : {p : 700, t : "xfx"}, - "=.." : {p : 700, t : "xfx"}, - "=@=" : {p : 700, t : "xfx"}, - "=:=" : {p : 700, t : "xfx"}, - "=<" : {p : 700, t : "xfx"}, - "==" : {p : 700, t : "xfx"}, - "=\\=" : {p : 700, t : "xfx"}, - ">" : {p : 700, t : "xfx"}, - ">=" : {p : 700, t : "xfx"}, - "@<" : {p : 700, t : "xfx"}, - "@=<" : {p : 700, t : "xfx"}, - "@>" : {p : 700, t : "xfx"}, - "@>=" : {p : 700, t : "xfx"}, - "\\=" : {p : 700, t : "xfx"}, - "\\==" : {p : 700, t : "xfx"}, - "is" : {p : 700, t : "xfx"}, - - ":" : {p : 600, t : "xfy"}, - - "+" : [ {p : 500, t : "yfx"}, {p : 200, t : "fy"} ], - "-" : [ {p : 500, t : "yfx"}, {p : 200, t : "fy"} ], - "/\\" : {p : 500, t : "yfx"}, - "\\/" : {p : 500, t : "yfx"}, - "xor" : {p : 500, t : "yfx"}, - - "?" : {p : 500, t : "fx"}, - - "*" : {p : 400, t : "yfx"}, - "/" : {p : 400, t : "yfx"}, - "//" : {p : 400, t : "yfx"}, - "rdiv" : {p : 400, t : "yfx"}, - "<<" : {p : 400, t : "yfx"}, - ">>" : {p : 400, t : "yfx"}, - "mod" : {p : 400, t : "yfx"}, - "rem" : {p : 400, t : "yfx"}, - - "**" : {p : 200, t : "xfx"}, - "^" : {p : 200, t : "xfy"}, - - "\\" : {p : 200, t : "fy"} - }; - - - var builtins = { - "C" : "prolog", - "abolish" : "prolog", - "abolish_all_tables" : "prolog", - "abolish_frozen_choice_points" : "prolog", - "abolish_module" : "prolog", - "abolish_table" : "prolog", - "abort" : "prolog", - "absolute_file_name" : "prolog", - "absolute_file_system_path" : "prolog", - "access" : "prolog", - "access_file" : "prolog", - "acyclic_term" : "prolog", - "add_import_module" : "prolog", - "add_to_array_element" : "prolog", - "add_to_path" : "prolog", - "alarm" : "prolog", - "all" : "prolog", - "always_prompt_user" : "prolog", - "arena_size" : "prolog", - "arg" : "prolog", - "array" : "prolog", - "array_element" : "prolog", - "assert" : "prolog", - "assert_static" : "prolog", - "asserta" : "prolog", - "asserta_static" : "prolog", - "assertz" : "prolog", - "assertz_static" : "prolog", - "at_end_of_line" : "prolog", - "at_end_of_stream" : "prolog", - "at_end_of_stream_0" : "prolog", - "at_halt" : "prolog", - "atom" : "prolog", - "atom_chars" : "prolog", - "atom_codes" : "prolog", - "atom_concat" : "prolog", - "atom_length" : "prolog", - "atom_number" : "prolog", - "atom_string" : "prolog", - "atom_to_term" : "prolog", - "atomic_concat" : "prolog", - "atomic_length" : "prolog", - "atomic_list_concat" : "prolog", - "atomics_to_string" : "prolog", - "attvar" : "prolog", - "b_getval" : "prolog", - "b_setval" : "prolog", - "bagof" : "prolog", - "bb_delete" : "prolog", - "bb_get" : "prolog", - "bb_put" : "prolog", - "bb_update" : "prolog", - "between" : "prolog", - "bootstrap" : "prolog", - "break" : "prolog", - "call" : "prolog", - "call_cleanup" : "prolog", - "call_count" : "prolog", - "call_count_data" : "prolog", - "call_count_reset" : "prolog", - "call_residue" : "prolog", - "call_residue_vars" : "prolog", - "call_shared_object_function" : "prolog", - "call_with_args" : "prolog", - "callable" : "prolog", - "catch" : "prolog", - "catch_ball" : "prolog", - "cd" : "prolog", - "cfile_search_path" : "prolog", - "char_code" : "prolog", - "char_conversion" : "prolog", - "char_type" : "prolog", - "clause" : "prolog", - "clause_property" : "prolog", - "close" : "prolog", - "close_shared_object" : "prolog", - "close_static_array" : "prolog", - "code_type" : "prolog", - "commons_directory" : "prolog", - "commons_library" : "prolog", - "compare" : "prolog", - "compile" : "prolog", - "compile_expressions" : "prolog", - "compile_predicates" : "prolog", - "compound" : "prolog", - "consult" : "prolog", - "consult_depth" : "prolog", - "context_module" : "prolog", - "copy_term" : "prolog", - "copy_term_nat" : "prolog", - "create_mutable" : "prolog", - "create_prolog_flag" : "prolog", - "creep_allowed" : "prolog", - "current_atom" : "prolog", - "current_char_conversion" : "prolog", - "current_host" : "prolog", - "current_input" : "prolog", - "current_key" : "prolog", - "current_line_number" : "prolog", - "current_module" : "prolog", - "current_mutex" : "prolog", - "current_op" : "prolog", - "current_predicate" : "prolog", - "current_prolog_flag" : "prolog", - "current_reference_count" : "prolog", - "current_stream" : "prolog", - "current_thread" : "prolog", - "db_files" : "prolog", - "db_reference" : "prolog", - "debug" : "prolog", - "debugging" : "prolog", - "decrease_reference_count" : "prolog", - "del_attr" : "prolog", - "del_attrs" : "prolog", - "delete_import_module" : "prolog", - "depth_bound_call" : "prolog", - "dif" : "prolog", - "discontiguous" : "prolog", - "display" : "prolog", - "do_c_built_in" : "prolog", - "do_c_built_metacall" : "prolog", - "do_not_compile_expressions" : "prolog", - "dule" : "prolog", - "dum" : "prolog", - "dump_active_goals" : "prolog", - "duplicate_term" : "prolog", - "dynamic" : "prolog", - "dynamic_predicate" : "prolog", - "dynamic_update_array" : "prolog", - "eamconsult" : "prolog", - "eamtrans" : "prolog", - "end_of_file" : "prolog", - "ensure_loaded" : "prolog", - "erase" : "prolog", - "eraseall" : "prolog", - "erased" : "prolog", - "exists" : "prolog", - "exists_directory" : "prolog", - "exists_file" : "prolog", - "exists_source" : "prolog", - "exo_files" : "prolog", - "expand_expr" : "prolog", - "expand_exprs" : "prolog", - "expand_file_name" : "prolog", - "expand_goal" : "prolog", - "expand_term" : "prolog", - "expects_dialect" : "prolog", - "export" : "prolog", - "export_list" : "prolog", - "export_resource" : "prolog", - "extend" : "prolog", - "fail" : "prolog", - "false" : "prolog", - "file_base_name" : "prolog", - "file_directory_name" : "prolog", - "file_exists" : "prolog", - "file_name_extension" : "prolog", - "file_search_path" : "prolog", - "file_size" : "prolog", - "fileerrors" : "prolog", - "findall" : "prolog", - "float" : "prolog", - "flush_output" : "prolog", - "forall" : "prolog", - "foreign_directory" : "prolog", - "format" : "prolog", - "freeze" : "prolog", - "freeze_choice_point" : "prolog", - "frozen" : "prolog", - "functor" : "prolog", - "garbage_collect" : "prolog", - "garbage_collect_atoms" : "prolog", - "gc" : "prolog", - "get" : "prolog", - "get0" : "prolog", - "get_attr" : "prolog", - "get_attrs" : "prolog", - "get_byte" : "prolog", - "get_char" : "prolog", - "get_code" : "prolog", - "get_depth_limit" : "prolog", - "get_mutable" : "prolog", - "get_string_code" : "prolog", - "get_value" : "prolog", - "getcwd" : "prolog", - "getenv" : "prolog", - "global_trie_statistics" : "prolog", - "ground" : "prolog", - "grow_heap" : "prolog", - "grow_stack" : "prolog", - "halt" : "prolog", - "heap_space_info" : "prolog", - "hide_atom" : "prolog", - "hide_predicate" : "prolog", - "hostname_address" : "prolog", - "hread_get_message" : "prolog", - "hread_signal" : "prolog", - "if" : "prolog", - "ignore" : "prolog", - "import_module" : "prolog", - "incore" : "prolog", - "increase_reference_count" : "prolog", - "init_random_state" : "prolog", - "initialization" : "prolog", - "instance" : "prolog", - "instance_property" : "prolog", - "int_message" : "prolog", - "integer" : "prolog", - "is" : "prolog", - "is_absolute_file_name" : "prolog", - "is_list" : "prolog", - "is_mutable" : "prolog", - "is_tabled" : "prolog", - "isinf" : "prolog", - "isnan" : "prolog", - "key_erased_statistics" : "prolog", - "key_statistics" : "prolog", - "keysort" : "prolog", - "leash" : "prolog", - "length" : "prolog", - "libraries_directories" : "prolog", - "line_count" : "prolog", - "listing" : "prolog", - "load_absolute_foreign_files" : "prolog", - "load_db" : "prolog", - "load_files" : "prolog", - "load_foreign_files" : "prolog", - "log_event" : "prolog", - "logsum" : "prolog", - "ls" : "prolog", - "ls_imports" : "prolog", - "make" : "prolog", - "make_directory" : "prolog", - "make_library_index" : "prolog", - "message_queue_create" : "prolog", - "message_queue_destroy" : "prolog", - "message_queue_property" : "prolog", - "message_to_string" : "prolog", - "mmapped_array" : "prolog", - "module" : "prolog", - "module_property" : "prolog", - "module_state" : "prolog", - "msort" : "prolog", - "multifile" : "prolog", - "must_be_of_type" : "prolog", - "mutex_create" : "prolog", - "mutex_property" : "prolog", - "mutex_unlock_all" : "prolog", - "name" : "prolog", - "nb_create" : "prolog", - "nb_current" : "prolog", - "nb_delete" : "prolog", - "nb_getval" : "prolog", - "nb_linkarg" : "prolog", - "nb_linkval" : "prolog", - "nb_set_bit" : "prolog", - "nb_set_shared_arg" : "prolog", - "nb_set_shared_val" : "prolog", - "nb_setarg" : "prolog", - "nb_setval" : "prolog", - "new_system_module" : "prolog", - "nl" : "prolog", - "no_source" : "prolog", - "no_style_check" : "prolog", - "nodebug" : "prolog", - "nofileeleerrors" : "prolog", - "nogc" : "prolog", - "nonvar" : "prolog", - "nospy" : "prolog", - "nospyall" : "prolog", - "not" : "prolog", - "notrace" : "prolog", - "nth_clause" : "prolog", - "nth_instance" : "prolog", - "number" : "prolog", - "number_atom" : "prolog", - "number_chars" : "prolog", - "number_codes" : "prolog", - "number_string" : "prolog", - "numbervars" : "prolog", - "on_exception" : "prolog", - "on_signal" : "prolog", - "once" : "prolog", - "op" : "prolog", - "opaque" : "prolog", - "open" : "prolog", - "open_pipe_stream" : "prolog", - "open_shared_object" : "prolog", - "opt_statistics" : "prolog", - "or_statistics" : "prolog", - "ortray_clause" : "prolog", - "otherwise" : "prolog", - "parallel" : "prolog", - "parallel_findall" : "prolog", - "parallel_findfirst" : "prolog", - "parallel_once" : "prolog", - "path" : "prolog", - "peek" : "prolog", - "peek_byte" : "prolog", - "peek_char" : "prolog", - "peek_code" : "prolog", - "phrase" : "prolog", - "plus" : "prolog", - "portray_clause" : "prolog", - "predicate_erased_statistics" : "prolog", - "predicate_property" : "prolog", - "predicate_statistics" : "prolog", - "predmerge" : "prolog", - "predsort" : "prolog", - "primitive" : "prolog", - "print" : "prolog", - "print_message" : "prolog", - "print_message_lines" : "prolog", - "private" : "prolog", - "profalt" : "prolog", - "profend" : "prolog", - "profile_data" : "prolog", - "profile_reset" : "prolog", - "profinit" : "prolog", - "profoff" : "prolog", - "profon" : "prolog", - "prolog" : "prolog", - "prolog_current_frame" : "prolog", - "prolog_file_name" : "prolog", - "prolog_file_type" : "prolog", - "prolog_flag" : "prolog", - "prolog_flag_property" : "prolog", - "prolog_initialization" : "prolog", - "prolog_load_context" : "prolog", - "prolog_to_os_filename" : "prolog", - "prompt" : "prolog", - "prompt1" : "prolog", - "put" : "prolog", - "put_attr" : "prolog", - "put_attrs" : "prolog", - "put_byte" : "prolog", - "put_char" : "prolog", - "put_char1" : "prolog", - "put_code" : "prolog", - "putenv" : "prolog", - "pwd" : "prolog", - "qend_program" : "prolog", - "qload_file" : "prolog", - "qload_module" : "prolog", - "qpack_clean_up_to_disjunction" : "prolog", - "qsave_file" : "prolog", - "qsave_module" : "prolog", - "qsave_program" : "prolog", - "raise_exception" : "prolog", - "rational" : "prolog", - "rational_term_to_tree" : "prolog", - "read" : "prolog", - "read_clause" : "prolog", - "read_sig" : "prolog", - "read_term" : "prolog", - "read_term_from_atom" : "prolog", - "read_term_from_atomic" : "prolog", - "read_term_from_string" : "prolog", - "real_path" : "prolog", - "reconsult" : "prolog", - "recorda" : "prolog", - "recorda_at" : "prolog", - "recordaifnot" : "prolog", - "recorded" : "prolog", - "recordz" : "prolog", - "recordz_at" : "prolog", - "recordzifnot" : "prolog", - "release_random_state" : "prolog", - "remove_from_path" : "prolog", - "rename" : "prolog", - "repeat" : "prolog", - "reset_static_array" : "prolog", - "reset_total_choicepoints" : "prolog", - "resize_static_array" : "prolog", - "restore" : "prolog", - "retract" : "prolog", - "retractall" : "prolog", - "rmdir" : "prolog", - "same_file" : "prolog", - "save_program" : "prolog", - "see" : "prolog", - "seeing" : "prolog", - "seen" : "prolog", - "set_base_module" : "prolog", - "set_input" : "prolog", - "set_output" : "prolog", - "set_prolog_flag" : "prolog", - "set_random_state" : "prolog", - "set_stream" : "prolog", - "set_stream_position" : "prolog", - "set_value" : "prolog", - "setarg" : "prolog", - "setenv" : "prolog", - "setof" : "prolog", - "setup_call_catcher_cleanup" : "prolog", - "setup_call_cleanup" : "prolog", - "sformat" : "prolog", - "sh" : "prolog", - "show_all_local_tables" : "prolog", - "show_all_tables" : "prolog", - "show_global_trie" : "prolog", - "show_global_trieshow_tabled_predicates" : "prolog", - "show_low_level_trace" : "prolog", - "show_table" : "prolog", - "show_tabled_predicates" : "prolog", - "showprofres" : "prolog", - "simple" : "prolog", - "skip" : "prolog", - "skip1" : "prolog", - "socket" : "prolog", - "socket_accept" : "prolog", - "socket_bind" : "prolog", - "socket_close" : "prolog", - "socket_connect" : "prolog", - "socket_listen" : "prolog", - "sort" : "prolog", - "sort2" : "prolog", - "source" : "prolog", - "source_file" : "prolog", - "source_file_property" : "prolog", - "source_location" : "prolog", - "source_mode" : "prolog", - "source_module" : "prolog", - "split_path_file" : "prolog", - "spy" : "prolog", - "srandom" : "prolog", - "start_low_level_trace" : "prolog", - "stash_predicate" : "prolog", - "static_array" : "prolog", - "static_array_location" : "prolog", - "static_array_properties" : "prolog", - "static_array_to_term" : "prolog", - "statistics" : "prolog", - "stop_low_level_trace" : "prolog", - "stream_position" : "prolog", - "stream_position_data" : "prolog", - "stream_property" : "prolog", - "stream_select" : "prolog", - "string" : "prolog", - "string_chars" : "prolog", - "string_code" : "prolog", - "string_codes" : "prolog", - "string_concat" : "prolog", - "string_length" : "prolog", - "string_number" : "prolog", - "string_to_atom" : "prolog", - "string_to_atomic" : "prolog", - "string_to_list" : "prolog", - "strip_module" : "prolog", - "style_check" : "prolog", - "sub_atom" : "prolog", - "sub_string" : "prolog", - "subsumes_term" : "prolog", - "succ" : "prolog", - "sys_debug" : "prolog", - "system" : "prolog", - "system_error" : "prolog", - "system_library" : "prolog", - "system_module" : "prolog", - "system_predicate" : "prolog", - "t_body" : "prolog", - "t_head" : "prolog", - "t_hgoal" : "prolog", - "t_hlist" : "prolog", - "t_tidy" : "prolog", - "tab" : "prolog", - "tab1" : "prolog", - "table" : "prolog", - "table_statistics" : "prolog", - "tabling_mode" : "prolog", - "tabling_statistics" : "prolog", - "tell" : "prolog", - "telling" : "prolog", - "term_attvars" : "prolog", - "term_factorized" : "prolog", - "term_to_atom" : "prolog", - "term_to_string" : "prolog", - "term_variables" : "prolog", - "thread_at_exit" : "prolog", - "thread_cancel" : "prolog", - "thread_create" : "prolog", - "thread_default" : "prolog", - "thread_defaults" : "prolog", - "thread_detach" : "prolog", - "thread_exit" : "prolog", - "thread_get_message" : "prolog", - "thread_join" : "prolog", - "thread_local" : "prolog", - "thread_peek_message" : "prolog", - "thread_property" : "prolog", - "thread_self" : "prolog", - "thread_send_message" : "prolog", - "thread_set_default" : "prolog", - "thread_set_defaults" : "prolog", - "thread_signal" : "prolog", - "thread_sleep" : "prolog", - "thread_statistics" : "prolog", - "threads" : "prolog", - "throw" : "prolog", - "time" : "prolog", - "time_file" : "prolog", - "time_file64" : "prolog", - "told" : "prolog", - "tolower" : "prolog", - "total_choicepoints" : "prolog", - "total_erased" : "prolog", - "toupper" : "prolog", - "trace" : "prolog", - "true" : "prolog", - "true_file_name" : "prolog", - "tthread_peek_message" : "prolog", - "ttyget" : "prolog", - "ttyget0" : "prolog", - "ttynl" : "prolog", - "ttyput" : "prolog", - "ttyskip" : "prolog", - "udi" : "prolog", - "unhide_atom" : "prolog", - "unify_with_occurs_check" : "prolog", - "unix" : "prolog", - "unknown" : "prolog", - "unload_file" : "prolog", - "unload_module" : "prolog", - "unnumbervars" : "prolog", - "update_array" : "prolog", - "update_mutable" : "prolog", - "use_module" : "prolog", - "use_system_module" : "prolog", - "user_defined_directive" : "prolog", - "var" : "prolog", - "version" : "prolog", - "volatile" : "prolog", - "wake_choice_point" : "prolog", - "when" : "prolog", - "with_mutex" : "prolog", - "with_output_to" : "prolog", - "working_directory" : "prolog", - "write" : "prolog", - "write_canonical" : "prolog", - "write_depth" : "prolog", - "write_term" : "prolog", - "writeln" : "prolog", - "writeq" : "prolog", - "yap_flag" : "prolog" - }; - - /******************************* - * RETURN OBJECT * - *******************************/ - - var external = { - startState : function() { - return { - tokenize : plTokenBase, - inBody : false, - goalStart : false, - headStart : true, - headFunctor : "", - lastType : null, - nesting : new Array(), /* ([{}]) nesting FIXME: copy this */ - curTerm : null, /* term index in metainfo */ - curToken : null /* token in term */ - }; - }, - token : function(stream, state) { - // var nest; - - if (state.curTerm == null && parserConfig.metainfo) { - state.curTerm = 0; - state.curToken = 0; - } - - if (stream.sol()) - delete state.commaAtEOL; - - if (state.tokenize == plTokenBase && stream.eatSpace()) { - if (stream.eol()) - setArgAlignment(state); - return null; - } - - var style = state.tokenize(stream, state); - - if (stream.eol()) - setArgAlignment(state); - - if (type == "neck") { - state.inBody = true; - state.goalStart = true; - } else if (type == "fullstop") { - state.inBody = false; - state.goalStart = true; - } - - state.lastType = type; - - if (builtins[state.curToken] == "prolog") - return "builtin"; - if (ops[state.curToken]) - return "operator"; - - //if (typeof(parserConfig.enrich) == "function") - // style = parserConfig.enrich(stream, state, type, content, style); - - return style; - - }, - - indent : function(state, textAfter) { - if (state.tokenize == plTokenComment) - return CodeMirror.Pass; - - var nest; - if ((nest = nesting(state))) { - if (nest.closeColumn && !state.commaAtEOL) - return nest.closeColumn; - if ( (textAfter === ']' || textAfter === ')') && nest.control) - return nest.alignment-1; - return nest.alignment; - } - if (!state.inBody) - return 0; - - return conf.indentUnit; - }, - - // theme: "prolog", - - blockCommentStart : "/*", /* continuecomment.js support */ - blockCommentEnd : "*/", - blockCommentContinue : " * ", - lineComment : "%", - fold : "indent" - }; - return external; - -}); - -CodeMirror.defineMIME("text/x-prolog", "prolog"); - -}); diff --git a/packages/python/swig/prolog/yapi.yap b/packages/python/swig/prolog/yapi.yap index 6d9bb6ef8..778c3a962 100644 --- a/packages/python/swig/prolog/yapi.yap +++ b/packages/python/swig/prolog/yapi.yap @@ -83,9 +83,9 @@ python_query( Caller, String, Bindings ) :- Caller.q.port := Status, output(Caller, Bindings). -output( _, Bindings ) :- - write_query_answer( Bindings ), - fail. +%% output( _, Bindings ) :- +%% write_query_answer( Bindings ), +%% fail. output( Caller, Bindings) :- maplist(into_dict(Caller),Bindings). @@ -96,21 +96,3 @@ bv(V,I,I1) :- into_dict(D,V0=T) :- D.q.answer[V0] := T. - -/** - * - */ -ground_dict(_Dict,var([_V]), I, I) :- - !. -ground_dict(_Dict,var([V,V]), I, I) :- - !. -ground_dict(Dict, nonvar([V0|Vs],T),I0, [V0=T| I0]) :- - !, - ground_dict(Dict, var([V0|Vs]),I0, I0). -ground_dict(Dict, var([V0,V1|Vs]), I, I) :- - !, - Dict[V1] := V0, - ground_dict(Dict, var([V0|Vs]), I, I). - - - diff --git a/packages/python/yap_kernel/CMakeLists.txt b/packages/python/yap_kernel/CMakeLists.txt index df7f221fb..adbb63556 100644 --- a/packages/python/yap_kernel/CMakeLists.txt +++ b/packages/python/yap_kernel/CMakeLists.txt @@ -411,8 +411,13 @@ add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/kerne ) add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js - COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/misc/editors/yap.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js - DEPENDS ${CMAKE_SOURCE_DIR}/misc/editors/yap.js + COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/misc/editors/codemirror/prolog.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js + DEPENDS ${CMAKE_SOURCE_DIR}/misc/editors/codemirror/prolog.js + ) + +add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/meta.js + COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/misc/editors/codemirror/meta.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/meta.js + DEPENDS ${CMAKE_SOURCE_DIR}/misc/editors/codemirror/meta.js ) diff --git a/packages/python/yap_kernel/README.md b/packages/python/yap_kernel/README.md index 1878553e9..8ad4a0e06 100644 --- a/packages/python/yap_kernel/README.md +++ b/packages/python/yap_kernel/README.md @@ -25,7 +25,7 @@ output for a aline such as: fs.ensureDirSync('node_modules/codemirror/mode/prolog'); fs.copySync(path.join(path.resolve(jlab.buildDir),'../../../kernels/yap_kernel/prolog.js'), 'node_modules/codemirror/mode/prolog/prolog.js'); fs.copySync(path.join(path.resolve(jlab.buildDir),'../../../kernels/yap_kernel/meta.js'), 'node_modules/codemirror/mode/meta.js'); -~~~~~~~~ +..~~~~~~~~ These lines should copy YAP's prolog.js and a new version of the mode directory, meta.js. whenever you rebuild jlab, eg, if you add a new plugin. Next, please check the lines in context. diff --git a/pl/debug.yap b/pl/debug.yap index 1550a3bb8..467f17730 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -299,11 +299,7 @@ be lost. * @return `call(Goal)` */ '$trace'(Mod:G) :- - '$stop_creeping'(_), - ( prolog_flag(debug, false) ; - '__NB_getval__'('$debug_status',state(zip,_Border,Spy),fail), - ( Spy == ignore ; \+ '$pred_being_spied'(G, Mod) ) - ), + '$trace_is_off'(Mod:G,_GN0), !, '$execute_nonstop'(G,Mod). '$trace'(Mod:G) :- @@ -464,14 +460,7 @@ be lost. %% Actuallb sy debugs a %% goal! '$trace_goal'(G, M, GoalNumber, _H) :- - ( - current_prolog_flag(debug, false) - ; - '__NB_getval__'('$debug_status',state(zip,Border,Spy), fail), - Border < GoalNumber, - ( Spy == ignore ; \+ '$pred_being_spied'(G, M) ) - ), - %writeln(go:G:M), + '$trace_is_off'(M:G,GoalNumber), !, '$execute_nonstop'(G,M). '$trace_goal'(G, M, GoalNumber, H) :- diff --git a/pl/spy.yap b/pl/spy.yap index 08da105f4..0d8d9b7ae 100644 --- a/pl/spy.yap +++ b/pl/spy.yap @@ -391,6 +391,48 @@ notrace(G) :- fail ). +'$disable_debugging_on_port'(retry) :- + !, + '$enable_debugging'. +'$disable_debugging_on_port'(_Port) :- + '$disable_debugging'. + + + +% enable creeping +'$enable_debugging':- + current_prolog_flag(debug, false), !. +'$enable_debugging' :- + nb_setval('$debug_status', state(creep, 0, stop)), + '$trace_on', !, + '$creep'. +'$enable_debugging'. + +'$trace_on' :- + '__NB_getval__'('$debug_status', state(_Creep, GN, Spy), fail), + nb_setval('$debug_status', state(zip, GN, Spy)). + +'$trace_off' :- + '__NB_getval__'('$debug_status', state(_Creep, GN, Spy), fail), + nb_setval('$debug_status', state(zip, GN, Spy)). + +'$trace_is_off'(_,_) :- + current_prolog_flag(debug, false), !. +'$trace_is_off'(Module:G, GN0) :- + '__NB_getval__'('$debug_status',state(zip, GN, Spy), fail), + ( + + '$pred_being_spied'(G,Module) + -> + Spy == ignore + ; + var(GN0) + -> + true + ; + GN > G0 + ). + /* diff --git a/pl/top.yap b/pl/top.yap index 74ee6b29f..d2712e7cc 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -82,6 +82,7 @@ live :- % stop at spy-points if debugging is on. nb_setval('$debug_run',off), nb_setval('$debug_jump',off), + nb_setval('$debug_status', state(zip, 0, stop), fail) '$command'(Command,Varnames,Pos,top), current_prolog_flag(break_level, BreakLevel), ( @@ -590,31 +591,6 @@ write_query_answer( Bindings ) :- '$disable_debugging_on_port'(Port) ). -'$disable_debugging_on_port'(retry) :- - !, - '$enable_debugging'. -'$disable_debugging_on_port'(_Port) :- - '$disable_debugging'. - - - -% enable creeping -'$enable_debugging':- - current_prolog_flag(debug, false), !. -'$enable_debugging' :- - nb_setval('$debug_status', state(false,creep, 0, stop)), - '$trace_on', !, - '$creep'. -'$enable_debugging'. - -'$trace_on' :- - '__NB_getval__'('$debug_status', state(_,Creep, GN, Spy), fail), - nb_setval('$debug_status', state(true,Creep, GN, Spy)). - -'$trace_off' :- - '__NB_getval__'('$debug_status', state(_,Creep, GN, Spy), fail), - nb_setval('$debug_status', state(false,Creep, GN, Spy)). - '$cut_by'(CP) :- '$$cut_by'(CP). % @@ -727,21 +703,21 @@ write_query_answer( Bindings ) :- '$execute0'(G, CurMod). '$loop'(Stream,exo) :- - prolog_flag(agc_margin,Old,0), + prolog_flag(agc_margin,Old,0), prompt1(': '), prompt(_,' '), - '$current_module'(OldModule), - repeat, - '$system_catch'(dbload_from_stream(Stream, OldModule, exo), '$db_load', Error, - user:'$LoopError'(Error, top)), - prolog_flag(agc_margin,_,Old), - !. + '$current_module'(OldModule), + repeat, + '$system_catch'(dbload_from_stream(Stream, OldModule, exo), '$db_load', Error, + user:'$LoopError'(Error, top)), + prolog_flag(agc_margin,_,Old), + !. '$loop'(Stream,db) :- - prolog_flag(agc_margin,Old,0), + prolog_flag(agc_margin,Old,0), prompt1(': '), prompt(_,' '), - '$current_module'(OldModule), - repeat, - '$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error, - prolog_flag(agc_margin,_,Old), + '$current_module'(OldModule), + repeat, + '$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error, + prolog_flag(agc_margin,_,Old), !. '$loop'(Stream,Status) :- repeat, From 25afc1477c1a2240ec43b116244db03544a10d7f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 21 Mar 2019 09:02:43 +0000 Subject: [PATCH 085/101] modules --- os/readterm.c | 8 +++++++- packages/python/swig/prolog/yapi.yap | 2 +- .../python/yap_kernel/yap_ipython/prolog/jupyter.yap | 3 ++- pl/debug.yap | 4 ++-- pl/spy.yap | 2 +- pl/top.yap | 9 +++++---- 6 files changed, 18 insertions(+), 10 deletions(-) diff --git a/os/readterm.c b/os/readterm.c index 11fe6548c..230b838c2 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -1851,9 +1851,15 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool { Term t1 = Deref(ARG1); int l = push_text_stack(); + Term cm = CurrentModule; + if (IsApplTerm(t1)) { + Term tmod = LOCAL_SourceModule; + t1 = Yap_YapStripModule(t1, &tmod); + CurrentModule = tmod; + } const unsigned char *s = Yap_TextToUTF8Buffer(t1 PASS_REGS); Int rc = Yap_UBufferToTerm(s, add_output(ARG2, add_names(ARG3, TermNil))); - + CurrentModule = cm; pop_text_stack(l); return rc; } diff --git a/packages/python/swig/prolog/yapi.yap b/packages/python/swig/prolog/yapi.yap index 778c3a962..eeeb8066a 100644 --- a/packages/python/swig/prolog/yapi.yap +++ b/packages/python/swig/prolog/yapi.yap @@ -28,7 +28,7 @@ :- python_import(json). %:- python_import(gc). -:- meta_predicate( yapi_query(:,+) ). +:- meta_predicate yapi_query(:,+), python_query(+,:), python_query(+,:,-) . %:- start_low_level_trace. diff --git a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap index 7f5686fee..589ed0aa8 100644 --- a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap +++ b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap @@ -37,7 +37,8 @@ u :- python_import(sys). - +:- meta_predicate jupyter_query(+,:,+,-), jupyter_query(+,:,+). + jupyter_query(Caller, Cell, Line, Bindings ) :- gated_call( streams(true), diff --git a/pl/debug.yap b/pl/debug.yap index 467f17730..212d59afe 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -463,7 +463,7 @@ be lost. '$trace_is_off'(M:G,GoalNumber), !, '$execute_nonstop'(G,M). -'$trace_goal'(G, M, GoalNumber, H) :- +'$trace_goal'(G, M, _GoalNumber, _H) :- '$undefined'(G, M), !, '$undefp'([M|G], _ ). @@ -848,7 +848,7 @@ be lost. '$action'(s,P,CallNumber,_,_,_) :- !, % 's skip '$scan_number'(ScanNumber), ( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ), - ( (P=call; P=redo) -> + ( (P==call; P==redo) -> '__NB_setval__'('$debug_status', state(leap, Goal, ignore) ) ; '$ilgl'(s) % ' ). diff --git a/pl/spy.yap b/pl/spy.yap index 0d8d9b7ae..5a1c61dd4 100644 --- a/pl/spy.yap +++ b/pl/spy.yap @@ -430,7 +430,7 @@ notrace(G) :- -> true ; - GN > G0 + GN > GN0 ). diff --git a/pl/top.yap b/pl/top.yap index d2712e7cc..00038fd5a 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -82,7 +82,7 @@ live :- % stop at spy-points if debugging is on. nb_setval('$debug_run',off), nb_setval('$debug_jump',off), - nb_setval('$debug_status', state(zip, 0, stop), fail) + nb_setval('$debug_status', state(zip, 0, stop), fail), '$command'(Command,Varnames,Pos,top), current_prolog_flag(break_level, BreakLevel), ( @@ -715,9 +715,10 @@ write_query_answer( Bindings ) :- prolog_flag(agc_margin,Old,0), prompt1(': '), prompt(_,' '), '$current_module'(OldModule), - repeat, - '$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error, - prolog_flag(agc_margin,_,Old), + repeat, + '$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error, user:'$LoopError'(Error, db) + ), + prolog_flag(agc_margin,_,Old), !. '$loop'(Stream,Status) :- repeat, From 953667db2138e4e2c2a96650471144d76740cd65 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 22 Mar 2019 15:41:14 +0000 Subject: [PATCH 086/101] bddss --- .../problog_examples/learn_graph_lbdd.pl | 14 ++- packages/ProbLog/problog_lbfgs.yap | 52 ++++++--- packages/ProbLog/problog_learning_lbdd.yap | 13 +-- pl/consult.yap | 104 +++++++++--------- pl/top.yap | 2 +- 5 files changed, 96 insertions(+), 89 deletions(-) diff --git a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl index c79718960..5541121f0 100644 --- a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl +++ b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl @@ -17,17 +17,19 @@ :- use_module('../problog_lbfgs'). -%:- set_problog_flag(init_method,(Query,K,Bdd,problog:problog_exact_lbdd(Query,Bdd))). +%% :- if(true). + + :- use_module('kbgraph'). -%:- if(true). -:- use_module('kbgraph'). %%%% % background knowledge %%%% % definition of acyclic path using list of visited nodes -/*:- else. +%:- else. +/* +:- set_problog_flag(init_method,(Query,K,Bdd,problog:problog_exact_lbdd(Query,Bdd))). path(X,Y) :- path(X,Y,[X],_). @@ -46,8 +48,8 @@ edge(X,Y) :- dir_edge(X,Y). absent(_,[]). absent(X,[Y|Z]):-X \= Y, absent(X,Z). -:- endif. -*/ +%:- endif. +*/ %%%% % probabilistic facts % - probability represented by t/1 term means learnable parameter diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index 515a56245..343a134b1 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -238,7 +238,7 @@ :- dynamic(learning_initialized/0). :- dynamic(current_iteration/1). :- dynamic(example_count/1). -%:- dynamic(query_probability_intern/2). +:- dynamic(query_probability_intern/2). %:- dynamic(query_gradient_intern/4). :- dynamic(last_mse/1). :- dynamic(query_is_similar/2). @@ -372,7 +372,7 @@ reset_learning :- retractall(values_correct), retractall(current_iteration(_)), retractall(example_count(_)), -% retractall(query_probability_intern(_,_)),% + retractall(query_probability_intern(_,_)), % retractall(query_gradient_intern(_,_,_,_)), retractall(last_mse(_)), retractall(query_is_similar(_,_)), @@ -610,7 +610,7 @@ init_one_query(QueryID,Query,_Type) :- %= %======================================================================== query_probability(QueryID,Prob) :- - Prob <== qp[QueryID]. + query_probability_intern(QueryID,Prob). %======================================================================== %= @@ -663,7 +663,6 @@ mse_trainingset :- update_values, findall(t(LogCurrentProb,SquaredError), (user:example(QueryID,Query,TrueQueryProb,_Type), -% once(update_query(QueryID,'+',probability)), query_probability(QueryID,CurrentProb), format(Handle,'ex(~q,training,~q,~q,~10f,~10f).~n',[Iteration,QueryID,Query,TrueQueryProb,CurrentProb]), @@ -781,11 +780,22 @@ inv_sigmoid(T,Slope,InvSig) :- %= probabilities of the examples have to be recalculated %======================================================================== +:- dynamic index/2. + save_old_probabilities. +mkindex :- + retractall(index(_,_)), + findall(FactID,tunable_fact(FactID,_GroundTruth),L), + foldl(mkindex, L, 0, Count), + assert(count_tunables(Count)). +mkindex(Key,I,I1) :- + I1 is I+1, + assert(index(Key,I),I1). % vsc: avoid silly search gradient_descent :- +mkindex, problog_flag(sigmoid_slope,Slope), % current_iteration(Iteration), findall(FactID,tunable_fact(FactID,_GroundTruth),L), @@ -798,7 +808,8 @@ gradient_descent :- lbfgs_finalize(Solver). set_fact(FactID, Slope, P ) :- - X <== P[FactID], + index(FactID, I), + X <== P[I], sigmoid(X, Slope, Pr), (Pr > 0.99 -> @@ -824,7 +835,15 @@ set_tunable(I,Slope,P) :- user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :- %Handle = user_error, go( X,Grad, LLs), - sum_list( LLs, LLH_Training_Queries). + sum_list( LLs, LLH_Training_Queries), + writeln(LLH_Training_Queries). + + +update_tunables(X) :- + tunable_fact(FactID,GroundTruth), + set_fact_probability(ID,Prob), + fail. +update_tunables. go( X,Grad, LLs) :- problog_flag(sigmoid_slope,Slope), @@ -832,14 +851,19 @@ go( X,Grad, LLs) :- LL, compute_gradient(Grad, X, Slope,LL), LLs - ). + ), + forall(tunable_fact(FactID,_GroundTruth), + set_fact( FactID, Slope, X) + ). compute_gradient( Grad, X, Slope, LL) :- user:example(QueryID,_Query,QueryProb), recorded(QueryID,BDD,_), query_probability( BDD, Slope, X, BDDProb), - LL is (BDDProb-QueryProb)*(BDDProb-QueryProb), + LL is (BDDProb-QueryProb)*(BDDProb-QueryProb), + retractall( query_probability_intern( QueryID, _) ), + assert( query_probability_intern( QueryID,BDDProb )), forall( query_gradients(BDD,Slope,X,I,GradValue), gradient_pair(BDDProb, QueryProb, Grad, GradValue, Slope, X, I) @@ -848,7 +872,8 @@ compute_gradient( Grad, X, Slope, LL) :- gradient_pair(BDDProb, QueryProb, Grad, GradValue, Slope, X, I) :- G0 <== Grad[I], log2prob(X,Slope,I,Prob), - GN is G0-GradValue*2*Prob*(1-Prob)*(QueryProb-BDDProb), + %writeln(Prob=BDDProb), + GN is G0+GradValue*BDDProb*(1-BDDProb)*2*(QueryProb-BDDProb), Grad[I] <== GN. wrap( X, Grad, GradCount) :- @@ -865,16 +890,13 @@ wrap( _X, _Grad, _GradCount). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % stop calculate gradient %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_Iteration,_Ls,-1) :- +user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,CurrentIteration,_Ls,-1) :- FX < 0, !, format('stopped on bad FX=~4f~n',[FX]). -user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :- +user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N, CurrentIteration,Ls,0) :- + assertz(current_iteration(Iteration)), problog_flag(sigmoid_slope,Slope), forall(tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)), - current_iteration(CurrentIteration), - retractall(current_iteration(_)), - NextIteration is CurrentIteration+1, - assertz(current_iteration(NextIteration)), logger_set_variable(mse_trainingset, FX), save_model, X0 <== X[0], sigmoid(X0,Slope,P0), diff --git a/packages/ProbLog/problog_learning_lbdd.yap b/packages/ProbLog/problog_learning_lbdd.yap index fdf342e5a..a09dc0da1 100644 --- a/packages/ProbLog/problog_learning_lbdd.yap +++ b/packages/ProbLog/problog_learning_lbdd.yap @@ -462,18 +462,7 @@ do_learning_intern(Iterations,Epsilon) :- logger_stop_timer(duration), - logger_write_data, - - - - RemainingIterations is Iterations-1, - - ( - MSE_Diff>Epsilon - -> - do_learning_intern(RemainingIterations,Epsilon); - true - ). + logger_write_data. %======================================================================== diff --git a/pl/consult.yap b/pl/consult.yap index c15b050dc..26ace8454 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -734,7 +734,9 @@ db_files(Fs) :- % format( 'I=~w~n', [Verbosity=UserFile] ), % export to process b_setval('$lf_status', TOpts), - '$reset_if'(OldIfLevel), + '__NB_getval__'('$if_level', OldIfLevel, OldIfLevel=0), + nb_setval('$if_level',0), + writeln(ln(OldIfLevel)), % take care with [a:f], a is the ContextModule '$current_module'(SourceModule, ContextModule), '$lf_opt'(consult, TOpts, Reconsult0), @@ -768,7 +770,6 @@ db_files(Fs) :- true ), '$loop'(Stream,Reconsult), - '$lf_opt'(imports, TOpts, Imports), '$import_to_current_module'(File, ContextModule, Imports, _, TOpts), '$current_module'(Mod, SourceModule), @@ -785,14 +786,14 @@ db_files(Fs) :- ; true ), + writeln(out(OldIfLevel)), + nb_setval('$if_level',OldIfLevel), set_stream( OldStream, alias(loop_stream) ), set_prolog_flag(generate_debug_info, GenerateDebug), '$comp_mode'(_CompMode, OldCompMode), working_directory(_,OldD), % surely, we were in run mode or we would not have included the file! - nb_setval('$if_skip_mode',run), % back to include mode! - nb_setval('$if_level',OldIfLevel), '$lf_opt'('$use_module', TOpts, UseModule), '$bind_module'(Mod, UseModule), '$reexport'( TOpts, ParentF, Reexport, Imports, File ), @@ -812,17 +813,6 @@ db_files(Fs) :- '$qsave_file_'( File, UserF, F ). '$q_do_save_file'(_File, _, _TOpts ). -'$reset_if'(OldIfLevel) :- - '__NB_getval__'('$if_level', OldIfLevel, fail), !, - nb_setval('$if_level',0). -'$reset_if'(0) :- -nb_setval('$if_level',0). - -'$get_if'(Level0) :- - '__NB_getval__'('$if_level', Level, fail), !, - Level0 = Level. -'$get_if'(0). - '$bind_module'(_, load_files). '$bind_module'(Mod, use_module(Mod)). @@ -1561,29 +1551,30 @@ If an error occurs, the error is printed and processing proceeds as if % '$if'(_,top) :- !, fail. '$if'(_Goal,_) :- - '$get_if'(Level0), - Level is Level0 + 1, - nb_setval('$if_level',Level), - ( '__NB_getval__'('$endif', OldEndif, fail) -> true ; OldEndif=top), - ( '__NB_getval__'('$if_skip_mode', Mode, fail) -> true ; Mode = run ), - nb_setval('$endif',elif(Level,OldEndif,Mode)), - fail. + '__NB_getval__'('$if_level',Level0,Level=0), + Level is Level0 + 1, +writeln(Level), + nb_setval('$if_level',Level), + ( '__NB_getval__'('$endif', OldEndif, fail) -> true ; OldEndif=top), + ( '__NB_getval__'('$if_skip_mode', Mode, fail) -> true ; Mode = run ), + nb_setval('$endif',elif(Level,OldEndif,Mode)), + fail. % we are in skip mode, ignore.... '$if'(_Goal,_) :- - '__NB_getval__'('$endif',elif(Level, OldEndif, skip), fail), !, - nb_setval('$endif',endif(Level, OldEndif, skip)). + '__NB_getval__'('$endif',elif(Level, OldEndif, skip), fail), !, + nb_setval('$endif',endif(Level, OldEndif, skip)). % we are in non skip mode, check.... '$if'(Goal,_) :- - ('$if_call'(Goal) - -> - % we will execute this branch, and later enter skip + ( + '$if_call'(Goal) + -> + % we will execute this branch, and later enter skip '__NB_getval__'('$endif', elif(Level,OldEndif,Mode), fail), nb_setval('$endif',endif(Level,OldEndif,Mode)) - ; % we are now in skip, but can start an elif. nb_setval('$if_skip_mode',skip) - ). + ). /** @pred else @@ -1592,18 +1583,19 @@ Start `else' branch. */ '$else'(top) :- !, fail. '$else'(_) :- - '$get_if'(0), !, - '$do_error'(context_error(no_if),(:- else)). + '__NB_getval__'('$if_level',0,true), + !, + '$do_error'(context_error(no_if),(:- else)). % we have done an if, so just skip '$else'(_) :- - nb_getval('$endif',endif(_Level,_,_)), !, - nb_setval('$if_skip_mode',skip). + nb_getval('$endif',endif(_Level,_,_)), !, + nb_setval('$if_skip_mode',skip). % we can try the elif '$else'(_) :- - '$get_if'(Level), - nb_getval('$endif',elif(Level,OldEndif,Mode)), - nb_setval('$endif',endif(Level,OldEndif,Mode)), - nb_setval('$if_skip_mode',run). + '__NB_getval__'('$if_level',Level,Level=0), + nb_getval('$endif',elif(Level,OldEndif,Mode)), + nb_setval('$endif',endif(Level,OldEndif,Mode)), + nb_setval('$if_skip_mode',run). /** @pred elif(+ _Goal_) @@ -1614,24 +1606,25 @@ no test succeeds the else branch is processed. */ '$elif'(_,top) :- !, fail. '$elif'(Goal,_) :- - '$get_if'(0), - '$do_error'(context_error(no_if),(:- elif(Goal))). + '__NB_getval__'('$if_level',0,true), + !, + '$do_error'(context_error(no_if),(:- elif(Goal))). % we have done an if, so just skip '$elif'(_,_) :- - nb_getval('$endif',endif(_,_,_)), !, - nb_setval('$if_skip_mode',skip). + nb_getval('$endif',endif(_,_,_)), !, + nb_setval('$if_skip_mode',skip). % we can try the elif '$elif'(Goal,_) :- - '$get_if'(Level), + '__NB_getval__'('$if_level',Level,fail), '__NB_getval__'('$endif',elif(Level,OldEndif,Mode),fail), ('$if_call'(Goal) -> % we will not skip, and we will not run any more branches. - nb_setval('$endif',endif(Level,OldEndif,Mode)), - nb_setval('$if_skip_mode',run) + nb_setval('$endif',endif(Level,OldEndif,Mode)), + nb_setval('$if_skip_mode',run) ; % we will (keep) on skipping - nb_setval('$if_skip_mode',skip) + nb_setval('$if_skip_mode',skip) ). '$elif'(_,_). @@ -1642,18 +1635,19 @@ End of conditional compilation. '$endif'(top) :- !, fail. '$endif'(_) :- % unmmatched endif. - '$get_if'(0), - '$do_error'(context_error(no_if),(:- endif)). + '__NB_getval__'('$if_level',0,true), + !, + '$do_error'(context_error(no_if),(:- endif)). '$endif'(_) :- % back to where you belong. - '$get_if'(Level), - nb_getval('$endif',Endif), - Level0 is Level-1, - nb_setval('$if_level',Level0), - arg(2,Endif,OldEndif), - arg(3,Endif,OldMode), - nb_setval('$endif',OldEndif), - nb_setval('$if_skip_mode',OldMode). + '__NB_getval__'('$if_level',Level,Level=0), + nb_getval('$endif',Endif), + Level0 is Level-1, + nb_setval('$if_level',Level0), + arg(2,Endif,OldEndif), + arg(3,Endif,OldMode), + nb_setval('$endif',OldEndif), + nb_setval('$if_skip_mode',OldMode). '$if_call'(G) :- diff --git a/pl/top.yap b/pl/top.yap index 00038fd5a..d21fac56d 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -82,7 +82,7 @@ live :- % stop at spy-points if debugging is on. nb_setval('$debug_run',off), nb_setval('$debug_jump',off), - nb_setval('$debug_status', state(zip, 0, stop), fail), + nb_setval('$debug_status', state(zip, 0, stop)), '$command'(Command,Varnames,Pos,top), current_prolog_flag(break_level, BreakLevel), ( From 69fcc9494cd02cb3dd70888b6a60ad75e7851ce1 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 26 Mar 2019 09:40:54 +0000 Subject: [PATCH 087/101] jupyter --- C/adtdefs.c | 2 +- C/stack.c | 32 +------ os/fmem.c | 1 + os/format.c | 1 + packages/python/swig/prolog/yapi.yap | 85 +++++++++++++++++-- packages/python/swig/yap4py/systuples.py | 5 +- .../yap_kernel/yap_ipython/prolog/jupyter.yap | 12 +-- .../yap_kernel/yap_ipython/prolog/verify.yap | 3 +- .../python/yap_kernel/yap_ipython/yapi.py | 34 ++++---- pl/consult.yap | 5 -- pl/errors.yap | 2 +- pl/messages.yap | 6 +- 12 files changed, 115 insertions(+), 73 deletions(-) diff --git a/C/adtdefs.c b/C/adtdefs.c index 064f02421..de7ca09c7 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -1296,7 +1296,7 @@ Atom Yap_LookupAtomWithLength(const char *atom, at = NameOfFunctor(pe->FunctorOfPred); } } - if (mods == PROLOG_MODULE || mods == USER_MODULE) + if (pe->ModuleOfPred == PROLOG_MODULE || pe->ModuleOfPred == USER_MODULE) snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "%s/" UInt_FORMAT, RepAtom(at)->StrOfAE, arity); else diff --git a/C/stack.c b/C/stack.c index 3418c0ef1..62e411d85 100644 --- a/C/stack.c +++ b/C/stack.c @@ -262,7 +262,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p, choiceptr b_ptr = B; CELL *env_ptr = ENV; - if (check_everything && P) { + if (check_everything && P && ENV) { PredEntry *pe = EnvPreg(P); if (p == pe) return true; @@ -284,7 +284,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p, PredEntry *pe; if (!cp) - return true; + return false; pe = EnvPreg(cp); if (p == pe) return true; @@ -296,38 +296,12 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p, } } /* now mark the choicepoint */ - if (b_ptr) { pe = PredForChoicePt(b_ptr->cp_ap, NULL); } else return false; if (pe == p) { - if (check_everything) - return true; - PELOCK(38, p); - if (p->PredFlags & IndexedPredFlag) { - yamop *code_p = b_ptr->cp_ap; - yamop *code_beg = p->cs.p_code.TrueCodeOfPred; - - /* FIX ME */ - - if (p->PredFlags & LogUpdatePredFlag) { - LogUpdIndex *cl = ClauseCodeToLogUpdIndex(code_beg); - if (find_owner_log_index(cl, code_p)) - b_ptr->cp_ap = cur_log_upd_clause(pe, b_ptr->cp_ap->y_u.Otapl.d); - } else if (p->PredFlags & MegaClausePredFlag) { - StaticIndex *cl = ClauseCodeToStaticIndex(code_beg); - if (find_owner_static_index(cl, code_p)) - b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->y_u.Otapl.d); - } else { - /* static clause */ - StaticIndex *cl = ClauseCodeToStaticIndex(code_beg); - if (find_owner_static_index(cl, code_p)) { - b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->y_u.Otapl.d); - } - } - } - UNLOCKPE(63, pe); + return true; } env_ptr = b_ptr->cp_env; b_ptr = b_ptr->cp_b; diff --git a/os/fmem.c b/os/fmem.c index b50763a5d..56707cbef 100755 --- a/os/fmem.c +++ b/os/fmem.c @@ -331,6 +331,7 @@ bool Yap_CloseMemoryStream(int sno) { if (GLOBAL_Stream[sno].status & FreeOnClose_Stream_f) free(GLOBAL_Stream[sno].nbuf); } + GLOBAL_Stream[sno].status = Free_Stream_f; return true; } diff --git a/os/format.c b/os/format.c index 7e03ee227..0428b13ce 100644 --- a/os/format.c +++ b/os/format.c @@ -990,6 +990,7 @@ static Int doformat(volatile Term otail, volatile Term oargs, Term ta[2]; ta[0] = otail; ta[1] = oargs; + format_clean_up(sno, sno0, finfo); Yap_ThrowError(LOCAL_Error_TYPE, Yap_MkApplTerm(Yap_MkFunctor(AtomFormat, 2), 2, ta), "arguments to format"); diff --git a/packages/python/swig/prolog/yapi.yap b/packages/python/swig/prolog/yapi.yap index eeeb8066a..bc287d938 100644 --- a/packages/python/swig/prolog/yapi.yap +++ b/packages/python/swig/prolog/yapi.yap @@ -37,9 +37,9 @@ %% dictionary, Examples %% %% -yapi_query( VarNames, Self ) :- +yapi_query( VarNames, Caller ) :- show_answer(VarNames, Dict), - Self.bindings := Dict. + Caller.bindings := Dict. @@ -74,12 +74,9 @@ argi(N,I,I1) :- python_query( Caller, String ) :- python_query( Caller, String, _Bindings). -user:user_python_query( Caller, String, Bindings ) :- - python_query( Caller, String, _Bindings). - python_query( Caller, String, Bindings ) :- atomic_to_term( String, Goal, VarNames ), - query_to_answer( Goal, VarNames, Status, Bindings), + query_to_answer( user:Goal, VarNames, Status, Bindings), Caller.q.port := Status, output(Caller, Bindings). @@ -87,12 +84,84 @@ python_query( Caller, String, Bindings ) :- %% write_query_answer( Bindings ), %% fail. output( Caller, Bindings) :- - maplist(into_dict(Caller),Bindings). + copy_term( Bindings, Bs), + simplify(Bs, 1, Bss), + numbervars(Bss, 0, _), + maplist(into_dict(Caller),Bss). + +simplify([],_,[]). +simplify([X=V|Xs], [X=V|NXs]) :- + var(V), + !, + X=V, + simplify(Xs,NXs). +simplify([X=V|Xs], I, NXs) :- + var(V), + !, + X=V, + simplify(Xs,I,NXs). +simplify([X=V|Xs], I, [X=V|NXs]) :- + !, + simplify(Xs,I,NXs). +simplify([G|Xs],I, [D=G|NXs]) :- + I1 is I+1, + atomic_concat(['__delay_',I,'__'],D), + simplify(Xs,I1,NXs). + bv(V,I,I1) :- atomic_concat(['__',I],V), I1 is I+1. into_dict(D,V0=T) :- - D.q.answer[V0] := T. + listify(T,L), + D.q.answer[V0] := L. + +listify('$VAR'(Bnd), V) :- + !, + listify_var(Bnd, V). +listify([A|As], V) :- + !, + maplist(listify,[A|As], V). +listify(A:As, A:Vs) :- + (atom(A);string(A)), + !, + maplist(listify,As, Vs). +listify(WellKnown, V) :- + WellKnown=..[N|As], + length(As,Sz), + well_known(N,Sz), + !, + maplist(listify,As, Vs), + V =.. [N|Vs]. + +listify('$VAR'(Bnd), V) :- + !, + listify_var(Bnd, V). +listify(T, t(S,V)) :- + T =.. [S,A|As], + !, + maplist(listify, [A|As], Vs), + V =.. [t|Vs]. +listify(S, S). + +listify_var(I, S) :- + I >= 0, + I =< 26, + !, + V is 0'A+I, + string_codes(S, [V]). +listify_var(I, S) :- + I < 0, + I >= -26, + !, + V is 0'A+I, + string_codes(S, [0'_+V]). +listify_var(S, S). + +well_known(+,2). +well_known(-,2). +well_known(*,2). +well_known(/,2). +well_known((','),2). diff --git a/packages/python/swig/yap4py/systuples.py b/packages/python/swig/yap4py/systuples.py index 4db75a74b..6676d2c11 100644 --- a/packages/python/swig/yap4py/systuples.py +++ b/packages/python/swig/yap4py/systuples.py @@ -4,7 +4,7 @@ asserta = namedtuple('asserta', 'clause') assertz = namedtuple('assertz', 'clause') bindvars = namedtuple('bindvars', 'list') compile = namedtuple('compile', 'file') -compdletionsile = namedtuple('completions', 'text self') +completions = namedtuple('completions', 'text self') dbms = namedtuple('dbms', 'filedbms') errors = namedtuple('errors', 'fileng engee') foreign = namedtuple('foreign', 'filedbms') @@ -15,10 +15,13 @@ ostreams = namedtuple('ostreams', ' text') prolog_library=namedtuple('prolog_library', 'listfiles') python_query = namedtuple('python_query', 'engine query') set_prolog_flag = namedtuple('set_prolog_flag', 'flag new_value') +current_prolog_flag = namedtuple('current_prolog_flag', 'flag value') show_answer = namedtuple('show_answer', 'vars dict') streams = namedtuple('streams', 'text') v = namedtuple('_', 'slot') v0 = namedtuple('v', 'slot') +yap_flag = namedtuple('yap_flag', 'flag value new_value') +show_answer = namedtuple('show_answer', 'vars dict') yap_query = namedtuple('yap_query', 'query owner') yapi_query = namedtuple('yapi_query', 'vars dict') diff --git a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap index 589ed0aa8..04e68ff6d 100644 --- a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap +++ b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap @@ -1,4 +1,4 @@ -u + /** * @file jupyter.yap * @@ -57,7 +57,6 @@ next_streams( _Caller, answer, _Bindings ) :- % Caller.answer := Bindings, !. next_streams(_, redo, _ ) :- - streams(true), !. next_streams( _, _, _ ) :- streams(false). @@ -74,7 +73,7 @@ jupyter_cell( _Caller, _, Line , _) :- jupyter_cell(Caller, _, Line, Bindings ) :- Query = Caller, catch( - user:user_python_query(Query,Line, Bindings), + python_query(Query,Line, Bindings), error(A,B), system_error(A,B) ). @@ -103,11 +102,12 @@ jupyter_consult(Cell) :- ( Options = [], open_mem_read_stream( Cell, Stream), - load_files(Stream,[stream(Stream)| Options]) + load_files(user:Stream,[stream(Stream)| Options]) ), error(A,B), - (close(Stream), system_error(A,B)) + (close(Stream), system_error(A,B)) ), + close(Stream), fail. jupyter_consult(_Cell). @@ -124,7 +124,7 @@ blank(Text) :- streams(false) :- - close(user_input), + close(user_input), close(user_output), close(user_error). streams( true) :- diff --git a/packages/python/yap_kernel/yap_ipython/prolog/verify.yap b/packages/python/yap_kernel/yap_ipython/prolog/verify.yap index 164d236bf..315004fab 100644 --- a/packages/python/yap_kernel/yap_ipython/prolog/verify.yap +++ b/packages/python/yap_kernel/yap_ipython/prolog/verify.yap @@ -72,7 +72,8 @@ jupyter(En), close_esh( _Engine , Stream ) :- retractall(jupyter(_)), assertz(jupyter([])), - close(Stream). + close(Stream), + python_clear_errors. diff --git a/packages/python/yap_kernel/yap_ipython/yapi.py b/packages/python/yap_kernel/yap_ipython/yapi.py index fbf2f82e1..715b66045 100644 --- a/packages/python/yap_kernel/yap_ipython/yapi.py +++ b/packages/python/yap_kernel/yap_ipython/yapi.py @@ -560,7 +560,7 @@ class YAPRun(InteractiveShell): self.iterations = 0 pg = jupyter_query(self,program,squery) self.q = Query(self.engine, pg) - while self.q.next(): + for v in self.q: self.iterations += 1 o = '[ ' o += str(self.iterations ) @@ -704,39 +704,39 @@ class YAPRun(InteractiveShell): self.shell.displayhook.exec_result = result if self.syntaxErrors(cell): result.result = [] - return + return result has_raised = False try: + if not cell.strip('\n \t'): + return result builtin_mod.input = input self.shell.input = input self.engine.mgoal(streams(True),"user", True) - if cell.strip('\n \t'): - #create a Trace object, telling it what to ignore, and whether to - # do tracing or line-counting or both. - # tracer = trace.Trace( - # ignoredirs=[sys.prefix, sys.exec_prefix], - # trace=1, - # count=0) - # + #create a Trace object, telling it what to ignore, and whether to + # do tracing or line-counting or both. + # tracer = trace.Trace( + # ignoredirs=[sys.prefix, sys.exec_prefix], + # trace=1, + # count=0) + # - # def f(self, cell, state): - # state = self.jupyter_query( cell ) + # def f(self, cell, state): + # state = self.jupyter_query( cell ) # run the new command using the given tracer # # tracer.runfunc(f,self,cell,state) - answers = self.prolog( cell, result ) - # state = tracer.runfunc(hist - # er_query( self, cell ) ) - self.shell.last_execution_succeeded = True + answers = self.prolog( cell, result ) + # state = tracer.runfunc(hist + # er_query( self, cell ) ) except Exception as e: has_raised = True try: (etype, value, tb) = e traceback.print_exception(etype, value, tb) + self.engine.mgoal(streams(False),"user", True) except: print(e) - pass self.shell.last_execution_succeeded = not has_raised diff --git a/pl/consult.yap b/pl/consult.yap index 26ace8454..c799a4e2c 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -348,8 +348,6 @@ load_files(Files0,Opts) :- ; true ), - % make sure we can run consult - '$init_consult', '$lf'(Files, M, Call, TOpts). '$check_files'(Files, Call) :- @@ -736,7 +734,6 @@ db_files(Fs) :- b_setval('$lf_status', TOpts), '__NB_getval__'('$if_level', OldIfLevel, OldIfLevel=0), nb_setval('$if_level',0), - writeln(ln(OldIfLevel)), % take care with [a:f], a is the ContextModule '$current_module'(SourceModule, ContextModule), '$lf_opt'(consult, TOpts, Reconsult0), @@ -786,7 +783,6 @@ db_files(Fs) :- ; true ), - writeln(out(OldIfLevel)), nb_setval('$if_level',OldIfLevel), set_stream( OldStream, alias(loop_stream) ), set_prolog_flag(generate_debug_info, GenerateDebug), @@ -1553,7 +1549,6 @@ If an error occurs, the error is printed and processing proceeds as if '$if'(_Goal,_) :- '__NB_getval__'('$if_level',Level0,Level=0), Level is Level0 + 1, -writeln(Level), nb_setval('$if_level',Level), ( '__NB_getval__'('$endif', OldEndif, fail) -> true ; OldEndif=top), ( '__NB_getval__'('$if_skip_mode', Mode, fail) -> true ; Mode = run ), diff --git a/pl/errors.yap b/pl/errors.yap index abb4fb9ea..f4000aef9 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -94,7 +94,7 @@ error_handler(Error, Level) :- '$LoopError'(Error, Level). '$LoopError'(_, _) :- - %stop_low_level_trace, + stop_low_level_trace, flush_output(user_output), flush_output(user_error), fail. diff --git a/pl/messages.yap b/pl/messages.yap index 3cae1b7d9..08ffcc55c 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -206,6 +206,7 @@ compose_message(error(E, Exc), Level) --> { '$show_consult_level'(LC) }, + print_exception(Exc), location(error(E, Exc), Level, LC), main_message(error(E,Exc) , Level, LC ), c_goal( error(E, Exc), Level ), @@ -282,10 +283,8 @@ location( error(_,Info), Level, LC ) --> query_exception(prologPredArity, Desc, Ar) }, !, - display_consulting( File, Level, Info, LC ), {simplify_pred(M:Na/Ar,FF)}, [ '~a:~d:0 ~a while executing ~q:'-[File, FilePos,Level,FF] ]. - location( error(_,Info), Level, LC ) --> { '$error_descriptor'(Info, Desc) }, { @@ -294,7 +293,6 @@ location( error(_,Info), Level, LC ) --> query_exception(errorFunction, Desc, F) }, !, - display_consulting( File, Level, Info, LC ), {simplify_pred(F,FF)}, [ '~a:~d:0 ~a while executing ~a().'-[File, FilePos,Level,FF] ]. location( _Ball, _Level, _LC ) --> []. @@ -351,7 +349,7 @@ main_error_message(evaluation_error(What, Who)) --> [ '~*|** ~w caused ~a during evaluation of arithmetic expressions **' - [ 10,Who,What], nl ]. main_error_message(existence_error(Type , Who)) --> [nl], - [ '~*|** ~q ~q could not be found **' - [ 10,Type, Who], nl ]. + [ '~*|** ~q ~q does not exist **' - [ 10,Type, Who], nl ]. main_error_message(permission_error(Op, Type, Id)) --> [ '~*|** value ~q is not allowed in ~a ~q **' - [ 10, Op, Type,Id], nl ]. main_error_message(instantiation_error) --> From c0f7dfe3c39b1f1f4acd90b8a4e003aad07da0e2 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 26 Mar 2019 15:34:42 +0000 Subject: [PATCH 088/101] jupyter --- .../python/yap_kernel/yap_ipython/yapi.py | 122 ++++++++++-------- 1 file changed, 68 insertions(+), 54 deletions(-) diff --git a/packages/python/yap_kernel/yap_ipython/yapi.py b/packages/python/yap_kernel/yap_ipython/yapi.py index 715b66045..3b86834a9 100644 --- a/packages/python/yap_kernel/yap_ipython/yapi.py +++ b/packages/python/yap_kernel/yap_ipython/yapi.py @@ -8,9 +8,6 @@ from yap4py.systuples import * from yap4py.yapi import * from IPython.core.completer import Completer # import IPython.core -from traitlets import Instance -from IPython.core import interactiveshell -from IPython.core.displayhook import DisplayHook from IPython.core.inputsplitter import * from IPython.core.inputtransformer import * from IPython.core.interactiveshell import * @@ -536,18 +533,17 @@ class YAPRun(InteractiveShell): if text == self.os: return self.errors self.errors=[] - (text,_,_,_) = self.clean_end(text) self.engine.mgoal(errors(self,text),"user",True) return self.errors - def prolog(self, s, result): + def prolog(self, ccell, result): # # construct a self.query from a one-line string # self.q is opaque to Python try: - program,squery,_ ,howmany = self.prolog_cell(s) # sys.settrace(tracefunc) + (program, squery, _, howmany) = ccell if self.q and self.os == (program,squery): howmany += self.iterations else: @@ -557,7 +553,6 @@ class YAPRun(InteractiveShell): self.answers = [] result.result = [] self.os = (program,squery) - self.iterations = 0 pg = jupyter_query(self,program,squery) self.q = Query(self.engine, pg) for v in self.q: @@ -702,13 +697,15 @@ class YAPRun(InteractiveShell): # Give the displayhook a reference to our ExecutionResult so it # can fill in the output value. self.shell.displayhook.exec_result = result - if self.syntaxErrors(cell): + ccell = self.prolog_cell(cell) + (program,squery,_ ,howmany) = ccell + if howmany == 0 and not program: + return result + if self.syntaxErrors(program+squery+".\n") : result.result = [] return result has_raised = False try: - if not cell.strip('\n \t'): - return result builtin_mod.input = input self.shell.input = input self.engine.mgoal(streams(True),"user", True) @@ -726,7 +723,7 @@ class YAPRun(InteractiveShell): # run the new command using the given tracer # # tracer.runfunc(f,self,cell,state) - answers = self.prolog( cell, result ) + answers = self.prolog( ccell, result ) # state = tracer.runfunc(hist # er_query( self, cell ) ) except Exception as e: @@ -734,7 +731,6 @@ class YAPRun(InteractiveShell): try: (etype, value, tb) = e traceback.print_exception(etype, value, tb) - self.engine.mgoal(streams(False),"user", True) except: print(e) @@ -757,40 +753,9 @@ class YAPRun(InteractiveShell): self.engine.mgoal(streams(False),"user", True) return - def clean_end(self,s): - """ - Look at the query suffix and return - - whatever is left - - how much was taken - - whether to stop - - when to stop - """ - l0 = len(s) - i = s.rfind(";") - if i < 0: - its = 1 - stop = True - taken = 0 - else: - taken = l0-(i-1) - n = s[i+1:].strip() - s = s[:i] - if n: - its = 0 - for ch in n: - if not ch.isdigit(): - raise SyntaxError("expected positive number", (self.cellname,s.strip.lines()+1,s.count('\n'),n)) - its = its*10+ (ord(ch) - ord('0')) - stop = False - else: - stop = False - its = -1 - # one solution, stop - return s, taken, stop, its - - def prolog_cell(self,s): + def prolog_cell(self, s): """ Trasform a text into program+query. A query is the last line if the last line is non-empty and does not terminate @@ -803,14 +768,63 @@ class YAPRun(InteractiveShell): is a comment. """ try: - s0 = s.rstrip(' \n\t\i') - [program,x,query] = s0.rpartition('\n') - if query[-1] == '.': - return s,'',False,0 - (query, _,loop, sols) = self.clean_end(query) - return (program, query, loop, sols) - except: - return (s,'',true,1) + sl = s.splitlines() + l = len(sl) + i = 0 + while i Date: Tue, 26 Mar 2019 23:53:47 +0000 Subject: [PATCH 089/101] jupyter --- packages/python/pyio.c | 2 +- .../python/yap_kernel/yap_ipython/yapi.py | 48 +++++++++---------- 2 files changed, 23 insertions(+), 27 deletions(-) diff --git a/packages/python/pyio.c b/packages/python/pyio.c index e0a7813ce..e5f288fe0 100644 --- a/packages/python/pyio.c +++ b/packages/python/pyio.c @@ -171,7 +171,7 @@ static bool pygetLine(StreamDesc *rl_iostream, int sno) { PyObject_GetAttrString(s->u.private_data, "readline"); if (!readl) { readl = - PyObject_GetAttrString(s->u.private_data, "read"); + PyObject_GetAttrString(s->u.private_data, "input"); } if (readl) user_line = PyObject_CallFunctionObjArgs(readl, diff --git a/packages/python/yap_kernel/yap_ipython/yapi.py b/packages/python/yap_kernel/yap_ipython/yapi.py index 3b86834a9..491d54111 100644 --- a/packages/python/yap_kernel/yap_ipython/yapi.py +++ b/packages/python/yap_kernel/yap_ipython/yapi.py @@ -13,7 +13,6 @@ from IPython.core.inputtransformer import * from IPython.core.interactiveshell import * from ipython_genutils.py3compat import builtin_mod -import copy import json from yap_kernel.displayhook import ZMQShellDisplayHook @@ -536,14 +535,13 @@ class YAPRun(InteractiveShell): self.engine.mgoal(errors(self,text),"user",True) return self.errors - def prolog(self, ccell, result): + def prolog(self, program, squery, howmany, result): # # construct a self.query from a one-line string # self.q is opaque to Python try: # sys.settrace(tracefunc) - (program, squery, _, howmany) = ccell if self.q and self.os == (program,squery): howmany += self.iterations else: @@ -553,6 +551,7 @@ class YAPRun(InteractiveShell): self.answers = [] result.result = [] self.os = (program,squery) + self.iterations = 0 pg = jupyter_query(self,program,squery) self.q = Query(self.engine, pg) for v in self.q: @@ -671,7 +670,6 @@ class YAPRun(InteractiveShell): except: magic = cell[2:].strip() body = "" - linec = False try: [magic,line] = magic.split(maxsplit=1) except: @@ -680,7 +678,6 @@ class YAPRun(InteractiveShell): result.result = self.shell.run_cell_magic(magic, line, body) return else: - linec = True rcell = cell[1:].strip() try: [magic,cell] = rcell.split(maxsplit = 1, sep = '\n') @@ -697,9 +694,9 @@ class YAPRun(InteractiveShell): # Give the displayhook a reference to our ExecutionResult so it # can fill in the output value. self.shell.displayhook.exec_result = result - ccell = self.prolog_cell(cell) - (program,squery,_ ,howmany) = ccell - if howmany == 0 and not program: + (program,squery,_ ,howmany) = self.prolog_cell(cell) + print(program, squery, howmany) + if howmany <= 0 and not program: return result if self.syntaxErrors(program+squery+".\n") : result.result = [] @@ -723,7 +720,7 @@ class YAPRun(InteractiveShell): # run the new command using the given tracer # # tracer.runfunc(f,self,cell,state) - answers = self.prolog( ccell, result ) + answers = self.prolog( program, squery, howmany, result ) # state = tracer.runfunc(hist # er_query( self, cell ) ) except Exception as e: @@ -731,6 +728,7 @@ class YAPRun(InteractiveShell): try: (etype, value, tb) = e traceback.print_exception(etype, value, tb) + self.engine.mgoal(streams(False),"user", True) except: print(e) @@ -781,6 +779,7 @@ class YAPRun(InteractiveShell): if line[-1] == '.': return (s,'','.',0) query = '' + loop = '' while i Date: Wed, 27 Mar 2019 11:01:55 +0000 Subject: [PATCH 090/101] jupyter --- .../python/yap_kernel/yap_ipython/yapi.py | 138 +++++++++--------- 1 file changed, 69 insertions(+), 69 deletions(-) diff --git a/packages/python/yap_kernel/yap_ipython/yapi.py b/packages/python/yap_kernel/yap_ipython/yapi.py index 3b86834a9..56c286a16 100644 --- a/packages/python/yap_kernel/yap_ipython/yapi.py +++ b/packages/python/yap_kernel/yap_ipython/yapi.py @@ -661,7 +661,7 @@ class YAPRun(InteractiveShell): self.cell_name = str( self.shell.execution_count) self.shell.displayhook.exec_result= result cell = raw_cell.strip() - while cell[0] == '%': + while cell and cell[0] == '%': if cell[1] == '%': ## cell magic txt0 = cell[2:].split(maxsplit = 1, sep = '\n') @@ -756,75 +756,75 @@ class YAPRun(InteractiveShell): def prolog_cell(self, s): - """ - Trasform a text into program+query. A query is the - last line if the last line is non-empty and does not terminate - on a dot. You can also finish with + return pcell(s) - - `*`: you request all solutions - - ';'[N]: you want an answer; optionally you want N answers - If the line terminates on a `*/` or starts on a `%` we assume the line - is a comment. - """ - try: - sl = s.splitlines() - l = len(sl) - i = 0 - while i Date: Wed, 27 Mar 2019 16:31:31 +0000 Subject: [PATCH 091/101] jupyter --- packages/python/swig/prolog/yapi.yap | 20 +-- .../yap_kernel/yap_ipython/prolog/jupyter.yap | 48 +++---- .../python/yap_kernel/yap_ipython/yapi.py | 136 +++++++++--------- 3 files changed, 99 insertions(+), 105 deletions(-) diff --git a/packages/python/swig/prolog/yapi.yap b/packages/python/swig/prolog/yapi.yap index bc287d938..a4d06b556 100644 --- a/packages/python/swig/prolog/yapi.yap +++ b/packages/python/swig/prolog/yapi.yap @@ -3,16 +3,16 @@ %% @brief support yap shell %% - :- module(yapi, [ - python_ouput/0, - show_answer/2, - show_answer/3, - yap_query/4, - python_query/2, - python_query/3, - python_import/1, - yapi_query/2 - ]). + %% :- module(yapi, [ + %% python_ouput/0, + %% show_answer/2, + %% show_answer/3, + %% yap_query/4, + %% python_query/2, + %% python_query/3, + %% python_import/1, + %% yapi_query/2 + %% ]). %:- yap_flag(verbose, silent). diff --git a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap index 04e68ff6d..f319253d3 100644 --- a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap +++ b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap @@ -6,22 +6,22 @@ */ %:- yap_flag(gc_trace,verbose). - :- module( jupyter, - [jupyter_query/3, - jupyter_query/4, - op(100,fy,('$')), - op(950,fy,:=), - op(950,yfx,:=), -% op(950,fx,<-), -% op(950,yfx,<-), - op(50, yf, []), - op(50, yf, '()'), - op(100, xfy, '.'), - op(100, fy, '.'), - blank/1, - streams/1 - ] - ). +%% :- module( jupyter, +%% [jupyter_query/3, +%% jupyter_query/4, +%% op(100,fy,('$')), +%% op(950,fy,:=), +%% op(950,yfx,:=), +%% % op(950,fx,<-), +%% % op(950,yfx,<-), +%% op(50, yf, []), +%% op(50, yf, '()'), +%% op(100, xfy, '.'), +%% op(100, fy, '.'), +%% blank/1, +%% streams/1 +%% ] +%% ). :- use_module(library(hacks)). @@ -37,15 +37,10 @@ :- python_import(sys). -:- meta_predicate jupyter_query(+,:,+,-), jupyter_query(+,:,+). +%:- meta_predicate jupyter_query(+,:,+,-), jupyter_query(+,:,+). jupyter_query(Caller, Cell, Line, Bindings ) :- - gated_call( - streams(true), - jupyter_cell(Caller, Cell, Line, Bindings), - Port, - next_streams( Caller, Port, Bindings ) - ). + jupyter_cell(Caller, Cell, Line, Bindings). jupyter_query(Caller, Cell, Line ) :- jupyter_query( Caller, Cell, Line, _Bindings ). @@ -58,8 +53,8 @@ next_streams( _Caller, answer, _Bindings ) :- !. next_streams(_, redo, _ ) :- !. -next_streams( _, _, _ ) :- - streams(false). +next_streams( _, _, _ ). % :- + % streams(false). @@ -105,9 +100,8 @@ jupyter_consult(Cell) :- load_files(user:Stream,[stream(Stream)| Options]) ), error(A,B), - (close(Stream), system_error(A,B)) + system_error(A,B) ), - close(Stream), fail. jupyter_consult(_Cell). diff --git a/packages/python/yap_kernel/yap_ipython/yapi.py b/packages/python/yap_kernel/yap_ipython/yapi.py index 882e3723c..2be1ba7ff 100644 --- a/packages/python/yap_kernel/yap_ipython/yapi.py +++ b/packages/python/yap_kernel/yap_ipython/yapi.py @@ -614,6 +614,13 @@ class YAPRun(InteractiveShell): `result : :class:`ExecutionResult` """ + if store_history: + # Write output to the database. Does nothing unless + # history output logging is enabled. + self.shell.history_manager.store_output(self.shell.execution_count) + # Each cell is a *single* input, regardless of how many lines it has + self.shell.execution_count += 1 + # construct a query from a one-line string # q is opaque to Python # vs is the list of variables @@ -649,8 +656,6 @@ class YAPRun(InteractiveShell): # # Display the exception if input processing failed. if preprocessing_exc_tuple is not None: self.showtraceback(preprocessing_exc_tuple) - if store_history: - self.shell.execution_count += 1 return self.error_before_exec(preprocessing_exc_tuple[2]) # Our own compiler remembers the __future__ environment. If we want to @@ -695,7 +700,7 @@ class YAPRun(InteractiveShell): # can fill in the output value. self.shell.displayhook.exec_result = result (program,squery,_ ,howmany) = self.prolog_cell(cell) - print(program, squery, howmany) + print("program",program, "q", squery, "h",howmany) if howmany <= 0 and not program: return result if self.syntaxErrors(program+squery+".\n") : @@ -741,13 +746,6 @@ class YAPRun(InteractiveShell): if not silent: self.shell.events.trigger('post_run_cell') - if store_history: - # Write output to the database. Does nothing unless - # history output logging is enabled. - self.shell.history_manager.store_output(self.shell.execution_count) - # Each cell is a *single* input, regardless of how many lines it has - self.shell.execution_count += 1 - self.engine.mgoal(streams(False),"user", True) return @@ -758,8 +756,8 @@ class YAPRun(InteractiveShell): def pcell(s): - """ - Trasform a text into program+query. A query is the + """ + Trasform a text into program+query. A query is the last line if the last line is non-empty and does not terminate on a dot. You can also finish with @@ -768,64 +766,66 @@ def pcell(s): If the line terminates on a `*/` or starts on a `%` we assume the line is a comment. - """ - try: - sl = s.splitlines() - l = len(sl) - i = 0 - while i Date: Thu, 28 Mar 2019 14:06:16 +0000 Subject: [PATCH 092/101] errors --- os/streams.c | 21 +++++++++ .../python/yap_kernel/yap_ipython/yapi.py | 1 - pl/debug.yap | 44 ++++++++++++------- pl/errors.yap | 1 - pl/messages.yap | 5 +-- pl/spy.yap | 19 ++++---- pl/top.yap | 38 ++++++++-------- 7 files changed, 81 insertions(+), 48 deletions(-) diff --git a/os/streams.c b/os/streams.c index 1173e66c6..051d9d7c1 100644 --- a/os/streams.c +++ b/os/streams.c @@ -93,6 +93,9 @@ static char SccsId[] = "%W% %G%"; #endif #endif #include "iopreds.h" +#if HAVE_EXECINFO_H +#include +#endif #if _MSC_VER || defined(__MINGW32__) #define SYSTEM_STAT _stat @@ -128,6 +131,7 @@ FILE *Yap_GetOutputStream(Term t, const char *msg) { return rc; } +cmax =7; int GetFreeStreamD(void) { CACHE_REGS LOCK(GLOBAL_StreamDescLock); @@ -137,6 +141,23 @@ int GetFreeStreamD(void) { break; } } +#if HAVE_BACKTRACEX + void *callstack[256]; + int i; + if (sno > cmax) { + cmax++; + for (i=7; i< sno; i++) + fprintf(stderr," %d %x\n", i,GLOBAL_Stream[i].status); + } + fprintf(stderr, "++++ got %d\n", sno); + int frames = backtrace(callstack, 256); + char **strs = backtrace_symbols(callstack, frames); + fprintf(stderr, "Execution stack:\n"); + for (i = 0; i < 5; ++i) { + fprintf(stderr, " %s\n", strs[i]); + } + free(strs); +#endif if (sno == MaxStreams) { UNLOCK(GLOBAL_StreamDescLock); return -1; diff --git a/packages/python/yap_kernel/yap_ipython/yapi.py b/packages/python/yap_kernel/yap_ipython/yapi.py index 2be1ba7ff..e83ee0fa6 100644 --- a/packages/python/yap_kernel/yap_ipython/yapi.py +++ b/packages/python/yap_kernel/yap_ipython/yapi.py @@ -700,7 +700,6 @@ class YAPRun(InteractiveShell): # can fill in the output value. self.shell.displayhook.exec_result = result (program,squery,_ ,howmany) = self.prolog_cell(cell) - print("program",program, "q", squery, "h",howmany) if howmany <= 0 and not program: return result if self.syntaxErrors(program+squery+".\n") : diff --git a/pl/debug.yap b/pl/debug.yap index 212d59afe..4e40fdeee 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -299,7 +299,7 @@ be lost. * @return `call(Goal)` */ '$trace'(Mod:G) :- - '$trace_is_off'(Mod:G,_GN0), + '$creep_is_off'(Mod:G,_GN0), !, '$execute_nonstop'(G,Mod). '$trace'(Mod:G) :- @@ -460,7 +460,7 @@ be lost. %% Actuallb sy debugs a %% goal! '$trace_goal'(G, M, GoalNumber, _H) :- - '$trace_is_off'(M:G,GoalNumber), + '$creep_is_off'(M:G,GoalNumber), !, '$execute_nonstop'(G,M). '$trace_goal'(G, M, _GoalNumber, _H) :- @@ -556,7 +556,7 @@ be lost. */ '$debug'(_, G, M, _H) :- - '__NB_getval__'('$debug_status',state(zip,_Border,Spy), fail), + '__NB_getval__'('$debug_status',state(zip,_Border,Spy,_Trace), fail), ( Spy == stop -> \+ '$pred_being_spied'(G,M) ; true ), !, '$execute_nonstop'( G, M ). @@ -608,10 +608,10 @@ be lost. '$trace_port'(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :- '$stop_creeping'(_) , current_prolog_flag(debug, true), - '__NB_getval__'('$debug_status',state(Skip,Border,_), fail), + '__NB_getval__'('$debug_status',state(Skip,Border,_,Trace), fail), ( Skip == creep -> true; '$id_goal'(GoalNumber), GoalNumber =< Border), !, - '__NB_setval__'('$debug_status', state(creep, 0, stop)), + '__NB_setval__'('$debug_status', state(creep, 0, stop,Trace)), '$trace_port_'(Port, GoalNumber, G, Module, Info). '$trace_port'(_Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info). @@ -697,7 +697,7 @@ be lost. Goal. '$port'(_P, _G, _M,GoalNumber,_Determinic, _Info ) :- %%> leap - '__NB_getval__'('$debug_status',state(leap,Border,_), fail), + '__NB_getval__'('$debug_status',state(leap,Border,_,_), fail), GoalNumber > Border, !. '$port'(P,G,Module,L,Deterministic, Info) :- @@ -752,7 +752,8 @@ be lost. get_char( debugger_input,C), '$action'(C,P,CallNumber,G,Module,H). '$action'('\n',_,_,_,_,_) :- !, % newline creep - '__NB_setval__'('$debug_status', state(creep, 0, stop)). + '__NB_getval__'('$trace',Trace,fail), + '__Nb_setval__'('$debug_status', state(creep, 0, stop, Trace)). '$action'(!,_,_,_,_,_) :- !, % ! 'g execute read(debugger_input, G), % don't allow yourself to be caught by creep. @@ -772,7 +773,8 @@ be lost. lists:memberchk( call_tracer, Opts), !, % <'Depth skip( debugger_input, 10), - '__NB_setval__'('$debug_status', state(creep, 0, stop)). + '__NB_getval__'('$trace',Trace,fail), + '__NB_setval__'('$debug_status', state(creep, 0, stop,Trace)). '$action'(^,_,_,G,_,_) :- !, % ' '$print_deb_sterm'(G), skip( debugger_input, 10), @@ -793,7 +795,8 @@ be lost. fail. '$action'(c,_,_,_,_,_) :- !, % 'c creep skip( debugger_input, 10), - '__NB_setval__'('$debug_status',status(creep,0,stop)). + '__NB_getval__'('$trace',Trace,fail), + '__NB_setval__'('$debug_status',status(creep,0,stop,Trace)). '$action'(e,_,_,_,_,_) :- !, % 'e exit halt. '$action'(f,_,CallNumber,_,_,_) :- !, % 'f fail @@ -827,19 +830,23 @@ be lost. '$action'(l,_,CallNumber,_,_,_) :- !, % 'l leap '$scan_number'(ScanNumber), ( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ), - '__NB_setval__'('$debug_status', state(leap, Goal, stop)). + '__NB_getval__'('$trace',Trace,fail), + '__NB_setval__'('$debug_status', state(leap, Goal, stop,Trace)). '$action'(z,_,_allNumber,_,_,_H) :- !, % 'z zip, fast leap - '__NB_setval__'('$debug_status', state(zip, 0, stop)). + '__NB_getval__'('$trace',Trace,fail), + '__NB_setval__'('$debug_status', state(zip, 0, stop, Trace)). % skip first call (for current goal), % stop next time. '$action'(k,_,_CallNumber,_,_,_) :- !, % 'k zip, fast leap - '__NB_setval__'('$debug_status', state(zip, 0, stop)). + '__NB_getval__'('$trace',Trace,fail), + '__NB_setval__'('$debug_status', state(zip, 0, stop, Trace)). % skip first call (for current goal), % stop next time. '$action'(n,_,_,_,_,_) :- !, % 'n nodebug skip( debugger_input, 10), % ' % tell debugger never to stop. - '__NB_setval__'('$debug_status', state(zip, 0, ignore)), + '__NB_getval__'('$trace',Trace,fail), + '__NB_setval__'('$debug_status', state(zip, 0, ignore, Trace)), nodebug. '$action'(r,_,CallNumber,_,_,_) :- !, % r retry '$scan_number'(ScanNumber), @@ -849,21 +856,24 @@ be lost. '$scan_number'(ScanNumber), ( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ), ( (P==call; P==redo) -> - '__NB_setval__'('$debug_status', state(leap, Goal, ignore) ) ; + '__NB_getval__'('$trace',Trace,fail), + '__NB_setval__'('$debug_status', state(leap, Goal, ignore,Trace) ) ; '$ilgl'(s) % ' ). '$action'(t,P,CallNumber,_,_,_) :- !, % 't fast skip '$scan_number'(ScanNumber), ( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ), - ( (P=call; P=redo) -> - '__NB_setval__'('$debug_status', state(zip, Goal, ignore)) ; + ( (P=call; P=redo) -> + '__NB_getval__'('$trace',Trace,fail), + '__NB_setval__'('$debug_status', state(zip, Goal, ignore,Trace)) ; '$ilgl'(t) % ' ). '$action'(q,P,CallNumber,_,_,_) :- !, % 'qst skip '$scan_number'(ScanNumber), ( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ), ( (P=call; P=redo) -> - '__NB_setval__'('$debug_status', state(leap, Goal, stop)) ; + '__NB_getval__'('$trace',Trace,fail), + '__NB_setval__'('$debug_status', state(leap, Goal, stop, Trace)) ; '$ilgl'(t) % ' ). '$action'(+,_,_,G,M,_) :- !, %% spy this diff --git a/pl/errors.yap b/pl/errors.yap index f4000aef9..ce0824b00 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -94,7 +94,6 @@ error_handler(Error, Level) :- '$LoopError'(Error, Level). '$LoopError'(_, _) :- - stop_low_level_trace, flush_output(user_output), flush_output(user_error), fail. diff --git a/pl/messages.yap b/pl/messages.yap index 08ffcc55c..e0e2dc9c7 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -206,7 +206,6 @@ compose_message(error(E, Exc), Level) --> { '$show_consult_level'(LC) }, - print_exception(Exc), location(error(E, Exc), Level, LC), main_message(error(E,Exc) , Level, LC ), c_goal( error(E, Exc), Level ), @@ -273,7 +272,7 @@ location(style_check(A,LN,FileName,B ), Level , LC) --> !, display_consulting( FileName, Level,style_check(A,LN,FileName,B ), LC ), [ '~a:~d:0: ~a: ' - [FileName,LN,Level] ] . -location( error(_,Info), Level, LC ) --> +location( error(_,Info), Level, _LC ) --> { '$error_descriptor'(Info, Desc) }, { query_exception(prologPredFile, Desc, File), @@ -285,7 +284,7 @@ location( error(_,Info), Level, LC ) --> !, {simplify_pred(M:Na/Ar,FF)}, [ '~a:~d:0 ~a while executing ~q:'-[File, FilePos,Level,FF] ]. -location( error(_,Info), Level, LC ) --> +location( error(_,Info), Level, _LC ) --> { '$error_descriptor'(Info, Desc) }, { query_exception(errorFile, Desc, File), diff --git a/pl/spy.yap b/pl/spy.yap index 5a1c61dd4..3a6a41920 100644 --- a/pl/spy.yap +++ b/pl/spy.yap @@ -403,23 +403,26 @@ notrace(G) :- '$enable_debugging':- current_prolog_flag(debug, false), !. '$enable_debugging' :- - nb_setval('$debug_status', state(creep, 0, stop)), - '$trace_on', !, + '__NB_getval__'('$trace',Trace,fail), + nb_setval('$debug_status', state(creep, 0, stop,Trace)), + Trace = on, !, '$creep'. '$enable_debugging'. '$trace_on' :- - '__NB_getval__'('$debug_status', state(_Creep, GN, Spy), fail), - nb_setval('$debug_status', state(zip, GN, Spy)). + '__NB_getval__'('$debug_status', state(_Creep, GN, Spy,_), fail), + '__NB_setval__'('$trace',on), + nb_setval('$debug_status', state(creep, GN, Spy, on)). '$trace_off' :- '__NB_getval__'('$debug_status', state(_Creep, GN, Spy), fail), - nb_setval('$debug_status', state(zip, GN, Spy)). + '__NB_setval__'('$trace',off), + nb_setval('$debug_status', state(zip, GN, Spy,off)). -'$trace_is_off'(_,_) :- +'$creep_is_off'(_,_) :- current_prolog_flag(debug, false), !. -'$trace_is_off'(Module:G, GN0) :- - '__NB_getval__'('$debug_status',state(zip, GN, Spy), fail), +'$creep_is_off'(Module:G, GN0) :- + '__NB_getval__'('$debug_status',state(zip, GN, Spy,_), fail), ( '$pred_being_spied'(G,Module) diff --git a/pl/top.yap b/pl/top.yap index d21fac56d..8031ca654 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -82,7 +82,8 @@ live :- % stop at spy-points if debugging is on. nb_setval('$debug_run',off), nb_setval('$debug_jump',off), - nb_setval('$debug_status', state(zip, 0, stop)), + '__NB_setval__'('$trace',off), + nb_setval('$debug_status', state(zip, 0, stop,off)), '$command'(Command,Varnames,Pos,top), current_prolog_flag(break_level, BreakLevel), ( @@ -1016,28 +1017,29 @@ log_event( String, Args ) :- LF = ['Break (level ', BreakLevel, ')'|LD] ), current_prolog_flag(debug, DBON), + ( + DBON = true + -> ( - '$trace_on' - -> - ( - var(LF) - -> - LD = ['trace'|LP] - ; - LD = [', trace '|LP] - ) + '__NB_getval__'('$debug_status',state(_, _, _,on), fail), + ( + var(LF) + -> + LD = ['trace'|LP] + ; + LD = [', trace '|LP] + ) ; - DBON == true + (var(LF) -> - (var(LF) - -> - LD = ['debug'|LP] - ; - LD = [', debug'|LP] - ) + LD = ['debug'|LP] + ; + LD = [', debug'|LP] + ) + ) ; LD = LP - ), + ), ( var(LF) -> From 2af4dae017d432cc40a7615566a3b9de974c6d8c Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 29 Mar 2019 14:37:03 +0000 Subject: [PATCH 093/101] ilbfgs --- packages/ProbLog/problog/lbdd.yap | 97 ++++++++----------- .../problog_examples/learn_graph_lbdd.pl | 24 ++--- packages/ProbLog/problog_lbfgs.yap | 91 +++++++++-------- 3 files changed, 98 insertions(+), 114 deletions(-) diff --git a/packages/ProbLog/problog/lbdd.yap b/packages/ProbLog/problog/lbdd.yap index 6a3cefd1e..7a9a920f4 100644 --- a/packages/ProbLog/problog/lbdd.yap +++ b/packages/ProbLog/problog/lbdd.yap @@ -58,11 +58,6 @@ update_query(QueryID,Symbol,What_To_Update) :- ) ). -maplist_to_hash([], H0, H0). -maplist_to_hash([I-V|MapList], H0, Hash) :- - rb_insert(H0, V, I, H1), - maplist_to_hash(MapList, H1, Hash). - prob2log(_X,Slope,FactID,V) :- get_fact_probability(FactID, V0), @@ -73,14 +68,11 @@ log2prob(X,Slope,FactID,V) :- sigmoid(V0, Slope, V). bind_maplist([], _Slope, _X). -bind_maplist([Node-Pr|MapList], Slope, X) :- - Pr <== X[Node], +bind_maplist([Node-(Node-Pr)|MapList], Slope, X) :- + SigPr <== X[Node], + sigmoid(SigPr, Slope, Pr), bind_maplist(MapList, Slope, X). -tree_to_grad([], _, Grad, Grad). -tree_to_grad([Node|Tree], H, Grad0, Grad) :- - node_to_gradient_node(Node, H, GNode), - tree_to_grad(Tree, H, [GNode|Grad0], Grad). %get_prob(Node, Prob) :- % query_probability(Node,Prob), !. @@ -97,58 +89,51 @@ gradient(_QueryID, l, _). gradient(QueryID, g, Slope) :- recorded(QueryID, BDD, _), query_gradients(BDD,Slope,I,Grad), -% writeln(grad(QueryID:I:Grad)), assert(query_gradient_intern(QueryID,I,p,Grad)), fail. gradient(QueryID, g, Slope) :- gradient(QueryID, l, Slope). -query_probability( DBDD, Slope, X, Prob) :- - DBDD = bdd(Dir, Tree, MapList), - bind_maplist(MapList, Slope, X), - run_sp(Tree, Slope, 1.0, Prob0), +query_probabilities( DBDD, Prob) :- + DBDD = bdd(Dir, Tree, _MapList), + findall(P, evalp(Tree,P), [Prob0]), (Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0). +evalp( Tree, Prob0) :- + foldl(evalp, Tree, _, Prob0). -query_gradients(bdd(Dir, Tree, MapList),Slope,X,I,Grad) :- - bind_maplist(MapList, Slope, X), - member(I-_, MapList), - run_grad(Tree, I, Slope, 0.0, Grad0), - ( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0). - - -node_to_gradient_node(pp(P-G,X,L,R), H, gnodep(P,G,X,Id,PL,GL,PR,GR)) :- - rb_lookup(X,Id,H), - (L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL), - (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). -node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :- - rb_lookup(X,Id,H), - (L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL), - (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). - -run_sp([], _, P0, P0). -run_sp(gnodep(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- - EP = 1.0 / (1.0 + exp(-X * Slope) ), - P is EP*PL+ (1.0-EP)*PR, - run_sp(Tree, Slope, P, PF). -run_sp(gnoden(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- - EP is 1.0 / (1.0 + exp(-X * Slope) ), - P is EP*PL + (1.0-EP)*(1.0 - PR), - run_sp(Tree, Slope, P, PF). - -run_grad([], _I, _, G0, G0). -run_grad([gnodep(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :- - EP is 1.0/(1.0 + exp(-X * Slope)), - P is EP*PL+ (1.0-EP)*PR, - G0 is EP*GL + (1.0-EP)*GR, - % don' t forget the -X - ( I == Id -> G is G0+(PL-PR)* EP*(1-EP)*Slope ; G = G0 ), - run_grad(Tree, I, Slope, G, GF). -run_grad([gnoden(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :- - EP is 1.0 / (1.0 + exp(-X * Slope) ), - P is EP*PL + (1.0-EP)*(1.0 - PR), - G0 is EP*GL - (1.0 - EP) * GR, - ( I == Id -> G is G0+(PL+PR-1)*EP*(1-EP)*Slope ; G = G0 ), - run_grad(Tree, I, Slope, G, GF). +query_gradients(bdd(Dir, Tree, MapList),I,IProb,Grad) :- + member(I-(_-IProb), MapList), + % run_grad(Tree, I, Slope, 0.0, Grad0), + foldl( evalg(I), Tree, _, Grad0), + ( Dir == 1 -> Grad = Grad0 ; Grad is -Grad0). + +evalp( pn(P, _-X, PL, PR), _,P ):- + P is X*PL+ (1.0-X)*(1.0-PR). +evalp( pp(P, _-X, PL, PR), _,P ):- + P is X*PL+ (1.0-X)*PR. + +evalg( I, pp(P-G, J-X, L, R), _, G ):- + ( number(L) -> PL=L, GL = 0.0 ; L = PL-GL ), + ( number(R) -> PR=R, GR = 0.0 ; R = PR-GR ), + P is X*PL+ (1.0-X)*PR, + ( + I == J + -> + G is X*GL+ (1.0-X)*GR+PL-PR + ; + G is X*GL+ (1.0-X)*GR + ). +evalg( I, pn(P-G, J-X, L, R), _,G ):- + ( number(L) -> PL=L, GL = 0.0 ; L = PL-GL ), + ( number(R) -> PR=R, GR = 0.0 ; R = PR-GR ), + P is X*PL+ (1.0-X)*(1.0-PR), + ( + I == J + -> + G is X*GL-(1.0-X)*GR+PL-(1-PR) + ; + G is X*GL- (1.0-X)*GR + ). diff --git a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl index 5541121f0..c91e644ac 100644 --- a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl +++ b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl @@ -17,7 +17,7 @@ :- use_module('../problog_lbfgs'). -%% :- if(true). + :- if(true). :- use_module('kbgraph'). @@ -27,9 +27,9 @@ %%%% % definition of acyclic path using list of visited nodes -%:- else. -/* -:- set_problog_flag(init_method,(Query,K,Bdd,problog:problog_exact_lbdd(Query,Bdd))). +:- else. + +:- Query=path(X,Y), set_problog_flag(init_method,(Query,K,Bdd,problog:problog_exact_lbdd(Query,Bdd))). path(X,Y) :- path(X,Y,[X],_). @@ -48,8 +48,8 @@ edge(X,Y) :- dir_edge(X,Y). absent(_,[]). absent(X,[Y|Z]):-X \= Y, absent(X,Z). -%:- endif. -*/ +:- endif. + %%%% % probabilistic facts % - probability represented by t/1 term means learnable parameter @@ -84,12 +84,12 @@ example(13,path(4,5),0.57). example(14,path(4,6),0.51). example(15,path(5,6),0.69). % some examples for learning from proofs: -%example(16,(dir_edge(2,3),dir_edge(2,6),dir_edge(6,5),dir_edge(5,4)),0.032). -%example(17,(dir_edge(1,6),dir_edge(2,6),dir_edge(2,3),dir_edge(3,4)),0.168). -%example(18,(dir_edge(5,3),dir_edge(5,4)),0.14). -%example(19,(dir_edge(2,6),dir_edge(6,5)),0.2). -%example(20,(dir_edge(1,2),dir_edge(2,3),dir_edge(3,4)),0.432). - +/*example(16,(dir_edge(2,3),dir_edge(2,6),dir_edge(6,5),dir_edge(5,4)),0.032). +example(17,(dir_edge(1,6),dir_edge(2,6),dir_edge(2,3),dir_edge(3,4)),0.168). +example(18,(dir_edge(5,3),dir_edge(5,4)),0.14). +example(19,(dir_edge(2,6),dir_edge(6,5)),0.2). +example(20,(dir_edge(1,2),dir_edge(2,3),dir_edge(3,4)),0.432). +*/ %%%%%%%%%%%%%% % test examples of form test_example(ID,Query,DesiredProbability) % note: ID namespace is shared with training example IDs diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index 343a134b1..05e4fd7dc 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -217,7 +217,7 @@ :- yap_flag(unknown,error). % load modules from the YAP library -:- use_module(library(lists), [member/2,max_list/2, min_list/2, sum_list/2]). +:- use_module(library(lists), [member/2,max_list/2, min_list/2, sum_list/2, reverse/2]). :- use_module(library(system), [file_exists/1, shell/2]). :- use_module(library(rbtrees)). :- use_module(library(lbfgs)). @@ -572,20 +572,22 @@ init_one_query(QueryID,Query,_Type) :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % if BDD file does not exist, call ProbLog %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + fail, problog_flag(init_method,(Query,N,Bdd,user:graph2bdd(Query,N,Bdd))), !, b_setval(problog_required_keep_ground_ids,false), (QueryID mod 100 =:= 0 ->writeln(QueryID) ; true), - Bdd = bdd(Dir, Tree,MapList), - user:graph2bdd(Query,N,Bdd), - rb_new(H0), - maplist_to_hash(MapList, H0, Hash), - tree_to_grad(Tree, Hash, [], Grad), + Bdd = bdd(Dir, Tree0,MapList), + user:graph2bdd(Query,N,Bdd), + reverse(Tree0,Tree), + %rb_new(H0), + %maplist_to_hash(MapList, H0, Hash), + %tree_to_grad(Tree, Hash, [], Grad), % ; % Bdd = bdd(-1,[],[]), % Grad=[] write('.'), - recordz(QueryID,bdd(Dir, Grad, MapList),_). + recordz(QueryID,bdd(Dir, Tree, MapList),_). init_one_query(QueryID,Query,_Type) :- % format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -594,15 +596,16 @@ init_one_query(QueryID,Query,_Type) :- b_setval(problog_required_keep_ground_ids,false), problog_flag(init_method,(Query,_K,Bdd,Call)), !, - Bdd = bdd(Dir, Tree, MapList), + Bdd = bdd(Dir, Tree0, MapList), % trace, once(Call), - rb_new(H0), - maplist_to_hash(MapList, H0, Hash), + reverse(Tree0,Tree), + %rb_new(H0), + %maplist_to_hash(MapList, H0, Hash), %Tree \= [], % writeln(Dir:Tree:MapList), - tree_to_grad(Tree, Hash, [], Grads), - recordz(QueryID,bdd(Dir, Grads, MapList),_). + %tree_to_grad(Tree, Hash, [], Grads), + recordz(QueryID,bdd(Dir, Tree, MapList),_). %======================================================================== %= @@ -780,22 +783,11 @@ inv_sigmoid(T,Slope,InvSig) :- %= probabilities of the examples have to be recalculated %======================================================================== -:- dynamic index/2. save_old_probabilities. -mkindex :- - retractall(index(_,_)), - findall(FactID,tunable_fact(FactID,_GroundTruth),L), - foldl(mkindex, L, 0, Count), - assert(count_tunables(Count)). - -mkindex(Key,I,I1) :- - I1 is I+1, - assert(index(Key,I),I1). % vsc: avoid silly search gradient_descent :- -mkindex, problog_flag(sigmoid_slope,Slope), % current_iteration(Iteration), findall(FactID,tunable_fact(FactID,_GroundTruth),L), @@ -808,8 +800,7 @@ mkindex, lbfgs_finalize(Solver). set_fact(FactID, Slope, P ) :- - index(FactID, I), - X <== P[I], + X <== P[FactID], sigmoid(X, Slope, Pr), (Pr > 0.99 -> @@ -834,16 +825,26 @@ set_tunable(I,Slope,P) :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :- %Handle = user_error, + N1 is N-1, + forall(between(0,N1,I),(Grad[I]<==0.0)), go( X,Grad, LLs), - sum_list( LLs, LLH_Training_Queries), - writeln(LLH_Training_Queries). + sum_list( LLs, LLH_Training_Queries). + +test :- + S =.. [f,0-0.9,1-0.8,2-0.6,3-0.7,4-0.5,5-0.4,6-0.7,7-0.2], + functor(S,_,N), N1 is N-1, + problog_flag(sigmoid_slope,Slope), + X <== array[N] of floats, +Grad <== array[N] of floats, + forall(between(0,N1,I),(Grad[I]<==0.0)), + forall(between(1,N,I),(arg(I,S,_-V),inv_sigmoid(V,Slope,V0),I1 is I-1,X[I1]<==V0)), + findall( + LL, + compute_gradient(Grad, X, Slope,LL), + LLs + ), sum_list( LLs, LLH_Training_Queries), writeln(LLH_Training_Queries:LLs ),forall(between(0,N1,I),(G<==Grad[I],writeln(I=G))). -update_tunables(X) :- - tunable_fact(FactID,GroundTruth), - set_fact_probability(ID,Prob), - fail. -update_tunables. go( X,Grad, LLs) :- problog_flag(sigmoid_slope,Slope), @@ -851,29 +852,27 @@ go( X,Grad, LLs) :- LL, compute_gradient(Grad, X, Slope,LL), LLs - ), - forall(tunable_fact(FactID,_GroundTruth), - set_fact( FactID, Slope, X) - ). + ). compute_gradient( Grad, X, Slope, LL) :- + user:example(QueryID,_Query,QueryProb), recorded(QueryID,BDD,_), - query_probability( BDD, Slope, X, BDDProb), + BDD = bdd(_,_,MapList), + bind_maplist(MapList, Slope, X), + query_probabilities( BDD, BDDProb), LL is (BDDProb-QueryProb)*(BDDProb-QueryProb), retractall( query_probability_intern( QueryID, _) ), assert( query_probability_intern( QueryID,BDDProb )), forall( - query_gradients(BDD,Slope,X,I,GradValue), - gradient_pair(BDDProb, QueryProb, Grad, GradValue, Slope, X, I) + query_gradients(BDD,I,IProb,GradValue), + gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, IProb) ). -gradient_pair(BDDProb, QueryProb, Grad, GradValue, Slope, X, I) :- +gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, Prob) :- G0 <== Grad[I], - log2prob(X,Slope,I,Prob), - %writeln(Prob=BDDProb), - GN is G0+GradValue*BDDProb*(1-BDDProb)*2*(QueryProb-BDDProb), + GN is G0-GradValue*Prob*(1-Prob)*2*(QueryProb-BDDProb), Grad[I] <== GN. wrap( X, Grad, GradCount) :- @@ -890,10 +889,10 @@ wrap( _X, _Grad, _GradCount). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % stop calculate gradient %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,CurrentIteration,_Ls,-1) :- +user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_CurrentIteration,_Ls,-1) :- FX < 0, !, format('stopped on bad FX=~4f~n',[FX]). -user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N, CurrentIteration,Ls,0) :- +user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N, Iteration,Ls,0) :- assertz(current_iteration(Iteration)), problog_flag(sigmoid_slope,Slope), forall(tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)), @@ -901,7 +900,7 @@ user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N, CurrentIteration,Ls,0) :- save_model, X0 <== X[0], sigmoid(X0,Slope,P0), X1 <== X[1], sigmoid(X1,Slope,P1), - format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[CurrentIteration,P0 ,P1,FX,X_Norm,G_Norm,Step,Ls]). + format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[Iteration,P0 ,P1,FX,X_Norm,G_Norm,Step,Ls]). %======================================================================== From 3f9e57fc48180d4d0bfaafe691c570219b3fc9e0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sat, 30 Mar 2019 10:37:16 +0000 Subject: [PATCH 094/101] fixes in module flow also: - user is everyone's parent; - system predicate <=> prolog:predicate --- packages/myddas/MyddasProto.h | 2 -- packages/myddas/myddas.h | 3 --- packages/myddas/myddas_shared.c | 6 ++++++ packages/myddas/pl/myddas.ypp | 21 ++++++------------- .../myddas/pl/myddas_assert_predicates.ypp | 3 ++- packages/myddas/pl/myddas_driver.ypp | 15 ++++++------- packages/myddas/sqlite3/myddas_sqlite3.c | 9 +++++--- packages/myddas/sqlite3/sqlitest.yap | 4 ++-- pl/imports.yap | 7 +++---- pl/preds.yap | 3 ++- 10 files changed, 33 insertions(+), 40 deletions(-) diff --git a/packages/myddas/MyddasProto.h b/packages/myddas/MyddasProto.h index 66eb1e400..54c9c6d5f 100644 --- a/packages/myddas/MyddasProto.h +++ b/packages/myddas/MyddasProto.h @@ -75,8 +75,6 @@ extern void Yap_InitBackMYDDAS_PostgresPreds(void); /* myddas_sqlite3.c */ #if defined MYDDAS_SQLITE3 extern void init_sqlite3( void ); -extern void Yap_InitMYDDAS_SQLITE3Preds(void); -extern void Yap_InitBackMYDDAS_SQLITE3Preds(void); #endif /* Myddas_shared.c */ diff --git a/packages/myddas/myddas.h b/packages/myddas/myddas.h index d40bf95d0..bbfbdd127 100644 --- a/packages/myddas/myddas.h +++ b/packages/myddas/myddas.h @@ -17,9 +17,6 @@ typedef struct myddas_global *MYDDAS_GLOBAL; #include "myddas_util.h" -// extern void Yap_InitMYDDAS_SQLITE3Preds(void); -// extern void Yap_InitBackMYDDAS_SQLITE3Preds(void); - #ifdef MYDDAS_STATS typedef struct myddas_stats_time_struct *MYDDAS_STATS_TIME; typedef struct myddas_global_stats *MYDDAS_GLOBAL_STATS; diff --git a/packages/myddas/myddas_shared.c b/packages/myddas/myddas_shared.c index 9061cc05c..2314072aa 100644 --- a/packages/myddas/myddas_shared.c +++ b/packages/myddas/myddas_shared.c @@ -51,6 +51,8 @@ static Int c_db_check(USES_REGS1); #endif void Yap_InitMYDDAS_SharedPreds(void) { + Term cm = CurrentModule; + CurrentModule = MkAtomTerm(Yap_LookupAtom("myddas")); /* c_db_initialize_myddas */ Yap_InitCPred("c_db_initialize_myddas", 0, c_db_initialize_myddas, 0); @@ -86,15 +88,19 @@ void Yap_InitMYDDAS_SharedPreds(void) { #ifdef DEBUG Yap_InitCPred("c_db_check", 0, c_db_check, 0); #endif + CurrentModule = cm; } void Yap_InitBackMYDDAS_SharedPreds(void) { + Term cm = CurrentModule; + CurrentModule = MkAtomTerm(Yap_LookupAtom("myddas")); /* Gives all the predicates associated to a given connection */ Yap_InitCPredBack("c_db_preds_conn", 4, sizeof(Int), c_db_preds_conn_start, c_db_preds_conn_continue, 0); /* Gives all the connections stored on the MYDDAS Structure*/ Yap_InitCPredBack("c_db_connection", 1, sizeof(Int), c_db_connection_start, c_db_connection_continue, 0); + CurrentModule = cm; } static bool myddas_initialised; diff --git a/packages/myddas/pl/myddas.ypp b/packages/myddas/pl/myddas.ypp index 40b1ca32e..583de5e82 100644 --- a/packages/myddas/pl/myddas.ypp +++ b/packages/myddas/pl/myddas.ypp @@ -97,15 +97,6 @@ #endif % myddas_assert_predicates.ypp , - db_import/2, - db_import/3, - db_view/2, - db_view/3, - db_insert/2, - db_insert/3, - db_abolish/2, - db_listing/0, - db_listing/1 % myddas_mysql.ypp ]). @@ -123,7 +114,7 @@ ]). #endif -:- use_module(myddas_assert_predicates,[ +:- reexport(myddas_assert_predicates,[ db_import/2, db_import/3, db_view/2, @@ -140,12 +131,12 @@ :- use_module(myddas_sqlite3,[ % myddas_mysql.ypp - %c_sqlite3_connect/4, - %c_sqlite3_disconnect/1, - %c_sqlite3_query/5, + c_sqlite3_connect/4, + c_sqlite3_disconnect/1, + c_sqlite3_query/5, + c_sqlite3_number_of_fields/3, + c_sqlite3_get_attributes_types/3, sqlite3_result_set/1, - %c_sqlite3_number_of_fields/3, - %c_sqlite3_get_attributes_types/3, sqlite3_describe/3, sqlite3_show_tables/2, sqlite3_row/3 diff --git a/packages/myddas/pl/myddas_assert_predicates.ypp b/packages/myddas/pl/myddas_assert_predicates.ypp index 157e46c1f..e64743e5f 100644 --- a/packages/myddas/pl/myddas_assert_predicates.ypp +++ b/packages/myddas/pl/myddas_assert_predicates.ypp @@ -29,7 +29,8 @@ :- use_module(myddas,[ - db_module/1 + db_module/1, + c_db_connection_type/2 ]). :- use_module(myddas_errors,[ diff --git a/packages/myddas/pl/myddas_driver.ypp b/packages/myddas/pl/myddas_driver.ypp index 9431bf116..698cdbccd 100644 --- a/packages/myddas/pl/myddas_driver.ypp +++ b/packages/myddas/pl/myddas_driver.ypp @@ -19,28 +19,27 @@ #define DBMS(x) sqlite3_##x #define c_DBMS(x) c_sqlite3_##x #define NAME() 'YAPsqlite3' -#define MODULE() user +#define MODULE() myddas_sqlite3 #define INIT() init_sqlite3 #elif defined( odbc ) #undef odbc #define DBMS(x) odbc_##x #define c_DBMS(x) c_odbc_##x #define NAME() 'YAPodbc' -#define MODULE() user +#define MODULE() myddas_odbc #define INIT() init_odbc #elif defined( postgres ) #undef postgres #define DBMS(x) postgres_##x #define c_DBMS(x) c_postgres_##x #define NAME() 'YAPpostgres' -#define MODULE() user +#define MODULE() myddas_postgres #define INIT() init_postgres #endif #if defined(DBMS) :- module(MODULE(),[ - /* c_DBMS(change_database)/2, c_DBMS(connect)/4, c_DBMS(disconnect)/1, @@ -50,8 +49,8 @@ c_DBMS(get_next_result_set)/3, c_DBMS(query)/5, c_DBMS(number_of_fields)/3, - */ DBMS(describe)/3, + DBMS(result_set)/1, DBMS(show_tables)/2, DBMS(row)/3 ]). @@ -61,9 +60,7 @@ :- use_module(library(maplist)). -:- use_module(myddas,[ - db_sql/3 - ]). +:- use_module(myddas). :- use_module(myddas_errors,[ '$error_checks'/1 @@ -154,7 +151,7 @@ DBMS(datalog_show_tables)(Connection) :- % DBMS(show_tables)/2 % gives the results of the SHOW TABLES statement % by backtracking -DBMS(show_tables)(Connection,table(Table)) :- +DBMS(showq_tables)(Connection,table(Table)) :- '$get_value'(Connection,Conn), SQL = 'SELECT name FROM sqlite_master WHERE type=\'table\' ORDER BY name', DBMS(result_set)(Mode), diff --git a/packages/myddas/sqlite3/myddas_sqlite3.c b/packages/myddas/sqlite3/myddas_sqlite3.c index 164ef0b27..c878c1a75 100644 --- a/packages/myddas/sqlite3/myddas_sqlite3.c +++ b/packages/myddas/sqlite3/myddas_sqlite3.c @@ -630,6 +630,8 @@ static Int c_sqlite3_row(USES_REGS1) { } static void Yap_InitMYDDAS_SQLITE3Preds(void) { + Term cm = CurrentModule; + CurrentModule = MkAtomTerm(Yap_LookupAtom("myddas_sqlite3")); /* db_dbect: Host x User x Passwd x Database x dbection x ERROR_CODE */ Yap_InitCPred("c_sqlite3_connect", 4, c_sqlite3_connect, 0); @@ -661,23 +663,24 @@ static void Yap_InitMYDDAS_SQLITE3Preds(void) { /* c_sqlite3_change_database: connection x DataBaseName */ Yap_InitCPred("c_sqlite3_change_database", 2, c_sqlite3_change_database, 0); + CurrentModule = cm; } static void Yap_InitBackMYDDAS_SQLITE3Preds(void) { + Term cm = CurrentModule; + CurrentModule = MkAtomTerm(Yap_LookupAtom("myddas_sqlite3")); /* db_row: ResultSet x Arity x ListOfArgs */ // Yap_InitCPredBack("c_sqlite3_row", 3, 0, c_sqlite3_row_initialise, // c_sqlite3_row, c_sqlite3_row_terminate); Yap_InitCPred("c_sqlite3_row_initialise", 2, c_sqlite3_row_initialise, 0); Yap_InitCPred("c_sqlite3_row_terminate", 2, c_sqlite3_row_terminate, 0); Yap_InitCPredBack("c_sqlite3_row_get", 4, 0, c_sqlite3_row, c_sqlite3_row, 0); + CurrentModule = cm; } X_API void init_sqlite3(void) { - Term cm = CurrentModule; - Yap_InitMYDDAS_SQLITE3Preds(); Yap_InitBackMYDDAS_SQLITE3Preds(); - CurrentModule = cm; } diff --git a/packages/myddas/sqlite3/sqlitest.yap b/packages/myddas/sqlite3/sqlitest.yap index bd57c91f3..8723d985b 100644 --- a/packages/myddas/sqlite3/sqlitest.yap +++ b/packages/myddas/sqlite3/sqlitest.yap @@ -1,5 +1,4 @@ - :- use_module(library(plunit)). :- begin_tests(sqlite3). @@ -13,7 +12,7 @@ test(db_open) :- db_open(sqlite3, '/data/user/0/pt.up.yap/files/chinook.db', _, _). :- else. test(db_open) :- - db_open(sqlite3,myddas,dataset('chinook.db'),_,_). + db_open(sqlite3,myddas,dataset('chinook.db'),_,_). :-endif. test(schema0, all((Desc ==[(table albums), @@ -98,3 +97,4 @@ test(close) :- :- end_tests(sqlite3). :- run_tests. + diff --git a/pl/imports.yap b/pl/imports.yap index 416799689..3e52e7fb5 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -46,10 +46,9 @@ fail. recorded('$import','$import'(ExportingMod,ImportingMod,G0,G,_,_),_). %% parent/user '$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :- - ( '$parent_module'(ImportingMod, PMod) ), %; PMod = user), - (nonvar(G0),'$pred_exists'(G0,PMod), PMod:G0 = ExportingMod:G; - recorded('$import','$import'(ExportingMod,PMod,G0,G,_,_),_) - ). + ( '$parent_module'(ImportingMod, PMod) ; PMod = user ), + ImportingMod \= PMod, + '$get_predicate_definition'(PMod:G, ExportingMod:G0). %% autoload` %'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :- % current_prolog_flag(autoload, true), diff --git a/pl/preds.yap b/pl/preds.yap index 2e37b45dd..acb9fe7b1 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -485,8 +485,9 @@ current_predicate(A0,T0) :- '$all_current_modules'(M) ), % M is bound + M \= prolog, ( - '$current_predicate'(A,M,T,user), + '$current_predicate'(A,M,T,_), functor(T, A, _) ; '$get_predicate_definition'(M:T,M1:_T1), From 4dff2ad2ecd788cff33ae9549d728ba73b7e3b28 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 31 Mar 2019 11:45:03 +0100 Subject: [PATCH 095/101] allow (m:a)/i as indicator. --- C/errors.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/C/errors.c b/C/errors.c index d64e1210c..34b4512c2 100755 --- a/C/errors.c +++ b/C/errors.c @@ -1296,6 +1296,9 @@ static Int is_callable(USES_REGS1) { * + Module:Name//Arity-2 * * if it is, it will extract the predicate's module, name, and arity. + * + * Note: this will now accept both mod:(a/n) and + * (mod:a)/n as valid. */ static Int get_predicate_indicator(USES_REGS1) { Term G = Deref(ARG1); @@ -1317,6 +1320,7 @@ static Int get_predicate_indicator(USES_REGS1) { } if (f == FunctorSlash || f == FunctorDoubleSlash) { Term name = ArgOfTerm(1,G), arity = ArgOfTerm(2,G); + name = Yap_YapStripModule (name, &mod); if (IsVarTerm(name)) { Yap_ThrowError(INSTANTIATION_ERROR, name, NULL); } else if (!IsAtomTerm(name)) { From 4926067be982e2c511654702535cc9d0fb2715cd Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 31 Mar 2019 11:46:17 +0100 Subject: [PATCH 096/101] shift modules around. --- packages/myddas/pl/myddas.ypp | 64 ++++++++++++++----- .../myddas/pl/myddas_assert_predicates.ypp | 24 ++++--- packages/myddas/pl/myddas_driver.ypp | 4 +- packages/myddas/pl/myddas_util_predicates.ypp | 3 +- packages/myddas/sqlite3/sqlitest.yap | 2 +- 5 files changed, 68 insertions(+), 29 deletions(-) diff --git a/packages/myddas/pl/myddas.ypp b/packages/myddas/pl/myddas.ypp index 583de5e82..067ba6f1d 100644 --- a/packages/myddas/pl/myddas.ypp +++ b/packages/myddas/pl/myddas.ypp @@ -22,30 +22,30 @@ #define SWITCH(Contype, G) \ ( Contype == mysql -> \ - my_ ## G \ + myddas_my:my_ ## G \ ; \ Contype == sqlite3 -> \ - sqlite3_ ## G \ + myddas_sqlite3:sqlite3_ ## G \ ; \ Contype == postgres -> \ - postgres_ ## G \ + myddas_postgres:postgres_ ## G \ ; \ Contype == odbc -> \ - odbc_ ## G \ + myddas_odbc:odbc_ ## G \ ) #define C_SWITCH(Contype, G) \ ( Contype == mysql -> \ - c_my_ ## G \ + myddas_my:c_my_ ## G \ ; \ Contype == sqlite3 -> \ - c_sqlite3_ ## G \ + myddas_sqlite3:c_sqlite3_ ## G \ ; \ Contype == postgres -> \ - c_postgres_ ## G \ + myddas_postgres:c_postgres_ ## G \ ; \ Contype == odbc -> \ - c_odbc_ ## G \ + myddas_odbc:c_odbc_ ## G \ ) :- module(myddas,[ @@ -85,19 +85,49 @@ db_get_attributes_types/3, db_number_of_fields/2, db_number_of_fields/3, - - db_multi_queries_number/2 - + % myddas_shared.c + c_db_connection_type/2, + c_db_add_preds/4, + c_db_preds_conn/4, + c_db_connection/1, + c_db_check_if_exists_pred/3, + c_db_delete_predicate/2, + c_db_multi_queries_number/2, + #ifdef MYDDAS_STATS + c_db_stats/2, + c_db_stats_walltime/1, + c_db_stats_translate/2, + c_db_stats_time/2, + #endif + #ifdef DEBUG + c_db_check/0, + #endif + c_db_initialize_myddas/0, + c_db_connection_type/2, + c_db_add_preds/4, + c_db_preds_conn/4, + c_db_connection/1, + c_db_check_if_exists_pred/3, + c_db_delete_predicate/2, + c_db_multi_queries_number/2, + #ifdef MYDDAS_STATS + c_db_stats/2, + c_db_stats_walltime/1, + c_db_stats_translate/2, + c_db_stats_time/2, + #endif + #ifdef DEBUG + c_db_check/0, + #endif % myddas_top_level.ypp #ifdef MYDDAS_TOP_LEVEL - , - db_top_level/4, + db_top_level/4, db_top_level/5, - db_datalog_select/3 + db_datalog_select/3, #endif % myddas_assert_predicates.ypp - , - % myddas_mysql.ypp + % myddas_mysql.ypp, + db_multi_queries_number/2 ]). @@ -386,7 +416,7 @@ db_sql_(ConType, Con, SQL,LA):- c_postgres_query(SQL,ResultSet,Con,Mode,Arity) ;ConType == sqlite3 -> sqlite3_result_set(Mode), - myddas_myddas_sqlite3:c_sqlite3_query(SQL,ResultSet,Con,Mode,Arity) + c_sqlite3_query(SQL,ResultSet,Con,Mode,Arity) ; c_odbc_query(SQL,ResultSet,Arity,LA,Con), c_odbc_number_of_fields_in_query(SQL,Con,Arity) diff --git a/packages/myddas/pl/myddas_assert_predicates.ypp b/packages/myddas/pl/myddas_assert_predicates.ypp index e64743e5f..8ce1fd8ac 100644 --- a/packages/myddas/pl/myddas_assert_predicates.ypp +++ b/packages/myddas/pl/myddas_assert_predicates.ypp @@ -30,8 +30,15 @@ :- use_module(myddas,[ db_module/1, - c_db_connection_type/2 - ]). + c_db_check_if_exists_pred/3, + c_db_preds_conn/4, + c_db_connection_type/2, + c_db_add_preds/4, + c_db_preds_conn/4, + c_db_connection/1, + c_db_check_if_exists_pred/3, + c_db_delete_predicate/2 + ]). :- use_module(myddas_errors,[ '$error_checks'/1 @@ -58,6 +65,7 @@ :- use_module(myddas_sqlite3,[ sqlite3_result_set/1, + sqlite3_show_tables/1, c_sqlite3_change_database/2, c_sqlite3_connect/4, c_sqlite3_disconnect/1, @@ -92,8 +100,8 @@ % db_import/3 % db_import/2 % -db_import(RelationName,PredName):- - db_import(myddas,RelationName,PredName). +db_import(RelationName,PredName0):- + db_import(myddas,RelationName,PredName0). db_import(Connection,RelationName,PredName0) :- '$error_checks'(db_import(Connection,RelationName,PredName0)), get_value(Connection,Con), @@ -319,9 +327,9 @@ table_access_predicate( sqlite3, Con, Arity, P, LA, M, myddas_prolog2sql:queries_atom(Code,FinalSQL), myddas_sqlite3:sqlite3_result_set(Mode), myddas_util_predicates:'$write_or_not'(FinalSQL), - user:c_sqlite3_query(FinalSQL,ResultSet,Con,Mode,_), + myddas_sqlite3:c_sqlite3_query(FinalSQL,ResultSet,Con,Mode,_), !, - myddas_aqlite3:sqlite3_row(ResultSet,Arity,LA) + myddas_sqlite3:sqlite3_row(ResultSet,Arity,LA) ) )). table_access_predicate( odbc, Con, Arity, P, LA, M, @@ -416,6 +424,6 @@ table_view( sqlite3, Con, CopyView, CopyGoal, Arity, LA, M, translate(ProjT,NG,Code), queries_atom(Code,FinalSQL), '$write_or_not'(FinalSQL), - c_sqlite3_query(FinalSQL,ResultSet,Con,_,_), + myddas_sqlite3:c_sqlite3_query(FinalSQL,ResultSet,Con,_,_), !, - c_sqlite3_row(ResultSet,Arity,LA) ))). + myddas_sqlite3:sqlite3_row(ResultSet,Arity,LA) ))). diff --git a/packages/myddas/pl/myddas_driver.ypp b/packages/myddas/pl/myddas_driver.ypp index 698cdbccd..101133bf4 100644 --- a/packages/myddas/pl/myddas_driver.ypp +++ b/packages/myddas/pl/myddas_driver.ypp @@ -10,7 +10,7 @@ * * * File: myddas_mysql.yap * * Last rev: * -* mods: * +* mods: *show * comments: MySQL Predicates * * * *************************************************************************/ @@ -151,7 +151,7 @@ DBMS(datalog_show_tables)(Connection) :- % DBMS(show_tables)/2 % gives the results of the SHOW TABLES statement % by backtracking -DBMS(showq_tables)(Connection,table(Table)) :- +DBMS(show_tables)(Connection,table(Table)) :- '$get_value'(Connection,Conn), SQL = 'SELECT name FROM sqlite_master WHERE type=\'table\' ORDER BY name', DBMS(result_set)(Mode), diff --git a/packages/myddas/pl/myddas_util_predicates.ypp b/packages/myddas/pl/myddas_util_predicates.ypp index f144c0020..1e8d7ddb3 100644 --- a/packages/myddas/pl/myddas_util_predicates.ypp +++ b/packages/myddas/pl/myddas_util_predicates.ypp @@ -46,7 +46,8 @@ ]). :- use_module(myddas,[ - db_verbose/1 + db_verbose/1, + c_db_preds_conn/4 ]). :- use_module(myddas_errors,[ diff --git a/packages/myddas/sqlite3/sqlitest.yap b/packages/myddas/sqlite3/sqlitest.yap index 8723d985b..75601d911 100644 --- a/packages/myddas/sqlite3/sqlitest.yap +++ b/packages/myddas/sqlite3/sqlitest.yap @@ -75,7 +75,7 @@ test(att_types, true((Als == ['AlbumId','','Title','','ArtistId',''], As == ['ArtistId','','Name',''], Ts == ['TrackId','','Name','','AlbumId','','MediaTypeId','','GenreId','', 'Composer','','Milliseconds','','Bytes','','UnitPrice','']))) :- - db_get_attributes_types(albums,Als), + ., db_get_attributes_types(tracks,Ts), db_get_attributes_types(artists,As). From 0112ad9c20d44e545acb96ff02f4b34fe5c67c5f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 31 Mar 2019 23:14:14 +0100 Subject: [PATCH 097/101] -temp fixes --- packages/ProbLog/problog_lbfgs.yap | 67 ++++++++++++++++-------------- pl/debug.yap | 1 + pl/spy.yap | 3 +- 3 files changed, 39 insertions(+), 32 deletions(-) diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index 05e4fd7dc..d683849ed 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -222,6 +222,7 @@ :- use_module(library(rbtrees)). :- use_module(library(lbfgs)). :- reexport(library(matrix)). +:- reexport(library(terms)). % load our own modules :- reexport(problog). @@ -237,6 +238,7 @@ :- dynamic(values_correct/0). :- dynamic(learning_initialized/0). :- dynamic(current_iteration/1). +:- dynamic(solver_iteration/1). :- dynamic(example_count/1). :- dynamic(query_probability_intern/2). %:- dynamic(query_gradient_intern/4). @@ -244,11 +246,6 @@ :- dynamic(query_is_similar/2). :- dynamic(query_md5/2). - -% used to identify queries which have identical proofs -:- dynamic(query_is_similar/2). -:- dynamic(query_md5/3). - % used to identify queries which have identical proofs :- dynamic(query_is_similar/2). :- dynamic(query_md5/3). @@ -266,7 +263,7 @@ user:test_example(A,B,C,=) :- user:test_example(A,B,C), \+ user:problog_discard_example(B). - +solver_iteration(0). %======================================================================== %= store the facts with the learned probabilities to a file @@ -274,7 +271,9 @@ user:test_example(A,B,C,=) :- save_model:- current_iteration(Iteration), - create_factprobs_file_name(Iteration,Filename), + solver_iteration(LBFGSIteration), + Id is Iteration*100+LBFGSIteration, + create_factprobs_file_name(Id,Filename), export_facts(Filename). @@ -559,7 +558,7 @@ empty_bdd_directory. init_queries :- - empty_bdd_directory, + %empty_bdd_directory, format_learning(2,'Build BDDs for examples~n',[]), forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)), forall(user:example(ID,Query,_Prob,_),init_one_query(ID,Query,training)). @@ -572,11 +571,9 @@ init_one_query(QueryID,Query,_Type) :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % if BDD file does not exist, call ProbLog %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - fail, - problog_flag(init_method,(Query,N,Bdd,user:graph2bdd(Query,N,Bdd))), +problog_flag(init_method,(Query,N,Bdd,user:graph2bdd(Query,N,Bdd))), !, b_setval(problog_required_keep_ground_ids,false), - (QueryID mod 100 =:= 0 ->writeln(QueryID) ; true), Bdd = bdd(Dir, Tree0,MapList), user:graph2bdd(Query,N,Bdd), reverse(Tree0,Tree), @@ -586,8 +583,7 @@ init_one_query(QueryID,Query,_Type) :- % ; % Bdd = bdd(-1,[],[]), % Grad=[] - write('.'), - recordz(QueryID,bdd(Dir, Tree, MapList),_). + store_bdd(QueryID, Dir, Tree, MapList). init_one_query(QueryID,Query,_Type) :- % format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -600,12 +596,22 @@ init_one_query(QueryID,Query,_Type) :- % trace, once(Call), reverse(Tree0,Tree), - %rb_new(H0), - %maplist_to_hash(MapList, H0, Hash), - %Tree \= [], -% writeln(Dir:Tree:MapList), - %tree_to_grad(Tree, Hash, [], Grads), - recordz(QueryID,bdd(Dir, Tree, MapList),_). + store_bdd(QueryID, Dir, Tree, MapList). + + +store_bdd(QueryID, Dir, Tree, MapList) :- + (QueryID mod 100 =:= 0 ->writeln(QueryID) ; true), + ( + recorded(QueryID, Bdd0, R), + arg(3, Bdd0, MapList0), variant(MapList0,MapList) + -> + put_char('.') + ; + (nonvar(R) -> erase(R);true), + recorda(QueryID,bdd(Dir, Tree, MapList),_), + put_char('.') + ). + %======================================================================== %= @@ -668,7 +674,6 @@ mse_trainingset :- (user:example(QueryID,Query,TrueQueryProb,_Type), query_probability(QueryID,CurrentProb), format(Handle,'ex(~q,training,~q,~q,~10f,~10f).~n',[Iteration,QueryID,Query,TrueQueryProb,CurrentProb]), - once(update_query_cleanup(QueryID)), SquaredError is (CurrentProb-TrueQueryProb)**2, LogCurrentProb is log(CurrentProb) @@ -784,7 +789,6 @@ inv_sigmoid(T,Slope,InvSig) :- %======================================================================== -save_old_probabilities. % vsc: avoid silly search gradient_descent :- @@ -797,7 +801,9 @@ gradient_descent :- set_fact( FactID, Slope, X) ), lbfgs_run(Solver,_BestF), - lbfgs_finalize(Solver). + lbfgs_finalize(Solver), + mse_trainingset, + mse_testset. set_fact(FactID, Slope, P ) :- X <== P[FactID], @@ -842,7 +848,7 @@ Grad <== array[N] of floats, LL, compute_gradient(Grad, X, Slope,LL), LLs - ), sum_list( LLs, LLH_Training_Queries), writeln(LLH_Training_Queries:LLs ),forall(between(0,N1,I),(G<==Grad[I],writeln(I=G))). + ), sum_list( LLs, _LLH_Training_Queries). @@ -856,15 +862,12 @@ go( X,Grad, LLs) :- compute_gradient( Grad, X, Slope, LL) :- - user:example(QueryID,_Query,QueryProb), recorded(QueryID,BDD,_), BDD = bdd(_,_,MapList), bind_maplist(MapList, Slope, X), query_probabilities( BDD, BDDProb), LL is (BDDProb-QueryProb)*(BDDProb-QueryProb), - retractall( query_probability_intern( QueryID, _) ), - assert( query_probability_intern( QueryID,BDDProb )), forall( query_gradients(BDD,I,IProb,GradValue), gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, IProb) @@ -892,15 +895,17 @@ wrap( _X, _Grad, _GradCount). user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_CurrentIteration,_Ls,-1) :- FX < 0, !, format('stopped on bad FX=~4f~n',[FX]). -user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N, Iteration,Ls,0) :- - assertz(current_iteration(Iteration)), - problog_flag(sigmoid_slope,Slope), - forall(tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)), +user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N, LBFGSIteration,Ls,0) :- + problog_flag(sigmoid_slope,Slope), + forall( + tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)), logger_set_variable(mse_trainingset, FX), + retractall(solver_iterations(_)), + assert(solver_iterations(LBFGSIteration)), save_model, X0 <== X[0], sigmoid(X0,Slope,P0), X1 <== X[1], sigmoid(X1,Slope,P1), - format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[Iteration,P0 ,P1,FX,X_Norm,G_Norm,Step,Ls]). + format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[LBFGSIteration,P0,P1,FX,X_Norm,G_Norm,Step,Ls]). %======================================================================== diff --git a/pl/debug.yap b/pl/debug.yap index 4e40fdeee..b46c5dfd5 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -1,3 +1,4 @@ + /**********************************************************************a*** * * * YAP Prolog * diff --git a/pl/spy.yap b/pl/spy.yap index 3a6a41920..0f0844b66 100644 --- a/pl/spy.yap +++ b/pl/spy.yap @@ -220,7 +220,8 @@ debug :- ; set_prolog_flag(debug, false) ), - '__NB_setval__'('$debug_state',state(creep,0,stop) ). +'__NB_getval__'('$trace',Trace, fail), + '__NB_setval__'('$debug_state',state(creep,0,stop,Trace) ). nodebug :- '$init_debugger', From 2f1eb61cf9cc00fc925007196c937bbb00f9e920 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 31 Mar 2019 23:23:04 +0100 Subject: [PATCH 098/101] yap4r --- packages/real/yap4r/DESCRIPTION | 12 +++ packages/real/yap4r/NAMESPACE | 3 + packages/real/yap4r/R/RcppExports.R | 19 +++++ packages/real/yap4r/man/yap4r-package.Rd | 34 +++++++++ packages/real/yap4r/src/Makevars.in | 2 + packages/real/yap4r/src/RcppExports.cpp | 67 +++++++++++++++++ packages/real/yap4r/src/yap4r.cpp | 93 ++++++++++++++++++++++++ 7 files changed, 230 insertions(+) create mode 100644 packages/real/yap4r/DESCRIPTION create mode 100644 packages/real/yap4r/NAMESPACE create mode 100644 packages/real/yap4r/R/RcppExports.R create mode 100644 packages/real/yap4r/man/yap4r-package.Rd create mode 100644 packages/real/yap4r/src/Makevars.in create mode 100644 packages/real/yap4r/src/RcppExports.cpp create mode 100644 packages/real/yap4r/src/yap4r.cpp diff --git a/packages/real/yap4r/DESCRIPTION b/packages/real/yap4r/DESCRIPTION new file mode 100644 index 000000000..b9d787454 --- /dev/null +++ b/packages/real/yap4r/DESCRIPTION @@ -0,0 +1,12 @@ +Package: yap4r +Type: Package +Title: What the Package Does in One 'Title Case' Line +Version: 1.0 +Date: 2019-03-25 +Author: Your Name +Maintainer: Your Name +Description: One paragraph description of what the package does as one + or more full sentences. +License: GPL (>= 2) +Imports: Rcpp (>= 1.0.1) +LinkingTo: Rcpp diff --git a/packages/real/yap4r/NAMESPACE b/packages/real/yap4r/NAMESPACE new file mode 100644 index 000000000..a97033a02 --- /dev/null +++ b/packages/real/yap4r/NAMESPACE @@ -0,0 +1,3 @@ +useDynLib(yap4r, .registration=TRUE) +exportPattern("^[[:alpha:]]+") +importFrom(Rcpp, evalCpp) diff --git a/packages/real/yap4r/R/RcppExports.R b/packages/real/yap4r/R/RcppExports.R new file mode 100644 index 000000000..1c03a2ce6 --- /dev/null +++ b/packages/real/yap4r/R/RcppExports.R @@ -0,0 +1,19 @@ +# Generated by using Rcpp::compileAttributes() -> do not edit by hand +# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 + +query <- function(p_name, p_module, sexp) { + .Call(`_yap4r_query`, p_name, p_module, sexp) +} + +next <- function() { + .Call(`_yap4r_next`) +} + +cut <- function() { + .Call(`_yap4r_cut`) +} + +ask <- function(i) { + .Call(`_yap4r_ask`, i) +} + diff --git a/packages/real/yap4r/man/yap4r-package.Rd b/packages/real/yap4r/man/yap4r-package.Rd new file mode 100644 index 000000000..ae1dc9709 --- /dev/null +++ b/packages/real/yap4r/man/yap4r-package.Rd @@ -0,0 +1,34 @@ +\name{yap4r-package} +\alias{yap4r-package} +\alias{yap4r} +\docType{package} +\title{ + A short title line describing what the package does +} +\description{ + A more detailed description of what the package does. A length + of about one to five lines is recommended. +} +\details{ + This section should provide a more detailed overview of how to use the + package, including the most important functions. +} +\author{ +Your Name, email optional. + +Maintainer: Your Name +} +\references{ + This optional section can contain literature or other references for + background information. +} +\keyword{ package } +\seealso{ + Optional links to other man pages +} +\examples{ + \dontrun{ + ## Optional simple examples of the most important functions + ## These can be in \dontrun{} and \donttest{} blocks. + } +} diff --git a/packages/real/yap4r/src/Makevars.in b/packages/real/yap4r/src/Makevars.in new file mode 100644 index 000000000..508f8895a --- /dev/null +++ b/packages/real/yap4r/src/Makevars.in @@ -0,0 +1,2 @@ +PKG_LIBS=-L/home/vsc/.local/lib/Yap/ -lreal +PKG_CPPFLAGS=-I../../../../CXX -I../../../../build -I../../../../include -I../../../../H -I../../../../OPTYap -I../../../../os -I../.. \ No newline at end of file diff --git a/packages/real/yap4r/src/RcppExports.cpp b/packages/real/yap4r/src/RcppExports.cpp new file mode 100644 index 000000000..d44a30492 --- /dev/null +++ b/packages/real/yap4r/src/RcppExports.cpp @@ -0,0 +1,67 @@ +// Generated by using Rcpp::compileAttributes() -> do not edit by hand +// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 + +#include + +using namespace Rcpp; + +// query +bool query(std::string p_name, std::string p_module, SEXP sexp); +RcppExport SEXP _yap4r_query(SEXP p_nameSEXP, SEXP p_moduleSEXP, SEXP sexpSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< std::string >::type p_name(p_nameSEXP); + Rcpp::traits::input_parameter< std::string >::type p_module(p_moduleSEXP); + Rcpp::traits::input_parameter< SEXP >::type sexp(sexpSEXP); + rcpp_result_gen = Rcpp::wrap(query(p_name, p_module, sexp)); + return rcpp_result_gen; +END_RCPP +} +// next +bool next(); +RcppExport SEXP _yap4r_next() { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = Rcpp::wrap(next()); + return rcpp_result_gen; +END_RCPP +} +// cut +bool cut(); +RcppExport SEXP _yap4r_cut() { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = Rcpp::wrap(cut()); + return rcpp_result_gen; +END_RCPP +} +// ask +SEXP ask(int i); +RcppExport SEXP _yap4r_ask(SEXP iSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type i(iSEXP); + rcpp_result_gen = Rcpp::wrap(ask(i)); + return rcpp_result_gen; +END_RCPP +} + +RcppExport SEXP _rcpp_module_boot_mod_yap4r(); + +static const R_CallMethodDef CallEntries[] = { + {"_yap4r_query", (DL_FUNC) &_yap4r_query, 3}, + {"_yap4r_next", (DL_FUNC) &_yap4r_next, 0}, + {"_yap4r_cut", (DL_FUNC) &_yap4r_cut, 0}, + {"_yap4r_ask", (DL_FUNC) &_yap4r_ask, 1}, + {"_rcpp_module_boot_mod_yap4r", (DL_FUNC) &_rcpp_module_boot_mod_yap4r, 0}, + {NULL, NULL, 0} +}; + +RcppExport void R_init_yap4r(DllInfo *dll) { + R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); +} diff --git a/packages/real/yap4r/src/yap4r.cpp b/packages/real/yap4r/src/yap4r.cpp new file mode 100644 index 000000000..16ecd9820 --- /dev/null +++ b/packages/real/yap4r/src/yap4r.cpp @@ -0,0 +1,93 @@ +#include + +#undef Realloc +#undef Malloc +#undef Free +#include + +#include + +#include "real.h" + + +using namespace Rcpp; + +class YAP4R { + + YAPEngine *yap; + YAPQuery *q; + std::vector args; + bool failed; + +public: +//[[Rcpp::export]] + +YAP4R() { + YAPEngineArgs *yargs = new YAPEngineArgs(); + yap = new YAPEngine(yargs); +}; + + +//[[Rcpp::export]] +bool query(std::string p_name,std::string p_module, SEXP sexp) { + + YAPPairTerm tmp; + if (q) { + q->close(); + q = NULL; + } + if (!sexp_to_pl(tmp.handle(), sexp)) + return false; + args = tmp.listToVector(); + YAPTerm ts[1], hd; + YAPTerm qt = YAPApplTerm(p_name,args); + q = new YAPQuery(qt); + return true; +}; + + +//[[Rcpp::export]] + bool next() { + bool rc = true; + if (failed) + return false; + if (q) + rc = next(); + if (!rc) { + failed = true; + } + return rc; + } + +//[[Rcpp::export]] + bool cut() { + bool rc = true; + if (failed) + return false; + if (q) + rc = cut(); + q = NULL; + return rc; + }; + +//[[Rcpp::export]] + SEXP ask(int i) { + if (failed || q==nullptr) + return R_MissingArg; + return term_to_sexp(YAPTerm(Yap_XREGS[i]).handle(), false); + }; + + + +}; + + RCPP_MODULE(mod_yap4r) { + Rcpp::class_( "YAP4R" ) + .constructor("documentation for default constructor") + .method( "query", &YAP4R::query ) +.method( "next", &YAP4R::next ) +.method( "ask", &YAP4R::ask ) +.method( "cut", &YAP4R::cut ) + ; +; +} From b24df86cb0d2512ca2fc5b51078e67b3a65bf511 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 1 Apr 2019 09:27:55 +0100 Subject: [PATCH 099/101] debugger yap4r --- packages/ProbLog/problog_lbfgs.yap | 19 ++++++++----- packages/python/yap_kernel/CMakeLists.txt | 6 +++-- packages/real/CMakeLists.txt | 33 +++++++++++++++++++++-- packages/real/yap4r/src/Makevars.in | 4 +-- pl/debug.yap | 24 ++++++++++------- pl/spy.yap | 7 ++--- pl/top.yap | 2 +- 7 files changed, 69 insertions(+), 26 deletions(-) diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index d683849ed..1f57be808 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -269,16 +269,25 @@ solver_iteration(0). %= store the facts with the learned probabilities to a file %======================================================================== -save_model:- +save_model(X):- + problog_flag(sigmoid_slope,Slope), current_iteration(Iteration), solver_iteration(LBFGSIteration), Id is Iteration*100+LBFGSIteration, create_factprobs_file_name(Id,Filename), + retractall( query_probability_intern(_,_)), + forall( + user:example(QueryID,_Query,_QueryProb), + (recorded(QueryID,BDD,_), + BDD = bdd(_,_,MapList), + bind_maplist(MapList, Slope, X), + query_probabilities( BDD, BDDProb), + assert( query_probability_intern(QueryID,BDDProb))) + ), export_facts(Filename). - %======================================================================== %= find out whether some example IDs are used more than once %= if so, complain and stop @@ -423,8 +432,6 @@ do_learning_intern(Iterations,Epsilon) :- %leash(0),trace, gradient_descent, - once(save_model), - update_values, mse_trainingset, ( last_mse(Last_MSE) @@ -669,7 +676,6 @@ mse_trainingset :- create_training_predictions_file_name(Iteration,File_Name), open(File_Name, write,Handle), format_learning(2,'MSE_Training ',[]), - update_values, findall(t(LogCurrentProb,SquaredError), (user:example(QueryID,Query,TrueQueryProb,_Type), query_probability(QueryID,CurrentProb), @@ -714,7 +720,6 @@ mse_testset :- create_test_predictions_file_name(Iteration,File_Name), open(File_Name, write,Handle), format_learning(2,'MSE_Test ',[]), - update_values, bb_put(llh_test_queries,0.0), findall(SquaredError, (user:test_example(QueryID,Query,TrueQueryProb,Type), @@ -902,7 +907,7 @@ user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N, LBFGSIteration,Ls,0) :- logger_set_variable(mse_trainingset, FX), retractall(solver_iterations(_)), assert(solver_iterations(LBFGSIteration)), - save_model, + save_model(X), X0 <== X[0], sigmoid(X0,Slope,P0), X1 <== X[1], sigmoid(X1,Slope,P1), format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[LBFGSIteration,P0,P1,FX,X_Norm,G_Norm,Step,Ls]). diff --git a/packages/python/yap_kernel/CMakeLists.txt b/packages/python/yap_kernel/CMakeLists.txt index adbb63556..f491c20b2 100644 --- a/packages/python/yap_kernel/CMakeLists.txt +++ b/packages/python/yap_kernel/CMakeLists.txt @@ -433,12 +433,14 @@ endforeach() add_custom_target(YAP_KERNEL ALL WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} - DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-32x32.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-64x64.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/kernel.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js ${OUTS} YAP4PY + COMMAND ${PYTHON_EXECUTABLE} ${SETUP_PY} build sdist bdist + DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-32x32.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-64x64.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/kernel.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js ${OUTS} YAP4PY ) +set(REAL_SOURCES real.c) + install(CODE "execute_process( - COMMAND ${PYTHON_EXECUTABLE} ${SETUP_PY} build sdist bdist COMMAND ${PYTHON_EXECUTABLE} -m pip install ${PYTHON_USER_INSTALL} --ignore-installed --no-deps . COMMAND ${PYTHON_EXECUTABLE} -m yap_kernel.kernelspec ERROR_VARIABLE setupErr diff --git a/packages/real/CMakeLists.txt b/packages/real/CMakeLists.txt index cfb293196..342510d4d 100644 --- a/packages/real/CMakeLists.txt +++ b/packages/real/CMakeLists.txt @@ -1,8 +1,6 @@ # PROJECT ( YAP_REAL C ) - - set(REAL_SOURCES real.c) # LIBR_FOUND @@ -16,6 +14,20 @@ set_package_properties(R PROPERTIES DESCRIPTION "The R Project for Statistical Computing." URL "https://www.r-project.org/") + + +foreach(f ${FILES}) + add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/${f} + COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/${f} ${CMAKE_CURRENT_BINARY_DIR}/${f} + DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/${f} + ) + list(APPEND OUTS ${CMAKE_CURRENT_BINARY_DIR}/${f} ) +endforeach() + +add_custom_target(YAP4R + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} + DEPENDS ${OUTS} + ) add_library(real ${REAL_SOURCES}) target_link_libraries (real ${LIBR_LIBRARIES} libYap) include_directories ( @@ -36,6 +48,23 @@ include_directories ( check_include_files( "Rembedded.h;Rinterface.h" HAVE_R_INTERFACE_H ) configure_file ("rconfig.h.cmake" "rconfig.h" ) + configure_file ("yap4r/src/Makevars.in" "yap4r/src/Makevars" ) + + + set(YAP4R_SOURCES + yap4r/man/yap4r-package.Rd +yap4r/R +yap4r/R/RcppExports.R +yap4r/NAMESPACE +yap4r/DESCRIPTION +yap4r/src +yap4r/src/Makevars.in +yap4r/src/yap4r.cpp +yap4r/src/RcppExports.cpp +) + + + install(TARGETS real RUNTIME DESTINATION ${YAP_INSTALL_LIBDIR} diff --git a/packages/real/yap4r/src/Makevars.in b/packages/real/yap4r/src/Makevars.in index 508f8895a..709fa07d5 100644 --- a/packages/real/yap4r/src/Makevars.in +++ b/packages/real/yap4r/src/Makevars.in @@ -1,2 +1,2 @@ -PKG_LIBS=-L/home/vsc/.local/lib/Yap/ -lreal -PKG_CPPFLAGS=-I../../../../CXX -I../../../../build -I../../../../include -I../../../../H -I../../../../OPTYap -I../../../../os -I../.. \ No newline at end of file +PKG_LIBS=-L${YAP_LIBDIR} -L${YAP_DLLDIR} -L ../../.. -lreal -lYap +PKG_CPPFLAGS=-I${YAP_SOURCE_DIR}/CXX -I${YAP_BINARY_DIR} -I${YAP_SOURCE_DIR}/include -I${YAP_SOURCE_DIR}/H -I${YAP_SOURCE_DIR}/OPTYap -I${YAP_SOURCE_DIR}/os -I../.. diff --git a/pl/debug.yap b/pl/debug.yap index b46c5dfd5..1f3deecce 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -81,7 +81,7 @@ To start debugging, the user will either call `trace` or spy the relevant procedures, entering debug mode, and start execution of the program. When finding the first spy-point, YAP's debugger will take control and show a message of the form: - +v ~~~~~ * (1) call: quicksort([1,2,3],_38) ? ~~~~~ @@ -167,7 +167,7 @@ the argument, the command fails all the way to the goal. If goal _GoalId_ has c side effects of the goal cannot be undone. This command is not available at the call port. If f receives a goal number as the argument, the command retries goal _GoalId_ instead. If goal _GoalId_ has -completed execution, YAP fails until meeting the first active ancestor. +vcompleted execution, YAP fails until meeting the first active ancestor. + `a` - abort @@ -525,10 +525,10 @@ be lost. true ), /* get goal list */ - '__NB_getval__'('$spy_glist',History,true), + '__NB_getval__'('$spy_glist',History,History=[]), H = [Info|History], Info = info(L,Module,G,_Retry,_Det,_HasFoundAnswers), - '__B_setval__'('$spy_glist',H), + b_setval('$spy_glist',H), /* and update it */ '$port'(call,G,Module,L,deterministic, Info). @@ -610,7 +610,10 @@ be lost. '$stop_creeping'(_) , current_prolog_flag(debug, true), '__NB_getval__'('$debug_status',state(Skip,Border,_,Trace), fail), - ( Skip == creep -> true; '$id_goal'(GoalNumber), GoalNumber =< Border), + ( Skip == creep -> true; + '$stop_creeping'(_) , + '$id_goal'(GoalNumber), + GoalNumber =< Border), !, '__NB_setval__'('$debug_status', state(creep, 0, stop,Trace)), '$trace_port_'(Port, GoalNumber, G, Module, Info). @@ -624,15 +627,18 @@ be lost. '$trace_port_'(answer, GoalNumber, G, Module, Info) :- '$port'(exit,G,Module,GoalNumber,nondeterministic, Info). '$trace_port_'(redo, GoalNumber, G, Module, Info) :- - '$port'(redo,G,Module,GoalNumber,nondeterministic, Info), /* inform user_error */ - '$stop_creeping'(_ ). + '$stop_creeping'(_ ), + '$port'(redo,G,Module,GoalNumber,nondeterministic, Info). /* inform user_error */ '$trace_port_'(fail, GoalNumber, G, Module, Info) :- + '$stop_creeping'(_ ), '$port'(fail,G,Module,GoalNumber,deterministic, Info). /* inform user_error */ '$trace_port_'(! ,_GoalNumber,_G,_Module,_Imfo) :- /* inform user_error */ !. '$trace_port_'(exception(E), GoalNumber, G, Module, Info) :- + '$stop_creeping'(_ ), '$TraceError'(E, GoalNumber, G, Module, Info). '$trace_port_'(external_exception(E), GoalNumber, G, Module, Info) :- + '$stop_creeping'(_ ), '$TraceError'(E, GoalNumber, G, Module, Info). @@ -754,7 +760,7 @@ be lost. '$action'(C,P,CallNumber,G,Module,H). '$action'('\n',_,_,_,_,_) :- !, % newline creep '__NB_getval__'('$trace',Trace,fail), - '__Nb_setval__'('$debug_status', state(creep, 0, stop, Trace)). + '__NB_setval__'('$debug_status', state(creep, 0, stop, Trace)). '$action'(!,_,_,_,_,_) :- !, % ! 'g execute read(debugger_input, G), % don't allow yourself to be caught by creep. @@ -1075,7 +1081,7 @@ be lost. '$debugger_process_meta_arguments'(G, _M, G). '$ldebugger_process_meta_args'([], _, [], []). -'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$user_call'(G1,M1)|BG1s]) :- +'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$trace'(M1:G1)|BG1s]) :- number(N), N >= 0, '$yap_strip_module'( M:G, M1, G1 ), diff --git a/pl/spy.yap b/pl/spy.yap index 0f0844b66..cb3149008 100644 --- a/pl/spy.yap +++ b/pl/spy.yap @@ -68,7 +68,7 @@ mode and the existing spy-points, when the debugger is on. '__NB_setval__'('$if_skip_mode',no_skip), '__NB_setval__'('$spy_glist',[]), '__NB_setval__'('$spy_gn',1), - '__NB_setval__'('$debug_state', state(creep,0,stop)). + '__NB_setval__'('$debug_state', state(zip,0,stop,off)). % First part : setting and reseting spy points @@ -220,8 +220,9 @@ debug :- ; set_prolog_flag(debug, false) ), -'__NB_getval__'('$trace',Trace, fail), - '__NB_setval__'('$debug_state',state(creep,0,stop,Trace) ). + '__NB_getval__'('$trace',Trace, fail), + ( Trace == on -> Creep = crep; Creep = zip ), + '__NB_setval__'('$debug_state',state(Creep,0,stop,Trace) ). nodebug :- '$init_debugger', diff --git a/pl/top.yap b/pl/top.yap index 8031ca654..8efc4a306 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -1021,7 +1021,7 @@ log_event( String, Args ) :- DBON = true -> ( - '__NB_getval__'('$debug_status',state(_, _, _,on), fail), + '__NB_getval__'('$debug_status',state(_, _, _, _,on), fail), ( var(LF) -> From 9156b90b666473445f4a33ba45b29d8e325b7eb7 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 1 Apr 2019 13:40:17 +0100 Subject: [PATCH 100/101] bfgs --- packages/ProbLog/problog/lbdd.yap | 5 +- .../problog_examples/learn_graph_lbdd.pl | 2 +- packages/ProbLog/problog_lbfgs.yap | 60 +++++++++++-------- 3 files changed, 38 insertions(+), 29 deletions(-) diff --git a/packages/ProbLog/problog/lbdd.yap b/packages/ProbLog/problog/lbdd.yap index 7a9a920f4..1b572c9b2 100644 --- a/packages/ProbLog/problog/lbdd.yap +++ b/packages/ProbLog/problog/lbdd.yap @@ -79,10 +79,7 @@ bind_maplist([Node-(Node-Pr)|MapList], Slope, X) :- get_prob(Node, Prob) :- get_fact_probability(Node,Prob). -gradient(QueryID, l, Slope) :- - probability( QueryID, Slope, Prob), - assert(query_probability_intern(QueryID,Prob)), - fail. + gradient(_QueryID, l, _). /* query_probability(21,6.775948e-01). */ diff --git a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl index c91e644ac..688f2ea9e 100644 --- a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl +++ b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl @@ -17,7 +17,7 @@ :- use_module('../problog_lbfgs'). - :- if(true). + :- if(false). :- use_module('kbgraph'). diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index 1f57be808..a5fd499a9 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -238,7 +238,7 @@ :- dynamic(values_correct/0). :- dynamic(learning_initialized/0). :- dynamic(current_iteration/1). -:- dynamic(solver_iteration/1). +:- dynamic(solver_iterations/2). :- dynamic(example_count/1). :- dynamic(query_probability_intern/2). %:- dynamic(query_gradient_intern/4). @@ -263,28 +263,15 @@ user:test_example(A,B,C,=) :- user:test_example(A,B,C), \+ user:problog_discard_example(B). -solver_iteration(0). +solver_iterations(0,0). %======================================================================== %= store the facts with the learned probabilities to a file %======================================================================== -save_model(X):- - problog_flag(sigmoid_slope,Slope), - current_iteration(Iteration), - solver_iteration(LBFGSIteration), - Id is Iteration*100+LBFGSIteration, - create_factprobs_file_name(Id,Filename), - retractall( query_probability_intern(_,_)), - forall( - user:example(QueryID,_Query,_QueryProb), - (recorded(QueryID,BDD,_), - BDD = bdd(_,_,MapList), - bind_maplist(MapList, Slope, X), - query_probabilities( BDD, BDDProb), - assert( query_probability_intern(QueryID,BDDProb))) - ), - export_facts(Filename). +save_model:- + current_iteration(Id), + create_factprobs_file_name(Id,Filename), export_facts(Filename). @@ -900,19 +887,44 @@ wrap( _X, _Grad, _GradCount). user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_CurrentIteration,_Ls,-1) :- FX < 0, !, format('stopped on bad FX=~4f~n',[FX]). -user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N, LBFGSIteration,Ls,0) :- +user:progress(FX,X,G,X_Norm,G_Norm,Step,_N, LBFGSIteration,Ls,0) :- problog_flag(sigmoid_slope,Slope), - forall( - tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)), + save_state(X, Slope, G), logger_set_variable(mse_trainingset, FX), - retractall(solver_iterations(_)), - assert(solver_iterations(LBFGSIteration)), - save_model(X), + (retract(solver_iterations(SI,_)) -> true ; SI = 0), + (retract(current_iteration(TI)) -> true ; TI = 0), + SI1 is SI+1, + TI1 is TI+1, + assert(current_iteration(TI1)), + assert(solver_iterations(SI1,LBFGSIteration)), + save_model, X0 <== X[0], sigmoid(X0,Slope,P0), X1 <== X[1], sigmoid(X1,Slope,P1), format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[LBFGSIteration,P0,P1,FX,X_Norm,G_Norm,Step,Ls]). +save_state(X,Slope,_Grad) :- + tunable_fact(FactID,_GroundTruth), + set_tunable(FactID,Slope,X), + fail. +save_state(X, Slope, _) :- + user:example(QueryID,_Query,_QueryProb), + recorded(QueryID,BDD,_), + BDD = bdd(_,_,MapList), + bind_maplist(MapList, Slope, X), + query_probabilities( BDD, BDDProb), + assert( query_probability_intern(QueryID,BDDProb)), + fail. +save_state(X, Slope, _) :- + user:test_example(QueryID,_Query,_QueryProb), + recorded(QueryID,BDD,_), + BDD = bdd(_,_,MapList), + bind_maplist(MapList, Slope, X), + query_probabilities( BDD, BDDProb), + assert( query_probability_intern(QueryID,BDDProb)), + fail. +save_state(_X, _Slope, _). + %======================================================================== %= initialize the logger module and set the flags for learning %= don't change anything here! use set_problog_flag/2 instead From 63a514cad5e93d6942be028af700e3c3650637e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 2 Apr 2019 10:27:37 +0100 Subject: [PATCH 101/101] yap4r --- packages/real/CMakeLists.txt | 32 ++++--- packages/real/real.c | 56 ++---------- packages/real/real.h | 114 ++++++++++++------------ packages/real/yap4r/NAMESPACE | 6 +- packages/real/yap4r/R/RcppExports.R | 19 ---- packages/real/yap4r/R/zzz.R | 15 ++++ packages/real/yap4r/src/Makevars.in | 8 +- packages/real/yap4r/src/RcppExports.cpp | 48 ---------- packages/real/yap4r/src/yap4r.cpp | 75 ++++++++-------- 9 files changed, 143 insertions(+), 230 deletions(-) delete mode 100644 packages/real/yap4r/R/RcppExports.R create mode 100644 packages/real/yap4r/R/zzz.R diff --git a/packages/real/CMakeLists.txt b/packages/real/CMakeLists.txt index 342510d4d..20c2641e6 100644 --- a/packages/real/CMakeLists.txt +++ b/packages/real/CMakeLists.txt @@ -1,6 +1,15 @@ # PROJECT ( YAP_REAL C ) + set(YAP4R_SOURCES + yap4r/man/yap4r-package.Rd +yap4r/R/zzz.R +yap4r/NAMESPACE +yap4r/DESCRIPTION +yap4r/src/yap4r.cpp +yap4r/src/RcppExports.cpp +) + set(REAL_SOURCES real.c) # LIBR_FOUND @@ -16,10 +25,10 @@ set_package_properties(R PROPERTIES URL "https://www.r-project.org/") -foreach(f ${FILES}) +foreach(f ${YAP4R_SOURCES}) add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/${f} COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/${f} ${CMAKE_CURRENT_BINARY_DIR}/${f} - DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/${f} + DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/${f} ) list(APPEND OUTS ${CMAKE_CURRENT_BINARY_DIR}/${f} ) endforeach() @@ -28,12 +37,14 @@ add_custom_target(YAP4R WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} DEPENDS ${OUTS} ) + add_library(real ${REAL_SOURCES}) target_link_libraries (real ${LIBR_LIBRARIES} libYap) include_directories ( ${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_BINARY_DIR} ${CMAKE_SOURCE_DIR}/include + ${CMAKE_CURRENT_SOURCE_DIR} ${LIBR_INCLUDE_DIRS} ) @@ -51,21 +62,8 @@ include_directories ( configure_file ("yap4r/src/Makevars.in" "yap4r/src/Makevars" ) - set(YAP4R_SOURCES - yap4r/man/yap4r-package.Rd -yap4r/R -yap4r/R/RcppExports.R -yap4r/NAMESPACE -yap4r/DESCRIPTION -yap4r/src -yap4r/src/Makevars.in -yap4r/src/yap4r.cpp -yap4r/src/RcppExports.cpp -) - - - - + add_dependencies(real YAP4R) + install(TARGETS real RUNTIME DESTINATION ${YAP_INSTALL_LIBDIR} ARCHIVE DESTINATION ${YAP_INSTALL_LIBDIR} diff --git a/packages/real/real.c b/packages/real/real.c index 5a08e092d..d0d4706ae 100644 --- a/packages/real/real.c +++ b/packages/real/real.c @@ -16,59 +16,24 @@ */ #define CSTACK_DEFNS #include "rconfig.h" -#if HAVE_R_H || !defined(_YAP_NOT_INSTALLED_) + #include #undef ERROR #if HAVE_R_EMBEDDED_H #include #endif -#include -#include #if HAVE_R_INTERFACE_H #include #define R_SIGNAL_HANDLERS 1 #endif -#include +#include + #include #include #include +#include -bool R_isNull(SEXP sexp); - -#if DEBUG_MEMORY -#define PROTECT_AND_COUNT(EXP) \ - { \ - extern int R_PPStackTop; \ - PROTECT(EXP); \ - nprotect++; \ - printf("%s:%d +%d=%d\n", __FUNCTION__, __LINE__, nprotect, R_PPStackTop); \ - } -#define Ureturn \ - { \ - extern int R_PPStackTop; \ - printf("%s:%d -%d=%d\n", __FUNCTION__, __LINE__, nprotect, \ - R_PPStackTop - nprotect); \ - } \ - unprotect(nprotect); \ - return -#else -#define PROTECT_AND_COUNT(EXP) \ - { \ - PROTECT(EXP); \ - nprotect++; \ - } -#define Ureturn \ - unprotect(nprotect); \ - return -#endif - -// #define PL_free(v) - -static inline SEXP protected_tryEval(SEXP expr, SEXP env, int *errp) { - SEXP o; - o = R_tryEval(expr, env, errp); - return o ? o : expr; -} +#include "real.h" static atom_t ATOM_break; static atom_t ATOM_false; @@ -106,9 +71,6 @@ static functor_t FUNCTOR_while2; X_API install_t install_real(void); -static SEXP term_to_sexp(term_t t, bool eval); -static int sexp_to_pl(term_t t, SEXP s); - #define PL_R_BOOL (1) /* const char * */ #define PL_R_CHARS (2) /* const char * */ #define PL_R_INTEGER (3) /* int */ @@ -491,7 +453,7 @@ static int merge_dots(term_t t) { } // put t in ans[index]; and stores elements of type objtype -static int term_to_S_el(term_t t, int objtype, size_t index, SEXP ans) { +int term_to_S_el(term_t t, int objtype, size_t index, SEXP ans) { switch (objtype) { case PL_R_CHARS: case PL_R_PLUS: { @@ -1226,7 +1188,7 @@ static int pl_to_binary(const char *s, term_t t, term_t tmp, SEXP *ansP) { * * @return whether it succeeds or fails. */ -static SEXP(term_to_sexp(term_t t, bool eval)) { +SEXP term_to_sexp(term_t t, bool eval) { int nprotect = 0; SEXP ans = R_NilValue; int objtype; @@ -1671,8 +1633,7 @@ static int bind_sexp(term_t t, SEXP sexp) { /******************************* * SEXP --> Prolog * *******************************/ - -static int sexp_to_pl(term_t t, SEXP s) { +bool sexp_to_pl(term_t t, SEXP s) { int rank = sexp_rank(s); size_t shape[256]; @@ -2225,6 +2186,5 @@ install_real(void) { /* FUNCTOR_dot2 = PL_new_functor(PL_new_atom("."), 2); */ PL_register_foreign("is_R_variable", 1, is_R_variable, 0); } -#endif /* R_H */ /// @} diff --git a/packages/real/real.h b/packages/real/real.h index 8b0984e89..c3792110a 100644 --- a/packages/real/real.h +++ b/packages/real/real.h @@ -1,68 +1,64 @@ -#include -#include -#include -#include -#include + +/** + * @file real.h + * @date Sat May 19 13:44:04 2018 + * + * @brief Prolog to R interface + * + * + */ -#include -#include +#ifdef __cplusplus +extern "C"{ +#endif + +bool R_isNull(SEXP sexp); -#define BUFSIZE 256 +#if DEBUG_MEMORY +#define PROTECT_AND_COUNT(EXP) \ + { \ + extern int R_PPStackTop; \ + PROTECT(EXP); \ + nprotect++; \ + printf("%s:%d +%d=%d\n", __FUNCTION__, __LINE__, nprotect, R_PPStackTop); \ + } +#define Ureturn \ + { \ + extern int R_PPStackTop; \ + printf("%s:%d -%d=%d\n", __FUNCTION__, __LINE__, nprotect, \ + R_PPStackTop - nprotect); \ + } \ + unprotect(nprotect); \ + return +#else +#define PROTECT_AND_COUNT(EXP) \ + { \ + PROTECT(EXP); \ + nprotect++; \ + } +#define Ureturn \ + unprotect(nprotect); \ + return +#endif -typedef unsigned int PL_Type; +// #define PL_free(v) -#define PL_Nil 0 -#define PL_Var 1 -#define PL_Atom 2 -#define PL_Appl 3 -#define PL_Pair 4 -#define PL_Int 5 -#define PL_Float 6 -#define PL_DbRef 7 -#define PL_Unknown 8 +static inline SEXP protected_tryEval(SEXP expr, SEXP env, int *errp) { + SEXP o; + o = R_tryEval(expr, env, errp); + return o ? o : expr; +} + #ifndef term_t +#define term_t YAP_Int + #endif -typedef enum { - r_undefined, - r_double, - r_int, - r_character -} r_basic_types; + +extern bool sexp_to_pl(term_t t, SEXP s); +extern SEXP term_to_sexp(term_t t, bool eval); -typedef struct -{ - r_basic_types type; - union { - int int_val; - double double_val; - char *char_val; - } real_u; -} list_cell; +#ifdef __cplusplus +} +#endif -typedef struct -{ - int size; - int nDims; - int dims[BUFSIZE]; - list_cell values[BUFSIZE]; -} list; - -#define real_Int 1 -#define real_Float 2 -#define real_Char 3 -#define real_Bool 4 - -#define real_ty_Vector 1 -#define real_ty_Matrix 2 -#define real_ty_List 3 -#define real_ty_Array 4 //not used, yet - -extern void init_R(void); -extern void end_R(void); -extern void send_command(char * expression); -extern int set_list_values(void); -extern int set_vec_values(void); -extern int set_array_values(void); -extern SEXP process_expression(char * expression); -extern YAP_Term sexp_pl(SEXP s); diff --git a/packages/real/yap4r/NAMESPACE b/packages/real/yap4r/NAMESPACE index a97033a02..7e69d01ea 100644 --- a/packages/real/yap4r/NAMESPACE +++ b/packages/real/yap4r/NAMESPACE @@ -1,3 +1,5 @@ -useDynLib(yap4r, .registration=TRUE) exportPattern("^[[:alpha:]]+") -importFrom(Rcpp, evalCpp) +import(Rcpp) +useDynLib(yap4r, .registration=TRUE) + + diff --git a/packages/real/yap4r/R/RcppExports.R b/packages/real/yap4r/R/RcppExports.R deleted file mode 100644 index 1c03a2ce6..000000000 --- a/packages/real/yap4r/R/RcppExports.R +++ /dev/null @@ -1,19 +0,0 @@ -# Generated by using Rcpp::compileAttributes() -> do not edit by hand -# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -query <- function(p_name, p_module, sexp) { - .Call(`_yap4r_query`, p_name, p_module, sexp) -} - -next <- function() { - .Call(`_yap4r_next`) -} - -cut <- function() { - .Call(`_yap4r_cut`) -} - -ask <- function(i) { - .Call(`_yap4r_ask`, i) -} - diff --git a/packages/real/yap4r/R/zzz.R b/packages/real/yap4r/R/zzz.R new file mode 100644 index 000000000..2fdc83886 --- /dev/null +++ b/packages/real/yap4r/R/zzz.R @@ -0,0 +1,15 @@ + +## Up until R 2.15.0, the require("methods") is needed but (now) +## triggers an warning from R CMD check +#.onLoad <- function(libname, pkgname){ +# #require("methods") ## needed with R <= 2.15.0 +# loadRcppModules() +#} + + +## For R 2.15.1 and later this also works. Note that calling loadModule() triggers +## a load action, so this does not have to be placed in .onLoad() or evalqOnLoad(). +loadModule("mod_yap4r", TRUE) + + + diff --git a/packages/real/yap4r/src/Makevars.in b/packages/real/yap4r/src/Makevars.in index 709fa07d5..18c55bee1 100644 --- a/packages/real/yap4r/src/Makevars.in +++ b/packages/real/yap4r/src/Makevars.in @@ -1,2 +1,6 @@ -PKG_LIBS=-L${YAP_LIBDIR} -L${YAP_DLLDIR} -L ../../.. -lreal -lYap -PKG_CPPFLAGS=-I${YAP_SOURCE_DIR}/CXX -I${YAP_BINARY_DIR} -I${YAP_SOURCE_DIR}/include -I${YAP_SOURCE_DIR}/H -I${YAP_SOURCE_DIR}/OPTYap -I${YAP_SOURCE_DIR}/os -I../.. +PKG_LIBS=-Wl,-rpath=${YAP_LIBDIR} -Wl,-rpath=${YAP_DLLDIR} \ + -L${YAP_LIBDIR} -L${YAP_DLLDIR} -lreal -lYAP++ -lYap +PKG_CXXFLAGS=-I${YAP_SOURCE_DIR}/CXX -I${YAP_BINARY_DIR}\ + -I${YAP_SOURCE_DIR}/include -I${YAP_SOURCE_DIR}/H\ + -I${YAP_SOURCE_DIR}/OPTYap -I${YAP_SOURCE_DIR}/os\ + -I../.. -I${YAP_SOURCE_DIR}/utf8proc -I${YAP_SOURCE_DIR}/packages/real diff --git a/packages/real/yap4r/src/RcppExports.cpp b/packages/real/yap4r/src/RcppExports.cpp index d44a30492..02ffefcff 100644 --- a/packages/real/yap4r/src/RcppExports.cpp +++ b/packages/real/yap4r/src/RcppExports.cpp @@ -5,58 +5,10 @@ using namespace Rcpp; -// query -bool query(std::string p_name, std::string p_module, SEXP sexp); -RcppExport SEXP _yap4r_query(SEXP p_nameSEXP, SEXP p_moduleSEXP, SEXP sexpSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< std::string >::type p_name(p_nameSEXP); - Rcpp::traits::input_parameter< std::string >::type p_module(p_moduleSEXP); - Rcpp::traits::input_parameter< SEXP >::type sexp(sexpSEXP); - rcpp_result_gen = Rcpp::wrap(query(p_name, p_module, sexp)); - return rcpp_result_gen; -END_RCPP -} -// next -bool next(); -RcppExport SEXP _yap4r_next() { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - rcpp_result_gen = Rcpp::wrap(next()); - return rcpp_result_gen; -END_RCPP -} -// cut -bool cut(); -RcppExport SEXP _yap4r_cut() { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - rcpp_result_gen = Rcpp::wrap(cut()); - return rcpp_result_gen; -END_RCPP -} -// ask -SEXP ask(int i); -RcppExport SEXP _yap4r_ask(SEXP iSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< int >::type i(iSEXP); - rcpp_result_gen = Rcpp::wrap(ask(i)); - return rcpp_result_gen; -END_RCPP -} RcppExport SEXP _rcpp_module_boot_mod_yap4r(); static const R_CallMethodDef CallEntries[] = { - {"_yap4r_query", (DL_FUNC) &_yap4r_query, 3}, - {"_yap4r_next", (DL_FUNC) &_yap4r_next, 0}, - {"_yap4r_cut", (DL_FUNC) &_yap4r_cut, 0}, - {"_yap4r_ask", (DL_FUNC) &_yap4r_ask, 1}, {"_rcpp_module_boot_mod_yap4r", (DL_FUNC) &_rcpp_module_boot_mod_yap4r, 0}, {NULL, NULL, 0} }; diff --git a/packages/real/yap4r/src/yap4r.cpp b/packages/real/yap4r/src/yap4r.cpp index 16ecd9820..26b6cffbd 100644 --- a/packages/real/yap4r/src/yap4r.cpp +++ b/packages/real/yap4r/src/yap4r.cpp @@ -6,13 +6,14 @@ #include #include +#include #include "real.h" using namespace Rcpp; -class YAP4R { +class yap4r { YAPEngine *yap; YAPQuery *q; @@ -20,74 +21,78 @@ class YAP4R { bool failed; public: -//[[Rcpp::export]] + yap4r(); + bool query(std::string p_name,std::string p_module,Rcpp::GenericVector sexps); + bool more(); + bool done(); + SEXP peek(int i); +}; -YAP4R() { + yap4r::yap4r() { YAPEngineArgs *yargs = new YAPEngineArgs(); yap = new YAPEngine(yargs); }; -//[[Rcpp::export]] -bool query(std::string p_name,std::string p_module, SEXP sexp) { + + + bool yap4r::query(std::string p_name,std::string p_module,Rcpp::GenericVector sexps) { - YAPPairTerm tmp; if (q) { q->close(); q = NULL; } - if (!sexp_to_pl(tmp.handle(), sexp)) - return false; - args = tmp.listToVector(); - YAPTerm ts[1], hd; + std::vector args = std::vector(); + yhandle_t sls = Yap_NewHandles(sexps.length()); + for (int i=0; inext(); if (!rc) { failed = true; } return rc; } -//[[Rcpp::export]] - bool cut() { - bool rc = true; + + bool yap4r::done() { + if (failed) return false; if (q) - rc = cut(); + q->cut(); q = NULL; - return rc; - }; + return true; + } -//[[Rcpp::export]] - SEXP ask(int i) { + + SEXP yap4r::peek(int i) { if (failed || q==nullptr) return R_MissingArg; - return term_to_sexp(YAPTerm(Yap_XREGS[i]).handle(), false); - }; + return term_to_sexp(Yap_InitSlot(Yap_XREGS[i]), false); + } - -}; - RCPP_MODULE(mod_yap4r) { - Rcpp::class_( "YAP4R" ) - .constructor("documentation for default constructor") - .method( "query", &YAP4R::query ) -.method( "next", &YAP4R::next ) -.method( "ask", &YAP4R::ask ) -.method( "cut", &YAP4R::cut ) - ; -; + class_( "yap4r" ) + .constructor("create an object encapsulating a Prolog engine") + .method( "query", &yap4r::query, "create an active query within the engine") + .method( "more", &yap4r::more, "ask for an extra solution") + .method( "done", &yap4r::done, "terminate the query") + .method( "peek", &yap4r::peek, "load arg[i] into R") + ; }