From 85a88feb6f3d80ca9c551f485766ec280b235b20 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 26 Aug 2016 15:23:37 -0500 Subject: [PATCH 1/6] fix assert/2 given name chancge --- library/tries/core_tries.h | 10 +++++----- pl/preddyns.yap | 18 +++++++++--------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/library/tries/core_tries.h b/library/tries/core_tries.h index 5608c907c..cced2cb4a 100644 --- a/library/tries/core_tries.h +++ b/library/tries/core_tries.h @@ -51,7 +51,7 @@ #define TRIE_PRINT_FLOAT2 2 #define TRIE_PRINT_FLOAT_END 3 -#define BASE_AUXILIARY_TERM_STACK_SIZE 10000 +#define BASE_AUXILIARY_TERM_STACK_SIZE 100000 @@ -138,13 +138,13 @@ typedef struct trie_hash { #define MkTrieVar(INDEX) ((INDEX) << 4) #define TrieVarIndex(TERM) ((TERM) >> 4) -#define BASE_HASH_BUCKETS 64 -#define MAX_NODES_PER_TRIE_LEVEL 8 +#define BASE_HASH_BUCKETS 256 +#define MAX_NODES_PER_TRIE_LEVEL 32 #define MAX_NODES_PER_BUCKET (MAX_NODES_PER_TRIE_LEVEL / 2) #define HASH_TERM(TERM, SEED) (((TERM) >> 4) & (SEED)) #define IS_HASH_NODE(NODE) (TrHash_mark(NODE) == NULL) -#define BASE_SAVE_MARK 1000 /* could lead to errors if the number of different variables in a term is greater than it */ +#define BASE_SAVE_MARK 10000 /* could lead to errors if the number of different variables in a term is greater than it */ #define HASH_SAVE_MARK ((YAP_Term) MkTrieVar(BASE_SAVE_MARK)) #define ATOM_SAVE_MARK ((YAP_Term) MkTrieVar(BASE_SAVE_MARK + 1)) #define FUNCTOR_SAVE_MARK ((YAP_Term) MkTrieVar(BASE_SAVE_MARK + 2)) @@ -165,7 +165,7 @@ typedef struct trie_hash { #define PUSH_DOWN(STACK, ITEM, STACK_TOP) \ { if (STACK > STACK_TOP) { \ fprintf(stderr, "**************************************\n"); \ - fprintf(stderr, " Tries core module: term stack full\n"); \ + fprintf(stderr, " Tries core module: term stack empty\n"); \ fprintf(stderr, "**************************************\n"); \ } \ *STACK = (YAP_Term)(ITEM); \ diff --git a/pl/preddyns.yap b/pl/preddyns.yap index 71a48c5d1..95f5e7091 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -64,7 +64,7 @@ declared dynamic. */ asserta(Clause, Ref) :- - '$assert'(Clause, first, Ref). + '$assert'(Clause, asserta, Ref). /** @pred assertz(+ _C_,- _R_) @@ -77,7 +77,7 @@ declared dynamic. */ assertz(Clause, Ref) :- - '$assert'(Clause, last, Ref). + '$assert'(Clause, assertz, Ref). /** @pred assert(+ _C_,- _R_) @@ -90,14 +90,14 @@ declared dynamic. */ assert(Clause, Ref) :- - '$assert'(Clause, last, Ref). + '$assert'(Clause, assertz, Ref). '$assertz_dynamic'(X, C, C0, Mod) :- (X/\4)=:=0, !, '$head_and_body'(C,H,B), - '$assertat_d'(last,H,B,C0,Mod,_). + '$assertat_d'(assertz,H,B,C0,Mod,_). '$assertz_dynamic'(X,C,C0,Mod) :- '$head_and_body'(C,H,B), functor(H,N,A), @@ -110,7 +110,7 @@ assert(Clause, Ref) :- ; true ), - '$assertat_d'(last,H,B,C0,Mod,_). + '$assertat_d'(assertz,H,B,C0,Mod,_). '$remove_all_d_clauses'(H,M) :- @@ -129,8 +129,8 @@ assert(Clause, Ref) :- fail. '$erase_all_mf_dynamic'(_,_,_). -'$assertat_d'(first,Head,Body,C0,Mod,R) :- !, - '$compile_dynamic'((Head:-Body), first, C0, Mod, CR), +'$assertat_d'(asserta,Head,Body,C0,Mod,R) :- !, + '$compile_dynamic'((Head:-Body), asserta, C0, Mod, CR), ( get_value('$abol',true) -> '$predicate_flags'(Head,Mod,Fl,Fl), @@ -147,8 +147,8 @@ assert(Clause, Ref) :- ; true ). -'$assertat_d'(last,Head,Body,C0,Mod,R) :- - '$compile_dynamic'((Head:-Body), last, C0, Mod, CR), +'$assertat_d'(assertz,Head,Body,C0,Mod,R) :- + '$compile_dynamic'((Head:-Body), assertz, C0, Mod, CR), ( get_value('$abol',true) -> '$predicate_flags'(Head,Mod,Fl,Fl), From 2bbc3b926542b2998da0057bb7f3a64fc05fb05a Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 22 Sep 2016 21:53:42 -0500 Subject: [PATCH 2/6] rrors --- C/errors.c | 9 ++++--- C/exec.c | 12 +++++++++- CXX/yapi.cpp | 47 +++++++++++++++++++++--------------- CXX/yapie.hh | 2 ++ cmake/Config.cmake | 1 + config.h.cmake | 3 +++ include/YapError.h | 2 ++ include/YapErrors.h | 1 + packages/python/yapex.py | 11 ++++++++- packages/swig/yap.i | 52 +++++++++++++++++++++------------------- 10 files changed, 91 insertions(+), 49 deletions(-) diff --git a/C/errors.c b/C/errors.c index 824048465..dba801a01 100755 --- a/C/errors.c +++ b/C/errors.c @@ -266,7 +266,8 @@ static char tmpbuf[YAP_BUF_SIZE]; } #define END_ERROR_CLASSES() \ - } \ + } \ + return TermNil; \ } #define BEGIN_ERRORS() \ @@ -291,7 +292,7 @@ static char tmpbuf[YAP_BUF_SIZE]; return mkerrorct(B, ts); #define END_ERRORS() \ - } \ + } return TermNil; \ } #include "YapErrors.h" @@ -347,7 +348,9 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, Yap_RestartYap(1); } LOCAL_ActiveError.errorNo = type; - LOCAL_ActiveError.errorClass = Yap_errorClass(LOCAL_ActiveError.errorNo); + LOCAL_ActiveError.errorAsText = Yap_LookupAtom(Yap_errorName( type )); + LOCAL_ActiveError.errorClass = Yap_errorClass( type); + LOCAL_ActiveError.classAsText = Yap_LookupAtom(Yap_errorClassName( LOCAL_ActiveError.errorClass )); LOCAL_ActiveError.errorLine = lineno; LOCAL_ActiveError.errorFunction = function; LOCAL_ActiveError.errorFile = file; diff --git a/C/exec.c b/C/exec.c index a235a3ffa..41906519b 100755 --- a/C/exec.c +++ b/C/exec.c @@ -2074,8 +2074,18 @@ static Int jump_env(USES_REGS1) { Yap_Error(INSTANTIATION_ERROR, t, "throw ball must be bound"); return false; } else if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorError) { + Term t2; + Yap_find_prolog_culprit(PASS_REGS1); - LOCAL_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_TYPE = ERROR_EVENT; + t = ArgOfTerm(1, t); + if (IsApplTerm(t) && IsAtomTerm((t2 = ArgOfTerm(1,t)))) { + LOCAL_ActiveError.errorAsText = AtomOfTerm(t2); + LOCAL_ActiveError.classAsText = NameOfFunctor(t); + } else if (IsAtomTerm(t)) { + LOCAL_ActiveError.errorAsText = AtomOfTerm(t); + LOCAL_ActiveError.classAsText = NULL; + } } else { LOCAL_Error_TYPE = THROW_EVENT; } diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index 10ebd22be..e74278ec0 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -1,6 +1,7 @@ #define YAP_CPP_INTERFACE 1 +#include #include "yapi.hh" extern "C" { @@ -947,30 +948,38 @@ void *YAPPrologPredicate::retractClause(YAPTerm skeleton, bool all) { void *YAPPrologPredicate::clause(YAPTerm skeleton, YAPTerm &body) { return 0; } const char *YAPError::text() { + + char buf[256]; std::string s = ""; - if (LOCAL_ActiveError.prologPredLine) { - s += LOCAL_ActiveError.prologPredFile->StrOfAE; - s += ":"; - s += LOCAL_ActiveError.prologPredLine; - s += ":0 error "; - s += Yap_errorClassName(getErrorClass()); - s += "."; - s += Yap_errorName(getID()); - s += " in "; - s += LOCAL_ActiveError.prologPredModule; - s += ":"; - s += (LOCAL_ActiveError.prologPredName)->StrOfAE; - s += "/"; - s += LOCAL_ActiveError.prologPredArity; - s += "\n"; - } if (LOCAL_ActiveError.errorFunction) { s += LOCAL_ActiveError.errorFile; s += ":"; - s += LOCAL_ActiveError.errorLine; - s += ":0 C-code for error."; - s += "\n"; + sprintf(buf, "%ld", (long int)LOCAL_ActiveError.errorLine); + s += buf; + s += ":0 in C-code"; } + if (LOCAL_ActiveError.prologPredLine) { + s += "\n" ; + s+= LOCAL_ActiveError.prologPredFile->StrOfAE ; + s+= ":" ; + sprintf(buf, "%ld", (long int)LOCAL_ActiveError.prologPredLine); + s+= buf; // std::to_string(LOCAL_ActiveError.prologPredLine) ; + // YAPIntegerTerm(LOCAL_ActiveError.prologPredLine).text(); + s+= ":0 " ; + s+= LOCAL_ActiveError.prologPredModule ; + s+= ":" ; + s+= (LOCAL_ActiveError.prologPredName)->StrOfAE ; + s+= "/" ; + sprintf(buf, "%ld", (long int)LOCAL_ActiveError.prologPredArity); + s+= // std::to_string(LOCAL_ActiveError.prologPredArity); + buf; + } + s += " error "; + if (LOCAL_ActiveError.classAsText != nullptr) + s += LOCAL_ActiveError.classAsText->StrOfAE; + s += "."; + s += LOCAL_ActiveError.errorAsText->StrOfAE; + s += ".\n"; if (LOCAL_ActiveError.errorTerm) { Term t = Yap_PopTermFromDB(LOCAL_ActiveError.errorTerm); if (t) { diff --git a/CXX/yapie.hh b/CXX/yapie.hh index 1a2374f39..f85723bb9 100644 --- a/CXX/yapie.hh +++ b/CXX/yapie.hh @@ -7,6 +7,8 @@ class YAPTerm; /// take information on a Prolog error: class YAPError { + std::string name, errorClass, info; + int swigcode; public: /// error handling when receiving the error term diff --git a/cmake/Config.cmake b/cmake/Config.cmake index b2f59a456..9c0abcae4 100644 --- a/cmake/Config.cmake +++ b/cmake/Config.cmake @@ -345,6 +345,7 @@ check_function_exists(strcasestr HAVE_STRCASESTR) check_function_exists(strchr HAVE_STRCHR) check_function_exists(strerror HAVE_STRERROR) check_function_exists(stricmp HAVE_STRICMP) +check_function_exists(strlcpy HAVE_STRLCPY) check_function_exists(strlwr HAVE_STRLWR) check_function_exists(strncasecmp HAVE_STRNCASECMP) check_function_exists(strncat HAVE_STRNCAT) diff --git a/config.h.cmake b/config.h.cmake index 02f74bf2b..baf479b92 100644 --- a/config.h.cmake +++ b/config.h.cmake @@ -2011,6 +2011,9 @@ calls it, or to nothing if 'inline' is not supported under any name. */ #endif #endif +#ifndef HAVE_STRLCPY +#define strlcpy(X,Y,Z) strcpy(X,Y) +#endif //#define DEBUG_MALLOC 1 #if DEBUG_MALLOC diff --git a/include/YapError.h b/include/YapError.h index 681c2ca6e..04e3351bf 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -178,6 +178,8 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi, typedef struct yap_error_descriptor { enum yap_error_status status; yap_error_class_number errorClass; + YAP_Atom errorAsText; + YAP_Atom classAsText; yap_error_number errorNo; YAP_Int errorLine; const char *errorFunction; diff --git a/include/YapErrors.h b/include/YapErrors.h index 7c8fe2692..a7969e5ad 100644 --- a/include/YapErrors.h +++ b/include/YapErrors.h @@ -148,6 +148,7 @@ E(SYSTEM_ERROR_JIT_NOT_AVAILABLE, SYSTEM_ERROR_CLASS, "jit_not_available") E(SYSTEM_ERROR_OPERATING_SYSTEM, SYSTEM_ERROR_CLASS, "operating_system_error") E(SYSTEM_ERROR_SAVED_STATE, SYSTEM_ERROR_CLASS, "saved_state_error") +E(ERROR_EVENT, EVENT, "error") E(ABORT_EVENT, EVENT, "abort") E(THROW_EVENT, EVENT, "throw") E(CALL_COUNTER_UNDERFLOW_EVENT, EVENT, "call_counter_underflow") diff --git a/packages/python/yapex.py b/packages/python/yapex.py index f42c58a4e..6bb9fb92e 100644 --- a/packages/python/yapex.py +++ b/packages/python/yapex.py @@ -20,10 +20,19 @@ class T(tuple): return str(self.name) + str(self.tuple) + def query_prolog(engine, s): + + def answer( q ): +# try: + return q.next() +# except yap.YAPPythonException e: +# print e.text() +# return False + q = engine.query(s) ask = True - while q.next(): + while answer(q): vs = q.namedVarsCopy() if vs: i = 0 diff --git a/packages/swig/yap.i b/packages/swig/yap.i index 9e91ad369..6cee68b1d 100644 --- a/packages/swig/yap.i +++ b/packages/swig/yap.i @@ -85,20 +85,23 @@ return *new YAPTerm(); // Language independent exception handler -%exception { +%exception next { try { $action - } catch (YAPError e) { + } catch (YAPError &e) { + yap_error_number en = e.getID(); + PyObject *pyerr = PyExc_RuntimeError; + + LOCAL_Error_TYPE = YAP_NO_ERROR; switch (e.getErrorClass()) { case YAPC_NO_ERROR: break; /// bad domain, "first argument often is the predicate. case DOMAIN_ERROR: { - yap_error_number en = e.getID(); switch (en) { case DOMAIN_ERROR_OUT_OF_RANGE: case DOMAIN_ERROR_NOT_LESS_THAN_ZERO: - PyErr_SetString(PyExc_IndexError, e.text()); + pyerr = PyExc_IndexError; break; case DOMAIN_ERROR_CLOSE_OPTION: case DOMAIN_ERROR_ENCODING: @@ -106,47 +109,45 @@ return *new YAPTerm(); case DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION: case DOMAIN_ERROR_READ_OPTION: case DOMAIN_ERROR_SET_STREAM_OPTION: - PyErr_SetString(PyExc_KeyError, e.text()); + pyerr = PyExc_KeyError; break; case DOMAIN_ERROR_FILE_ERRORS: case DOMAIN_ERROR_FILE_TYPE: case DOMAIN_ERROR_IO_MODE: case DOMAIN_ERROR_SOURCE_SINK: case DOMAIN_ERROR_STREAM_POSITION: - PyErr_SetString(PyExc_IOError, e.text()); + pyerr = PyExc_IOError; break; default: - PyErr_SetString(PyExc_ValueError, e.text()); + pyerr = PyExc_ValueError; } } break; /// bad arithmetic case EVALUATION_ERROR: { - yap_error_number en = e.getID(); switch (en) { case EVALUATION_ERROR_FLOAT_OVERFLOW: case EVALUATION_ERROR_INT_OVERFLOW: - PyErr_SetString(PyExc_OverflowError, e.text()); + pyerr = PyExc_OverflowError; break; case EVALUATION_ERROR_FLOAT_UNDERFLOW: case EVALUATION_ERROR_UNDERFLOW: case EVALUATION_ERROR_ZERO_DIVISOR: - PyErr_SetString(PyExc_ArithmeticError, e.text()); + pyerr = PyExc_ArithmeticError; break; default: - PyErr_SetString(PyExc_RuntimeError, e.text()); + pyerr = PyExc_RuntimeError; } } break; /// missing object (I/O mostly) case EXISTENCE_ERROR: - PyErr_SetString(PyExc_NotImplementedError, e.text()); + pyerr = PyExc_NotImplementedError; break; /// should be bound case INSTANTIATION_ERROR_CLASS: - PyErr_SetString(PyExc_RuntimeError, e.text()); + pyerr = PyExc_RuntimeError; break; /// bad access, I/O case PERMISSION_ERROR: { - yap_error_number en = e.getID(); switch (en) { case PERMISSION_ERROR_INPUT_BINARY_STREAM: case PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM: @@ -157,40 +158,42 @@ return *new YAPTerm(); case PERMISSION_ERROR_REPOSITION_STREAM: case PERMISSION_ERROR_OUTPUT_STREAM: case PERMISSION_ERROR_OUTPUT_TEXT_STREAM: - PyErr_SetString(PyExc_OverflowError, e.text()); + pyerr = PyExc_OverflowError; break; default: - PyErr_SetString(PyExc_RuntimeError, e.text()); + pyerr = PyExc_RuntimeError; } } break; /// something that could not be represented into a type case REPRESENTATION_ERROR: - PyErr_SetString(PyExc_RuntimeError, e.text()); + pyerr = PyExc_RuntimeError; break; /// not enough .... case RESOURCE_ERROR: - PyErr_SetString(PyExc_RuntimeError, e.text()); + pyerr = PyExc_RuntimeError; break; /// bad text case SYNTAX_ERROR_CLASS: - PyErr_SetString(PyExc_SyntaxError, e.text()); + pyerr = PyExc_SyntaxError; break; /// OS or internal case SYSTEM_ERROR_CLASS: - PyErr_SetString(PyExc_RuntimeError, e.text()); + pyerr = PyExc_RuntimeError; break; /// bad typing case TYPE_ERROR: - PyErr_SetString(PyExc_TypeError, e.text()); + pyerr = PyExc_TypeError; break; /// should be unbound case UNINSTANTIATION_ERROR_CLASS: - PyErr_SetString(PyExc_RuntimeError, e.text()); + pyerr = PyExc_RuntimeError; break; /// escape hatch default: break; } + PyErr_SetString(pyerr, e.text()); + return Py_False; } } @@ -203,12 +206,13 @@ return *new YAPTerm(); try { $action } catch (YAPError e) { +yap_error_number en = e.getID(); +LOCAL_ERROR_Type = YAP_NO_ERROR; switch (e.getErrorClass()) { case YAPC_NO_ERROR: break; /// bad domain, "first argument often is the predicate. case DOMAIN_ERROR: { - yap_error_number en = e.getID(); switch (en) { case DOMAIN_ERROR_OUT_OF_RANGE: case DOMAIN_ERROR_NOT_LESS_THAN_ZERO: @@ -235,7 +239,6 @@ return *new YAPTerm(); } break; /// bad arithmetic case EVALUATION_ERROR: { - yap_error_number en = e.getID(); switch (en) { case EVALUATION_ERROR_FLOAT_OVERFLOW: case EVALUATION_ERROR_FLOAT_UNDERFLOW: @@ -260,7 +263,6 @@ return *new YAPTerm(); break; /// bad access, I/O case PERMISSION_ERROR: { - yap_error_number en = e.getID(); switch (en) { case PERMISSION_ERROR_INPUT_BINARY_STREAM: case PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM: From f9655cccb694d24f17d600fa5214798e534b4a65 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 23 Sep 2016 01:21:42 -0500 Subject: [PATCH 3/6] error handling --- CXX/yapdb.hh | 4 ++-- packages/python/yapex.py | 10 +++++----- packages/swig/yap.i | 5 ++--- 3 files changed, 9 insertions(+), 10 deletions(-) diff --git a/CXX/yapdb.hh b/CXX/yapdb.hh index 97820bacb..ae8008325 100644 --- a/CXX/yapdb.hh +++ b/CXX/yapdb.hh @@ -136,7 +136,7 @@ protected: YAPPredicate(const char *s0, Term &out, Term &names) { CACHE_REGS BACKUP_MACHINE_REGS(); - Term *outp; + Term *modp = NULL;; out = Yap_StringToTerm(s0, strlen(s0) + 1, &LOCAL_encoding, 1200, &names); // extern char *s0; @@ -145,7 +145,7 @@ protected: // delete [] ns; if (out == 0L) throw YAPError(); - ap = getPred(out, outp); + ap = getPred(out, modp); RECOVER_MACHINE_REGS(); } diff --git a/packages/python/yapex.py b/packages/python/yapex.py index 6bb9fb92e..f27f88053 100644 --- a/packages/python/yapex.py +++ b/packages/python/yapex.py @@ -24,11 +24,11 @@ class T(tuple): def query_prolog(engine, s): def answer( q ): -# try: - return q.next() -# except yap.YAPPythonException e: -# print e.text() -# return False + try: + return q.next() + except Exception as e: + print( e.args[1] ) + return False q = engine.query(s) ask = True diff --git a/packages/swig/yap.i b/packages/swig/yap.i index 6cee68b1d..02ef5dfdf 100644 --- a/packages/swig/yap.i +++ b/packages/swig/yap.i @@ -96,7 +96,7 @@ return *new YAPTerm(); switch (e.getErrorClass()) { case YAPC_NO_ERROR: break; - /// bad domain, "first argument often is the predicate. + /// bad domain, "first argument often is the predicate. case DOMAIN_ERROR: { switch (en) { case DOMAIN_ERROR_OUT_OF_RANGE: @@ -193,8 +193,7 @@ return *new YAPTerm(); break; } PyErr_SetString(pyerr, e.text()); - return Py_False; - } + } } #else From cd3b94c40ce7eda4664c3d9ad3f09ddeb1c5cc1f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 23 Sep 2016 01:36:14 -0500 Subject: [PATCH 4/6] balance --- packages/real/real.c | 108 ++++++++++++++++++++----------------------- 1 file changed, 51 insertions(+), 57 deletions(-) diff --git a/packages/real/real.c b/packages/real/real.c index f25218aff..62e8baf0b 100644 --- a/packages/real/real.c +++ b/packages/real/real.c @@ -1,3 +1,4 @@ + #include "rconfig.h" #if HAVE_R_H || !defined(_YAP_NOT_INSTALLED_) #include @@ -17,19 +18,22 @@ bool R_isNull(SEXP sexp); -#if 1 // DEBUG_MEMORY -#define PROTECT_AND_COUNT(EXP) { PROTECT(EXP); nprotect++; printf("%d +%d\n",+ __LINE__,nprotect); } -#define Ureturn printf("%d -%d\n", __LINE__,nprotect); unprotect(nprotect); return +#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 = R_tryEval( expr, env, errp); - return o ? o : expr; + SEXP o; + o = R_tryEval( expr, env, errp); + return o ? o : expr; } static atom_t ATOM_break; @@ -236,7 +240,6 @@ setListElement(term_t t, SEXP s_str, SEXP sexp) PROTECT_AND_COUNT(call_R = lang3(R_DollarSymbol, list, name_R)); p = lang3(install("<-"), call_R, sexp); (void) protected_tryEval(p, R_GlobalEnv, &hadError); - UNPROTECT(nprotect); Ureturn TRUE; } @@ -983,16 +986,16 @@ pl_to_func( term_t t, bool eval) // first evaluate arguments left to right a = PL_new_term_ref(), a1 = PL_new_term_ref(); - PROTECT_AND_COUNT( c_R = allocList(arity+1) ); - call_R = c_R; + PROTECT_AND_COUNT( call_R = allocList(arity+1) ); + c_R = call_R ; c_R = CDR(c_R); for (i=0; i< arity;i ++) { if ( !PL_get_arg( i+ 1, t, a) ) { REAL_Error("argument access", t); - return R_NilValue; + { Ureturn R_NilValue; } } if ( PL_is_functor(a, FUNCTOR_equal2) ) { - char *s; + char *s = NULL; if (!PL_get_arg(1, a, a1)) { Ureturn FALSE; } if ( PL_is_pair( a1 ) || @@ -1115,7 +1118,6 @@ pl_to_defun( term_t t, SEXP *ansP) { Ureturn FALSE; } SET_BODY(clo_R, body_R); *ansP = clo_R; - UNPROTECT( nprotect ); Ureturn TRUE; } @@ -1173,7 +1175,8 @@ subset_to_sexp( term_t t, bool eval) } if ( PL_skip_list( a, b, &len ) != PL_LIST) { Ureturn R_NilValue; } - PROTECT_AND_COUNT(c_R = call_R = allocList(len+2)); + PROTECT_AND_COUNT(call_R = allocList(len+2)); + c_R = call_R; SETCAR(c_R, sin); SET_TYPEOF(c_R, LANGSXP); c_R = CDR(c_R); @@ -1185,6 +1188,7 @@ subset_to_sexp( term_t t, bool eval) SEXP ans; if (eval) { PROTECT_AND_COUNT( res_R = protected_tryEval(call_R, R_GlobalEnv, &ierror) ); + if (ierror) { Ureturn call_R; } ans = res_R; @@ -1222,9 +1226,9 @@ set_subset_eval( SEXP symbol, term_t a, SEXP lhs_R, SEXP sexp) } PROTECT_AND_COUNT(call_R = LCONS(symbol, CONS(lhs_R,index_R))); SET_TYPEOF(call_R, LANGSXP); - p = lang3(install("<-"), call_R, sexp); + PROTECT_AND_COUNT( p = lang3(install("<-"), call_R, sexp) ); (void) protected_tryEval(p, R_GlobalEnv, &hadError); - Ureturn hadError; + { Ureturn hadError; } } static int @@ -1317,10 +1321,11 @@ static SEXP term_t tmp = PL_copy_term_ref( t ); int rc; + objtype = REAL_term_type(tmp, 0); if (objtype & PL_R_VECTOR) { - PROTECT(ans = list_to_sexp( t, objtype ) ); + PROTECT_AND_COUNT(ans = list_to_sexp( t, objtype ) ); rc = ( ans != R_NilValue ) ; } else switch(objtype) @@ -1356,7 +1361,7 @@ static SEXP /// /// atoms can be evaluated case PL_R_SYMBOL: - { char *s; + { char *s = NULL; if ((rc = PL_get_chars(t, &s, CVT_ATOM|CVT_STRING|BUF_DISCARDABLE|REP_UTF8)) ) { @@ -1741,7 +1746,7 @@ bind_sexp(term_t t, SEXP sexp) } break; case PL_R_SYMBOL: - { char *s; + { char *s = NULL; if ( PL_get_chars(t, &s, CVT_ATOM|CVT_STRING|BUF_DISCARDABLE|REP_UTF8) ) { @@ -1770,9 +1775,7 @@ bind_sexp(term_t t, SEXP sexp) assert(0); } - UNPROTECT(nprotect); - - return TRUE; + { Ureturn TRUE; } } /* @@ -2067,21 +2070,18 @@ process_expression(const char * expression) { Sdprintf("Error: %d, in parsing R expression.\n", status ); /* do not continue with protected_tryEval() */ - UNPROTECT(nprotect); /* PL_unify_term(except, PL_FUNCTOR_CHARS, "r_expression_syntax_error", 2, PL_CHARS, expression, PL_R_INTEGER, status ); */ /*FIXME: return the expression too (as atom) */ /* PL_FUNCTOR_CHARS, "r_expression_syntax_error", 2, PL_CHARS, "atom", PL_TERM, to; */ /* return PL_raise_exception(except); */ - return NULL; + Ureturn NULL; } /* FIXME: Check status (nicos: it seems to be always 1 though? */ - val = protected_tryEval(VECTOR_ELT(e, 0), R_GlobalEnv, &hadError); - UNPROTECT(nprotect); - + PROTECT_AND_COUNT(val = protected_tryEval(VECTOR_ELT(e, 0), R_GlobalEnv, &hadError)); if ( !hadError ) - return val; - return NULL; + { Ureturn val; } + { Ureturn NULL; } } static foreign_t @@ -2171,7 +2171,7 @@ send_c_vector(term_t tvec, term_t tout) if (!ans) { Ureturn FALSE; } for (i = 0; i < arity; i++) { - char *str; + char *str = NULL; _PL_get_arg(i+1, tvec, targ); if ( PL_get_chars(targ, &str, CVT_ALL|BUF_DISCARDABLE|REP_UTF8) ) @@ -2217,27 +2217,26 @@ rexpr_to_pl_term(term_t in, term_t out) static foreign_t robj_to_pl_term(term_t name, term_t out) { char *plname; - + int nprotect = 0; + if ( PL_get_chars(name, &plname, CVT_ALL|BUF_DISCARDABLE|REP_UTF8) ) { SEXP s; - int nprotect = 0; term_t tmp = PL_new_term_ref(); int rc; PROTECT_AND_COUNT( s= findVar(install(plname), R_GlobalEnv) ); - nprotect ++; if (s == R_UnboundValue || TYPEOF(s)==SYMSXP) - return REAL_Error("r_variable", name); + { Ureturn REAL_Error("r_variable", name); } rc = sexp_to_pl(tmp, s); - UNPROTECT(nprotect); - if ( rc ) - return PL_unify(out, tmp); + if ( rc ) { + Ureturn PL_unify(out, tmp); + } } - return FALSE; + { Ureturn FALSE; } } static foreign_t @@ -2256,12 +2255,11 @@ set_R_variable(term_t rvar, term_t value) } if (vname) PL_free(vname); - UNPROTECT( nprotect ); - return rc; + Ureturn rc; } static foreign_t -execute_R_1(term_t value) +execute_R_1(term_t value ) { SEXP sexp; foreign_t rc = FALSE; int nprotect = 0; @@ -2271,14 +2269,13 @@ execute_R_1(term_t value) PROTECT_AND_COUNT( sexp = term_to_sexp(value, TRUE) ); rc = !Rf_isNull(sexp); if (rc) { - sexp = protected_tryEval(sexp, R_GlobalEnv, &hadError); + PROTECT_AND_COUNT( sexp = protected_tryEval(sexp, R_GlobalEnv, &hadError) ); if (hadError) { - UNPROTECT( nprotect ); - return false; + Ureturn false; } - } UNPROTECT( nprotect ); - return rc; + } + Ureturn rc; } static foreign_t @@ -2287,21 +2284,19 @@ execute_R(term_t rvar, term_t value) foreign_t rc = FALSE; term_t t1 = PL_new_term_ref(); int nprotect = 0; - PROTECT_AND_COUNT(R_GlobalEnv); - PROTECT_AND_COUNT( sexp = term_to_sexp(value, true) ); //PROTECT_AND_COUNT( sexp = protected_tryEval(sexp, R_GlobalEnv, &hadError) ); if (sexp == R_UnboundValue || Rf_isNull(sexp)) { - UNPROTECT( nprotect ); - return false; + PL_reset_term_refs( t1 ); + Ureturn false; } else { - int hadError; + int hadError = false; sexp = protected_tryEval(sexp, R_GlobalEnv, &hadError); if (hadError) { - UNPROTECT( nprotect ); - return false; + PL_reset_term_refs( t1 ); + Ureturn false; } } if ( PL_is_ground( rvar ) ) { @@ -2312,8 +2307,8 @@ execute_R(term_t rvar, term_t value) else rc = PL_unify( rvar, t1 ); } - UNPROTECT( nprotect ); - return rc; + PL_reset_term_refs( t1 ); + Ureturn rc; } static foreign_t @@ -2329,13 +2324,11 @@ is_R_variable(term_t t) CHARACTER_DATA(name)[0] = mkCharCE(s, CE_UTF8); } else { - UNPROTECT(nprotect); - return FALSE; + Ureturn FALSE; } PROTECT_AND_COUNT(o = findVar(install(CHAR(STRING_ELT(name, 0))), R_GlobalEnv)); - UNPROTECT(nprotect); - return o != R_UnboundValue; + Ureturn o != R_UnboundValue; } #ifndef ATOM_dot @@ -2393,3 +2386,4 @@ install_real(void) } #endif /* R_H */ + From 298b287859e9dccb229f66402ae786bdc21c3b55 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 23 Sep 2016 01:37:18 -0500 Subject: [PATCH 5/6] op --- library/matrix.yap | 2 ++ 1 file changed, 2 insertions(+) diff --git a/library/matrix.yap b/library/matrix.yap index 6a864a521..524abd8fd 100644 --- a/library/matrix.yap +++ b/library/matrix.yap @@ -27,6 +27,8 @@ :- module( matrix, [(<==)/2, op(800, xfx, '<=='), + (+=)/2, op(800, xfx, '+='), + (-=)/2, op(800, xfx, '-='), op(700, xfx, in), op(700, xfx, ins), op(450, xfx, ..), % should bind more tightly than \/ From bee39cb38551f2ed23fe7a258ce0ac6b787d3c08 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 23 Sep 2016 01:37:36 -0500 Subject: [PATCH 6/6] MALLOC --- library/dialect/swi/fli/swi.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 53148e037..313cbf8da 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -209,6 +209,10 @@ X_API int PL_get_nchars(term_t l, size_t *lengthp, char **s, unsigned flags) { } else { out.enc = ENC_ISO_LATIN1; } + + if (flags & BUF_MALLOC) { + out.type |= YAP_STRING_MALLOC; + } if (lengthp) { out.type |= YAP_STRING_NCHARS; out.max = *lengthp; @@ -231,10 +235,7 @@ int PL_get_wchars(term_t l, size_t *lengthp, wchar_t **s, unsigned flags) { inp.type = cvtFlags(flags); out.type = YAP_STRING_WCHARS; if (flags & BUF_MALLOC) { - out.type |= YAP_STRING_MALLOC; - out.val.w = *s; - } else { - out.val.w = NULL; + out.type |= YAP_STRING_MALLOC; } if (lengthp) { out.type |= YAP_STRING_NCHARS;