Merge vcosta-laptop:github/yap-6.3

C/errors.c

@@ -68,7 +68,24 @@ bool Yap_Warning(const char *s, ...) {
   rc = Yap_execute_pred(pred, ts, true PASS_REGS);
   return rc;
 }
-void Yap_InitError(yap_error_number e, Term t, const char *msg) {
+
+void Yap_InitError__(const char *file, const char *function, int lineno, yap_error_number e, Term t, ...) {
+  CACHE_REGS
+  va_list ap;
+  va_start(ap, t);
+  const char *fmt;
+  char tmpbuf[MAXPATHLEN];
+
+  fmt = va_arg(ap, char *);
+  if (fmt != NULL) {
+#if HAVE_VSNPRINTF
+    vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap);
+#else
+    (void)vsprintf(tmpbuf, fmt, ap);
+#endif
+  } else
+    return;
+  va_end(ap);
   if (LOCAL_ActiveError->status) {
     Yap_exit(1);
   }
@@ -76,10 +93,10 @@ void Yap_InitError(yap_error_number e, Term t, const char *msg) {
   LOCAL_ActiveError->errorFile = NULL;
   LOCAL_ActiveError->errorFunction = NULL;
   LOCAL_ActiveError->errorLine = 0;
-  if (msg) {
+  if (fmt) {
-    LOCAL_Error_Size = strlen(msg);
+    LOCAL_Error_Size = strlen(tmpbuf);
     LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1);
-    strcpy(LOCAL_ActiveError->errorMsg, msg);
+    strcpy(LOCAL_ActiveError->errorMsg, tmpbuf);
   } else {
     LOCAL_Error_Size = 0;
   }

C/scanner.c

@@ -970,6 +970,10 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *st, int sign) {
       number_overflow();
     *sp++ = ch;
     ch = getchr(st);
+    if (!iswhexnumber(ch))  {
+      Yap_InitError(SYNTAX_ERROR, TermNil, "empty hexadecimal number 0x%C",ch)   ;
+      return 0;
+    }
     while (my_isxdigit(ch, 'F', 'f')) {
       Int oval = val;
       int chval =
@@ -982,16 +986,27 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *st, int sign) {
       if (oval != (val - chval) / 16) /* overflow */
         has_overflow = TRUE;
       ch = getchr(st);
+
     }
     *chp = ch;
   } else if (ch == 'o' && base == 0) {
-    might_be_float = FALSE;
+    might_be_float = false;
     base = 8;
     ch = getchr(st);
+      if (ch < '0' || ch > '7') {
+          Yap_InitError(SYNTAX_ERROR, TermNil, "empty octal number 0b%C", ch)   ;
+        return 0;
+      }
   } else if (ch == 'b' && base == 0) {
-    might_be_float = FALSE;
+    might_be_float = false;
     base = 2;
     ch = getchr(st);
+  if (ch < '0' || ch > '1') {
+                                          Yap_InitError(SYNTAX_ERROR, TermNil, "empty binary  0b%C", ch)   ;
+    return 0;
+                                      }
+
+
   } else {
     val = base;
     base = 10;
@@ -1011,7 +1026,7 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *st, int sign) {
     }
     val = val * base + ch - '0';
     if (val / base != oval || val - oval * base != ch - '0') /* overflow */
-      has_overflow = TRUE;
+      has_overflow = true;
     ch = getchr(st);
   }
   if (might_be_float && (ch == '.' || ch == 'e' || ch == 'E')) {
@@ -1162,8 +1177,7 @@ Term Yap_scan_num(StreamDesc *inp, bool error_on) {
 #endif
   if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) {
     Yap_clean_tokenizer(old_tr, NULL, NULL);
-    if (error_on)
+   Yap_InitError(SYNTAX_ERROR, ARG2, "while converting stream %d to number", inp-GLOBAL_Stream );
-      Yap_Error(SYNTAX_ERROR, ARG2, "converting number");
     return 0;
   }
   return out;
@@ -1472,7 +1486,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
       cherr = 0;
       CHECK_SPACE();
       if ((t->TokInfo = get_num(&cha, &cherr, st, sign)) == 0L) {
-        if (p) {
+        if (t->TokInfo == 0) {
           p->Tok = eot_tok;
           t->TokInfo = TermError;
         }

C/text.c

@@ -736,19 +736,21 @@ static size_t write_length(const unsigned char *s0, seq_tv_t *out USES_REGS) {
 static Term write_number(unsigned char *s, seq_tv_t *out,
                          bool error_on USES_REGS) {
   Term t;
-  yap_error_number erro = LOCAL_Error_TYPE;
+    yap_error_descriptor_t new_error;
     int i = push_text_stack();
+    Yap_pushErrorContext(&new_error);
   t = Yap_StringToNumberTerm((char *)s, &out->enc, error_on);
   pop_text_stack(i);
-  LOCAL_Error_TYPE = erro;
+    Yap_popErrorContext(true);
   return t;
 }
 
 static Term string_to_term(void *s, seq_tv_t *out USES_REGS) {
   Term o;
-  yap_error_number erro = LOCAL_Error_TYPE;
+    yap_error_descriptor_t new_error;
+    Yap_pushErrorContext(&new_error);
     o = out->val.t = Yap_BufferToTerm(s, TermNil);
-  LOCAL_Error_TYPE = erro;
+    Yap_popErrorContext(true);
 
     return o;
 }

CXX/yapq.hh

@@ -38,12 +38,10 @@ class X_API YAPPredicate;
 class X_API YAPQuery : public YAPPredicate {
   bool q_open;
   int q_state;
-  yhandle_t q_g, q_handles;
+  yhandle_t  q_handles;
   struct yami *q_p, *q_cp;
-  sigjmp_buf q_env;
   int q_flags;
   YAP_dogoalinfo q_h;
-  YAPQuery *oq;
   YAPPairTerm names;
   YAPTerm goal;
   // temporaries

include/YapError.h

@@ -37,10 +37,12 @@
 
 #define MAX_ERROR_MSG_SIZE 1024
 
-struct yami *Yap_Error__(const char *file, const char *function, int lineno,
+extern void Yap_InitError__(const char *file, const char *function, int lineno, yap_error_number e, YAP_Term g, ...);
+
+extern struct yami *Yap_Error__(const char *file, const char *function, int lineno,
                          yap_error_number err, YAP_Term wheret, ...);
 
-void Yap_ThrowError__(const char *file, const char *function, int lineno,
+extern void Yap_ThrowError__(const char *file, const char *function, int lineno,
                       yap_error_number err, YAP_Term wheret, ...)
 #ifndef MSC_VER
     __attribute__((noreturn))
@@ -50,6 +52,9 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno,
 #define Yap_NilError(id, ...)                                                  \
   Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__)
 
+#define Yap_InitError(id, ...)                                                  \
+  Yap_InitError__(__FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__)
+
 #define Yap_Error(id, inp, ...)                                                \
   Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, inp, __VA_ARGS__)
 

os/YapIOConfig.h.cmake

@@ -1,3 +1,12 @@
+
+// play nice
+#ifndef HAVE_PYTHON
+#cmakedefine HAVE_PYTHON  ${HAVE_PYTHON}
+#endif
+#if HAVE_PYTHON
+#include <Python.h>
+#endif
+
 /* Define if you have libreadline */
 #ifndef HAVE_LIBREADLINE
 #cmakedefine HAVE_LIBREADLINE  ${HAVE_LIBREADLINE}

os/chartypes.c

@@ -95,8 +95,6 @@ Term Yap_StringToNumberTerm(const char *s, encoding_t *encp, bool error_on) {
     s++;
 #endif
   t = Yap_scan_num(GLOBAL_Stream + sno, error_on);
-  if (LOCAL_Error_TYPE == SYNTAX_ERROR)
-    LOCAL_Error_TYPE = YAP_NO_ERROR;
     Yap_CloseStream(sno);
   UNLOCK(GLOBAL_Stream[sno].streamlock);
   return t;

os/readterm.c

@@ -729,7 +729,7 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
   CACHE_REGS
   Term v_vp, v_vnames, v_comments, v_pos;
 
-  if (fe->t0 & fe->t && !Yap_unify(fe->t, fe->t0))
+  if (fe->t0 && fe->t && !Yap_unify(fe->t, fe->t0))
     return false;
   if (fe->t && fe->vp)
     v_vp = get_variables(fe, tokstart);
@@ -907,6 +907,9 @@ static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) {
     }
   }
   // go back to the start
+  if (LOCAL_Error_TYPE == SYNTAX_ERROR) {
+    return YAP_PARSING_ERROR;
+  }
   if (re->seekable) {
     if (GLOBAL_Stream[inp_stream].status & InMemory_Stream_f) {
       GLOBAL_Stream[inp_stream].u.mem_string.pos = re->cpos;

packages/jpl/jpl.pl

@@ -4470,7 +4470,7 @@ add_search_path(Path, Dir) :-
 %	=CLASSPATH=, etc.
 
 search_path_separator((;)) :-
-	current_prolog_flag(windows, true), !.
+	current_prolog_flag(windo/.... ,,,,,,,,,,,,,,,,,, :l'p[KIO)_"?ws, true), !.
 search_path_separator(:).
 
 		 /*******************************
@@ -4506,7 +4506,7 @@ location(java_root, _, JRE) :-
     member(Root, [ '/usr/lib',
 		   '/usr/local/lib',
                    '/opt/lib',
-  '/Library/Java/JavaVirtualMachines',
+  '/Library/Java/JavaVirtual hines',
   '/System/Library/Frameworks'
 		 ]),
     exists_directory(Root),

packages/python/py2pl.c

@@ -150,7 +150,7 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
     for (i = 0; i < sz; i++) {
       PyObject *obj;
       rc = rc && PL_unify_list(t, to, t);
-      if ((obj = PyList_GetItem(pVal, i - 1)) == NULL) {
+      if ((obj = PyList_GetItem(pVal, i)) == NULL) {
         obj = Py_None;
       }
       rc = rc && python_to_term(obj, to);

pl/boot.yap

@@ -107,7 +107,66 @@ private(_).
 :- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1,
         '$iso_check_goal'/2]).
 
-% be careful here not to generate an undefined exception.
+% be careful here not to generate an undefined exception..
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
 
 print_message(L,E) :-
 	'$number_of_clauses'(print_message(L,E), prolog_complete, 1),
@@ -212,7 +271,7 @@ print_message(L,E) :-
 	 '$yap_strip_module'(C, EM, EG),
 	  '$execute_command'(EG,EM,VL,Pos,Con,C), ! ;
 	  % do term expansion
-	  '$expand_term'(C, EC),
+	  '$expand_term'(C, Con, EC),
     '$yap_strip_module'(EC, EM, EG),
 	  % execute a list of commands
 	  '$execute_commands'(EG,EM,VL,Pos,Con,_Source),

pl/grammar.yap

@@ -67,7 +67,6 @@ right hand side of a grammar rule
 Grammar related built-in predicates:
 
 */
-/*
 :- system_module( '$_grammar', [!/2,
          (',')/4,
          (->)/4,
@@ -81,7 +80,7 @@ Grammar related built-in predicates:
         phrase/3,
         {}/3,
         ('|')/4], ['$do_error'/2]).
-*/
+
 
 % :- meta_predicate ^(?,0,?).
 % ^(Xs, Goal, Xs) :- call(Goal).
@@ -121,7 +120,7 @@ t_hgoal(V, _, _, _, G0) :- var(V), !,
 t_hgoal(M:H, M:NH, S, SR, G0) :- !,
 	t_hgoal(H, NH, S, SR, G0).
 t_hgoal(H, NH, S, SR, _) :-
-	extend([S,SR],H,NH).
+	dcg_extend([S,SR],H,NH).
 
 t_hlist(V, _, _, _, G0) :- var(V), !,
 	'$do_error'(instantiation_error,G0).
@@ -174,10 +173,10 @@ t_body((T|R), _ToFill, _, S, SR, (Tt;Rt)) :- !,
 t_body(M:G, ToFill, Last, S, SR, M:NG) :- !,
 	t_body(G, ToFill, Last, S, SR, NG).
 t_body(T, filled_in, _, S, SR, Tt) :-
-	extend([S,SR], T, Tt).
+	dcg_extend([S,SR], T, Tt).
 
 
-extend(More, OldT, NewT) :-
+dcg_extend(More, OldT, NewT) :-
 	OldT =.. OldL,
 	lists:append(OldL, More, NewL),
 	NewT =.. NewL.

pl/load_foreign.yap

@@ -98,7 +98,13 @@ load_foreign_files(Objs,Libs,Entry) :-
 Loads object files produced by the C compiler. It is useful when no search should be performed and instead one has the full paths to the _Files_ and _Libs_.
 
 */
-load_absolute_foreign_files(_Objs,_Libs,_Entry).
+load_absolute_foreign_files(Objs,Libs,Entry) :-
+    source_module(M),
+   '$load_foreign_files'(Objs,Libs,Entry),
+    !,
+    prolog_load_context(file, F),
+    ignore( recordzifnot( '$load_foreign_done', [F, M], _) ).
+
 '$checklib_prefix'(F,F) :- is_absolute_file_name(F), !.
 '$checklib_prefix'(F, F) :-
 	sub_atom(F, 0, _, _, lib), !.

pl/meta.yap

@@ -300,8 +300,9 @@ meta_predicate declaration
     nonvar(G),
     G = (A = B),
     !.
-'$expand_goals'(\+A,\+A1,('$current_choice_point'(CP),AO,'$$cut_by'(CP)-> false;true),HM,SM,BM,HVars) :- !,
+'$expand_goals'(\+A,\+A1,(AO-> false;true),HM,SM,BM,HVars) :- !,
-	'$expand_goals'(A,A1,AO,HM,SM,BM,HVars).
+	'$expand_goals'(A,A1,AOO,HM,SM,BM,HVars),
+	'$clean_cuts'(AOO, AO).
 '$expand_goals'(once(A),once(A1),
 	('$current_choice_point'(CP),AO,'$$cut_by'(CP)),HM,SM,BM,HVars) :- !,
 	'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
@@ -591,8 +592,8 @@ meta_predicate(P) :-
 	spy(:),
 	stash_predicate(:),
 	use_module(:),
-	use_module(:,?),
+	use_module(:,+),
-	use_module(?,:,?),
+	use_module(?,:,+),
 	when(+,0),
 	with_mutex(+,0),
 	with_output_to(?,0),

pl/top.yap

@@ -231,14 +231,21 @@ current_prolog_flag(break_level, BreakLevel),
 	 '$continue_with_command'(Option, VL, Pos, M:G, Source).
 
 '$expand_term'(T,O) :-
-	catch( '$expand_term0'(T,O), _,( '$disable_debugging', fail) ),
+	 '$expand_term'(T,top,O).
+
+'$expand_term'(T,Con,O) :-
+	catch( '$expand_term0'(T,Con,O), _,( '$disable_debugging', fail) ),
       	!.
 
-'$expand_term0'(T,O) :-
+		'$expand_term0'(T,consult,O) :-
+		expand_term( T,  O).
+		'$expand_term0'(T,reconsult,O) :-
+		expand_term( T,  O).
+		'$expand_term0'(T,top,O) :-
 	expand_term( T,  T1),
 	!,
  	'$expand_term1'(T1,O).
-'$expand_term0'(T,T).
+'$expand_term0'(T,_,T).
 
 '$expand_term1'(T,O) :-
         '$expand_meta_call'(T, [], O),

swi/library/debug.pl

@@ -116,8 +116,8 @@ debugging(Topic) :-
 debugging(Topic, Bool) :-
 	debugging(Topic, Bool, _To).
 
-%%	debug(+Topic) is det.
+%%	@pred debug(+Topic) is det.
-%%	nodebug(+Topic) is det.
+%%	@pred nodebug(+Topic) is det.
 %
 %	Add/remove a topic from being   printed.  nodebug(_) removes all
 %	topics. Gives a warning if the topic is not defined unless it is

swi/library/prolog_xref.pl

@@ -55,9 +55,7 @@
 :- use_module(library(lists), [append/3, member/2]).
 :- use_module(library(operators),
 	      [pop_operators/0, push_op/3, push_operators/1]).
-:- if(current_prolog_flag(dialect, swi)).
 :- use_module(library(shlib), [current_foreign_library/2]).
-:- endif.
 :- use_module(library(prolog_source)).
 :- use_module(library(option)).
 :- use_module(library(error)).
@@ -121,12 +119,12 @@ called_by(on_signal(_,_,New), [New+1]) :-
 
 :- expects_dialect(swi).
 
-:- if(current_prolog_flag(dialect, swi)).
+% :- if(current_prolog_flag(dialect, swi)).
-system_predicate(Goal) :-
+% system_predicate(Goal) :-
-	functor(Goal, Name, Arity),
+% 	functor(Goal, Name, Arity),
-	current_predicate(system:Name/Arity),	% avoid autoloading
+% 	current_predicate(system:Name/Arity),	% avoid autoloading
-	predicate_property(system:Goal, built_in), !.
+% 	predicate_property(system:Goal, built_in), !.
-:-endif.
+% :-endif.
 
 		/********************************
 		*            TOPLEVEL		*
@@ -1452,4 +1450,3 @@ do_xref_source_file(Spec, File, Options) :-
 			     access(read),
 			     file_errors(fail)
 			   ], File), !.
-