Merge /home/vsc/yap

C/arrays.c

@@ -1028,34 +1028,31 @@ restart:
 
 #define CREATE_ARRAY_DEFS()     \
   PAR("type", isatom, CREATE_ARRAY_TYPE),                             \
-  PAR("address", isaddress, CREATE_ARRAY_ADDRESS),                                     \
+  PAR("address", filler, CREATE_ARRAY_ADDRESS),                   \
-  PAR("int", isnull, CREATE_ARRAY_INT),                                     \
+  PAR("int", filler, CREATE_ARRAY_INT),                     \
-  PAR("dbref", isnull, CREATE_ARRAY_DBREF),                                     \
+  PAR("dbref", filler, CREATE_ARRAY_DBREF),                   \
-  PAR("float", isnull, CREATE_ARRAY_FLOAT),                                     \
+  PAR("float", filler, CREATE_ARRAY_FLOAT),                \
-  PAR("ptr", isnull, CREATE_ARRAY_PTR),                                     \
+  PAR("ptr", filler, CREATE_ARRAY_PTR),                            \
-  PAR("atom", isnull, CREATE_ARRAY_ATOM),                                     \
+  PAR("atom", filler, CREATE_ARRAY_ATOM),                    \
-  PAR("char", isnull, CREATE_ARRAY_CHAR),                                     \
+  PAR("char", filler, CREATE_ARRAY_CHAR),                     \
-  PAR("unsigned_char", isnull, CREATE_UNSIGNED_CHAR),                                     \
+  PAR("unsigned_char", filler, CREATE_UNSIGNED_CHAR),      \
-  PAR("nb_term", isnull, CREATE_ARRAY_NB_TERM),                                     \
+  PAR("term", filler, CREATE_ARRAY_TERM),                          \
-  PAR("address", isaddress, CREATE_ARRAY_ADDRESS),                                     \
+  PAR("nb_term", filler, CREATE_ARRAY_NB_TERM)
-  PAR("address", isaddress, CREATE_ARRAY_ADDRESS),                                     \
+
-  PAR("address", isaddress, CREATE_ARRAY_ADDRESS),                                     \
+#define PAR(x, y, z) z
-  PAR("address", isaddress, CREATE_ARRAY_ADDRESS),                                     \
+
-  PAR("address", isaddress, CREATE_ARRAY_ADDRESS),                                     \
+
-  PAR("address", isaddress, CREATE_ARRAY_ADDRESS),                                     \
+typedef enum create_array_enum_choices { CREATE_ARRAY_DEFS() } create_array_choices_t;
-  PAR("address", isaddress, CREATE_ARRAY_ADDRESS),                                     \
+
-      PAR("close_on_abort", booleanFlag, OPEN_CLOSE_ON_ABORT),                 \
+#undef PAR
-      PAR("create", isatom, OPEN_CREATE),                                      \
+
-      PAR("encoding", isatom, OPEN_ENCODING),                                  \
+#define PAR(x, y, z)                                                           \
-      PAR("eof_action", isatom, OPEN_EOF_ACTION),                              \
+  { x, y, z }
-      PAR("expand_filename", booleanFlag, OPEN_EXPAND_FILENAME),               \
+
-      PAR("file_name", isatom, OPEN_FILE_NAME), PAR("input", ok, OPEN_INPUT),  \
+static const param_t create_array_defs[] = {CREATE_ARRAY_DEFS()};
-      PAR("locale", isatom, OPEN_LOCALE), PAR("lock", isatom, OPEN_LOCK),      \
+#undef PAR
-      PAR("mode", isatom, OPEN_MODE), PAR("output", ok, OPEN_OUTPUT),          \
+
-      PAR("representation_errors", booleanFlag, OPEN_REPRESENTATION_ERRORS),   \
+
-      PAR("reposition", booleanFlag, OPEN_REPOSITION),                         \
-      PAR("script", booleanFlag, OPEN_SCRIPT), PAR("type", isatom, OPEN_TYPE), \
-      PAR("wait", booleanFlag, OPEN_WAIT), PAR(NULL, ok, OPEN_END)
 
 /* create an array (+Name, + Size, +Props) */
     /** @pred  static_array(+ _Name_, + _Size_, + _Type_)
@@ -1087,6 +1084,8 @@ static Int
       return (FALSE);
     }
   }
+xarg *args =
+      Yap_ArgListToVector(tprops, create_array_defs, CREATE_ARRAY_NB_TERM, DOMAIN_ERROR_CREATE_ARRAY_OPTION);
   
   if (IsVarTerm(tprops)) {
     Yap_Error(INSTANTIATION_ERROR, tprops, "create static array");

C/cdmgr.c

@@ -1,4 +1,3 @@
-
 /*************************************************************************
  *									 *
  *	 YAP Prolog 							 *

C/errors.c

@@ -91,16 +91,19 @@ static bool setErr(const char *q, yap_error_descriptor_t *i, Term t) {
     return i->k ? TermTrue : TermFalse;                                        \
   }
 
-#define query_key_i(k, ks, q, i)                                             if (strcmp(ks, q) == 0) {                                                    \
+#define query_key_i(k, ks, q, i) \
+if (strcmp(ks, q) == 0) {                                                    \
     return MkIntegerTerm(i->k);                                                \
   }
 
 #define query_key_s(k, ks, q, i)  \
-  if (strcmp(ks, q) == 0 && i->k) {                                                    \
+if (strcmp(ks, q) == 0 ) \
-  return MkAtomTerm(Yap_LookupAtom(i->k)); } else {return TermNil;}
+{  if (i->k) return MkAtomTerm(Yap_LookupAtom(i->k)); else return TermNil; }
+
 
 #define query_key_t(k, ks, q, i)     \
   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 Term queryErr(const char *q, yap_error_descriptor_t *i) {
@@ -594,6 +597,7 @@ yap_error_descriptor_t *Yap_popErrorContext(bool mdnew, bool pass) {
     memmove(ep, e, sizeof(*e));
     ep->top_error = epp;
   }
+  free(e);
   return LOCAL_ActiveError;
 }
 /**
@@ -643,9 +647,9 @@ void Yap_ThrowExistingError(void) {
 bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
                        const char *function, int lineno, yap_error_number type,
   Term where, const char *s) {
-  if (!Yap_pc_add_location(r, CP, B, ENV))
+  if (!Yap_pc_add_location(r, P, B, ENV))
     Yap_env_add_location(r, CP, B, ENV, 0);
-  if (where == 0L || where == TermNil || type == INSTANTIATION_ERROR) {
+  if (where == 0L || where == TermNil) {
     r->culprit = NULL;
   } else {
     r->culprit = Yap_TermToBuffer(
@@ -662,7 +666,6 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
   r->errorLine = lineno;
   r->errorFunction = function;
   r->errorFile = file;
-  Yap_prolog_add_culprit(r PASS_REGS1);
   LOCAL_PrologMode |= InErrorMode;
   Yap_ClearExs();
   // first, obtain current location
@@ -739,7 +742,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
     if (LOCAL_PrologMode & BootMode) {
       fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf);
     } else {
-      Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE);
+      Yap_output_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE);
       if (tmpbuf[0]) {
         fprintf(stderr, "%% Bug found while executing %s\n", tmpbuf);
       }

C/globals.c

@@ -352,9 +352,9 @@ 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;	       \
+  { 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+sz; }
 
 static int copy_complex_term(register CELL *pt0, register CELL *pt0_end,
                              int share, int copy_att_vars, CELL *ptf,
@@ -502,7 +502,7 @@ loop:
       ptf++;
 /* store the terms to visit */
 #ifdef RATIONAL_TREES
