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

syntax error handling

This commit is contained in:
Vítor Santos Costa 2015-07-27 22:22:44 -05:00
parent 36058116f5
commit dbdae6a930
18 changed files with 338 additions and 4027 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

141
C/parser.c
View File

@ -147,6 +147,9 @@ dot with single quotes.
#if HAVE_STRING_H
#include <string.h>
#endif
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#ifdef __STDC__XXX
#define Volatile volatile
@ -164,6 +167,21 @@ static Term ParseArgs( Atom, wchar_t, JMPBUFF *, Term CACHE_TYPE);
static Term ParseList( JMPBUFF *CACHE_TYPE);
static Term ParseTerm( int, JMPBUFF *CACHE_TYPE);
static void
syntax_msg( const char *msg, ...)
{
CACHE_REGS
va_list ap;
if (LOCAL_toktide == LOCAL_tokptr) {
va_start(ap, msg);
vsnprintf( LOCAL_FileNameBuf2, YAP_FILENAME_MAX-1, msg, ap );
LOCAL_ErrorMessage = LOCAL_FileNameBuf2;
LOCAL_Error_TYPE = SYNTAX_ERROR;
va_end(ap);
}
}
#define TRY(S, P) \
{ \
Volatile JMPBUFF *saveenv, newenv; \
@ -205,6 +223,54 @@ static Term ParseTerm( int, JMPBUFF *CACHE_TYPE);
#define FAIL siglongjmp(FailBuff->JmpBuff, 1)
static const char *tokRep(TokEntry *tokptr)
{
CACHE_REGS
Term info = tokptr->TokInfo;
char *b, *buf = LOCAL_FileNameBuf2;
size_t length, sze = YAP_FILENAME_MAX-1;
UInt flags = 0;
switch (tokptr->Tok) {
case Name_tok:
return RepAtom((Atom)info)->StrOfAE;
case Number_tok:
if ((b = Yap_TermToString(info, buf, sze, &length,LOCAL_encoding, flags)) != buf) {
if (b) free(b);
return NULL;
}
return buf;
case Var_tok:
{
VarEntry *varinfo = (VarEntry *)info;
return varinfo->VarRep;
}
case String_tok:
case BQString_tok:
return (char *)info;
case WString_tok:
case WBQString_tok:
return utf8_wcscpy(buf, (wchar_t *)info);
case Error_tok:
return "<ERR>";
case eot_tok:
return "<EOT>";
case Ponctuation_tok:
{
buf[1] = '\0';
if ((info) == 'l') {
buf[0] = '(';
} else {
buf[0] = (char)info;
}
}
return buf;
case QuasiQuotes_tok:
case WQuasiQuotes_tok:
return "<QQ>";
}
}
VarEntry *Yap_LookupVar(const char *var) /* lookup variable in variables table */
{
CACHE_REGS
@ -430,16 +496,18 @@ int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) {
inline static void GNextToken(USES_REGS1) {
if (LOCAL_tokptr->Tok == Ord(eot_tok))
return;
if (LOCAL_tokptr == LOCAL_toktide)
if (LOCAL_tokptr == LOCAL_toktide) {
LOCAL_toktide = LOCAL_tokptr = LOCAL_tokptr->TokNext;
else
} else
LOCAL_tokptr = LOCAL_tokptr->TokNext;
}
inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) {
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
LOCAL_tokptr->TokInfo != (Term)c)
LOCAL_tokptr->TokInfo != (Term)c) {
syntax_msg("expected to find \'%c\', found %s", tokRep(LOCAL_tokptr));
FAIL;
}
NextToken;
}
@ -517,12 +585,12 @@ static Term ParseArgs( Atom a, wchar_t close, JMPBUFF *FailBuff,
func = Yap_MkFunctor(a, 1);
if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow";
syntax_msg("Heap Overflow");
FAIL;
}
t = Yap_MkApplTerm(func, nargs, p);
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
syntax_msg("Stack Overflow");
return TermNil;
}
NextToken;
@ -532,7 +600,7 @@ static Term ParseArgs( Atom a, wchar_t close, JMPBUFF *FailBuff,
while (1) {
Term *tp = (Term *)ParserAuxSp;
if (ParserAuxSp + 1 > LOCAL_TrailTop) {
LOCAL_ErrorMessage = "Trail Overflow";
syntax_msg("Trail Overflow");
FAIL;
}
*tp++ = Unsigned(ParseTerm( 999, FailBuff PASS_REGS));
@ -550,12 +618,12 @@ static Term ParseArgs( Atom a, wchar_t close, JMPBUFF *FailBuff,
* order
*/
if (HR > ASP - (nargs + 1)) {
LOCAL_ErrorMessage = "Stack Overflow";
syntax_msg("Stack Overflow");
FAIL;
}
func = Yap_MkFunctor(a, nargs);
if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow";
syntax_msg("Heap Overflow");
FAIL;
}
#ifdef SFUNC
@ -570,7 +638,7 @@ static Term ParseArgs( Atom a, wchar_t close, JMPBUFF *FailBuff,
t = Yap_MkApplTerm(func, nargs, p);
#endif
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
syntax_msg("Stack Overflow");
return TermNil;
}
/* check for possible overflow against local stack */
@ -609,7 +677,7 @@ loop:
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
to_store[1] = TermNil;
LOCAL_ErrorMessage = "Stack Overflow";
syntax_msg("Stack Overflow");
FAIL;
} else {
to_store[1] = AbsPair(HR);
@ -622,8 +690,10 @@ loop:
} else {
to_store[1] = MkAtomTerm(AtomNil);
}
} else
} else {
syntax_msg("looking for symbol ',','|' got symbol '%s'", tokRep(LOCAL_tokptr) );
FAIL;
}
return (o);
}
@ -693,13 +763,13 @@ static Term ParseTerm( int prio, JMPBUFF *FailBuff USES_REGS) {
/* build appl on the heap */
func = Yap_MkFunctor((Atom)t, 1);
if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow";
syntax_msg( "Heap Overflow" );
FAIL;
} t = ParseTerm( oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
syntax_msg( "Stack Overflow" );
FAIL;
} curprio = opprio;
, break;)
@ -722,6 +792,7 @@ static Term ParseTerm( int prio, JMPBUFF *FailBuff USES_REGS) {
Volatile char *p = (char *)LOCAL_tokptr->TokInfo;
t = Yap_CharsToTDQ(p, CurrentModule PASS_REGS);
if (!t) {
syntax_msg( "could not convert \'%s\'", (char *)LOCAL_tokptr->TokInfo );
FAIL;
}
NextToken;
@ -732,6 +803,7 @@ static Term ParseTerm( int prio, JMPBUFF *FailBuff USES_REGS) {
Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo;
t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS);
if (!t) {
syntax_msg( "could not convert \'%S\'", (wchar_t *)LOCAL_tokptr->TokInfo );
FAIL;
}
NextToken;
@ -742,6 +814,7 @@ static Term ParseTerm( int prio, JMPBUFF *FailBuff USES_REGS) {
Volatile char *p = (char *)LOCAL_tokptr->TokInfo;
t = Yap_CharsToTBQ(p, CurrentModule PASS_REGS);
if (!t) {
syntax_msg( "could not convert \'%s\"", (char *)LOCAL_tokptr->TokInfo );
FAIL;
}
NextToken;
@ -752,6 +825,7 @@ static Term ParseTerm( int prio, JMPBUFF *FailBuff USES_REGS) {
Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo;
t = Yap_WCharsToTBQ(p, CurrentModule PASS_REGS);
if (!t) {
syntax_msg( "could not convert \"%S\"", (wchar_t *)LOCAL_tokptr->TokInfo );
FAIL;
}
NextToken;
@ -766,6 +840,7 @@ case Var_tok:
break;
case Error_tok:
syntax_msg( "found ill-formed \"%s\"", tokRep(LOCAL_tokptr) );
FAIL;
case Ponctuation_tok:
@ -799,12 +874,13 @@ case Var_tok:
t = Yap_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
syntax_msg("Stack Overflow");
FAIL;
}
checkfor('}', FailBuff PASS_REGS);
break;
default:
syntax_msg("unexpected ponctuation signal %s", tokRep(LOCAL_tokptr));
FAIL;
}
break;
@ -848,19 +924,23 @@ case Var_tok:
NextToken;
t = ParseTerm( 1200, FailBuff PASS_REGS);
if (LOCAL_tokptr->Tok != QuasiQuotes_tok) {
syntax_msg( "expected to find quasi quotes, got \"%s\"", , tokRep(LOCAL_tokptr) );
FAIL;
}
if (!(is_quasi_quotation_syntax(t, &at)))
if (!(is_quasi_quotation_syntax(t, &at))) {
syntax_msg( "bad quasi quotation syntax, at \"%s\"", tokRep(LOCAL_tokptr) );
FAIL;
}
/* Arg 2: the content */
tn = Yap_MkNewApplTerm(SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4);
tnp = RepAppl(tn) + 1;
tnp[0] = MkAtomTerm(at);
if (!get_quasi_quotation(Yap_InitSlot(ArgOfTerm(2, tn)),
&qq->text,
qq->text + strlen((const char *)qq->text)))
qq->text + strlen((const char *)qq->text))) {
syntax_msg( "could not get quasi quotation, at \"%s\"", tokRep(LOCAL_tokptr) );
FAIL;
}
if (positions) {
intptr_t qqend = qq->end.charno;
@ -869,6 +949,7 @@ case Var_tok:
FUNCTOR_minus2, PL_INTPTR,
qq->mid.charno + 2, /* end of | token */
PL_INTPTR, qqend - 2)) /* end minus "|}" */
syntax_msg( "failed to unify quasi quotation, at \"%s\"", tokRep(LOCAL_tokptr) );
FAIL;
}
@ -878,14 +959,16 @@ case Var_tok:
t = ArgOfTerm(4, tn);
if (!(to = PL_new_term_ref()) ||
!PL_unify_list(LOCAL_qq_tail, to, LOCAL_qq_tail) ||
!PL_unify(to, Yap_InitSlot(tn )))
!PL_unify(to, Yap_InitSlot(tn ))) {
syntax_msg( "failed to unify quasi quotation, at \"%s\"", tokRep(LOCAL_tokptr) );
FAIL;
}
}
#endif
NextToken;
break;
default:
syntax_msg( "expected operator, got \'%s\'", tokRep(LOCAL_tokptr) );
FAIL;
}
@ -900,7 +983,7 @@ case Var_tok:
Volatile int oldprio = curprio;
TRY3(func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 2);
if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow";
syntax_msg("Heap Overflow");
FAIL;
} NextToken;
{
@ -910,7 +993,7 @@ case Var_tok:
t = Yap_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
syntax_msg("Stack Overflow");
FAIL;
}
},
@ -923,13 +1006,13 @@ case Var_tok:
/* parse as posfix operator */
Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1);
if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow";
syntax_msg("Heap Overflow");
FAIL;
}
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
syntax_msg("Stack Overflow");
FAIL;
}
curprio = opprio;
@ -948,7 +1031,7 @@ case Var_tok:
t = Yap_MkApplTerm(FunctorComma, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
syntax_msg("Stack Overflow");
FAIL;
}
curprio = 1000;
@ -963,7 +1046,7 @@ case Var_tok:
t = Yap_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
syntax_msg("Stack Overflow");
FAIL;
}
curprio = opprio;
@ -992,8 +1075,10 @@ case Var_tok:
continue;
}
}
if (LOCAL_tokptr->Tok <= Ord(WString_tok))
if (LOCAL_tokptr->Tok <= Ord(WString_tok)) {
syntax_msg( "expected operator, got \'%s\'", tokRep(LOCAL_tokptr) );
FAIL;
}
break;
}
#if DEBUG
@ -1014,6 +1099,10 @@ Term Yap_Parse(UInt prio) {
if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
t = ParseTerm(prio, &FailBuff PASS_REGS);
if (LOCAL_Error_TYPE == SYNTAX_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
LOCAL_ErrorMessage = NULL;
}
// if (LOCAL_tokptr->Tok != Ord(eot_tok))
// return (0L);
return (t);

3
C/scanner.c
View File

@ -469,8 +469,7 @@ static char chtype0[NUMBER_OF_CHARS + 1] = {
BS, BS, BS, BS, BS, BS, BS,
/* sp ! " # $ % & ' ( ) * + , - . / */
BS, SL, DC, SY, SY, CC, SY, QT, BK,
BK, SY, SY, BK, SY, SY, SY,
BS, SL, DC, SY, SY, CC, SY, QT, BK, BK, SY, SY, BK, SY, SY, SY,
/* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? */
NU, NU, NU, NU, NU, NU, NU, NU, NU,

2
C/threads.c
View File

@ -51,7 +51,7 @@ blob_type_t PL_Message_Queue = {
#if DEBUG_LOCKS||DEBUG_PE_LOCKS
int debug_locks = FALSE, debug_pe_locks = FALSE;
bool debug_locks = true, debug_pe_locks = true;
static Int p_debug_locks( USES_REGS1 ) { debug_pe_locks = 1; return TRUE; }
static Int p_nodebug_locks( USES_REGS1 ) { debug_locks = 0; debug_pe_locks = 0; return TRUE; }

3792
C/x.c
View File

File diff suppressed because it is too large Load Diff

20
H/Yap.h
View File

@ -847,6 +847,26 @@ LOG0(const char *f, int l, const char *fmt, ...)
#define REGS_LOG( ... )
#endif
// YAP lexicon
/* Character types for tokenizer and write.c */
typedef enum char_kind_t {
BG = 0, /* initial state */
UC = 1, /* Upper case */
UL = 2, /* Underline */
LC = 3, /* Lower case */
NU = 4, /* digit */
QT = 5, /* single quote */
DC = 6, /* double quote */
SY = 7, /* Symbol character */
SL = 8, /* Solo character */
BK = 9, /* Brackets & friends */
BS = 10, /* Blank */
EF = 11, /* End of File marker */
CC = 12 /* comment,char % */
} charkind_t;
#ifndef __ANDROID__
#define __android_log_print( ... )
#endif

2
H/iatoms.h
View File

@ -500,7 +500,7 @@
FunctorStreamEOS = Yap_MkFunctor(AtomEndOfStream,1);
FunctorStreamPos = Yap_MkFunctor(AtomStreamPos,4);
FunctorString1 = Yap_MkFunctor(AtomString,1);
FunctorSyntaxError = Yap_MkFunctor(AtomSyntaxError,7);
FunctorSyntaxError = Yap_MkFunctor(AtomSyntaxError,5);
FunctorShortSyntaxError = Yap_MkFunctor(AtomSyntaxError,1);
FunctorTermExpansion = Yap_MkFunctor(AtomTermExpansion,2);
FunctorThreadRun = Yap_MkFunctor(AtomTopThreadGoal,2);

16
OPTYap/locks_pthread.h
View File

@ -32,7 +32,7 @@ int Yap_ThreadID( void );
#define DESTROY_LOCK(LOCK_VAR) pthread_mutex_destroy(&(LOCK_VAR))
#define TRY_LOCK(LOCK_VAR) pthread_mutex_trylock(&(LOCK_VAR))
#if DEBUG_LOCKS
extern int debug_locks;
extern bool debug_locks;
#define LOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: LOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_lock(&(LOCK_VAR)) )
#define UNLOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: UNLOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_unlock(&(LOCK_VAR)) )
@ -41,21 +41,21 @@ extern int debug_locks;
#define UNLOCK(LOCK_VAR) pthread_mutex_unlock(&(LOCK_VAR))
#endif
static inline int
static inline bool
xIS_LOCKED(pthread_mutex_t *LOCK_VAR) {
if (pthread_mutex_trylock(LOCK_VAR) == 0) {
pthread_mutex_unlock(LOCK_VAR);
return TRUE;
return true;
}
return FALSE;
return false;
}
static inline int
static inline bool
xIS_UNLOCKED(pthread_mutex_t *LOCK_VAR) {
if (pthread_mutex_trylock(LOCK_VAR) == 0) {
pthread_mutex_unlock(LOCK_VAR);
return FALSE;
return false;
}
return TRUE;
return true;
}
#define IS_LOCKED(LOCK_VAR) xIS_LOCKED(&(LOCK_VAR))
@ -65,7 +65,7 @@ xIS_UNLOCKED(pthread_mutex_t *LOCK_VAR) {
#define INIT_RWLOCK(X) pthread_rwlock_init(&(X), NULL)
#define DESTROY_RWLOCK(X) pthread_rwlock_destroy(&(X))
#if DEBUG_PE_LOCKS
extern int debug_pe_locks;
extern bool debug_pe_locks;
#define READ_LOCK(X) ((debug_pe_locks ? \
fprintf(debugf, "[%d] %s:%d: RLOCK(%p)\n", \

2
include/YapError.h
View File

@ -23,9 +23,7 @@ typedef enum
FATAL_ERROR,
INTERNAL_ERROR,
INTERNAL_COMPILER_ERROR,
#if !YAP_JIT
NOJIT_ERROR, /* I added */
#endif
PURE_ABORT,
CALL_COUNTER_UNDERFLOW,
/* ISO_ERRORS */

2
misc/ATOMS
View File

@ -505,7 +505,7 @@ F Stream Stream 1
F StreamEOS EndOfStream 1
F StreamPos StreamPos 4
F String1 String 1
F SyntaxError SyntaxError 7
F SyntaxError SyntaxError 5
F ShortSyntaxError SyntaxError 1
F TermExpansion TermExpansion 2
F ThreadRun TopThreadGoal 2

4
os/charsio.c
View File

@ -1012,8 +1012,8 @@ Yap_InitCharsio( void )
Yap_InitCPred ("get_char", 1, getchar_1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("get0", 1, getcode_1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$get0_line_codes", 2, get0_line_codes, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("get_byte", 2, get_byte, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("get_byte", 1, get_byte_1, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("get_byte", 2, get_byte, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("get_byte", 1, get_byte_1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("put", 1, put_code_1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("put", 2, put_code, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("put_code", 1, put_code_1, SafePredFlag|SyncPredFlag);

12
os/format.c
View File

@ -658,7 +658,17 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
if (targ > tnum-1)
goto do_consistency_error;
t = targs[targ++];
if (!format_print_str (sno, repeats, has_repeats, t, f_putc)) {
if (IsVarTerm(t))
goto do_instantiation_error;
if (IsStringTerm(t)) {
if (has_repeats)
goto do_consistency_error;
yhandle_t sl = Yap_StartSlots();
// stream is already locked.
Yap_plwrite (t, GLOBAL_Stream+sno, 0, Handle_vars_f|To_heap_f, 1200);
Yap_CloseSlots(sl);
LOCAL_FormatInfo = &finfo;
} else if (!format_print_str (sno, repeats, has_repeats, t, f_putc)) {
goto do_default_error;
}
break;

6
os/iopreds.h
View File

@ -13,6 +13,10 @@ static char SccsId[] = "%W% %G%";
#ifndef IOPREDS_H
#define IOPREDS_H 1
#include <stdlib.h>
#include "Yap.h"
#include "Atoms.h"
/*
* This file defines main data-structure for stream management,
*
@ -106,7 +110,7 @@ typedef struct read_data_t
Term subtpos; /* Report Subterm positions */
bool cycles; /* Re-establish cycles */
yapSourceLocation start_of_term; /* Position of start of term */
ModEntry* module; /* Current source module */
struct mod_entry* module; /* Current source module */
unsigned int flags; /* Module syntax flags */
int styleCheck; /* style-checking mask */
bool backquoted_string; /* Read `hello` as string */

85
os/readterm.c
View File

@ -230,25 +230,32 @@ static const param_t read_defs[] =
* +
*/
Term
Yap_syntax_error (TokEntry * tokptr, int sno)
Yap_syntax_error (TokEntry * errtok, int sno)
{
CACHE_REGS
Term info;
Term out = MkIntTerm(0);
Term startline, errline, endline;
Term tf[7];
Term *error = tf+3;
Term tf[5];
Term *tailp = tf+4;
CELL *Hi = HR;
UInt count = 0;
Term tcount = MkIntegerTerm(count);
TokEntry * tok = LOCAL_tokptr;
Int cline = tok->TokPos;
startline = MkIntegerTerm(tokptr->TokPos);
*tailp = TermNil;
startline = MkIntegerTerm(cline);
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
while (1) {
if (errtok != LOCAL_toktide) {
errtok = LOCAL_toktide;
}
errline = MkIntegerTerm( errtok->TokPos );
while (tok) {
Term ts[2];
if (HR > ASP-1024) {
tf[3] = TermNil;
tf[4] = TermNil;
errline = MkIntegerTerm(0);
endline = MkIntegerTerm( 0 );
count = 0;
@ -256,12 +263,16 @@ Yap_syntax_error (TokEntry * tokptr, int sno)
HR = Hi;
break;
}
if (tokptr == LOCAL_toktide) {
errline = MkIntegerTerm( tokptr->TokPos );
out = MkIntegerTerm(count);
if (tok->TokPos != cline) {
*tailp = MkPairTerm(MkAtomTerm(AtomNil),TermNil);
tailp = RepPair(*tailp)+1;
}
info = tokptr->TokInfo;
switch (tokptr->Tok) {
if (tok == errtok && tok->Tok != Error_tok) {
*tailp = MkPairTerm(MkAtomTerm(AtomError),TermNil);
tailp = RepPair(*tailp)+1;
}
info = tok->TokInfo;
switch (tok->Tok) {
case Name_tok:
{
Term t0[1];
@ -270,7 +281,7 @@ Yap_syntax_error (TokEntry * tokptr, int sno)
}
break;
case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber,1),1,&(tokptr->TokInfo));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber,1),1,&(tok->TokInfo));
break;
case Var_tok:
{
@ -312,7 +323,14 @@ Yap_syntax_error (TokEntry * tokptr, int sno)
}
break;
case Error_tok:
{
ts[0] = MkAtomTerm(AtomError);
}
break;
case eot_tok:
endline = MkIntegerTerm(tok->TokPos);
ts[0] = MkAtomTerm(AtomDot);
break;
case Ponctuation_tok:
{
@ -326,20 +344,13 @@ Yap_syntax_error (TokEntry * tokptr, int sno)
ts[0] = MkAtomTerm(Yap_LookupAtom(s));
}
}
if (tokptr->Tok == Ord (eot_tok)) {
*error = TermNil;
endline = MkIntegerTerm(tokptr->TokPos);
tok = tok->TokNext;
if (!tok)
break;
} else if (tokptr->Tok != Ord (Error_tok)) {
ts[1] = MkIntegerTerm(tokptr->TokPos);
*error = MkPairTerm(Yap_MkApplTerm(FunctorMinus,2,ts),TermNil);
error = RepPair(*error)+1;
count++;
}
tokptr = tokptr->TokNext;
*tailp = MkPairTerm(ts[0], TermNil);
tailp = RepPair(*tailp)+1;
}
{
Term tcount = MkIntegerTerm(count);
Term t[3];
tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomRead,1),1,&tcount);
@ -348,11 +359,17 @@ Yap_syntax_error (TokEntry * tokptr, int sno)
t[2] = endline;
tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween,3),3,t);
}
tf[2] = tf[3] = TermDot;
tf[4] = MkIntegerTerm(count);
tf[5] = out;
tf[6] = Yap_StreamUserName(sno);
return(Yap_MkApplTerm(FunctorSyntaxError,7,tf));
/* 0: id */
/* 1: strat, error, end line */
/*2 msg */
if (LOCAL_ErrorMessage)
tf[2] = MkStringTerm(LOCAL_ErrorMessage);
else
tf[2] = MkStringTerm("");
/* file */
tf[3] = Yap_StreamUserName(sno);
/* tf[4] = ; */
return(Yap_MkApplTerm(FunctorSyntaxError,5,tf));
}
typedef struct FEnv {
@ -360,6 +377,7 @@ typedef struct FEnv {
Term tpos; /// initial position of the term to be read.
Term t; /// the output term
TokEntry *tokstart; /// the token list
TokEntry *toklast; /// the last token
CELL *old_H; /// initial H, will be reset on stack overflow.
tr_fr_ptr old_TR; /// initial TR
xarg *args; /// input args
@ -712,8 +730,6 @@ parseError(REnv *re, FEnv *fe, int inp_stream)
{
CACHE_REGS
fe->t = 0;
TokEntry * tokstart =
LOCAL_tokptr;
if (LOCAL_Error_TYPE == OUT_OF_TRAIL_ERROR ||
LOCAL_Error_TYPE == OUT_OF_AUXSPACE_ERROR ||
LOCAL_Error_TYPE == OUT_OF_HEAP_ERROR ||
@ -725,7 +741,7 @@ parseError(REnv *re, FEnv *fe, int inp_stream)
/* just fail */
return YAP_PARSING_FINISHED;
} else {
Term terr = Yap_syntax_error(tokstart, inp_stream);
Term terr = Yap_syntax_error(fe->toklast, inp_stream);
if (ParserErrorStyle ==TermError) {
LOCAL_ErrorMessage = "SYNTAX ERROR";
Yap_Error(SYNTAX_ERROR,terr,LOCAL_ErrorMessage);
@ -747,6 +763,8 @@ parse(REnv *re, FEnv *fe, int inp_stream)
LOCAL_tokptr;
fe->t = Yap_Parse(re->prio);
fe->toklast = LOCAL_tokptr;
LOCAL_tokptr = tokstart;
if (fe->t == 0 || LOCAL_ErrorMessage)
return YAP_PARSING_ERROR;
TR = (tr_fr_ptr)LOCAL_ScannerStack;
@ -760,7 +778,6 @@ parse(REnv *re, FEnv *fe, int inp_stream)
first_char = tokstart->TokPos;
#endif /* EMACS */
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
LOCAL_tokptr = NULL;
return YAP_PARSING_FINISHED;
}
@ -775,7 +792,7 @@ parse(REnv *re, FEnv *fe, int inp_stream)
*
* @return the term or 0 in case of error.
*
* Implemenfayubluses a state machine: default is init, scan, parse, complete.
* Implementation uses a state machine: default is init, scan, parse, complete.
*
*
*/

15
os/yapio.h
View File

@ -31,21 +31,6 @@
#ifndef _PL_WRITE_
/* Character types for tokenizer and write.c */
#define UC 1 /* Upper case */
#define UL 2 /* Underline */
#define LC 3 /* Lower case */
#define NU 4 /* digit */
#define QT 5 /* single quote */
#define DC 6 /* double quote */
#define SY 7 /* Symbol character */
#define SL 8 /* Solo character */
#define BK 9 /* Brackets & friends */
#define BS 10 /* Blank */
#define EF 11 /* End of File marker */
#define CC 12 /* comment char % */
#define EOFCHAR EOF
#endif

3
pl/boot.yap
View File

@ -237,8 +237,7 @@ private(_).
'$cut_by'/1,
'$disable_debugging'/0,
'$do_live'/0,
'$
'/0,
'$'/0,
'$find_goal_definition'/4,
'$handle_throw'/3,
'$head_and_body'/3,

4
pl/errors.yap
View File

@ -341,9 +341,9 @@ print_message(_, Term) :-
'$print_system_message'(_, banner, _) :-
current_prolog_flag(verbose, silent), !.
'$print_system_message'(Term, Level, Lines) :-
( Level == error -> Term \= error(syntax_error(_), _) ; Level == warning ),
( Level == error -> true ; Level == warning ),
'$messages':prefix(Level, LinePrefix, Stream, Lines2, Lines),
'$messages':file_location(LinesF, Lines2), !,
'$messages':file_location(Term, LinesF, Lines2), !,
flush_output(user_output),
flush_output(user_error),
print_message_lines(Stream, LinePrefix, [nl|LinesF]).

2
pl/init.yap
View File

@ -240,7 +240,7 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- set_prolog_flag(generate_debug_info,true).
:- recorda('$dialect',yap,_).
grep:- recorda('$dialect',yap,_).
%
% cleanup ensure loaded and recover some data-base space.

92
pl/messages.yap
View File

@ -67,14 +67,13 @@ handling in YAP:
:- multifile user:generate_message_hook/3.
file_location -->
{ source_location(FileName, LN) },
file_position(FileName,LN).
file_location(syntax_error(_,between(_,LN,_),_,FileName,_)) -->
[ '~a:~d:0: ' - [FileName,LN] ],
{ source_location(FileName, LN) }.
file_location(_) -->
[ '~a:~d:0: ' - [FileName,LN] ],
{ source_location(FileName, LN) }.
file_position(user_input,LN) -->
[ 'user_input:~d:0: ' - [LN] ].
file_position(FileName,LN) -->
[ '~a:~d:0: ' - [FileName,LN] ].
generate_message(Term, Lines, []) :-
user:generate_message_hook(Term, [], Lines), !.
@ -121,7 +120,7 @@ generate_message(error(Error,Context)) -->
system_message(error(Error,Context)),
stack_dump(error(Error,Context)).
generate_message(M) -->
file_location,
file_location(M),
system_message(M),
stack_dump(M).
@ -133,8 +132,8 @@ stack_dump(error(_,_)) -->
'$hacks':display_stack_info(CPs, Envs, 20, CP).
stack_dump(_) --> [].
prolog_message(X,Y,Z) :-
system_message(X,Y,Z).
prolog_message(X) -->
system_message(X).
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
system_message(query(_QueryResult,_)) --> [].
@ -212,6 +211,11 @@ system_message(myddas_version(Version)) -->
[ 'MYDDAS version ~a' - [Version] ].
system_message(yes) -->
[ 'yes' ].
system_message( syntax_error(read(_R),between(L0,LM,LF),Msg,_,Term) ) -->
!,
['SYNTAX ERROR: ~s' - [Msg]],
[nl],
syntax_error_term( between(L0,LM,LF), Term ).
system_message(error(Msg,Info)) -->
( { var(Msg) } ; { var(Info)} ), !,
['bad error ~w' - [error(Msg,Info)]].
@ -346,34 +350,9 @@ system_message(error(resource_error(trail), Where)) -->
[ 'RESOURCE ERROR- not enough trail space' - [Where] ].
system_message(error(signal(SIG,_), _)) -->
[ 'UNEXPECTED SIGNAL: ~a' - [SIG] ].
system_message(error(syntax_error(_), [syntax_error(G,_,Msg,[],_,0,File)|_])) -->
[ 'SYNTAX ERROR at "~a", goal ~q: ~a' - [File,G,Msg] ].
% SWI like I/O error message.
system_message(error(syntax_error(end_of_clause), [stream(Stream, Line, _, _)|_])) -->
[ 'SYNTAX ERROR ~a, stream ~w, near line ~d.' - ['Unexpected end of clause',Stream,Line] ].
system_message(error(syntax_error(read(_R),between(_L0,_LM,_LF),_Dot,Term,Pos,Start,File))) -->
{ Term = [_|_] },
['SYNTAX ERROR' - []],
syntax_error_line(File, Start, Pos),
syntax_error_term(10, Pos, Term),
[ '.' ].
system_message(error(system_error, Where)) -->
[ 'SYSTEM ERROR- ~w' - [Where] ].
system_message(error(internal_compiler_error, Where)) -->
[ 'INTERNAL COMPILER ERROR- ~w' - [Where] ].
system_message(error(system_error(Message), Where)) -->
[ 'SYSTEM ERROR- ~w at ~w]' - [Message,Where] ].
system_message(error(timeout_error(T,Obj), _Where)) -->
[ 'TIMEOUT ERROR- operation ~w on object ~w' - [T,Obj] ].
system_message(error(type_error(T,_,Err,M), _Where)) -->
[ 'TYPE ERROR- ~w: expected ~w, got ~w' - [T,Err,M] ].
system_message(error(type_error(TE,W), Where)) -->
{ object_name(TE, M) }, !,
[ 'TYPE ERROR- ~w: expected ~a, got ~w' - [Where,M,W] ].
system_message(error(type_error(TE,W), Where)) -->
[ 'TYPE ERROR- ~w: expected ~q, got ~w' - [Where,TE,W] ].
system_message(error(unknown, Where)) -->
[ 'EXISTENCE ERROR- procedure ~w undefined' - [Where] ].
system_message(error(unhandled_exception,Throw)) -->
[ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ].
system_message(error(uninstantiation_error(TE), _Where)) -->
@ -500,26 +479,17 @@ list_of_preds([P|L]) -->
['~q' - [P]],
list_of_preds(L).
syntax_error_term(between(I,I,I),L) -->
!,
syntax_error_tokens(L).
syntax_error_term(between(I,_J,L),LTaL) -->
[' term from line ~d to line ~d' - [I,L] ],
syntax_error_tokens(LTaL).
syntax_error_line('', _,_) --> !,
[':~n' ].
syntax_error_line(File, Position,_) -->
[' at ~a, near line ~d:~n' - [File,Position]].
syntax_error_term(0,J,L) -->
['~n' ],
syntax_error_term(10,J,L).
syntax_error_term(_,0,L) --> !,
[ '~n<==== HERE ====>~n' ],
syntax_error_term(10,-1,L).
syntax_error_term(_,_,[]) --> !.
syntax_error_term(I,J,[T-_P|R]) -->
syntax_error_tokens([]) --> [].
syntax_error_tokens([T|L]) -->
syntax_error_token(T),
{
I1 is I-1,
J1 is J-1
},
syntax_error_term(I1,J1,R).
syntax_error_tokens(L).
syntax_error_token(atom(A)) --> !,
[ '~a' - [A] ].
@ -528,11 +498,23 @@ syntax_error_token(number(N)) --> !,
syntax_error_token(var(_,S,_)) --> !,
[ '~s' - [S] ].
syntax_error_token(string(S)) --> !,
[ ' ""~s"' - [S] ].
[ '\"~s\"' - [S] ].
syntax_error_token(error) --> !,
[ '~n<==== HERE ====>~n' ].
syntax_error_token('[]') --> !,
[ nl ].
syntax_error_token('(') --> !,
[ '(' ].
syntax_error_token('(') --> !,
[ '{' ].
syntax_error_token('(') --> !,
[ '[' ].
syntax_error_token(')') --> !,
[ ' )' ].
syntax_error_token(')') --> !,
[ ']' ].
syntax_error_token(')') --> !,
[ '}' ].
syntax_error_token(',') --> !,
[ ',' ].
syntax_error_token(A) --> !,
@ -571,7 +553,7 @@ the _Prefix_ is printed too.
*/
prolog:print_message_lines(_S, _, []) :- !.
prolog:print_message_lines(_S, P, [at_same_line|Lines]) :- !,
prolog:print_message_lines(S, P, [at_same_line|Lines]) :- !,
'$messages':print_message_line(S, Lines, Rest),
prolog:print_message_lines(S, P, Rest).
prolog:print_message_lines(S, kind(Kind), Lines) :- !,