From 6a4dbd91ece9ac099e5be92eb66cdcf43ca914b8 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 4 Dec 2016 12:52:42 -0600 Subject: [PATCH] merge text to term routines --- C/c_interface.c | 5 +- C/flags.c | 90 +- C/text.c | 86 +- library/dialect/swi/os/pl-read.c | 2007 ++++++++++++++---------------- library/dialect/swi/os/pl-yap.h | 156 ++- library/maplist.yap | 1 + library/system/CMakeLists.txt | 4 +- os/iopreds.h | 13 +- os/readterm.c | 235 ++-- os/writeterm.c | 4 +- os/yapio.h | 7 +- 11 files changed, 1249 insertions(+), 1359 deletions(-) diff --git a/C/c_interface.c b/C/c_interface.c index be37457d8..7ce0a5f1a 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -1379,8 +1379,9 @@ X_API Term YAP_ReadBuffer(const char *s, Term *tp) { else tv = 0; LOCAL_ErrorMessage = NULL; - while (!(t = Yap_StringToTerm(s, strlen(s) + 1, &LOCAL_encoding, - GLOBAL_MaxPriority, tv))) { + const unsigned char *us = (const unsigned char *)s; + while (!(t = Yap_BufferToTermWithPrioBindings( + us, strlen(s) + 1, TermNil, GLOBAL_MaxPriority, tv))) { if (LOCAL_ErrorMessage) { if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) { if (!Yap_dogc(0, NULL PASS_REGS)) { diff --git a/C/flags.c b/C/flags.c index bf04be85c..fa1b553e6 100644 --- a/C/flags.c +++ b/C/flags.c @@ -51,9 +51,9 @@ static Term stream(Term inp); static bool getenc(Term inp); static bool typein(Term inp); static bool dqf(Term t2); -static bool set_error_stream( Term inp ); -static bool set_input_stream( Term inp ); -static bool set_output_stream( Term inp ); +static bool set_error_stream(Term inp); +static bool set_input_stream(Term inp); +static bool set_output_stream(Term inp); static void newFlag(Term fl, Term val); static Int current_prolog_flag(USES_REGS1); @@ -173,41 +173,38 @@ static Term isaccess(Term inp) { } static Term stream(Term inp) { - if ( IsVarTerm(inp) ) + if (IsVarTerm(inp)) return inp; - if (Yap_CheckStream( inp, Input_Stream_f | Output_Stream_f | - Append_Stream_f | Socket_Stream_f, "yap_flag/3" ) >= 0) + if (Yap_CheckStream(inp, Input_Stream_f | Output_Stream_f | Append_Stream_f | + Socket_Stream_f, + "yap_flag/3") >= 0) return inp; return 0; - } -static bool -set_error_stream( Term inp ) { - if( IsVarTerm(inp) ) - return Yap_unify( inp, Yap_StreamUserName( LOCAL_c_error_stream ) ); - LOCAL_c_error_stream = Yap_CheckStream( inp, Output_Stream_f | - Append_Stream_f | Socket_Stream_f, "yap_flag/3" ); - return true; -} - -static bool -set_input_stream( Term inp ) { - if( IsVarTerm(inp) ) - return Yap_unify( inp, Yap_StreamUserName( LOCAL_c_input_stream ) ); - LOCAL_c_input_stream = Yap_CheckStream( inp, Input_Stream_f | Socket_Stream_f, "yap_flag/3" ); +static bool set_error_stream(Term inp) { + if (IsVarTerm(inp)) + return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_error_stream)); + LOCAL_c_error_stream = Yap_CheckStream( + inp, Output_Stream_f | Append_Stream_f | Socket_Stream_f, "yap_flag/3"); return true; } -static bool -set_output_stream( Term inp ) { - if( IsVarTerm(inp) ) - return Yap_unify( inp, Yap_StreamUserName( LOCAL_c_output_stream ) ); - LOCAL_c_output_stream = Yap_CheckStream( inp, Output_Stream_f | - Append_Stream_f | Socket_Stream_f, "yap_flag/3" ); +static bool set_input_stream(Term inp) { + if (IsVarTerm(inp)) + return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_input_stream)); + LOCAL_c_input_stream = + Yap_CheckStream(inp, Input_Stream_f | Socket_Stream_f, "yap_flag/3"); return true; } +static bool set_output_stream(Term inp) { + if (IsVarTerm(inp)) + return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_output_stream)); + LOCAL_c_output_stream = Yap_CheckStream( + inp, Output_Stream_f | Append_Stream_f | Socket_Stream_f, "yap_flag/3"); + return true; +} static Term isground(Term inp) { return Yap_IsGroundTerm(inp) ? inp : TermZERO; @@ -1182,24 +1179,26 @@ static Int source_mode(USES_REGS1) { static bool setInitialValue(bool bootstrap, flag_func f, const char *s, flag_term *tarr) { errno = 0; + const char *ss = (const char *)s; if (f == booleanFlag) { if (!bootstrap) { return 0; } - if (!strcmp(s, "true")) { + const char *ss = (const char *)s; + if (!strcmp(ss, "true")) { tarr->at = TermTrue; return true; } - if (!strcmp(s, "false")) { + if (!strcmp(ss, "false")) { tarr->at = TermFalse; return true; } - if (!strcmp(s, "on")) { + if (!strcmp(ss, "on")) { tarr->at = TermTrue; return true; } - if (!strcmp(s, "off")) { + if (!strcmp(ss, "off")) { tarr->at = TermFalse; return true; } @@ -1210,7 +1209,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, if (!bootstrap) { return 0; } - UInt r = strtoul(s, NULL, 10); + UInt r = strtoul(ss, NULL, 10); Term t; if (errno) { Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, @@ -1229,27 +1228,27 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, if (!bootstrap) { return false; } - if (!strcmp(s, "INT_MAX")) { + if (!strcmp(ss, "INT_MAX")) { tarr->at = MkIntTerm(Int_MAX); return true; } - if (!strcmp(s, "MAX_THREADS")) { + if (!strcmp(ss, "MAX_THREADS")) { tarr->at = MkIntTerm(MAX_THREADS); return true; } - if (!strcmp(s, "MAX_WORKERS")) { + if (!strcmp(ss, "MAX_WORKERS")) { tarr->at = MkIntTerm(MAX_WORKERS); return true; } - if (!strcmp(s, "INT_MIN")) { + if (!strcmp(ss, "INT_MIN")) { tarr->at = MkIntTerm(Int_MIN); return true; } - if (!strcmp(s, "YAP_NUMERIC_VERSION")) { + if (!strcmp(ss, "YAP_NUMERIC_VERSION")) { tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION)); return true; } - if (!strcmp(s, "YAP_NUMERIC_VERSION")) { + if (!strcmp(ss, "YAP_NUMERIC_VERSION")) { tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION)); return true; } @@ -1297,7 +1296,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, return true; } } - } else if (strcmp(s, "@boot") == 0) { + } else if (strcmp(ss, "@boot") == 0) { if (bootstrap) { return true; } @@ -1317,9 +1316,9 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, return false; } CACHE_REGS - encoding_t encoding = ENC_ISO_UTF8; - t0 = - Yap_StringToTerm(s, strlen(s) + 1, &encoding, GLOBAL_MaxPriority, 0L); + const unsigned char *us = (const unsigned char *)s; + t0 = Yap_BufferToTermWithPrioBindings(us, strlen(s) + 1, TermNil, + GLOBAL_MaxPriority, 0L); if (!t0) return false; if (IsAtomTerm(t0) || IsIntTerm(t0)) { @@ -1570,7 +1569,7 @@ static Int do_create_prolog_flag(USES_REGS1) { fv->type = isground; } break; case PROLOG_FLAG_PROPERTY_SCOPE: - free(args); + free(args); return false; case PROLOG_FLAG_PROPERTY_END: break; @@ -1621,8 +1620,9 @@ void Yap_InitFlags(bool bootstrap) { while (f->name != NULL) { bool itf = setInitialValue(bootstrap, f->def, f->init, LOCAL_Flags + LOCAL_flagCount); - // Term itf = Yap_StringToTerm(f->init, strlen(f->init)+1, - // EBC_ISO_UTF8, GLOBAL_MaxPriority, &tp); + // Term itf = Yap_BufferToTermWithPrioBindings(f->init, + // strlen(f->init)+1, + // LOBAL_MaxPriority, &tp); if (itf) { initFlag(f, LOCAL_flagCount, false); } diff --git a/C/text.c b/C/text.c index 66b83dbea..e67a6a27d 100644 --- a/C/text.c +++ b/C/text.c @@ -51,9 +51,7 @@ typedef struct TextBuffer_manager { int lvl; } text_buffer_t; -int push_text_stack(USES_REGS1) { - return LOCAL_TextBuffer->lvl++; -} +int push_text_stack(USES_REGS1) { return LOCAL_TextBuffer->lvl++; } int pop_text_stack(int i) { int lvl = LOCAL_TextBuffer->lvl; @@ -81,9 +79,9 @@ void *Malloc(size_t sz USES_REGS) { sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL); struct mblock *o = malloc(sz); o->prev = LOCAL_TextBuffer->last[lvl]; - if (o->prev) { - o->prev->next = o; - } + if (o->prev) { + o->prev->next = o; + } if (LOCAL_TextBuffer->first[lvl]) { LOCAL_TextBuffer->last[lvl] = o; } else { @@ -206,7 +204,7 @@ static Int SkipListCodes(unsigned char **bufp, Term *l, Term **tailp, (*atoms)++; if (*atoms < length) { *tailp = l; - return -REPRESENTATION_ERROR_CHARACTER_CODE; + return -REPRESENTATION_ERROR_CHARACTER_CODE; } else { AtomEntry *ae = RepAtom(AtomOfTerm(hd)); if ((ae->StrOfAE)[1] != '\0') { @@ -386,35 +384,32 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) { // this is a term, extract to a buffer, and representation is wide // Yap_DebugPlWriteln(inp->val.t); Atom at = AtomOfTerm(inp->val.t); - if (lengp) - *lengp = strlen_utf8(at->UStrOfAE); + if (lengp) + *lengp = strlen_utf8(at->UStrOfAE); return at->UStrOfAE; } if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) { // this is a term, extract to a buffer, and representation is wide // Yap_DebugPlWriteln(inp->val.t); - if (lengp) - *lengp = strlen_utf8(UStringOfTerm(inp->val.t)); - return (unsigned char *)UStringOfTerm(inp->val.t); + if (lengp) + *lengp = strlen_utf8(UStringOfTerm(inp->val.t)); + return (unsigned char *)UStringOfTerm(inp->val.t); } if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) == (YAP_STRING_CODES | YAP_STRING_ATOMS)) && IsPairOrNilTerm(inp->val.t)) { // Yap_DebugPlWriteln(inp->val.t); - return - Yap_ListToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS); + return Yap_ListToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS); // this is a term, extract to a sfer, and representation is wide } if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) { // Yap_DebugPlWriteln(inp->val.t); - return Yap_ListOfCodesToBuffer(s0, inp->val.t, inp, &wide, - lengp PASS_REGS); + return Yap_ListOfCodesToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS); // this is a term, extract to a sfer, and representation is wide } if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) { // Yap_DebugPlWriteln(inp->val.t); - return Yap_ListOfAtomsToBuffer(s0, inp->val.t, inp, &wide, - lengp PASS_REGS); + return Yap_ListOfAtomsToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS); // this is a term, extract to a buffer, and representation is wide } if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) { @@ -434,17 +429,21 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) { } if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) { char *s; - size_t sz = 1024; + size_t sz = 1024; // Yap_DebugPlWriteln(inp->val.t); - if (s0) - { s = (char *)s0; sz = strlen(s);} - else + if (s0) { + s = (char *)s0; + sz = strlen(s); + } else s = Malloc(sz); - if (!s) - AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char); + if (!s) + AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char); while (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, sz - 1)) { - if (s0) { s = Malloc(sz=1024); s0 = NULL; } - else s = Realloc(s, sz+1024); + if (s0) { + s = Malloc(sz = 1024); + s0 = NULL; + } else + s = Realloc(s, sz + 1024); } *lengp = strlen(s); return inp->val.uc = (unsigned char *)s; @@ -634,11 +633,11 @@ static Term write_codes(void *s0, seq_tv_t *out, size_t leng USES_REGS) { static Atom write_atom(void *s0, seq_tv_t *out, size_t leng USES_REGS) { unsigned char *s = s0; int32_t ch; - if ( leng == 0) { - return Yap_LookupAtom(""); - } - if ( strlen_utf8(s0) <= leng) { - return Yap_LookupAtom(s0); + if (leng == 0) { + return Yap_LookupAtom(""); + } + if (strlen_utf8(s0) <= leng) { + return Yap_LookupAtom(s0); } else { size_t n = get_utf8(s, 1, &ch); unsigned char *buf = Malloc(n + 1); @@ -720,18 +719,18 @@ static size_t write_length(const unsigned char *s0, seq_tv_t *out, return leng; } -static Term write_number(unsigned char *s, seq_tv_t *out, int size, bool error_on USES_REGS) { +static Term write_number(unsigned char *s, seq_tv_t *out, int size, + bool error_on USES_REGS) { Term t; int i = push_text_stack(); t = Yap_StringToNumberTerm((char *)s, &out->enc, error_on); - pop_text_stack(i); - return t; + pop_text_stack(i); + return t; } static Term string_to_term(void *s, seq_tv_t *out, size_t leng USES_REGS) { Term o; - o = out->val.t = - Yap_StringToTerm(s, strlen(s) + 1, &out->enc, GLOBAL_MaxPriority, 0L); + o = out->val.t = Yap_BufferToTerm(s, strlen(s) + 1, TermNil); return o; } @@ -746,7 +745,8 @@ bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) { return out->val.t != 0; } if (out->type & (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) { - if ((out->val.t = write_number(inp, out, leng,!(out->type & YAP_STRING_ATOM) PASS_REGS)) != 0L) { + if ((out->val.t = write_number( + inp, out, leng, !(out->type & YAP_STRING_ATOM)PASS_REGS)) != 0L) { // Yap_DebugPlWriteln(out->val.t); return true; @@ -800,7 +800,7 @@ bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) { out->val.t = write_number(inp, out, leng, true PASS_REGS); // Yap_DebugPlWriteln(out->val.t); return out->val.t != 0; - default: { return true ; } + default: { return true; } } return false; } @@ -917,9 +917,9 @@ static unsigned char *concat(int n, void *sv[] USES_REGS) { buf = Malloc(room + 1); buf0 = buf; for (i = 0; i < n; i++) { -#if _WIN32 || defined( __ANDROID__ ) +#if _WIN32 || defined(__ANDROID__) strcpy(buf, sv[i]); - buf = (char*)buf + strlen(buf); + buf = (char *)buf + strlen(buf); #else buf = stpcpy(buf, sv[i]); #endif @@ -1021,14 +1021,14 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, next = 0; else next = cuts[i - 1]; - if (i>0 && cuts[i] == 0) + if (i > 0 && cuts[i] == 0) break; void *bufi = slice(next, cuts[i], buf PASS_REGS); if (!write_Text(bufi, outv + i, cuts[i] - next PASS_REGS)) { return false; } } - + return true; } @@ -1085,7 +1085,7 @@ const char *Yap_TextTermToText(Term t, char *buf, size_t len, encoding_t enc) { const char *Yap_PredIndicatorToUTF8String(PredEntry *ap) { CACHE_REGS Atom at; - arity_t arity = 0; + arity_t arity = 0; Functor f; char *s, *smax, *s0; s = s0 = malloc(1024); diff --git a/library/dialect/swi/os/pl-read.c b/library/dialect/swi/os/pl-read.c index 1af2d57aa..45381df79 100644 --- a/library/dialect/swi/os/pl-read.c +++ b/library/dialect/swi/os/pl-read.c @@ -1,11 +1,11 @@ -#include "pl-incl.h" #include "pl-ctype.h" -#include "pl-utf8.h" #include "pl-dtoa.h" -#include "pl-umap.c" /* Unicode map */ +#include "pl-incl.h" +#include "pl-umap.c" /* Unicode map */ +#include "pl-utf8.h" -#include "pl-read.h" /* read structure */ +#include "pl-read.h" /* read structure */ /** * @defgroup ReadTerm Read Term from Streams @@ -13,17 +13,13 @@ * @{ */ -static bool -isStringStream(IOSTREAM *s) -{ return s->functions == &Sstringfunctions; +static bool isStringStream(IOSTREAM *s) { + return s->functions == &Sstringfunctions; } - - -void -init_read_data(ReadData _PL_rd, IOSTREAM *in ARG_LD) -{ CACHE_REGS - memset(_PL_rd, 0, sizeof(*_PL_rd)); /* optimise! */ +void init_read_data(ReadData _PL_rd, IOSTREAM *in ARG_LD) { + CACHE_REGS + memset(_PL_rd, 0, sizeof(*_PL_rd)); /* optimise! */ _PL_rd->magic = RD_MAGIC; _PL_rd->varnames = 0; @@ -32,106 +28,87 @@ init_read_data(ReadData _PL_rd, IOSTREAM *in ARG_LD) _PL_rd->stream = in; _PL_rd->has_exception = 0; _PL_rd->module = MODULE_parse; - _PL_rd->flags = _PL_rd->module->flags; /* change for options! */ + _PL_rd->flags = _PL_rd->module->flags; /* change for options! */ _PL_rd->styleCheck = LOCAL_debugstatus.styleCheck; _PL_rd->on_error = AtomError; _PL_rd->backquoted_string = truePrologFlag(PLFLAG_BACKQUOTED_STRING); } -void -free_read_data(ReadData _PL_rd) -{ -} +void free_read_data(ReadData _PL_rd) {} -static int -read_term(term_t t, ReadData _PL_rd ARG_LD) -{ +static int read_term(term_t t, ReadData _PL_rd ARG_LD) { return Yap_read_term(t, rb.stream, _PL_rd); } +static void addUTF8Buffer(Buffer b, int c); -static void addUTF8Buffer(Buffer b, int c); +static void addUTF8Buffer(Buffer b, int c) { + if (c >= 0x80) { + char buf[6]; + char *p, *end; -static void -addUTF8Buffer(Buffer b, int c) -{ if ( c >= 0x80 ) - { char buf[6]; - char *p, *end; - - end = utf8_put_char(buf, c); - for(p=buf; p= UC, U_ID_CONTINUE) -#define PlSymbolW(c) CharTypeW(c, == SY, U_SYMBOL) -#define PlPunctW(c) CharTypeW(c, == PU, 0) -#define PlSoloW(c) CharTypeW(c, == SO, U_OTHER) -#define PlInvalidW(c) (uflagsW(c) == 0) +#define PlBlankW(c) CharTypeW(c, == SP, U_SEPARATOR) +#define PlUpperW(c) CharTypeW(c, == UC, U_UPPERCASE) +#define PlIdStartW(c) \ + (c <= 0xff ? (isLower(c) || isUpper(c) || c == '_') : uflagsW(c) & U_ID_START) +#define PlIdContW(c) CharTypeW(c, >= UC, U_ID_CONTINUE) +#define PlSymbolW(c) CharTypeW(c, == SY, U_SYMBOL) +#define PlPunctW(c) CharTypeW(c, == PU, 0) +#define PlSoloW(c) CharTypeW(c, == SO, U_OTHER) +#define PlInvalidW(c) (uflagsW(c) == 0) -int -f_is_prolog_var_start(wint_t c) -{ return PlIdStartW(c) && (PlUpperW(c) || c == '_'); +int f_is_prolog_var_start(wint_t c) { + return PlIdStartW(c) && (PlUpperW(c) || c == '_'); } -int -f_is_prolog_atom_start(wint_t c) -{ return PlIdStartW(c) != 0; +int f_is_prolog_atom_start(wint_t c) { return PlIdStartW(c) != 0; } + +int f_is_prolog_identifier_continue(wint_t c) { + return PlIdContW(c) || c == '_'; } -int -f_is_prolog_identifier_continue(wint_t c) -{ return PlIdContW(c) || c == '_'; -} +int f_is_prolog_symbol(wint_t c) { return PlSymbolW(c) != 0; } -int -f_is_prolog_symbol(wint_t c) -{ return PlSymbolW(c) != 0; -} - -int -unicode_separator(pl_wchar_t c) -{ return PlBlankW(c); -} +int unicode_separator(pl_wchar_t c) { return PlBlankW(c); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FALSE return false TRUE redo - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -static int -reportReadError(ReadData rd) -{ if ( rd->on_error == ATOM_error ) +static int reportReadError(ReadData rd) { + if (rd->on_error == ATOM_error) return PL_raise_exception(rd->exception); - if ( rd->on_error != ATOM_quiet ) + if (rd->on_error != ATOM_quiet) printMessage(ATOM_error, PL_TERM, rd->exception); PL_clear_exception(); - if ( rd->on_error == ATOM_dec10 ) + if (rd->on_error == ATOM_dec10) return TRUE; return FALSE; } - /* static int */ -/* reportSingletons(ReadData rd, singletons, Atom amod, Atom aname, UInt arity) */ +/* reportSingletons(ReadData rd, singletons, Atom amod, Atom aname, UInt arity) + */ /* { */ /* printMessage(ATOM_warning, PL_FUNCTOR_CHARS, */ /* "singletons", 2, */ @@ -144,12 +121,10 @@ reportReadError(ReadData rd) /* return FALSE; */ /* } */ - /******************************** * RAW READING * *********************************/ - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Scan the input, give prompts when necessary and return a char * holding a stripped version of the next term. Contiguous white space is mapped @@ -159,126 +134,114 @@ reportReadError(ReadData rd) (char *) NULL is returned on a syntax error. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -#define syntaxError(what, rd) { errorWarning(what, 0, rd); fail; } +#define syntaxError(what, rd) \ + { \ + errorWarning(what, 0, rd); \ + fail; \ + } -static term_t -makeErrorTerm(const char *id_str, term_t id_term, ReadData _PL_rd) -{ GET_LD - term_t ex, loc=0; /* keep compiler happy */ +static term_t makeErrorTerm(const char *id_str, term_t id_term, + ReadData _PL_rd) { + GET_LD + term_t ex, loc = 0; /* keep compiler happy */ unsigned char const *s, *ll = NULL; int rc = TRUE; - if ( !(ex = PL_new_term_ref()) || - !(loc = PL_new_term_ref()) ) + if (!(ex = PL_new_term_ref()) || !(loc = PL_new_term_ref())) rc = FALSE; - if ( rc && !id_term ) - { if ( !(id_term=PL_new_term_ref()) || - !PL_put_atom_chars(id_term, id_str) ) - rc = FALSE; - } + if (rc && !id_term) { + if (!(id_term = PL_new_term_ref()) || !PL_put_atom_chars(id_term, id_str)) + rc = FALSE; + } - if ( rc ) - rc = PL_unify_term(ex, - PL_FUNCTOR, FUNCTOR_error2, - PL_FUNCTOR, FUNCTOR_syntax_error1, - PL_TERM, id_term, - PL_TERM, loc); + if (rc) + rc = PL_unify_term(ex, PL_FUNCTOR, FUNCTOR_error2, PL_FUNCTOR, + FUNCTOR_syntax_error1, PL_TERM, id_term, PL_TERM, loc); source_char_no += last_token_start - rdbase; - for(s=rdbase; s 0) + lp--; + break; + case '\t': + lp |= 7; + default: + lp++; + } } - if ( ll ) - { int lp = 0; + source_line_pos = lp; + } - for(s = ll; s 0 ) lp--; - break; - case '\t': - lp |= 7; - default: - lp++; - } - } + if (rc) { + if (ReadingSource) /* reading a file */ + { + rc = PL_unify_term(loc, PL_FUNCTOR, FUNCTOR_file4, PL_ATOM, + source_file_name, PL_INT, source_line_no, PL_INT, + source_line_pos, PL_INT64, source_char_no); + } else if (isStringStream(rb.stream)) { + size_t pos; - source_line_pos = lp; - } - - if ( rc ) - { if ( ReadingSource ) /* reading a file */ - { rc = PL_unify_term(loc, - PL_FUNCTOR, FUNCTOR_file4, - PL_ATOM, source_file_name, - PL_INT, source_line_no, - PL_INT, source_line_pos, - PL_INT64, source_char_no); - } else if ( isStringStream(rb.stream) ) - { size_t pos; - - pos = utf8_strlen((char *)rdbase, last_token_start-rdbase); - - rc = PL_unify_term(loc, - PL_FUNCTOR, FUNCTOR_string2, - PL_UTF8_STRING, rdbase, - PL_INT, (int)pos); - } else /* any stream */ - { term_t stream; - - if ( !(stream=PL_new_term_ref()) || - !PL_unify_stream_or_alias(stream, rb.stream) || - !PL_unify_term(loc, - PL_FUNCTOR, FUNCTOR_stream4, - PL_TERM, stream, - PL_INT, source_line_no, - PL_INT, source_line_pos, - PL_INT64, source_char_no) ) - rc = FALSE; - } + pos = utf8_strlen((char *)rdbase, last_token_start - rdbase); + + rc = PL_unify_term(loc, PL_FUNCTOR, FUNCTOR_string2, PL_UTF8_STRING, + rdbase, PL_INT, (int)pos); + } else /* any stream */ + { + term_t stream; + + if (!(stream = PL_new_term_ref()) || + !PL_unify_stream_or_alias(stream, rb.stream) || + !PL_unify_term(loc, PL_FUNCTOR, FUNCTOR_stream4, PL_TERM, stream, + PL_INT, source_line_no, PL_INT, source_line_pos, + PL_INT64, source_char_no)) + rc = FALSE; } + } return (rc ? ex : (term_t)0); } +static bool errorWarning(const char *id_str, term_t id_term, ReadData _PL_rd) { + GET_LD + term_t ex; - -static bool -errorWarning(const char *id_str, term_t id_term, ReadData _PL_rd) -{ GET_LD - term_t ex; - - LD->exception.processing = TRUE; /* allow using spare stack */ + LD->exception.processing = TRUE; /* allow using spare stack */ ex = makeErrorTerm(id_str, id_term, _PL_rd); - if ( _PL_rd ) - { _PL_rd->has_exception = TRUE; - if ( ex ) - PL_put_term(_PL_rd->exception, ex); - else - PL_put_term(_PL_rd->exception, exception_term); - } else - { if ( ex ) - PL_raise_exception(ex); - } + if (_PL_rd) { + _PL_rd->has_exception = TRUE; + if (ex) + PL_put_term(_PL_rd->exception, ex); + else + PL_put_term(_PL_rd->exception, exception_term); + } else { + if (ex) + PL_raise_exception(ex); + } fail; } - - -static void -clearBuffer(ReadData _PL_rd) -{ if (rb.size == 0) - { rb.base = rb.fast; - rb.size = sizeof(rb.fast); - } +static void clearBuffer(ReadData _PL_rd) { + if (rb.size == 0) { + rb.base = rb.fast; + rb.size = sizeof(rb.fast); + } rb.end = rb.base + rb.size; rdbase = rb.here = rb.base; @@ -286,91 +249,78 @@ clearBuffer(ReadData _PL_rd) _PL_rd->posi = 0; } +static void growToBuffer(int c, ReadData _PL_rd) { + if (rb.base == rb.fast) /* intptr_t clause: jump to use malloc() */ + { + rb.base = PL_malloc(FASTBUFFERSIZE * 2); + memcpy(rb.base, rb.fast, FASTBUFFERSIZE); + } else + rb.base = PL_realloc(rb.base, rb.size * 2); -static void -growToBuffer(int c, ReadData _PL_rd) -{ if ( rb.base == rb.fast ) /* intptr_t clause: jump to use malloc() */ - { rb.base = PL_malloc(FASTBUFFERSIZE * 2); - memcpy(rb.base, rb.fast, FASTBUFFERSIZE); - } else - rb.base = PL_realloc(rb.base, rb.size*2); - - DEBUG(8, Sdprintf("Reallocated read buffer at %ld\n", (intptr_t) rb.base)); + DEBUG(8, Sdprintf("Reallocated read buffer at %ld\n", (intptr_t)rb.base)); _PL_rd->posp = rdbase = rb.base; rb.here = rb.base + rb.size; rb.size *= 2; - rb.end = rb.base + rb.size; + rb.end = rb.base + rb.size; _PL_rd->posi = 0; *rb.here++ = c; } +static inline void addByteToBuffer(int c, ReadData _PL_rd) { + c &= 0xff; -static inline void -addByteToBuffer(int c, ReadData _PL_rd) -{ c &= 0xff; - - if ( rb.here >= rb.end ) + if (rb.here >= rb.end) growToBuffer(c, _PL_rd); else *rb.here++ = c; } +static void addToBuffer(int c, ReadData _PL_rd) { + if (c <= 0x7f) { + addByteToBuffer(c, _PL_rd); + } else { + char buf[10]; + char *s, *e; -static void -addToBuffer(int c, ReadData _PL_rd) -{ if ( c <= 0x7f ) - { addByteToBuffer(c, _PL_rd); - } else - { char buf[10]; - char *s, *e; - - e = utf8_put_char(buf, c); - for(s=buf; schar_conversion_table || c < 0 || c >= 256 ) + if (!_PL_rd->char_conversion_table || c < 0 || c >= 256) return c; return _PL_rd->char_conversion_table[c]; } - -#define getchr() getchr__(_PL_rd) +#define getchr() getchr__(_PL_rd) #define getchrq() Sgetcode(rb.stream) -#define ensure_space(c) { if ( something_read && \ - (c == '\n' || !isBlank(rb.here[-1])) ) \ - addToBuffer(c, _PL_rd); \ +#define ensure_space(c) \ + { \ + if (something_read && (c == '\n' || !isBlank(rb.here[-1]))) \ + addToBuffer(c, _PL_rd); \ } -#define set_start_line { if ( !something_read ) \ - { setCurrentSourceLocation(_PL_rd PASS_LD); \ - something_read++; \ - } \ +#define set_start_line \ + { \ + if (!something_read) { \ + setCurrentSourceLocation(_PL_rd PASS_LD); \ + something_read++; \ + } \ } - - - - #ifdef O_QUASIQUOTATIONS /** '$qq_open'(+QQRange, -Stream) is det. @@ -381,546 +331,541 @@ getchr__(ReadData _PL_rd) reflects the location in the real file. */ -static -PRED_IMPL("$qq_open", 2, qq_open, 0) -{ PRED_LD +static PRED_IMPL("$qq_open", 2, qq_open, 0) { + PRED_LD - if ( PL_is_functor(A1, FUNCTOR_dquasi_quotation3) ) - { void *ptr; - char * start; - size_t len; - term_t arg = PL_new_term_ref(); - IOSTREAM *s; + if (PL_is_functor(A1, FUNCTOR_dquasi_quotation3)) { + void *ptr; + char *start; + size_t len; + term_t arg = PL_new_term_ref(); + IOSTREAM *s; - if ( PL_get_arg(1, A1, arg) && PL_get_pointer_ex(arg, &ptr) && - PL_get_arg(2, A1, arg) && PL_get_intptr(arg, (intptr_t *)&start) && - PL_get_arg(3, A1, arg) && PL_get_intptr(arg, (intptr_t *)&len) ) - { //source_location pos; - if ( (s=Sopenmem(&start, &len, "r")) ) - s->encoding = ENC_UTF8; + if (PL_get_arg(1, A1, arg) && PL_get_pointer_ex(arg, &ptr) && + PL_get_arg(2, A1, arg) && PL_get_intptr(arg, (intptr_t *)&start) && + PL_get_arg(3, A1, arg) && + PL_get_intptr(arg, (intptr_t *)&len)) { // source_location pos; + if ((s = Sopenmem(&start, &len, "r"))) + s->encoding = ENC_UTF8; - return PL_unify_stream(A2, s); - } - } else - PL_type_error("read_context", A1); + return PL_unify_stream(A2, s); + } + } else + PL_type_error("read_context", A1); 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 */ - { return PL_unify_nil(_PL_rd->quasi_quotations); + 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 rawSyntaxError(what) { addToBuffer(EOS, _PL_rd); \ - rdbase = rb.base, last_token_start = rb.here-1; \ - syntaxError(what, _PL_rd); \ +#define rawSyntaxError(what) \ + { \ + addToBuffer(EOS, _PL_rd); \ + rdbase = rb.base, last_token_start = rb.here - 1; \ + syntaxError(what, _PL_rd); \ } -static int -raw_read_quoted(int q, ReadData _PL_rd) -{ int newlines = 0; +static int raw_read_quoted(int q, ReadData _PL_rd) { + int newlines = 0; int c; addToBuffer(q, _PL_rd); - while((c=getchrq()) != EOF && c != q) - { if ( c == '\\' && DO_CHARESCAPE ) - { int base; - addToBuffer(c, _PL_rd); - - switch( (c=getchrq()) ) - { case EOF: - goto eofinstr; - case 'u': /* \uXXXX */ - case 'U': /* \UXXXXXXXX */ - addToBuffer(c, _PL_rd); - continue; - case 'x': /* \xNN\ */ - addToBuffer(c, _PL_rd); - c = getchrq(); - if ( c == EOF ) - goto eofinstr; - if ( digitValue(16, c) >= 0 ) - { base = 16; - addToBuffer(c, _PL_rd); - - xdigits: - c = getchrq(); - while( digitValue(base, c) >= 0 ) - { addToBuffer(c, _PL_rd); - c = getchrq(); - } - } - if ( c == EOF ) - goto eofinstr; - addToBuffer(c, _PL_rd); - if ( c == q ) - return TRUE; - continue; - default: - addToBuffer(c, _PL_rd); - if ( digitValue(8, c) >= 0 ) /* \NNN\ */ - { base = 8; - goto xdigits; - } else if ( c == '\n' ) /* \ */ - { c = getchrq(); - if ( c == EOF ) - goto eofinstr; - addToBuffer(c, _PL_rd); - if ( c == q ) - return TRUE; - } - continue; /* \symbolic-control-char */ - } - } else if (c == '\n' && - newlines++ > MAXNEWLINES && - (_PL_rd->styleCheck & LONGATOM_CHECK)) - { rawSyntaxError("long_string"); - } + while ((c = getchrq()) != EOF && c != q) { + if (c == '\\' && DO_CHARESCAPE) { + int base; addToBuffer(c, _PL_rd); + + switch ((c = getchrq())) { + case EOF: + goto eofinstr; + case 'u': /* \uXXXX */ + case 'U': /* \UXXXXXXXX */ + addToBuffer(c, _PL_rd); + continue; + case 'x': /* \xNN\ */ + addToBuffer(c, _PL_rd); + c = getchrq(); + if (c == EOF) + goto eofinstr; + if (digitValue(16, c) >= 0) { + base = 16; + addToBuffer(c, _PL_rd); + + xdigits: + c = getchrq(); + while (digitValue(base, c) >= 0) { + addToBuffer(c, _PL_rd); + c = getchrq(); + } + } + if (c == EOF) + goto eofinstr; + addToBuffer(c, _PL_rd); + if (c == q) + return TRUE; + continue; + default: + addToBuffer(c, _PL_rd); + if (digitValue(8, c) >= 0) /* \NNN\ */ + { + base = 8; + goto xdigits; + } else if (c == '\n') /* \ */ + { + c = getchrq(); + if (c == EOF) + goto eofinstr; + addToBuffer(c, _PL_rd); + if (c == q) + return TRUE; + } + continue; /* \symbolic-control-char */ + } + } else if (c == '\n' && newlines++ > MAXNEWLINES && + (_PL_rd->styleCheck & LONGATOM_CHECK)) { + rawSyntaxError("long_string"); } - if (c == EOF) - { eofinstr: - rawSyntaxError("end_of_file_in_string"); - } + addToBuffer(c, _PL_rd); + } + if (c == EOF) { + eofinstr: + rawSyntaxError("end_of_file_in_string"); + } addToBuffer(c, _PL_rd); return TRUE; } - -static int -add_comment(Buffer b, IOPOS *pos, ReadData _PL_rd ARG_LD) -{ term_t head = PL_new_term_ref(); +static int add_comment(Buffer b, IOPOS *pos, ReadData _PL_rd ARG_LD) { + term_t head = PL_new_term_ref(); assert(_PL_rd->comments); - if ( !PL_unify_list(_PL_rd->comments, head, _PL_rd->comments) ) + if (!PL_unify_list(_PL_rd->comments, head, _PL_rd->comments)) return FALSE; - if ( pos ) - { if ( !PL_unify_term(head, - PL_FUNCTOR, FUNCTOR_minus2, - PL_FUNCTOR, FUNCTOR_stream_position4, - PL_INT64, pos->charno, - PL_INT, pos->lineno, - PL_INT, pos->linepos, - PL_INT, 0, - PL_UTF8_STRING, baseBuffer(b, char)) ) - return FALSE; - } else - { if ( !PL_unify_term(head, - PL_FUNCTOR, FUNCTOR_minus2, - ATOM_minus, - PL_UTF8_STRING, baseBuffer(b, char)) ) - return FALSE; - } + if (pos) { + if (!PL_unify_term(head, PL_FUNCTOR, FUNCTOR_minus2, PL_FUNCTOR, + FUNCTOR_stream_position4, PL_INT64, pos->charno, PL_INT, + pos->lineno, PL_INT, pos->linepos, PL_INT, 0, + PL_UTF8_STRING, baseBuffer(b, char))) + return FALSE; + } else { + if (!PL_unify_term(head, PL_FUNCTOR, FUNCTOR_minus2, ATOM_minus, + PL_UTF8_STRING, baseBuffer(b, char))) + return FALSE; + } PL_reset_term_refs(head); return TRUE; } +static void setErrorLocation(IOPOS *pos, ReadData _PL_rd) { + if (pos) { + GET_LD -static void -setErrorLocation(IOPOS *pos, ReadData _PL_rd) -{ if ( pos ) - { GET_LD - - source_char_no = pos->charno; - source_line_pos = pos->linepos; - source_line_no = pos->lineno; - } - rb.here = rb.base+1; /* see rawSyntaxError() */ + source_char_no = pos->charno; + source_line_pos = pos->linepos; + source_line_no = pos->lineno; + } + rb.here = rb.base + 1; /* see rawSyntaxError() */ } - -static unsigned char * -raw_read2(ReadData _PL_rd ARG_LD) -{ int c; +static unsigned char *raw_read2(ReadData _PL_rd ARG_LD) { + int c; bool something_read = FALSE; bool dotseen = FALSE; - IOPOS pbuf; /* comment start */ + IOPOS pbuf; /* comment start */ IOPOS *pos; - clearBuffer(_PL_rd); /* clear input buffer */ + clearBuffer(_PL_rd); /* clear input buffer */ _PL_rd->strictness = truePrologFlag(PLFLAG_ISO); source_line_no = -1; - for(;;) - { c = getchr(); + for (;;) { + c = getchr(); - handle_c: - switch(c) - { case EOF: - if ( isStringStream(rb.stream) ) /* do not require '. ' when */ - { addToBuffer(' ', _PL_rd); /* reading from a string */ - addToBuffer('.', _PL_rd); - addToBuffer(' ', _PL_rd); - addToBuffer(EOS, _PL_rd); - return rb.base; - } - if (something_read) - { if ( dotseen ) /* term. */ - { if ( rb.here - rb.base == 1 ) - rawSyntaxError("end_of_clause"); - ensure_space(' '); - addToBuffer(EOS, _PL_rd); - return rb.base; - } - rawSyntaxError("end_of_file"); - } - if ( Sfpasteof(rb.stream) ) - { term_t stream; + handle_c: + switch (c) { + case EOF: + if (isStringStream(rb.stream)) /* do not require '. ' when */ + { + addToBuffer(' ', _PL_rd); /* reading from a string */ + addToBuffer('.', _PL_rd); + addToBuffer(' ', _PL_rd); + addToBuffer(EOS, _PL_rd); + return rb.base; + } + if (something_read) { + if (dotseen) /* term. */ + { + if (rb.here - rb.base == 1) + rawSyntaxError("end_of_clause"); + ensure_space(' '); + addToBuffer(EOS, _PL_rd); + return rb.base; + } + rawSyntaxError("end_of_file"); + } + if (Sfpasteof(rb.stream)) { + term_t stream; - LD->exception.processing = TRUE; - stream = PL_new_term_ref(); - PL_unify_stream_or_alias(stream, rb.stream); - PL_error(NULL, 0, NULL, ERR_PERMISSION, - ATOM_input, ATOM_past_end_of_stream, stream); - return NULL; - } - set_start_line; - strcpy((char *)rb.base, "end_of_file. "); - rb.here = rb.base + 14; - return rb.base; - case '/': if ( rb.stream->position ) - { pbuf = *rb.stream->position; - pbuf.charno--; - pbuf.linepos--; - pos = &pbuf; - } else - pos = NULL; + LD->exception.processing = TRUE; + stream = PL_new_term_ref(); + PL_unify_stream_or_alias(stream, rb.stream); + PL_error(NULL, 0, NULL, ERR_PERMISSION, ATOM_input, + ATOM_past_end_of_stream, stream); + return NULL; + } + set_start_line; + strcpy((char *)rb.base, "end_of_file. "); + rb.here = rb.base + 14; + return rb.base; + case '/': + if (rb.stream->position) { + pbuf = *rb.stream->position; + pbuf.charno--; + pbuf.linepos--; + pos = &pbuf; + } else + pos = NULL; - c = getchr(); - if ( c == '*' ) - { int last; - int level = 1; - union { - tmp_buffer ctmpbuf; - buffer tmpbuf; - } u; - Buffer cbuf; + c = getchr(); + if (c == '*') { + int last; + int level = 1; + union { + tmp_buffer ctmpbuf; + buffer tmpbuf; + } u; + Buffer cbuf; - if ( _PL_rd->comments ) - { initBuffer(&u.ctmpbuf); - cbuf = &u.tmpbuf; - addUTF8Buffer(cbuf, '/'); - addUTF8Buffer(cbuf, '*'); - } else - { cbuf = NULL; - } + if (_PL_rd->comments) { + initBuffer(&u.ctmpbuf); + cbuf = &u.tmpbuf; + addUTF8Buffer(cbuf, '/'); + addUTF8Buffer(cbuf, '*'); + } else { + cbuf = NULL; + } - if ((last = getchr()) == EOF) - { if ( cbuf ) - discardBuffer(cbuf); - setErrorLocation(pos, _PL_rd); - rawSyntaxError("end_of_file_in_block_comment"); - } - if ( cbuf ) - addUTF8Buffer(cbuf, last); + if ((last = getchr()) == EOF) { + if (cbuf) + discardBuffer(cbuf); + setErrorLocation(pos, _PL_rd); + rawSyntaxError("end_of_file_in_block_comment"); + } + if (cbuf) + addUTF8Buffer(cbuf, last); - if ( something_read ) - { addToBuffer(' ', _PL_rd); /* positions */ - addToBuffer(' ', _PL_rd); - addToBuffer(last == '\n' ? last : ' ', _PL_rd); - } + if (something_read) { + addToBuffer(' ', _PL_rd); /* positions */ + addToBuffer(' ', _PL_rd); + addToBuffer(last == '\n' ? last : ' ', _PL_rd); + } - for(;;) - { c = getchr(); + for (;;) { + c = getchr(); - if ( cbuf ) - addUTF8Buffer(cbuf, c); + if (cbuf) + addUTF8Buffer(cbuf, c); - switch( c ) - { case EOF: - if ( cbuf ) - discardBuffer(cbuf); - setErrorLocation(pos, _PL_rd); - rawSyntaxError("end_of_file_in_block_comment"); + switch (c) { + case EOF: + if (cbuf) + discardBuffer(cbuf); + setErrorLocation(pos, _PL_rd); + rawSyntaxError("end_of_file_in_block_comment"); #ifndef __YAP_PROLOG__ - /* YAP does not support comment levels in original scanner */ - case '*': - if ( last == '/' ) - level++; - break; + /* YAP does not support comment levels in original scanner */ + case '*': + if (last == '/') + level++; + break; #endif - case '/': - if ( last == '*' && - (--level == 0 || _PL_rd->strictness) ) - { if ( cbuf ) - { addUTF8Buffer(cbuf, EOS); - if ( !add_comment(cbuf, pos, _PL_rd PASS_LD) ) - { discardBuffer(cbuf); - return FALSE; - } - discardBuffer(cbuf); - } - c = ' '; - goto handle_c; - } - break; - } - if ( something_read ) - addToBuffer(c == '\n' ? c : ' ', _PL_rd); - last = c; - } - } else - { set_start_line; - addToBuffer('/', _PL_rd); - if ( isSymbolW(c) ) - { while( c != EOF && isSymbolW(c) && - !(c == '`' && _PL_rd->backquoted_string) ) - { addToBuffer(c, _PL_rd); - c = getchr(); - } - } - dotseen = FALSE; - goto handle_c; - } - case '%': if ( something_read ) - addToBuffer(' ', _PL_rd); - if ( _PL_rd->comments ) - { union { - tmp_buffer ctmpbuf; - buffer uctmpbuf; - } u; - Buffer cbuf; + case '/': + if (last == '*' && (--level == 0 || _PL_rd->strictness)) { + if (cbuf) { + addUTF8Buffer(cbuf, EOS); + if (!add_comment(cbuf, pos, _PL_rd PASS_LD)) { + discardBuffer(cbuf); + return FALSE; + } + discardBuffer(cbuf); + } + c = ' '; + goto handle_c; + } + break; + } + if (something_read) + addToBuffer(c == '\n' ? c : ' ', _PL_rd); + last = c; + } + } else { + set_start_line; + addToBuffer('/', _PL_rd); + if (isSymbolW(c)) { + while (c != EOF && isSymbolW(c) && + !(c == '`' && _PL_rd->backquoted_string)) { + addToBuffer(c, _PL_rd); + c = getchr(); + } + } + dotseen = FALSE; + goto handle_c; + } + case '%': + if (something_read) + addToBuffer(' ', _PL_rd); + if (_PL_rd->comments) { + union { + tmp_buffer ctmpbuf; + buffer uctmpbuf; + } u; + Buffer cbuf; - if ( rb.stream->position ) - { pbuf = *rb.stream->position; - pbuf.charno--; - pbuf.linepos--; - pos = &pbuf; - } else - pos = NULL; + if (rb.stream->position) { + pbuf = *rb.stream->position; + pbuf.charno--; + pbuf.linepos--; + pos = &pbuf; + } else + pos = NULL; - initBuffer(&u.ctmpbuf); - cbuf = (Buffer)&u.uctmpbuf; - addUTF8Buffer(cbuf, '%'); + initBuffer(&u.ctmpbuf); + cbuf = (Buffer)&u.uctmpbuf; + addUTF8Buffer(cbuf, '%'); - for(;;) - { while((c=getchr()) != EOF && c != '\n') - { addUTF8Buffer(cbuf, c); - if ( something_read ) /* record positions */ - addToBuffer(' ', _PL_rd); - } - if ( c == '\n' ) - { int c2 = Speekcode(rb.stream); + for (;;) { + while ((c = getchr()) != EOF && c != '\n') { + addUTF8Buffer(cbuf, c); + if (something_read) /* record positions */ + addToBuffer(' ', _PL_rd); + } + if (c == '\n') { + int c2 = Speekcode(rb.stream); - if ( c2 == '%' ) - { if ( something_read ) - { addToBuffer(c, _PL_rd); - addToBuffer(' ', _PL_rd); - } - addUTF8Buffer(cbuf, c); - c = Sgetcode(rb.stream); - assert(c==c2); - addUTF8Buffer(cbuf, c); - continue; - } - } - break; - } - addUTF8Buffer(cbuf, EOS); - if ( !add_comment(cbuf, pos, _PL_rd PASS_LD) ) - { discardBuffer(cbuf); - return FALSE; - } - discardBuffer(cbuf); - } else - { while((c=getchr()) != EOF && c != '\n') - { if ( something_read ) /* record positions */ - addToBuffer(' ', _PL_rd); - } - } - goto handle_c; /* is the newline */ - case '\'': if ( rb.here > rb.base && isDigit(rb.here[-1]) ) - { cucharp bs = &rb.here[-1]; + if (c2 == '%') { + if (something_read) { + addToBuffer(c, _PL_rd); + addToBuffer(' ', _PL_rd); + } + addUTF8Buffer(cbuf, c); + c = Sgetcode(rb.stream); + assert(c == c2); + addUTF8Buffer(cbuf, c); + continue; + } + } + break; + } + addUTF8Buffer(cbuf, EOS); + if (!add_comment(cbuf, pos, _PL_rd PASS_LD)) { + discardBuffer(cbuf); + return FALSE; + } + discardBuffer(cbuf); + } else { + while ((c = getchr()) != EOF && c != '\n') { + if (something_read) /* record positions */ + addToBuffer(' ', _PL_rd); + } + } + goto handle_c; /* is the newline */ + case '\'': + if (rb.here > rb.base && isDigit(rb.here[-1])) { + cucharp bs = &rb.here[-1]; - if ( bs > rb.base && isDigit(bs[-1]) ) - bs--; - if ( bs > rb.base && isSign(bs[-1]) ) - bs--; + if (bs > rb.base && isDigit(bs[-1])) + bs--; + if (bs > rb.base && isSign(bs[-1])) + bs--; - if ( bs == rb.base || !PlIdContW(bs[-1]) ) - { int base; + if (bs == rb.base || !PlIdContW(bs[-1])) { + int base; - if ( isSign(bs[0]) ) - bs++; - base = atoi((char*)bs); + if (isSign(bs[0])) + bs++; + base = atoi((char *)bs); - if ( base <= 36 ) - { if ( base == 0 ) /* 0' */ - { addToBuffer(c, _PL_rd); - { if ( (c=getchr()) != EOF ) - { addToBuffer(c, _PL_rd); - if ( c == '\\' ) /* 0'\ */ - { if ( (c=getchr()) != EOF ) - addToBuffer(c, _PL_rd); - } else if ( c == '\'' ) /* 0'' */ - { if ( (c=getchr()) != EOF ) - { if ( c == '\'' ) - addToBuffer(c, _PL_rd); - else - goto handle_c; - } - } - break; - } - rawSyntaxError("end_of_file"); - } - } else - { int c2 = Speekcode(rb.stream); + if (base <= 36) { + if (base == 0) /* 0' */ + { + addToBuffer(c, _PL_rd); + { + if ((c = getchr()) != EOF) { + addToBuffer(c, _PL_rd); + if (c == '\\') /* 0'\ */ + { + if ((c = getchr()) != EOF) + addToBuffer(c, _PL_rd); + } else if (c == '\'') /* 0'' */ + { + if ((c = getchr()) != EOF) { + if (c == '\'') + addToBuffer(c, _PL_rd); + else + goto handle_c; + } + } + break; + } + rawSyntaxError("end_of_file"); + } + } else { + int c2 = Speekcode(rb.stream); - if ( c2 != EOF ) - { if ( digitValue(base, c2) >= 0 ) - { addToBuffer(c, _PL_rd); - c = Sgetcode(rb.stream); - addToBuffer(c, _PL_rd); - dotseen = FALSE; - break; - } - goto sqatom; - } - rawSyntaxError("end_of_file"); - } - } - } - } + if (c2 != EOF) { + if (digitValue(base, c2) >= 0) { + addToBuffer(c, _PL_rd); + c = Sgetcode(rb.stream); + addToBuffer(c, _PL_rd); + dotseen = FALSE; + break; + } + goto sqatom; + } + rawSyntaxError("end_of_file"); + } + } + } + } - sqatom: - set_start_line; - if ( !raw_read_quoted(c, _PL_rd) ) - fail; - dotseen = FALSE; - break; - case '"': set_start_line; - if ( !raw_read_quoted(c, _PL_rd) ) - fail; - dotseen = FALSE; - break; - case '.': addToBuffer(c, _PL_rd); - set_start_line; - dotseen++; - c = getchr(); - if ( isSymbolW(c) ) - { while( c != EOF && isSymbolW(c) && - !(c == '`' && _PL_rd->backquoted_string) ) - { addToBuffer(c, _PL_rd); - c = getchr(); - } - dotseen = FALSE; - } - goto handle_c; - case '`': if ( _PL_rd->backquoted_string ) - { set_start_line; - if ( !raw_read_quoted(c, _PL_rd) ) - fail; - dotseen = FALSE; - break; - } - /*FALLTHROUGH*/ - default: if ( c < 0xff ) - { switch(_PL_char_types[c]) - { case SP: - case CT: - blank: - if ( dotseen ) - { if ( rb.here - rb.base == 1 ) - rawSyntaxError("end_of_clause"); - ensure_space(c); - addToBuffer(EOS, _PL_rd); - return rb.base; - } - do - { if ( something_read ) /* positions, \0 --> ' ' */ - addToBuffer(c ? c : ' ', _PL_rd); - else - ensure_space(c); - c = getchr(); - } while( c != EOF && PlBlankW(c) ); - goto handle_c; - case SY: - set_start_line; - do - { addToBuffer(c, _PL_rd); - c = getchr(); - if ( c == '`' && _PL_rd->backquoted_string ) - break; - } while( c != EOF && c <= 0xff && isSymbol(c) ); - /* TBD: wide symbols? */ - dotseen = FALSE; - goto handle_c; - case LC: - case UC: - set_start_line; - do - { addToBuffer(c, _PL_rd); - c = getchr(); - } while( c != EOF && PlIdContW(c) ); - dotseen = FALSE; - goto handle_c; - default: - addToBuffer(c, _PL_rd); - dotseen = FALSE; - set_start_line; - } - } else /* > 255 */ - { if ( PlIdStartW(c) ) - { set_start_line; - do - { addToBuffer(c, _PL_rd); - c = getchr(); - } while( c != EOF && PlIdContW(c) ); - dotseen = FALSE; - goto handle_c; - } else if ( PlBlankW(c) ) - { goto blank; - } else - { addToBuffer(c, _PL_rd); - dotseen = FALSE; - set_start_line; - } - } - } + sqatom: + set_start_line; + if (!raw_read_quoted(c, _PL_rd)) + fail; + dotseen = FALSE; + break; + case '"': + set_start_line; + if (!raw_read_quoted(c, _PL_rd)) + fail; + dotseen = FALSE; + break; + case '.': + addToBuffer(c, _PL_rd); + set_start_line; + dotseen++; + c = getchr(); + if (isSymbolW(c)) { + while (c != EOF && isSymbolW(c) && + !(c == '`' && _PL_rd->backquoted_string)) { + addToBuffer(c, _PL_rd); + c = getchr(); + } + dotseen = FALSE; + } + goto handle_c; + case '`': + if (_PL_rd->backquoted_string) { + set_start_line; + if (!raw_read_quoted(c, _PL_rd)) + fail; + dotseen = FALSE; + break; + } + /*FALLTHROUGH*/ + default: + if (c < 0xff) { + switch (_PL_char_types[c]) { + case SP: + case CT: + blank: + if (dotseen) { + if (rb.here - rb.base == 1) + rawSyntaxError("end_of_clause"); + ensure_space(c); + addToBuffer(EOS, _PL_rd); + return rb.base; + } + do { + if (something_read) /* positions, \0 --> ' ' */ + addToBuffer(c ? c : ' ', _PL_rd); + else + ensure_space(c); + c = getchr(); + } while (c != EOF && PlBlankW(c)); + goto handle_c; + case SY: + set_start_line; + do { + addToBuffer(c, _PL_rd); + c = getchr(); + if (c == '`' && _PL_rd->backquoted_string) + break; + } while (c != EOF && c <= 0xff && isSymbol(c)); + /* TBD: wide symbols? */ + dotseen = FALSE; + goto handle_c; + case LC: + case UC: + set_start_line; + do { + addToBuffer(c, _PL_rd); + c = getchr(); + } while (c != EOF && PlIdContW(c)); + dotseen = FALSE; + goto handle_c; + default: + addToBuffer(c, _PL_rd); + dotseen = FALSE; + set_start_line; + } + } else /* > 255 */ + { + if (PlIdStartW(c)) { + set_start_line; + do { + addToBuffer(c, _PL_rd); + c = getchr(); + } while (c != EOF && PlIdContW(c)); + dotseen = FALSE; + goto handle_c; + } else if (PlBlankW(c)) { + goto blank; + } else { + addToBuffer(c, _PL_rd); + dotseen = FALSE; + set_start_line; + } + } } + } } - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Raw reading returns a string in UTF-8 notation of the a Prolog term. Comment inside the term is replaced by spaces or newline to ensure @@ -928,150 +873,140 @@ raw_read2(ReadData _PL_rd ARG_LD) skipped. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -static unsigned char * -raw_read(ReadData _PL_rd, unsigned char **endp ARG_LD) -{ unsigned char *s; +static unsigned char *raw_read(ReadData _PL_rd, unsigned char **endp ARG_LD) { + unsigned char *s; - if ( (rb.stream->flags & SIO_ISATTY) && Sfileno(rb.stream) >= 0 ) - { ttybuf tab; + if ((rb.stream->flags & SIO_ISATTY) && Sfileno(rb.stream) >= 0) { + ttybuf tab; - PushTty(rb.stream, &tab, TTY_SAVE); /* make sure tty is sane */ - PopTty(rb.stream, &ttytab, FALSE); - s = raw_read2(_PL_rd PASS_LD); - PopTty(rb.stream, &tab, TRUE); - } else - { s = raw_read2(_PL_rd PASS_LD); - } + PushTty(rb.stream, &tab, TTY_SAVE); /* make sure tty is sane */ + PopTty(rb.stream, &ttytab, FALSE); + s = raw_read2(_PL_rd PASS_LD); + PopTty(rb.stream, &tab, TRUE); + } else { + s = raw_read2(_PL_rd PASS_LD); + } - if ( endp ) + if (endp) *endp = _PL_rd->_rb.here; return s; } -static void -callCommentHook(term_t comments, term_t tpos, term_t term) -{ GET_LD - fid_t fid; +static void callCommentHook(term_t comments, term_t tpos, term_t term) { + GET_LD + fid_t fid; term_t av; - if ( (fid = PL_open_foreign_frame()) && - (av = PL_new_term_refs(3)) ) - { qid_t qid; + if ((fid = PL_open_foreign_frame()) && (av = PL_new_term_refs(3))) { + qid_t qid; - PL_put_term(av+0, comments); - PL_put_term(av+1, tpos); - PL_put_term(av+2, term); + PL_put_term(av + 0, comments); + PL_put_term(av + 1, tpos); + PL_put_term(av + 2, term); - if ( (qid = PL_open_query(NULL, PL_Q_NODEBUG|PL_Q_CATCH_EXCEPTION, - (predicate_t)PredCommentHook, av)) ) - { term_t ex; + if ((qid = PL_open_query(NULL, PL_Q_NODEBUG | PL_Q_CATCH_EXCEPTION, + (predicate_t)PredCommentHook, av))) { + term_t ex; - if ( !PL_next_solution(qid) && (ex=PL_exception(qid)) ) - printMessage(ATOM_error, PL_TERM, ex); + if (!PL_next_solution(qid) && (ex = PL_exception(qid))) + printMessage(ATOM_error, PL_TERM, ex); - PL_close_query(qid); - } - PL_discard_foreign_frame(fid); + PL_close_query(qid); } + PL_discard_foreign_frame(fid); + } } - - /******************************** * PROLOG CONNECTION * *********************************/ -static unsigned char * -backSkipUTF8(unsigned const char *start, unsigned const char *end, int *chr) -{ const unsigned char *s; +static unsigned char *backSkipUTF8(unsigned const char *start, + unsigned const char *end, int *chr) { + const unsigned char *s; - for(s=end-1 ; s>start && ( *s&0x80 ); s--) + for (s = end - 1; s > start && (*s & 0x80); s--) ; - utf8_get_char((char*)s, chr); + utf8_get_char((char *)s, chr); return (unsigned char *)s; } +static unsigned char *backSkipBlanks(const unsigned char *start, + const unsigned char *end) { + const unsigned char *s; -static unsigned char * -backSkipBlanks(const unsigned char *start, const unsigned char *end) -{ const unsigned char *s; + for (; end > start; end = s) { + unsigned char *e; + int chr; - for( ; end > start; end = s) - { unsigned char *e; - int chr; - - for(s=end-1 ; s>start && ISUTF8_CB(*s); s--) - ; - e = (unsigned char*)utf8_get_char((char*)s, &chr); - assert(e == end); - if ( !PlBlankW(chr) ) - return (unsigned char*)end; - } + for (s = end - 1; s > start && ISUTF8_CB(*s); s--) + ; + e = (unsigned char *)utf8_get_char((char *)s, &chr); + assert(e == end); + if (!PlBlankW(chr)) + return (unsigned char *)end; + } return (unsigned char *)start; } -static inline ucharp -skipSpaces(cucharp in) -{ int chr; +static inline ucharp skipSpaces(cucharp in) { + int chr; ucharp s; - for( ; *in; in=s) - { s = utf8_get_uchar(in, &chr); + for (; *in; in = s) { + s = utf8_get_uchar(in, &chr); - if ( !PlBlankW(chr) ) - return (ucharp)in; - } + if (!PlBlankW(chr)) + return (ucharp)in; + } return (ucharp)in; } - - -word -pl_raw_read2(term_t from, term_t term) -{ GET_LD - unsigned char *s, *e, *t2, *top; +word pl_raw_read2(term_t from, term_t term) { + GET_LD + unsigned char *s, *e, *t2, *top; read_data rd; word rval; IOSTREAM *in; int chr; PL_chars_t txt; - if ( !getTextInputStream(from, &in) ) + if (!getTextInputStream(from, &in)) fail; init_read_data(&rd, in PASS_LD); - if ( !(s = raw_read(&rd, &e PASS_LD)) ) - { rval = PL_raise_exception(rd.exception); - goto out; - } + if (!(s = raw_read(&rd, &e PASS_LD))) { + rval = PL_raise_exception(rd.exception); + goto out; + } /* strip the input from blanks */ - top = backSkipBlanks(s, e-1); + top = backSkipBlanks(s, e - 1); t2 = backSkipUTF8(s, top, &chr); - if ( chr == '.' ) + if (chr == '.') top = backSkipBlanks(s, t2); /* watch for "0' ." */ - if ( top < e && top-2 >= s && top[-1] == '\'' && top[-2] == '0' ) + if (top < e && top - 2 >= s && top[-1] == '\'' && top[-2] == '0') top++; *top = EOS; s = skipSpaces(s); - txt.text.t = (char*)s; - txt.length = top-s; - txt.storage = PL_CHARS_HEAP; - txt.encoding = ENC_UTF8; + txt.text.t = (char *)s; + txt.length = top - s; + txt.storage = PL_CHARS_HEAP; + txt.encoding = ENC_UTF8; txt.canonical = FALSE; rval = PL_unify_text(term, 0, &txt, PL_ATOM); LD->read_varnames = rd.varnames; - out: +out: free_read_data(&rd); - if ( Sferror(in) ) + if (Sferror(in)) return streamStatus(in); else PL_release_stream(in); @@ -1079,31 +1014,24 @@ pl_raw_read2(term_t from, term_t term) return rval; } - -static int -unify_read_term_position(term_t tpos ARG_LD) -{ if ( tpos && source_line_no > 0 ) - { return PL_unify_term(tpos, - PL_FUNCTOR, FUNCTOR_stream_position4, - PL_INT64, source_char_no, - PL_INT, source_line_no, - PL_INT, source_line_pos, - PL_INT64, source_byte_no); - } else - { return TRUE; - } +static int unify_read_term_position(term_t tpos ARG_LD) { + if (tpos && source_line_no > 0) { + return PL_unify_term(tpos, PL_FUNCTOR, FUNCTOR_stream_position4, PL_INT64, + source_char_no, PL_INT, source_line_no, PL_INT, + source_line_pos, PL_INT64, source_byte_no); + } else { + return TRUE; + } } -static const opt_spec read_clause_options[] = - { { ATOM_variable_names, OPT_TERM }, - { ATOM_term_position, OPT_TERM }, - { ATOM_subterm_positions, OPT_TERM }, - { ATOM_process_comment, OPT_BOOL }, - { ATOM_comments, OPT_TERM }, - { ATOM_syntax_errors, OPT_ATOM }, - { NULL_ATOM, 0 } - }; - +static const opt_spec read_clause_options[] = { + {ATOM_variable_names, OPT_TERM}, + {ATOM_term_position, OPT_TERM}, + {ATOM_subterm_positions, OPT_TERM}, + {ATOM_process_comment, OPT_BOOL}, + {ATOM_comments, OPT_TERM}, + {ATOM_syntax_errors, OPT_ATOM}, + {NULL_ATOM, 0}}; /** read_clause(+Stream:stream, -Clause:clause, +Options:list) @@ -1117,9 +1045,7 @@ static const opt_spec read_clause_options[] = * term_position(-Position) * subterm_positions(-Layout) */ -static int -read_clause(IOSTREAM *s, term_t term, term_t options ARG_LD) -{ +static int read_clause(IOSTREAM *s, term_t term, term_t options ARG_LD) { read_data rd; int rval; fid_t fid; @@ -1136,98 +1062,84 @@ read_clause(IOSTREAM *s, term_t term, term_t options ARG_LD) else process_comment = TRUE; } - if ( !(fid=PL_open_foreign_frame()) ) + if (!(fid = PL_open_foreign_frame())) return FALSE; - retry: +retry: init_read_data(&rd, s PASS_LD); - if ( options && - !scan_options(options, 0, ATOM_read_option, read_clause_options, - &rd.varnames, - &tpos, - &rd.subtpos, - &process_comment, - &opt_comments, - &syntax_errors) ) - { PL_close_foreign_frame(fid); - return FALSE; - } + if (options && + !scan_options(options, 0, ATOM_read_option, read_clause_options, + &rd.varnames, &tpos, &rd.subtpos, &process_comment, + &opt_comments, &syntax_errors)) { + PL_close_foreign_frame(fid); + return FALSE; + } - if ( opt_comments ) - { comments = PL_new_term_ref(); - } else if ( process_comment ) - { if ( !tpos ) - tpos = PL_new_term_ref(); - comments = PL_new_term_ref(); - } + if (opt_comments) { + comments = PL_new_term_ref(); + } else if (process_comment) { + if (!tpos) + tpos = PL_new_term_ref(); + comments = PL_new_term_ref(); + } REGS_FROM_LD - rd.module = Yap_GetModuleEntry( LOCAL_SourceModule ); - if ( comments ) + rd.module = Yap_GetModuleEntry(LOCAL_SourceModule); + if (comments) rd.comments = PL_copy_term_ref(comments); rd.on_error = syntax_errors; rd.singles = rd.styleCheck & SINGLETON_CHECK ? 1 : 0; - if ( (rval=read_term(term, &rd PASS_LD)) && - (!tpos || (rval=unify_read_term_position(tpos PASS_LD))) ) - { - PredEntry *ap; - LD->read_varnames = rd.varnames; + if ((rval = read_term(term, &rd PASS_LD)) && + (!tpos || (rval = unify_read_term_position(tpos PASS_LD)))) { + PredEntry *ap; + LD->read_varnames = rd.varnames; - if (rd.singles) { - // warning, singletons([X=_A],f(X,Y,Z), pos). - printMessage(ATOM_warning, - PL_FUNCTOR_CHARS, "singletons", 3, - PL_TERM, rd.singles, - PL_TERM, term, - PL_TERM, tpos ); - } - ap = Yap_PredFromClause( Yap_GetFromSlot(term) PASS_REGS); - if (rd.styleCheck & (DISCONTIGUOUS_STYLE|MULTIPLE_CHECK) && ap != NULL ) { - if ( rd.styleCheck & (DISCONTIGUOUS_STYLE) && Yap_discontiguous( ap PASS_REGS) ) { - printMessage(ATOM_warning, - PL_FUNCTOR_CHARS, "discontiguous", 2, - PL_TERM, term, - PL_TERM, tpos ); - } - if ( rd.styleCheck & (MULTIPLE_CHECK) && Yap_multiple( ap PASS_REGS) ) { - printMessage(ATOM_warning, - PL_FUNCTOR_CHARS, "multiple", 3, - PL_TERM, term, - PL_TERM, tpos, - PL_ATOM, YAP_SWIAtomFromAtom(ap->src.OwnerFile) ); - } - } - if ( rd.comments && - (rval = PL_unify_nil(rd.comments)) ) - { if ( opt_comments ) - rval = PL_unify(opt_comments, comments); - else if ( !PL_get_nil(comments) ) - callCommentHook(comments, tpos, term); - } - } else - { if ( rd.has_exception && reportReadError(&rd) ) - { PL_rewind_foreign_frame(fid); - free_read_data(&rd); - goto retry; - } + if (rd.singles) { + // warning, singletons([X=_A],f(X,Y,Z), pos). + printMessage(ATOM_warning, PL_FUNCTOR_CHARS, "singletons", 3, PL_TERM, + rd.singles, PL_TERM, term, PL_TERM, tpos); } + ap = Yap_PredFromClause(Yap_GetFromSlot(term) PASS_REGS); + if (rd.styleCheck & (DISCONTIGUOUS_STYLE | MULTIPLE_CHECK) && ap != NULL) { + if (rd.styleCheck & (DISCONTIGUOUS_STYLE) && + Yap_discontiguous(ap PASS_REGS)) { + printMessage(ATOM_warning, PL_FUNCTOR_CHARS, "discontiguous", 2, + PL_TERM, term, PL_TERM, tpos); + } + if (rd.styleCheck & (MULTIPLE_CHECK) && Yap_multiple(ap PASS_REGS)) { + printMessage(ATOM_warning, PL_FUNCTOR_CHARS, "multiple", 3, PL_TERM, + term, PL_TERM, tpos, PL_ATOM, + YAP_SWIAtomFromAtom(ap->src.OwnerFile)); + } + } + if (rd.comments && (rval = PL_unify_nil(rd.comments))) { + if (opt_comments) + rval = PL_unify(opt_comments, comments); + else if (!PL_get_nil(comments)) + callCommentHook(comments, tpos, term); + } + } else { + if (rd.has_exception && reportReadError(&rd)) { + PL_rewind_foreign_frame(fid); + free_read_data(&rd); + goto retry; + } + } free_read_data(&rd); return rval; } - -static -PRED_IMPL("read_clause", 3, read_clause, 0) -{ PRED_LD - int rc; +static PRED_IMPL("read_clause", 3, read_clause, 0) { + PRED_LD + int rc; IOSTREAM *s; - if ( !getTextInputStream(A1, &s) ) + if (!getTextInputStream(A1, &s)) return FALSE; rc = read_clause(s, A2, A3 PASS_LD); - if ( Sferror(s) ) + if (Sferror(s)) return streamStatus(s); else PL_release_stream(s); @@ -1235,37 +1147,30 @@ PRED_IMPL("read_clause", 3, read_clause, 0) return rc; } +word pl_raw_read(term_t term) { return pl_raw_read2(0, term); } -word -pl_raw_read(term_t term) -{ return pl_raw_read2(0, term); -} - - -static const opt_spec read_term_options[] = - { { ATOM_variable_names, OPT_TERM }, - { ATOM_variables, OPT_TERM }, - { ATOM_singletons, OPT_TERM }, - { ATOM_term_position, OPT_TERM }, +static const opt_spec read_term_options[] = { + {ATOM_variable_names, OPT_TERM}, + {ATOM_variables, OPT_TERM}, + {ATOM_singletons, OPT_TERM}, + {ATOM_term_position, OPT_TERM}, // { ATOM_subterm_positions, OPT_TERM }, - { ATOM_character_escapes, OPT_BOOL }, - { ATOM_double_quotes, OPT_ATOM }, - { ATOM_module, OPT_ATOM }, - { ATOM_syntax_errors, OPT_ATOM }, - { ATOM_backquoted_string, OPT_BOOL }, - { ATOM_comments, OPT_TERM }, - { ATOM_process_comment, OPT_BOOL }, + {ATOM_character_escapes, OPT_BOOL}, + {ATOM_double_quotes, OPT_ATOM}, + {ATOM_module, OPT_ATOM}, + {ATOM_syntax_errors, OPT_ATOM}, + {ATOM_backquoted_string, OPT_BOOL}, + {ATOM_comments, OPT_TERM}, + {ATOM_process_comment, OPT_BOOL}, #ifdef O_QUASIQUOTATIONS - { ATOM_quasi_quotations, OPT_TERM }, + {ATOM_quasi_quotations, OPT_TERM}, #endif - { ATOM_cycles, OPT_BOOL }, - { NULL_ATOM, 0 } - }; + {ATOM_cycles, OPT_BOOL}, + {NULL_ATOM, 0}}; - -static foreign_t -read_term_from_stream(IOSTREAM *s, term_t term, term_t options ARG_LD) -{ term_t tpos = 0; +static foreign_t read_term_from_stream(IOSTREAM *s, term_t term, + term_t options ARG_LD) { + term_t tpos = 0; term_t comments = 0; term_t opt_comments = 0; int process_comment; @@ -1279,26 +1184,18 @@ read_term_from_stream(IOSTREAM *s, term_t term, term_t options ARG_LD) if (!fid) return FALSE; - retry: +retry: init_read_data(&rd, s PASS_LD); - if ( !scan_options(options, 0, ATOM_read_option, read_term_options, - &rd.varnames, - &rd.variables, - &rd.singles, - &tpos, - // &rd.subtpos, - &charescapes, - &dq, - &mname, - &rd.on_error, - &rd.backquoted_string, - &opt_comments, - &process_comment, + if (!scan_options(options, 0, ATOM_read_option, read_term_options, + &rd.varnames, &rd.variables, &rd.singles, &tpos, + // &rd.subtpos, + &charescapes, &dq, &mname, &rd.on_error, + &rd.backquoted_string, &opt_comments, &process_comment, #ifdef O_QUASIQUOTATIONS - &rd.quasi_quotations, + &rd.quasi_quotations, #endif - &rd.cycles) ) { + &rd.cycles)) { PL_discard_foreign_frame(fid); free_read_data(&rd); return FALSE; @@ -1311,67 +1208,66 @@ read_term_from_stream(IOSTREAM *s, term_t term, term_t options ARG_LD) process_comment = FALSE; } - if ( opt_comments ) - { comments = PL_new_term_ref(); - } else if ( process_comment ) - { if ( !tpos ) - tpos = PL_new_term_ref(); - comments = PL_new_term_ref(); - } + if (opt_comments) { + comments = PL_new_term_ref(); + } else if (process_comment) { + if (!tpos) + tpos = PL_new_term_ref(); + comments = PL_new_term_ref(); + } - if ( mname ) - { rd.module = lookupModule(mname); - rd.flags = rd.module->flags; - } + if (mname) { + rd.module = lookupModule(mname); + rd.flags = rd.module->flags; + } - if ( charescapes != -1 ) - { if ( charescapes ) - set(&rd, M_CHARESCAPE); - else - clear(&rd, M_CHARESCAPE); - } - if ( dq ) - { if ( !setDoubleQuotes(dq, &rd.flags) ) - return FALSE; - } - if ( rd.singles && PL_get_atom(rd.singles, &w) && w == ATOM_warning) + if (charescapes != -1) { + if (charescapes) + set(&rd, M_CHARESCAPE); + else + clear(&rd, M_CHARESCAPE); + } + if (dq) { + if (!setDoubleQuotes(dq, &rd.flags)) + return FALSE; + } + if (rd.singles && PL_get_atom(rd.singles, &w) && w == ATOM_warning) rd.singles = 1; - if ( comments ) + if (comments) rd.comments = PL_copy_term_ref(comments); rval = read_term(term, &rd PASS_LD); - if ( Sferror(s) ) { + if (Sferror(s)) { free_read_data(&rd); return FALSE; } LD->read_varnames = rd.varnames; #ifdef O_QUASIQUOTATIONS - if ( rval ) + if (rval) rval = parse_quasi_quotations(&rd PASS_LD); #endif - if ( rval ) - { if ( tpos ) - rval = unify_read_term_position(tpos PASS_LD); - if (rval) { - if ( opt_comments ) - rval = PL_unify(opt_comments, comments); - else if (comments && !PL_get_nil(comments) ) - callCommentHook(comments, tpos, term); - } - } else { - if ( rd.has_exception && reportReadError(&rd) ) - { PL_rewind_foreign_frame(fid); - free_read_data(&rd); - goto retry; - } + if (rval) { + if (tpos) + rval = unify_read_term_position(tpos PASS_LD); + if (rval) { + if (opt_comments) + rval = PL_unify(opt_comments, comments); + else if (comments && !PL_get_nil(comments)) + callCommentHook(comments, tpos, term); + } + } else { + if (rd.has_exception && reportReadError(&rd)) { + PL_rewind_foreign_frame(fid); + free_read_data(&rd); + goto retry; + } } free_read_data(&rd); return rval; } - /** @pred read_term(+ _Stream_,- _T_,+ _Options_) is iso Reads term _T_ from stream _Stream_ with execution controlled by the @@ -1379,19 +1275,18 @@ read_term_from_stream(IOSTREAM *s, term_t term, term_t options ARG_LD) */ -static -PRED_IMPL("read_term", 3, read_term, PL_FA_ISO) -{ PRED_LD - IOSTREAM *s; +static PRED_IMPL("read_term", 3, read_term, PL_FA_ISO) { + PRED_LD + IOSTREAM *s; - if ( getTextInputStream(A1, &s) ) - { if ( read_term_from_stream(s, A2, A3 PASS_LD) ) - return PL_release_stream(s); - if ( Sferror(s) ) - return streamStatus(s); - PL_release_stream(s); - return FALSE; - } + if (getTextInputStream(A1, &s)) { + if (read_term_from_stream(s, A2, A3 PASS_LD)) + return PL_release_stream(s); + if (Sferror(s)) + return streamStatus(s); + PL_release_stream(s); + return FALSE; + } return FALSE; } @@ -1399,7 +1294,6 @@ PRED_IMPL("read_term", 3, read_term, PL_FA_ISO) /** read_term(-Term, +Options) is det. */ - /** @pred read_term(- _T_,+ _Options_) is iso @@ -1447,103 +1341,100 @@ PRED_IMPL("read_term", 3, read_term, PL_FA_ISO) */ -static -PRED_IMPL("read_term", 2, read_term, PL_FA_ISO) -{ PRED_LD - IOSTREAM *s; +static PRED_IMPL("read_term", 2, read_term, PL_FA_ISO) { + PRED_LD + IOSTREAM *s; - if ( getTextInputStream(0, &s) ) - { if ( read_term_from_stream(s, A1, A2 PASS_LD) ) - return PL_release_stream(s); - if ( Sferror(s) ) - return streamStatus(s); - PL_release_stream(s); - return FALSE; - } + if (getTextInputStream(0, &s)) { + if (read_term_from_stream(s, A1, A2 PASS_LD)) + return PL_release_stream(s); + if (Sferror(s)) + return streamStatus(s); + PL_release_stream(s); + return FALSE; + } return FALSE; } - /******************************* * TERM <->ATOM * *******************************/ -static int -atom_to_term(term_t atom, term_t term, term_t bindings) -{ GET_LD +static int atom_to_term(term_t atom, term_t term, term_t bindings) { + GET_LD + PL_chars_t txt; + + if (!bindings && PL_is_variable(atom)) /* term_to_atom(+, -) */ + { + char buf[1024]; + size_t bufsize = sizeof(buf); + int rval; + char *s = buf; + IOSTREAM *stream; PL_chars_t txt; - if ( !bindings && PL_is_variable(atom) ) /* term_to_atom(+, -) */ - { char buf[1024]; - size_t bufsize = sizeof(buf); - int rval; - char *s = buf; - IOSTREAM *stream; - PL_chars_t txt; + stream = Sopenmem(&s, &bufsize, "w"); + stream->encoding = ENC_UTF8; + PL_write_term(stream, term, 1200, PL_WRT_QUOTED); + Sflush(stream); - stream = Sopenmem(&s, &bufsize, "w"); - stream->encoding = ENC_UTF8; - PL_write_term(stream, term, 1200, PL_WRT_QUOTED); - Sflush(stream); + txt.text.t = s; + txt.length = bufsize; + txt.storage = PL_CHARS_HEAP; + txt.encoding = ENC_UTF8; + txt.canonical = FALSE; + rval = PL_unify_text(atom, 0, &txt, PL_ATOM); - txt.text.t = s; - txt.length = bufsize; - txt.storage = PL_CHARS_HEAP; - txt.encoding = ENC_UTF8; - txt.canonical = FALSE; - rval = PL_unify_text(atom, 0, &txt, PL_ATOM); + Sclose(stream); + if (s != buf) + Sfree(s); - Sclose(stream); - if ( s != buf ) - Sfree(s); + return rval; + } - return rval; - } + if (PL_get_text(atom, &txt, CVT_ALL | CVT_EXCEPTION)) { + GET_LD + read_data rd; + int rval; + IOSTREAM *stream; + source_location oldsrc = LD->read_source; - if ( PL_get_text(atom, &txt, CVT_ALL|CVT_EXCEPTION) ) - { GET_LD - read_data rd; - int rval; - IOSTREAM *stream; - source_location oldsrc = LD->read_source; + stream = Sopen_text(&txt, "r"); - stream = Sopen_text(&txt, "r"); + init_read_data(&rd, stream PASS_LD); + if (bindings && (PL_is_variable(bindings) || PL_is_list(bindings))) + rd.varnames = bindings; + else if (bindings) + return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, bindings); - init_read_data(&rd, stream PASS_LD); - if ( bindings && (PL_is_variable(bindings) || PL_is_list(bindings)) ) - rd.varnames = bindings; - else if ( bindings ) - return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, bindings); + if (!(rval = read_term(term, &rd PASS_LD)) && rd.has_exception) + rval = PL_raise_exception(rd.exception); + free_read_data(&rd); + Sclose(stream); + LD->read_source = oldsrc; - if ( !(rval = read_term(term, &rd PASS_LD)) && rd.has_exception ) - rval = PL_raise_exception(rd.exception); - free_read_data(&rd); - Sclose(stream); - LD->read_source = oldsrc; - - // getchar(); - return rval; - } + // getchar(); + return rval; + } fail; } -Term -Yap_StringToTerm(const char *s, size_t *lenp, term_t bindings) -{ GET_LD; +Term Yap_CharsToTerm(const char *s, size_t *lenp, Term *bindingsp) { + GET_LD; read_data rd; int rval; IOSTREAM *stream; source_location oldsrc = LD->read_source; - stream = Sopen_string(0, (char *)s, strlen( s ), "r"); + stream = Sopen_string(0, (char *)s, strlen(s), "r"); init_read_data(&rd, stream PASS_LD); rd.varnames = bindings; term_t tt = Yap_NewSlots(1); - if ( !(rval = read_term(tt, &rd PASS_LD)) && rd.has_exception ) { + if (!(rval = read_term(tt, &rd PASS_LD)) && rd.has_exception) { rval = PL_raise_exception(rd.exception); return 0L; } @@ -1552,40 +1443,38 @@ Yap_StringToTerm(const char *s, size_t *lenp, term_t bindings) LD->read_source = oldsrc; // getchar(); - return Yap_GetFromSlot( tt); + return Yap_GetFromSlot(tt); } /** @pred atom_to_term(+ _Atom_, - _Term_, - _Bindings_) - Use _Atom_ as input to read_term/2 using the option `variable_names` and return the read term in _Term_ and the variable bindings in _Bindings_. _Bindings_ is a list of `Name = Var` couples, thus providing access to the actual variable names. See also read_term/2. If Atom has no valid syntax, a syntax_error exception is raised. + Use _Atom_ as input to read_term/2 using the option `variable_names` and + return the read term in _Term_ and the variable bindings in _Bindings_. + _Bindings_ is a list of `Name = Var` couples, thus providing access to the + actual variable names. See also read_term/2. If Atom has no valid syntax, a + syntax_error exception is raised. */ -static -PRED_IMPL("atom_to_term", 3, atom_to_term, 0) -{ return atom_to_term(A1, A2, A3); +static PRED_IMPL("atom_to_term", 3, atom_to_term, 0) { + return atom_to_term(A1, A2, A3); } - -static -PRED_IMPL("term_to_atom", 2, term_to_atom, 0) -{ return atom_to_term(A2, A1, 0); +static PRED_IMPL("term_to_atom", 2, term_to_atom, 0) { + return atom_to_term(A2, A1, 0); } -static -PRED_IMPL("$context_variables", 1, context_variables, 0) -{ CACHE_REGS - if ( LOCAL_VarNames == (CELL)0 ) - return Yap_unify( TermNil, ARG1); - return Yap_unify( LOCAL_VarNames, ARG1); +static PRED_IMPL("$context_variables", 1, context_variables, 0) { + CACHE_REGS + if (LOCAL_VarNames == (CELL)0) + return Yap_unify(TermNil, ARG1); + return Yap_unify(LOCAL_VarNames, ARG1); } -static -PRED_IMPL("$set_source", 2, set_source, 0) -{ +static PRED_IMPL("$set_source", 2, set_source, 0) { GET_LD - atom_t at; + atom_t at; term_t a = PL_new_term_ref(); if (!PL_get_atom(A1, &at)) @@ -1594,23 +1483,22 @@ PRED_IMPL("$set_source", 2, set_source, 0) if (!PL_get_arg(1, A2, a) || !PL_get_int64(a, &source_char_no) || !PL_get_arg(2, A2, a) || !PL_get_long(a, &source_line_no) || !PL_get_arg(3, A2, a) || !PL_get_long(a, &source_line_pos) || - !PL_get_arg(4, A2, a) || !PL_get_int64(a, &source_byte_no) ) { + !PL_get_arg(4, A2, a) || !PL_get_int64(a, &source_byte_no)) { return FALSE; } return TRUE; } -int -PL_chars_to_term(const char *s, term_t t) -{ GET_LD - read_data rd; +int PL_chars_to_term(const char *s, term_t t) { + GET_LD + read_data rd; int rval; IOSTREAM *stream = Sopen_string(NULL, (char *)s, -1, "r"); source_location oldsrc = LD->read_source; init_read_data(&rd, stream PASS_LD); PL_put_variable(t); - if ( !(rval = read_term(t, &rd PASS_LD)) && rd.has_exception ) + if (!(rval = read_term(t, &rd PASS_LD)) && rd.has_exception) PL_put_term(t, rd.exception); LOCAL_VarNames = rd.varnames; free_read_data(&rd); @@ -1624,17 +1512,16 @@ PL_chars_to_term(const char *s, term_t t) * PUBLISH PREDICATES * *******************************/ -BeginPredDefs(read) -PRED_DEF("read_term", 3, read_term, PL_FA_ISO) -PRED_DEF("read_term", 2, read_term, PL_FA_ISO) -PRED_DEF("read_clause", 3, read_clause, 0) -PRED_DEF("atom_to_term", 3, atom_to_term, 0) -PRED_DEF("term_to_atom", 2, term_to_atom, 0) -PRED_DEF("$context_variables", 1, context_variables, 0) -PRED_DEF("$set_source", 2, set_source, 0) +BeginPredDefs(read) PRED_DEF("read_term", 3, read_term, PL_FA_ISO) + PRED_DEF("read_term", 2, read_term, PL_FA_ISO) + PRED_DEF("read_clause", 3, read_clause, 0) + PRED_DEF("atom_to_term", 3, atom_to_term, 0) + PRED_DEF("term_to_atom", 2, term_to_atom, 0) + PRED_DEF("$context_variables", 1, context_variables, 0) + PRED_DEF("$set_source", 2, set_source, 0) #ifdef O_QUASIQUOTATIONS -PRED_DEF("$qq_open", 2, qq_open, 0) + PRED_DEF("$qq_open", 2, qq_open, 0) #endif -EndPredDefs + EndPredDefs -//! @} + //! @} diff --git a/library/dialect/swi/os/pl-yap.h b/library/dialect/swi/os/pl-yap.h index e100d332f..fd79a3c1e 100644 --- a/library/dialect/swi/os/pl-yap.h +++ b/library/dialect/swi/os/pl-yap.h @@ -8,7 +8,7 @@ #include /* depends on tag schema, but 4 should always do */ -#define LMASK_BITS 4 /* total # mask bits */ +#define LMASK_BITS 4 /* total # mask bits */ #if HAVE_CTYPE_H #include @@ -20,64 +20,63 @@ #define SIZE_VOIDP SIZEOF_INT_P - -#if SIZEOF_LONG_INT==4 +#if SIZEOF_LONG_INT == 4 #define INT64_FORMAT "%lld" #else #define INT64_FORMAT "%ld" #endif -#define INTBITSIZE (sizeof(int)*8) +#define INTBITSIZE (sizeof(int) * 8) -typedef module_t Module; -typedef Term (*Func)(term_t); /* foreign functions */ +typedef module_t Module; +typedef Term (*Func)(term_t); /* foreign functions */ extern const char *Yap_GetCurrentPredName(void); -extern Int Yap_GetCurrentPredArity(void); +extern Int Yap_GetCurrentPredArity(void); extern term_t Yap_fetch_module_for_format(term_t args, Term *modp); -extern void Yap_setCurrentSourceLocation( void *rd ); -extern void *Yap_GetStreamHandle(Atom at); -extern void Yap_WriteAtom(IOSTREAM *s, Atom atom); +extern void Yap_setCurrentSourceLocation(void *rd); +extern void *Yap_GetStreamHandle(Atom at); +extern void Yap_WriteAtom(IOSTREAM *s, Atom atom); extern atom_t codeToAtom(int chrcode); -#define valTermRef(t) ((Word)Yap_AddressFromSlot(t)) +#define valTermRef(t) ((Word)Yap_AddressFromSlot(t)) #include "pl-codelist.h" -//move this to SWI +// move this to SWI -#define GP_CREATE 2 /* create (in this module) */ +#define GP_CREATE 2 /* create (in this module) */ #ifndef HAVE_MBSCOLL COMMON(int) mbscoll(const char *s1, const char *s2); #endif - #ifndef HAVE_MBSCASECOLL COMMON(int) mbscasecoll(const char *s1, const char *s2); #endif -COMMON(atom_t) TemporaryFile(const char *id, int *fdp); -COMMON(char *) Getenv(const char *, char *buf, size_t buflen); +COMMON(atom_t) TemporaryFile(const char *id, int *fdp); +COMMON(char *) Getenv(const char *, char *buf, size_t buflen); /*** memory allocation stuff: SWI wraps around malloc */ #define stopItimer() -COMMON(word) pl_print(term_t term); -COMMON(word) pl_write(term_t term); -COMMON(word) pl_write_canonical(term_t term); -COMMON(word) pl_write_term(term_t term, term_t options); -COMMON(word) pl_writeq(term_t term); +COMMON(word) pl_print(term_t term); +COMMON(word) pl_write(term_t term); +COMMON(word) pl_write_canonical(term_t term); +COMMON(word) pl_write_term(term_t term, term_t options); +COMMON(word) pl_writeq(term_t term); -static inline int -get_procedure(term_t descr, predicate_t *proc, term_t he, int f) { +static inline int get_procedure(term_t descr, predicate_t *proc, term_t he, + int f) { CACHE_REGS - Term t = Yap_GetFromSlot(descr ); + Term t = Yap_GetFromSlot(descr); - if (IsVarTerm(t)) return FALSE; + if (IsVarTerm(t)) + return FALSE; if (IsAtomTerm(t)) - *proc = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t),CurrentModule)); + *proc = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), CurrentModule)); else if (IsApplTerm(t)) { Functor f = FunctorOfTerm(t); if (IsExtensionFunctor(f)) { @@ -88,41 +87,38 @@ get_procedure(term_t descr, predicate_t *proc, term_t he, int f) { return TRUE; } - /* TBD */ extern word globalString(size_t size, char *s); extern word globalWString(size_t size, wchar_t *s); -#define allocHeap(n) allocHeap__LD(n PASS_LD) +#define allocHeap(n) allocHeap__LD(n PASS_LD) #define valHandle(r) valHandle__LD(r PASS_LD) -Int YAP_PLArityOfSWIFunctor(functor_t f); -struct PL_blob_t* YAP_find_blob_type(Atom at); +Int YAP_PLArityOfSWIFunctor(functor_t f); +struct PL_blob_t *YAP_find_blob_type(Atom at); void PL_license(const char *license, const char *module); - #define arityFunctor(f) YAP_PLArityOfSWIFunctor(f) -#define stringAtom(w) (YAP_AtomFromSWIAtom(w)->StrOfAE) -#define isInteger(A) (!IsVarTerm(A) && ( IsIntegerTerm((A)) || YAP_IsBigNumTerm((A)) )) -#define isString(A) (!IsVarTerm(A) && IsStringTerm(A) ) -#define isAtom(A) (!IsVarTerm(A) && IsAtomTerm((A)) ) -#define isList(A) (!IsVarTerm(A) && IsPairTerm((A)) ) +#define stringAtom(w) (YAP_AtomFromSWIAtom(w)->StrOfAE) +#define isInteger(A) \ + (!IsVarTerm(A) && (IsIntegerTerm((A)) || YAP_IsBigNumTerm((A)))) +#define isString(A) (!IsVarTerm(A) && IsStringTerm(A)) +#define isAtom(A) (!IsVarTerm(A) && IsAtomTerm((A))) +#define isList(A) (!IsVarTerm(A) && IsPairTerm((A))) #define isNil(A) ((A) == TermNil) -#define isReal(A) (!IsVarTerm(A) && IsFloatTerm((A)) ) -#define isFloat(A) (!IsVarTerm(A) && IsFloatTerm((A)) ) +#define isReal(A) (!IsVarTerm(A) && IsFloatTerm((A))) +#define isFloat(A) (!IsVarTerm(A) && IsFloatTerm((A))) #define isVar(A) IsVarTerm((A)) #define valReal(w) FloatOfTerm((w)) #define valFloat(w) FloatOfTerm((w)) #define atomValue(atom) AtomOfTerm(atom) #define atomFromTerm(term) YAP_SWIAtomFromAtom(AtomOfTerm(term)) -inline static char * -atomName(Atom atom) -{ +inline static char *atomName(Atom atom) { if (IsWideAtom(atom)) return (char *)(atom->WStrOfAE); return atom->StrOfAE; @@ -131,16 +127,19 @@ atomName(Atom atom) #define nameOfAtom(atom) nameOfAtom(atom) #define atomBlobType(at) YAP_find_blob_type(at) -#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i)))) -#define deRef(t) while (IsVarTerm(*(t)) && !IsUnboundVar(t)) { t = (CELL *)(*(t)); } -#define canBind(t) FALSE // VSC: to implement -#define _PL_predicate(A,B,C,D) PL_predicate(A,B,C) +#define argTermP(w, i) ((Word)((YAP_ArgsOfTerm(w) + (i)))) +#define deRef(t) \ + while (IsVarTerm(*(t)) && !IsUnboundVar(t)) { \ + t = (CELL *)(*(t)); \ + } +#define canBind(t) FALSE // VSC: to implement +#define _PL_predicate(A, B, C, D) PL_predicate(A, B, C) #define predicateHasClauses(pe) ((pe)->cs.p_code.NOfClauses != 0) #define lookupModule(A) Yap_GetModuleEntry(MkAtomTerm(YAP_AtomFromSWIAtom(A))) Procedure resolveProcedure(functor_t f, Module module); -#define charEscapeWriteOption(A) FALSE // VSC: to implement +#define charEscapeWriteOption(A) FALSE // VSC: to implement #define wordToTermRef(A) Yap_InitSlot(*(A)) #define isTaggedInt(A) IsIntegerTerm(A) #define valInt(A) IntegerOfTerm(A) @@ -156,34 +155,32 @@ extern term_t Yap_CvtTerm(term_t ts); wchar_t *nameOfWideAtom(atom_t atom); int isWideAtom(atom_t atom); -inline static int -charCode(Term w) -{ if ( IsAtomTerm(w) ) - { - Atom a = atomValue(w); +inline static int charCode(Term w) { + if (IsAtomTerm(w)) { + Atom a = atomValue(w); - if (IsWideAtom(a)) { - if (wcslen(a->WStrOfAE) == 1) - return a->WStrOfAE[0]; - return -1; - } - if (strlen(a->StrOfAE) == 1) - return ((unsigned char *)(a->StrOfAE))[0]; + if (IsWideAtom(a)) { + if (wcslen(a->WStrOfAE) == 1) + return a->WStrOfAE[0]; return -1; } + if (strlen(a->StrOfAE) == 1) + return ((unsigned char *)(a->StrOfAE))[0]; + return -1; + } return -1; } -#define PL_get_atom(t, a) PL_get_atom__LD(t, a PASS_LD) -#define PL_get_atom_ex(t, a) PL_get_atom_ex__LD(t, a PASS_LD) -#define PL_get_text(l, t, f) PL_get_text__LD(l, t, f PASS_LD) -#define PL_is_atom(t) PL_is_atom__LD(t PASS_LD) -#define PL_is_variable(t) PL_is_variable__LD(t PASS_LD) -#define PL_new_term_ref() PL_new_term_ref__LD(PASS_LD1) -#define PL_put_atom(t, a) PL_put_atom__LD(t, a PASS_LD) -#define PL_put_term(t1, t2) PL_put_term__LD(t1, t2 PASS_LD) -#define PL_unify_atom(t, a) PL_unify_atom__LD(t, a PASS_LD) -#define PL_unify_integer(t, i) PL_unify_integer__LD(t, i PASS_LD) +#define PL_get_atom(t, a) PL_get_atom__LD(t, a PASS_LD) +#define PL_get_atom_ex(t, a) PL_get_atom_ex__LD(t, a PASS_LD) +#define PL_get_text(l, t, f) PL_get_text__LD(l, t, f PASS_LD) +#define PL_is_atom(t) PL_is_atom__LD(t PASS_LD) +#define PL_is_variable(t) PL_is_variable__LD(t PASS_LD) +#define PL_new_term_ref() PL_new_term_ref__LD(PASS_LD1) +#define PL_put_atom(t, a) PL_put_atom__LD(t, a PASS_LD) +#define PL_put_term(t1, t2) PL_put_term__LD(t1, t2 PASS_LD) +#define PL_unify_atom(t, a) PL_unify_atom__LD(t, a PASS_LD) +#define PL_unify_integer(t, i) PL_unify_integer__LD(t, i PASS_LD) #define _PL_get_arg(i, t, a) _PL_get_arg__LD(i, t, a PASS_LD); @@ -192,13 +189,12 @@ charCode(Term w) unsigned int getUnknownModule(module_t m); #if IN_PL_OS_C -static int -stripostfix(const char *s, const char *e) -{ size_t ls = strlen(s); +static int stripostfix(const char *s, const char *e) { + size_t ls = strlen(s); size_t le = strlen(e); - if ( ls >= le ) - return strcasecmp(&s[ls-le], e) == 0; + if (ls >= le) + return strcasecmp(&s[ls - le], e) == 0; return FALSE; } @@ -209,9 +205,8 @@ stripostfix(const char *s, const char *e) #include #endif -static inline void -unblockSignal(int sig) -{ sigset_t set; +static inline void unblockSignal(int sig) { + sigset_t set; sigemptyset(&set); sigaddset(&set, sig); @@ -220,10 +215,7 @@ unblockSignal(int sig) // DEBUG(1, Sdprintf("Unblocked signal %d\n", sig)); } #else -static inline void -unblockSignal(int sig) -{ -} +static inline void unblockSignal(int sig) {} #endif #define suspendTrace(x) @@ -234,6 +226,8 @@ atom_t ATOM_; intptr_t system_thread_id(void); #endif -extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio,Term *bindingsp); +extern Term Yap_BufferToTermWithPrioBindings(const char *s, size_t len, + encoding_t enc, int prio, + Term *bindingsp); #endif /* PL_YAP_H */ diff --git a/library/maplist.yap b/library/maplist.yap index 6e7aa2fb4..e1af90dfe 100644 --- a/library/maplist.yap +++ b/library/maplist.yap @@ -1,3 +1,4 @@ + /** * @file maplist.yap * @author Lawrence Byrd + Richard A. O'Keefe, VITOR SANTOS COSTA diff --git a/library/system/CMakeLists.txt b/library/system/CMakeLists.txt index af67b740a..917cc3ac9 100644 --- a/library/system/CMakeLists.txt +++ b/library/system/CMakeLists.txt @@ -10,9 +10,9 @@ set (TARGET sys) endif() -if (NOT ANDROID) +if (NOT ANDROID AND WITH_OPENSSL) # -# this will support getting better cryptographic support, +# this will evolve to getting better cryptographic support, # but right now Open SSL is not supported enough. # find_package (OpenSSL) diff --git a/os/iopreds.h b/os/iopreds.h index 680562834..6c7d12608 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -35,7 +35,6 @@ extern bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name, encoding_t encoding, stream_flags_t flags, Atom open_mode); -# #define Yap_CheckStream(arg, kind, msg) \ Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg) extern int Yap_CheckStream__(const char *, const char *, int, Term, int, @@ -80,7 +79,7 @@ Int Yap_CloseSocket(int, socket_info, socket_domain); #endif /* USE_SOCKET */ -extern Term Yap_read_term(int inp_stream, Term opts, int nargs); +extern Term Yap_read_term(int inp_stream, Term opts, bool clauatse); extern Term Yap_Parse(UInt prio, encoding_t enc, Term cmod); extern void init_read_data(ReadData _PL_rd, struct stream_desc *s); @@ -98,16 +97,17 @@ static inline Int GetCurInpPos(StreamDesc *inp_stream) { #define PlIOError(type, culprit, ...) \ PlIOError__(__FILE__, __FUNCTION__, __LINE__, type, culprit, __VA_ARGS__) -extern Int PlIOError__(const char *, const char *, int, yap_error_number, Term, ...); +extern Int PlIOError__(const char *, const char *, int, yap_error_number, Term, + ...); extern int GetFreeStreamD(void); -extern Term Yap_MkStream(int n); +extern Term Yap_MkStream(int n); extern bool Yap_PrintWarning(Term twarning); extern void Yap_plwrite(Term, struct stream_desc *, int, int, int); extern void Yap_WriteAtom(struct stream_desc *s, Atom atom); -extern bool Yap_WriteTerm( int output_stream, Term t, Term opts USES_REGS); +extern bool Yap_WriteTerm(int output_stream, Term t, Term opts USES_REGS); extern Term Yap_scan_num(struct stream_desc *, bool); @@ -275,7 +275,8 @@ extern bool Yap_Exists(const char *f); static inline void freeBuffer(const void *ptr) { CACHE_REGS - if (ptr == NULL || ptr == LOCAL_FileNameBuf || ptr == LOCAL_FileNameBuf2 || ptr == AuxBase) + if (ptr == NULL || ptr == LOCAL_FileNameBuf || ptr == LOCAL_FileNameBuf2 || + ptr == AuxBase) return; free((void *)ptr); } diff --git a/os/readterm.c b/os/readterm.c index b4755a23f..494a46cc5 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -8,6 +8,7 @@ * * ************************************************************************** * * +read_term * File: iopreds.c * * Last rev: 5/2/88 * * mods: * @@ -184,6 +185,7 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) { #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), \ @@ -206,6 +208,24 @@ typedef enum open_enum_choices { READ_DEFS() } read_choices_t; 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); + Yap_unify(t, ArgOfTerm(1, topt)); + return MkPairTerm(topt, tail); +} + +static Term add_names(Term t, Term tail) { + Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1); + Yap_unify(t, ArgOfTerm(1, topt)); + return MkPairTerm(topt, tail); +} + +static Term add_priority(Term t, Term tail) { + Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1); + Yap_unify(t, ArgOfTerm(1, topt)); + return MkPairTerm(topt, tail); +} + /** * Syntax Error Handler * @@ -299,7 +319,7 @@ Term Yap_syntax_error(TokEntry *errtok, int sno) { typedef struct FEnv { Term qq, tp, sp, np, vp, ce; Term tpos; /// initial position of the term to be read. - Term t; /// the output term + 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. @@ -341,14 +361,18 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { } re->bq = getBackQuotesFlag(); - if (args[READ_MODULE].used) { - fe->cmod = args[READ_MODULE].tvalue; + if (args[READ_OUTPUT].used) { + fe->t0 = args[READ_OUTPUT].tvalue; } else { - fe->cmod = CurrentModule; + fe->t0 = 0; } - if (fe->cmod == TermProlog) - fe->cmod = PROLOG_MODULE; - if (args[READ_BACKQUOTED_STRING].used) { + 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 (!setBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue)) { return false; } @@ -562,6 +586,9 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) { CACHE_REGS Term v1, v2, v3, vc, tp; + if (fe->t0 && !(Yap_unify(fe->t, fe->t0))) + return false; + if (fe->t && fe->vp) v1 = get_variables(fe, tokstart); else @@ -598,6 +625,8 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) { CACHE_REGS Term v_vp, v_vnames, v_comments, v_pos; + if (fe->t0 && !Yap_unify(fe->t, fe->t0)) + return false; if (fe->t && fe->vp) v_vp = get_variables(fe, tokstart); else @@ -630,7 +659,7 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) { } static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, - int nargs); + bool clause); static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream); @@ -681,8 +710,7 @@ static parser_state_t scanEOF(FEnv *fe, int inp_stream) { } static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, - int nargs) { - CACHE_REGS + bool clause) { LOCAL_ErrorMessage = NULL; fe->old_TR = TR; LOCAL_Error_TYPE = YAP_NO_ERROR; @@ -690,12 +718,10 @@ static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, LOCAL_eot_before_eof = false; fe->tpos = StreamPosition(inp_stream); fe->old_H = HR; - fe->reading_clause = nargs < 0; - if (fe->reading_clause) { - fe->nargs = -nargs; + fe->reading_clause = clause; + if (clause) { fe->args = setClauseReadEnv(opts, fe, re, inp_stream); } else { - fe->nargs = nargs; fe->args = setReadEnv(opts, fe, re, inp_stream); } if (fe->args == NULL) { @@ -848,7 +874,7 @@ static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) { * * */ -Term Yap_read_term(int inp_stream, Term opts, int nargs) { +Term Yap_read_term(int inp_stream, Term opts, bool clause) { FEnv fe; REnv re; #if EMACS @@ -860,7 +886,7 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) { while (true) { switch (state) { case YAP_START_PARSING: - state = initParser(opts, &fe, &re, inp_stream, nargs); + state = initParser(opts, &fe, &re, inp_stream, clause); if (state == YAP_PARSING_FINISHED) { pop_text_stack(lvl); return 0; @@ -907,12 +933,8 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) { static Int read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */ - Term rc; - yhandle_t h = Yap_PushHandle(ARG1); - if ((rc = Yap_read_term(LOCAL_c_input_stream, ARG2, 2)) == 0) - return FALSE; - Term tf = Yap_PopHandle(h); - return rc && Yap_unify(tf, rc); + return Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, ARG2), false) != + 0; } static Int read_term( @@ -922,15 +944,13 @@ static Int read_term( /* needs to change LOCAL_output_stream for write */ - yhandle_t h = Yap_PushHandle(ARG2); inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); if (inp_stream == -1) { return (FALSE); } - out = Yap_read_term(inp_stream, ARG3, 3); + out = Yap_read_term(inp_stream, add_output(ARG1, ARG2), false); UNLOCK(GLOBAL_Stream[inp_stream].streamlock); - Term tf = Yap_PopHandle(h); - return out != 0L && Yap_unify(tf, out); + return out != 0L; } #define READ_CLAUSE_DEFS() \ @@ -940,6 +960,7 @@ static Int read_term( 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 @@ -966,6 +987,11 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION; 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 { @@ -977,6 +1003,11 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, fe->enc = GLOBAL_Stream[inp_stream].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 { @@ -1018,30 +1049,28 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, } /** - * @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det + * @pred read_clause( +Stream, -Clause, ?Opts) is det * - u* Same as read_clause/3, but from the standard input stream. + * Same as read_clause/3, but from the standard input stream. * */ static Int read_clause2(USES_REGS1) { - Term rc; - yhandle_t h = Yap_InitSlot(ARG1); - rc = Yap_read_term(LOCAL_c_input_stream, Deref(ARG2), -2); - Term tf = Yap_GetFromSlot(h); - Yap_RecoverSlots(1, h); - return rc && Yap_unify(tf, rc); + Term ctl = add_output(ARG1, ARG2); + return Yap_read_term(LOCAL_c_input_stream, ctl, true); } /** - * @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det + * @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, + * + 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 `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 @@ -1057,27 +1086,14 @@ static Int read_clause( USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ int inp_stream; Term out; - Term t3 = Deref(ARG3); - yhandle_t h = Yap_InitSlot(ARG2); + /* needs to change LOCAL_output_stream for write */ inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); if (inp_stream < 0) return false; - out = Yap_read_term(inp_stream, t3, -3); -#if COMMENTED - if (LOCAL_SourceFileLineno == 707) { - char *s; - size_t length; - - s = Yap_TermToString(out, &length, LOCAL_encoding, 0); - __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", "at %d %s", - LOCAL_SourceFileLineno, s); - } -#endif + out = Yap_read_term(inp_stream, add_output(ARG2, ARG3), true); UNLOCK(GLOBAL_Stream[inp_stream].streamlock); - Term tf = Yap_GetFromSlot(h); - Yap_RecoverSlots(1, h); - return out && Yap_unify(tf, out); + return out != 0; } /** @@ -1144,7 +1160,7 @@ static Int source_location(USES_REGS1) { } /** - * @pred read(+ _Stream_, - _Term_ ) is iso + * @pred read(+ Stream, -Term ) is iso * * Reads term _T_ from the stream _S_ instead of from the current input * stream. @@ -1163,12 +1179,12 @@ static Int read2( if (inp_stream == -1) { return (FALSE); } - out = Yap_read_term(inp_stream, TermNil, 1); + out = Yap_read_term(inp_stream, add_output(ARG2, TermNil), false); UNLOCK(GLOBAL_Stream[inp_stream].streamlock); - return out && Yap_unify(ARG2, out); + 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 @@ -1180,8 +1196,8 @@ 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, TermNil, 1); - return out && Yap_unify(ARG1, out); + Term out = Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, TermNil), 1); + return out; } /** @pred fileerrors @@ -1252,38 +1268,35 @@ static Int style_checker(USES_REGS1) { return TRUE; } -X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, - int prio, Term *bindingsp) { - CACHE_REGS - Term ctl; - int lvl = push_text_stack(); - - if (len == 0) { - Term rval = TermEof; - pop_text_stack(lvl); - return rval; - } - if (bindingsp) { - ctl = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1); - } else { - ctl = TermNil; - } - +Term Yap_BufferToTerm(const unsigned char *s, size_t len, Term opts) { Term rval; - int stream = Yap_open_buf_read_stream(s, len, encp, MEM_BUF_USER); + int sno; + encoding_t L; + sno = Yap_open_buf_read_stream((char *)s, len, &L, MEM_BUF_USER); - rval = Yap_read_term(stream, ctl, 3); - Yap_CloseStream(stream); - UNLOCK(GLOBAL_Stream[stream].streamlock); - if (rval && bindingsp) { - *bindingsp = ArgOfTerm(1, ctl); - } - pop_text_stack(lvl); + rval = Yap_read_term(sno, opts, false); + Yap_CloseStream(sno); return rval; } +X_API Term Yap_BufferToTermWithPrioBindings(const unsigned char *s, size_t len, + Term opts, int prio, + Term bindings) { + 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, len, ctl); +} + /** - * @pred read_term_from_atom( +_Atom_ , - _T_ , + _Options_ + * @pred read_term_from_atom( +Atom , -T , +Options ) * * read a term _T_ stored in constant _Atom_ according to _Options_ * @@ -1291,14 +1304,19 @@ X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, * @param _T_ the output term _T_, may be any term * @param _Options_ read_term/3 options. * - * @notes 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 + * @notes 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), rc; + Term t1 = Deref(ARG1); Atom at; + const unsigned char *s; + size_t len; + if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "style_check/1"); return false; @@ -1307,31 +1325,21 @@ static Int read_term_from_atom(USES_REGS1) { return false; } else { at = AtomOfTerm(t1); + s = at->UStrOfAE; + len = strlen_utf8(s); } - if ((rc = Yap_AtomToTerm(at, Deref(ARG3))) == 0L) - return false; - return Yap_unify(rc, ARG2); -} + Term ctl = add_output(ARG2, ARG3); -Term Yap_AtomToTerm(Atom a, Term opts) { - Term rval; - int sno; - char *s = a->StrOfAE; - size_t len = strlen(s); - encoding_t enc = ENC_ISO_UTF8; - sno = Yap_open_buf_read_stream((char *)s, len, &enc, MEM_BUF_USER); - - rval = Yap_read_term(sno, opts, 3); - Yap_CloseStream(sno); - return rval; + return Yap_BufferToTerm(s, len, ctl); } /** - * @pred read_term_from_atomic( +_Atomic_ , - _T_ , + _Options_ ) + * @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 + * @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. @@ -1341,7 +1349,7 @@ Term Yap_AtomToTerm(Atom a, Term opts) { * Encoding is fixed in atoms and strings. */ static Int read_term_from_atomic(USES_REGS1) { - Term t1 = Deref(ARG1), rc; + Term t1 = Deref(ARG1); const unsigned char *s; size_t len; if (IsVarTerm(t1)) { @@ -1353,20 +1361,15 @@ static Int read_term_from_atomic(USES_REGS1) { } else { Term t = Yap_AtomicToString(t1 PASS_REGS); s = UStringOfTerm(t); - len = strlen_utf8((unsigned char *)s); + 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); - rc = Yap_read_term(sno, Deref(ARG3), 3); - Yap_CloseStream(sno); - if (!rc) - return false; - return Yap_unify(rc, ARG2); + Term ctl = add_output(ARG2, ARG3); + + return Yap_BufferToTerm(s, len, ctl); } /** - * @pred read_term_from_string( +_String_ , - _T_ , + _Options_ + * @pred read_term_from_string( +String , - T , + Options ) * * read a term _T_ stored in constant _String_ according to _Options_ * diff --git a/os/writeterm.c b/os/writeterm.c index e35dea94c..16f943073 100644 --- a/os/writeterm.c +++ b/os/writeterm.c @@ -716,7 +716,9 @@ static Int term_to_atom(USES_REGS1) { at = AtomOfTerm(t2); } ctl = TermNil; - return (rc = Yap_AtomToTerm(at, ctl)) && Yap_unify(rc, ARG1); + return (rc = Yap_BufferToTerm(RepAtom(at)->UStrOfAE, + strlen(RepAtom(at)->StrOfAE), ctl)) && + Yap_unify(rc, ARG1); } void Yap_InitWriteTPreds(void) { diff --git a/os/yapio.h b/os/yapio.h index a5d2144e1..99a70f1f3 100644 --- a/os/yapio.h +++ b/os/yapio.h @@ -105,8 +105,6 @@ typedef enum mem_buf_source { extern char *Yap_MemStreamBuf(int sno); -extern X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, - int prio, Term *bindingsp); extern Term Yap_StringToNumberTerm(const char *s, encoding_t *encp, bool error_on); extern int Yap_FormatFloat(Float f, char **s, size_t sz); @@ -115,7 +113,10 @@ extern int Yap_open_buf_read_stream(const char *buf, size_t nchars, extern bool Yap_set_stream_to_buf(struct stream_desc *st, const char *buf, size_t nchars); extern int Yap_open_buf_write_stream(encoding_t enc, memBufSource src); -extern Term Yap_AtomToTerm(Atom a, Term opts); +extern Term Yap_BufferToTerm(const unsigned char *s, size_t sz, Term opts); +extern X_API Term Yap_BufferToTermWithPrioBindings(const unsigned char *s, + size_t sz, Term opts, + int prio, Term bindings); extern FILE *Yap_GetInputStream(Term t, const char *m); extern FILE *Yap_GetOutputStream(Term t, const char *m); extern char *Yap_guessFileName(FILE *f, int sno, char *nameb, size_t max);