Merge vcosta-laptop:github/yap-6.3

This commit is contained in:
Vitor Santos Costa 2018-02-21 17:41:20 +00:00
commit 13f36c1f67
17 changed files with 188 additions and 73 deletions

View File

@ -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) {
LOCAL_Error_Size = strlen(msg);
if (fmt) {
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;
}

View File

@ -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_Error(SYNTAX_ERROR, ARG2, "converting number");
Yap_InitError(SYNTAX_ERROR, ARG2, "while converting stream %d to number", inp-GLOBAL_Stream );
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;
}

View File

@ -736,21 +736,23 @@ 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;
int i = push_text_stack();
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;
o = out->val.t = Yap_BufferToTerm(s, TermNil);
LOCAL_Error_TYPE = erro;
yap_error_descriptor_t new_error;
Yap_pushErrorContext(&new_error);
o = out->val.t = Yap_BufferToTerm(s, TermNil);
Yap_popErrorContext(true);
return o;
return o;
}
bool write_Text(unsigned char *inp, seq_tv_t *out USES_REGS) {

View File

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

View File

@ -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__)

View File

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

View File

@ -95,9 +95,7 @@ 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);
Yap_CloseStream(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return t;
}

View File

@ -324,9 +324,9 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos) {
CELL *Hi = HR;
TokEntry *tok = LOCAL_tokptr;
Int cline = tok->TokLine;
Int startpos = tok->TokPos;
errtok = LOCAL_toktide;
Int errpos = errtok->TokPos;
Int startpos = tok->TokPos;
errtok = LOCAL_toktide;
Int errpos = errtok->TokPos;
UInt diff = 0;
startline = MkIntegerTerm(cline);
endline = MkIntegerTerm(cline);
@ -335,15 +335,15 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos) {
if (LOCAL_ErrorMessage)
tm = MkStringTerm(LOCAL_ErrorMessage);
else {
tm = MkStringTerm("syntax error");
tm = MkStringTerm("syntax error");
}
if (GLOBAL_Stream[sno].status & Seekable_Stream_f) {
if (errpos && newpos >= 0) {
char o[128 + 1];
diff = errpos - startpos;
if (diff > 128) {
diff = 128;
startpos = errpos - diff;
diff = 128;
startpos = errpos - diff;
}
#if HAVE_FTELLO
Int curpos = ftello(GLOBAL_Stream[sno].file);
@ -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;

View File

@ -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(:).
/*******************************
@ -4499,14 +4499,14 @@ check_java_libs(JVM, Java) :-
libfile( java, Root, Java), !.
% try JAVA_HOME, registry, etc..
location( java_root, _, Home) :-
location( java_root, _, Home) :-
getenv( 'JAVA_HOME', Home ).
location(java_root, _, JRE) :-
% OS well-known
member(Root, [ '/usr/lib',
'/usr/local/lib',
'/opt/lib',
'/Library/Java/JavaVirtualMachines',
'/Library/Java/JavaVirtual hines',
'/System/Library/Frameworks'
]),
exists_directory(Root),
@ -4517,13 +4517,13 @@ jdk_jre( Home, J ) :-
absolute_file_name( Extension, [expand(true), relative_to(Home), access(exists), file_type( directory ), file_errors(fail), solutions(all) ], J0 ),
pick_jdk_jre(J0, J).
pick_jdk_jre(J, J).
pick_jdk_jre(J0, J) :-
absolute_file_name( 'jre*', [expand(true), relative_to(J0), access(exists), file_type( directory ), file_errors(fail), solutions(all) ], J ).
pick_jdk_jre(J0, J) :-
absolute_file_name( 'jdk*', [expand(true), relative_to(J0), access(exists), file_type( directory ), file_errors(fail), solutions(all) ], J ).
libfile(Base, HomeLib, File) :-
java_arch( Arch ),
@ -4534,7 +4534,7 @@ libfile(Base, HomeLib, File) :-
jlib(Base, LBase),
atom_concat(['lib',LBase], Lib),
absolute_file_name( Lib, [relative_to(HomeLib), access(read), file_type( executable), expand(true), file_errors(fail), solutions(all)], File ).
jlib( jvm, '/server/libjvm' ).
jlib( jvm, '/client/libjvm' ).
jlib( java, '/libjava' ).
@ -4616,10 +4616,10 @@ add_jpl_to_ldpath(JPL, File) :-
% This appears to work on Windows. Unfortunately most Unix systems
% appear to inspect the content of LD_LIBRARY_PATH only once.
add_java_to_ldpath(_LIBJAVA, LIBJVM) :-
add_java_to_ldpath(_LIBJAVA, LIBJVM) :-
add_lib_to_ldpath(LIBJVM),
fail.
add_java_to_ldpath(LIBJAVA, _LIBJVM) :-
add_java_to_ldpath(LIBJAVA, _LIBJVM) :-
add_lib_to_ldpath(LIBJAVA),
fail.
add_java_to_ldpath(_,_).

View File

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

View File

@ -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),

View File

@ -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.
@ -232,7 +231,7 @@ prolog:phrase(V, S0, S) :-
'$do_error'(instantiation_error,phrase(V,S0,S)).
prolog:phrase([H|T], S0, S) :-
!,
S0 = [H|S1],
S0 = [H|S1],
'$phrase_list'(T, S1, S).
prolog:phrase([], S0, S) :-
!,
@ -313,10 +312,10 @@ prolog:'\\+'(A, S0, S) :-
do_c_built_in('C'(A,B,C), _, _, (A=[B|C])) :- !.
do_c_built_in(phrase(NT,Xs0, Xs),Mod, _, NewGoal) :-
do_c_built_in(phrase(NT,Xs0, Xs),Mod, _, NewGoal) :-
nonvar(NT), nonvar(Mod), !,
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal).
do_c_built_in(phrase(NT,Xs),Mod,_,NewGoal) :-
nonvar(NT), nonvar(Mod),
'$c_built_in_phrase'(NT, Xs, [], Mod, NewGoal).

View File

@ -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), !.

View File

@ -73,7 +73,7 @@ meta_predicate declaration
retractall(prolog:'$meta_predicate'(F,M2,N,_)),
fail.
'$install_meta_predicate'(P,M,F,N) :-
( M = prolog -> M2 = _ ; M2 = M),
( M = prolog -> M2 = _ ; M2 = M),
assertz('$meta_predicate'(F,M2,N,P)).
% comma has its own problems.
@ -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,HM,SM,BM,HVars).
'$expand_goals'(\+A,\+A1,(AO-> false;true),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),
@ -606,5 +607,5 @@ meta_predicate(P) :-
'|'(2,2,?,?),
->(2,2,?,?),
\+(2,?,?),
\+( 0 )
\+( 0 )
.

View File

@ -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_term( T, T1),
'$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),

View File

@ -116,8 +116,8 @@ debugging(Topic) :-
debugging(Topic, Bool) :-
debugging(Topic, Bool, _To).
%% debug(+Topic) is det.
%% nodebug(+Topic) is det.
%% @pred debug(+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

View File

@ -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)).
system_predicate(Goal) :-
functor(Goal, Name, Arity),
current_predicate(system:Name/Arity), % avoid autoloading
predicate_property(system:Goal, built_in), !.
:-endif.
% :- if(current_prolog_flag(dialect, swi)).
% system_predicate(Goal) :-
% functor(Goal, Name, Arity),
% current_predicate(system:Name/Arity), % avoid autoloading
% predicate_property(system:Goal, built_in), !.
% :-endif.
/********************************
* TOPLEVEL *
@ -1452,4 +1450,3 @@ do_xref_source_file(Spec, File, Options) :-
access(read),
file_errors(fail)
], File), !.