diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

exceptions

Browse Source
This commit is contained in:
Vítor Santos Costa 2018-04-04 01:37:15 +01:00
parent 3a44eb657d
commit d379034a96
5 changed files with 145 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
C/errors.c
View File

@ -32,6 +32,48 @@
#endif
#include "Foreign.h"
#define query_key_b(k, ks, q, i) \
if (strcmp(ks,q) == 0) \
{ return i->k ? TermTrue : TermFalse; } \
#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) \
{ return i->k ? MkStringTerm(i->k) : TermNil; }
static Term queryErr(const char *q, yap_error_descriptor_t *i) {
query_key_i( errorNo, "errorNo", q, i );
query_key_i(errorClass, "errorClass", q, i);
query_key_s(errorAsText, "errorAsText", q, i);
query_key_s( errorGoal, "errorGoal", q, i);
query_key_s( classAsText, "classAsText", q, i);
query_key_i( errorLine, "errorLine", q, i );
query_key_s( errorFunction, "errorFunction", q, i);
query_key_s( errorFile, "errorFile", q, i);
query_key_i( prologPredLine, "prologPredLine", q, i);
query_key_i( prologPredFirstLine, "prologPredFirstLine", q, i);
query_key_i( prologPredLastLine, "prologPredLastLine", q, i);
query_key_s( prologPredName, "prologPredName", q, i);
query_key_i( prologPredArity, "prologPredArity", q, i);
query_key_s( prologPredModule, "prologPredModule", q, i);
query_key_s( prologPredFile, "prologPredFile", q, i);
query_key_i( prologParserPos, "prologParserPos", q, i);
query_key_i( prologParserLine, "prologParserLine", q, i);
query_key_i( prologParserFirstLine, "prologParserFirstLine", q, i);
query_key_i( prologParserLastLine, "prologParserLastLine", q, i);
query_key_s( prologParserText, "prologParserText", q, i);
query_key_s( prologParserFile, "prologParserFile", q, i);
query_key_b( prologConsulting, "prologConsulting", q, i);
query_key_s( culprit, "culprit", q, i);
query_key_s( errorMsg, "errorMsg", q, i);
query_key_i( errorMsgLen, "errorMsgLen", q, i);
return TermNil;
}
static void print_key_b(const char *key, bool v)
{
const char *b = v ? "true" : "false";
@ -914,10 +956,10 @@ const char *Yap_errorClassName(yap_error_class_number e) {
Term Yap_GetException(void) {
CACHE_REGS
if (LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
yap_error_descriptor_t *t = LOCAL_ActiveError;
Term rc = mkerrort(t->errorNo, Yap_BufferToTerm(t->culprit, TermNil), err2list(t));
Yap_DebugPlWriteln(rc);
Yap_ResetException(worker_id);
yap_error_descriptor_t *t = LOCAL_ActiveError, *nt = malloc(sizeof(yap_error_descriptor_t));
memcpy(nt,t,sizeof(yap_error_descriptor_t));
Term rc = mkerrort(t->errorNo, Yap_BufferToTerm(t->culprit, TermNil), MkAddressTerm(nt));
Yap_ResetException(worker_id);
save_H();
return rc;
}
@ -945,6 +987,34 @@ const char *Yap_errorClassName(yap_error_class_number e) {
static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); }
static Int read_exception(USES_REGS1) {
yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1));
Term rc = mkerrort(t->errorNo, Yap_BufferToTerm(t->culprit, TermNil), err2list(t));
Yap_DebugPlWriteln(rc);
return Yap_unify(ARG2, rc);
}
static Int query_exception(USES_REGS1) {
const char *query;
Term t;
if (IsAtomTerm((t = Deref(ARG1))))
query = RepAtom(AtomOfTerm(t))->StrOfAE;
if (IsStringTerm(t))
query = StringOfTerm(t);
yap_error_descriptor_t *y = AddressOfTerm(Deref(ARG2));
Term rc = queryErr(query, y);
Yap_DebugPlWriteln(rc);
return Yap_unify(ARG3, rc);
}
static Int drop_exception(USES_REGS1) {
yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1));
free(t);
return true;
}
static Int get_exception(USES_REGS1) {
Term t;
@ -959,6 +1029,10 @@ void Yap_InitErrorPreds(void) {
CACHE_REGS
Yap_InitCPred("$reset_exception", 1, reset_exception, 0);
Yap_InitCPred("$get_exception", 1, get_exception, 0);
Yap_InitCPred("$drop_exception", 1, get_exception, 0);
Yap_InitCPred("$read_exception", 2, read_exception, 0);
Yap_InitCPred("$query_exception", 3, query_exception, 0);
Yap_InitCPred("$drop_exception", 1, drop_exception, 0);
Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag);
Yap_InitCPred("is_boolean", 2, is_boolean, TestPredFlag);
Yap_InitCPred("is_callable", 2, is_callable, TestPredFlag);

4
C/text.c
View File

@ -854,9 +854,7 @@ static size_t downcase(void *s0, seq_tv_t *out USES_REGS) {
bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) {
unsigned char *buf;
bool rc;
yap_error_descriptor_t new;
/*
//printf(stderr, "[ %d ", n++) ;
if (inp->type & (YAP_STRING_TERM|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES

2
C/utilpreds.c
View File

@ -1665,7 +1665,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
++ pt0;
ptd0 = pt0;
d0 = *ptd0;
fprintf(stderr,"d0=%lx in attvars after jmp=%p\n", d0, HR);
deref_head(d0, attvars_in_term_unk);
attvars_in_term_nvar:
{

5
C/write.c
View File

@ -1255,11 +1255,9 @@ char *Yap_TermToBuffer(Term t, encoding_t enc, int flags) {
CACHE_REGS
int sno = Yap_open_buf_write_stream(enc, flags);
const char *sf;
yap_error_descriptor_t ne;
if (sno < 0)
return NULL;
Yap_pushErrorContext(&ne);
if (enc)
GLOBAL_Stream[sno].encoding = enc;
else
@ -1271,6 +1269,5 @@ char *Yap_TermToBuffer(Term t, encoding_t enc, int flags) {
char *new = malloc(len + 1);
strcpy(new, sf);
Yap_CloseStream(sno);
Yap_popErrorContext (true);
return new;
}

95
pl/messages.yap
View File

@ -228,12 +228,12 @@ compose_message(myddas_version(Version), _Leve) -->
compose_message(yes, _Level) --> !,
[ 'yes'- [] ].
compose_message(Term, Level) -->
{ '$show_consult_level'(LC) },
location(Term, Level, LC),
{ '$show_consult_level'(LC) },
location( Term, Level, LC),
main_message( Term, Level, LC ),
c_goal( Term, Level ),
caller( Term, Level ),
extra_info( Term, Level ),
extra_info( Term, Level ),
!,
[nl,nl].
compose_message(Term, Level) -->
@ -249,15 +249,23 @@ location(error(syntax_error(_),info(between(_,LN,_), FileName, _ChrPos, _Err)),
location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ , _) -->
!,
[ '~a:~d:0 ' - [FileName,LN] ] .
location( error(_,Term), Level, LC ) -->
location( error(_,Desc), Level, LC ) -->
{ source_location(F0, L),
stream_property(_Stream, alias(loop_stream)) }, !,
display_consulting( F0, Level, LC ),
{ lists:memberchk([p|p(M,Na,Ar,_File,_FilePos)], Term ) },
'$query_exception'(prologPredModule, Desc, M),
'$query_exception'(prologPredName, Desc, Na),
'$query_exception'(prologPredArity, Desc, Ar),
display_consulting( F0, Level, LC )
},
[ '~a:~d:0 ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ].
location( error(_,Term), Level, LC ) -->
{ lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) }, !,
location( error(_,Desc), Level, LC ) -->
'$query_exception'(prologPredFile, Desc, File),
display_consulting( File, Level, LC ),
'$query_exception'(prologPredLine, Desc, FilePos),
'$query_exception'(prologPredModule, Desc, M),
'$query_exception'(prologPredName, Desc, Na),
'$query_exception'(prologPredArity, Desc, Ar)
},
[ '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ].
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
@ -284,25 +292,25 @@ main_message(error(style_check(style_check(singleton(SVs),_Pos,_File,P)),_), Lev
}.
main_message(error(style_check(style_check(multiple(N,A,Mod,I0),_Pos,File,_P)),_), Level, _LC) -->
!,
[ ' ~a: ~a redefines ~q from ~a.' - [Level,File, Mod:N/A, I0] ].
[ ' ~a: ~a redefines ~q from ~a.' - [Level,File, Mod:N/A, I0] ].
main_message(error(style_check(style_check(discontiguous(N,A,Mod),_S,_W,_P)),_) , Level, _LC)-->
!,
[ ' ~a: discontiguous definition for ~p.' - [Level,Mod:N/A] ].
[ ' ~a: discontiguous definition for ~p.' - [Level,Mod:N/A] ].
main_message(error(consistency_error(Who)), Level, _LC) -->
!,
[ ' ~a: has argument ~a not consistent with type.'-[Level,Who] ].
[ ' ~a: has argument ~a not consistent with type.'-[Level,Who] ].
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 ].
[ ' ~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 ].
[ ' ~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) -->
@ -327,29 +335,50 @@ display_consulting( F, Level, LC) -->
display_consulting(_F, _, _LC) -->
[].
caller( error(_,Term), _) -->
{ lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) },
{ lists:memberchk([g|g(Call)], Term) },
!,
['~*|goal was ~q' - [10,Call]],
caller( error(_,Desc), _) -->
{
'$query_exception'(errorGoal, Desc, Call),
Call \= [],
'$query_exception'(prologPredFile, Desc, File),
File \= [],
'$query_exception'(prologPredLine, Desc, FilePos),
'$query_exception'(prologPredModule, Desc, M),
'$query_exception'(prologPredName, Desc, Na),
'$query_exception'(prologPredArity, Desc, Ar)
},
!,
['~*|goal was ~s' - [10,Call]],
[nl],
['~*|exception raised from ~a:~q:~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]],
[nl].
caller( error(_,Term), _) -->
{ lists:memberchk([e|p(M,Na,Ar,File,FilePos)], Term ) },
caller( error(_,Desc), _) -->
{
'$query_exception'(prologPredFile, Desc, File),
File \= [],
'$query_exception'(prologPredLine, Desc, FilePos),
'$query_exception'(prologPredModule, Desc, M),
'$query_exception'(prologPredName, Desc, Na),
'$query_exception'(prologPredArity, Desc, Ar)
},
!,
['~*|exception raised from ~a:~q/~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]],
[nl].
caller( error(_,Term), _) -->
{ lists:memberchk([g|g(Call)], Term) },
caller( error(_,Desc), _) -->
{
'$query_exception'(errorGoal, Desc, Call),
Call \= [] },
!,
['~*|goal ~q '-[10,Call]],
[nl].
caller( _, _) -->
[].
c_goal( error(_,Term), Level ) -->
{ lists:memberchk([c|c(File, Line, Func)], Term ) },
c_goal( error(_,Desc), Level ) -->
{ '$query_exception'(errorFile, 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]],
[nl].
@ -576,7 +605,11 @@ domain_error(Domain, Opt) -->
[ '~w not a valid element for ~w' - [Opt,Domain] ].
extra_info( error(_,Extra), _ ) -->
{lists:memberchk([i|Msg], Extra)}, !,
{
'$query_exception'(prologPredFile, Extra, Msg),
Msg != []
},
!,
['~*|user provided data is: ~q' - [10,Msg]],
[nl].
extra_info( _, _ ) -->