/*************************************************************************
* *
* 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
#include "Yap.h"
#include "YapEval.h"
#include "YapHeap.h"
#include "YapText.h"
#include "Yatom.h"
#include "yapio.h"
/* stuff we want to use in standard YAP code */
#include "iopreds.h"
#if HAVE_STRING_H
#include <string.h>
#endif
#if HAVE_STDARG_H
#include <stdarg.h>
#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(Term, JMPBUFF *, encoding_t CACHE_TYPE);
static Term ParseArgs(Atom, Term, 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);
extern Term Yap_tokRep(void *tokptr);
extern const char *Yap_tokText(void *tokptr);
static void syntax_msg(const char *msg, ...) {
CACHE_REGS
va_list ap;
if (!LOCAL_Error_TYPE ||
(LOCAL_Error_TYPE == SYNTAX_ERROR &&
LOCAL_toktide->TokPos < LOCAL_ActiveError->parserPos)) {
if (!LOCAL_ErrorMessage) {
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1);
}
va_start(ap, msg);
vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, msg, ap);
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;
Atom vat = Yap_LookupAtom(var);
#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, RepAtom(p->VarRep)->StrOfAE)) == 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(sizeof(VarEntry));
*op = p;
p->VarLeft = p->VarRight = NULL;
p->hv = hv;
p->refs = 1L;
p->VarRep = vat;
} else {
/* anon var */
p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry));
p->VarLeft = LOCAL_AnonVarTable;
LOCAL_AnonVarTable = p;
p->VarRight = NULL;
p->refs = 0L;
p->hv = 1L;
p->VarRep = vat;
}
p->VarAdr = TermNil;
return (p);
}
static Term VarNames(VarEntry *p, Term l USES_REGS) {
if (p != NULL) {
if (strcmp(RepAtom(p->VarRep)->StrOfAE, "_") != 0) {
Term t[2];
Term o;
t[0] = MkAtomTerm(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();
longjmp(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 (RepAtom(p->VarRep)->StrOfAE[0] != '_' && p->refs == 1) {
Term t[2];
Term o;
t[0] = MkAtomTerm(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();
longjmp(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
l = Variables(LOCAL_AnonVarTable, l PASS_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(Term c, JMPBUFF *FailBuff,
encoding_t enc USES_REGS) {
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || LOCAL_tokptr->TokInfo != c) {
char s[1024];
strncpy(s, Yap_tokText(LOCAL_tokptr), 1023);
syntax_msg("line %d: expected to find "
"\'%c....................................\', found %s",
LOCAL_tokptr->TokLine, 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, Term 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->TokLine);
FAIL;
}
t = Yap_MkApplTerm(func, nargs, p);
if (HR > ASP - 4096) {
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
return TermNil;
}
NextToken;
return t;
}
}
while (1) {
Term *tp = (Term *)ParserAuxSp;
if (ParserAuxSp + 1 > LOCAL_TrailTop) {
syntax_msg("line %d: Trail Overflow", LOCAL_tokptr->TokLine);
FAIL;
}
*tp++ = Unsigned(ParseTerm(999, FailBuff, enc, cmod PASS_REGS));
ParserAuxSp = (char *)tp;
++nargs;
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok))
break;
if (LOCAL_tokptr->TokInfo != TermComma)
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->TokLine);
FAIL;
}
func = Yap_MkFunctor(a, nargs);
if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
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->TokLine);
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));
int 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 (LOCAL_tokptr->TokInfo == TermComma) {
NextToken;
{
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
to_store[1] = TermNil;
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
FAIL;
} else {
to_store[1] = AbsPair(HR);
goto loop;
}
}
} else if (LOCAL_tokptr->TokInfo == TermVBar) {
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->TokLine, Yap_tokText(LOCAL_tokptr));
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 (t == TermMinus) {
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) ||
LOCAL_tokptr->TokInfo != Terml) &&
IsPrefixOp(AtomOfTerm(t), &opprio, &oprprio, cmod PASS_REGS)) {
if (LOCAL_tokptr->Tok == Name_tok) {
Atom at = AtomOfTerm(LOCAL_tokptr->TokInfo);
#ifndef _MSC_VER
if (t == TermPlus) {
if (at == AtomInf) {
t = MkFloatTerm(INFINITY);
NextToken;
break;
} else if (at == AtomNan) {
t = MkFloatTerm(NAN);
NextToken;
break;
}
} else if (t == TermMinus) {
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(AtomOfTerm(t), 1); if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
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->TokLine);
FAIL;
} curprio = opprio;
, break;)
}
}
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
LOCAL_tokptr->TokInfo == Terml)
t = ParseArgs(AtomOfTerm(t), TermEndBracket, FailBuff, 0L, enc,
cmod PASS_REGS);
break;
case Number_tok:
t = LOCAL_tokptr->TokInfo;
NextToken;
break;
case String_tok: /* build list on the heap */
t = LOCAL_tokptr->TokInfo;
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->TokLine,
Yap_tokText(LOCAL_tokptr));
FAIL;
case Ponctuation_tok:
switch (RepAtom(AtomOfTerm(LOCAL_tokptr->TokInfo))->StrOfAE[0]) {
case '(':
case 'l': /* non solo ( */
NextToken;
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS);
checkfor(TermEndBracket, FailBuff, enc PASS_REGS);
break;
case '[':
NextToken;
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
LOCAL_tokptr->TokInfo == TermEndSquareBracket) {
t = TermNil;
NextToken;
break;
}
t = ParseList(FailBuff, enc, cmod PASS_REGS);
checkfor(TermEndSquareBracket, FailBuff, enc PASS_REGS);
break;
case '{':
NextToken;
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
(int)LOCAL_tokptr->TokInfo == TermEndCurlyBracket) {
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->TokLine);
FAIL;
}
checkfor(TermEndCurlyBracket, FailBuff, enc PASS_REGS);
break;
default:
syntax_msg("line %d: unexpected ponctuation signal %s",
LOCAL_tokptr->TokLine, Yap_tokRep(LOCAL_tokptr));
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_tokText(LOCAL_tokptr));
FAIL;
}
if (!(is_quasi_quotation_syntax(t, &at))) {
syntax_msg("bad quasi quotation syntax, at \"%s\"",
Yap_tokText(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))) {
syntax_msg("could not get quasi quotation, at \"%s\"",
Yap_tokText(LOCAL_tokptr));
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_tokText(LOCAL_tokptr));
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->TokLine,
Yap_tokText(LOCAL_tokptr));
FAIL;
}
/* main loop to parse infix and posfix operators starts here */
while (true) {
Atom name;
if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
Yap_HasOp((name = AtomOfTerm(LOCAL_tokptr->TokInfo)))) {
Atom save_opinfo = opinfo = name;
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(save_opinfo, 2); if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
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->TokLine);
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(AtomOfTerm(LOCAL_tokptr->TokInfo), 1);
if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
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->TokLine);
FAIL;
}
curprio = opprio;
NextToken;
continue;
}
break;
}
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (LOCAL_tokptr->TokInfo == TermComma && 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->TokLine);
FAIL;
}
curprio = 1000;
continue;
} else if (LOCAL_tokptr->TokInfo == TermVBar &&
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->TokLine);
FAIL;
}
curprio = opprio;
continue;
} else if (LOCAL_tokptr->TokInfo == TermBeginBracket &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio,
cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptyBrackets, TermEndBracket, FailBuff, t, enc,
cmod PASS_REGS);
curprio = opprio;
continue;
} else if (LOCAL_tokptr->TokInfo == TermBeginSquareBracket &&
IsPosfixOp(AtomEmptySquareBrackets, &opprio, &oplprio,
cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptySquareBrackets, TermEndSquareBracket, FailBuff,
t, enc, cmod PASS_REGS);
t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS);
curprio = opprio;
continue;
} else if (LOCAL_tokptr->TokInfo == TermBeginCurlyBracket &&
IsPosfixOp(AtomBraces, &opprio, &oplprio, cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomBraces, TermEndCurlyBracket, FailBuff, t, enc,
cmod PASS_REGS);
t = MakeAccessor(t, FunctorBraces PASS_REGS);
curprio = opprio;
continue;
}
}
if (LOCAL_tokptr->Tok <= Ord(String_tok)) {
syntax_msg("line %d: expected operator, got \'%s\'",
LOCAL_tokptr->TokLine, Yap_tokText(LOCAL_tokptr));
FAIL;
}
break;
}
return t;
}
Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) {
CACHE_REGS
// ensure that if we throw an exception
// t will be 0.
LOCAL_ActiveError->errorMsg=NULL;
LOCAL_ActiveError->errorMsgLen=0;
Volatile Term t = 0;
JMPBUFF FailBuff;
yhandle_t sls = Yap_StartSlots();
LOCAL_ErrorMessage = NULL;
LOCAL_toktide = LOCAL_tokptr;
if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
LOCAL_ActiveError->errorMsg=NULL;
LOCAL_ActiveError->errorMsgLen=0;
t = ParseTerm(prio, &FailBuff, enc, cmod PASS_REGS);
#if DEBUG
if (GLOBAL_Option['p' - 'a' + 1]) {
Yap_DebugPlWrite(MkIntTerm(LOCAL_tokptr->TokLine));
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;
if (LOCAL_tokptr->TokNext) {
size_t sz = strlen("bracket or operator expected.");
LOCAL_ErrorMessage =malloc(sz+1);
strncpy(LOCAL_ErrorMessage, "bracket or operator expected.", sz );
} else {
size_t sz = strlen("term must end with . or EOF.");
LOCAL_ErrorMessage =malloc(sz+1);
strncpy(LOCAL_ErrorMessage,"term must end with . or EOF.", sz );
}
t = 0;
}
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;
}
//! @}