/************************************************************************* * * * 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) { LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE+1); va_start(ap, msg); vsnprintf(LOCAL_ErrorMessage, YAP_FILENAME_MAX , msg, ap); 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 */ 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->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); } //! @}