diff --git a/C/stack.c b/C/stack.c index 3e1d75c98..fb3ca3a6e 100644 --- a/C/stack.c +++ b/C/stack.c @@ -1925,7 +1925,7 @@ const char *Yap_dump_stack(void) { } if (!max_count--) { ADDBUF(snprintf(lbuf, lbufsz , "%% .....~n")); - return pop_output_text_stack(lvl, lbuf); + return pop_output_text_stack(lvl, buf); } ipc = (yamop *)(env_ptr[E_CP]); env_ptr = (CELL *)(env_ptr[E_E]); @@ -1933,7 +1933,7 @@ const char *Yap_dump_stack(void) { if (b_ptr) { if (!max_count--) { ADDBUF(snprintf(lbuf, lbufsz , "// .....~n")); - return pop_output_text_stack(lvl, lbuf); + return pop_output_text_stack(lvl, buf); } if (b_ptr->cp_ap && /* tabling */ b_ptr->cp_ap->opc != Yap_opcode(_or_else) && @@ -1949,7 +1949,7 @@ const char *Yap_dump_stack(void) { } } } - return pop_output_text_stack(lvl, lbuf); + return pop_output_text_stack(lvl, buf); } void DumpActiveGoals(USES_REGS1) { diff --git a/os/readterm.c b/os/readterm.c index ead724602..a994edab2 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -1,19 +1,19 @@ /************************************************************************* - * * - * YAP Prolog * - * * - * Yap Prolog was developed at NCCUP - Universidade do Porto * - * * - * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * - * * - ************************************************************************** - * * - * File: iopreds.c * - * Last rev: 5/2/88 * - * mods: * - * comments: Input/Output C implemented predicates * - * * - *************************************************************************/ +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: iopreds.c * +* Last rev: 5/2/88 * +* mods: * +* comments: Input/Output C implemented predicates * +* * +*************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif @@ -84,7 +84,7 @@ static char SccsId[] = "%W% %G%"; #endif #include #ifndef S_ISDIR -#define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR) +#define S_ISDIR(x) (((x) & _S_IFDIR) == _S_IFDIR) #endif #endif #include "iopreds.h" @@ -97,7 +97,8 @@ static char SccsId[] = "%W% %G%"; static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int start, bool code, const char *msg); -static void clean_vars(VarEntry *p) { +static void clean_vars(VarEntry *p) +{ if (p == NULL) return; p->VarAdr = TermNil; @@ -115,85 +116,98 @@ static void clean_vars(VarEntry *p) { @arg QQRange is a term '$quasi_quotation'(ReadData, Start, Length) @arg Stream is a UTF-8 encoded string, whose position indication reflects the location in the real file. -*/ + */ -static Int qq_open(USES_REGS1) { +static Int qq_open(USES_REGS1) +{ PRED_LD - Term t = Deref(ARG1); + Term t = Deref(ARG1); + if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) = - FunctorDQuasiQuotation) { - void *ptr; - char *start; - size_t l int s; - Term t0, t1, t2; + FunctorDQuasiQuotation) + { + void *ptr; + char *start; + size_t l int s; + Term t0, t1, t2; - if (IsPointerTerm((t0 = ArgOfTerm(1, t))) && - IsPointerTerm((t1 = ArgOfTerm(2, t))) && - IsIntegerTerm((t2 = ArgOfTerm(3, t)))) { - ptr = PointerOfTerm(t0); - start = PointerOfTerm(t1); - len = IntegerOfTerm(t2); - if ((s = Yap_open_buf_read_stream(start, len, ENC_UTF8, MEM_BUF_USER)) < - 0) - return false; - return Yap_unify(ARG2, Yap_MkStream(s)); - } else { - Yap_Error(TYPE_ERROR_READ_CONTEXT, t); + if (IsPointerTerm((t0 = ArgOfTerm(1, t))) && + IsPointerTerm((t1 = ArgOfTerm(2, t))) && + IsIntegerTerm((t2 = ArgOfTerm(3, t)))) + { + ptr = PointerOfTerm(t0); + start = PointerOfTerm(t1); + len = IntegerOfTerm(t2); + if ((s = Yap_open_buf_read_stream(start, len, ENC_UTF8, MEM_BUF_USER)) < + 0) + return false; + return Yap_unify(ARG2, Yap_MkStream(s)); + } + else + { + Yap_Error(TYPE_ERROR_READ_CONTEXT, t); + } + + return FALSE; } - - return FALSE; - } } -static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) { - if (_PL_rd->qq_tail) { - term_t av; - int rc; +static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) +{ + if (_PL_rd->qq_tail) + { + term_t av; + int rc; - if (!PL_unify_nil(_PL_rd->qq_tail)) - return FALSE; + if (!PL_unify_nil(_PL_rd->qq_tail)) + return FALSE; - if (!_PL_rd->quasi_quotations) { - if ((av = PL_new_term_refs(2)) && PL_put_term(av + 0, _PL_rd->qq) && + if (!_PL_rd->quasi_quotations) + { + if ((av = PL_new_term_refs(2)) && PL_put_term(av + 0, _PL_rd->qq) && #if __YAP_PROLOG__ - PL_put_atom(av + 1, YAP_SWIAtomFromAtom(_PL_rd->module->AtomOfME)) && + PL_put_atom(av + 1, YAP_SWIAtomFromAtom(_PL_rd->module->AtomOfME)) && #else - PL_put_atom(av + 1, _PL_rd->module->name) && + PL_put_atom(av + 1, _PL_rd->module->name) && #endif - PL_cons_functor_v(av, FUNCTOR_dparse_quasi_quotations2, av)) { - term_t ex; - rc = callProlog(MODULE_system, av + 0, PL_Q_CATCH_EXCEPTION, &ex); - if (rc) - return TRUE; - _PL_rd->exception = ex; - _PL_rd->has_exception = TRUE; - } - return FALSE; - } else - return TRUE; - } else if (_PL_rd->quasi_quotations) /* user option, but no quotes */ + PL_cons_functor_v(av, FUNCTOR_dparse_quasi_quotations2, av)) + { + term_t ex; + rc = callProlog(MODULE_system, av + 0, PL_Q_CATCH_EXCEPTION, &ex); + if (rc) + return TRUE; + _PL_rd->exception = ex; + _PL_rd->has_exception = TRUE; + } + return FALSE; + } + else + return TRUE; + } + else if (_PL_rd->quasi_quotations) /* user option, but no quotes */ { return PL_unify_nil(_PL_rd->quasi_quotations); - } else + } + else return TRUE; } #endif /*O_QUASIQUOTATIONS*/ -#define READ_DEFS() \ - PAR("comments", list_filler, READ_COMMENTS) \ +#define READ_DEFS() \ + PAR("comments", list_filler, READ_COMMENTS) \ , PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \ - PAR("output", filler, READ_OUTPUT), \ - PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \ - PAR("term_position", filler, READ_TERM_POSITION), \ - PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \ - PAR("singletons", filler, READ_SINGLETONS), \ - PAR("variables", filler, READ_VARIABLES), \ - PAR("variable_names", filler, READ_VARIABLE_NAMES), \ - PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \ - PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \ - PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END) + PAR("output", filler, READ_OUTPUT), \ + PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \ + PAR("term_position", filler, READ_TERM_POSITION), \ + PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \ + PAR("singletons", filler, READ_SINGLETONS), \ + PAR("variables", filler, READ_VARIABLES), \ + PAR("variable_names", filler, READ_VARIABLE_NAMES), \ + PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \ + PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \ + PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END) #define PAR(x, y, z) z @@ -201,83 +215,111 @@ typedef enum open_enum_choices { READ_DEFS() } read_choices_t; #undef PAR -#define PAR(x, y, z) \ +#define PAR(x, y, z) \ { x, y, z } -static const param_t read_defs[] = {READ_DEFS()}; +static const param_t read_defs[] = { READ_DEFS() }; #undef PAR -static Term add_output(Term t, Term tail) { +static Term add_output(Term t, Term tail) +{ Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomOutput, 1), 1); + tail = Deref(tail); - if (IsVarTerm(tail)) { - Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options"); - } + if (IsVarTerm(tail)) + { + Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options"); + } Yap_unify(t, ArgOfTerm(1, topt)); - if (IsVarTerm(tail)) { - Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options"); - } else if (IsPairTerm(tail) || tail == TermNil) { - return MkPairTerm(topt, tail); - } else { - return MkPairTerm(topt, MkPairTerm(tail, TermNil)); - } + if (IsVarTerm(tail)) + { + Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options"); + } + else if (IsPairTerm(tail) || tail == TermNil) + { + return MkPairTerm(topt, tail); + } + else + { + return MkPairTerm(topt, MkPairTerm(tail, TermNil)); + } } -static Term add_names(Term t, Term tail) { +static Term add_names(Term t, Term tail) +{ Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1); + Yap_unify(t, ArgOfTerm(1, topt)); - if (IsVarTerm(tail)) { - Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options"); - } else if (IsPairTerm(tail) || tail == TermNil) { - return MkPairTerm(topt, tail); - } else { - return MkPairTerm(topt, MkPairTerm(tail, TermNil)); - } + if (IsVarTerm(tail)) + { + Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options"); + } + else if (IsPairTerm(tail) || tail == TermNil) + { + return MkPairTerm(topt, tail); + } + else + { + return MkPairTerm(topt, MkPairTerm(tail, TermNil)); + } } -static Term add_priority(Term t, Term tail) { +static Term add_priority(Term t, Term tail) +{ Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1); + Yap_unify(t, ArgOfTerm(1, topt)); - if (IsVarTerm(tail)) { - Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options"); - } else if (IsPairTerm(tail) || tail == TermNil) { - return MkPairTerm(topt, tail); - } else { - return MkPairTerm(topt, MkPairTerm(tail, TermNil)); - } + if (IsVarTerm(tail)) + { + Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options"); + } + else if (IsPairTerm(tail) || tail == TermNil) + { + return MkPairTerm(topt, tail); + } + else + { + return MkPairTerm(topt, MkPairTerm(tail, TermNil)); + } } -static Term scanToList(TokEntry *tok, TokEntry *errtok) { +static Term scanToList(TokEntry *tok, TokEntry *errtok) +{ TokEntry *tok0 = tok; CELL *Hi = HR; Term ts[1]; + ts[0] = TermNil; Term *tailp = ts; - while (tok) { - - if (HR > ASP - 1024) { - Int used = HR - Hi; - /* for some reason moving this earlier confuses gcc on solaris */ - HR = Hi; - tok = tok0; - if (!Yap_gcl(used, 1, ENV, CP)) { - return 0; - } - continue; - } - if (tok == errtok && tok->Tok != Error_tok) { - *tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil); + while (tok) + { + if (HR > ASP - 1024) + { + Int used = HR - Hi; + /* for some reason moving this earlier confuses gcc on solaris */ + HR = Hi; + tok = tok0; + if (!Yap_gcl(used, 1, ENV, CP)) + { + return 0; + } + continue; + } + if (tok == errtok && tok->Tok != Error_tok) + { + *tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil); + tailp = RepPair(*tailp) + 1; + } + Term rep = Yap_tokRep(tok); + *tailp = MkPairTerm(rep, TermNil); tailp = RepPair(*tailp) + 1; + if (tok->TokNext == NULL) + { + break; + } + tok = tok->TokNext; } - Term rep = Yap_tokRep(tok); - *tailp = MkPairTerm(rep, TermNil); - tailp = RepPair(*tailp) + 1; - if (tok->TokNext == NULL) { - break; - } - tok = tok->TokNext; - } return ts[0]; } @@ -286,26 +328,28 @@ static Term scanToList(TokEntry *tok, TokEntry *errtok) { Generate a list of tokens from a scan of the (input) stream, Tokens are of the form: - + `atom`(Atom) - + ``(Text) - + `number`(Number) - + `var`(VarName) - + `string`(String) - + 'EOF'' - + symbols, including `(`, `)`, `,`, `;` + + `atom`(Atom) + + ``(Text) + + `number`(Number) + + `var`(VarName) + + `string`(String) + + 'EOF'' + + symbols, including `(`, `)`, `,`, `;` -*/ -static Int scan_to_list(USES_REGS1) { + */ +static Int scan_to_list(USES_REGS1) +{ int inp_stream; Term tpos, tout; /* needs to change LOCAL_output_stream for write */ inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); - if (inp_stream == -1) { - return false; - } + if (inp_stream == -1) + { + return false; + } TokEntry *tok = LOCAL_tokptr = LOCAL_toktide = - Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &tpos); + Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &tpos); UNLOCK(GLOBAL_Stream[inp_stream].streamlock); tout = scanToList(tok, NULL); if (tout == 0) @@ -324,693 +368,844 @@ static Int scan_to_list(USES_REGS1) { * Implicit arguments: * + */ -static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool code, const char *msg) { +static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool code, const char *msg) +{ CACHE_REGS - Yap_MkErrorRecord( LOCAL_ActiveError, __FILE__, __FUNCTION__, __LINE__, SYNTAX_ERROR, 0, NULL); + Yap_MkErrorRecord(LOCAL_ActiveError, __FILE__, __FUNCTION__, __LINE__, SYNTAX_ERROR, 0, NULL); TokEntry *tok = LOCAL_tokptr; Int start_line = tok->TokLine; Int err_line = errtok->TokLine; - Int end_line = GetCurInpLine(GLOBAL_Stream+sno); + Int end_line = GetCurInpLine(GLOBAL_Stream + sno); Int startpos = tok->TokPos; Int errpos = errtok->TokPos; - Int endpos = GetCurInpPos(GLOBAL_Stream+sno); + Int endpos = GetCurInpPos(GLOBAL_Stream + sno); Yap_local.ActiveError->errorNo = SYNTAX_ERROR; - Yap_local.ActiveError->parserFirstLine = start_line; + Yap_local.ActiveError->parserFirstLine = start_line; Yap_local.ActiveError->parserLastLine = end_line; - Yap_local.ActiveError->parserFirstPos = startpos; - Yap_local.ActiveError->parserLastPos =endpos; + Yap_local.ActiveError->parserFirstPos = startpos; + Yap_local.ActiveError->parserLastPos = endpos; Yap_local.ActiveError->parserFile = - RepAtom(AtomOfTerm((GLOBAL_Stream+sno)->user_name))->StrOfAE; + RepAtom(AtomOfTerm((GLOBAL_Stream + sno)->user_name))->StrOfAE; Yap_local.ActiveError->parserReadingCode = code; int lvl = push_text_stack(); - if (GLOBAL_Stream[sno].status & Seekable_Stream_f) { - char *o, *o2; + if (GLOBAL_Stream[sno].status & Seekable_Stream_f) + { + char *o, *o2; #if HAVE_FTELLO fseeko(GLOBAL_Stream[sno].file, startpos, SEEK_SET); #else fseek(GLOBAL_Stream[sno].file, startpos, SEEK_SET); #endif - int lvl = push_text_stack(); - if (GLOBAL_Stream[sno].status & Seekable_Stream_f) { - char *o, *o2; - while (tok) { - if (tok->Tok != Error_tok) { - tok = tok->TokNext; - } - } - err_line = tok->TokLine; - errpos = tok->TokPos; + int lvl = push_text_stack(); + if (GLOBAL_Stream[sno].status & Seekable_Stream_f) + { + char *o, *o2; + while (tok) + { + if (tok->Tok != Error_tok) + { + tok = tok->TokNext; + } + } + err_line = tok->TokLine; + errpos = tok->TokPos; - if (errpos <= startpos) { - o = malloc(1); - o[0] = '\0'; - } else { - Int sza = (errpos-startpos)+1, tot = sza; - o = malloc(sza); - char *p = o; - while (true) - { - size_t siz = fread( p,tot-1,1,GLOBAL_Stream[sno].file); - if (siz < 0) Yap_Error(EVALUATION_ERROR_READ_STREAM,GLOBAL_Stream[sno].user_name,"%s", strerror(errno) ); - if (siz < tot -1) { - p += siz; - tot -= siz; - } + if (errpos <= startpos) + { + o = malloc(1); + o[0] = '\0'; + } else { - break; + Int sza = (errpos - startpos) + 1, tot = sza; + o = malloc(sza); + char *p = o; + while (true) + { + size_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file); + if (siz < 0) + Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno)); + if (siz < tot - 1) + { + p += siz; + tot -= siz; + } + else + { + break; + } + } + o[sza - 1] = '\0'; } - - } o[sza-1] = '\0'; - - } - Yap_local.ActiveError->parserTextA = o; - if (endpos <= errpos) { - o2 = malloc(1); - o2[0] = '\0'; - } else { - Int sza = (endpos-errpos)+1, tot = sza; - o2 = malloc(sza); - char *p = o2; - while (true) - { - size_t siz = fread( p,tot-1,1,GLOBAL_Stream[sno].file); - if (siz < 0) Yap_Error(EVALUATION_ERROR_READ_STREAM,GLOBAL_Stream[sno].user_name,"%s", strerror(errno) ); - if (siz < tot -1) { - p += siz; - tot -= siz; } + Yap_local.ActiveError->parserTextA = o; + if (endpos <= errpos) + { + o2 = malloc(1); + o2[0] = '\0'; + } else { - break; + Int sza = (endpos - errpos) + 1, tot = sza; + o2 = malloc(sza); + char *p = o2; + while (true) + { + size_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file); + if (siz < 0) + Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno)); + if (siz < tot - 1) + { + p += siz; + tot -= siz; + } + else + { + break; + } + } + o2[sza - 1] = '\0'; } - - } o2[sza-1] = '\0'; - - } - Yap_local.ActiveError->parserTextB = o2; - } else { - size_t sz = 1024, e; - char *o = malloc(1024); - char *s = o; - o[0] = '\0'; - while (tok) { - if (tok->Tok == Error_tok) { - o = realloc(o, strlen(o)+1); - Yap_local.ActiveError->parserTextA= o; - o = malloc(1024); - sz = 1024; -err_line = tok->TokLine; - errpos = tok->TokPos; - tok = tok->TokNext; - continue; - } - const char *ns = Yap_tokText(tok); - e = strlen(ns); - if (ns && ns[0] && e+1 > sz-256) { - strcat(s,ns); - o += e; - sz -= e; - } - if (tok->TokNext && tok->TokNext->TokLine > tok->TokLine) { - strcat(s,"\n") - ;sz--; - } - tok = tok->TokNext; + Yap_local.ActiveError->parserTextB = o2; + } + else + { + size_t sz = 1024, e; + char *o = malloc(1024); + char *s = o; + o[0] = '\0'; + while (tok) + { + if (tok->Tok == Error_tok) + { + o = realloc(o, strlen(o) + 1); + Yap_local.ActiveError->parserTextA = o; + o = malloc(1024); + sz = 1024; + err_line = tok->TokLine; + errpos = tok->TokPos; + tok = tok->TokNext; + continue; + } + const char *ns = Yap_tokText(tok); + e = strlen(ns); + if (ns && ns[0] && e + 1 > sz - 256) + { + strcat(s, ns); + o += e; + sz -= e; + } + if (tok->TokNext && tok->TokNext->TokLine > tok->TokLine) + { + strcat(s, "\n") + ; sz--; + } + tok = tok->TokNext; + } + o = realloc(o, strlen(o) + 1); + Yap_local.ActiveError->parserTextB = o; + } + Yap_local.ActiveError->parserPos = errpos; + Yap_local.ActiveError->parserLine = err_line; + /* 0: strat, error, end line */ + /*2 msg */ + /* 1: file */ + if (!msg) + msg = "unspecified"; + Yap_local.ActiveError->culprit = + Yap_local.ActiveError->errorMsg = (char*)msg; + Yap_local.ActiveError->errorMsgLen = strlen(msg); + clean_vars(LOCAL_VarTable); + clean_vars(LOCAL_AnonVarTable); + if (Yap_ExecutionMode == YAP_BOOT_MODE) + { + fprintf(stderr, "SYNTAX ERROR while booting: "); + } + pop_text_stack(lvl); + return Yap_MkFullError(); } - o = realloc(o, strlen(o)+1); - Yap_local.ActiveError->parserTextB= o; - } - Yap_local.ActiveError->parserPos = errpos; - Yap_local.ActiveError->parserLine = err_line; - /* 0: strat, error, end line */ - /*2 msg */ - /* 1: file */ - if (!msg) - msg = "unspecified"; - Yap_local.ActiveError->culprit = - Yap_local.ActiveError->errorMsg = (char*)msg; - Yap_local.ActiveError->errorMsgLen = strlen(msg); - clean_vars(LOCAL_VarTable); - clean_vars(LOCAL_AnonVarTable); - if (Yap_ExecutionMode == YAP_BOOT_MODE) { - fprintf(stderr, "SYNTAX ERROR while booting: "); - } - pop_text_stack(lvl); - return Yap_MkFullError(); -} - -Term Yap_syntax_error(TokEntry *errtok, int sno, const char *msg) { - return syntax_error(errtok, sno, CurrentModule, -1, false, msg); -} - -typedef struct FEnv { - Term qq, tp, sp, np, vp, ce; - Term tpos; /// initial position of the term to be read. - Term t, t0; /// the output term - TokEntry *tokstart; /// the token list - TokEntry *toklast; /// the last token - CELL *old_H; /// initial H, will be reset on stack overflow. - tr_fr_ptr old_TR; /// initial TR - xarg *args; /// input args - bool reading_clause; /// read_clause - size_t nargs; /// arity of current procedure - encoding_t enc; /// encoding of the stream being read - Term tcomms; /// Access to comments - Term cmod; /// Access to comments - char *msg; /// Error Messagge -} FEnv; - -typedef struct renv { - Term bq; - bool ce, sw; - Term sy; - UInt cpos; - int prio; - int ungetc_oldc; - int had_ungetc; - bool seekable; -} REnv; - -static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, - int inp_stream); -static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { - CACHE_REGS - LOCAL_VarTable = NULL; - LOCAL_AnonVarTable = NULL; - fe->enc = GLOBAL_Stream[inp_stream].encoding; - xarg *args = - Yap_ArgListToVector(opts, read_defs, READ_END, DOMAIN_ERROR_READ_OPTION); - if (args == NULL) { - return NULL; + Term Yap_syntax_error(TokEntry *errtok, int sno, const char *msg) + { + return syntax_error(errtok, sno, CurrentModule, -1, false, msg); } - re->bq = getReadTermBackQuotesFlag(); - if (args[READ_OUTPUT].used) { - fe->t0 = args[READ_OUTPUT].tvalue; - } else { - fe->t0 = 0; - } - if (args[READ_MODULE].used) { - fe->cmod = args[READ_MODULE].tvalue; - } else { - fe->cmod = CurrentModule; - if (fe->cmod == TermProlog) - fe->cmod = PROLOG_MODULE; - } - if (args[READ_BACKQUOTED_STRING].used) { - if (!setReadTermBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue)) { - return false; - } - } - if (args[READ_QUASI_QUOTATIONS].used) { - fe->qq = args[READ_QUASI_QUOTATIONS].tvalue; - } else { - fe->qq = 0; - } - if (args[READ_COMMENTS].used) { - fe->tcomms = args[READ_COMMENTS].tvalue; - } else { - fe->tcomms = 0; - } - if (args[READ_TERM_POSITION].used) { - fe->tp = args[READ_TERM_POSITION].tvalue; - } else { - fe->tp = 0; - } - if (args[READ_SINGLETONS].used) { - fe->sp = args[READ_SINGLETONS].tvalue; - } else { - fe->sp = 0; - } - if (args[READ_SYNTAX_ERRORS].used) { - re->sy = args[READ_SYNTAX_ERRORS].tvalue; - } else { - re->sy = TermError; // getYapFlag( MkAtomTerm(AtomSyntaxErrors) ); - } - if (args[READ_VARIABLES].used) { - fe->vp = args[READ_VARIABLES].tvalue; - } else { - fe->vp = 0; - } - if (args[READ_VARIABLE_NAMES].used) { - fe->np = args[READ_VARIABLE_NAMES].tvalue; - } else { - fe->np = 0; - } - if (args[READ_CHARACTER_ESCAPES].used || Yap_CharacterEscapes(fe->cmod)) { - fe->ce = true; - } else { - fe->ce = false; - } - re->seekable = (GLOBAL_Stream[inp_stream].status & Seekable_Stream_f) != 0; - if (re->seekable) { - re->cpos = GLOBAL_Stream[inp_stream].charcount; - } - if (args[READ_PRIORITY].used) { - re->prio = IntegerOfTerm(args[READ_PRIORITY].tvalue); - if (re->prio > GLOBAL_MaxPriority) { - Yap_ThrowError(DOMAIN_ERROR_OPERATOR_PRIORITY, opts, - "max priority in Prolog is %d, not %ld", - GLOBAL_MaxPriority, re->prio); - } - } else { - re->prio = LOCAL_default_priority; - } - fe->msg = NULL; - return args; -} + typedef struct FEnv { + Term qq, tp, sp, np, vp, ce; + Term tpos; /// initial position of the term to be read. + Term t, t0; /// the output term + TokEntry *tokstart; /// the token list + TokEntry *toklast; /// the last token + CELL *old_H; /// initial H, will be reset on stack overflow. + tr_fr_ptr old_TR; /// initial TR + xarg *args; /// input args + bool reading_clause; /// read_clause + size_t nargs; /// arity of current procedure + encoding_t enc; /// encoding of the stream being read + Term tcomms; /// Access to comments + Term cmod; /// Access to comments + char *msg; /// Error Messagge + } FEnv; -typedef enum { - YAP_START_PARSING, /// initialization - YAP_SCANNING, /// input to list of tokens - YAP_SCANNING_ERROR, /// serious error (eg oom); trying error handling, followd - /// by either restart or failure - YAP_PARSING, /// list of tokens to term - YAP_PARSING_ERROR, /// oom or syntax error - YAP_PARSING_FINISHED /// exit parser -} parser_state_t; + typedef struct renv { + Term bq; + bool ce, sw; + Term sy; + UInt cpos; + int prio; + int ungetc_oldc; + int had_ungetc; + bool seekable; + } REnv; -Int Yap_FirstLineInParse(void) { - CACHE_REGS + static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, + int inp_stream); + static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) + { + CACHE_REGS + LOCAL_VarTable = NULL; + + LOCAL_AnonVarTable = NULL; + fe->enc = GLOBAL_Stream[inp_stream].encoding; + xarg *args = + Yap_ArgListToVector(opts, read_defs, READ_END, DOMAIN_ERROR_READ_OPTION); + if (args == NULL) + { + return NULL; + } + + re->bq = getReadTermBackQuotesFlag(); + if (args[READ_OUTPUT].used) + { + fe->t0 = args[READ_OUTPUT].tvalue; + } + else + { + fe->t0 = 0; + } + if (args[READ_MODULE].used) + { + fe->cmod = args[READ_MODULE].tvalue; + } + else + { + fe->cmod = CurrentModule; + if (fe->cmod == TermProlog) + fe->cmod = PROLOG_MODULE; + } + if (args[READ_BACKQUOTED_STRING].used) + { + if (!setReadTermBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue)) + { + return false; + } + } + if (args[READ_QUASI_QUOTATIONS].used) + { + fe->qq = args[READ_QUASI_QUOTATIONS].tvalue; + } + else + { + fe->qq = 0; + } + if (args[READ_COMMENTS].used) + { + fe->tcomms = args[READ_COMMENTS].tvalue; + } + else + { + fe->tcomms = 0; + } + if (args[READ_TERM_POSITION].used) + { + fe->tp = args[READ_TERM_POSITION].tvalue; + } + else + { + fe->tp = 0; + } + if (args[READ_SINGLETONS].used) + { + fe->sp = args[READ_SINGLETONS].tvalue; + } + else + { + fe->sp = 0; + } + if (args[READ_SYNTAX_ERRORS].used) + { + re->sy = args[READ_SYNTAX_ERRORS].tvalue; + } + else + { + re->sy = TermError; // getYapFlag( MkAtomTerm(AtomSyntaxErrors) ); + } + if (args[READ_VARIABLES].used) + { + fe->vp = args[READ_VARIABLES].tvalue; + } + else + { + fe->vp = 0; + } + if (args[READ_VARIABLE_NAMES].used) + { + fe->np = args[READ_VARIABLE_NAMES].tvalue; + } + else + { + fe->np = 0; + } + if (args[READ_CHARACTER_ESCAPES].used || Yap_CharacterEscapes(fe->cmod)) + { + fe->ce = true; + } + else + { + fe->ce = false; + } + re->seekable = (GLOBAL_Stream[inp_stream].status & Seekable_Stream_f) != 0; + if (re->seekable) + { + re->cpos = GLOBAL_Stream[inp_stream].charcount; + } + if (args[READ_PRIORITY].used) + { + re->prio = IntegerOfTerm(args[READ_PRIORITY].tvalue); + if (re->prio > GLOBAL_MaxPriority) + { + Yap_ThrowError(DOMAIN_ERROR_OPERATOR_PRIORITY, opts, + "max priority in Prolog is %d, not %ld", + GLOBAL_MaxPriority, re->prio); + } + } + else + { + re->prio = LOCAL_default_priority; + } + fe->msg = NULL; + return args; + } + + typedef enum { + YAP_START_PARSING, /// initialization + YAP_SCANNING, /// input to list of tokens + YAP_SCANNING_ERROR, /// serious error (eg oom); trying error handling, followd + /// by either restart or failure + YAP_PARSING, /// list of tokens to term + YAP_PARSING_ERROR, /// oom or syntax error + YAP_PARSING_FINISHED /// exit parser + } parser_state_t; + + Int Yap_FirstLineInParse(void) + { + CACHE_REGS return LOCAL_StartLineCount; -} + } #define PUSHFET(X) *HR++ = fe->X #define POPFET(X) fe->X = *--HR -static void reset_regs(TokEntry *tokstart, FEnv *fe) { - CACHE_REGS + static void reset_regs(TokEntry *tokstart, FEnv *fe) + { + CACHE_REGS restore_machine_regs(); - /* restart global */ - PUSHFET(qq); - PUSHFET(tp); - PUSHFET(sp); - PUSHFET(np); - PUSHFET(vp); - PUSHFET(tpos); - PUSHFET(t); - HR = fe->old_H; - TR = (tr_fr_ptr)LOCAL_ScannerStack; - LOCAL_Error_TYPE = YAP_NO_ERROR; - Yap_growstack_in_parser(&fe->old_TR, &tokstart, &LOCAL_VarTable); - LOCAL_ScannerStack = (char *)TR; - TR = fe->old_TR; - POPFET(t); - POPFET(tpos); - POPFET(vp); - POPFET(np); - POPFET(sp); - POPFET(tp); - POPFET(qq); -} + /* restart global */ + PUSHFET(qq); + PUSHFET(tp); + PUSHFET(sp); + PUSHFET(np); + PUSHFET(vp); + PUSHFET(tpos); + PUSHFET(t); + HR = fe->old_H; + TR = (tr_fr_ptr)LOCAL_ScannerStack; + LOCAL_Error_TYPE = YAP_NO_ERROR; + Yap_growstack_in_parser(&fe->old_TR, &tokstart, &LOCAL_VarTable); + LOCAL_ScannerStack = (char*)TR; + TR = fe->old_TR; + POPFET(t); + POPFET(tpos); + POPFET(vp); + POPFET(np); + POPFET(sp); + POPFET(tp); + POPFET(qq); + } -static Term get_variables(FEnv *fe, TokEntry *tokstart) { - CACHE_REGS + static Term get_variables(FEnv *fe, TokEntry *tokstart) + { + CACHE_REGS Term v; - if (fe->vp) { - while (true) { - fe->old_H = HR; - if (setjmp(LOCAL_IOBotch) == 0) { - if ((v = Yap_Variables(LOCAL_VarTable, TermNil))) { - fe->old_H = HR; - return v; - } - } else { - reset_regs(tokstart, fe); + if (fe->vp) + { + while (true) + { + fe->old_H = HR; + if (setjmp(LOCAL_IOBotch) == 0) + { + if ((v = Yap_Variables(LOCAL_VarTable, TermNil))) + { + fe->old_H = HR; + return v; + } + } + else + { + reset_regs(tokstart, fe); + } + } } - } + return 0; } - return 0; -} -static Term get_varnames(FEnv *fe, TokEntry *tokstart) { - CACHE_REGS + static Term get_varnames(FEnv *fe, TokEntry *tokstart) + { + CACHE_REGS Term v; - if (fe->np) { - while (true) { - fe->old_H = HR; - if (setjmp(LOCAL_IOBotch) == 0) { - if ((v = Yap_VarNames(LOCAL_VarTable, TermNil))) { - fe->old_H = HR; - return v; - } - } else { - reset_regs(tokstart, fe); + if (fe->np) + { + while (true) + { + fe->old_H = HR; + + if (setjmp(LOCAL_IOBotch) == 0) + { + if ((v = Yap_VarNames(LOCAL_VarTable, TermNil))) + { + fe->old_H = HR; + return v; + } + } + else + { + reset_regs(tokstart, fe); + } + } } - } + return 0; } - return 0; -} -static Term get_singletons(FEnv *fe, TokEntry *tokstart) { - CACHE_REGS + static Term get_singletons(FEnv *fe, TokEntry *tokstart) + { + CACHE_REGS Term v; - if (fe->sp) { - while (TRUE) { - fe->old_H = HR; - if (setjmp(LOCAL_IOBotch) == 0) { - if ((v = Yap_Singletons(LOCAL_VarTable, TermNil))) { - return v; - } - } else { - reset_regs(tokstart, fe); + if (fe->sp) + { + while (TRUE) + { + fe->old_H = HR; + + if (setjmp(LOCAL_IOBotch) == 0) + { + if ((v = Yap_Singletons(LOCAL_VarTable, TermNil))) + { + return v; + } + } + else + { + reset_regs(tokstart, fe); + } + } } - } + return 0; } - return 0; -} -static void warn_singletons(FEnv *fe, TokEntry *tokstart) { - CACHE_REGS + static void warn_singletons(FEnv *fe, TokEntry *tokstart) + { + CACHE_REGS Term v; - fe->sp = TermNil; - v = get_singletons(fe, tokstart); - if (v && v != TermNil) { - Term singls[4]; - singls[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomSingleton, 1), 1, &v); - singls[1] = MkIntegerTerm(LOCAL_SourceFileLineno); - singls[2] = MkAtomTerm(LOCAL_SourceFileName); - if (fe->t) - singls[3] = fe->t; - else - singls[1] = TermTrue; - Term t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, singls); - Yap_PrintWarning(t); - } -} -static Term get_stream_position(FEnv *fe, TokEntry *tokstart) { - CACHE_REGS - Term v; - if (fe->tp) { - while (true) { - fe->old_H = HR; - - if (setjmp(LOCAL_IOBotch) == 0) { - if ((v = CurrentPositionToTerm())) { - return v; - } - } else { - reset_regs(tokstart, fe); + fe->sp = TermNil; + v = get_singletons(fe, tokstart); + if (v && v != TermNil) + { + Term singls[4]; + singls[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomSingleton, 1), 1, &v); + singls[1] = MkIntegerTerm(LOCAL_SourceFileLineno); + singls[2] = MkAtomTerm(LOCAL_SourceFileName); + if (fe->t) + singls[3] = fe->t; + else + singls[1] = TermTrue; + Term t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, singls); + Yap_PrintWarning(t); } - } } - return 0; -} -static bool complete_processing(FEnv *fe, TokEntry *tokstart) { - CACHE_REGS + static Term get_stream_position(FEnv *fe, TokEntry *tokstart) + { + CACHE_REGS + Term v; + + if (fe->tp) + { + while (true) + { + fe->old_H = HR; + + if (setjmp(LOCAL_IOBotch) == 0) + { + if ((v = CurrentPositionToTerm())) + { + return v; + } + } + else + { + reset_regs(tokstart, fe); + } + } + } + return 0; + } + + static bool complete_processing(FEnv *fe, TokEntry *tokstart) + { + CACHE_REGS Term v1, v2, v3, vc, tp; - if (fe->t0 && fe->t && !(Yap_unify(fe->t, fe->t0))) - return false; + if (fe->t0 && fe->t && !(Yap_unify(fe->t, fe->t0))) + return false; - if (fe->t && fe->vp) - v1 = get_variables(fe, tokstart); - else - v1 = 0L; - if (fe->t && fe->np) - v2 = get_varnames(fe, tokstart); - else - v2 = 0L; - if (fe->t && fe->sp) - v3 = get_singletons(fe, tokstart); - else - v3 = 0L; - if (fe->t && fe->tcomms) - vc = LOCAL_Comments; - else - vc = 0L; - if (fe->t && fe->tp) - tp = get_stream_position(fe, tokstart); - else - tp = 0L; - Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); - free(fe->args); + if (fe->t && fe->vp) + v1 = get_variables(fe, tokstart); + else + v1 = 0L; + if (fe->t && fe->np) + v2 = get_varnames(fe, tokstart); + else + v2 = 0L; + if (fe->t && fe->sp) + v3 = get_singletons(fe, tokstart); + else + v3 = 0L; + if (fe->t && fe->tcomms) + vc = LOCAL_Comments; + else + vc = 0L; + if (fe->t && fe->tp) + tp = get_stream_position(fe, tokstart); + else + tp = 0L; + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); + free(fe->args); - // trail must be ok by now.] - if (fe->t) { - return (!v1 || Yap_unify(v1, fe->vp)) && (!v2 || Yap_unify(v2, fe->np)) && - (!v3 || Yap_unify(v3, fe->sp)) && (!tp || Yap_unify(tp, fe->tp)) && - (!vc || Yap_unify(vc, fe->tcomms)); + // trail must be ok by now.] + if (fe->t) + { + return (!v1 || Yap_unify(v1, fe->vp)) && (!v2 || Yap_unify(v2, fe->np)) && + (!v3 || Yap_unify(v3, fe->sp)) && (!tp || Yap_unify(tp, fe->tp)) && + (!vc || Yap_unify(vc, fe->tcomms)); + } + return true; } - return true; -} -static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) { - CACHE_REGS + static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) + { + CACHE_REGS Term v_vp, v_vnames, v_comments, v_pos; - if (fe->t0 && fe->t && !Yap_unify(fe->t, fe->t0)) - return false; - if (fe->t && fe->vp) - v_vp = get_variables(fe, tokstart); - else - v_vp = 0L; - if (fe->t && fe->np) - v_vnames = get_varnames(fe, tokstart); - else - v_vnames = 0L; - if (fe->t && trueGlobalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) { - warn_singletons(fe, tokstart); + if (fe->t0 && fe->t && !Yap_unify(fe->t, fe->t0)) + return false; + if (fe->t && fe->vp) + v_vp = get_variables(fe, tokstart); + else + v_vp = 0L; + if (fe->t && fe->np) + v_vnames = get_varnames(fe, tokstart); + else + v_vnames = 0L; + if (fe->t && trueGlobalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) + { + warn_singletons(fe, tokstart); + } + if (fe->t && fe->tcomms) + v_comments = LOCAL_Comments; + else + v_comments = 0L; + if (fe->t && fe->tp) + v_pos = get_stream_position(fe, tokstart); + else + v_pos = 0L; + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); + free(fe->args); + // trail must be ok by now.] + if (fe->t) + { + return (!v_vp || Yap_unify(v_vp, fe->vp)) && + (!v_vnames || Yap_unify(v_vnames, fe->np)) && + (!v_pos || Yap_unify(v_pos, fe->tp)) && + (!v_comments || Yap_unify(v_comments, fe->tcomms)); + } + return true; } - if (fe->t && fe->tcomms) - v_comments = LOCAL_Comments; - else - v_comments = 0L; - if (fe->t && fe->tp) - v_pos = get_stream_position(fe, tokstart); - else - v_pos = 0L; - Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); - free(fe->args); - // trail must be ok by now.] - if (fe->t) { - return (!v_vp || Yap_unify(v_vp, fe->vp)) && - (!v_vnames || Yap_unify(v_vnames, fe->np)) && - (!v_pos || Yap_unify(v_pos, fe->tp)) && - (!v_comments || Yap_unify(v_comments, fe->tcomms)); - } - return true; -} -static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, - bool clause); + static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, + bool clause); -static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream); + static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream); -static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream); + static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream); -static parser_state_t scanEOF(FEnv *fe, int inp_stream); + static parser_state_t scanEOF(FEnv *fe, int inp_stream); -static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream); + static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream); -static parser_state_t scanEOF(FEnv *fe, int inp_stream) { - CACHE_REGS + static parser_state_t scanEOF(FEnv *fe, int inp_stream) + { + CACHE_REGS // bool store_comments = false; TokEntry *tokstart = LOCAL_tokptr; - // check for an user abort - if (tokstart != NULL && tokstart->Tok != Ord(eot_tok)) { - /* we got the end of file from an abort */ - if (fe->msg && !strcmp(fe->msg, "Abort")) { - fe->t = 0L; - Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); - return YAP_PARSING_FINISHED; - } - // a :- - if (GLOBAL_Stream[inp_stream].status & Past_Eof_Stream_f) { - fe->msg = "parsing stopped at a end-of-file"; - return YAP_PARSING_ERROR; - } - /* we need to force the next read to also give end of file.*/ - GLOBAL_Stream[inp_stream].status |= Push_Eof_Stream_f; - fe->msg = "end of file found before end of term"; - return YAP_PARSING; - } else { - // - // return end_of_file - TR = (tr_fr_ptr)tokstart; - Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); - fe->t = MkAtomTerm(AtomEof); - if (fe->np && !Yap_unify(TermNil, fe->np)) - fe->t = 0; - if (fe->sp && !Yap_unify(TermNil, fe->sp)) - fe->t = 0; - if (fe->vp && !Yap_unify(TermNil, fe->vp)) - fe->t = 0; - if (fe->tp && !Yap_unify(fe->tp, fe->tpos)) - fe->t = 0; + + // check for an user abort + if (tokstart != NULL && tokstart->Tok != Ord(eot_tok)) + { + /* we got the end of file from an abort */ + if (fe->msg && !strcmp(fe->msg, "Abort")) + { + fe->t = 0L; + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); + return YAP_PARSING_FINISHED; + } + // a :- + if (GLOBAL_Stream[inp_stream].status & Past_Eof_Stream_f) + { + fe->msg = "parsing stopped at a end-of-file"; + return YAP_PARSING_ERROR; + } + /* we need to force the next read to also give end of file.*/ + GLOBAL_Stream[inp_stream].status |= Push_Eof_Stream_f; + fe->msg = "end of file found before end of term"; + return YAP_PARSING; + } + else + { + // + // return end_of_file + TR = (tr_fr_ptr)tokstart; + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); + fe->t = MkAtomTerm(AtomEof); + if (fe->np && !Yap_unify(TermNil, fe->np)) + fe->t = 0; + if (fe->sp && !Yap_unify(TermNil, fe->sp)) + fe->t = 0; + if (fe->vp && !Yap_unify(TermNil, fe->vp)) + fe->t = 0; + if (fe->tp && !Yap_unify(fe->tp, fe->tpos)) + fe->t = 0; #if DEBUG - if (GLOBAL_Option['p' - 'a' + 1]) { - fprintf(stderr, "[ end_of_file %p ]\n", GLOBAL_Stream[inp_stream].name); - } + if (GLOBAL_Option['p' - 'a' + 1]) + { + fprintf(stderr, "[ end_of_file %p ]\n", GLOBAL_Stream[inp_stream].name); + } #endif - return YAP_PARSING_FINISHED; + return YAP_PARSING_FINISHED; + } } -} -static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, - bool clause) { - LOCAL_ErrorMessage = NULL; - fe->old_TR = TR; - LOCAL_Error_TYPE = YAP_NO_ERROR; - LOCAL_SourceFileName = GLOBAL_Stream[inp_stream].name; - LOCAL_eot_before_eof = false; - fe->tpos = StreamPosition(inp_stream); - fe->reading_clause = clause; - if (clause) { - fe->args = setClauseReadEnv(opts, fe, re, inp_stream); - } else { - fe->args = setReadEnv(opts, fe, re, inp_stream); + static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, + bool clause) + { + LOCAL_ErrorMessage = NULL; + fe->old_TR = TR; + LOCAL_Error_TYPE = YAP_NO_ERROR; + LOCAL_SourceFileName = GLOBAL_Stream[inp_stream].name; + LOCAL_eot_before_eof = false; + fe->tpos = StreamPosition(inp_stream); + fe->reading_clause = clause; + if (clause) + { + fe->args = setClauseReadEnv(opts, fe, re, inp_stream); + } + else + { + fe->args = setReadEnv(opts, fe, re, inp_stream); + } + if (fe->args == NULL) + { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) + LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION; + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, opts, NULL); + fe->t = 0; + return YAP_PARSING_FINISHED; + ; + } + if (GLOBAL_Stream[inp_stream].status & Push_Eof_Stream_f) + { + fe->t = MkAtomTerm(AtomEof); + GLOBAL_Stream[inp_stream].status &= ~Push_Eof_Stream_f; + return YAP_PARSING_FINISHED; + } + if (!fe->args) + { + return YAP_PARSING_FINISHED; + } + return YAP_SCANNING; } - if (fe->args == NULL) { - if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) - LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION; - if (LOCAL_Error_TYPE) - Yap_Error(LOCAL_Error_TYPE, opts, NULL); - fe->t = 0; - return YAP_PARSING_FINISHED; - ; - } - if (GLOBAL_Stream[inp_stream].status & Push_Eof_Stream_f) { - fe->t = MkAtomTerm(AtomEof); - GLOBAL_Stream[inp_stream].status &= ~Push_Eof_Stream_f; - return YAP_PARSING_FINISHED; - } - if (!fe->args) { - return YAP_PARSING_FINISHED; - } - return YAP_SCANNING; -} -static parser_state_t scan(REnv *re, FEnv *fe, int sno) { - CACHE_REGS + static parser_state_t scan(REnv *re, FEnv *fe, int sno) + { + CACHE_REGS /* preserve value of H after scanning: otherwise we may lose strings and floats */ - LOCAL_tokptr = LOCAL_toktide = + LOCAL_tokptr = LOCAL_toktide = + + Yap_tokenizer(GLOBAL_Stream + sno, false, &fe->tpos); - Yap_tokenizer(GLOBAL_Stream + sno, false, &fe->tpos); #if DEBUG - if (GLOBAL_Option[2]) { - TokEntry *t = LOCAL_tokptr; - int n = 0; - while (t) { - fprintf(stderr, "[Token %d %s %d]", Ord(t->Tok), Yap_tokText(t), n++); - t = t->TokNext; - } - fprintf(stderr, "\n"); - } + if (GLOBAL_Option[2]) + { + TokEntry *t = LOCAL_tokptr; + int n = 0; + while (t) + { + fprintf(stderr, "[Token %d %s %d]", Ord(t->Tok), Yap_tokText(t), n++); + t = t->TokNext; + } + fprintf(stderr, "\n"); + } #endif - if (LOCAL_ErrorMessage) - return YAP_SCANNING_ERROR; - if (LOCAL_tokptr->Tok != Ord(eot_tok)) { - // next step - return YAP_PARSING; + if (LOCAL_ErrorMessage) + return YAP_SCANNING_ERROR; + if (LOCAL_tokptr->Tok != Ord(eot_tok)) + { + // next step + return YAP_PARSING; + } + if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) + { + LOCAL_ErrorMessage = ". is end-of-term?"; + return YAP_PARSING_ERROR; + } + return scanEOF(fe, sno); } - if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) { - LOCAL_ErrorMessage = ". is end-of-term?"; - return YAP_PARSING_ERROR; - } - return scanEOF(fe, sno); -} -static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) { - CACHE_REGS + static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) + { + CACHE_REGS fe->t = 0; - // running out of memory - if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growtrail(sizeof(CELL) * K16, FALSE)) { - return YAP_PARSING_FINISHED; - } - } else if (LOCAL_Error_TYPE == RESOURCE_ERROR_AUXILIARY_STACK) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - return YAP_PARSING_FINISHED; - } - } else if (LOCAL_Error_TYPE == RESOURCE_ERROR_HEAP) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growheap(FALSE, 0, NULL)) { - return YAP_PARSING_FINISHED; - } - } else if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gcl(LOCAL_Error_Size, fe->nargs, ENV, CP)) { - return YAP_PARSING_FINISHED; - } - } - // go back to the start - if (LOCAL_Error_TYPE == SYNTAX_ERROR) { - return YAP_PARSING_ERROR; - } - if (re->seekable) { - if (GLOBAL_Stream[inp_stream].status & InMemory_Stream_f) { - GLOBAL_Stream[inp_stream].u.mem_string.pos = re->cpos; - } else if (GLOBAL_Stream[inp_stream].status) { + + // running out of memory + if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL) + { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growtrail(sizeof(CELL) * K16, FALSE)) + { + return YAP_PARSING_FINISHED; + } + } + else if (LOCAL_Error_TYPE == RESOURCE_ERROR_AUXILIARY_STACK) + { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) + { + return YAP_PARSING_FINISHED; + } + } + else if (LOCAL_Error_TYPE == RESOURCE_ERROR_HEAP) + { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growheap(FALSE, 0, NULL)) + { + return YAP_PARSING_FINISHED; + } + } + else if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) + { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gcl(LOCAL_Error_Size, fe->nargs, ENV, CP)) + { + return YAP_PARSING_FINISHED; + } + } + // go back to the start + if (LOCAL_Error_TYPE == SYNTAX_ERROR) + { + return YAP_PARSING_ERROR; + } + if (re->seekable) + { + if (GLOBAL_Stream[inp_stream].status & InMemory_Stream_f) + { + GLOBAL_Stream[inp_stream].u.mem_string.pos = re->cpos; + } + else if (GLOBAL_Stream[inp_stream].status) + { #if HAVE_FTELLO - fseeko(GLOBAL_Stream[inp_stream].file, re->cpos, 0L); + fseeko(GLOBAL_Stream[inp_stream].file, re->cpos, 0L); #else - fseek(GLOBAL_Stream[inp_stream].file, re->cpos, 0L); + fseek(GLOBAL_Stream[inp_stream].file, re->cpos, 0L); #endif - } + } + } + return YAP_SCANNING; } - return YAP_SCANNING; -} -static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) { - CACHE_REGS + static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) + { + CACHE_REGS fe->t = 0; - if (LOCAL_Error_TYPE != SYNTAX_ERROR && LOCAL_Error_TYPE != YAP_NO_ERROR) { - return YAP_SCANNING_ERROR; - } - Term ParserErrorStyle = re->sy; - if (ParserErrorStyle == TermQuiet || LOCAL_Error_TYPE == YAP_NO_ERROR) { - /* just fail */ - LOCAL_Error_TYPE = YAP_NO_ERROR; - return YAP_PARSING_FINISHED; - } - Term t = syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos, fe->reading_clause, fe->msg); - if (ParserErrorStyle == TermException) { - if (LOCAL_RestartEnv && !LOCAL_delay) { - Yap_RestartYap(5); - } - Yap_exit(5); - } - if (re->seekable) { - re->cpos = GLOBAL_Stream[inp_stream].charcount; - } + + if (LOCAL_Error_TYPE != SYNTAX_ERROR && LOCAL_Error_TYPE != YAP_NO_ERROR) + { + return YAP_SCANNING_ERROR; + } + Term ParserErrorStyle = re->sy; + if (ParserErrorStyle == TermQuiet || LOCAL_Error_TYPE == YAP_NO_ERROR) + { + /* just fail */ + LOCAL_Error_TYPE = YAP_NO_ERROR; + return YAP_PARSING_FINISHED; + } + Term t = syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos, fe->reading_clause, fe->msg); + if (ParserErrorStyle == TermException) + { + if (LOCAL_RestartEnv && !LOCAL_delay) + { + Yap_RestartYap(5); + } + Yap_exit(5); + } + if (re->seekable) + { + re->cpos = GLOBAL_Stream[inp_stream].charcount; + } LOCAL_Error_TYPE = WARNING_SYNTAX_ERROR; - t = Yap_MkFullError(); + t = Yap_MkFullError(); Yap_PrintWarning(t); LOCAL_Error_TYPE = YAPC_NO_ERROR; - if (ParserErrorStyle == TermDec10) { - return YAP_SCANNING; - } - return YAP_PARSING_FINISHED; -} + if (ParserErrorStyle == TermDec10) + { + return YAP_SCANNING; + } + return YAP_PARSING_FINISHED; + } -static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) { - CACHE_REGS + static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) + { + CACHE_REGS TokEntry *tokstart = LOCAL_tokptr; - fe->t = Yap_Parse(re->prio, fe->enc, fe->cmod); - fe->toklast = LOCAL_tokptr; - LOCAL_tokptr = tokstart; - TR = (tr_fr_ptr)tokstart; + + fe->t = Yap_Parse(re->prio, fe->enc, fe->cmod); + fe->toklast = LOCAL_tokptr; + LOCAL_tokptr = tokstart; + TR = (tr_fr_ptr)tokstart; #if EMACS - first_char = tokstart->TokPos; + first_char = tokstart->TokPos; #endif /* EMACS */ - if (LOCAL_Error_TYPE != YAP_NO_ERROR || fe->t == 0) - return YAP_PARSING_ERROR; - return YAP_PARSING_FINISHED; -} + if (LOCAL_Error_TYPE != YAP_NO_ERROR || fe->t == 0) + return YAP_PARSING_ERROR; + return YAP_PARSING_FINISHED; + } /** * @brief generic routine to read terms from a stream @@ -1027,176 +1222,218 @@ static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) { * * */ -Term Yap_read_term(int sno, Term opts, bool clause) { - FEnv fe; - REnv re; + Term Yap_read_term(int sno, Term opts, bool clause) + { + FEnv fe; + REnv re; + #if EMACS - int emacs_cares = FALSE; + int emacs_cares = FALSE; #endif - yap_error_descriptor_t *new = malloc(sizeof *new); - bool err = Yap_pushErrorContext(true, new); - int lvl = push_text_stack(); - parser_state_t state = YAP_START_PARSING; - while (true) { - switch (state) { - case YAP_START_PARSING: - state = initParser(opts, &fe, &re, sno, clause); - if (state == YAP_PARSING_FINISHED) { - pop_text_stack(lvl); - Yap_popErrorContext(err, true); - return 0; - } - break; - case YAP_SCANNING: - state = scan(&re, &fe, sno); - break; - case YAP_SCANNING_ERROR: - state = scanError(&re, &fe, sno); - break; - case YAP_PARSING: - state = parse(&re, &fe, sno); - break; - case YAP_PARSING_ERROR: - state = parseError(&re, &fe, sno); - break; - case YAP_PARSING_FINISHED: { - CACHE_REGS - bool done; - if (fe.reading_clause) - done = complete_clause_processing(&fe, LOCAL_tokptr); - else - done = complete_processing(&fe, LOCAL_tokptr); - if (!done) { - state = YAP_PARSING_ERROR; - fe.t = 0; - break; - } + yap_error_descriptor_t *new = malloc(sizeof *new); + bool err = Yap_pushErrorContext(true, new); + int lvl = push_text_stack(); + parser_state_t state = YAP_START_PARSING; + while (true) + { + switch (state) + { + case YAP_START_PARSING: + state = initParser(opts, &fe, &re, sno, clause); + if (state == YAP_PARSING_FINISHED) + { + pop_text_stack(lvl); + Yap_popErrorContext(err, true); + return 0; + } + break; + + case YAP_SCANNING: + state = scan(&re, &fe, sno); + break; + + case YAP_SCANNING_ERROR: + state = scanError(&re, &fe, sno); + break; + + case YAP_PARSING: + state = parse(&re, &fe, sno); + break; + + case YAP_PARSING_ERROR: + state = parseError(&re, &fe, sno); + break; + + case YAP_PARSING_FINISHED: { + CACHE_REGS + bool done; + if (fe.reading_clause) + done = complete_clause_processing(&fe, LOCAL_tokptr); + else + done = complete_processing(&fe, LOCAL_tokptr); + if (!done) + { + state = YAP_PARSING_ERROR; + fe.t = 0; + break; + } #if EMACS - first_char = tokstart->TokPos; + first_char = tokstart->TokPos; #endif /* EMACS */ - pop_text_stack(lvl); - Yap_popErrorContext(err, true); - return fe.t; - } - } + pop_text_stack(lvl); + Yap_popErrorContext(err, true); + return fe.t; + } + } + } + Yap_popErrorContext(err, true); + pop_text_stack(lvl); + return 0; } - Yap_popErrorContext(err, true); - pop_text_stack(lvl); - return 0; -} -static Int -read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */ - return Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, ARG2), false) != - 0; -} - -static Int read_term( - USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ - int sno; - Term out; - - /* needs to change LOCAL_output_stream for write */ - - sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); - if (sno == -1) { - return (FALSE); + static Int + read_term2(USES_REGS1) /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */ + { + return Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, ARG2), false) != + 0; } - out = Yap_read_term(sno, add_output(ARG2, ARG3), false); - UNLOCK(GLOBAL_Stream[sno].streamlock); - return out != 0L; -} -#define READ_CLAUSE_DEFS() \ - PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \ - , PAR("module", isatom, READ_CLAUSE_MODULE), \ - PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \ - PAR("variables", filler, READ_CLAUSE_VARIABLES), \ - PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \ - PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \ - PAR("output", isatom, READ_CLAUSE_OUTPUT), \ - PAR(NULL, ok, READ_CLAUSE_END) + static Int read_term( + USES_REGS1) /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ + { + int sno; + Term out; + + /* needs to change LOCAL_output_stream for write */ + + sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); + if (sno == -1) + { + return(FALSE); + } + out = Yap_read_term(sno, add_output(ARG2, ARG3), false); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return out != 0L; + } + +#define READ_CLAUSE_DEFS() \ + PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \ + , PAR("module", isatom, READ_CLAUSE_MODULE), \ + PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \ + PAR("variables", filler, READ_CLAUSE_VARIABLES), \ + PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \ + PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \ + PAR("output", isatom, READ_CLAUSE_OUTPUT), \ + PAR(NULL, ok, READ_CLAUSE_END) #define PAR(x, y, z) z -typedef enum read_clause_enum_choices { - READ_CLAUSE_DEFS() -} read_clause_choices_t; + typedef enum read_clause_enum_choices { + READ_CLAUSE_DEFS() + } read_clause_choices_t; #undef PAR -#define PAR(x, y, z) \ +#define PAR(x, y, z) \ { x, y, z } -static const param_t read_clause_defs[] = {READ_CLAUSE_DEFS()}; + static const param_t read_clause_defs[] = { READ_CLAUSE_DEFS() }; #undef PAR -static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, int sno) { - CACHE_REGS + static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, int sno) + { + CACHE_REGS xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END, - DOMAIN_ERROR_READ_OPTION); - if (args == NULL) { - return NULL; - } - if (args[READ_CLAUSE_OUTPUT].used) { - fe->t0 = args[READ_CLAUSE_OUTPUT].tvalue; - } else { - fe->t0 = 0; - } - if (args[READ_CLAUSE_MODULE].used) { - fe->cmod = args[READ_CLAUSE_MODULE].tvalue; - } else { - fe->cmod = LOCAL_SourceModule; - if (fe->cmod == TermProlog) - fe->cmod = PROLOG_MODULE; - } - re->bq = getReadTermBackQuotesFlag(); - fe->enc = GLOBAL_Stream[sno].encoding; - fe->sp = 0; - fe->qq = 0; - if (args[READ_CLAUSE_OUTPUT].used) { - fe->t0 = args[READ_CLAUSE_OUTPUT].tvalue; - } else { - fe->t0 = 0; - } - if (args[READ_CLAUSE_TERM_POSITION].used) { - fe->tp = args[READ_CLAUSE_TERM_POSITION].tvalue; - } else { - fe->tp = 0; - } - fe->sp = 0; - if (args[READ_CLAUSE_COMMENTS].used) { - fe->tcomms = args[READ_CLAUSE_COMMENTS].tvalue; - } else { - fe->tcomms = 0L; - } - if (args[READ_CLAUSE_SYNTAX_ERRORS].used) { - re->sy = args[READ_CLAUSE_SYNTAX_ERRORS].tvalue; - } else { - re->sy = TermDec10; - } - fe->vp = 0; - if (args[READ_CLAUSE_VARIABLE_NAMES].used) { - fe->np = args[READ_CLAUSE_VARIABLE_NAMES].tvalue; - } else { - fe->np = 0; - } - if (args[READ_CLAUSE_VARIABLES].used) { - fe->vp = args[READ_CLAUSE_VARIABLES].tvalue; - } else { + DOMAIN_ERROR_READ_OPTION); + + if (args == NULL) + { + return NULL; + } + if (args[READ_CLAUSE_OUTPUT].used) + { + fe->t0 = args[READ_CLAUSE_OUTPUT].tvalue; + } + else + { + fe->t0 = 0; + } + if (args[READ_CLAUSE_MODULE].used) + { + fe->cmod = args[READ_CLAUSE_MODULE].tvalue; + } + else + { + fe->cmod = LOCAL_SourceModule; + if (fe->cmod == TermProlog) + fe->cmod = PROLOG_MODULE; + } + re->bq = getReadTermBackQuotesFlag(); + fe->enc = GLOBAL_Stream[sno].encoding; + fe->sp = 0; + fe->qq = 0; + if (args[READ_CLAUSE_OUTPUT].used) + { + fe->t0 = args[READ_CLAUSE_OUTPUT].tvalue; + } + else + { + fe->t0 = 0; + } + if (args[READ_CLAUSE_TERM_POSITION].used) + { + fe->tp = args[READ_CLAUSE_TERM_POSITION].tvalue; + } + else + { + fe->tp = 0; + } + fe->sp = 0; + if (args[READ_CLAUSE_COMMENTS].used) + { + fe->tcomms = args[READ_CLAUSE_COMMENTS].tvalue; + } + else + { + fe->tcomms = 0L; + } + if (args[READ_CLAUSE_SYNTAX_ERRORS].used) + { + re->sy = args[READ_CLAUSE_SYNTAX_ERRORS].tvalue; + } + else + { + re->sy = TermDec10; + } fe->vp = 0; + if (args[READ_CLAUSE_VARIABLE_NAMES].used) + { + fe->np = args[READ_CLAUSE_VARIABLE_NAMES].tvalue; + } + else + { + fe->np = 0; + } + if (args[READ_CLAUSE_VARIABLES].used) + { + fe->vp = args[READ_CLAUSE_VARIABLES].tvalue; + } + else + { + fe->vp = 0; + } + fe->ce = Yap_CharacterEscapes(fe->cmod); + re->seekable = (GLOBAL_Stream[sno].status & Seekable_Stream_f) != 0; + if (re->seekable) + { + re->cpos = GLOBAL_Stream[sno].charcount; + } + re->prio = LOCAL_default_priority; + fe->msg = NULL; + return args; } - fe->ce = Yap_CharacterEscapes(fe->cmod); - re->seekable = (GLOBAL_Stream[sno].status & Seekable_Stream_f) != 0; - if (re->seekable) { - re->cpos = GLOBAL_Stream[sno].charcount; - } - re->prio = LOCAL_default_priority; - fe->msg = NULL; - return args; -} /** * @pred read_clause( +Stream, -Clause, ?Opts) is det @@ -1204,47 +1441,50 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, int sno) { * Same as read_clause/3, but from the standard input stream. * */ -static Int read_clause2(USES_REGS1) { - Term ctl = add_output(ARG1, ARG2); - return Yap_read_term(LOCAL_c_input_stream, ctl, true); -} + static Int read_clause2(USES_REGS1) + { + Term ctl = add_output(ARG1, ARG2); + + return Yap_read_term(LOCAL_c_input_stream, ctl, true); + } /** * @pred read_clause( +Stream, -Clause, ?Opts) is det * * This predicate receives a set of options _OPts_ based on read_term/3, but - *specific + * specific * to readin clauses. The following options are considered: * * + The `comments` option unifies its argument with the comments in the - *term, + * term, * represented as strings * + The `process_comments` option calls a hook, it is current ignored by - *YAP. + * YAP. * + The `term_position` unifies its argument with a term describing the * position of the term. * + The `syntax_errors` flag controls response to syntactic errors, the - *default is `dec10`. + * default is `dec10`. * * The next two options are called implicitly: * * + The `module` option is initialized to the current source module, by - *default. + * default. * + The `singletons` option is set from the single var flag */ -static Int read_clause( - USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ - int sno; - Term out; + static Int read_clause( + USES_REGS1) /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ + { + int sno; + Term out; - /* needs to change LOCAL_output_stream for write */ - sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); - if (sno < 0) - return false; - out = Yap_read_term(sno, add_output(ARG2, ARG3), true); - UNLOCK(GLOBAL_Stream[sno].streamlock); - return out != 0; -} + /* needs to change LOCAL_output_stream for write */ + sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); + if (sno < 0) + return false; + out = Yap_read_term(sno, add_output(ARG2, ARG3), true); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return out != 0; + } /** * start input for a meta-clause. Should obtain: @@ -1258,378 +1498,446 @@ static Int read_clause( * @return [description] */ #if 0 -static Int start_mega(USES_REGS1) { - int sno; - Term out; - Term t3 = Deref(ARG3); - yhandle_t h = Yap_InitSlot(ARG2); - TokENtry *tok; - arity_t srity = 0; - /* needs to change LOCAL_output_stream for write */ - sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read_exo/3"); - if (sno < 0) - return false; - /* preserve value of H after scanning: otherwise we may lose strings - and floats */ - LOCAL_tokptr = LOCAL_toktide = - x Yap_tokenizer(GLOBAL_Stream + sno, false, &tpos); - if (tokptr->Tok == Name_tok && (next = tokptr->TokNext) != NULL && - next->Tok == Ponctuation_tok && next->TokInfo == TermOpenBracket) { - bool start = true; - while((tokptr = next->TokNext)) { + static Int start_mega(USES_REGS1) + { + int sno; + Term out; + Term t3 = Deref(ARG3); + yhandle_t h = Yap_InitSlot(ARG2); + TokENtry *tok; + arity_t srity = 0; - if (IsAtomOrIntTerm(t=*tp)) { - ip->opc = Yap_opcode(get_atom); - ip->y_u.x_c.c = t. - ip->y_u.x_c.x = tp++; /() c */ - } else if (IsAtomOrIntTerm(t=*tp)) { - (IsAtom(tok->Tokt)||IsIntTerm(XREGS+(i+1)))extra[arity] - ] - } + /* needs to change LOCAL_output_stream for write */ + sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read_exo/3"); + if (sno < 0) + return false; + /* preserve value of H after scanning: otherwise we may lose strings + and floats */ + LOCAL_tokptr = LOCAL_toktide = + x Yap_tokenizer(GLOBAL_Stream + sno, false, &tpos); + if (tokptr->Tok == Name_tok && (next = tokptr->TokNext) != NULL && + next->Tok == Ponctuation_tok && next->TokInfo == TermOpenBracket) + { + bool start = true; + while ((tokptr = next->TokNext)) + { + if (IsAtomOrIntTerm(t = *tp)) + { + ip->opc = Yap_opcode(get_atom); + ip->y_u.x_c.c = t. + ip->y_u.x_c.x = tp++; / ()c * / + } + else if (IsAtomOrIntTerm(t = *tp)) + { + (IsAtom(tok->Tokt) || IsIntTerm(XREGS + (i + 1)))extra[arity] + ] + } #endif - /** - * @pred source_location( - _File_ , _Line_ ) - * - * unify _File_ and _Line_ wuth the position of the last term read, if the - *term - * comes from a stream created by opening a file-system path with open/3 and - *friends.>position - * It ignores user_input or - * sockets. - * - * @param - _File_ - * @param - _Line_ - * - * - * - * @note SWI-Prolog built-in. - */ - static Int source_location(USES_REGS1) { - return Yap_unify(ARG1, MkAtomTerm(LOCAL_SourceFileName)) && - Yap_unify(ARG2, MkIntegerTerm(LOCAL_SourceFileLineno)); - } + /** + * @pred source_location( - _File_ , _Line_ ) + * + * unify _File_ and _Line_ wuth the position of the last term read, if the + * term + * comes from a stream created by opening a file-system path with open/3 and + * friends.>position + * It ignores user_input or + * sockets. + * + * @param - _File_ + * @param - _Line_ + * + * + * + * @note SWI-Prolog built-in. + */ + static Int source_location(USES_REGS1) + { + return Yap_unify(ARG1, MkAtomTerm(LOCAL_SourceFileName)) && + Yap_unify(ARG2, MkIntegerTerm(LOCAL_SourceFileLineno)); + } - /** - * @pred read(+ Stream, -Term ) is iso - * - * Reads term _T_ from the stream _S_ instead of from the current input - * stream. - * - * @param - _Stream_ - * @param - _Term_ - * - */ - static Int read2( - USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ - int sno; - Int out; + /** + * @pred read(+ Stream, -Term ) is iso + * + * Reads term _T_ from the stream _S_ instead of from the current input + * stream. + * + * @param - _Stream_ + * @param - _Term_ + * + */ + static Int read2( + USES_REGS1) /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ + { + int sno; + Int out; - /* needs to change LOCAL_output_stream for write */ - sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); - if (sno == -1) { - return (FALSE); + /* needs to change LOCAL_output_stream for write */ + sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); + if (sno == -1) + { + return(FALSE); } - out = Yap_read_term(sno, add_output(ARG2, TermNil), false); - UNLOCK(GLOBAL_Stream[sno].streamlock); - return out; - } + out = Yap_read_term(sno, add_output(ARG2, TermNil), false); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return out; + } - /** @pred read(- T) is iso + /** @pred read(- T) is iso - Reads the next term from the current input stream, and unifies it with - _T_. The term must be followed by a dot (`.`) and any blank-character - as previously defined. The syntax of the term must match the current - declarations for operators (see op). If the end-of-stream is reached, - _T_ is unified with the atom `end_of_file`. Further reads from of - the same stream may cause an error failure (see open/3). + Reads the next term from the current input stream, and unifies it with + _T_. The term must be followed by a dot (`.`) and any blank-character + as previously defined. The syntax of the term must match the current + declarations for operators (see op). If the end-of-stream is reached, + _T_ is unified with the atom `end_of_file`. Further reads from of + the same stream may cause an error failure (see open/3). - */ - static Int read1( - USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ - Term out = Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, TermNil), 1); - return out; - } + */ + static Int read1( + USES_REGS1) /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ + { + Term out = Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, TermNil), 1); - /** @pred fileerrors + return out; + } - Switches on the file_errors flag so that in certain error conditions - Input/Output predicates will produce an appropriated message and abort. + /** @pred fileerrors - */ - static Int fileerrors(USES_REGS1) { - return setYapFlag(TermFileErrors, TermTrue); - } + Switches on the file_errors flag so that in certain error conditions + Input/Output predicates will produce an appropriated message and abort. - /** - @pred nofileerrors + */ + static Int fileerrors(USES_REGS1) + { + return setYapFlag(TermFileErrors, TermTrue); + } - Switches off the `file_errors` flag, so that the predicates see/1, - tell/1, open/3 and close/1 just fail, instead of producing - an error message and aborting whenever the specified file cannot be - opened or closed. + /** + @pred nofileerrors - */ - static Int nofileerrors( - USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ - return setYapFlag(TermFileerrors, TermFalse); - } + Switches off the `file_errors` flag, so that the predicates see/1, + tell/1, open/3 and close/1 just fail, instead of producing + an error message and aborting whenever the specified file cannot be + opened or closed. - static Int style_checker(USES_REGS1) { - Term t = Deref(ARG1); + */ + static Int nofileerrors( + USES_REGS1) /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ + { + return setYapFlag(TermFileerrors, TermFalse); + } - if (IsVarTerm(t)) { - Term t = TermNil; - if (getYapFlag(MkAtomTerm(AtomSingleVarWarnings)) == TermTrue) { - t = MkPairTerm(MkAtomTerm(AtomSingleVarWarnings), t); - } - if (getYapFlag(MkAtomTerm(AtomDiscontiguousWarnings)) == TermTrue) { - t = MkPairTerm(MkAtomTerm(AtomDiscontiguousWarnings), t); - } - if (getYapFlag(MkAtomTerm(AtomRedefineWarnings)) == TermTrue) { - t = MkPairTerm(MkAtomTerm(AtomRedefineWarnings), t); - } - } else { - while (IsPairTerm(t)) { - Term h = HeadOfTerm(t); - t = TailOfTerm(t); + static Int style_checker(USES_REGS1) + { + Term t = Deref(ARG1); - if (IsVarTerm(h)) { - Yap_Error(INSTANTIATION_ERROR, t, "style_check/1"); - return (FALSE); - } else if (IsAtomTerm(h)) { - Atom at = AtomOfTerm(h); - if (at == AtomSingleVarWarnings) - setYapFlag(MkAtomTerm(AtomSingleVarWarnings), TermTrue); - else if (at == AtomDiscontiguousWarnings) - setYapFlag(MkAtomTerm(AtomDiscontiguousWarnings), TermTrue); - else if (at == AtomRedefineWarnings) - setYapFlag(MkAtomTerm(AtomRedefineWarnings), TermTrue); - } else { - Atom at = AtomOfTerm(ArgOfTerm(1, h)); - if (at == AtomSingleVarWarnings) - setYapFlag(MkAtomTerm(AtomSingleVarWarnings), TermFalse); - else if (at == AtomDiscontiguousWarnings) - setYapFlag(MkAtomTerm(AtomDiscontiguousWarnings), TermFalse); - else if (at == AtomRedefineWarnings) - setYapFlag(MkAtomTerm(AtomRedefineWarnings), TermFalse); - } - } + if (IsVarTerm(t)) + { + Term t = TermNil; + if (getYapFlag(MkAtomTerm(AtomSingleVarWarnings)) == TermTrue) + { + t = MkPairTerm(MkAtomTerm(AtomSingleVarWarnings), t); + } + if (getYapFlag(MkAtomTerm(AtomDiscontiguousWarnings)) == TermTrue) + { + t = MkPairTerm(MkAtomTerm(AtomDiscontiguousWarnings), t); + } + if (getYapFlag(MkAtomTerm(AtomRedefineWarnings)) == TermTrue) + { + t = MkPairTerm(MkAtomTerm(AtomRedefineWarnings), t); + } } - return TRUE; - } + else + { + while (IsPairTerm(t)) + { + Term h = HeadOfTerm(t); + t = TailOfTerm(t); - Term Yap_BufferToTerm(const char *s, Term opts) { - Term rval; - int sno; - encoding_t l = ENC_ISO_UTF8; - sno = - Yap_open_buf_read_stream((char *)s, strlen(s) + 1, &l, MEM_BUF_USER, - Yap_LookupAtom(Yap_StrPrefix(s, 16)), TermNone); - - GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; - rval = Yap_read_term(sno, opts, false); - Yap_CloseStream(sno); - return rval; - } - - Term Yap_UBufferToTerm(const unsigned char *s, Term opts) { - Term rval; - int sno; - encoding_t l = ENC_ISO_UTF8; - sno = Yap_open_buf_read_stream( - (char *)s, strlen((const char *)s), &l, MEM_BUF_USER, - Yap_LookupAtom(Yap_StrPrefix((char *)s, 16)), TermNone); - GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; - rval = Yap_read_term(sno, opts, false); - Yap_CloseStream(sno); - return rval; - } - - X_API Term Yap_BufferToTermWithPrioBindings(const char *s, Term opts, - Term bindings, size_t len, - int prio) { - CACHE_REGS - Term ctl; - - ctl = opts; - if (bindings) { - ctl = add_names(bindings, TermNil); + if (IsVarTerm(h)) + { + Yap_Error(INSTANTIATION_ERROR, t, "style_check/1"); + return(FALSE); + } + else if (IsAtomTerm(h)) + { + Atom at = AtomOfTerm(h); + if (at == AtomSingleVarWarnings) + setYapFlag(MkAtomTerm(AtomSingleVarWarnings), TermTrue); + else if (at == AtomDiscontiguousWarnings) + setYapFlag(MkAtomTerm(AtomDiscontiguousWarnings), TermTrue); + else if (at == AtomRedefineWarnings) + setYapFlag(MkAtomTerm(AtomRedefineWarnings), TermTrue); + } + else + { + Atom at = AtomOfTerm(ArgOfTerm(1, h)); + if (at == AtomSingleVarWarnings) + setYapFlag(MkAtomTerm(AtomSingleVarWarnings), TermFalse); + else if (at == AtomDiscontiguousWarnings) + setYapFlag(MkAtomTerm(AtomDiscontiguousWarnings), TermFalse); + else if (at == AtomRedefineWarnings) + setYapFlag(MkAtomTerm(AtomRedefineWarnings), TermFalse); + } + } } - if (prio != 1200) { - ctl = add_priority(bindings, ctl); + return TRUE; + } + + Term Yap_BufferToTerm(const char *s, Term opts) + { + Term rval; + int sno; + encoding_t l = ENC_ISO_UTF8; + + sno = + Yap_open_buf_read_stream((char*)s, strlen(s) + 1, &l, MEM_BUF_USER, + Yap_LookupAtom(Yap_StrPrefix(s, 16)), TermNone); + + GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; + rval = Yap_read_term(sno, opts, false); + Yap_CloseStream(sno); + return rval; + } + + Term Yap_UBufferToTerm(const unsigned char *s, Term opts) + { + Term rval; + int sno; + encoding_t l = ENC_ISO_UTF8; + + sno = Yap_open_buf_read_stream( + (char*)s, strlen((const char*)s), &l, MEM_BUF_USER, + Yap_LookupAtom(Yap_StrPrefix((char*)s, 16)), TermNone); + GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; + rval = Yap_read_term(sno, opts, false); + Yap_CloseStream(sno); + return rval; + } + + X_API Term Yap_BufferToTermWithPrioBindings(const char *s, Term opts, + Term bindings, size_t len, + int prio) + { + CACHE_REGS + Term ctl; + + ctl = opts; + if (bindings) + { + ctl = add_names(bindings, TermNil); } - return Yap_BufferToTerm(s, ctl); - } - - /** - * @pred read_term_from_atom( +Atom , -T , +Options ) - * - * read a term _T_ stored in constant _Atom_ according to _Options_ - * - * @param _Atom_ the source _Atom_ - * @param _T_ the output term _T_, may be any term - * @param _Options_ read_term/3 options. - * - * @note Originally from SWI-Prolog, in YAP only works with internalised - *atoms - * Check read_term_from_atomic/3 for the general version. Also, the built-in - *is - *supposed to - * use YAP's internal encoding, so please avoid the encoding/1 option. - */ - static Int read_term_from_atom(USES_REGS1) { - Term t1 = Deref(ARG1); - Atom at; - const unsigned char *s; - - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "style_check/1"); - return false; - } else if (!IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM, t1, "style_check/1"); - return false; - } else { - at = AtomOfTerm(t1); - s = at->UStrOfAE; + if (prio != 1200) + { + ctl = add_priority(bindings, ctl); } - Term ctl = add_output(ARG2, ARG3); + return Yap_BufferToTerm(s, ctl); + } - return Yap_UBufferToTerm(s, ctl); - } + /** + * @pred read_term_from_atom( +Atom , -T , +Options ) + * + * read a term _T_ stored in constant _Atom_ according to _Options_ + * + * @param _Atom_ the source _Atom_ + * @param _T_ the output term _T_, may be any term + * @param _Options_ read_term/3 options. + * + * @note Originally from SWI-Prolog, in YAP only works with internalised + * atoms + * Check read_term_from_atomic/3 for the general version. Also, the built-in + * is + * supposed to + * use YAP's internal encoding, so please avoid the encoding/1 option. + */ + static Int read_term_from_atom(USES_REGS1) + { + Term t1 = Deref(ARG1); + Atom at; + const unsigned char *s; - /** - * @pred read_term_from_atomic( +Atomic , - T , +Options ) - * - * read a term _T_ stored in text _Atomic_ according to _Options_ - * - * @param _Atomic_ the source may be an atom, string, list of codes, or list - *of - *chars. - * @param _T_ the output term _T_, may be any term - * @param _Options_ read_term/3 options. - * - * @notes Idea originally from SWI-Prolog, but in YAP we separate atomic and - *atom. - * Encoding is fixed in atoms and strings. - */ - static Int read_term_from_atomic(USES_REGS1) { - Term t1 = Deref(ARG1); - const unsigned char *s; - - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_atomic/3"); - return (FALSE); - } else if (!IsAtomicTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOMIC, t1, "read_term_from_atomic/3"); - return (FALSE); - } else { - Term t = Yap_AtomicToString(t1 PASS_REGS); - s = UStringOfTerm(t); + if (IsVarTerm(t1)) + { + Yap_Error(INSTANTIATION_ERROR, t1, "style_check/1"); + return false; } - Term ctl = add_output(ARG2, ARG3); - - return Yap_UBufferToTerm(s, ctl); - } - - /** - * @pred read_term_from_string( +String , - T , + Options ) - * - * read a term _T_ stored in constant _String_ according to _Options_ - * - * @param _String_ the source _String_ - * @param _T_ the output term _T_, may be any term - * @param _Options_ read_term/3 options. - * - * Idea from SWI-Prolog, in YAP only works with strings - * Check read_term_from_atomic/3 for the general version. - */ - static Int read_term_from_string(USES_REGS1) { - Term t1 = Deref(ARG1), rc; - const unsigned char *s; - size_t len; - BACKUP_H() - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); - return (FALSE); - } else if (!IsStringTerm(t1)) { - Yap_Error(TYPE_ERROR_STRING, t1, "read_term_from_string/3"); - return (FALSE); - } else { - s = UStringOfTerm(t1); - len = strlen_utf8(s); - } - char *ss = (char *)s; - encoding_t enc = ENC_ISO_UTF8; - int sno = Yap_open_buf_read_stream(ss, len, &enc, MEM_BUF_USER, - Yap_LookupAtom(Yap_StrPrefix(ss, 16)), - TermString); - GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; - rc = Yap_read_term(sno, Deref(ARG3), 3); - Yap_CloseStream(sno); - RECOVER_H(); - if (!rc) - return false; - return Yap_unify(rc, ARG2); - } - - static Int atomic_to_term(USES_REGS1) { - Term t1 = Deref(ARG1); - int l = push_text_stack(); - const unsigned char *s = Yap_TextToUTF8Buffer(t1 PASS_REGS); - Int rc = Yap_UBufferToTerm(s, add_output(ARG2, add_names(ARG3, TermNil))); - pop_text_stack(l); - return rc; - } - - static Int atom_to_term(USES_REGS1) { - Term t1 = Deref(ARG1); - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); - return (FALSE); - } else if (!IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM, t1, "read_term_from_atomic/3"); - return (FALSE); - } else { - Term t = Yap_AtomicToString(t1 PASS_REGS); - const unsigned char *us = UStringOfTerm(t); - return Yap_UBufferToTerm(us, add_output(ARG2, add_names(ARG3, TermNil))); + else if (!IsAtomTerm(t1)) + { + Yap_Error(TYPE_ERROR_ATOM, t1, "style_check/1"); + return false; } - } - - static Int string_to_term(USES_REGS1) { - Term t1 = Deref(ARG1); - - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); - return (FALSE); - } else if (!IsStringTerm(t1)) { - Yap_Error(TYPE_ERROR_STRING, t1, "read_term_from_string/3"); - return (FALSE); - } else { - const unsigned char *us = UStringOfTerm(t1); - return Yap_UBufferToTerm(us, add_output(ARG2, add_names(ARG3, TermNil))); + else + { + at = AtomOfTerm(t1); + s = at->UStrOfAE; } - } + Term ctl = add_output(ARG2, ARG3); - void Yap_InitReadTPreds(void) { - Yap_InitCPred("read_term", 2, read_term2, SyncPredFlag); - Yap_InitCPred("read_term", 3, read_term, SyncPredFlag); + return Yap_UBufferToTerm(s, ctl); + } - Yap_InitCPred("scan_to_list", 2, scan_to_list, SyncPredFlag); - Yap_InitCPred("read", 1, read1, SyncPredFlag); - Yap_InitCPred("read", 2, read2, SyncPredFlag); - Yap_InitCPred("read_clause", 2, read_clause2, SyncPredFlag); - Yap_InitCPred("read_clause", 3, read_clause, 0); - Yap_InitCPred("read_term_from_atom", 3, read_term_from_atom, 0); - Yap_InitCPred("read_term_from_atomic", 3, read_term_from_atomic, 0); - Yap_InitCPred("read_term_from_string", 3, read_term_from_string, 0); - Yap_InitCPred("atom_to_term", 3, atom_to_term, 0); - Yap_InitCPred("atomic_to_term", 3, atomic_to_term, 0); - Yap_InitCPred("string_to_term", 3, string_to_term, 0); + /** + * @pred read_term_from_atomic( +Atomic , - T , +Options ) + * + * read a term _T_ stored in text _Atomic_ according to _Options_ + * + * @param _Atomic_ the source may be an atom, string, list of codes, or list + * of + * chars. + * @param _T_ the output term _T_, may be any term + * @param _Options_ read_term/3 options. + * + * @notes Idea originally from SWI-Prolog, but in YAP we separate atomic and + * atom. + * Encoding is fixed in atoms and strings. + */ + static Int read_term_from_atomic(USES_REGS1) + { + Term t1 = Deref(ARG1); + const unsigned char *s; - Yap_InitCPred("fileerrors", 0, fileerrors, SyncPredFlag); - Yap_InitCPred("nofileeleerrors", 0, nofileerrors, SyncPredFlag); - Yap_InitCPred("source_location", 2, source_location, SyncPredFlag); - Yap_InitCPred("$style_checker", 1, style_checker, - SyncPredFlag | HiddenPredFlag); - } + if (IsVarTerm(t1)) + { + Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_atomic/3"); + return(FALSE); + } + else if (!IsAtomicTerm(t1)) + { + Yap_Error(TYPE_ERROR_ATOMIC, t1, "read_term_from_atomic/3"); + return(FALSE); + } + else + { + Term t = Yap_AtomicToString(t1 PASS_REGS); + s = UStringOfTerm(t); + } + Term ctl = add_output(ARG2, ARG3); + + return Yap_UBufferToTerm(s, ctl); + } + + /** + * @pred read_term_from_string( +String , - T , + Options ) + * + * read a term _T_ stored in constant _String_ according to _Options_ + * + * @param _String_ the source _String_ + * @param _T_ the output term _T_, may be any term + * @param _Options_ read_term/3 options. + * + * Idea from SWI-Prolog, in YAP only works with strings + * Check read_term_from_atomic/3 for the general version. + */ + static Int read_term_from_string(USES_REGS1) + { + Term t1 = Deref(ARG1), rc; + const unsigned char *s; + size_t len; + + BACKUP_H() + if (IsVarTerm(t1)) + { + Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); + return(FALSE); + } + else if (!IsStringTerm(t1)) + { + Yap_Error(TYPE_ERROR_STRING, t1, "read_term_from_string/3"); + return(FALSE); + } + else + { + s = UStringOfTerm(t1); + len = strlen_utf8(s); + } + char *ss = (char*)s; + encoding_t enc = ENC_ISO_UTF8; + int sno = Yap_open_buf_read_stream(ss, len, &enc, MEM_BUF_USER, + Yap_LookupAtom(Yap_StrPrefix(ss, 16)), + TermString); + GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; + rc = Yap_read_term(sno, Deref(ARG3), 3); + Yap_CloseStream(sno); + RECOVER_H(); + if (!rc) + return false; + return Yap_unify(rc, ARG2); + } + + static Int atomic_to_term(USES_REGS1) + { + Term t1 = Deref(ARG1); + int l = push_text_stack(); + const unsigned char *s = Yap_TextToUTF8Buffer(t1 PASS_REGS); + Int rc = Yap_UBufferToTerm(s, add_output(ARG2, add_names(ARG3, TermNil))); + + pop_text_stack(l); + return rc; + } + + static Int atom_to_term(USES_REGS1) + { + Term t1 = Deref(ARG1); + + if (IsVarTerm(t1)) + { + Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); + return(FALSE); + } + else if (!IsAtomTerm(t1)) + { + Yap_Error(TYPE_ERROR_ATOM, t1, "read_term_from_atomic/3"); + return(FALSE); + } + else + { + Term t = Yap_AtomicToString(t1 PASS_REGS); + const unsigned char *us = UStringOfTerm(t); + return Yap_UBufferToTerm(us, add_output(ARG2, add_names(ARG3, TermNil))); + } + } + + static Int string_to_term(USES_REGS1) + { + Term t1 = Deref(ARG1); + + if (IsVarTerm(t1)) + { + Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); + return(FALSE); + } + else if (!IsStringTerm(t1)) + { + Yap_Error(TYPE_ERROR_STRING, t1, "read_term_from_string/3"); + return(FALSE); + } + else + { + const unsigned char *us = UStringOfTerm(t1); + return Yap_UBufferToTerm(us, add_output(ARG2, add_names(ARG3, TermNil))); + } + } + + void Yap_InitReadTPreds(void) + { + Yap_InitCPred("read_term", 2, read_term2, SyncPredFlag); + Yap_InitCPred("read_term", 3, read_term, SyncPredFlag); + + Yap_InitCPred("scan_to_list", 2, scan_to_list, SyncPredFlag); + Yap_InitCPred("read", 1, read1, SyncPredFlag); + Yap_InitCPred("read", 2, read2, SyncPredFlag); + Yap_InitCPred("read_clause", 2, read_clause2, SyncPredFlag); + Yap_InitCPred("read_clause", 3, read_clause, 0); + Yap_InitCPred("read_term_from_atom", 3, read_term_from_atom, 0); + Yap_InitCPred("read_term_from_atomic", 3, read_term_from_atomic, 0); + Yap_InitCPred("read_term_from_string", 3, read_term_from_string, 0); + Yap_InitCPred("atom_to_term", 3, atom_to_term, 0); + Yap_InitCPred("atomic_to_term", 3, atomic_to_term, 0); + Yap_InitCPred("string_to_term", 3, string_to_term, 0); + + Yap_InitCPred("fileerrors", 0, fileerrors, SyncPredFlag); + Yap_InitCPred("nofileeleerrors", 0, nofileerrors, SyncPredFlag); + Yap_InitCPred("source_location", 2, source_location, SyncPredFlag); + Yap_InitCPred("$style_checker", 1, style_checker, + SyncPredFlag | HiddenPredFlag); + } diff --git a/pl/messages.yap b/pl/messages.yap index 3ca0470e4..0863ba32c 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -131,10 +131,8 @@ prolog:message_to_string(Event, Message) :- % The first is used for errors and warnings that can be related % to source-location. Note that syntax errors have their own % source-location and should therefore not be handled this way. -compose_message( Term, Level ) --> - [' ~w:'- [Level] - ], - prolog:message(Term), !. +compose_message( Term, _Level ) --> + message(Term), !. compose_message( query(_QueryResult,_), _Level) --> []. compose_message( absolute_file_path(File), _Level) --> @@ -281,13 +279,13 @@ location( error(_,Info), Level, LC ) --> query_exception(prologPredModule, Desc, M), query_exception(prologPredName, Desc, Na), query_exception(prologPredArity, Desc, Ar), - query_exception(prologStack, Desc, St) + query_exception(prologStack, Desc, Stack) }, !, display_consulting( File, Level, Info, LC ), {simplify_pred(M:Na/Ar,FF)}, [ '~a:~d:0 ~a while executing ~q:'-[File, FilePos,Level,FF] ], - ( { Stack == [] } -> [] ; [ nl, '~s'- [] ]). + ( { Stack == [] } -> [] ; [ nl, Stack- [] ]). location( error(_,Info), Level, LC ) --> { '$error_descriptor'(Info, Desc) }, { diff --git a/swi/library/plunit.pl b/swi/library/plunit.pl index bbabffca0..efbc15d6b 100644 --- a/swi/library/plunit.pl +++ b/swi/library/plunit.pl @@ -422,7 +422,7 @@ valid_test_mode(Options0, Options) :- test_mode(true(_)). test_mode(all(_)). test_mode(set(_)). -test_mode(fail). +test_mode(fail(_)). test_mode(throws(_)). @@ -509,7 +509,7 @@ verify_options([H|T], Pred) :- test_option(Option) :- test_set_option(Option), !. test_option(true(_)). -test_option(fail). +test_option(fail(_)). test_option(throws(_)). test_option(all(_)). test_option(set(_)). @@ -889,7 +889,7 @@ run_test_6(Unit, Name, Line, Options, Body, Result) :- option(set(Answer), Options), !, % set(Bindings) nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result). run_test_6(Unit, Name, Line, Options, Body, Result) :- - option(fail, Options), !, % fail + option(fail(true), Options), !, % fail unit_module(Unit, Module), ( setup(Module, test(Unit,Name,Line), Options) -> statistics(runtime, [T0,_]),