YAP 7.1.0
readterm.c
Go to the documentation of this file.
1/*************************************************************************
2
3 * *
4 * YAP Prolog *
5 * *
6 * Yap Prolog was developed at NCCUP - Universidade do Porto *
7 * *
8 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
9 * *
10 **************************************************************************
11 * *
12 * File: iopreds.c *
13 * Last rev: 5/2/88 *
14 * mods: *
15 * comments: Input/Output C implemented predicates *
16 *
17
18 *
19 *************************************************************************/
20#ifdef SCCS
21static char SccsId[] = "%W% %G%";
22#endif
23
31#include "Yap.h"
32#include "YapEval.h"
33#include "YapFlags.h"
34#include "YapHeap.h"
35#include "YapText.h"
36#include "Yatom.h"
37#include "yapio.h"
38#include <stdlib.h>
39#if HAVE_STDARG_H
40#include <stdarg.h>
41#endif
42#if HAVE_CTYPE_H
43#include <ctype.h>
44#endif
45#if HAVE_WCTYPE_H
46#include <wctype.h>
47#endif
48#if HAVE_SYS_TIME_H
49#include <sys/time.h>
50#endif
51#if HAVE_SYS_TYPES_H
52#include <sys/types.h>
53#endif
54#ifdef HAVE_SYS_STAT_H
55#include <sys/stat.h>
56#endif
57#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__)
58#include <sys/select.h>
59#endif
60#ifdef HAVE_UNISTD_H
61#include <unistd.h>
62#endif
63#if HAVE_STRING_H
64#include <string.h>
65#endif
66#if HAVE_SIGNAL_H
67#include <signal.h>
68#endif
69#if HAVE_FCNTL_H
70/* for O_BINARY and O_TEXT in WIN32 */
71#include <fcntl.h>
72#endif
73#ifdef _WIN32
74#if HAVE_IO_H
75/* priows */
76#include <io.h>
77#endif
78#endif
79#if !HAVE_STRNCAT
80#define strncat(X, Y, Z) strcat(X, Y)
81#endif
82#if !HAVE_STRNCPY
83#define strncpy(X, Y, Z) strcpy(X, Y)
84#endif
85#if _MSC_VER || defined(__MINGW32__)
86#if HAVE_SOCKET
87#include <winsock2.h>
88#endif
89#include <windows.h>
90#ifndef S_ISDIR
91#define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR)
92#endif
93#endif
94#include "iopreds.h"
95
96#if _MSC_VER || defined(__MINGW32__)
97#define SYSTEM_STAT _stat
98#else
99#define SYSTEM_STAT stat
100#endif
101
102static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int start,
103 bool code, const char *msg);
104
105static void clean_vars(VarEntry *p)
106{
107 if (p == NULL)
108 return;
109 p->VarAdr = TermNil;
110 clean_vars(p->VarLeft);
111 clean_vars(p->VarRight);
112}
113
114#undef PAR
115
116#ifdef O_QUASIQUOTATIONS
126static Int qq_open(USES_REGS1)
127{
128 PRED_LD
129
130 Term t = Deref(ARG1);
131
132 if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) =
133 FunctorDQuasiQuotation)
134 {
135 void *ptr;
136 char *start;
137 size_t l int s;
138 Term t0, t1, t2;
139
140 if (IsPointerTerm((t0 = ArgOfTerm(1, t))) &&
141 IsPointerTerm((t1 = ArgOfTerm(2, t))) &&
142 IsIntegerTerm((t2 = ArgOfTerm(3, t))))
143 {
144 ptr = PointerOfTerm(t0);
145 start = PointerOfTerm(t1);
146 len = IntegerOfTerm(t2);
147 if ((s = Yap_open_buf_read_stream(start, len, ENC_UTF8, MEM_BUF_USER)) <
148 0)
149 return false;
150 return Yap_unify(ARG2, Yap_MkStream(s));
151 }
152 else
153 {
154 Yap_ThrowError(TYPE_ERROR_READ_CONTEXT, t);
155 }
156
157 return FALSE;
158 }
159}
160
161static int parse_quasi_quotations(ReadData _PL_rd ARG_LD)
162{
163 if (_PL_rd->qq_tail)
164 {
165 term_t av;
166 int rc;
167
168 if (!PL_unify_nil(_PL_rd->qq_tail))
169 return FALSE;
170
171 if (!_PL_rd->quasi_quotations)
172 {
173 if ((av = PL_new_term_refs(2)) && PL_put_term(av + 0, _PL_rd->qq) &&
174#if __YAP_PROLOG__
175 PL_put_atom(av + 1, YAP_SWIAtomFromAtom(_PL_rd->module->AtomOfME)) &&
176#else
177 PL_put_atom(av + 1, _PL_rd->module->name) &&
178#endif
179 PL_cons_functor_v(av, FUNCTOR_dparse_quasi_quotations2, av))
180 {
181 term_t ex;
182 rc = callProlog(MODULE_system, av + 0, PL_Q_CATCH_EXCEPTION, &ex);
183 if (rc)
184 return TRUE;
185 _PL_rd->exception = ex;
186 _PL_rd->has_exception = TRUE;
187 }
188 return FALSE;
189 }
190 else
191 return TRUE;
192 }
193 else if (_PL_rd->quasi_quotations) /* user option, but no quotes */
194 {
195 return PL_unify_nil(_PL_rd->quasi_quotations);
196 }
197 else
198 return TRUE;
199}
200
201#endif /*O_QUASIQUOTATIONS*/
202
203#undef PAR
204
205#define READ_DEFS() \
206 PAR("comments", list_filler, READ_COMMENTS), \
207 PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \
208 PAR("output", filler, READ_OUTPUT), \
209 PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \
210 PAR("term_position", filler, READ_TERM_POSITION), \
211 PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \
212 PAR("singletons", filler, READ_SINGLETONS), \
213 PAR("variables", filler, READ_VARIABLES), \
214 PAR("variable_names", filler, READ_VARIABLE_NAMES), \
215 PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \
216 PAR("input_closing_blank", booleanFlag, READ_INPUT_CLOSING_BLANK), \
217 PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \
218 PAR("singlequoted_string", isatom, READ_SINGLEQUOTED_STRING), \
219 PAR("doublequoted_string", isatom, READ_DOUBLEQUOTED_STRING), \
220 PAR("var_prefix", isatom, READ_VAR_PREFIX), \
221 PAR("allow_variable_name_as_functor", isatom, \
222 READ_ALLOW_VARIABLE_NAME_AS_FUNCTOR), \
223 PAR("cycles", booleanFlag, READ_CYCLES), PAR(NULL, ok, READ_END)
224
225#define PAR(x, y, z) z
226
227typedef enum open_enum_choices
228{
229 READ_DEFS()
230} read_choices_t;
231
232#undef PAR
233
234#define PAR(x, y, z) \
235 { \
236 x, y, z \
237 }
238
239static const param_t read_defs[] = {READ_DEFS()};
240#undef PAR
241
242static Term add_output(Term t, Term tail)
243{
244 Term topt = Yap_MkApplTerm(Yap_MkFunctor(AtomOutput, 1), 1, &t);
245
246 tail = Deref(tail);
247 if (IsVarTerm(tail))
248 {
249 Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options");
250 }
251 else if (IsPairTerm(tail) || tail == TermNil)
252 {
253 return MkPairTerm(topt, tail);
254 }
255 else
256 {
257 Yap_ThrowError(TYPE_ERROR_LIST, tail, "list of options");
258 }
259 return false;
260}
261
262static Term add_names(Term t, Term tail)
263{
264 Term topt = Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &t);
265
266 if (IsVarTerm(tail))
267 {
268 Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options");
269 }
270 else if (IsPairTerm(tail) || tail == TermNil)
271 {
272 return MkPairTerm(topt, tail);
273 }
274 else
275 {
276 Yap_ThrowError(TYPE_ERROR_LIST, tail, "list of options");
277 }
278 return false;
279}
280
281static Term add_priority(Term t, Term tail)
282{
283 Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1);
284
285 Yap_unify(t, ArgOfTerm(1, topt));
286 if (IsVarTerm(tail))
287 {
288 Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options");
289 }
290 else if (IsPairTerm(tail) || tail == TermNil)
291 {
292 return MkPairTerm(topt, tail);
293 }
294 else
295 {
296 Yap_ThrowError(TYPE_ERROR_LIST, tail, "list of options");
297 }
298 return false;
299}
300
301static Term scanToList(TokEntry *tok, TokEntry *errtok)
302{
303 TokEntry *tok0 = tok;
304 CELL *Hi = HR;
305 Term ts[1];
306
307 ts[0] = TermNil;
308 Term *tailp = ts;
309
310 while (tok)
311 {
312 if (HR > ASP - 1024)
313 {
314 /* for some reason moving this earlier confuses gcc on solaris */
315 HR = Hi;
316 tok = tok0;
317 if (!Yap_dogc())
318 {
319 return 0;
320 }
321 continue;
322 }
323 if (tok == errtok && tok->Tok != Error_tok)
324 {
325 *tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil);
326 tailp = RepPair(*tailp) + 1;
327 }
328 Term rep = Yap_tokRep(tok);
329 *tailp = MkPairTerm(rep, TermNil);
330 tailp = RepPair(*tailp) + 1;
331 if (tok->TokNext == NULL)
332 {
333 break;
334 }
335 tok = tok->TokNext;
336 }
337 return ts[0];
338}
339
354static Int scan_to_list(USES_REGS1)
355{
356 int inp_stream;
357 Term tout;
358 scanner_params params;
359
360 /* needs to change LOCAL_output_stream for write */
361 inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3");
362 if (inp_stream == -1)
363 {
364 return false;
365 }
366 TokEntry *tok = LOCAL_tokptr = LOCAL_toktide =
367 Yap_tokenizer(GLOBAL_Stream + inp_stream, &params);
368 UNLOCK(GLOBAL_Stream[inp_stream].streamlock);
369 tout = scanToList(tok, NULL);
370 if (tout == 0)
371 return false;
373
374 return Yap_unify(ARG2, tout);
375}
376
386static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos,
387 bool code, const char *msg)
388{
389 CACHE_REGS
390 TokEntry *tok = LOCAL_tokptr;
391 Int start_line = tok->TokLine;
392 Int err_line = LOCAL_toktide->TokLine;
393 Int startpos = tok->TokPos;
394 Int errpos = LOCAL_toktide->TokOffset;
395 Int end_line = GetCurInpLine(GLOBAL_Stream + sno);
396 Int endpos = GetCurInpPos(GLOBAL_Stream + sno);
398 if (LOCAL_ActiveError) {
399 e = LOCAL_ActiveError;
400 } else {
401 LOCAL_ActiveError = e = malloc(sizeof(yap_error_descriptor_t));
402 }
403 memset(e,0,sizeof(yap_error_descriptor_t));
404 Yap_MkErrorRecord(e, __FILE__, __FUNCTION__, __LINE__, SYNTAX_ERROR,
405 TermNil, msg);
406 //const char *p1 =
407 e->errorNo = SYNTAX_ERROR;
408 e->errorClass = SYNTAX_ERROR_CLASS;
409 e->prologConsulting = LOCAL_consult_level > 0;
410 e->parserFirstLine = start_line;
411 e->parserLine = err_line;
412 e->parserLastLine = end_line;
413 e->parserFirstPos = startpos;
414 e->parserPos = errpos;
415 e->parserLastPos = endpos;
416 if (AtomOfTerm((GLOBAL_Stream + sno)->user_name))
417 e->parserFile =
418 RepAtom((GLOBAL_Stream + sno)->name)->StrOfAE;
419 else
420 e->parserFile =
421 RepAtom(AtomOfTerm((GLOBAL_Stream + sno)->user_name))->StrOfAE;
422
423 e->parserReadingCode = code;
424
425 if (GLOBAL_Stream[sno].status & Seekable_Stream_f &&
426 e->parserPos > 0)
427 {
428 char *o;
429 err_line = e->parserLine;
430 errpos = e->parserPos - 1;
431 startpos = e->parserFirstPos - 1;
432 endpos = e->parserLastPos - 1;
433#if HAVE_FTELLO
434 fseeko(GLOBAL_Stream[sno].file, startpos, SEEK_SET);
435#else
436 fseek(GLOBAL_Stream[sno].file, startpos, SEEK_SET);
437#endif
438 Int sza = (endpos - startpos);
439 o = malloc(sza + 1);
440 if (sza)
441 fread(o, sza, 1, GLOBAL_Stream[sno].file);
442 o[sza] = '\0';
443 e->parserTextA = o;
444 e->parserTextB = errpos - startpos;
445 }
446 else
447 {
448 int lvl = push_text_stack();
449 size_t sz = 1024;
450 char *o = Malloc(1024);
451 o[0] = '\0';
452 while (tok)
453 {
454 if (tok->Tok == Error_tok || tok == LOCAL_toktide)
455 {
456 e->parserTextB = strlen(o);
457 err_line = tok->TokLine;
458 errpos = tok->TokPos;
459 }
460 const char *ns = Yap_tokText(tok);
461 size_t esz = strlen(ns);
462 if (ns && ns[0])
463 {
464 if (esz + 1 > sz - 256)
465 {
466 o = Realloc(o, strlen(o) + sz + 1024);
467 sz += 1024; if ( tok->TokNext->TokLine > tok->TokLine) {
468 tok = tok->TokNext;
469
470 continue; }
471 }
472 else break;
473 }
474 if (tok->TokNext && tok->TokNext->TokLine > tok->TokLine)
475 {
476 strcat(o, "\n");
477 sz--;
478 }
479 tok = tok->TokNext;
480 }
481 e->parserTextA = malloc(strlen(o) + 1);
482 strcpy((char *)e->parserTextA, o);
483 pop_text_stack(lvl);
484 }
485 /* 0: strat, error, end line */
486 /*2 msg */
487 /* 1: file */
488 if (msg && msg[0])
489 {
490 e->errorMsgLen = strlen(msg);
491 e->errorMsg = malloc(e->errorMsgLen + 1);
492 strcpy(e->errorMsg, msg);
493 }
494 clean_vars(LOCAL_VarTable);
495 clean_vars(LOCAL_AnonVarTable);
496 Term sc[2];
497 Term msgt = (msg ? MkAtomTerm(Yap_LookupAtom(msg)) : TermNil);
498 sc[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &msgt);
499
500 sc[1] = MkSysError(e);
501 return Yap_MkApplTerm(Yap_MkFunctor(AtomError, 2), 2, sc);
502 if (Yap_ExecutionMode == YAP_BOOT_MODE)
503 {
504 fprintf(stderr, "SYNTAX ERROR while booting: ");
505 }
506}
507
508Term Yap_syntax_error(TokEntry *errtok, int sno, const char *msg)
509{
510 return syntax_error(errtok, sno, CurrentModule, -1, false, msg);
511}
512
513typedef struct FEnv
514{
515 scanner_params scanner;
516 Term qq, tp, sp, np, vprefix;
517 Term cmod;
518 Term t, t0;
521 CELL *old_H;
524 size_t nargs;
525 encoding_t enc;
526 char msg[4096];
528} FEnv;
529
530typedef struct renv
531{
532 Term bq;
533 bool ce, sw;
534 Term sy;
535 UInt cpos;
536 int prio;
537 int ungetc_oldc;
538 int had_ungetc;
539 bool seekable;
540} REnv;
541
542static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
543 int inp_stream);
544static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream)
545{
546 CACHE_REGS
547 LOCAL_VarTable = LOCAL_VarList = LOCAL_VarTail = LOCAL_AnonVarTable = NULL;
548 fe->enc = GLOBAL_Stream[inp_stream].encoding;
549 xarg *args = Malloc(sizeof(xarg)*READ_END);
550 memset(args, 0, sizeof(xarg)*READ_END);
551 args =
552 Yap_ArgListToVector(opts, read_defs, READ_END,args, DOMAIN_ERROR_READ_OPTION);
553 fe->top_stream = Yap_FirstFreeStreamD();
554
555 if (args && args[READ_OUTPUT].used)
556 {
557 fe->t0 = args[READ_OUTPUT].tvalue;
558 }
559 else
560 {
561 fe->t0 = 0;
562 }
563 if (args && args[READ_MODULE].used)
564 {
565 fe->cmod = args[READ_MODULE].tvalue;
566 }
567 else
568 {
569 fe->cmod = CurrentModule;
570 if (fe->cmod == TermProlog)
571 fe->cmod = PROLOG_MODULE;
572 }
573 if (args && args[READ_BACKQUOTED_STRING].used)
574 {
575 fe->scanner.backquotes = args[READ_BACKQUOTED_STRING].tvalue;
576 }
577 else
578 {
579 fe->scanner.backquotes = getBackQuotesFlag(fe->cmod);
580 }
581 if (args && args[READ_DOUBLEQUOTED_STRING].used)
582 {
583 fe->scanner.doublequotes = args[READ_DOUBLEQUOTED_STRING].tvalue;
584 }
585 else
586 {
587 fe->scanner.doublequotes = getDoubleQuotesFlag(fe->cmod);
588 }
589 if (args && args[READ_SINGLEQUOTED_STRING].used)
590 {
591 fe->scanner.singlequotes = args[READ_SINGLEQUOTED_STRING].tvalue;
592 }
593 else
594 {
595 fe->scanner.singlequotes = getSingleQuotesFlag(fe->cmod);
596 }
597 if (args && args[READ_CHARACTER_ESCAPES].used)
598 {
599 fe->scanner.ce = args[READ_CHARACTER_ESCAPES].tvalue == TermTrue;
600 }
601 else
602 {
603 fe->scanner.ce = Yap_CharacterEscapes(fe->cmod) == TermTrue;
604 }
605 if (args && args[READ_VAR_PREFIX].used)
606 {
607 fe->scanner.vprefix = args[READ_VAR_PREFIX].tvalue == TermTrue;
608 }
609 else
610 {
611 fe->scanner.vprefix = false;
612 }
613 if (args && args[READ_INPUT_CLOSING_BLANK].used)
614 {
615 fe->scanner.get_eot_blank =
616 args[READ_INPUT_CLOSING_BLANK].tvalue == TermTrue;
617 }
618 else
619 {
620 fe->scanner.get_eot_blank = false;
621 }
622 if (args && args[READ_ALLOW_VARIABLE_NAME_AS_FUNCTOR].used)
623 {
624 fe->scanner.vn_asfl =
625 args[READ_ALLOW_VARIABLE_NAME_AS_FUNCTOR].tvalue == TermTrue;
626 }
627 else
628 {
629 fe->scanner.vn_asfl =
630 trueLocalPrologFlag(ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG) == TermTrue;
631 }
632 if (args && args[READ_COMMENTS].used)
633 {
634 fe->scanner.store_comments = args[READ_COMMENTS].tvalue;
635 }
636 else
637 {
638 fe->scanner.store_comments = 0;
639 }
640 if (args && args[READ_QUASI_QUOTATIONS].used)
641 {
642 fe->qq = args[READ_QUASI_QUOTATIONS].tvalue;
643 }
644 else
645 {
646 fe->qq = 0;
647 }
648 if (args && args[READ_COMMENTS].used)
649 {
650 fe->scanner.tcomms = args[READ_COMMENTS].tvalue;
651 }
652 else
653 {
654 fe->scanner.tcomms = 0;
655 }
656 if (args && args[READ_TERM_POSITION].used)
657 {
658 fe->tp = args[READ_TERM_POSITION].tvalue;
659 }
660 else
661 {
662 fe->tp = 0;
663 }
664 if (args && args[READ_SINGLETONS].used)
665 {
666 fe->sp = args[READ_SINGLETONS].tvalue;
667 }
668 else
669 {
670 fe->sp = 0;
671 }
672 if (args && args[READ_SYNTAX_ERRORS].used)
673 {
674 re->sy = args[READ_SYNTAX_ERRORS].tvalue;
675 }
676 else
677 {
678 re->sy = TermException; // getYapFlag( MkAtomTerm(AtomSyntaxErrors) );
679 }
680 if (args && args[READ_VARIABLES].used)
681 {
682 fe->vprefix = args[READ_VARIABLES].tvalue;
683 }
684 else
685 {
686 fe->vprefix = 0;
687 }
688 if (args && args[READ_VARIABLE_NAMES].used)
689 {
690 fe->np = args[READ_VARIABLE_NAMES].tvalue;
691 }
692 else
693 {
694 fe->np = 0;
695 }
696 re->seekable = (GLOBAL_Stream[inp_stream].status & Seekable_Stream_f) != 0;
697 if (re->seekable)
698 {
699 re->cpos = GLOBAL_Stream[inp_stream].charcount;
700 }
701 if (args && args[READ_PRIORITY].used)
702 {
703 re->prio = IntegerOfTerm(args[READ_PRIORITY].tvalue);
704 if (re->prio > GLOBAL_MaxPriority)
705 {
706 Yap_ThrowError(DOMAIN_ERROR_OPERATOR_PRIORITY, opts,
707 "max priority in Prolog is %d, not %ld",
708 GLOBAL_MaxPriority, re->prio);
709 }
710 }
711 else
712 {
713 re->prio = LOCAL_default_priority;
714 }
715 return args;
716}
717
718typedef enum
719{
720 YAP_START_PARSING,
728
729Int Yap_FirstLineInParse(void)
730{
731 CACHE_REGS
732 return LOCAL_StartLineCount;
733}
734
735#define PUSHFET(X) *HR++ = fe->X
736#define POPFET(X) fe->X = *--HR
737
738static void reset_regs(TokEntry *tokstart, FEnv *fe)
739{
740 CACHE_REGS
741
742 restore_machine_regs();
743
744 /* restart global */
745 PUSHFET(qq);
746 PUSHFET(tp);
747 PUSHFET(sp);
748 PUSHFET(np);
749 PUSHFET(vprefix);
750 PUSHFET(t);
751 HR = fe->old_H;
752 memset(LOCAL_ActiveError,0,sizeof(*LOCAL_ActiveError));
753 LOCAL_Error_TYPE = YAP_NO_ERROR;
754 // Yap_growstack_in_parser();
755 POPFET(t);
756 POPFET(vprefix);
757 POPFET(np);
758 POPFET(sp);
759 POPFET(qq);
760}
761
762static Term get_variables(FEnv *fe, TokEntry *tokstart)
763{
764 CACHE_REGS
765 Term v;
766
767 if (fe->vprefix)
768 {
769 while (true)
770 {
771 fe->old_H = HR;
772 if (setjmp(LOCAL_IOBotch) == 0)
773 {
774 if ((v = Yap_Variables(LOCAL_VarList, TermNil)))
775 {
776 fe->old_H = HR;
777 return v;
778 }
779 }
780 else
781 {
782 reset_regs(tokstart, fe);
783 }
784 }
785 }
786 return 0;
787}
788
789static Term get_varnames(FEnv *fe, TokEntry *tokstart)
790{
791 CACHE_REGS
792 Term v;
793
794 if (fe->np)
795 {
796 while (true)
797 {
798 fe->old_H = HR;
799
800 if (setjmp(LOCAL_IOBotch) == 0)
801 {
802 if ((v = Yap_VarNames(LOCAL_VarList, TermNil)))
803 {
804 fe->old_H = HR;
805 return v;
806 }
807 }
808 else
809 {
810 reset_regs(tokstart, fe);
811 }
812 }
813 }
814 return 0;
815}
816
817static Term get_singletons(FEnv *fe, TokEntry *tokstart)
818{
819 CACHE_REGS
820 Term v;
821
822 if (fe->sp)
823 {
824 while (TRUE)
825 {
826 fe->old_H = HR;
827
828 if (setjmp(LOCAL_IOBotch) == 0)
829 {
830 if ((v = Yap_Singletons(LOCAL_VarList, TermNil)))
831 {
832 return v;
833 }
834 }
835 else
836 {
837 reset_regs(tokstart, fe);
838 }
839 }
840 }
841 return 0;
842}
843
844static void warn_singletons(FEnv *fe, TokEntry *tokstart)
845{
846 CACHE_REGS
847 Term v;
848
849 fe->sp = TermNil;
850 v = get_singletons(fe, tokstart);
851 if (v && v != TermNil)
852 {
853 Term singls[4];
854 singls[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomSingleton, 1), 1, &v);
855 singls[1] = MkIntegerTerm(LOCAL_SourceFileLineno);
856 singls[2] = MkAtomTerm(LOCAL_SourceFileName);
857 if (fe->t)
858 {
859 if (IsApplTerm(fe->t))
860 {
861 Functor f = FunctorOfTerm(fe->t);
862 if (f == FunctorQuery || f == FunctorAssert1)
863 return;
864 }
865 singls[3] = fe->t;
866 }
867 else
868 singls[1] = TermTrue;
869 Term sc[2];
870 sc[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, singls);
872 memset(e, 0, sizeof(yap_error_descriptor_t));
873 Yap_MkErrorRecord(e, __FILE__, __FUNCTION__, __LINE__, WARNING_SINGLETONS,
874 v, "singletons warning");
875
876 sc[1] = MkSysError(e);
877 Yap_PrintWarning(Yap_MkApplTerm(Yap_MkFunctor(AtomError, 2), 2, sc));
878 }
879}
880
881static Term get_stream_position(FEnv *fe, TokEntry *tokstart)
882{
883 CACHE_REGS
884 Term v;
885
886 if (fe->tp)
887 {
888 while (true)
889 {
890 fe->old_H = HR;
891
892 if (setjmp(LOCAL_IOBotch) == 0)
893 {
894 if ((v = CurrentPositionToTerm()))
895 {
896 return v;
897 }
898 }
899 else
900 {
901 reset_regs(tokstart, fe);
902 }
903 }
904 }
905 return 0;
906}
907
908static bool complete_processing(FEnv *fe, TokEntry *tokstart)
909{
910 CACHE_REGS
911 Term v1, v2, v3, vc;
912
913 if (fe->t0 && fe->t && !(Yap_unify(fe->t, fe->t0)))
914 return false;
915
916 if (fe->t && fe->vprefix)
917 v1 = get_variables(fe, tokstart);
918 else
919 v1 = 0L;
920 if (fe->t && fe->np)
921 v2 = get_varnames(fe, tokstart);
922 else
923 v2 = 0L;
924 if (fe->t && fe->sp)
925 v3 = get_singletons(fe, tokstart);
926 else
927 v3 = 0L;
928 if (fe->t && fe->scanner.tcomms)
929 vc = LOCAL_Comments;
930 else
931 vc = 0L;
932 Term tpos = get_stream_position(fe, tokstart);
934
935 if (LOCAL_ParserAuxBase) {
936
937 LOCAL_ParserAuxBase=NULL;
938
939
940
941
942 }
943 // trail must be ok by now.]
944 if (fe->t)
945 {
946 return (!v1 || Yap_unify(v1, fe->vprefix)) &&
947 (!v2 || Yap_unify(v2, fe->np)) && (!v3 || Yap_unify(v3, fe->sp)) &&
948 (!fe->tp ||
949 Yap_unify(fe->tp, tpos)) &&
950 (!vc || Yap_unify(vc, fe->scanner.tcomms));
951 }
952 return true;
953}
954
955static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart)
956{
957 CACHE_REGS
958 Term v_vprefix, v_vnames, v_comments, v_pos;
959
960 if (fe->t0 && fe->t && !Yap_unify(fe->t, fe->t0))
961 return false;
962 if (fe->t && fe->vprefix)
963 v_vprefix = get_variables(fe, tokstart);
964 else
965 v_vprefix = 0L;
966 if (fe->t && fe->np)
967 v_vnames = get_varnames(fe, tokstart);
968 else
969 v_vnames = 0L;
970 if (fe->t && fe->reading_clause &&
971 trueGlobalPrologFlag(SINGLE_VAR_WARNINGS_FLAG))
972 {
973 warn_singletons(fe, tokstart);
974 }
975 if (fe->t && fe->scanner.tcomms)
976 v_comments = LOCAL_Comments;
977 else
978 v_comments = 0L;
979 if (fe->t && fe->tp)
980 v_pos = get_stream_position(fe, tokstart);
981 else
982 v_pos = 0L;
984
985 // trail must be ok by now.]
986 if (fe->t)
987 {
988 return (!v_vprefix || Yap_unify(v_vprefix, fe->vprefix)) &&
989 (!v_vnames || Yap_unify(v_vnames, fe->np)) &&
990 (!v_pos || Yap_unify(v_pos, fe->tp)) &&
991 (!v_comments || Yap_unify(v_comments, fe->scanner.tcomms));
992 }
993 return true;
994}
995
996static parser_state_t initparser(Term opts, FEnv *fe, REnv *re, int inp_stream,
997 bool clause);
998
999static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream);
1000
1001static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream);
1002
1003static parser_state_t scanEOF(FEnv *fe, int inp_stream);
1004
1005static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream);
1006
1007static parser_state_t scanEOF(FEnv *fe, int inp_stream)
1008{
1009 CACHE_REGS
1010 // bool store_comments = false;
1011 TokEntry *tokstart = LOCAL_tokptr;
1012
1013 // check for an user abort
1014 if (tokstart != NULL && tokstart->Tok != Ord(eot_tok))
1015 {
1016 /* we got the end of file from an abort */
1017 if (fe->msg && fe->msg[0] && !strcmp(fe->msg, "Abort"))
1018 {
1019 fe->t = 0L;
1021 return YAP_PARSING_FINISHED;
1022 }
1023 // a :- <eof>
1024 if (GLOBAL_Stream[inp_stream].status & Past_Eof_Stream_f)
1025 {
1026 strcpy(fe->msg, "parsing stopped at a end-of-file");
1027 return YAP_PARSING_ERROR;
1028 }
1029 /* we need to force the next read to also give end of file.*/
1030 GLOBAL_Stream[inp_stream].status |= Push_Eof_Stream_f;
1031 strcpy(fe->msg,"end of file found before end of term");
1032 return YAP_PARSING;
1033 }
1034 else
1035 {
1036 // <eof>
1037 // return end_of_file
1039 fe->t = MkAtomTerm(AtomEof);
1040 if (fe->np && !Yap_unify(TermNil, fe->np))
1041 fe->t = 0;
1042 if (fe->sp && !Yap_unify(TermNil, fe->sp))
1043 fe->t = 0;
1044 if (fe->vprefix && !Yap_unify(TermNil, fe->vprefix))
1045 fe->t = 0;
1046 if (fe->tp &&
1047 !Yap_unify(fe->tp, StreamPosition(inp_stream)))
1048 fe->t = 0;
1049#if DEBUG
1050 if (GLOBAL_Option['p' - 'a' + 1])
1051 {
1052 fprintf(stderr, "[ end_of_file %p ]\n", GLOBAL_Stream[inp_stream].name);
1053 }
1054#endif
1055 return YAP_PARSING_FINISHED;
1056 }
1057}
1058
1059static parser_state_t initparser(Term opts, FEnv *fe, REnv *re, int inp_stream,
1060 bool clause)
1061{
1062 LOCAL_Error_TYPE = YAP_NO_ERROR;
1063 LOCAL_SourceFileName = GLOBAL_Stream[inp_stream].name;
1064 LOCAL_eot_before_eof = false;
1065 fe->tp = StreamPosition(inp_stream);
1066 fe->reading_clause = clause;
1067
1068 fe->top_stream = Yap_FirstFreeStreamD();
1069 if (clause)
1070 {
1071 fe->args = setClauseReadEnv(opts, fe, re, inp_stream);
1072 }
1073 else
1074 {
1075 fe->args = setReadEnv(opts, fe, re, inp_stream);
1076 }
1077 if (fe->args == NULL)
1078 {
1079 if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
1080 LOCAL_Error_TYPE = TYPE_ERROR_READ_TERM;
1081 if (LOCAL_Error_TYPE)
1082 Yap_ThrowError(LOCAL_Error_TYPE, opts, NULL);
1083 fe->t = 0;
1084 return YAP_PARSING_FINISHED;
1085 ;
1086 }
1087 if (GLOBAL_Stream[inp_stream].status & Push_Eof_Stream_f)
1088 {
1089 fe->t = MkAtomTerm(AtomEof);
1090 GLOBAL_Stream[inp_stream].status &= ~Push_Eof_Stream_f;
1091 return YAP_PARSING_FINISHED;
1092 }
1093 if (!fe->args)
1094 {
1095 return YAP_PARSING_FINISHED;
1096 }
1097 fe->old_H = HR;
1098 fe->msg[0] = '\0';
1099 return YAP_SCANNING;
1100}
1101
1102static parser_state_t scan(REnv *re, FEnv *fe, int sno)
1103{
1104 CACHE_REGS
1105 /* preserve value of H after scanning: otherwise we may lose strings
1106 and floats */
1107 LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(GLOBAL_Stream + sno, &fe->scanner);
1108
1109#if DEBUG
1110 if (GLOBAL_Option[2])
1111 {
1112 TokEntry *t = LOCAL_tokptr;
1113 int n = 0;
1114 while (t)
1115 {
1116 fprintf(stderr, "[Token %d %s %d]", Ord(t->Tok), Yap_tokText(t), n++);
1117 t = t->TokNext;
1118 }
1119 fprintf(stderr, "\n");
1120 }
1121#endif
1122 if (fe->msg[0])
1123 return YAP_SCANNING_ERROR;
1124 if (LOCAL_tokptr->Tok != Ord(eot_tok))
1125 {
1126 // next step
1127 return YAP_PARSING;
1128 }
1129 if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl)
1130 {
1131 strcpy(fe->msg, ". is end-of-term?");
1132 return YAP_PARSING_ERROR;
1133 }
1134 return scanEOF(fe, sno);
1135}
1136
1137static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream)
1138{
1139 CACHE_REGS
1140 fe->t = 0;
1141 HR =fe->old_H;
1142
1143 // running out of memory
1144 if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL)
1145 {
1146 LOCAL_Error_TYPE = YAP_NO_ERROR;
1147 if (!Yap_growtrail(sizeof(CELL) * K16, FALSE))
1148 {
1149 Yap_CloseTemporaryStreams(fe->top_stream);
1150 return YAP_PARSING_FINISHED;
1151 }
1152 }
1153 else if (LOCAL_Error_TYPE == RESOURCE_ERROR_AUXILIARY_STACK)
1154 {
1155 LOCAL_Error_TYPE = YAP_NO_ERROR;
1156 if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE))
1157 {
1158 Yap_CloseTemporaryStreams(fe->top_stream);
1159 return YAP_PARSING_FINISHED;
1160 }
1161 }
1162 else if (LOCAL_Error_TYPE == RESOURCE_ERROR_HEAP)
1163 {
1164 LOCAL_Error_TYPE = YAP_NO_ERROR;
1165 if (!Yap_growheap(FALSE, 0, NULL))
1166 {
1167 Yap_CloseTemporaryStreams(fe->top_stream);
1168 return YAP_PARSING_FINISHED;
1169 }
1170 }
1171 else if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK)
1172 {
1173 LOCAL_Error_TYPE = YAP_NO_ERROR;
1174 if (!Yap_dogc(PASS_REGS1))
1175 {
1176 Yap_CloseTemporaryStreams(fe->top_stream);
1177 return YAP_PARSING_FINISHED;
1178 }
1179 }
1180 // go back to the start
1181 if (LOCAL_Error_TYPE == SYNTAX_ERROR)
1182 {
1183 return YAP_PARSING_ERROR;
1184 }
1185 if (re->seekable)
1186 {
1187 if (GLOBAL_Stream[inp_stream].status & InMemory_Stream_f)
1188 {
1189 GLOBAL_Stream[inp_stream].u.mem_string.pos = re->cpos;
1190 }
1191 else if (GLOBAL_Stream[inp_stream].status)
1192 {
1193#if HAVE_FTELLO
1194 fseeko(GLOBAL_Stream[inp_stream].file, re->cpos, 0L);
1195#else
1196 fseek(GLOBAL_Stream[inp_stream].file, re->cpos, 0L);
1197#endif
1198 }
1199 }
1200 return YAP_SCANNING;
1201}
1202
1203static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream)
1204{
1205 CACHE_REGS
1206 fe->t = 0;
1207 HR =fe->old_H;
1208 if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
1209 LOCAL_Error_TYPE = YAP_NO_ERROR;
1210 while (!Yap_dogc( PASS_REGS1)) {
1211 Yap_ThrowError(RESOURCE_ERROR_STACK, MkStringTerm("read_term"),NULL);
1212 RECOVER_H();
1213 return 0L;
1214 }
1215 return YAP_START_PARSING;
1216 } else if (LOCAL_Error_TYPE == RESOURCE_ERROR_HEAP) {
1217 LOCAL_Error_TYPE = YAP_NO_ERROR;
1218 if (!Yap_growheap(FALSE, 0, NULL)) {
1219 Yap_ThrowError(RESOURCE_ERROR_HEAP, MkStringTerm("read_term"),NULL);
1220 RECOVER_H();
1221 return 0L;
1222 }
1223 return YAP_START_PARSING;
1224 } else if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL) {
1225 LOCAL_Error_TYPE = YAP_NO_ERROR;
1226 if (!Yap_growtrail(0, FALSE)) {
1227 Yap_ThrowError(RESOURCE_ERROR_HEAP, MkStringTerm("read_term"),NULL);
1228 RECOVER_H();
1229 return 0L;
1230 }
1231 return YAP_START_PARSING;
1232 }
1233 if (LOCAL_Error_TYPE != SYNTAX_ERROR && LOCAL_Error_TYPE != YAP_NO_ERROR)
1234 {
1235 return YAP_SCANNING_ERROR;
1236 }
1237 Term ParserErrorStyle = re->sy;
1238 if (ParserErrorStyle == TermQuiet || LOCAL_Error_TYPE == YAP_NO_ERROR)
1239 {
1240 /* just fail */
1241 LOCAL_Error_TYPE = YAP_NO_ERROR;
1242 Yap_CloseTemporaryStreams(fe->top_stream);
1243 return YAP_PARSING_FINISHED;
1244 }
1245
1246 if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) {
1247 strncpy(fe->msg, LOCAL_ErrorMessage, 4095);
1248 }
1249 LOCAL_Error_TYPE = SYNTAX_ERROR;
1250 Term err = syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos, fe->reading_clause,
1251 fe->msg);
1252 if (ParserErrorStyle == TermException)
1253 {
1254 Yap_JumpToEnv();
1255 Yap_RestartYap(5);
1256 return YAP_PARSING_FINISHED;
1257 }
1258 if (re->seekable)
1259 {
1260 re->cpos = GLOBAL_Stream[inp_stream].charcount;
1261 }
1262 Yap_PrintWarning(err);
1263 LOCAL_Error_TYPE = YAP_NO_ERROR;
1264 if (ParserErrorStyle == TermDec10)
1265 {
1266 return YAP_START_PARSING;
1267 }
1268 Yap_CloseTemporaryStreams(fe->top_stream);
1269 return YAP_PARSING_FINISHED;
1270}
1271
1272static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream)
1273{
1274 CACHE_REGS
1275 TokEntry *tokstart = LOCAL_tokptr;
1276
1277 fe->t = Yap_Parse(re->prio, fe->enc, fe->cmod);
1278 fe->toklast = LOCAL_tokptr;
1279 LOCAL_tokptr = tokstart;
1280#if EMACS
1281 first_char = tokstart->TokPos;
1282#endif /* EMACS */
1283 if (LOCAL_Error_TYPE != YAP_NO_ERROR || fe->t == 0)
1284 return YAP_PARSING_ERROR;
1285 return YAP_PARSING_FINISHED;
1286}
1287
1290static Term exit_parser(int sno, yhandle_t yopts, yap_error_descriptor_t *new, int lvl,
1291
1292 yap_error_descriptor_t *old, Term rc)
1293{
1294 Yap_PopHandle(yopts);
1295
1296 if (!(GLOBAL_Stream[sno].status & Free_Stream_f) &&
1297 LOCAL_Error_TYPE != YAP_NO_ERROR &&
1298 LOCAL_Error_TYPE != SYNTAX_ERROR &&
1299 GLOBAL_Stream[sno].status & CloseOnException_Stream_f)
1300 Yap_CloseStream(sno);
1301 pop_text_stack(lvl);
1302 if (old) {
1303 LOCAL_ActiveError = old;
1304 LOCAL_PrologMode |= InErrorMode;
1305 }
1306 return rc;
1307}
1308
1324Term Yap_read_term(int sno, Term opts, bool clause)
1325{
1326 int lvl = push_text_stack();
1327 yap_error_descriptor_t new, *old = NULL;
1328 yhandle_t y0 = Yap_StartHandles();
1329 FEnv *fe = Malloc(sizeof *fe);
1330 REnv *re = Malloc(sizeof *re);
1331#if EMACS
1332 int emacs_cares = FALSE;
1333#endif
1334 Term rc;
1335 parser_state_t state = YAP_START_PARSING;
1336 yhandle_t yopts = Yap_InitHandle(opts);
1337 while (true)
1338 {
1339 switch (state)
1340 {
1341 case YAP_START_PARSING:
1342 opts = Yap_GetFromHandle(yopts);
1343 state = initparser(opts, fe, re, sno, clause);
1344 if (state == YAP_PARSING_FINISHED)
1345 return exit_parser(sno, yopts, &new, lvl, old, 0);
1346 break;
1347
1348 case YAP_SCANNING:
1349 state = scan(re, fe, sno);
1350 break;
1351
1352 case YAP_SCANNING_ERROR:
1353 state = scanError(re, fe, sno);
1354 break;
1355
1356 case YAP_PARSING:
1357 state = parse(re, fe, sno);
1358 break;
1359
1360 case YAP_PARSING_ERROR:
1361 state = parseError(re, fe, sno);
1362 break;
1363
1365 {
1366 CACHE_REGS
1367 bool done;
1368 if (clause)
1369 done = complete_clause_processing(fe, LOCAL_tokptr);
1370 else
1371 done = complete_processing(fe, LOCAL_tokptr);
1372 if (!done)
1373 {
1374 state = YAP_PARSING_ERROR;
1375 rc = fe->t = 0;
1376 break;
1377 }
1378#if EMACS
1379 first_char = tokstart->TokPos;
1380#endif /* EMACS */
1381 rc = fe->t;
1382 rc = exit_parser(sno, yopts, &new, lvl, old, rc);
1383 Yap_CloseHandles(y0);
1384 return rc;
1385 }
1386 }
1387 }
1388
1389 return exit_parser(sno, yopts, & new, lvl, old, rc);
1390}
1391
1392static Int
1393 read_term2(USES_REGS1) /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
1394{
1395 return Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, ARG2), false) !=
1396 0;
1397}
1398
1399static Int read_term(
1400 USES_REGS1) /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
1401{
1402 int sno;
1403 Term out;
1404
1405 /* needs to change LOCAL_output_stream for write */
1406
1407 sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3");
1408 if (sno == -1)
1409 {
1410 return (FALSE);
1411 }
1412 out = Yap_read_term(sno, add_output(ARG2, ARG3), false);
1413 UNLOCK(GLOBAL_Stream[sno].streamlock);
1414 return out != 0L;
1415}
1416
1417#define READ_CLAUSE_DEFS() \
1418 PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \
1419 , PAR("module", isatom, READ_CLAUSE_MODULE), \
1420 PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \
1421 PAR("variables", filler, READ_CLAUSE_VARIABLES), \
1422 PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \
1423 PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \
1424 PAR("output", isatom, READ_CLAUSE_OUTPUT), \
1425 PAR(NULL, ok, READ_CLAUSE_END)
1426
1427#define PAR(x, y, z) z
1428
1429typedef enum read_clause_enum_choices
1430{
1431 READ_CLAUSE_DEFS()
1432} read_clause_choices_t;
1433
1434#undef PAR
1435
1436#define PAR(x, y, z) \
1437 { \
1438 x, y, z \
1439 }
1440
1441static const param_t read_clause_defs[] = {READ_CLAUSE_DEFS()};
1442#undef PAR
1443
1444static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, int sno)
1445{
1446 CACHE_REGS
1447
1448 LOCAL_VarTable = LOCAL_VarList = LOCAL_VarTail = LOCAL_AnonVarTable = NULL;
1449 xarg *args = Malloc(sizeof(xarg)*READ_CLAUSE_END);
1450 memset(args, 0, sizeof(xarg)*READ_CLAUSE_END);
1451 args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END, args,
1452 TYPE_ERROR_READ_TERM);
1453 memset(fe, 0, sizeof(*fe));
1454 fe->reading_clause = true;
1455 if (args && args[READ_CLAUSE_OUTPUT].used)
1456 {
1457 fe->t0 = args[READ_CLAUSE_OUTPUT].tvalue;
1458 }
1459 else
1460 {
1461 fe->t0 = 0;
1462 }
1463 if (args && args[READ_CLAUSE_MODULE].used)
1464 {
1465 fe->cmod = args[READ_CLAUSE_MODULE].tvalue;
1466 }
1467 else
1468 {
1469 fe->cmod = LOCAL_SourceModule;
1470 if (fe->cmod == TermProlog)
1471 fe->cmod = PROLOG_MODULE;
1472 }
1473 fe->scanner.backquotes = getBackQuotesFlag(fe->cmod);
1474 fe->scanner.singlequotes = getSingleQuotesFlag(fe->cmod);
1475 fe->scanner.doublequotes = getDoubleQuotesFlag(fe->cmod);
1476 fe->enc = GLOBAL_Stream[sno].encoding;
1477 fe->sp = 0;
1478 fe->qq = 0;
1479 if (args && args[READ_CLAUSE_TERM_POSITION].used)
1480 {
1481 fe->tp = args[READ_CLAUSE_TERM_POSITION].tvalue;
1482 }
1483 else
1484 {
1485 fe->tp = 0;
1486 }
1487 fe->sp = 0;
1488 if (args && args[READ_CLAUSE_COMMENTS].used)
1489 {
1490 fe->scanner.tcomms = args[READ_CLAUSE_COMMENTS].tvalue;
1491 }
1492 else
1493 {
1494 fe->scanner.tcomms = 0L;
1495 }
1496 if (args && args[READ_CLAUSE_SYNTAX_ERRORS].used)
1497 {
1498 re->sy = args[READ_CLAUSE_SYNTAX_ERRORS].tvalue;
1499 }
1500 else
1501 {
1502 re->sy = TermDec10;
1503 }
1504 fe->vprefix = 0;
1505 if (args && args[READ_CLAUSE_VARIABLE_NAMES].used)
1506 {
1507 fe->np = args[READ_CLAUSE_VARIABLE_NAMES].tvalue;
1508 }
1509 else
1510 {
1511 fe->np = 0;
1512 }
1513 if (args && args[READ_CLAUSE_VARIABLES].used)
1514 {
1515 fe->vprefix = args[READ_CLAUSE_VARIABLES].tvalue;
1516 }
1517 else
1518 {
1519 fe->vprefix = 0;
1520 }
1521 fe->scanner.ce = Yap_CharacterEscapes(fe->cmod);
1522 re->seekable = (GLOBAL_Stream[sno].status & Seekable_Stream_f) != 0;
1523 if (re->seekable)
1524 {
1525 re->cpos = GLOBAL_Stream[sno].charcount;
1526 }
1527 re->prio = LOCAL_default_priority;
1528 LOCAL_ErrorMessage=NULL;
1529 return args;
1530}
1531
1538static Int read_clause2(USES_REGS1)
1539{
1540 Term ctl = add_output(ARG1, ARG2);
1541
1542 return Yap_read_term(LOCAL_c_input_stream, ctl, true);
1543}
1544
1568static Int read_clause(
1569 USES_REGS1) /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
1570{
1571 int sno;
1572 Term out;
1573
1574 /* needs to change LOCAL_output_stream for write */
1575 sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3");
1576 if (sno < 0)
1577 return false;
1578 out = Yap_read_term(sno, add_output(ARG2, ARG3), true);
1579 UNLOCK(GLOBAL_Stream[sno].streamlock);
1580 return out != 0;
1581}
1582
1594#if 0
1595 static Int start_mega(USES_REGS1)
1596 {
1597 int sno;
1598 Term out;
1599 Term t3 = Deref(ARG3);
1600 /* needs to change LOCAL_output_stream for write */
1601 sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read_exo/3");
1602 if (sno < 0)
1603 return false;
1604 yhandle_t y0 = Yap_StartHandles();
1605 yhandle_t h = Yap_InitSlot(ARG2);
1606 TokENtry *tok;
1607 arity_t srity = 0;
1608
1609
1610 /* preserve value of H after scanning: otherwise we may lose strings
1611 and floats */
1612 LOCAL_tokptr = LOCAL_toktide =
1613 x Yap_tokenizer(GLOBAL_Stream + sno, fe->scanner);
1614 if (tokptr->Tok == Name_tok && (next = tokptr->TokNext) != NULL &&
1615 next->Tok == Ponctuation_tok && next->TokInfo == TermOpenBracket)
1616 {
1617 bool start = true;
1618 while ((tokptr = next->TokNext))
1619 {
1620 if (IsAtomOrIntTerm(t = fe->tp))
1621 {
1622 ip->opc = Yap_opcode(get_atom);
1623 ip->y_u.x_c.c = t.
1624 ip->y_u.x_c.x = fe->tp++; / ()c * /
1625 }
1626 else if (IsAtomOrIntTerm(t = *tp))
1627 {
1628 (IsAtom(tok->Tokt) || IsIntTerm(XREGS + (i + 1)))extra[arity]
1629 ]
1630 }
1631 }
1632 }
1633 Yap_CloseHandles(y0);
1634 }
1635#endif
1636
1654static Int source_location(USES_REGS1)
1655{
1656 return Yap_unify(ARG1, MkAtomTerm(LOCAL_SourceFileName)) &&
1657 Yap_unify(ARG2, MkIntegerTerm(LOCAL_SourceFileLineno));
1658}
1659
1670static Int
1671 read2(USES_REGS1) /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
1672{
1673 int sno;
1674 Int out;
1675
1676 /* needs to change LOCAL_output_stream for write */
1677 sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3");
1678 if (sno == -1)
1679 {
1680 return (FALSE);
1681 }
1682 out = Yap_read_term(sno, add_output(ARG2, TermNil), false);
1683 UNLOCK(GLOBAL_Stream[sno].streamlock);
1684 return out;
1685}
1686
1697static Int
1698 read1(USES_REGS1) /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
1699{
1700 Term out = Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, TermNil), false);
1701
1702 return out;
1703}
1704
1705static Int style_checker(USES_REGS1)
1706{
1707 Term t = Deref(ARG1);
1708
1709 if (IsVarTerm(t))
1710 {
1711 Term t = TermNil;
1712 if (getYapFlag(MkAtomTerm(AtomSingleVarWarnings)) == TermTrue)
1713 {
1714 t = MkPairTerm(MkAtomTerm(AtomSingleVarWarnings), t);
1715 }
1716 if (getYapFlag(MkAtomTerm(AtomDiscontiguousWarnings)) == TermTrue)
1717 {
1718 t = MkPairTerm(MkAtomTerm(AtomDiscontiguousWarnings), t);
1719 }
1720 if (getYapFlag(MkAtomTerm(AtomRedefineWarnings)) == TermTrue)
1721 {
1722 t = MkPairTerm(MkAtomTerm(AtomRedefineWarnings), t);
1723 }
1724 }
1725 else
1726 {
1727 while (IsPairTerm(t))
1728 {
1729 Term h = HeadOfTerm(t);
1730 t = TailOfTerm(t);
1731
1732 if (IsVarTerm(h))
1733 {
1734 Yap_ThrowError(INSTANTIATION_ERROR, t, "style_check/1");
1735 return (FALSE);
1736 }
1737 else if (IsAtomTerm(h))
1738 {
1739 Atom at = AtomOfTerm(h);
1740 if (at == AtomSingleVarWarnings)
1741 Yap_set_flag(MkAtomTerm(AtomSingleVarWarnings), TermTrue);
1742 else if (at == AtomDiscontiguousWarnings)
1743 Yap_set_flag(MkAtomTerm(AtomDiscontiguousWarnings), TermTrue);
1744 else if (at == AtomRedefineWarnings)
1745 Yap_set_flag(MkAtomTerm(AtomRedefineWarnings), TermTrue);
1746 }
1747 else
1748 {
1749 Atom at = AtomOfTerm(ArgOfTerm(1, h));
1750 if (at == AtomSingleVarWarnings)
1751 Yap_set_flag(MkAtomTerm(AtomSingleVarWarnings), TermFalse);
1752 else if (at == AtomDiscontiguousWarnings)
1753 Yap_set_flag(MkAtomTerm(AtomDiscontiguousWarnings), TermFalse);
1754 else if (at == AtomRedefineWarnings)
1755 Yap_set_flag(MkAtomTerm(AtomRedefineWarnings), TermFalse);
1756 }
1757 }
1758 }
1759 return TRUE;
1760}
1761
1762Term Yap_BufferToTerm(const char *s, Term opts)
1763{
1764 Term rval;
1765 int sno;
1766 encoding_t l = ENC_ISO_UTF8;
1767
1768 sno =
1769 Yap_open_buf_read_stream(NULL,(char *)s, strlen(s) + 1, &l, MEM_BUF_USER,
1770 Yap_LookupAtom(Yap_StrPrefix(s, 16)), TermNone);
1771
1772 GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
1773 rval = Yap_read_term(sno, opts, false);
1774 Yap_CloseStream(sno);
1775 return rval;
1776}
1777
1778Term Yap_UBufferToTerm(const unsigned char *s, Term opts)
1779{
1780 Term rval;
1781 int sno;
1782 encoding_t l = ENC_ISO_UTF8;
1783
1784 sno = Yap_open_buf_read_stream(NULL,
1785 (char *)s, strlen((const char *)s), &l, MEM_BUF_USER,
1786 Yap_LookupAtom(Yap_StrPrefix((char *)s, 16)), TermNone);
1787 GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
1788 rval = Yap_read_term(sno, opts, false);
1789 Yap_CloseStream(sno);
1790 return rval;
1791}
1792
1793X_API Term Yap_BufferToTermWithPrioBindings(const char *s, Term ctl,
1794 Term bindings, size_t len,
1795 int prio)
1796{
1797 CACHE_REGS
1798 if (bindings)
1799 {
1800 ctl = add_names(bindings, ctl);
1801 }
1802 if (prio != 1200)
1803 {
1804 ctl = add_priority(prio, ctl);
1805 }
1806 Term o = Yap_BufferToTerm(s, ctl);
1807 return o;
1808}
1809
1826static Int read_term_from_atom(USES_REGS1)
1827{
1828 Term t1 = Deref(ARG1);
1829 Atom at;
1830 const unsigned char *s;
1831
1832 if (IsVarTerm(t1))
1833 {
1834 Yap_ThrowError(INSTANTIATION_ERROR, t1, "style_check/1");
1835 return false;
1836 }
1837 else if (!IsAtomTerm(t1))
1838 {
1839 Yap_ThrowError(TYPE_ERROR_ATOM, t1, "style_check/1");
1840 return false;
1841 }
1842 else
1843 {
1844 at = AtomOfTerm(t1);
1845 s = at->UStrOfAE;
1846 }
1847 Term ctl = add_output(ARG2, ARG3);
1848
1849 Int rc = Yap_UBufferToTerm(s, ctl);
1850 if (Yap_RaiseException())
1851 {
1852 return false;
1853 }
1854 return rc;
1855}
1856
1872static Int read_term_from_atomic(USES_REGS1)
1873{
1874 Term t1 = Deref(ARG1);
1875 const unsigned char *s;
1876
1877 if (IsVarTerm(t1))
1878 {
1879 Yap_ThrowError(INSTANTIATION_ERROR, t1, "read_term_from_atomic/3");
1880 return (FALSE);
1881 }
1882 else if (!IsAtomicTerm(t1))
1883 {
1884 Yap_ThrowError(TYPE_ERROR_ATOMIC, t1, "read_term_from_atomic/3");
1885 return (FALSE);
1886 }
1887 else
1888 {
1889 Term t = Yap_AtomicToString(t1 PASS_REGS);
1890 s = UStringOfTerm(t);
1891 }
1892 Term ctl = add_output(ARG2, ARG3);
1893
1894 Int rc = Yap_UBufferToTerm(s, ctl);
1895 if (Yap_RaiseException())
1896 {
1897 return false;
1898 }
1899 return rc;
1900}
1901
1914static Int read_term_from_string(USES_REGS1)
1915{
1916 Term t1 = Deref(ARG1), rc;
1917 const unsigned char *s;
1918 size_t len;
1919
1920 BACKUP_H()
1921 if (IsVarTerm(t1))
1922 {
1923 Yap_ThrowError(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
1924 return (FALSE);
1925 }
1926 else if (!IsStringTerm(t1))
1927 {
1928 Yap_ThrowError(TYPE_ERROR_STRING, t1, "read_term_from_string/3");
1929 return (FALSE);
1930 }
1931 else
1932 {
1933 s = UStringOfTerm(t1);
1934 len = strlen_utf8(s);
1935 }
1936 char *ss = (char *)s;
1937 encoding_t enc = ENC_ISO_UTF8;
1938 int sno = Yap_open_buf_read_stream(NULL, ss, len, &enc, MEM_BUF_USER,
1939 Yap_LookupAtom(Yap_StrPrefix(ss, 16)),
1940 TermString);
1941 GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
1942 rc = Yap_read_term(sno, Deref(ARG3), 3);
1943 Yap_CloseStream(sno);
1944 if (Yap_RaiseException())
1945 {
1946 return false;
1947 }
1948 RECOVER_H();
1949 if (!rc)
1950 return false;
1951 return Yap_unify(rc, ARG2);
1952}
1953
1954
1955static Int atom_to_term(USES_REGS1)
1956{
1957 Term t1 = Deref(ARG1);
1958
1959 if (IsVarTerm(t1))
1960 {
1961 Yap_ThrowError(INSTANTIATION_ERROR, t1, "read_term_from_atom/3");
1962 return (FALSE);
1963 }
1964 else if (!IsAtomTerm(t1))
1965 {
1966 Yap_ThrowError(TYPE_ERROR_ATOM, t1, "read_term_from_atomic/3");
1967 return (FALSE);
1968 }
1969 else
1970 {
1971 Term t = Yap_AtomToString(t1 PASS_REGS);
1972 const unsigned char *us = UStringOfTerm(t);
1973 return Yap_UBufferToTerm(us, add_output(ARG2, add_names(ARG3, TermNil)));
1974 }
1975}
1976
1977static Int atomic_to_term(USES_REGS1)
1978{
1979 Term t1 = Deref(ARG1);
1980 int l = push_text_stack();
1981 Term cm = CurrentModule;
1982 if (IsApplTerm(t1))
1983 {
1984 Term tmod = LOCAL_SourceModule;
1985 t1 = Yap_YapStripModule(t1, &tmod);
1986 CurrentModule = tmod;
1987 }
1988 if (Yap_RaiseException())
1989 {
1990 return false;
1991 }
1992 const unsigned char *s = Yap_TextToUTF8Buffer(t1 PASS_REGS);
1993 Int rc = Yap_UBufferToTerm(s, add_output(ARG2, add_names(ARG3, TermNil)));
1994 CurrentModule = cm;
1995 pop_text_stack(l);
1996 return rc;
1997}
1998
1999static Int string_to_term(USES_REGS1)
2000{
2001 Term t1 = Deref(ARG1);
2002
2003 if (IsVarTerm(t1))
2004 {
2005 Yap_ThrowError(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
2006 return (FALSE);
2007 }
2008 else if (!IsStringTerm(t1))
2009 {
2010 Yap_ThrowError(TYPE_ERROR_STRING, t1, "read_term_from_string/3");
2011 return (FALSE);
2012 }
2013 else
2014 {
2015 const unsigned char *us = UStringOfTerm(t1);
2016 return Yap_UBufferToTerm(us, add_output(ARG2, add_names(ARG3, TermNil)));
2017 }
2018}
2019
2020void Yap_InitReadTPreds(void)
2021{
2022 Yap_InitCPred("read_term", 2, read_term2, SyncPredFlag);
2023 Yap_InitCPred("read_term", 3, read_term, SyncPredFlag);
2024
2025 Yap_InitCPred("atom_to_term", 3, atom_to_term, 0);
2026 Yap_InitCPred("atomic_to_term", 3, atomic_to_term, 0);
2027 Yap_InitCPred("string_to_term", 3, string_to_term, 0);
2028
2029 Yap_InitCPred("scan_to_list", 2, scan_to_list, SyncPredFlag);
2030 Yap_InitCPred("read", 1, read1, SyncPredFlag);
2031 Yap_InitCPred("read", 2, read2, SyncPredFlag);
2032 Yap_InitCPred("read_clause", 2, read_clause2, SyncPredFlag);
2033 Yap_InitCPred("read_clause", 3, read_clause, 0);
2034 Yap_InitCPred("read_term_from_atom", 3, read_term_from_atom, 0);
2035 Yap_InitCPred("read_term_from_atomic", 3, read_term_from_atomic, 0);
2036 Yap_InitCPred("read_term_from_string", 3, read_term_from_string, 0);
2037 Yap_InitCPred("source_location", 2, source_location, SyncPredFlag);
2038 Yap_InitCPred("$style_checker", 1, style_checker,
2039 SyncPredFlag | HiddenPredFlag);
2040}
syntax_error
Syntax Error Handler.
Definition: YapErrors.h:28
Main definitions.
bool Yap_RaiseException()
let's go
Definition: errors.c:1410
Term Yap_tokRep(void *tokptr)
convert a token to text
Definition: scanner.c:747
void Yap_clean_tokenizer(void)
terminate scanning: just closes the comment store
Definition: scanner.c:1577
void * Malloc(size_t sz USES_REGS)
allocate a temporary text block
Definition: alloc.c:1759
Term MkSysError(yap_error_descriptor_t *i)
Wrap the error descriptor as exception/2.
Definition: errors.c:841
bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file, const char *function, int lineno, yap_error_number type, Term where, const char *s)
complete an error descriptor:
Definition: errors.c:882
Term Yap_read_term(int sno, Term opts, bool clause)
generic routine to read terms from a stream
Definition: readterm.c:1324
parser_state_t
Definition: readterm.c:719
@ YAP_SCANNING_ERROR
input to list of tokens
Definition: readterm.c:722
@ YAP_PARSING_FINISHED
oom or syntax error
Definition: readterm.c:726
@ YAP_SCANNING
initialization
Definition: readterm.c:721
@ YAP_PARSING
serious error (eg oom); trying error handling, followd
Definition: readterm.c:724
@ YAP_PARSING_ERROR
list of tokens to term
Definition: readterm.c:725
Definition: readterm.c:514
bool reading_clause
input args
Definition: readterm.c:523
int top_stream
Error Messagge.
Definition: readterm.c:527
CELL * old_H
the last token
Definition: readterm.c:521
Term qq
scanner interface
Definition: readterm.c:516
TokEntry * tokstart
the output term
Definition: readterm.c:519
Term t
initial position of the term to be read
Definition: readterm.c:518
char msg[4096]
encoding of the stream being read
Definition: readterm.c:526
size_t nargs
read_clause
Definition: readterm.c:524
TokEntry * toklast
the token list
Definition: readterm.c:520
xarg * args
initial H, will be reset on stack overflow
Definition: readterm.c:522
encoding_t enc
arity of current procedure
Definition: readterm.c:525
Definition: regcomp.c:145
Definition: readterm.c:531
all we need to know about an error/throw
Definition: YapError.h:205
bool parserReadingCode
reading a clause, or called from read?
Definition: YapError.h:243
uintptr_t parserPos
syntax and other parsing errors
Definition: YapError.h:233
yap_error_number errorNo
error identifier
Definition: YapError.h:207
yap_error_class_number errorClass
kind of error: derived from errorNo;
Definition: YapError.h:209
bool prologConsulting
whether we are consulting
Definition: YapError.h:245
bool store_comments
Access to commen.
Definition: yapio.h:88
Definition: YapFlags.h:152