Merge branch 'master' of https://github.com/vscosta/yap-6.3

C/errors.c

@@ -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;

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;
   }

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();
   }
 

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.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;
+ sprintf(buf, "%ld", (long int)LOCAL_ActiveError.errorLine);
-    s += ":0 C-code for error.";
+ s += buf;
-    s += "\n";
+    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) {

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

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)

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

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;

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")

library/dialect/swi/fli/swi.c

@@ -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;

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 \/

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 BASE_HASH_BUCKETS        256
-#define MAX_NODES_PER_TRIE_LEVEL 8
+#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);                                     \

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 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

packages/real/real.c

@@ -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
+#if  DEBUG_MEMORY
-#define PROTECT_AND_COUNT(EXP) { PROTECT(EXP); nprotect++; printf("%d +%d\n",+ __LINE__,nprotect);  }
+#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          printf("%d -%d\n", __LINE__,nprotect); unprotect(nprotect);  return
+#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) );
+    PROTECT_AND_COUNT( call_R = allocList(arity+1) );
-  call_R = c_R;
+  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);
+  {  Ureturn TRUE; }
-
-  return 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);
+  PROTECT_AND_COUNT(val = protected_tryEval(VECTOR_ELT(e, 0), R_GlobalEnv, &hadError));
-  UNPROTECT(nprotect);
-
   if ( !hadError )
-    return val;
+    { Ureturn val; }
-  return NULL;
+  { 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 )
+      if ( rc ) {
-	return PL_unify(out, tmp);
+	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 );
+ Ureturn rc;
- return 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 );
+      Ureturn false;
-      return 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 );
+      PL_reset_term_refs( t1 );
-      return false;
+      Ureturn false;
     } else {
-      int hadError;
+     int hadError = false;
       sexp = protected_tryEval(sexp, R_GlobalEnv, &hadError);
       if (hadError)
 	{
-	  UNPROTECT( nprotect );
+	  PL_reset_term_refs( t1 );
-	  return false;
+	  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 );
+  PL_reset_term_refs( t1 );
-  return rc;
+  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);
+   Ureturn FALSE;
-    return FALSE;
   }
 
   PROTECT_AND_COUNT(o = findVar(install(CHAR(STRING_ELT(name, 0))), R_GlobalEnv));
-  UNPROTECT(nprotect);
+  Ureturn o != R_UnboundValue;
-  return o != R_UnboundValue;
 }
 
 #ifndef ATOM_dot
@@ -2393,3 +2386,4 @@ install_real(void)
 }
 
 #endif /* R_H */
+

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,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:

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) :- !,
+'$assertat_d'(asserta,Head,Body,C0,Mod,R) :- !,
-	'$compile_dynamic'((Head:-Body), first, C0, Mod, CR),
+	'$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) :-
+'$assertat_d'(assertz,Head,Body,C0,Mod,R) :-
-	'$compile_dynamic'((Head:-Body), last, C0, Mod, CR),
+	'$compile_dynamic'((Head:-Body), assertz, C0, Mod, CR),
     ( get_value('$abol',true)
     ->
       '$predicate_flags'(Head,Mod,Fl,Fl),