Merge branch 'master' of https://github.com/vscosta/yap-6.3
This commit is contained in:
commit
6802e83d83
@ -267,6 +267,7 @@ 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;
|
||||
|
12
C/exec.c
12
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;
|
||||
}
|
||||
|
@ -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();
|
||||
}
|
||||
|
||||
|
39
CXX/yapi.cpp
39
CXX/yapi.cpp
@ -1,6 +1,7 @@
|
||||
|
||||
#define YAP_CPP_INTERFACE 1
|
||||
|
||||
#include <string>
|
||||
#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.errorFunction) {
|
||||
s += LOCAL_ActiveError.errorFile;
|
||||
s += ":";
|
||||
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+= ":" ;
|
||||
s += LOCAL_ActiveError.prologPredLine;
|
||||
s += ":0 error ";
|
||||
s += Yap_errorClassName(getErrorClass());
|
||||
s += ".";
|
||||
s += Yap_errorName(getID());
|
||||
s += " in ";
|
||||
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+= "/" ;
|
||||
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.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) {
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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")
|
||||
|
@ -212,6 +212,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;
|
||||
@ -235,9 +239,6 @@ int PL_get_wchars(term_t l, size_t *lengthp, wchar_t **s, unsigned flags) {
|
||||
out.type = YAP_STRING_WCHARS;
|
||||
if (flags & BUF_MALLOC) {
|
||||
out.type |= YAP_STRING_MALLOC;
|
||||
out.val.w = *s;
|
||||
} else {
|
||||
out.val.w = NULL;
|
||||
}
|
||||
if (lengthp) {
|
||||
out.type |= YAP_STRING_NCHARS;
|
||||
|
@ -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 \/
|
||||
|
@ -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); \
|
||||
|
@ -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 Exception as e:
|
||||
print( e.args[1] )
|
||||
return False
|
||||
|
||||
q = engine.query(s)
|
||||
ask = True
|
||||
while q.next():
|
||||
while answer(q):
|
||||
vs = q.namedVarsCopy()
|
||||
if vs:
|
||||
i = 0
|
||||
|
@ -1,3 +1,4 @@
|
||||
|
||||
#include "rconfig.h"
|
||||
#if HAVE_R_H || !defined(_YAP_NOT_INSTALLED_)
|
||||
#include <SWI-Prolog.h>
|
||||
@ -17,18 +18,21 @@
|
||||
|
||||
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);
|
||||
SEXP o;
|
||||
o = R_tryEval( expr, env, errp);
|
||||
return o ? o : expr;
|
||||
}
|
||||
|
||||
@ -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,8 +2255,7 @@ set_R_variable(term_t rvar, term_t value)
|
||||
}
|
||||
if (vname)
|
||||
PL_free(vname);
|
||||
UNPROTECT( nprotect );
|
||||
return rc;
|
||||
Ureturn rc;
|
||||
}
|
||||
|
||||
static foreign_t
|
||||
@ -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 */
|
||||
|
||||
|
@ -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,41 @@ 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());
|
||||
}
|
||||
}
|
||||
|
||||
@ -203,12 +205,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 +238,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 +262,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:
|
||||
|
@ -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),
|
||||
|
Reference in New Issue
Block a user