YAP 7.1.0
parser.c
Go to the documentation of this file.
1/*************************************************************************
2 * *
3 * YAP Prolog *
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8 * *
9 **************************************************************************
10 * *
11 * File: parser.c *
12 * Last rev: *
13 * mods: *
14 * comments: Prolog's parser *
15 * *
16 *************************************************************************/
17#ifdef SCCS
18static char SccsId[] = "%W% %G%";
19#endif
20
34#include "Yap.h"
35#include "YapEval.h"
36#include "YapHeap.h"
37#include "YapText.h"
38#include "Yatom.h"
39#include "yapio.h"
40/* stuff we want to use in standard YAP code */
41#include "iopreds.h"
42#if HAVE_STRING_H
43#include <string.h>
44#endif
45#if HAVE_STDARG_H
46#include <stdarg.h>
47#endif
48
49#ifdef __STDC__XXX
50#define Volatile volatile
51#else
52#define Volatile
53#endif
54
55/* weak backtraking mechanism based on long_jump */
56
57typedef struct jmp_buff_struct {
58 sigjmp_buf JmpBuff;
59} JMPBUFF;
60
61static void GNextToken(CACHE_TYPE1);
62static void checkfor(Term, JMPBUFF *, encoding_t CACHE_TYPE);
63static Term ParseArgs(Atom, Term, JMPBUFF *, Term, encoding_t, Term CACHE_TYPE);
64static Term ParseList(JMPBUFF *, encoding_t, Term CACHE_TYPE);
65static Term ParseTerm(int, JMPBUFF *, encoding_t, Term CACHE_TYPE);
66
67extern Term Yap_tokRep(void *tokptr);
68extern const char *Yap_tokText(void *tokptr);
69
70static void syntax_msg(const char *msg, ...) {
71 CACHE_REGS
72 va_list ap;
73 if (!LOCAL_Error_TYPE ||
74 (LOCAL_Error_TYPE == SYNTAX_ERROR &&
75 LOCAL_toktide->TokPos < LOCAL_ActiveError->parserPos)) {
76 if (!LOCAL_ErrorMessage) {
77 LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1);
78 }
79 va_start(ap, msg);
80 vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, msg, ap);
81 va_end(ap);
82 }
83}
84
85#define TRY(S, P) \
86 { \
87 Volatile JMPBUFF *saveenv, newenv; \
88 Volatile TokEntry *saveT = LOCAL_tokptr; \
89 Volatile CELL *saveH = HR; \
90 Volatile int savecurprio = curprio; \
91 saveenv = FailBuff; \
92 if (!sigsetjmp(newenv.JmpBuff, 0)) { \
93 FailBuff = &newenv; \
94 S; \
95 FailBuff = saveenv; \
96 P; \
97 } else { \
98 FailBuff = saveenv; \
99 HR = saveH; \
100 curprio = savecurprio; \
101 LOCAL_tokptr = saveT; \
102 } \
103 }
104
105#define TRY3(S, P, F) \
106 { \
107 Volatile JMPBUFF *saveenv, newenv; \
108 Volatile TokEntry *saveT = LOCAL_tokptr; \
109 Volatile CELL *saveH = HR; \
110 saveenv = FailBuff; \
111 if (!sigsetjmp(newenv.JmpBuff, 0)) { \
112 FailBuff = &newenv; \
113 S; \
114 FailBuff = saveenv; \
115 P; \
116 } else { \
117 FailBuff = saveenv; \
118 HR = saveH; \
119 LOCAL_tokptr = saveT; \
120 F \
121 } \
122 }
123
124#define FAIL siglongjmp(FailBuff->JmpBuff, 1)
125
126VarEntry *Yap_LookupVar(const char *var) /* lookup variable in variables table
127 * */
128{
129 CACHE_REGS
130 VarEntry *p;
131 Atom vat = Yap_LookupAtom(var);
132
133#if DEBUG
134 if (GLOBAL_Option[4])
135 fprintf(stderr, "[LookupVar %s]", var);
136#endif
137 if (var[0] != '_' || var[1] != '\0') {
138 VarEntry **op = &LOCAL_VarTable;
139 UInt hv;
140
141 p = LOCAL_VarTable;
142 hv = HashFunction((unsigned char *)var) % AtomHashTableSize;
143 while (p != NULL) {
144 CELL hpv = p->hv;
145 if (hv == hpv) {
146 Int scmp;
147 if ((scmp = strcmp(var, RepAtom(p->VarRep)->StrOfAE)) == 0) {
148 p->refs++;
149 return (p);
150 } else if (scmp < 0) {
151 op = &(p->VarLeft);
152 p = p->VarLeft;
153 } else {
154 op = &(p->VarRight);
155 p = p->VarRight;
156 }
157 } else if (hv < hpv) {
158 op = &(p->VarLeft);
159 p = p->VarLeft;
160 } else {
161 op = &(p->VarRight);
162 p = p->VarRight;
163 }
164 }
165 p = Malloc(sizeof(VarEntry));
166 *op = p;
167 p->VarLeft = p->VarRight = NULL;
168 p->hv = hv;
169 p->refs = 1L;
170 p->VarRep = vat;
171 } else {
172 /* anon var */
173 p = Malloc(sizeof(VarEntry));
174 p->VarLeft = LOCAL_AnonVarTable;
175 LOCAL_AnonVarTable = p;
176 p->VarRight = NULL;
177 p->refs = 0L;
178 p->hv = 1L;
179 p->VarRep = vat;
180 }
181 p->VarAdr = TermNil;
182 p->VarNext = NULL;
183 if (LOCAL_VarList) {
184 LOCAL_VarTail->VarNext = p;
185 } else {
186 LOCAL_VarList = p;
187 }
188 LOCAL_VarTail = p;
189 return (p);
190}
191
192static Term VarNames(VarEntry *p, Term l USES_REGS) {
193 Term hd = l, tl = l;
194 Atom AtomUnderscore = Yap_LookupAtom("_");
195 while (p != NULL) {
196 Term t[2];
197 Term o;
198 if (p->VarRep &&
199 p->VarRep == AtomUnderscore ) {
200 p = p->VarNext;
201 continue;
202 }
203 t[0] = MkAtomTerm(p->VarRep);
204 t[1] = p->VarAdr;
205 o = Yap_MkApplTerm(FunctorEq, 2, t);
206 o = MkPairTerm(o, l);
207 if (hd == l) {
208 hd = tl = o;
209 } else {
210 RepPair(tl)[1] = o;
211 tl = o;
212 }
213 if (HR > ASP - 4096) {
214 save_machine_regs();
215 longjmp(LOCAL_IOBotch, 1);
216 }
217 p = p->VarNext;
218 }
219 return (hd);
220
221}
222
223Term Yap_VarNames(VarEntry *p, Term l) {
224 CACHE_REGS
225 return VarNames(p, l PASS_REGS);
226}
227
228static Term Singletons(VarEntry *p, Term l USES_REGS) {
229 Term hd = l, tl = l;
230 while (p != NULL) {
231 if (RepAtom(p->VarRep)->StrOfAE[0] != '_' && p->refs == 1) {
232 Term t[2];
233 Term o;
234
235 t[0] = MkAtomTerm(p->VarRep);
236 t[1] = p->VarAdr;
237 o = Yap_MkApplTerm(FunctorEq, 2, t);
238 o = MkPairTerm(o, l);
239 if (hd == l) {
240 hd = tl = o;
241 } else {
242 RepPair(tl)[1] = o;
243 tl = o;
244 }
245 if (HR > ASP - 4096) {
246 save_machine_regs();
247 longjmp(LOCAL_IOBotch, 1);
248 }
249 }
250 p = p->VarNext;
251 }
252 return (hd);
253}
254
255Term Yap_Singletons(VarEntry *p, Term l) {
256 CACHE_REGS
257 return Singletons(p, l PASS_REGS);
258}
259
260static Term Variables(VarEntry *p, Term l USES_REGS) {
261 Term hd = l, tl= l;
262 while (p != NULL) {
263 Term o;
264
265 o = p->VarAdr;
266 o = MkPairTerm(o, l);
267 if (hd == l) {
268 hd = tl = o;
269 } else {
270 RepPair(tl)[1] = o;
271 tl = o;
272 }
273 if (HR > ASP - 4096) {
274 save_machine_regs();
275 longjmp(LOCAL_IOBotch, 1);
276 }
277 p = p->VarNext;
278 }
279 return (hd);
280}
281
282Term Yap_Variables(VarEntry *p, Term l) {
283 CACHE_REGS
284 l = Variables(p, l PASS_REGS);
285 return Variables(p, l PASS_REGS);
286}
287
288static int IsPrefixOp(Atom op, int *pptr, int *rpptr, Term cmod USES_REGS) {
289 int p;
290
291 OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP, cmod PASS_REGS);
292 if (!opp)
293 return FALSE;
294 if (opp->OpModule && opp->OpModule != cmod) {
295 READ_UNLOCK(opp->OpRWLock);
296 return FALSE;
297 }
298 if ((p = opp->Prefix) != 0) {
299 READ_UNLOCK(opp->OpRWLock);
300 *pptr = *rpptr = p & MaskPrio;
301 if (p & DcrrpFlag)
302 --*rpptr;
303 return TRUE;
304 } else {
305 READ_UNLOCK(opp->OpRWLock);
306 return FALSE;
307 }
308}
309
310int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr) {
311 CACHE_REGS
312 return IsPrefixOp(op, pptr, rpptr, CurrentModule PASS_REGS);
313}
314
315static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr,
316 Term cmod USES_REGS) {
317 int p;
318
319 OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, cmod PASS_REGS);
320 if (!opp)
321 return false;
322 if (opp->OpModule && opp->OpModule != cmod) {
323 READ_UNLOCK(opp->OpRWLock);
324 return false;
325 }
326 if ((p = opp->Infix) != 0) {
327 READ_UNLOCK(opp->OpRWLock);
328 *pptr = *rpptr = *lpptr = p & MaskPrio;
329 if (p & DcrrpFlag)
330 --*rpptr;
331 if (p & DcrlpFlag)
332 --*lpptr;
333 return TRUE;
334 } else {
335 READ_UNLOCK(opp->OpRWLock);
336 return FALSE;
337 }
338}
339
340int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr) {
341 CACHE_REGS
342 return IsInfixOp(op, pptr, lpptr, rpptr, CurrentModule PASS_REGS);
343}
344
345static int IsPosfixOp(Atom op, int *pptr, int *lpptr, Term cmod USES_REGS) {
346 int p;
347
348 OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP, cmod PASS_REGS);
349 if (!opp)
350 return FALSE;
351 if (opp->OpModule && opp->OpModule != cmod) {
352 READ_UNLOCK(opp->OpRWLock);
353 return FALSE;
354 }
355 if ((p = opp->Posfix) != 0) {
356 READ_UNLOCK(opp->OpRWLock);
357 *pptr = *lpptr = p & MaskPrio;
358 if (p & DcrlpFlag)
359 --*lpptr;
360 return (TRUE);
361 } else {
362 READ_UNLOCK(opp->OpRWLock);
363 return (FALSE);
364 }
365}
366
367int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) {
368 CACHE_REGS
369 return IsPosfixOp(op, pptr, lpptr, CurrentModule PASS_REGS);
370}
371
372inline static void GNextToken(USES_REGS1) {
373 if (LOCAL_tokptr->Tok == Ord(eot_tok)) {
374 LOCAL_ErrorMessage = NULL;
375 return;
376 }
377 if (LOCAL_tokptr == LOCAL_toktide) {
378 LOCAL_toktide = LOCAL_tokptr = LOCAL_tokptr->TokNext;
379 } else
380 LOCAL_tokptr = LOCAL_tokptr->TokNext;
381}
382
383inline static void checkfor(Term c, JMPBUFF *FailBuff,
384 encoding_t enc USES_REGS) {
385 if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || LOCAL_tokptr->TokInfo != c) {
386 char s[1024];
387 strncpy(s, Yap_tokText(LOCAL_tokptr), 1023);
388 syntax_msg("line %d: expected to find "
389 "\'%c....................................\', found %s",
390 LOCAL_tokptr->TokLine, c, s);
391 FAIL;
392 }
393 NextToken;
394}
395
396static void
397grow_aux(USES_REGS1){
398 size_t sz = LOCAL_ParserAuxMax-LOCAL_ParserAuxBase, off = LOCAL_ParserAuxSp-LOCAL_ParserAuxBase;
399 fprintf(stderr,"%lx:::%p\n",off,LOCAL_ParserAuxBase);
400 sz *=2;
401 if (sz > 4096*K) sz = sz/2+ 4096*K;
402 if ((LOCAL_ParserAuxBase = Realloc(LOCAL_ParserAuxBase, sz*sizeof(Term)) )== NULL) {
403 Yap_ThrowError(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, "line %d: Parser Stack Overflow", LOCAL_tokptr->TokLine);
404 return;
405 }
406 fprintf(stderr,"%lx:::%p\n",sz,LOCAL_ParserAuxBase);
407 LOCAL_ParserAuxSp = LOCAL_ParserAuxBase+off;
408 LOCAL_ParserAuxMax = LOCAL_ParserAuxBase+sz;
409 }
410
411#ifdef O_QUASIQUOTATIONS
412
413static int is_quasi_quotation_syntax(Term goal, Atom *pat, encoding_t enc,
414 Term cmod) {
415 CACHE_REGS
416 Term m = cmod, t;
417 Atom at;
418 UInt arity;
419 Functor f;
420
421 t = Yap_StripModule(goal, &m);
422 f = FunctorOfTerm(t);
423 *pat = at = NameOfFunctor(f);
424 arity = ArityOfFunctor(f);
425 if (arity > 0)
426 return TRUE;
427 return FALSE;
428}
429
430static int get_quasi_quotation(term_t t, unsigned char **here,
431 unsigned char *ein) {
432 unsigned char *in, *start = *here;
433
434 for (in = start; in <= ein; in++) {
435 if (in[0] == '}' && in[-1] == '|') {
436 *here = in + 1; /* after } */
437 in--; /* Before | */
438
439 if (LOCAL_quasi_quotations) /* option; must return strings */
440 {
441 PL_chars_t txt;
442 int rc;
443
444 txt.text.t = (char *)start;
445 txt.length = in - start;
446 txt.storage = PL_CHARS_HEAP;
447 txt.encoding = ENC_UTF8;
448 txt.canonical = FALSE;
449
450 rc = PL_unify_text(t, 0, &txt, PL_CODE_LIST);
451 PL_free_text(&txt);
452
453 return rc;
454 } else {
455 return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_dquasi_quotation3,
456 PL_POINTER, LOCAL, PL_INTPTR, (intptr_t)(start),
457 PL_INTPTR, (intptr_t)(in - start));
458 }
459 }
460 }
461
462 return false; // errorWarning("end_of_file_in_quasi_quotation", 0, _PL_rd);
463}
464#endif /*O_QUASIQUOTATIONS*/
465
466static Term ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1,
467 encoding_t enc, Term cmod USES_REGS) {
468 int nargs = 0;
469 Int p;
470 Term t;
471 Functor func;
472#ifdef SFUNC
473 SFEntry *pe = (SFEntry *)Yap_GetAProp(a, SFProperty);
474#endif
475
476 NextToken;
477 p = LOCAL_ParserAuxSp-LOCAL_ParserAuxBase;
478 if (arg1) {
479 intptr_t diff = LOCAL_ParserAuxSp-LOCAL_ParserAuxBase;
480 LOCAL_ParserAuxBase[p] = arg1;
481 nargs++;
482 if (p+32>=LOCAL_ParserAuxMax-LOCAL_ParserAuxBase)
483 grow_aux (PASS_REGS1);
484 LOCAL_ParserAuxSp = LOCAL_ParserAuxBase+(p+1);
485 if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
486 LOCAL_tokptr->TokInfo == close) {
487
488 func = Yap_MkFunctor(a, 41);
489 if (func == NULL) {
490 LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
491 FAIL;
492 }
493 t = Yap_MkApplTerm(func, nargs, LOCAL_ParserAuxSp+diff);
494 if (HR > ASP - 4096) {
495 LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
496 FAIL;
497 }
498 NextToken;
499 if (p+16>=LOCAL_ParserAuxMax-LOCAL_ParserAuxBase)
500 grow_aux (PASS_REGS1);
501
502 LOCAL_ParserAuxSp = LOCAL_ParserAuxBase+p;
503 return t;
504 }
505 }
506 while (1) {
507 Term *tp = LOCAL_ParserAuxSp;
508 if (tp + 16 >= LOCAL_ParserAuxMax) {
509 grow_aux (PASS_REGS1);tp = LOCAL_ParserAuxSp;
510 }
511 *tp++ = ParseTerm(999, FailBuff, enc, cmod PASS_REGS);
512 LOCAL_ParserAuxSp = tp;
513 ++nargs;
514 if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok))
515 break;
516 if (LOCAL_tokptr->TokInfo != TermComma)
517 break;
518 NextToken;
519 }
520 if (p+16>=LOCAL_ParserAuxMax-LOCAL_ParserAuxBase)
521 grow_aux (PASS_REGS1);
522 LOCAL_ParserAuxSp = LOCAL_ParserAuxBase+p;
523 /*
524 * Needed because the arguments for the functor are placed in reverse
525 * order
526 */
527 if (HR > ASP - (nargs + 1024)) {
528
529 FAIL;
530 }
531 func = Yap_MkFunctor(a, nargs);
532 if (func == NULL) {
533 LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
534 FAIL;
535 }
536#ifdef SFUNC
537 if (pe)
538 t = MkSFTerm(Yap_MkFunctor(a, SFArity), nargs, p, pe->NilValue);
539 else
540 t = Yap_MkApplTerm(Yap_MkFunctor(a, nargs), nargs, p);
541#else
542 if (a == AtomDBref && nargs == 2)
543 t = MkDBRefTerm((DBRef)IntegerOfTerm(LOCAL_ParserAuxBase[p]));
544 else
545 t = Yap_MkApplTerm(func, nargs, LOCAL_ParserAuxBase+p);
546#endif
547 if (HR > ASP - 4096) {
548 LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
549 FAIL;
550 }
551 /* check for possible overflow against local stack */
552 checkfor(close, FailBuff, enc PASS_REGS);
553 return t;
554}
555
556static Term MakeAccessor(Term t, Functor f USES_REGS) {
557 UInt arity = ArityOfFunctor(FunctorOfTerm(t));
558 int i;
559 Term tf[2], tl = TermNil;
560
561 tf[1] = ArgOfTerm(1, t);
562 for (i = arity; i > 1; i--) {
563 tl = MkPairTerm(ArgOfTerm(i, t), tl);
564 }
565 tf[0] = tl;
566 return Yap_MkApplTerm(f, 2, tf);
567}
568
569static Term ParseList(JMPBUFF *FailBuff, encoding_t enc, Term cmod USES_REGS) {
570 Term o;
571 CELL *to_store;
572 o = AbsPair(HR);
573loop:
574 to_store = HR;
575 HR += 2;
576 to_store[0] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS);
577 if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
578 if (LOCAL_tokptr->TokInfo == TermComma) {
579 NextToken;
580 {
581 /* check for possible overflow against local stack */
582 if (HR > ASP - 4096) {
583 to_store[1] = TermNil;
584 LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
585
586 FAIL;
587 } else {
588 to_store[1] = AbsPair(HR);
589 goto loop;
590 }
591 }
592 } else if (LOCAL_tokptr->TokInfo == TermVBar) {
593 NextToken;
594 to_store[1] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS);
595 } else {
596 to_store[1] = MkAtomTerm(AtomNil);
597 }
598 } else {
599 syntax_msg("line %d: looking for symbol ',','|' got symbol '%s'",
600 LOCAL_tokptr->TokLine, Yap_tokText(LOCAL_tokptr));
601 FAIL;
602 }
603 return (o);
604}
605
606static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
607 Term cmod USES_REGS) {
608 /* parse term with priority prio */
609 Volatile Term t;
610 Volatile Functor func;
611 Volatile VarEntry *varinfo;
612 Volatile int curprio = 0, opprio, oplprio, oprprio;
613 Volatile Atom opinfo;
614
615 switch (LOCAL_tokptr->Tok) {
616 case Name_tok:
617 t = LOCAL_tokptr->TokInfo;
618 NextToken;
619 /* special rules apply for +1, -2.3, etc... */
620 if (LOCAL_tokptr->Tok == Number_tok) {
621 if (t == TermMinus) {
622 t = LOCAL_tokptr->TokInfo;
623 if (IsIntTerm(t))
624 t = MkIntTerm(-IntOfTerm(t));
625 else if (IsFloatTerm(t))
626 t = MkFloatTerm(-FloatOfTerm(t));
627#ifdef USE_GMP
628 else if (IsBigIntTerm(t)) {
629 t = Yap_gmp_neg_big(t);
630 }
631#endif
632 else
633 t = MkLongIntTerm(-LongIntOfTerm(t));
634 NextToken;
635 break;
636 }
637 }
638 if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
639 LOCAL_tokptr->TokInfo != Terml) &&
640 IsPrefixOp(AtomOfTerm(t), &opprio, &oprprio, cmod PASS_REGS)) {
641 if (LOCAL_tokptr->Tok == Name_tok) {
642 Atom at = AtomOfTerm(LOCAL_tokptr->TokInfo);
643#ifndef _MSC_VER
644 if (t == TermPlus) {
645 if (at == AtomInf) {
646 t = MkFloatTerm(INFINITY);
647 NextToken;
648 break;
649 } else if (at == AtomNan) {
650 t = MkFloatTerm(NAN);
651 NextToken;
652 break;
653 }
654 } else if (t == TermMinus) {
655 if (at == AtomInf) {
656 t = MkFloatTerm(-INFINITY);
657 NextToken;
658 break;
659 } else if (at == AtomNan) {
660 t = MkFloatTerm(NAN);
661 NextToken;
662 break;
663 }
664 }
665#endif
666 }
667 if (opprio <= prio) {
668 /* try to parse as a prefix operator */
669 TRY(
670 /* build appl on the heap */
671 func = Yap_MkFunctor(AtomOfTerm(t), 1); if (func == NULL) {
672 LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
673 syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
674 FAIL;
675 } t = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS);
676 t = Yap_MkApplTerm(func, 1, &t);
677 /* check for possible overflow against local stack */
678 if (HR > ASP - 4096) {
679 syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
680 FAIL;
681 LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
682 } curprio = opprio;
683 , break;)
684 }
685 }
686 if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
687 LOCAL_tokptr->TokInfo == Terml)
688 t = ParseArgs(AtomOfTerm(t), TermEndBracket, FailBuff, 0L, enc,
689 cmod PASS_REGS);
690 break;
691
692 case Number_tok:
693 t = LOCAL_tokptr->TokInfo;
694 NextToken;
695 break;
696
697 case String_tok: /* build list on the heap */
698 t = LOCAL_tokptr->TokInfo;
699 NextToken;
700 break;
701
702 case Var_tok:
703 varinfo = (VarEntry *)(LOCAL_tokptr->TokInfo);
704 if ((t = varinfo->VarAdr) == TermNil) {
705 t = varinfo->VarAdr = MkVarTerm();
706 }
707 NextToken;
708 break;
709
710 case Error_tok:
711 syntax_msg("line %d: found ill-formed \"%s\"", LOCAL_tokptr->TokLine,
712 Yap_tokText(LOCAL_tokptr));
713 FAIL;
714
715 case Ponctuation_tok:
716
717 switch (RepAtom(AtomOfTerm(LOCAL_tokptr->TokInfo))->StrOfAE[0]) {
718 case '(':
719 case 'l': /* non solo ( */
720 NextToken;
721 t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS);
722 checkfor(TermEndBracket, FailBuff, enc PASS_REGS);
723 break;
724 case '[':
725 NextToken;
726 if (LOCAL_tokptr->Tok == Ponctuation_tok &&
727 LOCAL_tokptr->TokInfo == TermEndSquareBracket) {
728 t = TermNil;
729 NextToken;
730 break;
731 }
732 t = ParseList(FailBuff, enc, cmod PASS_REGS);
733 checkfor(TermEndSquareBracket, FailBuff, enc PASS_REGS);
734 break;
735 case '{':
736 NextToken;
737 if (LOCAL_tokptr->Tok == Ponctuation_tok &&
738 (int)LOCAL_tokptr->TokInfo == TermEndCurlyBracket) {
739 t = MkAtomTerm(AtomBraces);
740 NextToken;
741 break;
742 }
743 t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS);
744 t = Yap_MkApplTerm(FunctorBraces, 1, &t);
745 /* check for possible overflow against local stack */
746 if (HR > ASP - 4096) {
747 LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
748 syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
749 FAIL;
750 }
751 checkfor(TermEndCurlyBracket, FailBuff, enc PASS_REGS);
752 break;
753 default:
754 syntax_msg("line %d: unexpected ponctuation signal %s",
755 LOCAL_tokptr->TokLine, Yap_tokRep(LOCAL_tokptr));
756 FAIL;
757 }
758 break;
759
760#if QQ
761 case QuasiQuotes_tok: {
762 qq_t *qq = (qq_t *)(LOCAL_tokptr->TokInfo);
763 term_t pv, positions = LOCAL_subtpos, to;
764 Atom at;
765 Term tn;
766 CELL *tnp;
767
768 // from SWI, enter the list
769 /* prepare (if we are the first in term) */
770 if (!LOCAL_varnames)
771 LOCAL_varnames = PL_new_term_ref();
772 if (!LOCAL_qq) {
773 if (LOCAL_quasi_quotations) {
774 LOCAL_qq = LOCAL_quasi_quotations;
775 } else {
776 if (!(LOCAL_qq = PL_new_term_ref()))
777 return FALSE;
778 }
779 // create positions term
780 if (positions) {
781 if (!(pv = PL_new_term_refs(3)) ||
782 !PL_unify_term(positions, PL_FUNCTOR,
783 FUNCTOR_quasi_quotation_position5, PL_INTPTR,
784 qq->start.charno, PL_VARIABLE, PL_TERM,
785 pv + 0, // leave three open slots
786 PL_TERM, pv + 1, PL_TERM, pv + 2))
787 return FALSE;
788 } else
789 pv = 0;
790 /* push type */
791
792 if (!(LOCAL_qq_tail = PL_copy_term_ref(LOCAL_qq)))
793 return FALSE;
794 }
795
796 NextToken;
797 t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS);
798 if (LOCAL_tokptr->Tok != QuasiQuotes_tok) {
799 syntax_msg("expected to find quasi quotes, got \"%s\"", ,
800 Yap_tokText(LOCAL_tokptr));
801 FAIL;
802 }
803 if (!(is_quasi_quotation_syntax(t, &at))) {
804 syntax_msg("bad quasi quotation syntax, at \"%s\"",
805 Yap_tokText(LOCAL_tokptr));
806 FAIL;
807 }
808 /* Arg 2: the content */
809 tn = Yap_MkNewApplTerm(SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4);
810 tnp = RepAppl(tn) + 1;
811 tnp[0] = MkAtomTerm(at);
812 if (!get_quasi_quotation(Yap_InitSlot(ArgOfTerm(2, tn)), &qq->text,
813 qq->text + strlen((const char *)qq->text))) {
814 syntax_msg("could not get quasi quotation, at \"%s\"",
815 Yap_tokText(LOCAL_tokptr));
816 FAIL;
817 }
818 if (positions) {
819 intptr_t qqend = qq->end.charno;
820
821 // set_range_position(positions, -1, qqend PASS_LD);
822 if (!PL_unify_term(Yap_InitSlot(ArgOfTerm(2, t)), PL_FUNCTOR,
823 FUNCTOR_minus2, PL_INTPTR,
824 qq->mid.charno + 2, /* end of | token */
825 PL_INTPTR, qqend - 2)) /* end minus "|}" */
826 syntax_msg("failed to unify quasi quotation, at \"%s\"",
827 Yap_tokText(LOCAL_tokptr));
828 FAIL;
829 }
830
831 tnp[2] = Yap_GetFromSlot(LOCAL_varnames); /* Arg 3: the var dictionary */
832 /* Arg 4: the result */
833 t = ArgOfTerm(4, tn);
834 if (!(to = PL_new_term_ref()) ||
835 !PL_unify_list(LOCAL_qq_tail, to, LOCAL_qq_tail) ||
836 !PL_unify(to, Yap_InitSlot(tn))) {
837 syntax_msg("failed to unify quasi quotation, at \"%s\"",
838 Yap_tokRep(LOCAL_tokptr, enc));
839 FAIL;
840 }
841 }
842#endif
843 NextToken;
844 break;
845 default:
846 syntax_msg("line %d: expected operator, got \'%s\'", LOCAL_tokptr->TokLine,
847 Yap_tokText(LOCAL_tokptr));
848 FAIL;
849 }
850
851 /* main loop to parse infix and posfix operators starts here */
852 while (true) {
853 Atom name;
854 if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
855 Yap_HasOp((name = AtomOfTerm(LOCAL_tokptr->TokInfo)))) {
856 Atom save_opinfo = opinfo = name;
857 if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio, cmod PASS_REGS) &&
858 opprio <= prio && oplprio >= curprio) {
859 /* try parsing as infix operator */
860 Volatile int oldprio = curprio;
861 TRY3(
862 func = Yap_MkFunctor(save_opinfo, 2); if (func == NULL) {
863 syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
864 FAIL;
865 } NextToken;
866 {
867 Term args[2];
868 args[0] = t;
869 args[1] = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS);
870 t = Yap_MkApplTerm(func, 2, args);
871 /* check for possible overflow against local stack */
872 if (HR > ASP - 4096) {
873 syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
874 FAIL;
875 }
876 },
877 curprio = opprio;
878 opinfo = save_opinfo; continue;, opinfo = save_opinfo;
879 curprio = oldprio;)
880 }
881 if (IsPosfixOp(opinfo, &opprio, &oplprio, cmod PASS_REGS) &&
882 opprio <= prio && oplprio >= curprio) {
883 /* parse as posfix operator */
884 Functor func = Yap_MkFunctor(AtomOfTerm(LOCAL_tokptr->TokInfo), 1);
885 if (func == NULL) {
886 syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokLine);
887 FAIL;
888 }
889 t = Yap_MkApplTerm(func, 1, &t);
890 /* check for possible overflow against local stack */
891 if (HR > ASP - 4096) {
892 syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
893 FAIL;
894 }
895 curprio = opprio;
896 NextToken;
897 continue;
898 }
899 break;
900 }
901 if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
902 if (LOCAL_tokptr->TokInfo == TermComma && prio >= 1000 &&
903 curprio <= 999) {
904 Volatile Term args[2];
905 NextToken;
906 args[0] = t;
907 args[1] = ParseTerm(1000, FailBuff, enc, cmod PASS_REGS);
908 t = Yap_MkApplTerm(FunctorComma, 2, args);
909 /* check for possible overflow against local stack */
910 if (HR > ASP - 4096) {
911 syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
912 FAIL;
913 }
914 curprio = 1000;
915 continue;
916 } else if (LOCAL_tokptr->TokInfo == TermVBar &&
917 IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio,
918 cmod PASS_REGS) &&
919 opprio <= prio && oplprio >= curprio) {
920 Volatile Term args[2];
921 NextToken;
922 args[0] = t;
923 args[1] = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS);
924 t = Yap_MkApplTerm(FunctorVBar, 2, args);
925 /* check for possible overflow against local stack */
926 if (HR > ASP - 4096) {
927 syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokLine);
928 FAIL;
929 }
930 curprio = opprio;
931 continue;
932 } else if (LOCAL_tokptr->TokInfo == TermBeginBracket &&
933 IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio,
934 cmod PASS_REGS) &&
935 opprio <= prio && oplprio >= curprio) {
936 t = ParseArgs(AtomEmptyBrackets, TermEndBracket, FailBuff, t, enc,
937 cmod PASS_REGS);
938 curprio = opprio;
939 continue;
940 } else if (LOCAL_tokptr->TokInfo == TermBeginSquareBracket &&
941 IsPosfixOp(AtomEmptySquareBrackets, &opprio, &oplprio,
942 cmod PASS_REGS) &&
943 opprio <= prio && oplprio >= curprio) {
944 t = ParseArgs(AtomEmptySquareBrackets, TermEndSquareBracket, FailBuff,
945 t, enc, cmod PASS_REGS);
946 t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS);
947 curprio = opprio;
948 continue;
949 } else if (LOCAL_tokptr->TokInfo == TermBeginCurlyBracket &&
950 IsPosfixOp(AtomBraces, &opprio, &oplprio, cmod PASS_REGS) &&
951 opprio <= prio && oplprio >= curprio) {
952 t = ParseArgs(AtomBraces, TermEndCurlyBracket, FailBuff, t, enc,
953 cmod PASS_REGS);
954 t = MakeAccessor(t, FunctorBraces PASS_REGS);
955 curprio = opprio;
956 continue;
957 }
958 }
959 if (LOCAL_tokptr->Tok <= Ord(String_tok)) {
960 syntax_msg("line %d: expected operator, got \'%s\'",
961 LOCAL_tokptr->TokLine, Yap_tokText(LOCAL_tokptr));
962 FAIL;
963 }
964 break;
965 }
966 return t;
967}
968
969Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) {
970 CACHE_REGS
971 // ensure that if we throw an exception
972 // t will be 0.
973 LOCAL_ActiveError->errorMsg=NULL;
974 LOCAL_ActiveError->errorMsgLen=0;
975 Volatile Term t = 0;
976 JMPBUFF FailBuff;
977 yhandle_t sls = Yap_StartSlots();
978 LOCAL_ErrorMessage = NULL;
979 LOCAL_toktide = LOCAL_tokptr;
980
981 if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
982 LOCAL_ActiveError->errorMsg=NULL;
983 LOCAL_ActiveError->errorMsgLen=0;
984 LOCAL_ParserAuxSp = LOCAL_ParserAuxBase = Malloc(4096*sizeof(CELL));
985 LOCAL_ParserAuxMax = LOCAL_ParserAuxBase+4096;
986 t = ParseTerm(prio, &FailBuff, enc, cmod PASS_REGS);
987#if DEBUG
988 if (GLOBAL_Option['p' - 'a' + 1]) {
989 Yap_DebugPlWrite(MkIntTerm(LOCAL_tokptr->TokLine));
990 Yap_DebugPutc(stderr, '[');
991 if (t == 0)
992 Yap_DebugPlWrite(MkIntTerm(0));
993 else
994 Yap_DebugPlWrite(t);
995 Yap_DebugPutc(stderr, ']');
996 Yap_DebugPutc(stderr, '\n');
997 }
998#endif
999 Yap_CloseSlots(sls);
1000 }
1001 if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
1002 LOCAL_Error_TYPE =SYNTAX_ERROR;
1003 if (LOCAL_tokptr->TokNext) {
1004 size_t sz = strlen("bracket or operator expected.");
1005 LOCAL_ErrorMessage =malloc(sz+1);
1006 strncpy(LOCAL_ErrorMessage, "bracket or operator expected.", sz );
1007 } else {
1008 size_t sz = strlen("term must end with . or EOF.");
1009 LOCAL_ErrorMessage =malloc(sz+1);
1010 strncpy(LOCAL_ErrorMessage,"term must end with . or EOF.", sz );
1011 }
1012 t = 0;
1013 }
1014 if (t != 0 && LOCAL_Error_TYPE == SYNTAX_ERROR) {
1015 LOCAL_Error_TYPE = YAP_NO_ERROR;
1016 LOCAL_ErrorMessage = NULL;
1017 }
1018 // if (LOCAL_tokptr->Tok != Ord(eot_tok))
1019 // return (0L);
1020 return t;
1021}
1022
Yap.h
Main definitions.
Yap_tokRep
Term Yap_tokRep(void *tokptr)
convert a token to text
Definition: scanner.c:747
jmp_buff_struct
Definition: parser.c:57
Malloc
void * Malloc(size_t sz USES_REGS)
allocate a temporary text block
Definition: alloc.c:1759
DB_STRUCT
Definition: Yatom.h:716
m
A matrix.
Definition: matrix.c:68
operator_entry
Definition: Yatom.h:295
qq_struct_t
Definition: YapStreams.h:89