-      if (to_visit + 1 >= to_visit_max) {
+      if (to_visit + 32 >= to_visit_max) {
           expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
       }
       to_visit->start_cp = pt0;

C/stack.c

@@ -1856,9 +1856,9 @@ void Yap_dump_stack(void) {
   fprintf(stderr, "%% \n%%  -------------------------------------\n%%\n");
   fprintf(stderr, "%% Program Position: %s\n\n", Yap_errorName(errno) );
   fprintf(stderr, "%%          PC: %s\n", (char *)HR);
-  Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
+  Yap_output_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
   fprintf(stderr, "%%          Continuation: %s\n", (char *)HR);
-  Yap_detect_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256);
+  Yap_output_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256);
   fprintf(stderr, "%%          Alternative: %s\n", (char *)HR);
 
   fprintf(stderr, "%% \n%%  -------------------------------------\n%%\n");
@@ -1916,7 +1916,7 @@ fprintf(stderr, "%% \n%%  -------------------------------------\n%%\n");
                     "Use--Local In Use)\n%%\n");
     while (b_ptr != NULL) {
       while (env_ptr && env_ptr <= (CELL *)b_ptr) {
-        Yap_detect_bug_location(ipc, FIND_PRED_FROM_ENV, 256);
+        Yap_output_bug_location(ipc, FIND_PRED_FROM_ENV, 256);
         if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) {
           b_ptr = b_ptr->cp_b;
           fprintf(stderr, "%%  %s\n", tp);
@@ -1940,7 +1940,7 @@ fprintf(stderr, "%% \n%%  -------------------------------------\n%%\n");
             b_ptr->cp_ap->opc != Yap_opcode(_or_last) &&
             b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) {
           /* we can safely ignore ; because there is always an upper env */
-          Yap_detect_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256);
+          Yap_output_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256);
           fprintf(stderr, "%%         %s (%luKB--%luKB)\n", tp,
                   (unsigned long int)((b_ptr->cp_h - H0) * sizeof(CELL) / 1024),
                   (unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024);
@@ -2086,7 +2086,12 @@ void DumpActiveGoals(USES_REGS1) {
   }
 }
 
