/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: parser.c *
* Last rev: *
* mods: *
* comments: Prolog's parser *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
/**
@defgroup YAPSyntax YAP Syntax
@ingroup YAPProgramming
@{
We will describe the syntax of YAP at two levels. We first will
describe the syntax for Prolog terms. In a second level we describe
the \a tokens from which Prolog \a terms are
built.
@defgroup Formal_Syntax Syntax of Terms
@ingroup Syntax
@{
Below, we describe the syntax of YAP terms from the different
classes of tokens defined above. The formalism used will be BNF,
extended where necessary with attributes denoting integer precedence or
operator type.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
term
----> subterm(1200) end_of_term_marker
subterm(N) ----> term(M) [M <= N]
term(N) ----> op(N, fx) subterm(N-1)
| op(N, fy) subterm(N)
| subterm(N-1) op(N, xfx) subterm(N-1)
| subterm(N-1) op(N, xfy) subterm(N)
| subterm(N) op(N, yfx) subterm(N-1)
| subterm(N-1) op(N, xf)
| subterm(N) op(N, yf)
term(0) ----> atom '(' arguments ')'
| '(' subterm(1200) ')'
| '{' subterm(1200) '}'
| list
| string
| number
| atom
| variable
arguments ----> subterm(999)
| subterm(999) ',' arguments
list ----> '[]'
| '[' list_expr ']'
list_expr ----> subterm(999)
| subterm(999) list_tail
list_tail ----> ',' list_expr
| ',..' subterm(999)
| '|' subterm(999)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Notes:
+ \a op(N,T) denotes an atom which has been previously declared with type
\a T and base precedence \a N.
+ Since ',' is itself a pre-declared operator with type \a xfy and
precedence 1000, is \a subterm starts with a '(', \a op must be
followed by a space to avoid ambiguity with the case of a functor
followed by arguments, e.g.:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ (a,b) [the same as '+'(','(a,b)) of arity one]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
versus
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+(a,b) [the same as '+'(a,b) of arity two]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
In the first rule for term(0) no blank space should exist between
\a atom and '('.
+
Each term to be read by the YAP parser must end with a single
dot, followed by a blank (in the sense mentioned in the previous
paragraph). When a name consisting of a single dot could be taken for
the end of term marker, the ambiguity should be avoided by surrounding the
dot with single quotes.
@}
*/
/*
* Description:
*
* parser: produces a prolog term from an array of tokens
*
* parser usage: the parser takes its input from an array of token descriptions
* addressed by the global variable 'tokptr' and produces a Term as result. A
* macro 'NextToken' should be defined in 'yap.h' for advancing 'tokptr' from
* one token to the next. In the distributed version this macro also updates
* a variable named 'toktide' for keeping track of how far the parser went
* before failling with a syntax error. The parser should be invoked with
* 'tokptr' pointing to the first token. The last token should have type
* 'eot_tok'. The parser return either a Term. Syntactic errors are signaled
* by a return value 0. The parser builds new terms on the 'global stack' and
* also uses an auxiliary stack pointed to by 'AuxSp'. In the distributed
* version this auxiliary stack is assumed to grow downwards. This
* assumption, however, is only relevant to routine 'ParseArgs', and to the
* variable toktide. conclusion: set tokptr pointing to first token set AuxSp
* Call Parse
*
* VSC: Working whithout known bugs in 87/4/6
*
* LD: -I or +I evaluated by parser 87/4/28
*
* LD: parser extended 87/4/28
*
*/
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "YapText.h"
#include "yapio.h"
#include "eval.h"
/* stuff we want to use in standard YAP code */
#include "iopreds.h"
#if HAVE_STRING_H
#include
#endif
#if HAVE_STDARG_H
#include
#endif
#ifdef __STDC__XXX
#define Volatile volatile
#else
#define Volatile
#endif
/* weak backtraking mechanism based on long_jump */
typedef struct jmp_buff_struct { sigjmp_buf JmpBuff; } JMPBUFF;
static void GNextToken(CACHE_TYPE1);
static void checkfor(wchar_t, JMPBUFF *, encoding_t CACHE_TYPE);
static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term, encoding_t, Term CACHE_TYPE);
static Term ParseList(JMPBUFF *, encoding_t, Term CACHE_TYPE);
static Term ParseTerm(int, JMPBUFF *, encoding_t, Term CACHE_TYPE);
const char *Yap_tokRep(TokEntry *tokptr, encoding_t enc);
static void syntax_msg(const char *msg, ...) {
CACHE_REGS
va_list ap;
if (LOCAL_toktide == LOCAL_tokptr) {
char out[YAP_FILENAME_MAX];
va_start(ap, msg);
vsnprintf(out, YAP_FILENAME_MAX - 1, msg, ap);
LOCAL_Error_Term = MkStringTerm( out );
LOCAL_Error_TYPE = SYNTAX_ERROR;
va_end(ap);
}
}
#define TRY(S, P) \
{ \
Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT = LOCAL_tokptr; \
Volatile CELL *saveH = HR; \
Volatile int savecurprio = curprio; \
saveenv = FailBuff; \
if (!sigsetjmp(newenv.JmpBuff, 0)) { \
FailBuff = &newenv; \
S; \
FailBuff = saveenv; \
P; \
} else { \
FailBuff = saveenv; \
HR = saveH; \
curprio = savecurprio; \
LOCAL_tokptr = saveT; \
} \
}
#define TRY3(S, P, F) \
{ \
Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT = LOCAL_tokptr; \
Volatile CELL *saveH = HR; \
saveenv = FailBuff; \
if (!sigsetjmp(newenv.JmpBuff, 0)) { \
FailBuff = &newenv; \
S; \
FailBuff = saveenv; \
P; \
} else { \
FailBuff = saveenv; \
HR = saveH; \
LOCAL_tokptr = saveT; \
F \
} \
}
#define FAIL siglongjmp(FailBuff->JmpBuff, 1)
VarEntry *
Yap_LookupVar(const char *var) /* lookup variable in variables table */
{
CACHE_REGS
VarEntry *p;
#if DEBUG
if (GLOBAL_Option[4])
fprintf(stderr, "[LookupVar %s]", var);
#endif
if (var[0] != '_' || var[1] != '\0') {
VarEntry **op = &LOCAL_VarTable;
UInt hv;
p = LOCAL_VarTable;
hv = HashFunction((unsigned char *)var) % AtomHashTableSize;
while (p != NULL) {
CELL hpv = p->hv;
if (hv == hpv) {
Int scmp;
if ((scmp = strcmp(var, p->VarRep)) == 0) {
p->refs++;
return (p);
} else if (scmp < 0) {
op = &(p->VarLeft);
p = p->VarLeft;
} else {
op = &(p->VarRight);
p = p->VarRight;
}
} else if (hv < hpv) {
op = &(p->VarLeft);
p = p->VarLeft;
} else {
op = &(p->VarRight);
p = p->VarRight;
}
}
p = (VarEntry *)Yap_AllocScannerMemory(strlen(var) + sizeof(VarEntry));
*op = p;
p->VarLeft = p->VarRight = NULL;
p->hv = hv;
p->refs = 1L;
strcpy(p->VarRep, var);
} else {
/* anon var */
p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry) + 2);
p->VarLeft = LOCAL_AnonVarTable;
LOCAL_AnonVarTable = p;
p->VarRight = NULL;
p->refs = 0L;
p->hv = 1L;
p->VarRep[0] = '_';
p->VarRep[1] = '\0';
}
p->VarAdr = TermNil;
return (p);
}
static Term VarNames(VarEntry *p, Term l USES_REGS) {
if (p != NULL) {
if (strcmp(p->VarRep, "_") != 0) {
Term t[2];
Term o;
t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep));
if (!IsVarTerm(p->VarAdr))
p->VarAdr = MkVarTerm();
t[1] = p->VarAdr;
o = Yap_MkApplTerm(FunctorEq, 2, t);
o = MkPairTerm(o, VarNames(p->VarRight,
VarNames(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs();
siglongjmp(LOCAL_IOBotch, 1);
}
return (o);
} else {
return VarNames(p->VarRight, VarNames(p->VarLeft, l PASS_REGS) PASS_REGS);
}
} else {
return (l);
}
}
Term Yap_VarNames(VarEntry *p, Term l) {
CACHE_REGS
return VarNames(p, l PASS_REGS);
}
static Term Singletons(VarEntry *p, Term l USES_REGS) {
if (p != NULL) {
if (p->VarRep[0] != '_' && p->refs == 1) {
Term t[2];
Term o;
t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep));
t[1] = p->VarAdr;
o = Yap_MkApplTerm(FunctorEq, 2, t);
o = MkPairTerm(o,
Singletons(p->VarRight,
Singletons(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs();
siglongjmp(LOCAL_IOBotch, 1);
}
return (o);
} else {
return Singletons(p->VarRight,
Singletons(p->VarLeft, l PASS_REGS) PASS_REGS);
}
} else {
return (l);
}
}
Term Yap_Singletons(VarEntry *p, Term l) {
CACHE_REGS
return Singletons(p, l PASS_REGS);
}
static Term Variables(VarEntry *p, Term l USES_REGS) {
if (p != NULL) {
Term o;
o = MkPairTerm(
p->VarAdr,
Variables(p->VarRight, Variables(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs();
siglongjmp(LOCAL_IOBotch, 1);
}
return (o);
} else {
return (l);
}
}
Term Yap_Variables(VarEntry *p, Term l) {
CACHE_REGS
return Variables(p, l PASS_REGS);
}
static int IsPrefixOp(Atom op, int *pptr, int *rpptr, Term cmod USES_REGS) {
int p;
OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP, cmod PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule && opp->OpModule != cmod) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Prefix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = p &MaskPrio;
if (p & DcrrpFlag)
--*rpptr;
return TRUE;
} else {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
}
int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr) {
CACHE_REGS
return IsPrefixOp(op, pptr, rpptr, CurrentModule PASS_REGS);
}
static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term cmod USES_REGS) {
int p;
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, cmod PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule && opp->OpModule != cmod) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Infix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = *lpptr = p &MaskPrio;
if (p & DcrrpFlag)
--*rpptr;
if (p & DcrlpFlag)
--*lpptr;
return TRUE;
} else {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
}
int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr) {
CACHE_REGS
return IsInfixOp(op, pptr, lpptr, rpptr, CurrentModule PASS_REGS);
}
static int IsPosfixOp(Atom op, int *pptr, int *lpptr, Term cmod USES_REGS) {
int p;
OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP, cmod PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule && opp->OpModule != cmod) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
if ((p = opp->Posfix) != 0) {
READ_UNLOCK(opp->OpRWLock);
*pptr = *lpptr = p &MaskPrio;
if (p & DcrlpFlag)
--*lpptr;
return (TRUE);
} else {
READ_UNLOCK(opp->OpRWLock);
return (FALSE);
}
}
int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) {
CACHE_REGS
return IsPosfixOp(op, pptr, lpptr, CurrentModule PASS_REGS);
}
inline static void GNextToken(USES_REGS1) {
if (LOCAL_tokptr->Tok == Ord(eot_tok))
return;
if (LOCAL_tokptr == LOCAL_toktide) {
LOCAL_toktide = LOCAL_tokptr = LOCAL_tokptr->TokNext;
} else
LOCAL_tokptr = LOCAL_tokptr->TokNext;
}
inline static void checkfor(wchar_t c, JMPBUFF *FailBuff, encoding_t enc USES_REGS) {
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
LOCAL_tokptr->TokInfo != (Term)c) {
char s[1024];
strncpy(s, Yap_tokRep(LOCAL_tokptr, enc), 1023);
syntax_msg("line %d: expected to find \'%c\', found %s", LOCAL_tokptr->TokPos, c, s);
FAIL;
}
NextToken;
}
#ifdef O_QUASIQUOTATIONS
static int is_quasi_quotation_syntax(Term goal, Atom *pat, encoding_t enc, Term cmod) {
CACHE_REGS
Term m = cmod, t;
Atom at;
UInt arity;
Functor f;
t = Yap_StripModule(goal, &m);
f = FunctorOfTerm(t);
*pat = at = NameOfFunctor(f);
arity = ArityOfFunctor(f);
if (arity > 0)
return TRUE;
return FALSE;
}
static int get_quasi_quotation(term_t t, unsigned char **here,
unsigned char *ein) {
unsigned char *in, *start = *here;
for (in = start; in <= ein; in++) {
if (in[0] == '}' && in[-1] == '|') {
*here = in + 1; /* after } */
in--; /* Before | */
if (LOCAL_quasi_quotations) /* option; must return strings */
{
PL_chars_t txt;
int rc;
txt.text.t = (char *)start;
txt.length = in - start;
txt.storage = PL_CHARS_HEAP;
txt.encoding = ENC_UTF8;
txt.canonical = FALSE;
rc = PL_unify_text(t, 0, &txt, PL_CODE_LIST);
PL_free_text(&txt);
return rc;
} else {
return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_dquasi_quotation3,
PL_POINTER, LOCAL, PL_INTPTR, (intptr_t)(start),
PL_INTPTR, (intptr_t)(in - start));
}
}
}
return FALSE; // errorWarning("end_of_file_in_quasi_quotation", 0, _PL_rd);
}
#endif /*O_QUASIQUOTATIONS*/
static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
Term arg1, encoding_t enc, Term cmod USES_REGS) {
int nargs = 0;
Term *p, t;
Functor func;
#ifdef SFUNC
SFEntry *pe = (SFEntry *)Yap_GetAProp(a, SFProperty);
#endif
NextToken;
p = (Term *)ParserAuxSp;
if (arg1) {
*p = arg1;
nargs++;
ParserAuxSp = (char *)(p + 1);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
LOCAL_tokptr->TokInfo == close) {
func = Yap_MkFunctor(a, 1);
if (func == NULL) {
syntax_msg("line %d: Heap Overflow",LOCAL_tokptr->TokPos );
FAIL;
}
t = Yap_MkApplTerm(func, nargs, p);
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos );
return TermNil;
}
NextToken;
return t;
}
}
while (1) {
Term *tp = (Term *)ParserAuxSp;
if (ParserAuxSp + 1 > LOCAL_TrailTop) {
syntax_msg("line %d: Trail Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
*tp++ = Unsigned(ParseTerm(999, FailBuff, enc,cmod PASS_REGS));
ParserAuxSp = (char *)tp;
++nargs;
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok))
break;
if (((int)LOCAL_tokptr->TokInfo) != ',')
break;
NextToken;
}
ParserAuxSp = (char *)p;
/*
* Needed because the arguments for the functor are placed in reverse
* order
*/
if (HR > ASP - (nargs + 1)) {
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
func = Yap_MkFunctor(a, nargs);
if (func == NULL) {
syntax_msg("line %d: Heap Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
#ifdef SFUNC
if (pe)
t = MkSFTerm(Yap_MkFunctor(a, SFArity), nargs, p, pe->NilValue);
else
t = Yap_MkApplTerm(Yap_MkFunctor(a, nargs), nargs, p);
#else
if (a == AtomDBref && nargs == 2)
t = MkDBRefTerm((DBRef)IntegerOfTerm(p[0]));
else
t = Yap_MkApplTerm(func, nargs, p);
#endif
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
return TermNil;
}
/* check for possible overflow against local stack */
checkfor(close, FailBuff, enc PASS_REGS);
return t;
}
static Term MakeAccessor(Term t, Functor f USES_REGS) {
UInt arity = ArityOfFunctor(FunctorOfTerm(t)), i;
Term tf[2], tl = TermNil;
tf[1] = ArgOfTerm(1, t);
for (i = arity; i > 1; i--) {
tl = MkPairTerm(ArgOfTerm(i, t), tl);
}
tf[0] = tl;
return Yap_MkApplTerm(f, 2, tf);
}
static Term ParseList(JMPBUFF *FailBuff, encoding_t enc, Term cmod USES_REGS) {
Term o;
CELL *to_store;
o = AbsPair(HR);
loop:
to_store = HR;
HR += 2;
to_store[0] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (((int)LOCAL_tokptr->TokInfo) == ',') {
NextToken;
{
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
to_store[1] = TermNil;
syntax_msg("line %d: Stack Overflow" ,LOCAL_tokptr->TokPos);
FAIL;
} else {
to_store[1] = AbsPair(HR);
goto loop;
}
}
} else if (((int)LOCAL_tokptr->TokInfo) == '|') {
NextToken;
to_store[1] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS);
} else {
to_store[1] = MkAtomTerm(AtomNil);
}
} else {
syntax_msg("line %d: looking for symbol ',','|' got symbol '%s'",LOCAL_tokptr->TokPos,
Yap_tokRep(LOCAL_tokptr, enc));
FAIL;
}
return (o);
}
static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USES_REGS) {
/* parse term with priority prio */
Volatile Term t;
Volatile Functor func;
Volatile VarEntry *varinfo;
Volatile int curprio = 0, opprio, oplprio, oprprio;
Volatile Atom opinfo;
switch (LOCAL_tokptr->Tok) {
case Name_tok:
t = LOCAL_tokptr->TokInfo;
NextToken;
/* special rules apply for +1, -2.3, etc... */
if (LOCAL_tokptr->Tok == Number_tok) {
if ((Atom)t == AtomMinus) {
t = LOCAL_tokptr->TokInfo;
if (IsIntTerm(t))
t = MkIntTerm(-IntOfTerm(t));
else if (IsFloatTerm(t))
t = MkFloatTerm(-FloatOfTerm(t));
#ifdef USE_GMP
else if (IsBigIntTerm(t)) {
t = Yap_gmp_neg_big(t);
}
#endif
else
t = MkLongIntTerm(-LongIntOfTerm(t));
NextToken;
break;
}
}
if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
Unsigned(LOCAL_tokptr->TokInfo) != 'l') &&
IsPrefixOp((Atom)t, &opprio, &oprprio, cmod PASS_REGS)) {
if (LOCAL_tokptr->Tok == Name_tok) {
Atom at = (Atom)LOCAL_tokptr->TokInfo;
#ifndef _MSC_VER
if ((Atom)t == AtomPlus) {
if (at == AtomInf) {
t = MkFloatTerm(INFINITY);
NextToken;
break;
} else if (at == AtomNan) {
t = MkFloatTerm(NAN);
NextToken;
break;
}
} else if ((Atom)t == AtomMinus) {
if (at == AtomInf) {
t = MkFloatTerm(-INFINITY);
NextToken;
break;
} else if (at == AtomNan) {
t = MkFloatTerm(NAN);
NextToken;
break;
}
}
#endif
}
if (opprio <= prio) {
/* try to parse as a prefix operator */
TRY(
/* build appl on the heap */
func = Yap_MkFunctor((Atom)t, 1); if (func == NULL) {
syntax_msg("line %d: Heap Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
t = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
FAIL;
} curprio = opprio;
, break;)
}
}
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
Unsigned(LOCAL_tokptr->TokInfo) == 'l')
t = ParseArgs((Atom)t, ')', FailBuff, 0L, enc, cmod PASS_REGS);
else
t = MkAtomTerm((Atom)t);
break;
case Number_tok:
t = LOCAL_tokptr->TokInfo;
NextToken;
break;
case String_tok: /* build list on the heap */
{
Volatile char *p = (char *)LOCAL_tokptr->TokInfo;
// we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
t = Yap_CharsToTDQ(p, cmod, enc PASS_REGS);
if (!t) {
syntax_msg("line %d: could not convert \"%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo);
FAIL;
}
LOCAL_Error_TYPE = oerr;
NextToken;
} break;
case WString_tok: /* build list on the heap */
{
Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo;
// we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
t = Yap_WCharsToTDQ(p, cmod PASS_REGS);
if (!t) {
syntax_msg("line %d: could not convert \'%S\'",LOCAL_tokptr->TokPos, (wchar_t *)LOCAL_tokptr->TokInfo);
FAIL;
}
LOCAL_Error_TYPE = oerr;
NextToken;
} break;
case BQString_tok: /* build list on the heap */
{
Volatile char *p = (char *)LOCAL_tokptr->TokInfo;
// we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
t = Yap_CharsToTBQ(p, cmod, LOCAL_encoding PASS_REGS);
if (!t) {
syntax_msg("line %d: could not convert \'%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo);
FAIL;
}
LOCAL_Error_TYPE = oerr;
NextToken;
} break;
case WBQString_tok: /* build list on the heap */
{
Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo;
t = Yap_WCharsToTBQ(p, cmod PASS_REGS);
// we may be operating under a syntax error
yap_error_number oerr = LOCAL_Error_TYPE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!t) {
syntax_msg("line %d: could not convert \"%S\"",LOCAL_tokptr->TokPos, (wchar_t *)LOCAL_tokptr->TokInfo);
FAIL;
}
LOCAL_Error_TYPE = oerr;
NextToken;
} break;
case Var_tok:
varinfo = (VarEntry *)(LOCAL_tokptr->TokInfo);
if ((t = varinfo->VarAdr) == TermNil) {
t = varinfo->VarAdr = MkVarTerm();
}
NextToken;
break;
case Error_tok:
syntax_msg("line %d: found ill-formed \"%s\"",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc));
FAIL;
case Ponctuation_tok:
switch ((int)LOCAL_tokptr->TokInfo) {
case '(':
case 'l': /* non solo ( */
NextToken;
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS);
checkfor(')', FailBuff, enc PASS_REGS);
break;
case '[':
NextToken;
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
(int)LOCAL_tokptr->TokInfo == ']') {
t = TermNil;
NextToken;
break;
}
t = ParseList(FailBuff, enc, cmod PASS_REGS);
checkfor(']', FailBuff, enc PASS_REGS);
break;
case '{':
NextToken;
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
(int)LOCAL_tokptr->TokInfo == '}') {
t = MkAtomTerm(AtomBraces);
NextToken;
break;
}
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS);
t = Yap_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
checkfor('}', FailBuff, enc PASS_REGS);
break;
default:
syntax_msg("line %d: unexpected ponctuation signal %s",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc));
FAIL;
}
break;
#if QQ
case QuasiQuotes_tok: {
qq_t *qq = (qq_t *)(LOCAL_tokptr->TokInfo);
term_t pv, positions = LOCAL_subtpos, to;
Atom at;
Term tn;
CELL *tnp;
// from SWI, enter the list
/* prepare (if we are the first in term) */
if (!LOCAL_varnames)
LOCAL_varnames = PL_new_term_ref();
if (!LOCAL_qq) {
if (LOCAL_quasi_quotations) {
LOCAL_qq = LOCAL_quasi_quotations;
} else {
if (!(LOCAL_qq = PL_new_term_ref()))
return FALSE;
}
// create positions term
if (positions) {
if (!(pv = PL_new_term_refs(3)) ||
!PL_unify_term(positions, PL_FUNCTOR,
FUNCTOR_quasi_quotation_position5, PL_INTPTR,
qq->start.charno, PL_VARIABLE, PL_TERM,
pv + 0, // leave three open slots
PL_TERM, pv + 1, PL_TERM, pv + 2))
return FALSE;
} else
pv = 0;
/* push type */
if (!(LOCAL_qq_tail = PL_copy_term_ref(LOCAL_qq)))
return FALSE;
}
NextToken;
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS);
if (LOCAL_tokptr->Tok != QuasiQuotes_tok) {
syntax_msg("expected to find quasi quotes, got \"%s\"", ,
Yap_tokRep(LOCAL_tokptr, enc));
FAIL;
}
if (!(is_quasi_quotation_syntax(t, &at))) {
syntax_msg("bad quasi quotation syntax, at \"%s\"",
Yap_tokRep(LOCAL_tokptr, enc));
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))) {
syntax_msg("could not get quasi quotation, at \"%s\"",
Yap_tokRep(LOCAL_tokptr, enc));
FAIL;
}
if (positions) {
intptr_t qqend = qq->end.charno;
// set_range_position(positions, -1, qqend PASS_LD);
if (!PL_unify_term(Yap_InitSlot(ArgOfTerm(2, t)), PL_FUNCTOR,
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\"",
Yap_tokRep(LOCAL_tokptr, enc));
FAIL;
}
tnp[2] = Yap_GetFromSlot(LOCAL_varnames); /* Arg 3: the var dictionary */
/* Arg 4: the result */
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))) {
syntax_msg("failed to unify quasi quotation, at \"%s\"",
Yap_tokRep(LOCAL_tokptr, enc));
FAIL;
}
}
#endif
NextToken;
break;
default:
syntax_msg("line %d: expected operator, got \'%s\'",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc));
FAIL;
}
/* main loop to parse infix and posfix operators starts here */
while (true) {
if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) {
Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo);
if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio, cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
/* try parsing as infix operator */
Volatile int oldprio = curprio;
TRY3(
func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 2);
if (func == NULL) {
syntax_msg("line %d: Heap Overflow",LOCAL_tokptr->TokPos);
FAIL;
} NextToken;
{
Term args[2];
args[0] = t;
args[1] = ParseTerm(oprprio, FailBuff,enc, cmod PASS_REGS);
t = Yap_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
},
curprio = opprio;
opinfo = save_opinfo; continue;, opinfo = save_opinfo;
curprio = oldprio;)
}
if (IsPosfixOp(opinfo, &opprio, &oplprio, cmod PASS_REGS) && opprio <= prio &&
oplprio >= curprio) {
/* parse as posfix operator */
Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1);
if (func == NULL) {
syntax_msg("line %d: Heap Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
curprio = opprio;
NextToken;
continue;
}
break;
}
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (Unsigned(LOCAL_tokptr->TokInfo) == ',' && prio >= 1000 &&
curprio <= 999) {
Volatile Term args[2];
NextToken;
args[0] = t;
args[1] = ParseTerm(1000, FailBuff, enc, cmod PASS_REGS);
t = Yap_MkApplTerm(FunctorComma, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
curprio = 1000;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' &&
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio, cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
Volatile Term args[2];
NextToken;
args[0] = t;
args[1] = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS);
t = Yap_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
FAIL;
}
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio, cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t, enc, cmod PASS_REGS);
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
IsPosfixOp(AtomEmptySquareBrackets, &opprio,
&oplprio, cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptySquareBrackets, ']', FailBuff, t, enc, cmod PASS_REGS);
t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS);
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio,
&oplprio, cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptyCurlyBrackets, '}', FailBuff, t, enc, cmod PASS_REGS);
t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS);
curprio = opprio;
continue;
}
}
if (LOCAL_tokptr->Tok <= Ord(WString_tok)) {
syntax_msg("line %d: expected operator, got \'%s\'",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc));
FAIL;
}
break;
}
return t;
}
Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) {
CACHE_REGS
Volatile Term t;
JMPBUFF FailBuff;
yhandle_t sls = Yap_StartSlots();
if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
t = ParseTerm(prio, &FailBuff, enc, cmod PASS_REGS);
#if DEBUG
if (GLOBAL_Option['p' - 'a' + 1]) {
Yap_DebugPutc(stderr, '[');
if (t == 0)
Yap_DebugPlWrite(MkIntTerm(0));
else
Yap_DebugPlWrite(t);
Yap_DebugPutc(stderr, ']');
Yap_DebugPutc(stderr, '\n');
}
#endif
Yap_CloseSlots(sls);
if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
LOCAL_Error_TYPE = SYNTAX_ERROR;
LOCAL_ErrorMessage = "term does not end on . ";
t = 0;
}
if (t != 0 && 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;
}
Yap_CloseSlots(sls);
return (0);
}
//! @}