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

syntax error handling

Browse Source
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

149
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
FAIL;
} 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,7 +792,8 @@ 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) {
FAIL;
syntax_msg( "could not convert \'%s\'", (char *)LOCAL_tokptr->TokInfo );
FAIL;
}
NextToken;
} break;
@ -732,7 +803,8 @@ 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) {
FAIL;
syntax_msg( "could not convert \'%S\'", (wchar_t *)LOCAL_tokptr->TokInfo );
FAIL;
}
NextToken;
} break;
@ -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)))
FAIL;
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);

7
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,
@ -893,7 +892,7 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
ch = getchr(inp_stream);
if (base == 0) {
CACHE_REGS
wchar_t ascii = ch;
wchar_t ascii = ch;
int scan_extra = TRUE;
if (ch == '\\' &&
@ -925,7 +924,7 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
has_overflow = (has_overflow || TRUE);
ch = getchr(inp_stream);
}
}
}
} else if (ch == 'x' && base == 0) {
might_be_float = FALSE;
if (--max_size == 0) {

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

112
os/charsio.c
View File

@ -38,7 +38,7 @@ static char SccsId[] = "%W% %G%";
#if HAVE_IO_H
/* Windows */
#include <io.h>
#endif
#endif
#if HAVE_SOCKET
#include <winsock2.h>
#endif
@ -60,12 +60,12 @@ static Int flush_all_streams( USES_REGS1);
INLINE_ONLY inline EXTERN Term MkCharTerm (Int c);
/**
/**
* MkCharTerm: convert a character into a single atom.
*
*
* @param c the character code
*
* @return the term.
*
* @return the term.
*/
INLINE_ONLY inline EXTERN Term
MkCharTerm (Int c)
@ -77,12 +77,12 @@ MkCharTerm (Int c)
}
/**
/**
* CharOfAtom: convert an atom into a single character.
*
*
* @param at the atom
*
* @return the char .
*
* @return the char .
*/
INLINE_ONLY inline EXTERN Int
CharOfAtom (Atom at)
@ -99,7 +99,7 @@ CharOfAtom (Atom at)
static Int
at_end_of_stream ( USES_REGS1 )
{ /* at_end_of_stream */
/* the next character is a EOF */
/* the next character is a EOF */
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "past_eof/1");
Int out;
@ -117,7 +117,7 @@ at_end_of_stream ( USES_REGS1 )
static Int
at_end_of_stream_0 ( USES_REGS1 )
{ /* at_end_of_stream */
/* the next character is a EOF */
/* the next character is a EOF */
int sno = LOCAL_c_input_stream;
Int out;
@ -137,7 +137,7 @@ yap_fflush( sno)
{
Yap_ReadlineFlush( sno );
if ( (GLOBAL_Stream[sno].status & Output_Stream_f) &&
! (GLOBAL_Stream[sno].status &
! (GLOBAL_Stream[sno].status &
(Null_Stream_f|
InMemory_Stream_f|
Socket_Stream_f|
@ -295,7 +295,7 @@ get0_line_codes ( USES_REGS1 )
}
out = read_line(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
if (rewind)
if (rewind)
return Yap_unify(MkPairTerm(MkIntegerTerm(ch),out), ARG2);
else
return Yap_unify(out,ARG2);
@ -347,7 +347,7 @@ put_code_1 ( USES_REGS1 )
{ /* '$put'(,N) */
int sno = LOCAL_c_output_stream, ch;
Term t2;
if (IsVarTerm(t2 = Deref(ARG1))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1");
return FALSE;
@ -367,7 +367,7 @@ put_code_1 ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, (int) IntegerOfTerm (Deref (ARG2)));
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file);
* yap_fflush(GLOBAL_Stream[sno].file);
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
@ -379,7 +379,7 @@ put_code ( USES_REGS1 )
int ch;
Term t2;
int sno;
if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1");
return FALSE;
@ -398,11 +398,11 @@ put_code ( USES_REGS1 )
Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2");
return(FALSE);
}
GLOBAL_Stream[sno].stream_wputc (sno, ch);
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file);
* yap_fflush(GLOBAL_Stream[sno].file);
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
@ -414,7 +414,7 @@ put_char_1 ( USES_REGS1 )
int sno = LOCAL_c_output_stream;
Term t2;
int ch;
if (IsVarTerm(t2 = Deref(ARG1))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE;
@ -434,7 +434,7 @@ put_char_1 ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, ch);
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file);
* yap_fflush(GLOBAL_Stream[sno].file);
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
@ -446,7 +446,7 @@ put_char ( USES_REGS1 )
Term t2;
int ch;
int sno;
if (IsVarTerm(t2 = Deref(ARG1))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE;
@ -468,7 +468,7 @@ put_char ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, (int) IntegerOfTerm (Deref (ARG2)));
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file);
* yap_fflush(GLOBAL_Stream[sno].file);
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
@ -490,7 +490,7 @@ tab_1 ( USES_REGS1 )
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "tab/1");
return FALSE;
}
LOCK(GLOBAL_Stream[sno].streamlock);
if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
@ -502,7 +502,7 @@ tab_1 ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, ' ');
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file);
* yap_fflush(GLOBAL_Stream[sno].file);
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
@ -527,7 +527,7 @@ tab ( USES_REGS1 )
sno = Yap_CheckStream (ARG1, Output_Stream_f, "nl/1");
if (sno < 0)
return (FALSE);
if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "nl/0");
@ -538,7 +538,7 @@ tab ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, ' ');
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file);
* yap_fflush(GLOBAL_Stream[sno].file);
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
@ -557,7 +557,7 @@ nl_1 ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, 10);
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file);
* yap_fflush(GLOBAL_Stream[sno].file);
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
@ -577,7 +577,7 @@ nl ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, 10);
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file);
* yap_fflush(GLOBAL_Stream[sno].file);
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
@ -610,7 +610,7 @@ put_byte ( USES_REGS1 )
GLOBAL_Stream[sno].stream_putc(sno, ch);
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file);
* yap_fflush(GLOBAL_Stream[sno].file);
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
@ -652,7 +652,7 @@ skip_1 ( USES_REGS1 )
Term t2;
int sno;
int ch;
if (IsVarTerm(t2 = Deref(ARG1))) {
Yap_Error(INSTANTIATION_ERROR, t2, "skip/2");
return FALSE;
@ -679,7 +679,7 @@ skip ( USES_REGS1 )
Term t2;
int sno;
int ch;
if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "skip/2");
return FALSE;
@ -698,14 +698,14 @@ skip ( USES_REGS1 )
return (TRUE);
}
/**
/**
* @pred flush_output(+Stream)
*
* Flush the stream _Stream_, that is, make sure all pending output is committed
* before any further execution.
*
* @param +_Stream_
*
*
* @param +_Stream_
*
*/
static Int
flush_output ( USES_REGS1 )
@ -718,13 +718,13 @@ flush_output ( USES_REGS1 )
return (TRUE);
}
/**
/**
* @pred flush_output
*
* Flush the current output stream, that is, make sure all pending output is committed
* before any further execution. By default this is user_output, but it may be
* changed by current_output/1.
*
*
*/
static Int
flush_output0 ( USES_REGS1 )
@ -746,7 +746,7 @@ flush_all_streams ( USES_REGS1 )
#else
fflush (NULL);
#endif
return TRUE;
}
@ -755,7 +755,7 @@ static Int dopeek( int sno )
Int ocharcount, olinecount, olinepos;
StreamDesc *s;
Int ch;
s = GLOBAL_Stream+sno;
ocharcount = s->charcount;
olinecount = s->linecount;
@ -784,7 +784,7 @@ static Int dopeek( int sno )
If _C_ is unbound, or is the code for a character, and
the stream _S_ is a text stream, read the next character from the
current stream and unify its code with _C_, while
leaving the current stream position unaltered.
leaving the current stream position unaltered.
*/
@ -794,13 +794,13 @@ leaving the current stream position unaltered.
If _C_ is unbound, or is the code for a character, and
the stream _S_ is a text stream, read the next character from the
current stream and unify its code with _C_, while
leaving the current stream position unaltered.
leaving the current stream position unaltered.
*/
static Int
peek_code ( USES_REGS1 )
{ /* at_end_of_stream */
/* the next character is a EOF */
/* the next character is a EOF */
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2");
Int ch;
@ -824,13 +824,13 @@ peek_code ( USES_REGS1 )
If _C_ is unbound, or is the code for a character, and
the current input stream is a text stream, read the next character from the
current stream and unify its code with _C_, while
leaving the current stream position unaltered.
leaving the current stream position unaltered.
*/
static Int
peek_code_1 ( USES_REGS1 )
{ /* at_end_of_stream */
/* the next character is a EOF */
/* the next character is a EOF */
int sno = LOCAL_c_input_stream;
Int ch;
@ -857,7 +857,7 @@ code with _C_, while leaving the current stream position unaltered.
static Int
peek_byte ( USES_REGS1 )
{ /* at_end_of_stream */
/* the next character is a EOF */
/* the next character is a EOF */
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2");
Int ch;
@ -885,7 +885,7 @@ code with _C_, while leaving the current stream position unaltered.
static Int
peek_byte_1 ( USES_REGS1 )
{ /* at_end_of_stream */
/* the next character is a EOF */
/* the next character is a EOF */
int sno = LOCAL_c_input_stream;
Int ch;
@ -915,8 +915,8 @@ atom with _C_, while leaving the stream position unaltered.
*/
static Int
peek_char ( USES_REGS1 )
{
/* the next character is a EOF */
{
/* the next character is a EOF */
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2");
wchar_t wsinp[2];
Int ch;
@ -947,12 +947,12 @@ atom with _C_, while leaving the stream position unaltered.
*/
static Int
peek_char_1 ( USES_REGS1 )
{
/* the next character is a EOF */
{
/* the next character is a EOF */
int sno = LOCAL_c_input_stream;
wchar_t wsinp[2];
Int ch;
LOCK(GLOBAL_Stream[sno].streamlock);
if ((ch = dopeek( sno )) < 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
@ -971,7 +971,7 @@ peek_char_1 ( USES_REGS1 )
If _C_ is unbound, or is the code for a character, and
the stream _S_ is a text stream, read the next character from the
current stream and unify its code with _C_, while
leaving the current stream position unaltered.
leaving the current stream position unaltered.
Please use the ISO built-in peek_code/2.
*/
@ -982,7 +982,7 @@ Please use the ISO built-in peek_code/2.
If _C_ is unbound, or is the code for a character, and
the currrent input stream is a text stream, read the next character from the
current stream and unify its code with _C_, while
leaving the current stream position unaltered.
leaving the current stream position unaltered.
*/
@ -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);
@ -1049,5 +1049,5 @@ Yap_InitCharsio( void )
Yap_InitCPred ("tab", 2, tab, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("tab1", 1, tab_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;

16
os/iopreds.h
View File

@ -13,8 +13,12 @@ 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,
* This file defines main data-structure for stream management,
*
*/
@ -95,18 +99,18 @@ typedef struct read_data_t
unsigned char *base; /* base of clause */
unsigned char *end; /* end of the clause */
unsigned char *token_start; /* start of most recent read token */
int magic; /* RD_MAGIC */
struct stream_desc *stream;
FILE *f; /* file. of known */
Term position; /* Line, line pos, char and byte */
void *posp; /* position pointer */
size_t posi; /* position number */
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 */
@ -119,7 +123,7 @@ typedef struct read_data_t
Term exception; /* raised exception */
Term variables; /* report variables */
Term singles; /* Report singleton variables */
Term varnames; /* Report variables+names */
Term varnames; /* Report variables+names */
int strictness; /* Strictness level */
#ifdef O_QUASIQUOTATIONS
@ -327,7 +331,7 @@ INLINE_ONLY inline EXTERN void count_output_char(int ch, StreamDesc *s);
Term Yap_StreamUserName(int sno);
INLINE_ONLY inline EXTERN void
INLINE_ONLY inline EXTERN void
count_output_char(int ch, StreamDesc *s)
{
if (ch == '\n')

103
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 info;
Term startline, errline, endline;
Term tf[7];
Term *error = tf+3;
Term tf[5];
Term *tailp = tf+4;
CELL *Hi = HR;
UInt count = 0;
startline = MkIntegerTerm(tokptr->TokPos);
Term tcount = MkIntegerTerm(count);
TokEntry * tok = LOCAL_tokptr;
Int cline = tok->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);
}
info = tokptr->TokInfo;
switch (tokptr->Tok) {
if (tok->TokPos != cline) {
*tailp = MkPairTerm(MkAtomTerm(AtomNil),TermNil);
tailp = RepPair(*tailp)+1;
}
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,10 +323,17 @@ Yap_syntax_error (TokEntry * tokptr, int sno)
}
break;
case Error_tok:
case eot_tok:
break;
{
ts[0] = MkAtomTerm(AtomError);
}
break;
case eot_tok:
endline = MkIntegerTerm(tok->TokPos);
ts[0] = MkAtomTerm(AtomDot);
break;
case Ponctuation_tok:
{
{
char s[2];
s[1] = '\0';
if ((info) == 'l') {
@ -325,21 +343,14 @@ 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);
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;
}
}
tok = tok->TokNext;
if (!tok)
break;
*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.

106
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_position(user_input,LN) -->
[ 'user_input:~d:0: ' - [LN] ].
file_position(FileName,LN) -->
[ '~a:~d:0: ' - [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) }.
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,10 +132,10 @@ 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) :- !,
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
system_message(query(_QueryResult,_)) --> [].
system_message(format(Msg, Args)) -->
[Msg - Args].
@ -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,43 +479,46 @@ 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] ].
[ '~a' - [A] ].
syntax_error_token(number(N)) --> !,
[ ' ~w' - [N] ].
[ '~w' - [N] ].
syntax_error_token(var(_,S,_)) --> !,
[ ' ~s' - [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) --> !,
[ ' ~a' - [A] ].
[ '~a' - [A] ].
% print_message_lines(+Stream, +Prefix, +Lines)
@ -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) :- !,