-void Yap_detect_bug_location(yamop *yap_pc, int where_from, int psize) {
+
+/**
+ * Used for debugging.
+ * 
+ */
+void Yap_output_bug_location(yamop *yap_pc, int where_from, int psize) {
   Atom pred_name;
   UInt pred_arity;
   Term pred_module;

C/text.c

@@ -176,14 +176,21 @@ void *MallocAtLevel(size_t sz, int atL USES_REGS) {
 }
 
 void *Realloc(void *pt, size_t sz USES_REGS) {
-  sz += sizeof(struct mblock);
   struct mblock *old = pt, *o;
   old--;
-  release_block(old);
+  sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL);
   o = realloc(old, sz);
+  if (o->next) {
+    o->next->prev = o;
+  } else {
+    LOCAL_TextBuffer->last[o->lvl] = o;
+  }
+  if (o->prev) {
+    o->prev->next = o;
+  } else {
+    LOCAL_TextBuffer->first[o->lvl] = o;
+  }
   o->sz = sz;
-  insert_block(o);
-
   return o + 1;
 }
 

H/YapFlags.h

@@ -187,6 +187,18 @@ static inline Term isatom(Term inp) {
   return TermZERO;
 }
 
+static inline Term isadress(Term inp) {
+  if (IsVarTerm(inp)) {
+    Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag %s",
+              "value must be bound");
+    return TermZERO;
+  }
+  if (IsAddressTerm(inp))
+    return inp;
+  Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
+  return TermZERO;
+}
+
 static inline Term options(Term inp) {
   return Yap_IsGroundTerm(inp) ? inp : TermZERO;
 }

H/Yapproto.h

@@ -391,7 +391,7 @@ extern void Yap_InitSortPreds(void);
 /* stack.c */
 extern void Yap_InitStInfo(void);
 extern void Yap_dump_stack(void);
-extern void Yap_detect_bug_location(yamop *yap_pc, int where_from, int psize);
+extern void Yap_output_bug_location(yamop *yap_pc, int where_from, int psize);
 
 #if !defined(YAPOR) && !defined(THREADS)
 extern bool Yap_search_for_static_predicate_in_use(struct pred_entry *, bool);

include/YapErrors.h

