/************************************************************************* * * * 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 /* * This file includes the definition of a miscellania of standard predicates * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, * */ #include "Yap.h" #include "YapEval.h" #include "YapFlags.h" #include "YapHeap.h" #include "YapText.h" #include "Yatom.h" #include "yapio.h" #include #if HAVE_STDARG_H #include #endif #if HAVE_CTYPE_H #include #endif #if HAVE_WCTYPE_H #include #endif #if HAVE_SYS_TIME_H #include #endif #if HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_SYS_STAT_H #include #endif #if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__) #include #endif #ifdef HAVE_UNISTD_H #include #endif #if HAVE_STRING_H #include #endif #if HAVE_SIGNAL_H #include #endif #if HAVE_FCNTL_H /* for O_BINARY and O_TEXT in WIN32 */ #include #endif #ifdef _WIN32 #if HAVE_IO_H /* priows */ #include #endif #endif #if !HAVE_STRNCAT #define strncat(X, Y, Z) strcat(X, Y) #endif #if !HAVE_STRNCPY #define strncpy(X, Y, Z) strcpy(X, Y) #endif #if _MSC_VER || defined(__MINGW32__) #if HAVE_SOCKET #include #endif #include #ifndef S_ISDIR #define S_ISDIR(x) (((x) & _S_IFDIR) == _S_IFDIR) #endif #endif #include "iopreds.h" #if _MSC_VER || defined(__MINGW32__) #define SYSTEM_STAT _stat #else #define SYSTEM_STAT stat #endif static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int start, bool code, const char *msg); static void clean_vars(VarEntry *p) { if (p == NULL) return; p->VarAdr = TermNil; clean_vars(p->VarLeft); clean_vars(p->VarRight); } #undef PAR #ifdef O_QUASIQUOTATIONS /** '$qq_open'(+QQRange, -Stream) is det. Opens a quasi-quoted memory range. @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) { PRED_LD 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; 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; } } 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_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)) && #else 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 */ { return PL_unify_nil(_PL_rd->quasi_quotations); } else return TRUE; } #endif /*O_QUASIQUOTATIONS*/ #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("input_closing_blank", booleanFlag, READ_INPUT_CLOSING_BLANK), \ PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \ PAR("singlequoted_string", isatom, READ_SINGLEQUOTED_STRING), \ PAR("doublequoted_string", isatom, READ_DOUBLEQUOTED_STRING), \ PAR("var_prefix", isatom, READ_VAR_PREFIX), \ PAR("allow_variable_name_as_functor", isatom,READ_ALLOW_VARIABLE_NAME_AS_FUNCTOR ), \ PAR("cycles", booleanFlag, READ_CYCLES), \ PAR(NULL, ok, READ_END) #define PAR(x, y, z) z typedef enum open_enum_choices { READ_DEFS() } read_choices_t; #undef PAR #define PAR(x, y, z) \ { x, y, z } static const param_t read_defs[] = { READ_DEFS() }; #undef PAR 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"); } 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)); } } 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)); } } 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)); } } 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); 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; } return ts[0]; } /** @pred scan_to_list( +Stream, -Tokens ) 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 `(`, `)`, `,`, `;` */ static Int scan_to_list(USES_REGS1) { int inp_stream; Term tout; scanner_params params; /* needs to change LOCAL_output_stream for write */ inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); if (inp_stream == -1) { return false; } TokEntry *tok = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(GLOBAL_Stream + inp_stream, ¶ms); UNLOCK(GLOBAL_Stream[inp_stream].streamlock); tout = scanToList(tok, NULL); if (tout == 0) return false; Yap_clean_tokenizer(tok, LOCAL_VarTable, LOCAL_AnonVarTable); return Yap_unify(ARG2, tout); } /** * Syntax Error Handler * * @par tokptr: the sequence of tokens * @par sno: the stream numbet * * Implicit arguments: * + */ 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); TokEntry *tok = LOCAL_tokptr; Int start_line = tok->TokLine; Int err_line = LOCAL_toktide->TokLine; Int startpos = tok->TokPos; Int errpos = LOCAL_toktide->TokPos; Int end_line = GetCurInpLine(GLOBAL_Stream + sno); Int endpos = GetCurInpPos(GLOBAL_Stream + sno); Yap_local.ActiveError->prologConsulting = Yap_Consulting(); Yap_local.ActiveError->parserFirstLine = start_line; Yap_local.ActiveError->parserLine = err_line; Yap_local.ActiveError->parserLastLine = end_line; Yap_local.ActiveError->parserFirstPos = startpos; Yap_local.ActiveError->parserPos = errpos; Yap_local.ActiveError->parserLastPos = endpos; Yap_local.ActiveError->parserFile = RepAtom(AtomOfTerm((GLOBAL_Stream + sno)->user_name))->StrOfAE; Yap_local.ActiveError->parserReadingCode = code; if (GLOBAL_Stream[sno].status & Seekable_Stream_f) { char *o, *o2; if (startpos) startpos--; #if HAVE_FTELLO fseeko(GLOBAL_Stream[sno].file, startpos, SEEK_SET); #else fseek(GLOBAL_Stream[sno].file, startpos, SEEK_SET); #endif if (GLOBAL_Stream[sno].status & Seekable_Stream_f) { err_line = LOCAL_ActiveError->parserLine; errpos = LOCAL_ActiveError->parserPos -1; if (errpos <= startpos) { o = malloc(1); o[0] = '\0'; } else { Int sza = (errpos - startpos) + 1, tot = sza; o = malloc(sza); char *p = o; { ssize_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)); 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; { ssize_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)); 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 || tok == LOCAL_toktide ) { 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 */ Yap_local.ActiveError->culprit = (char*)msg; if (Yap_local.ActiveError->errorMsg) { Yap_local.ActiveError->errorMsg = (char*)msg; Yap_local.ActiveError->errorMsgLen = strlen(Yap_local.ActiveError->errorMsg); } clean_vars(LOCAL_VarTable); clean_vars(LOCAL_AnonVarTable); if (Yap_ExecutionMode == YAP_BOOT_MODE) { fprintf(stderr, "SYNTAX ERROR while booting: "); } 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 { scanner_params scanner; /// scanner interface Term qq, tp, sp, np, vprefix; Term cmod; /// 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 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 && args[READ_OUTPUT].used) { fe->t0 = args[READ_OUTPUT].tvalue; } else { fe->t0 = 0; } if (args && args[READ_MODULE].used) { fe->cmod = args[READ_MODULE].tvalue; } else { fe->cmod = CurrentModule; if (fe->cmod == TermProlog) fe->cmod = PROLOG_MODULE; } if (args && args[READ_BACKQUOTED_STRING].used) { fe->scanner.backquotes = args[READ_BACKQUOTED_STRING].tvalue; } else { fe->scanner.backquotes = getBackQuotesFlag(fe->cmod); } if (args && args[READ_DOUBLEQUOTED_STRING].used) { fe->scanner.doublequotes = args[READ_DOUBLEQUOTED_STRING].tvalue; } else { fe->scanner.doublequotes = getDoubleQuotesFlag(fe->cmod); } if (args && args[READ_SINGLEQUOTED_STRING].used) { fe->scanner.singlequotes = args[READ_SINGLEQUOTED_STRING].tvalue; } else { fe->scanner.singlequotes = getSingleQuotesFlag(fe->cmod); } if (args && args[READ_CHARACTER_ESCAPES].used) { fe->scanner.ce = args[READ_CHARACTER_ESCAPES].tvalue == TermTrue; } else { fe->scanner.ce = Yap_CharacterEscapes(fe->cmod) == TermTrue; } if (args && args[READ_VAR_PREFIX].used) { fe->scanner.vprefix = args[READ_VAR_PREFIX].tvalue == TermTrue; } else { fe->scanner.vprefix = false; } if (args && args[READ_INPUT_CLOSING_BLANK].used) { fe->scanner.get_eot_blank = args[READ_INPUT_CLOSING_BLANK].tvalue == TermTrue; } else { fe->scanner.get_eot_blank = false; } if (args && args[READ_ALLOW_VARIABLE_NAME_AS_FUNCTOR].used) { fe->scanner.vn_asfl = args[READ_ALLOW_VARIABLE_NAME_AS_FUNCTOR].tvalue == TermTrue; } else { fe->scanner.vn_asfl = trueLocalPrologFlag(ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG) == TermTrue; } if (args && args[READ_COMMENTS].used) { fe->scanner.store_comments = args[READ_COMMENTS].tvalue; } else { fe->scanner.store_comments = 0; } if (args && args[READ_QUASI_QUOTATIONS].used) { fe->qq = args[READ_QUASI_QUOTATIONS].tvalue; } else { fe->qq = 0; } if (args && args[READ_COMMENTS].used) { fe->scanner.tcomms = args[READ_COMMENTS].tvalue; } else { fe->scanner.tcomms = 0; } if (args && args[READ_TERM_POSITION].used) { fe->scanner.tposINPUT = args[READ_TERM_POSITION].tvalue; } else { fe->scanner.tposINPUT = 0; } if (args && args[READ_SINGLETONS].used) { fe->sp = args[READ_SINGLETONS].tvalue; } else { fe->sp = 0; } if (args && args[READ_SYNTAX_ERRORS].used) { re->sy = args[READ_SYNTAX_ERRORS].tvalue; } else { re->sy = TermError; // getYapFlag( MkAtomTerm(AtomSyntaxErrors) ); } if (args && args[READ_VARIABLES].used) { fe->vprefix = args[READ_VARIABLES].tvalue; } else { fe->vprefix = 0; } if (args && args[READ_VARIABLE_NAMES].used) { fe->np = args[READ_VARIABLE_NAMES].tvalue; } else { fe->np = 0; } re->seekable = (GLOBAL_Stream[inp_stream].status & Seekable_Stream_f) != 0; if (re->seekable) { re->cpos = GLOBAL_Stream[inp_stream].charcount; } if (args && 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 restore_machine_regs(); /* restart global */ PUSHFET(qq); PUSHFET(tp); PUSHFET(sp); PUSHFET(np); PUSHFET(vprefix); PUSHFET(scanner.tposINPUT); PUSHFET(scanner.tposOUTPUT); 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(vprefix); POPFET(np); POPFET(sp); POPFET(scanner.tposOUTPUT); POPFET(scanner.tposINPUT); POPFET(qq); } static Term get_variables(FEnv *fe, TokEntry *tokstart) { CACHE_REGS Term v; if (fe->vprefix) { 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; } 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); } } } return 0; } 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); } } } return 0; } 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->scanner.tposOUTPUT) { 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; if (fe->t0 && fe->t && !(Yap_unify(fe->t, fe->t0))) return false; if (fe->t && fe->vprefix) 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->scanner.tcomms) vc = LOCAL_Comments; else vc = 0L; fe->scanner.tposOUTPUT = get_stream_position(fe, tokstart); 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->vprefix)) && (!v2 || Yap_unify(v2, fe->np)) && (!v3 || Yap_unify(v3, fe->sp)) && (!fe->scanner.tposINPUT || Yap_unify(fe->scanner.tposINPUT, fe->scanner.tposOUTPUT )) && (!vc ||Yap_unify(vc, fe->scanner.tcomms)); } return true; } static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) { CACHE_REGS Term v_vprefix, v_vnames, v_comments, v_pos; if (fe->t0 && fe->t && !Yap_unify(fe->t, fe->t0)) return false; if (fe->t && fe->vprefix) v_vprefix = get_variables(fe, tokstart); else v_vprefix = 0L; if (fe->t && fe->np) v_vnames = get_varnames(fe, tokstart); else v_vnames = 0L; if (fe->t && fe->reading_clause && trueGlobalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) { warn_singletons(fe, tokstart); } if (fe->t && fe->scanner.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_vprefix || Yap_unify(v_vprefix, fe->vprefix)) && (!v_vnames || Yap_unify(v_vnames, fe->np)) && (!v_pos || Yap_unify(v_pos, fe->tp)) && (!v_comments || Yap_unify(v_comments, fe->scanner.tcomms)); } return true; } 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 scanError(REnv *re, 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 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->vprefix && !Yap_unify(TermNil, fe->vprefix)) fe->t = 0; if (fe->scanner.tposINPUT && !Yap_unify(fe->scanner.tposINPUT, fe->scanner.tposOUTPUT)) fe->t = 0; #if DEBUG if (GLOBAL_Option['p' - 'a' + 1]) { fprintf(stderr, "[ end_of_file %p ]\n", GLOBAL_Stream[inp_stream].name); } #endif 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->scanner.tposOUTPUT = 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; } 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 = Yap_tokenizer(GLOBAL_Stream + sno, &fe->scanner); #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"); } #endif 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); } 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) { #if HAVE_FTELLO fseeko(GLOBAL_Stream[inp_stream].file, re->cpos, 0L); #else fseek(GLOBAL_Stream[inp_stream].file, re->cpos, 0L); #endif } } return YAP_SCANNING; } 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; } 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; Yap_PrintWarning(0); LOCAL_Error_TYPE = YAP_NO_ERROR; if (ParserErrorStyle == TermDec10) { return YAP_START_PARSING; } return YAP_PARSING_FINISHED; } 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; #if EMACS first_char = tokstart->TokPos; #endif /* EMACS */ 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 * * * @arg inp_stream: where we read from * @arg: opts, a list with options * @arg: if called from read_term, arity * called from read_clause, -arity * * @return the term or 0 in case of error. * * Implementation uses a state machine: default is init, scan, parse, complete. * * */ Term Yap_read_term(int sno, Term opts, bool clause) { #if EMACS int emacs_cares = FALSE; #endif int lvl = push_text_stack(); Term rc; yap_error_descriptor_t *new = malloc(sizeof *new); FEnv *fe = Malloc(sizeof *fe); REnv *re = Malloc(sizeof *re); bool err = Yap_pushErrorContext(true, new); parser_state_t state = YAP_START_PARSING; yhandle_t yopts = Yap_InitHandle(opts); while (true) { switch (state) { case YAP_START_PARSING: opts = Yap_GetFromHandle(yopts); state = initparser(opts, fe, re, sno, clause); if (state == YAP_PARSING_FINISHED) { Yap_PopHandle(yopts); 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; rc = fe->t = 0; break; } #if EMACS first_char = tokstart->TokPos; #endif /* EMACS */ rc = fe->t; pop_text_stack(lvl); Yap_popErrorContext(err, true); Yap_PopHandle(yopts); return rc; } } } Yap_PopHandle(yopts); 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); } 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; #undef PAR #define PAR(x, y, z) \ { x, y, z } 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 xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END, DOMAIN_ERROR_READ_OPTION); memset(fe,0,sizeof(*fe)); if (args && args[READ_CLAUSE_OUTPUT].used) { fe->t0 = args[READ_CLAUSE_OUTPUT].tvalue; } else { fe->t0 = 0; } if (args && 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; } fe->scanner.backquotes = getBackQuotesFlag(fe->cmod); fe->scanner.singlequotes = getSingleQuotesFlag(fe->cmod); fe->scanner.doublequotes = getDoubleQuotesFlag(fe->cmod); fe->enc = GLOBAL_Stream[sno].encoding; fe->sp = 0; fe->qq = 0; if (args && args[READ_CLAUSE_OUTPUT].used) { fe->t0 = args[READ_CLAUSE_OUTPUT].tvalue; } else { fe->t0 = 0; } if (args && args[READ_CLAUSE_TERM_POSITION].used) { fe->tp = args[READ_CLAUSE_TERM_POSITION].tvalue; } else { fe->tp = 0; } fe->sp = 0; if (args && args[READ_CLAUSE_COMMENTS].used) { fe->scanner.tcomms = args[READ_CLAUSE_COMMENTS].tvalue; } else { fe->scanner.tcomms = 0L; } if (args && args[READ_CLAUSE_SYNTAX_ERRORS].used) { re->sy = args[READ_CLAUSE_SYNTAX_ERRORS].tvalue; } else { re->sy = TermDec10; } fe->vprefix = 0; if (args && args[READ_CLAUSE_VARIABLE_NAMES].used) { fe->np = args[READ_CLAUSE_VARIABLE_NAMES].tvalue; } else { fe->np = 0; } if (args && args[READ_CLAUSE_VARIABLES].used) { fe->vprefix = args[READ_CLAUSE_VARIABLES].tvalue; } else { fe->vprefix = 0; } fe->scanner.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 * * 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); } /** * @pred read_clause( +Stream, -Clause, ?Opts) is det * * This predicate receives a set of options _OPts_ based on read_term/3, but * specific * to readin clauses. The following options are considered: * * + The `comments` option unifies its argument with the comments in the * term, * represented as strings * + The `process_comments` option calls a hook, it is current ignored by * 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`. * * The next two options are called implicitly: * * + The `module` option is initialized to the current source module, by * 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; /* 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: * - predicate name * - predicate arity * - address for 256 cluses. * * @param ARG1 input stream * @param ARG2 Adress of predicate. * @param ARG3 Term read. * @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, fe->scanner); 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 = fe->tp)) { ip->opc = Yap_opcode(get_atom); ip->y_u.x_c.c = t. ip->y_u.x_c.x = fe->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 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); } out = Yap_read_term(sno, add_output(ARG2, TermNil), false); UNLOCK(GLOBAL_Stream[sno].streamlock); return out; } /** @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). */ 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; } /** @pred fileerrors Switches on the file_errors flag so that in certain error conditions Input/Output predicates will produce an appropriated message and abort. */ static Int fileerrors(USES_REGS1) { return setYapFlag(TermFileErrors, TermTrue); } /** @pred nofileerrors 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 nofileerrors( USES_REGS1) /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ { return setYapFlag(TermFileerrors, TermFalse); } static Int style_checker(USES_REGS1) { Term t = Deref(ARG1); 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); 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); } } } 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); } if (prio != 1200) { ctl = add_priority(bindings, ctl); } 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; } Term ctl = add_output(ARG2, ARG3); return Yap_UBufferToTerm(s, ctl); } /** * @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); } 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(); Term cm = CurrentModule; if (IsApplTerm(t1)) { Term tmod = LOCAL_SourceModule; t1 = Yap_YapStripModule(t1, &tmod); CurrentModule = tmod; } const unsigned char *s = Yap_TextToUTF8Buffer(t1 PASS_REGS); Int rc = Yap_UBufferToTerm(s, add_output(ARG2, add_names(ARG3, TermNil))); CurrentModule = cm; 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); }