From 5f989e58b21b9e743291686a82c56e5f2a464f72 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 22 Oct 2018 12:38:13 +0100 Subject: [PATCH] holes --- C/absmi.c | 8 +- C/absmi_insts.i | 18 +- C/errors.c | 107 +++-- C/parser.c | 19 +- C/stack.c | 22 +- C/text.c | 2 +- H/YapText.h | 5 +- include/YapError.h | 41 +- include/YapErrors.h | 8 +- os/format.c | 64 ++- os/iopreds.h | 2 +- os/readterm.c | 1101 +++++++++++++++++++++---------------------- pl/consult.yap | 2 +- pl/messages.yap | 60 ++- 14 files changed, 756 insertions(+), 703 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 4dfb6f197..76f9cfc73 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -219,12 +219,12 @@ static int check_alarm_fail_int(int CONT USES_REGS) { } static int stack_overflow(PredEntry *pe, CELL *env, yamop *cp, - arity_t nargs USES_REGS) { + arity_t nargs USES_REGS) { if (Unsigned(YREG) - Unsigned(HR) < StackGap(PASS_REGS1) || Yap_get_signal(YAP_STOVF_SIGNAL)) { S = (CELL *)pe; if (!Yap_locked_gc(nargs, env, cp)) { - Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK, "stack overflow: gc failed"); return 0; } return 1; @@ -239,7 +239,7 @@ static int code_overflow(CELL *yenv USES_REGS) { /* do a garbage collection first to check if we can recover memory */ if (!Yap_locked_growheap(false, 0, NULL)) { Yap_NilError(RESOURCE_ERROR_HEAP, "YAP failed to grow heap: %s", - LOCAL_ErrorMessage); + "malloc/mmap failed"); return 0; } CACHE_A1(); @@ -689,7 +689,7 @@ static int interrupt_deallocate(USES_REGS1) { return rc; } if (!Yap_locked_gc(0, ENV, YESCODE)) { - Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK, "stack overflow: gc failed"); } S = ASP; S[E_CB] = (CELL)(LCL0 - cut_b); diff --git a/C/absmi_insts.i b/C/absmi_insts.i index 8c70a2895..6e2e8885c 100644 --- a/C/absmi_insts.i +++ b/C/absmi_insts.i @@ -1102,7 +1102,7 @@ PP = NULL; #endif if (!Yap_gc(3, ENV, CP)) { - Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK, "stack overflow: gc failed"); FAIL(); } #if defined(YAPOR) || defined(THREADS) @@ -1226,7 +1226,7 @@ PREG = NEXTOP(PREG,Osbpa); saveregs(); if (!Yap_gcl(sz, arity, YENV, PREG)) { - Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed"); setregs(); FAIL(); } else { @@ -10927,7 +10927,7 @@ /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxx),Osbpp))) { - Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed"); setregs(); JMPNext(); } else { @@ -11044,7 +11044,7 @@ /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxc),Osbpp))) { - Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed"); setregs(); JMPNext(); } else { @@ -11154,7 +11154,7 @@ /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gc(0, YREG, NEXTOP(NEXTOP(PREG,xxn),Osbpp))) { - Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed"); setregs(); JMPNext(); } else { @@ -11261,7 +11261,7 @@ /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxx),Osbpp))) { - Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed"); setregs(); JMPNext(); } else { @@ -11388,7 +11388,7 @@ /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxc),Osbpp))) { - Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed"); setregs(); JMPNext(); } else { @@ -11516,7 +11516,7 @@ /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxn),Osbpp))) { - Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed"); setregs(); JMPNext(); } else { @@ -11892,7 +11892,7 @@ /* make sure we have something to show for our trouble */ saveregs(); if (!Yap_gcl((1+d1)*sizeof(CELL), 3, YREG, NEXTOP(NEXTOP(PREG,e),Osbmp))) { - Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed" ); setregs(); JMPNext(); } else { diff --git a/C/errors.c b/C/errors.c index 2f36f29b3..4abbf4d56 100755 --- a/C/errors.c +++ b/C/errors.c @@ -35,7 +35,7 @@ #define set_key_b(k, ks, q, i, t) \ if (strcmp(ks, q) == 0) { \ - i->k = t == TermTrue ? true : false; \ + i->k = ( t == TermTrue ? true : false); \ return i->k || t == TermFalse; \ } @@ -67,18 +67,18 @@ static bool setErr(const char *q, yap_error_descriptor_t *i, Term t) { set_key_s(errorFunction, "errorFunction", q, i, t); set_key_s(errorFile, "errorFile", q, i, t); set_key_i(prologPredLine, "prologPredLine", q, i, t); - set_key_i(prologPredFirstLine, "prologPredFirstLine", q, i, t); - set_key_i(prologPredLastLine, "prologPredLastLine", q, i, t); set_key_s(prologPredName, "prologPredName", q, i, t); set_key_i(prologPredArity, "prologPredArity", q, i, t); set_key_s(prologPredModule, "prologPredModule", q, i, t); set_key_s(prologPredFile, "prologPredFile", q, i, t); - set_key_i(prologParserPos, "prologParserPos", q, i, t); - set_key_i(prologParserLine, "prologParserLine", q, i, t); - set_key_i(prologParserFirstLine, "prologParserFirstLine", q, i, t); - set_key_i(prologParserLastLine, "prologParserLastLine", q, i, t); - set_key_s(prologParserText, "prologParserText", q, i, t); - set_key_s(prologParserFile, "prologParserFile", q, i, t); + set_key_i(parserPos, "parserPos", q, i, t); + set_key_i(parserLine, "parserLine", q, i, t); + set_key_i(parserFirstLine, "parserFirstLine", q, i, t); + set_key_i(parserLastLine, "parserLastLine", q, i, t); + set_key_s(parserTextA, "parserTextA", q, i, t); + set_key_s(parserTextB, "parserTextB", q, i, t); + set_key_s(parserFile, "parserFile", q, i, t); + set_key_b(parserReadingCode, "parserReadingcode", q, i, t); set_key_b(prologConsulting, "prologConsulting", q, i, t); set_key_s(culprit, "culprit", q, i, t); set_key_s(errorMsg, "errorMsg", q, i, t); @@ -116,18 +116,18 @@ static Term queryErr(const char *q, yap_error_descriptor_t *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_i(parserPos, "parserPos", q, i); + query_key_i(parserLine, "parserLine", q, i); + query_key_i(parserFirstLine, "parserFirstLine", q, i); + query_key_i(parserLastLine, "parserLastLine", q, i); + query_key_s(parserTextA, "parserTextA", q, i); + query_key_s(parserTextB, "parserTextB", q, i); + query_key_s(parserFile, "parserFile", q, i); + query_key_b(parserReadingCode, "parserReadingCode", q, i); query_key_b(prologConsulting, "prologConsulting", q, i); query_key_t(culprit, "culprit", q, i); query_key_s(errorMsg, "errorMsg", q, i); @@ -162,18 +162,18 @@ static void printErr(yap_error_descriptor_t *i) { print_key_s("errorFunction", i->errorFunction); print_key_s("errorFile", i->errorFile); print_key_i("prologPredLine", i->prologPredLine); - print_key_i("prologPredFirstLine", i->prologPredFirstLine); - print_key_i("prologPredLastLine", i->prologPredLastLine); print_key_s("prologPredName", i->prologPredName); print_key_i("prologPredArity", i->prologPredArity); print_key_s("prologPredModule", i->prologPredModule); print_key_s("prologPredFile", i->prologPredFile); - print_key_i("prologParserPos", i->prologParserPos); - print_key_i("prologParserLine", i->prologParserLine); - print_key_i("prologParserFirstLine", i->prologParserFirstLine); - print_key_i("prologParserLastLine", i->prologParserLastLine); - print_key_s("prologParserText", i->prologParserText); - print_key_s("prologParserFile", i->prologParserFile); + print_key_i("parserPos", i->parserPos); + print_key_i("parserLine", i->parserLine); + print_key_i("parserFirstLine", i->parserFirstLine); + print_key_i("parserLastLine", i->parserLastLine); + print_key_s("parserTextA", i->parserTextA); + print_key_s("parserTextB", i->parserTextB); + print_key_s("parserFile", i->parserFile); + print_key_b("parserReadingCode", i->parserReadingCode); print_key_b("prologConsulting", i->prologConsulting); print_key_s("culprit", i->culprit); if (i->errorMsgLen) { @@ -220,18 +220,18 @@ static Term err2list(yap_error_descriptor_t *i) { o = add_key_s("errorFunction", i->errorFunction, o); o = add_key_s("errorFile", i->errorFile, o); o = add_key_i("prologPredLine", i->prologPredLine, o); - o = add_key_i("prologPredFirstLine", i->prologPredFirstLine, o); - o = add_key_i("prologPredLastLine", i->prologPredLastLine, o); o = add_key_s("prologPredName", i->prologPredName, o); o = add_key_i("prologPredArity", i->prologPredArity, o); o = add_key_s("prologPredModule", i->prologPredModule, o); o = add_key_s("prologPredFile", i->prologPredFile, o); - o = add_key_i("prologParserPos", i->prologParserPos, o); - o = add_key_i("prologParserLine", i->prologParserLine, o); - o = add_key_i("prologParserFirstLine", i->prologParserFirstLine, o); - o = add_key_i("prologParserLastLine", i->prologParserLastLine, o); - o = add_key_s("prologParserText", i->prologParserText, o); - o = add_key_s("prologParserFile", i->prologParserFile, o); + o = add_key_i("parserPos", i->parserPos, o); + o = add_key_i("parserLine", i->parserLine, o); + o = add_key_i("parserFirstLine", i->parserFirstLine, o); + o = add_key_i("parserLastLine", i->parserLastLine, o); + o = add_key_s("parserTextA", i->parserTextA, o); + o = add_key_s("parserTextB", i->parserTextB, o); + o = add_key_s("parserFile", i->parserFile, o); + o = add_key_b("parserReadingCode", i->parserReadingCode, o); o = add_key_b("prologConsulting", i->prologConsulting, o); o = add_key_s("culprit", i->culprit, o); if (i->errorMsgLen) { @@ -317,7 +317,7 @@ void Yap_InitError__(const char *file, const char *function, int lineno, if (fmt) { LOCAL_Error_Size = strlen(tmpbuf); LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1); - strcpy(LOCAL_ActiveError->errorMsg, tmpbuf); + strcpy((char *)LOCAL_ActiveError->errorMsg, tmpbuf); } else { LOCAL_Error_Size = 0; } @@ -334,6 +334,7 @@ bool Yap_PrintWarning(Term twarning) { Term ts[2], err; if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError && + LOCAL_ActiveError->errorClass != WARNING && (err = LOCAL_ActiveError->errorNo)) { fprintf(stderr, "%% Warning %s while processing error: %s %s\n", Yap_TermToBuffer(twarning, @@ -423,9 +424,7 @@ int Yap_SWIHandleError(const char *s, ...) { yap_error_number err = LOCAL_Error_TYPE; char *serr; - if (LOCAL_ErrorMessage) { - serr = LOCAL_ErrorMessage; - } else { + if (s) { serr = (char *)s; } switch (err) { @@ -575,9 +574,12 @@ static char tmpbuf[YAP_BUF_SIZE]; #include "YapErrors.h" -bool Yap_pushErrorContext(bool pass, yap_error_descriptor_t *new_error) { +/// add a new error descriptor, either to the top of the stack, +/// or replacing the top; +bool Yap_pushErrorContext(bool link , yap_error_descriptor_t *new_error) { memset(new_error, 0, sizeof(yap_error_descriptor_t)); - new_error->top_error = LOCAL_ActiveError; + if (link) + new_error->top_error = LOCAL_ActiveError; LOCAL_ActiveError = new_error; return true; } @@ -645,6 +647,16 @@ void Yap_ThrowExistingError(void) { Yap_exit(5); } +Term Yap_MkFullError(void) +{ + yap_error_descriptor_t *i = Yap_local.ActiveError; + i->errorAsText = Yap_errorName( i->errorNo ); + i->errorClass = Yap_errorClass( i-> errorNo ); + i->classAsText = Yap_errorClassName(i->errorClass); + return mkerrort(i->errorNo, TermNil , MkSysError(i) ); +} + + 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) { @@ -656,9 +668,9 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file, r->culprit = Yap_TermToBuffer( where, Quote_illegal_f | Ignore_ops_f); } - if (LOCAL_consult_level > 0) { - r->prologParserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE; - r->prologParserLine = Yap_source_line_no(); + if (type != SYNTAX_ERROR && LOCAL_consult_level > 0) { + r->parserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE; + r->parserLine = Yap_source_line_no(); } r->errorNo = type; r->errorAsText = Yap_errorName(type); @@ -670,6 +682,7 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file, LOCAL_PrologMode |= InErrorMode; Yap_ClearExs(); // first, obtain current location + // sprintf(LOCAL_FileNameBuf, "%s:%d in C-function %s ", file, lineno, // function); // tf = MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)); @@ -694,13 +707,11 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file, } // fprintf(stderr, "warning: "); if (s && s[0]) { + char *ns; r->errorMsgLen = strlen(s) + 1; - r->errorMsg = malloc(r->errorMsgLen); - strcpy(r->errorMsg, s); - } else if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) { - r->errorMsgLen = strlen(LOCAL_ErrorMessage) + 1; - r->errorMsg = malloc(r->errorMsgLen); - strcpy(r->errorMsg, LOCAL_ErrorMessage); + ns = malloc(r->errorMsgLen); + strcpy(ns, s); + r->errorMsg = ns; } else { r->errorMsgLen = 0; r->errorMsg = 0; diff --git a/C/parser.c b/C/parser.c index fca64504a..b83ecb453 100755 --- a/C/parser.c +++ b/C/parser.c @@ -60,12 +60,12 @@ static void syntax_msg(const char *msg, ...) { va_list ap; if (!LOCAL_ErrorMessage || (LOCAL_Error_TYPE == SYNTAX_ERROR && - LOCAL_tokptr->TokPos < LOCAL_ActiveError->prologParserPos)) { + LOCAL_tokptr->TokPos < LOCAL_ActiveError->parserPos)) { if (!LOCAL_ErrorMessage) { LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1); } - LOCAL_ActiveError->prologParserLine = LOCAL_tokptr->TokLine; - LOCAL_ActiveError->prologParserPos = LOCAL_tokptr->TokPos; + LOCAL_ActiveError->parserLine = LOCAL_tokptr->TokLine; + LOCAL_ActiveError->parserPos = LOCAL_tokptr->TokPos; va_start(ap, msg); vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, msg, ap); va_end(ap); @@ -911,12 +911,17 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) { CACHE_REGS // ensure that if we throw an exception // t will be 0. + LOCAL_ActiveError->errorMsg=NULL; + LOCAL_ActiveError->errorMsgLen=0; Volatile Term t = 0; JMPBUFF FailBuff; yhandle_t sls = Yap_StartSlots(); + LOCAL_ErrorMessage = NULL; LOCAL_toktide = LOCAL_tokptr; if (!sigsetjmp(FailBuff.JmpBuff, 0)) { + LOCAL_ActiveError->errorMsg=NULL; + LOCAL_ActiveError->errorMsgLen=0; t = ParseTerm(prio, &FailBuff, enc, cmod PASS_REGS); #if DEBUG @@ -936,9 +941,13 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) { if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) { LOCAL_Error_TYPE = SYNTAX_ERROR; if (LOCAL_tokptr->TokNext) { - LOCAL_ErrorMessage = "bracket or operator expected."; + size_t sz = strlen("bracket or operator expected."); + LOCAL_ErrorMessage =malloc(sz+1); + strncpy(LOCAL_ErrorMessage, "bracket or operator expected.", sz ); } else { - LOCAL_ErrorMessage = "term must end with . or EOF."; + size_t sz = strlen("term must end with . or EOF."); + LOCAL_ErrorMessage =malloc(sz+1); + strncpy(LOCAL_ErrorMessage,"term must end with . or EOF.", sz ); } t = 0; } diff --git a/C/stack.c b/C/stack.c index dab4238dd..ec841968d 100644 --- a/C/stack.c +++ b/C/stack.c @@ -1124,7 +1124,7 @@ static Term clause_info(yamop *codeptr, PredEntry *pp) { yap_error_descriptor_t *set_clause_info(yap_error_descriptor_t *t, yamop *codeptr, PredEntry *pp) { CACHE_REGS - Term ts[2]; + void *begin; if (pp->ArityOfPE == 0) { t->prologPredName = AtomName((Atom)pp->FunctorOfPred); @@ -1138,36 +1138,18 @@ yap_error_descriptor_t *set_clause_info(yap_error_descriptor_t *t, : "prolog"); t->prologPredFile = RepAtom(pp->src.OwnerFile)->StrOfAE; if (codeptr->opc == UNDEF_OPCODE) { - t->prologPredFirstLine = 0; t->prologPredLine = 0; - t->prologPredLastLine = 0; return t; } else if (pp->cs.p_code.NOfClauses) { - if ((t->prologPredCl = find_code_in_clause(pp, codeptr, &begin, NULL)) <= + if ((t->prologPredLine = find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) { t->prologPredLine = 0; } else { t->prologPredLine = IntegerOfTerm(clause_loc(begin, pp)); } - if (pp->PredFlags & LogUpdatePredFlag) { - t->prologPredFirstLine = - clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp); - t->prologPredLastLine = - clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause), pp); - - } else { - t->prologPredFirstLine = IntegerOfTerm( - ts[0] = clause_loc( - ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp)); - t->prologPredLastLine = IntegerOfTerm( - ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause), - pp)); - } return t; } else { - t->prologPredFirstLine = 0; t->prologPredLine = t->errorLine; - t->prologPredLastLine = 0; t->prologPredFile = t->errorFile; return t; } diff --git a/C/text.c b/C/text.c index b161b6456..e64e41bf3 100644 --- a/C/text.c +++ b/C/text.c @@ -990,7 +990,7 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) { else fprintf(stderr, "%s", out->val.c); fprintf(stderr, "\n]\n"); */ - pop_text_stack(l); + out->val.uc = pop_output_text_stack(l,out->val.uc); return rc; } diff --git a/H/YapText.h b/H/YapText.h index ee3cec3b1..1fef851a2 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -175,7 +175,10 @@ INLINE_ONLY char_kind_t chtype(Int ch) { #endif extern const char *Yap_tokText(void *tokptr); -extern Term Yap_tokRep(void *tokptr); +/// represent token *_tokptr_ in string s, maxlength is sz-1 +/// +/// conversion is based on token type. +extern Term Yap_tokRep(void *tokptrXS); // standard strings diff --git a/include/YapError.h b/include/YapError.h index bc3d23869..925e2cb3b 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -200,33 +200,51 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line, /// all we need to know about an error/throw typedef struct s_yap_error_descriptor { + /// error identifier yap_error_number errorNo; + /// kind of error: derived from errorNo; yap_error_class_number errorClass; + /// if non-NULL: goal who caused error; const char *errorGoal; + /// errorNo as text const char *errorAsText; + /// errorClass as text const char *classAsText; + /// c-code that generated the error + /// C-line intptr_t errorLine; + /// C-function const char *errorFunction; + /// C-file const char *errorFile; // struct error_prolog_source *errorSource; - intptr_t prologPredCl; - uintptr_t prologPredLine; - uintptr_t prologPredFirstLine; - uintptr_t prologPredLastLine; + /// Prolog predicate that caused the error: name const char *prologPredName; + /// Prolog predicate that caused the error:arity uintptr_t prologPredArity; + /// Prolog predicate that caused the error:module const char *prologPredModule; + /// Prolog predicate that caused the error:line const char *prologPredFile; - uintptr_t prologParserPos; - uintptr_t prologParserLine; - uintptr_t prologParserFirstLine; - uintptr_t prologParserLastLine; - const char *prologParserText; - const char *prologParserFile; + /// line where error clause defined + uintptr_t prologPredLine; + /// syntax and other parsing errors + uintptr_t parserPos; + uintptr_t parserFirstPos; + uintptr_t parserLastPos; + uintptr_t parserLine; + uintptr_t parserFirstLine; + uintptr_t parserLastLine; + const char *parserTextA; + const char *parserTextB; + const char *parserFile; + /// reading a clause, or called from read? + bool parserReadingCode; + /// whether we are consulting bool prologConsulting; const char *culprit; YAP_Term errorRawTerm, rawExtraErrorTerm; - char *errorMsg; + char *errorMsg; size_t errorMsgLen; struct s_yap_error_descriptor *top_error; } yap_error_descriptor_t; @@ -242,6 +260,7 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line, extern void Yap_CatchError(void); extern void Yap_ThrowExistingError(void); + extern YAP_Term Yap_MkFullError(void); extern bool Yap_MkErrorRecord( yap_error_descriptor_t * r, const char *file, const char *function, int lineno, yap_error_number type, YAP_Term where, const char *msg); diff --git a/include/YapErrors.h b/include/YapErrors.h index 84f40ed11..491945f9b 100644 --- a/include/YapErrors.h +++ b/include/YapErrors.h @@ -32,6 +32,8 @@ ECLASS(SYSTEM_ERROR_CLASS, "system_error", 1) ECLASS(TYPE_ERROR, "type_error", 2) /// should be unbound ECLASS(UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error", 1) +/// not quite an error, but almost +ECLASS(WARNING, "warning", 1) /// user defined escape hatch ECLASS(EVENT, "event", 1) @@ -196,7 +198,11 @@ E(TYPE_ERROR_REFERENCE, TYPE_ERROR, "reference") E(TYPE_ERROR_STRING, TYPE_ERROR, "string") E(TYPE_ERROR_TEXT, TYPE_ERROR, "text") E(TYPE_ERROR_UBYTE, TYPE_ERROR, "ubyte") -E(TYPE_ERROR_UCHAR, TYPE_ERROR, "uchar") +E(TYPE_ERROR_UCHAR, TYPE_ERROR, "unsigned char") + +E(WARNING_DISCONTIGUOUS, WARNING, "discontiguous") +E(WARNING_SINGLETONS, WARNING, "singletons") +E(WARNING_SYNTAX_ERROR, WARNING, "syntax_error") E1(UNINSTANTIATION_ERROR, UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error") diff --git a/os/format.c b/os/format.c index edd7eece0..2444950af 100644 --- a/os/format.c +++ b/os/format.c @@ -278,33 +278,55 @@ static int format_print_str(Int sno, Int size, Int has_size, Term args, while (*pt && (!has_size || size > 0)) { utf8proc_int32_t ch; + if ((pt += get_utf8(pt, -1, &ch)) > 0) { + f_putc(sno, ch); + } + } + } else if (IsAtomTerm(args)) { + const unsigned char *pt = RepAtom(AtomOfTerm(args))->UStrOfAE; + while (*pt && (!has_size || size > 0)) { + utf8proc_int32_t ch; + if ((pt += get_utf8(pt, -1, &ch)) > 0) { f_putc(sno, ch); } } } else { while (!has_size || size > 0) { + bool maybe_chars = true, maybe_codes = true; if (IsVarTerm(args)) { - Yap_Error(INSTANTIATION_ERROR, args, "format/2"); + Yap_ThrowError(INSTANTIATION_ERROR, args, "~s expects a bound argument"); return FALSE; } else if (args == TermNil) { return TRUE; } else if (!IsPairTerm(args)) { - Yap_Error(TYPE_ERROR_LIST, args, "format/2"); + Yap_ThrowError(TYPE_ERROR_TEXT, args, "format expects an atom, string, or list of codes or chars "); return FALSE; } arghd = HeadOfTerm(args); args = TailOfTerm(args); if (IsVarTerm(arghd)) { - Yap_Error(INSTANTIATION_ERROR, arghd, "format/2"); + Yap_ThrowError(INSTANTIATION_ERROR, arghd, "~s expects a bound argument"); return FALSE; - } else if (!IsIntTerm(arghd)) { - Yap_Error(TYPE_ERROR_LIST, arghd, "format/2"); + } else if (maybe_codes && IsIntTerm(arghd)) { + f_putc(sno, (int)IntOfTerm(arghd)); + size--; + maybe_chars = false; + } else if (maybe_chars && IsAtomTerm(arghd)) { + unsigned char *fptr = RepAtom(AtomOfTerm(arghd))->UStrOfAE; + int ch; + fptr += get_utf8(fptr, -1, &ch); + if (fptr[0] != '\0') { + Yap_ThrowError(TYPE_ERROR_TEXT, arghd, "~s expects a list of chars "); + } + f_putc(sno, ch); + size--; + maybe_codes = false; + } else { + Yap_ThrowError(TYPE_ERROR_TEXT, arghd, "~s expects an atom, string, or list of codes or chars "); return FALSE; } - f_putc(sno, (int)IntOfTerm(arghd)); - size--; - } + } } return TRUE; } @@ -313,11 +335,11 @@ static Int format_copy_args(Term args, Term *targs, Int tsz) { Int n = 0; while (args != TermNil) { if (IsVarTerm(args)) { - Yap_Error(INSTANTIATION_ERROR, args, "format/2"); + Yap_ThrowError(INSTANTIATION_ERROR, args, "format/2"); return FORMAT_COPY_ARGS_ERROR; } if (!IsPairTerm(args)) { - Yap_Error(TYPE_ERROR_LIST, args, "format/2"); + Yap_ThrowError(TYPE_ERROR_LIST, args, "format/2"); return FORMAT_COPY_ARGS_ERROR; } if (n == tsz) @@ -402,7 +424,7 @@ static Int doformat(volatile Term otail, volatile Term oargs, *HR++ = otail; if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) { pop_text_stack(l); - Yap_Error(RESOURCE_ERROR_HEAP, otail, "format/2"); + Yap_ThrowError(RESOURCE_ERROR_HEAP, otail, "format/2"); return false; } oargs = HR[-2]; @@ -418,20 +440,20 @@ static Int doformat(volatile Term otail, volatile Term oargs, targ = 0; if (IsVarTerm(tail)) { format_clean_up(sno0, sno, finfo ); - Yap_Error(INSTANTIATION_ERROR, tail, "format/2"); + Yap_ThrowError(INSTANTIATION_ERROR, tail, "format/2"); return (FALSE); } else if ((fstr = Yap_TextToUTF8Buffer(tail))) { fptr = fstr; alloc_fstr = true; } else { format_clean_up(sno0, sno, finfo); - Yap_Error(TYPE_ERROR_TEXT, tail, "format/2"); + Yap_ThrowError(TYPE_ERROR_TEXT, tail, "format/2"); return false; } if (IsVarTerm(args)) { pop_text_stack(l); format_clean_up(sno0, sno, finfo); - Yap_Error(INSTANTIATION_ERROR, args, "format/2"); + Yap_ThrowError(INSTANTIATION_ERROR, args, "format/2"); return FALSE; } while (IsApplTerm(args) && FunctorOfTerm(args) == FunctorModule) { @@ -440,19 +462,19 @@ static Int doformat(volatile Term otail, volatile Term oargs, if (IsVarTerm(fmod)) { format_clean_up(sno0, sno, finfo); pop_text_stack(l); - Yap_Error(INSTANTIATION_ERROR, fmod, "format/2"); + Yap_ThrowError(INSTANTIATION_ERROR, fmod, "format/2"); return false; } if (!IsAtomTerm(fmod)) { format_clean_up(sno0, sno, finfo); pop_text_stack(l); - Yap_Error(TYPE_ERROR_ATOM, fmod, "format/2"); + Yap_ThrowError(TYPE_ERROR_ATOM, fmod, "format/2"); return false; } if (IsVarTerm(args)) { format_clean_up(sno0, sno, finfo); pop_text_stack(l); - Yap_Error(INSTANTIATION_ERROR, args, "format/2"); + Yap_ThrowError(INSTANTIATION_ERROR, args, "format/2"); return FALSE; } } @@ -968,7 +990,7 @@ static Int doformat(volatile Term otail, volatile Term oargs, Term ta[2]; ta[0] = otail; ta[1] = oargs; - Yap_Error(LOCAL_Error_TYPE, + Yap_ThrowError(LOCAL_Error_TYPE, Yap_MkApplTerm(Yap_MkFunctor(AtomFormat, 2), 2, ta), "arguments to format"); } @@ -1028,7 +1050,7 @@ static Term memStreamToTerm(int output_stream, Functor f, Term inp) { } else if (f == FunctorString1) { return Yap_CharsToString(s, enc PASS_REGS); } - Yap_Error(DOMAIN_ERROR_FORMAT_OUTPUT, inp, NULL); + Yap_ThrowError(DOMAIN_ERROR_FORMAT_OUTPUT, inp, NULL); return 0L; } @@ -1088,7 +1110,7 @@ static Int with_output_to(USES_REGS1) { bool mem_stream = false; yhandle_t hdl = Yap_PushHandle(tin); if (IsVarTerm(tin)) { - Yap_Error(INSTANTIATION_ERROR, tin, "with_output_to/3"); + Yap_ThrowError(INSTANTIATION_ERROR, tin, "with_output_to/3"); return false; } if (IsApplTerm(tin) && (f = FunctorOfTerm(tin))) { @@ -1129,7 +1151,7 @@ static Int format(Term tf, Term tas, Term tout USES_REGS) { bool mem_stream = false; if (IsVarTerm(tout)) { - Yap_Error(INSTANTIATION_ERROR, tout, "format/3"); + Yap_ThrowError(INSTANTIATION_ERROR, tout, "format/3"); return false; } yhandle_t hl = Yap_StartHandles(), yo = Yap_PushHandle(tout); diff --git a/os/iopreds.h b/os/iopreds.h index 972937ee0..d64a984e8 100755 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -176,7 +176,7 @@ extern int Yap_peekWide(int sno); extern int Yap_peekChar(int sno); -extern Term Yap_syntax_error(TokEntry *tokptr, int sno); +extern Term Yap_syntax_error(TokEntry *tokptr, int sno, const char *msg); extern int console_post_process_read_char(int, StreamDesc *); extern int console_post_process_eof(StreamDesc *); diff --git a/os/readterm.c b/os/readterm.c index f681e8c32..88067e994 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -1,6 +1,6 @@ /************************************************************************* * * - * YAP Prolog * + * YAP Prolog * * * * Yap Prolog was developed at NCCUP - Universidade do Porto * * * @@ -95,7 +95,7 @@ static char SccsId[] = "%W% %G%"; #define SYSTEM_STAT stat #endif -static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int start); +static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int start, bool code, const char *msg); static void clean_vars(VarEntry *p) { if (p == NULL) @@ -120,23 +120,23 @@ static void clean_vars(VarEntry *p) { static Int qq_open(USES_REGS1) { PRED_LD - Term t = Deref(ARG1); + Term t = Deref(ARG1); if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) = - FunctorDQuasiQuotation) { + FunctorDQuasiQuotation) { void *ptr; char *start; size_t l int s; Term t0, t1, t2; if (IsPointerTerm((t0 = ArgOfTerm(1, t))) && - IsPointerTerm((t1 = ArgOfTerm(2, t))) && - IsIntegerTerm((t2 = ArgOfTerm(3, t)))) { + IsPointerTerm((t1 = ArgOfTerm(2, t))) && + IsIntegerTerm((t2 = ArgOfTerm(3, t)))) { ptr = PointerOfTerm(t0); start = PointerOfTerm(t1); len = IntegerOfTerm(t2); if ((s = Yap_open_buf_read_stream(start, len, ENC_UTF8, MEM_BUF_USER)) < - 0) - return false; + 0) + return false; return Yap_unify(ARG2, Yap_MkStream(s)); } else { Yap_Error(TYPE_ERROR_READ_CONTEXT, t); @@ -157,43 +157,43 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) { if (!_PL_rd->quasi_quotations) { if ((av = PL_new_term_refs(2)) && PL_put_term(av + 0, _PL_rd->qq) && #if __YAP_PROLOG__ - PL_put_atom(av + 1, YAP_SWIAtomFromAtom(_PL_rd->module->AtomOfME)) && + PL_put_atom(av + 1, YAP_SWIAtomFromAtom(_PL_rd->module->AtomOfME)) && #else - PL_put_atom(av + 1, _PL_rd->module->name) && + PL_put_atom(av + 1, _PL_rd->module->name) && #endif - PL_cons_functor_v(av, FUNCTOR_dparse_quasi_quotations2, av)) { - term_t ex; - rc = callProlog(MODULE_system, av + 0, PL_Q_CATCH_EXCEPTION, &ex); - if (rc) - return TRUE; - _PL_rd->exception = ex; - _PL_rd->has_exception = TRUE; + PL_cons_functor_v(av, FUNCTOR_dparse_quasi_quotations2, av)) { + term_t ex; + rc = callProlog(MODULE_system, av + 0, PL_Q_CATCH_EXCEPTION, &ex); + if (rc) + return TRUE; + _PL_rd->exception = ex; + _PL_rd->has_exception = TRUE; } return FALSE; } else return TRUE; } else if (_PL_rd->quasi_quotations) /* user option, but no quotes */ - { - return PL_unify_nil(_PL_rd->quasi_quotations); - } else + { + return PL_unify_nil(_PL_rd->quasi_quotations); + } else return TRUE; } #endif /*O_QUASIQUOTATIONS*/ -#define READ_DEFS() \ - PAR("comments", list_filler, READ_COMMENTS) \ - , PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \ - PAR("output", filler, READ_OUTPUT), \ - PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \ - PAR("term_position", filler, READ_TERM_POSITION), \ - PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \ - PAR("singletons", filler, READ_SINGLETONS), \ - PAR("variables", filler, READ_VARIABLES), \ - PAR("variable_names", filler, READ_VARIABLE_NAMES), \ - PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \ - PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \ - PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END) +#define READ_DEFS() \ + PAR("comments", list_filler, READ_COMMENTS) \ + , PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \ + PAR("output", filler, READ_OUTPUT), \ + PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \ + PAR("term_position", filler, READ_TERM_POSITION), \ + PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \ + PAR("singletons", filler, READ_SINGLETONS), \ + PAR("variables", filler, READ_VARIABLES), \ + PAR("variable_names", filler, READ_VARIABLE_NAMES), \ + PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \ + PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \ + PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END) #define PAR(x, y, z) z @@ -201,7 +201,7 @@ typedef enum open_enum_choices { READ_DEFS() } read_choices_t; #undef PAR -#define PAR(x, y, z) \ +#define PAR(x, y, z) \ { x, y, z } static const param_t read_defs[] = {READ_DEFS()}; @@ -262,7 +262,7 @@ static Term scanToList(TokEntry *tok, TokEntry *errtok) { HR = Hi; tok = tok0; if (!Yap_gcl(used, 1, ENV, CP)) { - return 0; + return 0; } continue; } @@ -305,7 +305,7 @@ static Int scan_to_list(USES_REGS1) { return false; } TokEntry *tok = LOCAL_tokptr = LOCAL_toktide = - Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &tpos); + Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &tpos); UNLOCK(GLOBAL_Stream[inp_stream].streamlock); tout = scanToList(tok, NULL); if (tout == 0) @@ -316,7 +316,7 @@ static Int scan_to_list(USES_REGS1) { } /** - * Syntaax Error Handler + * Syntax Error Handler * * @par tokptr: the sequence of tokens * @par sno: the stream numbet @@ -324,123 +324,107 @@ static Int scan_to_list(USES_REGS1) { * Implicit arguments: * + */ -static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos) { +static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool code, const char *msg) { CACHE_REGS - Term startline, errline, endline; - Term tf[4]; - Term tm; - Term *tailp = tf + 3; - - CELL *Hi = HR; + Yap_MkErrorRecord( LOCAL_ActiveError, __FILE__, __FUNCTION__, __LINE__, SYNTAX_ERROR, 0, NULL); TokEntry *tok = LOCAL_tokptr; - Int cline = tok->TokLine; + Int start_line = tok->TokLine; + Int err_line = errtok->TokLine; + Int end_line = GetCurInpLine(GLOBAL_Stream+sno); Int startpos = tok->TokPos; - errtok = LOCAL_toktide; Int errpos = errtok->TokPos; - UInt diff = 0; - startline = MkIntegerTerm(cline); - Yap_local.ActiveError->errorNo = SYNTAX_ERROR; - Yap_local.ActiveError->prologPredFirstLine = cline; - Yap_local.ActiveError->prologPredLastLine = cline; - endline = MkIntegerTerm(cline); + Int endpos = GetCurInpPos(GLOBAL_Stream+sno); - LOCAL_Error_TYPE = YAP_NO_ERROR; - errline = MkIntegerTerm(errtok->TokLine); - Yap_local.ActiveError->prologPredLine = errtok->TokLine; - if (!LOCAL_ErrorMessage) { - LOCAL_ErrorMessage = "syntax error"; - } - tm = MkStringTerm(LOCAL_ErrorMessage); - { - char *s = malloc(strlen(LOCAL_ErrorMessage) + 1); - strcpy(s, LOCAL_ErrorMessage); - Yap_local.ActiveError->errorMsg = s; - } - 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; - } + Yap_local.ActiveError->errorNo = SYNTAX_ERROR; + Yap_local.ActiveError->parserFirstLine = start_line; + Yap_local.ActiveError->parserLine = err_line; + Yap_local.ActiveError->parserLastLine = end_line; + Yap_local.ActiveError->parserFirstPos = startpos; + Yap_local.ActiveError->parserPos = errpos; + Yap_local.ActiveError->parserLastPos =endpos; + Yap_local.ActiveError->parserFile = + RepAtom(AtomOfTerm((GLOBAL_Stream+sno)->user_name))->StrOfAE; + Yap_local.ActiveError->parserReadingCode = code; #if HAVE_FTELLO - Int curpos = ftello(GLOBAL_Stream[sno].file); fseeko(GLOBAL_Stream[sno].file, startpos, SEEK_SET); #else - Int curpos = ftell(GLOBAL_Stream[sno].file); fseek(GLOBAL_Stream[sno].file, startpos, SEEK_SET); #endif - fread(o, diff, 1, GLOBAL_Stream[sno].file); -#if HAVE_FTELLO - fseeko(GLOBAL_Stream[sno].file, curpos, SEEK_SET); -#else - fseek(GLOBAL_Stream[sno].file, curpos, SEEK_SET); -#endif - o[diff] = '\0'; - tf[3] = MkStringTerm(o); - } - } else { - while (tok) { + int lvl = push_text_stack(); + if (GLOBAL_Stream[sno].status & Seekable_Stream_f) { + char *o, *o2; + if (errpos <= startpos) { + o = malloc(1); + o[0] = '\0'; + } else { + Int sza = (errpos-startpos)+1; + o = malloc(sza); + fread(o,sza-1,1,GLOBAL_Stream[sno].file); + o[sza-1] = '\0'; - if (HR > ASP - 1024) { - errline = MkIntegerTerm(0); - endline = MkIntegerTerm(0); - /* for some reason moving this earlier confuses gcc on solaris */ - HR = Hi; - break; - } - if (tok->TokLine != cline) { - *tailp = MkPairTerm(TermNewLine, TermNil); - tailp = RepPair(*tailp) + 1; - cline = tok->TokLine; - } - if (tok == errtok && tok->Tok != Error_tok) { - *tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil); - tailp = RepPair(*tailp) + 1; - } - Term rep = Yap_tokRep(tok); - if (tok->TokNext) { - tok = tok->TokNext; - } else { - endline = MkIntegerTerm(tok->TokLine); - tok = NULL; - break; - } - *tailp = MkPairTerm(rep, TermNil); - tailp = RepPair(*tailp) + 1; } + Yap_local.ActiveError->parserTextA = o; + if (endpos <= errpos) { + o2 = malloc(1); + o2[0] = '\0'; + } else { + Int sza = (endpos-errpos)+1; + o2 = malloc(sza); + fread(o2,sza-1,1,GLOBAL_Stream[sno].file); + o2[sza-1] = '\0'; + } + Yap_local.ActiveError->parserTextB = o2; + } else { + size_t sz = 1024, total=sz, e; + char *o = malloc(1024); + char *s = o; + o[0] = '\0'; + while (tok) { + if (tok->Tok == Error_tok) { + o = realloc(o, strlen(o)+1); + Yap_local.ActiveError->parserTextA= o; + o = malloc(1024); + total = sz = 1024; + tok = tok->TokNext; + continue; + } + const char *ns = Yap_tokText(tok); + e = strlen(ns); + if (ns && ns[0] && e+1 > sz-256) { + strcat(s,ns); + o += e; + sz -= e; + } + if (tok->TokNext && tok->TokNext->TokLine > tok->TokLine) { + strcat(s,"\n") + ;sz--; + } + tok = tok->TokNext; + } + o = realloc(o, strlen(o)+1); + Yap_local.ActiveError->parserTextA= o; + } - { - Term t[3]; - t[0] = startline; - t[1] = errline; - t[2] = endline; - tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween, 3), 3, t); - } + /* 0: strat, error, end line */ /*2 msg */ /* 1: file */ - tf[1] = Yap_StreamUserName(sno); - tf[2] = MkIntegerTerm(LOCAL_ActiveError->prologParserPos); + if (!msg) + msg = "unspecified"; + Yap_local.ActiveError->culprit = + Yap_local.ActiveError->errorMsg = (char*)msg; + Yap_local.ActiveError->errorMsgLen = strlen(msg); clean_vars(LOCAL_VarTable); clean_vars(LOCAL_AnonVarTable); - Term terr = Yap_MkApplTerm(FunctorInfo4, 4, tf); - Term tn[2]; - tn[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &tm); - tn[1] = terr; - terr = Yap_MkApplTerm(FunctorError, 2, tn); -#if DEBUG if (Yap_ExecutionMode == YAP_BOOT_MODE) { fprintf(stderr, "SYNTAX ERROR while booting: "); - fe } -#endif - return terr; + pop_text_stack(lvl); + return Yap_MkFullError(); } -Term Yap_syntax_error(TokEntry *errtok, int sno) { - return syntax_error(errtok, sno, CurrentModule, -1); +Term Yap_syntax_error(TokEntry *errtok, int sno, const char *msg) { + return syntax_error(errtok, sno, CurrentModule, -1, false, msg); } typedef struct FEnv { @@ -457,6 +441,7 @@ typedef struct FEnv { encoding_t enc; /// encoding of the stream being read Term tcomms; /// Access to comments Term cmod; /// Access to comments + char *msg; /// Error Messagge } FEnv; typedef struct renv { @@ -471,14 +456,14 @@ typedef struct renv { } REnv; static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, - int inp_stream); + int inp_stream); static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { CACHE_REGS - LOCAL_VarTable = NULL; + LOCAL_VarTable = NULL; LOCAL_AnonVarTable = NULL; fe->enc = GLOBAL_Stream[inp_stream].encoding; xarg *args = - Yap_ArgListToVector(opts, read_defs, READ_END, DOMAIN_ERROR_READ_OPTION); + Yap_ArgListToVector(opts, read_defs, READ_END, DOMAIN_ERROR_READ_OPTION); if (args == NULL) { return NULL; } @@ -549,12 +534,13 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { re->prio = IntegerOfTerm(args[READ_PRIORITY].tvalue); if (re->prio > GLOBAL_MaxPriority) { Yap_ThrowError(DOMAIN_ERROR_OPERATOR_PRIORITY, opts, - "max priority in Prolog is %d, not %ld", - GLOBAL_MaxPriority, re->prio); + "max priority in Prolog is %d, not %ld", + GLOBAL_MaxPriority, re->prio); } } else { re->prio = LOCAL_default_priority; } + fe->msg = NULL; return args; } @@ -570,7 +556,7 @@ typedef enum { Int Yap_FirstLineInParse(void) { CACHE_REGS - return LOCAL_StartLineCount; + return LOCAL_StartLineCount; } #define PUSHFET(X) *HR++ = fe->X @@ -579,7 +565,7 @@ Int Yap_FirstLineInParse(void) { static void reset_regs(TokEntry *tokstart, FEnv *fe) { CACHE_REGS - restore_machine_regs(); + restore_machine_regs(); /* restart global */ PUSHFET(qq); @@ -606,18 +592,18 @@ static void reset_regs(TokEntry *tokstart, FEnv *fe) { static Term get_variables(FEnv *fe, TokEntry *tokstart) { CACHE_REGS - Term v; + Term v; if (fe->vp) { while (true) { fe->old_H = HR; if (setjmp(LOCAL_IOBotch) == 0) { - if ((v = Yap_Variables(LOCAL_VarTable, TermNil))) { - fe->old_H = HR; - return v; - } + if ((v = Yap_Variables(LOCAL_VarTable, TermNil))) { + fe->old_H = HR; + return v; + } } else { - reset_regs(tokstart, fe); + reset_regs(tokstart, fe); } } } @@ -626,18 +612,18 @@ static Term get_variables(FEnv *fe, TokEntry *tokstart) { static Term get_varnames(FEnv *fe, TokEntry *tokstart) { CACHE_REGS - Term v; + Term v; if (fe->np) { while (true) { fe->old_H = HR; if (setjmp(LOCAL_IOBotch) == 0) { - if ((v = Yap_VarNames(LOCAL_VarTable, TermNil))) { - fe->old_H = HR; - return v; - } + if ((v = Yap_VarNames(LOCAL_VarTable, TermNil))) { + fe->old_H = HR; + return v; + } } else { - reset_regs(tokstart, fe); + reset_regs(tokstart, fe); } } } @@ -646,17 +632,17 @@ static Term get_varnames(FEnv *fe, TokEntry *tokstart) { static Term get_singletons(FEnv *fe, TokEntry *tokstart) { CACHE_REGS - Term v; + Term v; if (fe->sp) { while (TRUE) { fe->old_H = HR; if (setjmp(LOCAL_IOBotch) == 0) { - if ((v = Yap_Singletons(LOCAL_VarTable, TermNil))) { - return v; - } + if ((v = Yap_Singletons(LOCAL_VarTable, TermNil))) { + return v; + } } else { - reset_regs(tokstart, fe); + reset_regs(tokstart, fe); } } } @@ -665,7 +651,7 @@ static Term get_singletons(FEnv *fe, TokEntry *tokstart) { static void warn_singletons(FEnv *fe, TokEntry *tokstart) { CACHE_REGS - Term v; + Term v; fe->sp = TermNil; v = get_singletons(fe, tokstart); if (v && v != TermNil) { @@ -684,17 +670,17 @@ static void warn_singletons(FEnv *fe, TokEntry *tokstart) { static Term get_stream_position(FEnv *fe, TokEntry *tokstart) { CACHE_REGS - Term v; + Term v; if (fe->tp) { while (true) { fe->old_H = HR; if (setjmp(LOCAL_IOBotch) == 0) { - if ((v = CurrentPositionToTerm())) { - return v; - } + if ((v = CurrentPositionToTerm())) { + return v; + } } else { - reset_regs(tokstart, fe); + reset_regs(tokstart, fe); } } } @@ -703,7 +689,7 @@ static Term get_stream_position(FEnv *fe, TokEntry *tokstart) { static bool complete_processing(FEnv *fe, TokEntry *tokstart) { CACHE_REGS - Term v1, v2, v3, vc, tp; + Term v1, v2, v3, vc, tp; if (fe->t0 && fe->t && !(Yap_unify(fe->t, fe->t0))) return false; @@ -734,15 +720,15 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) { // trail must be ok by now.] if (fe->t) { return (!v1 || Yap_unify(v1, fe->vp)) && (!v2 || Yap_unify(v2, fe->np)) && - (!v3 || Yap_unify(v3, fe->sp)) && (!tp || Yap_unify(tp, fe->tp)) && - (!vc || Yap_unify(vc, fe->tcomms)); + (!v3 || Yap_unify(v3, fe->sp)) && (!tp || Yap_unify(tp, fe->tp)) && + (!vc || Yap_unify(vc, fe->tcomms)); } return true; } static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) { CACHE_REGS - Term v_vp, v_vnames, v_comments, v_pos; + Term v_vp, v_vnames, v_comments, v_pos; if (fe->t0 && fe->t && !Yap_unify(fe->t, fe->t0)) return false; @@ -770,15 +756,15 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) { // trail must be ok by now.] if (fe->t) { return (!v_vp || Yap_unify(v_vp, fe->vp)) && - (!v_vnames || Yap_unify(v_vnames, fe->np)) && - (!v_pos || Yap_unify(v_pos, fe->tp)) && - (!v_comments || Yap_unify(v_comments, fe->tcomms)); + (!v_vnames || Yap_unify(v_vnames, fe->np)) && + (!v_pos || Yap_unify(v_pos, fe->tp)) && + (!v_comments || Yap_unify(v_comments, fe->tcomms)); } return true; } static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, - bool clause); + bool clause); static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream); @@ -790,22 +776,24 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream); static parser_state_t scanEOF(FEnv *fe, int inp_stream) { CACHE_REGS - // bool store_comments = false; - TokEntry *tokstart = LOCAL_tokptr; + // bool store_comments = false; + TokEntry *tokstart = LOCAL_tokptr; // check for an user abort if (tokstart != NULL && tokstart->Tok != Ord(eot_tok)) { /* we got the end of file from an abort */ - if (LOCAL_ErrorMessage && !strcmp(LOCAL_ErrorMessage, "Abort")) { + if (fe->msg && !strcmp(fe->msg, "Abort")) { fe->t = 0L; Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); return YAP_PARSING_FINISHED; } // a :- - if (GLOBAL_Stream[inp_stream].status & Past_Eof_Stream_f) + if (GLOBAL_Stream[inp_stream].status & Past_Eof_Stream_f) { + fe->msg = "parsing stopped at a end-of-file"; return YAP_PARSING_ERROR; + } /* we need to force the next read to also give end of file.*/ GLOBAL_Stream[inp_stream].status |= Push_Eof_Stream_f; - LOCAL_ErrorMessage = "end of file found before end of term"; + fe->msg = "end of file found before end of term"; return YAP_PARSING; } else { // @@ -831,14 +819,13 @@ static parser_state_t scanEOF(FEnv *fe, int inp_stream) { } static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, - bool clause) { + bool clause) { LOCAL_ErrorMessage = NULL; fe->old_TR = TR; LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_SourceFileName = GLOBAL_Stream[inp_stream].name; LOCAL_eot_before_eof = false; fe->tpos = StreamPosition(inp_stream); - fe->old_H = HR; fe->reading_clause = clause; if (clause) { fe->args = setClauseReadEnv(opts, fe, re, inp_stream); @@ -867,11 +854,11 @@ static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, static parser_state_t scan(REnv *re, FEnv *fe, int sno) { CACHE_REGS - /* preserve value of H after scanning: otherwise we may lose strings - and floats */ - LOCAL_tokptr = LOCAL_toktide = + /* preserve value of H after scanning: otherwise we may lose strings + and floats */ + LOCAL_tokptr = LOCAL_toktide = - Yap_tokenizer(GLOBAL_Stream + sno, false, &fe->tpos); + Yap_tokenizer(GLOBAL_Stream + sno, false, &fe->tpos); #if DEBUG if (GLOBAL_Option[2]) { TokEntry *t = LOCAL_tokptr; @@ -890,7 +877,7 @@ static parser_state_t scan(REnv *re, FEnv *fe, int sno) { return YAP_PARSING; } if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) { - LOCAL_Error_TYPE = SYNTAX_ERROR; + LOCAL_ErrorMessage = ". is end-of-term?"; return YAP_PARSING_ERROR; } return scanEOF(fe, sno); @@ -898,7 +885,7 @@ static parser_state_t scan(REnv *re, FEnv *fe, int sno) { static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) { CACHE_REGS - fe->t = 0; + fe->t = 0; // running out of memory if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL) { LOCAL_Error_TYPE = YAP_NO_ERROR; @@ -941,7 +928,7 @@ static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) { static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) { CACHE_REGS - fe->t = 0; + fe->t = 0; if (LOCAL_Error_TYPE != SYNTAX_ERROR && LOCAL_Error_TYPE != YAP_NO_ERROR) { return YAP_SCANNING_ERROR; } @@ -950,27 +937,30 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) { /* just fail */ LOCAL_Error_TYPE = YAP_NO_ERROR; return YAP_PARSING_FINISHED; - } else { + } + Term t = syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos, fe->reading_clause, fe->msg); + if (ParserErrorStyle == TermException) { + if (LOCAL_RestartEnv && !LOCAL_delay) { + Yap_RestartYap(5); + } + Yap_exit(5); + } if (re->seekable) { re->cpos = GLOBAL_Stream[inp_stream].charcount; } - - Term t = syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos); - if (ParserErrorStyle == TermError) { - LOCAL_ActiveError->errorRawTerm = Yap_SaveTerm(t); - LOCAL_Error_TYPE = SYNTAX_ERROR; - // dec-10 - } else if (Yap_PrintWarning(t)) { - LOCAL_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = WARNING_SYNTAX_ERROR; + t = Yap_MkFullError(); + Yap_PrintWarning(t); + LOCAL_Error_TYPE = YAPC_NO_ERROR; + if (ParserErrorStyle == TermDec10) { return YAP_SCANNING; } - } return YAP_PARSING_FINISHED; } static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) { CACHE_REGS - TokEntry *tokstart = LOCAL_tokptr; + TokEntry *tokstart = LOCAL_tokptr; fe->t = Yap_Parse(re->prio, fe->enc, fe->cmod); fe->toklast = LOCAL_tokptr; LOCAL_tokptr = tokstart; @@ -1014,9 +1004,9 @@ Term Yap_read_term(int sno, Term opts, bool clause) { case YAP_START_PARSING: state = initParser(opts, &fe, &re, sno, clause); if (state == YAP_PARSING_FINISHED) { - pop_text_stack(lvl); - Yap_popErrorContext(err, true); - return 0; + pop_text_stack(lvl); + Yap_popErrorContext(err, true); + return 0; } break; case YAP_SCANNING: @@ -1033,15 +1023,15 @@ Term Yap_read_term(int sno, Term opts, bool clause) { break; case YAP_PARSING_FINISHED: { CACHE_REGS - bool done; + bool done; if (fe.reading_clause) - done = complete_clause_processing(&fe, LOCAL_tokptr); + done = complete_clause_processing(&fe, LOCAL_tokptr); else - done = complete_processing(&fe, LOCAL_tokptr); + done = complete_processing(&fe, LOCAL_tokptr); if (!done) { - state = YAP_PARSING_ERROR; - fe.t = 0; - break; + state = YAP_PARSING_ERROR; + fe.t = 0; + break; } #if EMACS first_char = tokstart->TokPos; @@ -1058,13 +1048,13 @@ Term Yap_read_term(int sno, Term opts, bool clause) { } static Int - read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */ +read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */ return Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, ARG2), false) != - 0; + 0; } static Int read_term( - USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ + USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ int sno; Term out; @@ -1079,15 +1069,15 @@ static Int read_term( return out != 0L; } -#define READ_CLAUSE_DEFS() \ - PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \ - , PAR("module", isatom, READ_CLAUSE_MODULE), \ - PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \ - PAR("variables", filler, READ_CLAUSE_VARIABLES), \ - PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \ - PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \ - PAR("output", isatom, READ_CLAUSE_OUTPUT), \ - PAR(NULL, ok, READ_CLAUSE_END) +#define READ_CLAUSE_DEFS() \ + PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \ + , PAR("module", isatom, READ_CLAUSE_MODULE), \ + PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \ + PAR("variables", filler, READ_CLAUSE_VARIABLES), \ + PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \ + PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \ + PAR("output", isatom, READ_CLAUSE_OUTPUT), \ + PAR(NULL, ok, READ_CLAUSE_END) #define PAR(x, y, z) z @@ -1097,7 +1087,7 @@ typedef enum read_clause_enum_choices { #undef PAR -#define PAR(x, y, z) \ +#define PAR(x, y, z) \ { x, y, z } static const param_t read_clause_defs[] = {READ_CLAUSE_DEFS()}; @@ -1106,8 +1096,8 @@ static const param_t read_clause_defs[] = {READ_CLAUSE_DEFS()}; static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, int sno) { CACHE_REGS - xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END, - DOMAIN_ERROR_READ_OPTION); + xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END, + DOMAIN_ERROR_READ_OPTION); if (args == NULL) { return NULL; } @@ -1165,6 +1155,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, int sno) { re->cpos = GLOBAL_Stream[sno].charcount; } re->prio = LOCAL_default_priority; + fe->msg = NULL; return args; } @@ -1203,7 +1194,7 @@ static Int read_clause2(USES_REGS1) { * + The `singletons` option is set from the single var flag */ static Int read_clause( - USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ + USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ int sno; Term out; @@ -1257,349 +1248,349 @@ static Int start_mega(USES_REGS1) { ] } #endif -/** - * @pred source_location( - _File_ , _Line_ ) - * - * unify _File_ and _Line_ wuth the position of the last term read, if the - *term - * comes from a stream created by opening a file-system path with open/3 and - *friends.>position - * It ignores user_input or - * sockets. - * - * @param - _File_ - * @param - _Line_ - * - * - * - * @note SWI-Prolog built-in. - */ -static Int source_location(USES_REGS1) { - return Yap_unify(ARG1, MkAtomTerm(LOCAL_SourceFileName)) && - Yap_unify(ARG2, MkIntegerTerm(LOCAL_SourceFileLineno)); -} - -/** - * @pred read(+ Stream, -Term ) is iso - * - * Reads term _T_ from the stream _S_ instead of from the current input - * stream. - * - * @param - _Stream_ - * @param - _Term_ - * - */ -static Int read2( - USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ - int sno; - Int out; - - /* needs to change LOCAL_output_stream for write */ - sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); - if (sno == -1) { - return (FALSE); - } - out = Yap_read_term(sno, add_output(ARG2, TermNil), false); - UNLOCK(GLOBAL_Stream[sno].streamlock); - return out; -} - -/** @pred read(- T) is iso - - Reads the next term from the current input stream, and unifies it with - _T_. The term must be followed by a dot (`.`) and any blank-character - as previously defined. The syntax of the term must match the current - declarations for operators (see op). If the end-of-stream is reached, - _T_ is unified with the atom `end_of_file`. Further reads from of - the same stream may cause an error failure (see open/3). - -*/ -static Int read1( - USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ - Term out = Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, TermNil), 1); - return out; -} - -/** @pred fileerrors - - Switches on the file_errors flag so that in certain error conditions - Input/Output predicates will produce an appropriated message and abort. - -*/ -static Int fileerrors(USES_REGS1) { - return setYapFlag(TermFileErrors, TermTrue); -} - -/** - @pred nofileerrors - - Switches off the `file_errors` flag, so that the predicates see/1, - tell/1, open/3 and close/1 just fail, instead of producing - an error message and aborting whenever the specified file cannot be - opened or closed. - -*/ -static Int nofileerrors( - USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ - return setYapFlag(TermFileerrors, TermFalse); -} - -static Int style_checker(USES_REGS1) { - Term t = Deref(ARG1); - - if (IsVarTerm(t)) { - Term t = TermNil; - if (getYapFlag(MkAtomTerm(AtomSingleVarWarnings)) == TermTrue) { - t = MkPairTerm(MkAtomTerm(AtomSingleVarWarnings), t); + /** + * @pred source_location( - _File_ , _Line_ ) + * + * unify _File_ and _Line_ wuth the position of the last term read, if the + *term + * comes from a stream created by opening a file-system path with open/3 and + *friends.>position + * It ignores user_input or + * sockets. + * + * @param - _File_ + * @param - _Line_ + * + * + * + * @note SWI-Prolog built-in. + */ + static Int source_location(USES_REGS1) { + return Yap_unify(ARG1, MkAtomTerm(LOCAL_SourceFileName)) && + Yap_unify(ARG2, MkIntegerTerm(LOCAL_SourceFileLineno)); } - if (getYapFlag(MkAtomTerm(AtomDiscontiguousWarnings)) == TermTrue) { - t = MkPairTerm(MkAtomTerm(AtomDiscontiguousWarnings), t); - } - if (getYapFlag(MkAtomTerm(AtomRedefineWarnings)) == TermTrue) { - t = MkPairTerm(MkAtomTerm(AtomRedefineWarnings), t); - } - } else { - while (IsPairTerm(t)) { - Term h = HeadOfTerm(t); - t = TailOfTerm(t); - if (IsVarTerm(h)) { - Yap_Error(INSTANTIATION_ERROR, t, "style_check/1"); - return (FALSE); - } else if (IsAtomTerm(h)) { - Atom at = AtomOfTerm(h); - if (at == AtomSingleVarWarnings) - setYapFlag(MkAtomTerm(AtomSingleVarWarnings), TermTrue); - else if (at == AtomDiscontiguousWarnings) - setYapFlag(MkAtomTerm(AtomDiscontiguousWarnings), TermTrue); - else if (at == AtomRedefineWarnings) - setYapFlag(MkAtomTerm(AtomRedefineWarnings), TermTrue); + /** + * @pred read(+ Stream, -Term ) is iso + * + * Reads term _T_ from the stream _S_ instead of from the current input + * stream. + * + * @param - _Stream_ + * @param - _Term_ + * + */ + static Int read2( + USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ + int sno; + Int out; + + /* needs to change LOCAL_output_stream for write */ + sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); + if (sno == -1) { + return (FALSE); + } + out = Yap_read_term(sno, add_output(ARG2, TermNil), false); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return out; + } + + /** @pred read(- T) is iso + + Reads the next term from the current input stream, and unifies it with + _T_. The term must be followed by a dot (`.`) and any blank-character + as previously defined. The syntax of the term must match the current + declarations for operators (see op). If the end-of-stream is reached, + _T_ is unified with the atom `end_of_file`. Further reads from of + the same stream may cause an error failure (see open/3). + + */ + static Int read1( + USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ + Term out = Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, TermNil), 1); + return out; + } + + /** @pred fileerrors + + Switches on the file_errors flag so that in certain error conditions + Input/Output predicates will produce an appropriated message and abort. + + */ + static Int fileerrors(USES_REGS1) { + return setYapFlag(TermFileErrors, TermTrue); + } + + /** + @pred nofileerrors + + Switches off the `file_errors` flag, so that the predicates see/1, + tell/1, open/3 and close/1 just fail, instead of producing + an error message and aborting whenever the specified file cannot be + opened or closed. + + */ + static Int nofileerrors( + USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ + return setYapFlag(TermFileerrors, TermFalse); + } + + static Int style_checker(USES_REGS1) { + Term t = Deref(ARG1); + + if (IsVarTerm(t)) { + Term t = TermNil; + if (getYapFlag(MkAtomTerm(AtomSingleVarWarnings)) == TermTrue) { + t = MkPairTerm(MkAtomTerm(AtomSingleVarWarnings), t); + } + if (getYapFlag(MkAtomTerm(AtomDiscontiguousWarnings)) == TermTrue) { + t = MkPairTerm(MkAtomTerm(AtomDiscontiguousWarnings), t); + } + if (getYapFlag(MkAtomTerm(AtomRedefineWarnings)) == TermTrue) { + t = MkPairTerm(MkAtomTerm(AtomRedefineWarnings), t); + } } else { - Atom at = AtomOfTerm(ArgOfTerm(1, h)); - if (at == AtomSingleVarWarnings) - setYapFlag(MkAtomTerm(AtomSingleVarWarnings), TermFalse); - else if (at == AtomDiscontiguousWarnings) - setYapFlag(MkAtomTerm(AtomDiscontiguousWarnings), TermFalse); - else if (at == AtomRedefineWarnings) - setYapFlag(MkAtomTerm(AtomRedefineWarnings), TermFalse); + while (IsPairTerm(t)) { + Term h = HeadOfTerm(t); + t = TailOfTerm(t); + + if (IsVarTerm(h)) { + Yap_Error(INSTANTIATION_ERROR, t, "style_check/1"); + return (FALSE); + } else if (IsAtomTerm(h)) { + Atom at = AtomOfTerm(h); + if (at == AtomSingleVarWarnings) + setYapFlag(MkAtomTerm(AtomSingleVarWarnings), TermTrue); + else if (at == AtomDiscontiguousWarnings) + setYapFlag(MkAtomTerm(AtomDiscontiguousWarnings), TermTrue); + else if (at == AtomRedefineWarnings) + setYapFlag(MkAtomTerm(AtomRedefineWarnings), TermTrue); + } else { + Atom at = AtomOfTerm(ArgOfTerm(1, h)); + if (at == AtomSingleVarWarnings) + setYapFlag(MkAtomTerm(AtomSingleVarWarnings), TermFalse); + else if (at == AtomDiscontiguousWarnings) + setYapFlag(MkAtomTerm(AtomDiscontiguousWarnings), TermFalse); + else if (at == AtomRedefineWarnings) + setYapFlag(MkAtomTerm(AtomRedefineWarnings), TermFalse); + } + } + } + return TRUE; + } + + Term Yap_BufferToTerm(const char *s, Term opts) { + Term rval; + int sno; + encoding_t l = ENC_ISO_UTF8; + sno = + Yap_open_buf_read_stream((char *)s, strlen(s) + 1, &l, MEM_BUF_USER, + Yap_LookupAtom(Yap_StrPrefix(s, 16)), TermNone); + + GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; + rval = Yap_read_term(sno, opts, false); + Yap_CloseStream(sno); + return rval; + } + + Term Yap_UBufferToTerm(const unsigned char *s, Term opts) { + Term rval; + int sno; + encoding_t l = ENC_ISO_UTF8; + sno = Yap_open_buf_read_stream( + (char *)s, strlen((const char *)s), &l, MEM_BUF_USER, + Yap_LookupAtom(Yap_StrPrefix((char *)s, 16)), TermNone); + GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; + rval = Yap_read_term(sno, opts, false); + Yap_CloseStream(sno); + return rval; + } + + X_API Term Yap_BufferToTermWithPrioBindings(const char *s, Term opts, + Term bindings, size_t len, + int prio) { + CACHE_REGS + Term ctl; + + ctl = opts; + if (bindings) { + ctl = add_names(bindings, TermNil); + } + if (prio != 1200) { + ctl = add_priority(bindings, ctl); + } + return Yap_BufferToTerm(s, ctl); + } + + /** + * @pred read_term_from_atom( +Atom , -T , +Options ) + * + * read a term _T_ stored in constant _Atom_ according to _Options_ + * + * @param _Atom_ the source _Atom_ + * @param _T_ the output term _T_, may be any term + * @param _Options_ read_term/3 options. + * + * @note Originally from SWI-Prolog, in YAP only works with internalised + *atoms + * Check read_term_from_atomic/3 for the general version. Also, the built-in + *is + *supposed to + * use YAP's internal encoding, so please avoid the encoding/1 option. + */ + static Int read_term_from_atom(USES_REGS1) { + Term t1 = Deref(ARG1); + Atom at; + const unsigned char *s; + + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR, t1, "style_check/1"); + return false; + } else if (!IsAtomTerm(t1)) { + Yap_Error(TYPE_ERROR_ATOM, t1, "style_check/1"); + return false; + } else { + at = AtomOfTerm(t1); + s = at->UStrOfAE; + } + Term ctl = add_output(ARG2, ARG3); + + return Yap_UBufferToTerm(s, ctl); + } + + /** + * @pred read_term_from_atomic( +Atomic , - T , +Options ) + * + * read a term _T_ stored in text _Atomic_ according to _Options_ + * + * @param _Atomic_ the source may be an atom, string, list of codes, or list + *of + *chars. + * @param _T_ the output term _T_, may be any term + * @param _Options_ read_term/3 options. + * + * @notes Idea originally from SWI-Prolog, but in YAP we separate atomic and + *atom. + * Encoding is fixed in atoms and strings. + */ + static Int read_term_from_atomic(USES_REGS1) { + Term t1 = Deref(ARG1); + const unsigned char *s; + + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_atomic/3"); + return (FALSE); + } else if (!IsAtomicTerm(t1)) { + Yap_Error(TYPE_ERROR_ATOMIC, t1, "read_term_from_atomic/3"); + return (FALSE); + } else { + Term t = Yap_AtomicToString(t1 PASS_REGS); + s = UStringOfTerm(t); + } + Term ctl = add_output(ARG2, ARG3); + + return Yap_UBufferToTerm(s, ctl); + } + + /** + * @pred read_term_from_string( +String , - T , + Options ) + * + * read a term _T_ stored in constant _String_ according to _Options_ + * + * @param _String_ the source _String_ + * @param _T_ the output term _T_, may be any term + * @param _Options_ read_term/3 options. + * + * Idea from SWI-Prolog, in YAP only works with strings + * Check read_term_from_atomic/3 for the general version. + */ + static Int read_term_from_string(USES_REGS1) { + Term t1 = Deref(ARG1), rc; + const unsigned char *s; + size_t len; + BACKUP_H() + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); + return (FALSE); + } else if (!IsStringTerm(t1)) { + Yap_Error(TYPE_ERROR_STRING, t1, "read_term_from_string/3"); + return (FALSE); + } else { + s = UStringOfTerm(t1); + len = strlen_utf8(s); + } + char *ss = (char *)s; + encoding_t enc = ENC_ISO_UTF8; + int sno = Yap_open_buf_read_stream(ss, len, &enc, MEM_BUF_USER, + Yap_LookupAtom(Yap_StrPrefix(ss, 16)), + TermString); + GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; + rc = Yap_read_term(sno, Deref(ARG3), 3); + Yap_CloseStream(sno); + RECOVER_H(); + if (!rc) + return false; + return Yap_unify(rc, ARG2); + } + + static Int atomic_to_term(USES_REGS1) { + Term t1 = Deref(ARG1); + int l = push_text_stack(); + const unsigned char *s = Yap_TextToUTF8Buffer(t1 PASS_REGS); + Int rc = Yap_UBufferToTerm(s, add_output(ARG2, add_names(ARG3, TermNil))); + pop_text_stack(l); + return rc; + } + + static Int atom_to_term(USES_REGS1) { + Term t1 = Deref(ARG1); + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); + return (FALSE); + } else if (!IsAtomTerm(t1)) { + Yap_Error(TYPE_ERROR_ATOM, t1, "read_term_from_atomic/3"); + return (FALSE); + } else { + Term t = Yap_AtomicToString(t1 PASS_REGS); + const unsigned char *us = UStringOfTerm(t); + return Yap_UBufferToTerm(us, add_output(ARG2, add_names(ARG3, TermNil))); } } - } - return TRUE; -} -Term Yap_BufferToTerm(const char *s, Term opts) { - Term rval; - int sno; - encoding_t l = ENC_ISO_UTF8; - sno = - Yap_open_buf_read_stream((char *)s, strlen(s) + 1, &l, MEM_BUF_USER, - Yap_LookupAtom(Yap_StrPrefix(s, 16)), TermNone); + static Int string_to_term(USES_REGS1) { + Term t1 = Deref(ARG1); - GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; - rval = Yap_read_term(sno, opts, false); - Yap_CloseStream(sno); - return rval; -} + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); + return (FALSE); + } else if (!IsStringTerm(t1)) { + Yap_Error(TYPE_ERROR_STRING, t1, "read_term_from_string/3"); + return (FALSE); + } else { + const unsigned char *us = UStringOfTerm(t1); + return Yap_UBufferToTerm(us, add_output(ARG2, add_names(ARG3, TermNil))); + } + } -Term Yap_UBufferToTerm(const unsigned char *s, Term opts) { - Term rval; - int sno; - encoding_t l = ENC_ISO_UTF8; - sno = Yap_open_buf_read_stream( - (char *)s, strlen((const char *)s), &l, MEM_BUF_USER, - Yap_LookupAtom(Yap_StrPrefix((char *)s, 16)), TermNone); - GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; - rval = Yap_read_term(sno, opts, false); - Yap_CloseStream(sno); - return rval; -} + void Yap_InitReadTPreds(void) { + Yap_InitCPred("read_term", 2, read_term2, SyncPredFlag); + Yap_InitCPred("read_term", 3, read_term, SyncPredFlag); -X_API Term Yap_BufferToTermWithPrioBindings(const char *s, Term opts, - Term bindings, size_t len, - int prio) { - CACHE_REGS - Term ctl; + Yap_InitCPred("scan_to_list", 2, scan_to_list, SyncPredFlag); + Yap_InitCPred("read", 1, read1, SyncPredFlag); + Yap_InitCPred("read", 2, read2, SyncPredFlag); + Yap_InitCPred("read_clause", 2, read_clause2, SyncPredFlag); + Yap_InitCPred("read_clause", 3, read_clause, 0); + Yap_InitCPred("read_term_from_atom", 3, read_term_from_atom, 0); + Yap_InitCPred("read_term_from_atomic", 3, read_term_from_atomic, 0); + Yap_InitCPred("read_term_from_string", 3, read_term_from_string, 0); + Yap_InitCPred("atom_to_term", 3, atom_to_term, 0); + Yap_InitCPred("atomic_to_term", 3, atomic_to_term, 0); + Yap_InitCPred("string_to_term", 3, string_to_term, 0); - ctl = opts; - if (bindings) { - ctl = add_names(bindings, TermNil); - } - if (prio != 1200) { - ctl = add_priority(bindings, ctl); - } - return Yap_BufferToTerm(s, ctl); -} - -/** - * @pred read_term_from_atom( +Atom , -T , +Options ) - * - * read a term _T_ stored in constant _Atom_ according to _Options_ - * - * @param _Atom_ the source _Atom_ - * @param _T_ the output term _T_, may be any term - * @param _Options_ read_term/3 options. - * - * @note Originally from SWI-Prolog, in YAP only works with internalised - *atoms - * Check read_term_from_atomic/3 for the general version. Also, the built-in - *is - *supposed to - * use YAP's internal encoding, so please avoid the encoding/1 option. - */ -static Int read_term_from_atom(USES_REGS1) { - Term t1 = Deref(ARG1); - Atom at; - const unsigned char *s; - - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "style_check/1"); - return false; - } else if (!IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM, t1, "style_check/1"); - return false; - } else { - at = AtomOfTerm(t1); - s = at->UStrOfAE; - } - Term ctl = add_output(ARG2, ARG3); - - return Yap_UBufferToTerm(s, ctl); -} - -/** - * @pred read_term_from_atomic( +Atomic , - T , +Options ) - * - * read a term _T_ stored in text _Atomic_ according to _Options_ - * - * @param _Atomic_ the source may be an atom, string, list of codes, or list - *of - *chars. - * @param _T_ the output term _T_, may be any term - * @param _Options_ read_term/3 options. - * - * @notes Idea originally from SWI-Prolog, but in YAP we separate atomic and - *atom. - * Encoding is fixed in atoms and strings. - */ -static Int read_term_from_atomic(USES_REGS1) { - Term t1 = Deref(ARG1); - const unsigned char *s; - - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_atomic/3"); - return (FALSE); - } else if (!IsAtomicTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOMIC, t1, "read_term_from_atomic/3"); - return (FALSE); - } else { - Term t = Yap_AtomicToString(t1 PASS_REGS); - s = UStringOfTerm(t); - } - Term ctl = add_output(ARG2, ARG3); - - return Yap_UBufferToTerm(s, ctl); -} - -/** - * @pred read_term_from_string( +String , - T , + Options ) - * - * read a term _T_ stored in constant _String_ according to _Options_ - * - * @param _String_ the source _String_ - * @param _T_ the output term _T_, may be any term - * @param _Options_ read_term/3 options. - * - * Idea from SWI-Prolog, in YAP only works with strings - * Check read_term_from_atomic/3 for the general version. - */ -static Int read_term_from_string(USES_REGS1) { - Term t1 = Deref(ARG1), rc; - const unsigned char *s; - size_t len; - BACKUP_H() - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); - return (FALSE); - } else if (!IsStringTerm(t1)) { - Yap_Error(TYPE_ERROR_STRING, t1, "read_term_from_string/3"); - return (FALSE); - } else { - s = UStringOfTerm(t1); - len = strlen_utf8(s); - } - char *ss = (char *)s; - encoding_t enc = ENC_ISO_UTF8; - int sno = Yap_open_buf_read_stream(ss, len, &enc, MEM_BUF_USER, - Yap_LookupAtom(Yap_StrPrefix(ss, 16)), - TermString); - GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; - rc = Yap_read_term(sno, Deref(ARG3), 3); - Yap_CloseStream(sno); - RECOVER_H(); - if (!rc) - return false; - return Yap_unify(rc, ARG2); -} - -static Int atomic_to_term(USES_REGS1) { - Term t1 = Deref(ARG1); - int l = push_text_stack(); - const unsigned char *s = Yap_TextToUTF8Buffer(t1 PASS_REGS); - Int rc = Yap_UBufferToTerm(s, add_output(ARG2, add_names(ARG3, TermNil))); - pop_text_stack(l); - return rc; -} - -static Int atom_to_term(USES_REGS1) { - Term t1 = Deref(ARG1); - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); - return (FALSE); - } else if (!IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM, t1, "read_term_from_atomic/3"); - return (FALSE); - } else { - Term t = Yap_AtomicToString(t1 PASS_REGS); - const unsigned char *us = UStringOfTerm(t); - return Yap_UBufferToTerm(us, add_output(ARG2, add_names(ARG3, TermNil))); - } -} - -static Int string_to_term(USES_REGS1) { - Term t1 = Deref(ARG1); - - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); - return (FALSE); - } else if (!IsStringTerm(t1)) { - Yap_Error(TYPE_ERROR_STRING, t1, "read_term_from_string/3"); - return (FALSE); - } else { - const unsigned char *us = UStringOfTerm(t1); - return Yap_UBufferToTerm(us, add_output(ARG2, add_names(ARG3, TermNil))); - } -} - -void Yap_InitReadTPreds(void) { - Yap_InitCPred("read_term", 2, read_term2, SyncPredFlag); - Yap_InitCPred("read_term", 3, read_term, SyncPredFlag); - - Yap_InitCPred("scan_to_list", 2, scan_to_list, SyncPredFlag); - Yap_InitCPred("read", 1, read1, SyncPredFlag); - Yap_InitCPred("read", 2, read2, SyncPredFlag); - Yap_InitCPred("read_clause", 2, read_clause2, SyncPredFlag); - Yap_InitCPred("read_clause", 3, read_clause, 0); - Yap_InitCPred("read_term_from_atom", 3, read_term_from_atom, 0); - Yap_InitCPred("read_term_from_atomic", 3, read_term_from_atomic, 0); - Yap_InitCPred("read_term_from_string", 3, read_term_from_string, 0); - Yap_InitCPred("atom_to_term", 3, atom_to_term, 0); - Yap_InitCPred("atomic_to_term", 3, atomic_to_term, 0); - Yap_InitCPred("string_to_term", 3, string_to_term, 0); - - Yap_InitCPred("fileerrors", 0, fileerrors, SyncPredFlag); - Yap_InitCPred("nofileeleerrors", 0, nofileerrors, SyncPredFlag); - Yap_InitCPred("source_location", 2, source_location, SyncPredFlag); - Yap_InitCPred("$style_checker", 1, style_checker, - SyncPredFlag | HiddenPredFlag); -} + Yap_InitCPred("fileerrors", 0, fileerrors, SyncPredFlag); + Yap_InitCPred("nofileeleerrors", 0, nofileerrors, SyncPredFlag); + Yap_InitCPred("source_location", 2, source_location, SyncPredFlag); + Yap_InitCPred("$style_checker", 1, style_checker, + SyncPredFlag | HiddenPredFlag); + } diff --git a/pl/consult.yap b/pl/consult.yap index 6b8ca4c54..5d0f57c65 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -695,7 +695,7 @@ db_files(Fs) :- '$csult'(Fs, _M) :- '$skip_list'(_, Fs ,L), -vz L \== [], + L \== [], !, user:dot_qualified_goal(Fs). '$csult'(Fs, M) :- diff --git a/pl/messages.yap b/pl/messages.yap index b7f29395d..ac9c7752e 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -197,16 +197,22 @@ compose_message( halt, _Level) --> !, [ 'YAP execution halted.'-[] ]. % syntax error. +compose_message(error(warning(syntax_error,Info), Exc), Level) --> + !, + compose_message(error(syntax_error(Info), Exc), Level). compose_message(error(E, Exc), Level) --> - { '$show_consult_level'(LC) }, - location(error(E, Exc), Level, LC), + { +% start_low_level_trace, + '$show_consult_level'(LC) + }, + location(error(E, Exc), Level, LC), main_message(error(E,Exc) , Level, LC ), - c_goal( error(E, Exc), Level ), - caller( error(E, Exc), Level ), - extra_info( error(E, Exc), Level ), - !, - [nl], - [nl]. + c_goal( error(E, Exc), Level ), + caller( error(E, Exc), Level ), + extra_info( error(E, Exc), Level ), + !, + [nl], + [nl]. compose_message( false, _Level) --> !, [ 'false.'-[] ]. compose_message( '$abort', _Level) --> !, @@ -249,9 +255,16 @@ compose_message(Throw, _Level) --> !, [ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ]. -location(error(syntax_error(_),info(between(_,LN,_), FileName, _ChrPos, _Err)), _ , _) --> - !, - [ '~a:~d:~d: ' - [FileName,LN,0] ] . +location(error(syntax_error(_),Info), _Level , LC) --> + { '$error_descriptor'(Info, Desc) }, + { query_exception(parserReadingCode, Desc, true) }, + {LC > 0}, + !, + { + query_exception(parserFile, Desc, FileName), + query_exception(parserLine, Desc, LN) + }, + [ '~a:~d:~d: ' - [FileName,LN,0] ] . location(style_check(A,LN,FileName,B ), Level , LC) --> !, display_consulting( FileName, Level,style_check(A,LN,FileName,B ), LC ), @@ -289,21 +302,17 @@ simplify_pred(F, F). %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, main_message(error(Msg,In), _, _) --> {var(Msg)}, !, [ 'Uninstantiated message ~w~n.' - [error(Msg,In)], nl ]. -main_message( error(syntax_error(Msg),info(between(L0,LM,LF),_Stream, _Pos, Term)), Level, LC ) --> - !, +main_message( error(syntax_error(Msg),Info), Level, _LC ) --> + !, + { + '$error_descriptor'(Info, Desc), + query_exception(parserTextA, Desc, J), + query_exception(parserTextB, Desc, T), + query_exception(parserLine, Desc, L) + }, [' ~a: syntax error ~s' - [Level,Msg]], [nl], - ( syntax_error_term( between(L0,LM,LF), Term, LC ) - -> - [] - ; - [' ~a: failed_processing syntax error term ~q' - [Level,Term]], - [nl] - ). -main_message( error(syntax_error(Msg), _Info), Level, _LC ) --> - !, - [' ~a: syntax error ~s' - [Level,Msg]], - [nl]. + [' ~s <<== at line ~d == ~s !' - [J,L,T], nl ]. main_message(style_check(singleton(SVs),_Pos,_File,P), _Level, _LC) --> !, % {writeln(ci)}, @@ -370,6 +379,7 @@ display_consulting( F, Level, _, LC) --> display_consulting(_F, _, _, _LC) --> []. +c_goal( error(syntax_error(_),Info), _) --> !. c_goal( error(_,Info), _) --> { '$error_descriptor'(Info, Desc) }, ({ query_exception(errorGoal, Desc, Call), @@ -711,7 +721,7 @@ syntax_error_token(var(_,S), _, _LC) --> !, syntax_error_token(string(S), _, _LC) --> !, [ '`~s`' - [S] ]. syntax_error_token(error, L, _LC) --> !, - [ ' <<<< at line %d' - [L] ]. + [ ' <<<< at line ~d >>>> ' - [L] ]. syntax_error_token('EOT',_, _LC) --> !, [ '.' - [], nl ]. syntax_error_token('(',_, _LC) --> !,