@@ -48,12 +48,12 @@ E(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, DOMAIN_ERROR,
 E(DOMAIN_ERROR_ARRAY_OVERFLOW, DOMAIN_ERROR, "array_overflow")
 E(DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR, "array_type")
 E(DOMAIN_ERROR_CLOSE_OPTION, DOMAIN_ERROR, "close_option")
+E(DOMAIN_ERROR_CREATE_ARRAY_OPTION, DOMAIN_ERROR, "create_array_option")
 E(DOMAIN_ERROR_ENCODING, DOMAIN_ERROR, "encoding")
 E(DOMAIN_ERROR_EXPAND_FILENAME_OPTION, DOMAIN_ERROR, "expand_filename")
 E(DOMAIN_ERROR_FILE_ERRORS, DOMAIN_ERROR, "file_errors")
 E(DOMAIN_ERROR_FILE_TYPE, DOMAIN_ERROR, "file_type")
-E(DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE, DOMAIN_ERROR, "format argument "
+E(DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE, DOMAIN_ERROR, "format argument")
-                                                      "domain")
 E(DOMAIN_ERROR_FORMAT_OUTPUT, DOMAIN_ERROR, "format output")
 E(DOMAIN_ERROR_GENERIC_ARGUMENT, DOMAIN_ERROR, "generic_argument")
 E(DOMAIN_ERROR_IO_MODE, DOMAIN_ERROR, "io_mode")

packages/python/yap_kernel/YAP_KERNEL.md

@@ -1,6 +1,51 @@
 A Jupyter Kernel for YAP		(#yap_kernel)
 =======================
 
-This kernel supports interaction with YAP Prolog. 
+This Jupyter kernel supports interaction with YAP Prolog. The kernel
+patches IPython and PyKernel so that the user interacts with the
+Prolog interpreter. Most of the original kernels are unaffected by the
+changes.
+
+You will need `python3` and `jupyter notebook`to use this package, plus:
+	- `setuptools`;
+	- `wheel`
+	- `pip`
+
+The configuration script should recognize whether these Python
+packages are installed.
+
+See `tut.ipynb` for details on how to use  the system.
+
+Both `jupyter notebook` and `jupyter lab` rely on the Javascript
+editor ` CodeMirror` for editing tasks such as highlighting, inlining,
+and folding. Unfortunately, `CodeMirror` does not support the Prolog
+language. Starting from Wielemaker's excellent `CodeMirror` module for
+`swish`, YAP includes a codemirror for Prolog, designed to fit easily
+with any `CodeMirror`-based application.
+	
++ `Jupyter lab` includes a complex dependency mechanism, that always
+  tries to download from the Internet. We do a first build to ensure
+  all packages are there, set the build offline, patch the different
+  copies of codemirror, and build locally.
+  
+  ~~~~
+  CM=$HOME/github/CodeMirror
+  PYLIB=$HOME/.local/lib/python3.6/site-packages
+  PYSHARE=$HOME/.local/share
+  cd $PYLIB/jupyterlab
+  jupyter lab build
+  cp commands.py commands.py.bk
+  sed  's/.node., YARN_PATH,/\"node", YARN_PATH, "--offline",/g' commands.py
+  cd $PYSHARE/jupyter/lab/staging/node_modules/codemirror/mode
+  split -n l/5 meta.js
+  cat xaa xab > meta.js
+  echo '     {name: "Prolog", mime: "text\/x-prolog", mode: "prolog", ext: ["yap","pl", "ypp", "prolog"]}' >> meta.js
+  cat xac xad xae >> meta.js
+  cp -a $CM/mode/prolog prolog
+  cd $PYLIB/jupyterlab
+  jupyter lab build
+  mv commands.py.bk commands.py
+  ~~~~
+
 
 

pl/messages.yap

@@ -205,7 +205,8 @@ compose_message(error(E, Exc), Level) -->
 	caller( error(E, Exc), Level ),
 	extra_info( error(E, Exc), Level ),
 	!,
-	[nl,nl].
+	[nl],
+	[nl].
 compose_message( false, _Level) --> !,
 	[ 'false.'-[] ].
 compose_message( '$abort', _Level) --> !,
@@ -267,7 +268,8 @@ location( error(_,Info), Level, LC ) -->
 	},
   !,
 display_consulting( File, Level, Info, LC ),
-	[  '~a:~d:0 ~a in ~a:~a/~d:'-[File, FilePos,Level,M,Na,Ar] ].
+  {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) },
    {
@@ -277,13 +279,17 @@ location( error(_,Info), Level, LC ) -->
 	},
   !,
   display_consulting( File, Level, Info,  LC ),
-  [  '~a:~d:0 ~a in ~a():'-[File, FilePos,Level,F] ].
+  {simplify_pred(F,FF)},
+  [  '~a:~d:0 ~a while executing ~a():'-[File, FilePos,Level,FF] ].
 location( _Ball, _Level, _LC ) --> [].
 
