/************************************************************************* * * * 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 <em>BNF</em>, 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 <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(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); } //! @}