+simplify_pred(user:F, F) :- !.
+simplify_pred(prolog:F, F) :- !.
+simplify_pred(F, F).
 
 %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
 main_message(error(Msg,In), _, _) --> {var(Msg)}, !,
-	[  'ninstantiated message ~w~n.' - [error(Msg,In)], nl ].
+	[  'Uninstantiated message ~w~n.' - [error(Msg,In)], nl ].
 main_message( error(syntax_error(Msg),info(between(L0,LM,LF),_Stream, _Pos, Term)), Level, LC ) -->
 	!,
 	[' ~a: syntax error ~s' - [Level,Msg]],
@@ -303,45 +309,50 @@ main_message(style_check(singleton(SVs),_Pos,_File,P), _Level, _LC) -->
     !,
 %    {writeln(ci)},
 	{ clause_to_indicator(P, I) },
-	[  nl, '           singleton variable~*c ~w in ~q.' - [  NVs, 0's, SVsL, I] ],
+	[  nl, '~*|singleton variable~*c ~w in ~q.' - [ 10,  NVs, 0's, SVsL, I] ],
 	{ svs(SVs,SVs,SVsL),
 	  ( SVs = [_] -> NVs = 0 ; NVs = 1 )
 	}.
 main_message(style_check(multiple(N,A,Mod,I0),_Pos,File,_P), _Level, _LC) -->
     !,
-    [  '           ~a redefines ~q, originally defined in  ~a.' - [File, Mod:N/A, I0] ].
+    [  '~*|~a redefines ~q, originally defined in  ~a.' - [ 10,File, Mod:N/A, I0] ].
 main_message(style_check(discontiguous(N,A,Mod),_S,_W,_P) , _Level, _LC)-->
     !,
-    [  '           discontiguous definition for ~p.' - [Mod:N/A] ].
+    [  '~*|discontiguous definition for ~p.' - [ 10,Mod:N/A] ].
-main_message(error(consistency_error(Who)), Level, _LC) -->
+main_message(error(ErrorInfo,_), _Level, _LC) -->
-    !,
+	[nl],
-    [ ' ~a: has argument ~a not consistent with type.'-[Level,Who] ].
+	main_error_message( ErrorInfo ),
-main_message(error(domain_error(Who , Type), _Where), Level, _LC) -->
-    !,
-    [ ' ~a:  ~q does not belong to domain ~a,' - [Level,Type,Who], nl ].
-main_message(error(evaluation_error(What), _Where), Level, _LC) -->
-    !,
-    [ ' ~a: ~w during evaluation of arithmetic expressions,' - [Level,What], nl ].
-main_message(error(evaluation_error(What, Who), _Where), Level, _LC) -->
-    !,
-    [ ' ~a: ~w caused ~a during evaluation of arithmetic expressions,' - [Level,Who,What], nl ].
-main_message(error(existence_error(Type , Who), _Where), Level, _LC) -->
-    !,
-    [  ' ~a:  ~q ~q could not be found,' - [Level,Type, Who], nl ].
-main_message(error(permission_error(Op, Type, Id), _Where), Level, _LC) -->
-	[ ' ~a:  ~q is not allowed in ~a ~q,' - [Level, Op, Type,Id], nl ].
-main_message(error(instantiation_error, _Where), Level, _LC) -->
-	[ ' ~a: unbound variable' - [Level], nl ].
-main_message(error(representation_error(Type)), Level, _LC) -->
-	[ ' ~a: ~a representation error ~a' - [Level, Type], nl ].
-main_message(error(type_error(Type,Who), _What), Level, _LC) -->
-	[ ' ~a: ~q should be of type ~a' - [Level,Who,Type]],
 	[nl].
-main_message(error(system_error(Who), _What), Level, _LC) -->
+
-	[ ' ~a: ~q' - [Level,Who]],
+
+main_error_message(consistency_error(Who)) -->
+    [ '~*|** argument ~a not consistent with type **'-[ 10,Who] ].
+main_error_message(domain_error(Who , Type)) -->
+    [ '~*|** ~q does not belong to domain ~a ** ' - [ 10,Type,Who], nl ].
+main_error_message(evaluation_error(What)) -->
+    [ '~*|** found ~w during evaluation of arithmetic expression **' - [ 10,What], nl ].
+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 ].
+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) -->	
+	[ '~*|** unbound variable **' - [10], nl ].
+main_error_message(representation_error(Type)) -->
+	[ '~*|** YAP cannot represent ~w **' - [10, Type], nl ].
+main_error_message(resource_error(Who)) -->
+	[ '~*|** ~q **' - [10,Who]],
 	[ nl ].
-main_message(error(uninstantiation_error(T),_), Level, _LC) -->
+main_error_message(type_error(Type,Who)) -->
-	[ ' ~a: found ~q, expected unbound variable ' - [Level,T], nl ].
+	[ '~*|** ~q should be of type ~a **' - [10,Who,Type]],
+	[ nl ].
+main_error_message(system_error(Who)) -->
+	[ '~*|** ~q **' - [10,Who]],
+	[ nl ].
+main_error_message(uninstantiation_error(T)) -->
+	[ '~*|** found ~q, expected unbound variable **' - [10,T], nl ].
 
 display_consulting( F, Level, Info, LC) -->
     {  LC > 0,
@@ -360,7 +371,7 @@ display_consulting( F, Level, _, LC) -->
 display_consulting(_F, _, _, _LC) -->
 	  [].
 
-caller( Info, _) -->
+c_goal( error(_,Info), _) -->
         { '$error_descriptor'(Info, Desc) },
         ({   query_exception(errorGoal, Desc, Call),
          	Call = M:(H :- G)
@@ -376,31 +387,34 @@ caller( Info, _) -->
           ;
           []
         ),
-	{ query_exception(prologPredFile, Desc, File),
+		!.
-	File \= [],
+c_goal(_,_) --> [].
-	query_exception(prologPredLine, Desc, FilePos),
-	query_exception(prologPredModule, Desc, M),
-	query_exception(prologPredName, Desc, Na),
-	query_exception(prologPredArity, Desc, Ar)
-	},
-	!,
-	  [nl],
-	  ['~*|        ~q:~d:0 ~a:~q'-[10,File, FilePos,M,Na,Ar]],
-	[nl].
-caller( _, _) -->
-	[].
 
-c_goal( Info, Level ) -->
+caller( error(_,Info), Level ) -->
 { '$error_descriptor'(Info, Desc) },
     { query_exception(errorFile, Desc, File),
+      File \= [],
+      query_exception(errorFunction, Desc, Func),
       Func \= [],
-      query_exception(errorFunction, Desc, File),
       query_exception(errorLine, Desc, Line)
       },
 	!,
-	['~*|~a raised at C-function ~a() in ~a:~d:0: '-[10, Level, Func, File, Line]],
+	['~*|~a raised by foreign-function ~a(), at ~a:~d:0: '-[10, Level, Func, File, Line]],
 	[nl].
-c_goal( _, _Level ) --> [].
+caller( _, _Level ) --> [].
+
+
+extra_info( error(_,Info), _ ) -->
+ { '$error_descriptor'(Info, Desc) },
+   {
+	 query_exception(errorMsg, Desc, Msg),
+	 Msg \= []
+    },
+    !,
+        ['~*|user provided data is: ~q' - [10,Msg]],
+        [nl].
+extra_info( _, _ ) -->
+	[].
 
 
 prolog_message(X) -->
@@ -622,17 +636,6 @@ domain_error(write_option, Opt) --> !,
 domain_error(Domain, Opt) -->
 	[ '~w not a valid element for ~w' - [Opt,Domain] ].
 
-extra_info( error(_,Extra), _ ) -->
-    {
-	 query_exception(prologPredFile, Extra, Msg),
-	 Msg \= []
-    },
-    !,
-        ['~*|user provided data is: ~q' - [10,Msg]],
-        [nl].
-extra_info( _, _ ) -->
-	[].
-
 object_name(array, array).
 object_name(atom, atom).
 object_name(atomic, atomic).
@@ -1056,8 +1059,8 @@ query_exception(K0,[H|L],V) :-
     (atom(K0) -> atom_to_string(K0, K) ; K = K0),
     !,
     lists:member(K=V,[H|L]).
-query_exception(K,V) :-
+query_exception(M,K,V) :-
-    '$query_exception'(K,V).
+    '$query_exception'(M,K,V).
 
 /**
   @}