warnings and stream read wchar simplification
This commit is contained in:
parent
a82a72fc14
commit
304489c74f
26
os/format.c
26
os/format.c
@ -982,23 +982,22 @@ static Int doformat(volatile Term otail, volatile Term oargs,
|
||||
goto do_format_control_sequence_error;
|
||||
t = targs[targ++];
|
||||
yhandle_t slf = Yap_StartSlots();
|
||||
Yap_plwrite(t, GLOBAL_Stream + sno, 0,
|
||||
Handle_vars_f | To_heap_f,
|
||||
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f,
|
||||
GLOBAL_MaxPriority);
|
||||
Yap_CloseSlots(slf);
|
||||
Yap_CloseSlots(slf);
|
||||
break;
|
||||
case 'W':
|
||||
if (targ > tnum - 2 || has_repeats)
|
||||
goto do_format_control_sequence_error;
|
||||
targ -= 2;
|
||||
{
|
||||
yhandle_t slf = Yap_StartSlots();
|
||||
if (!Yap_WriteTerm( sno, targs[1], targs[0] PASS_REGS)) {
|
||||
targ -= 2;
|
||||
{
|
||||
yhandle_t slf = Yap_StartSlots();
|
||||
if (!Yap_WriteTerm(sno, targs[1], targs[0] PASS_REGS)) {
|
||||
Yap_CloseSlots(slf);
|
||||
goto do_default_error;
|
||||
};
|
||||
Yap_CloseSlots(slf);
|
||||
goto do_default_error;
|
||||
};
|
||||
Yap_CloseSlots(slf);
|
||||
}
|
||||
}
|
||||
break;
|
||||
case '~':
|
||||
if (has_repeats)
|
||||
@ -1200,7 +1199,7 @@ static Int with_output_to(USES_REGS1) {
|
||||
Term tin = Deref(ARG1);
|
||||
Functor f;
|
||||
bool out;
|
||||
bool mem_stream = false;
|
||||
bool my_mem_stream;
|
||||
yhandle_t hdl = Yap_PushHandle(tin);
|
||||
if (IsVarTerm(tin)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, tin, "with_output_to/3");
|
||||
@ -1215,6 +1214,7 @@ static Int with_output_to(USES_REGS1) {
|
||||
/* needs to change LOCAL_c_output_stream for write */
|
||||
output_stream = Yap_CheckStream(ARG1, Output_Stream_f, "format/3");
|
||||
my_mem_stream = false;
|
||||
f = NIL;
|
||||
}
|
||||
if (output_stream == -1) {
|
||||
return false;
|
||||
@ -1223,7 +1223,7 @@ static Int with_output_to(USES_REGS1) {
|
||||
out = Yap_Execute(Deref(ARG2) PASS_REGS);
|
||||
LOCK(GLOBAL_Stream[output_stream].streamlock);
|
||||
LOCAL_c_output_stream = old_out;
|
||||
if (mem_stream) {
|
||||
if (my_mem_stream) {
|
||||
Term tat;
|
||||
Term inp = Yap_GetFromHandle(hdl);
|
||||
if (out) {
|
||||
|
100
os/getw.h
100
os/getw.h
@ -2,9 +2,9 @@
|
||||
/// compose a wide char from a sequence of getchars
|
||||
/// this is a slow lane routine, called if no specialised code
|
||||
/// isavailable.
|
||||
static int GETW(int sno) {
|
||||
extern int get_wchar(int sno) {
|
||||
StreamDesc *st = GLOBAL_Stream + sno;
|
||||
int ch = GETC();
|
||||
int ch = st->stream_getc(sno);
|
||||
|
||||
if (ch == -1)
|
||||
return post_process_weof(st);
|
||||
@ -31,7 +31,7 @@ static int GETW(int sno) {
|
||||
buf[0] = ch;
|
||||
int n = 1;
|
||||
while ((out = mbrtowc(&wch, buf, 1, &(mbstate))) != 1) {
|
||||
int ch = buf[0] = GETC();
|
||||
int ch = buf[0] = st->stream_getc(sno);
|
||||
n++;
|
||||
if (ch == -1)
|
||||
return post_process_weof(st);
|
||||
@ -49,7 +49,7 @@ static int GETW(int sno) {
|
||||
// if ((ch - 0xc2) > (0xf4-0xc2)) return UTF8PROC_ERROR_INVALIDUTF8;
|
||||
if (ch < 0xe0) { // 2-byte sequence
|
||||
// Must have valid continuation character
|
||||
int c1 = buf[0] = GETC();
|
||||
int c1 = buf[0] = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
// if (!utf_cont(*str)) return UTF8PROC_ERROR_INVALIDUTF8;
|
||||
@ -62,22 +62,22 @@ static int GETW(int sno) {
|
||||
// Check for surrogate chars
|
||||
// if (ch == 0xed && *str > 0x9f)
|
||||
// return UTF8PROC_ERROR_INVALIDUTF8;
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
int c2 = GETC();
|
||||
int c2 = st->stream_getc(sno);
|
||||
if (c2 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = ((ch & 0xf) << 12) | ((c1 & 0x3f) << 6) | (c2 & 0x3f);
|
||||
return post_process_read_wchar(wch, 3, st);
|
||||
} else {
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
int c2 = GETC();
|
||||
int c2 = st->stream_getc(sno);
|
||||
if (c2 == -1)
|
||||
return post_process_weof(st);
|
||||
int c3 = GETC();
|
||||
int c3 = st->stream_getc(sno);
|
||||
if (c3 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = ((ch & 7) << 18) | ((c1 & 0x3f) << 12) | ((c2 & 0x3f) << 6) |
|
||||
@ -89,15 +89,15 @@ static int GETW(int sno) {
|
||||
// little-endian: start with big shot
|
||||
{
|
||||
int wch;
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = (c1 << 8) + ch;
|
||||
if (wch >= 0xd800 && wch < 0xdc00) {
|
||||
int c2 = GETC();
|
||||
int c2 = st->stream_getc(sno);
|
||||
if (c2 == -1)
|
||||
return post_process_weof(st);
|
||||
int c3 = GETC();
|
||||
int c3 = st->stream_getc(sno);
|
||||
if (c3 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = wch + (((c3 << 8) + c2) << wch) + SURROGATE_OFFSET;
|
||||
@ -110,15 +110,15 @@ static int GETW(int sno) {
|
||||
// little-endian: start with big shot
|
||||
{
|
||||
int wch;
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = (c1) + (ch << 8);
|
||||
if (wch >= 0xd800 && wch < 0xdc00) {
|
||||
int c3 = GETC();
|
||||
int c3 = st->stream_getc(sno);
|
||||
if (c3 == -1)
|
||||
return post_process_weof(st);
|
||||
int c2 = GETC();
|
||||
int c2 = st->stream_getc(sno);
|
||||
if (c2 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = (((c3 << 8) + c2) << 10) + wch + SURROGATE_OFFSET;
|
||||
@ -131,7 +131,7 @@ static int GETW(int sno) {
|
||||
// little-endian: start with big shot
|
||||
{
|
||||
int wch;
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = (c1) + (ch << 8);
|
||||
@ -142,7 +142,7 @@ static int GETW(int sno) {
|
||||
// little-endian: start with big shot
|
||||
{
|
||||
int wch;
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = (c1 << 8) + ch;
|
||||
@ -155,19 +155,19 @@ static int GETW(int sno) {
|
||||
{
|
||||
int wch = ch;
|
||||
{
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = wch + c1;
|
||||
}
|
||||
{
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = (wch << 8) + c1;
|
||||
}
|
||||
{
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = (wch << 8) + c1;
|
||||
@ -179,19 +179,19 @@ static int GETW(int sno) {
|
||||
{
|
||||
int wch = ch;
|
||||
{
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
wch += c1 << 8;
|
||||
}
|
||||
{
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
wch += c1 << 16;
|
||||
}
|
||||
{
|
||||
int c1 = GETC();
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
wch += c1 << 24;
|
||||
@ -204,3 +204,57 @@ static int GETW(int sno) {
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
|
||||
extern int get_wchar_UTF8(int sno) {
|
||||
StreamDesc *st = GLOBAL_Stream + sno;
|
||||
int ch = st->stream_getc(sno);
|
||||
|
||||
if (ch == -1)
|
||||
return post_process_weof(st);
|
||||
else {
|
||||
int wch;
|
||||
unsigned char buf[8];
|
||||
|
||||
if (ch < 0x80) {
|
||||
return post_process_read_wchar(ch, 1, st);
|
||||
}
|
||||
// if ((ch - 0xc2) > (0xf4-0xc2)) return UTF8PROC_ERROR_INVALIDUTF8;
|
||||
if (ch < 0xe0) { // 2-byte sequence
|
||||
// Must have valid continuation character
|
||||
int c1 = buf[0] = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
// if (!utf_cont(*str)) return UTF8PROC_ERROR_INVALIDUTF8;
|
||||
wch = ((ch & 0x1f) << 6) | (c1 & 0x3f);
|
||||
return post_process_read_wchar(wch, 2, st);
|
||||
}
|
||||
if (ch < 0xf0) { // 3-byte sequence
|
||||
// if ((str + 1 >= end) || !utf_cont(*str) || !utf_cont(str[1]))
|
||||
// return UTF8PROC_ERROR_INVALIDUTF8;
|
||||
// Check for surrogate chars
|
||||
// if (ch == 0xed && *str > 0x9f)
|
||||
// return UTF8PROC_ERROR_INVALIDUTF8;
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
int c2 = st->stream_getc(sno);
|
||||
if (c2 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = ((ch & 0xf) << 12) | ((c1 & 0x3f) << 6) | (c2 & 0x3f);
|
||||
return post_process_read_wchar(wch, 3, st);
|
||||
} else {
|
||||
int c1 = st->stream_getc(sno);
|
||||
if (c1 == -1)
|
||||
return post_process_weof(st);
|
||||
int c2 = st->stream_getc(sno);
|
||||
if (c2 == -1)
|
||||
return post_process_weof(st);
|
||||
int c3 = st->stream_getc(sno);
|
||||
if (c3 == -1)
|
||||
return post_process_weof(st);
|
||||
wch = ((ch & 7) << 18) | ((c1 & 0x3f) << 12) | ((c2 & 0x3f) << 6) |
|
||||
(c3 & 0x3f);
|
||||
return post_process_read_wchar(wch, 4, st);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
20
os/iopreds.c
20
os/iopreds.c
@ -97,16 +97,9 @@ static char SccsId[] = "%W% %G%";
|
||||
#define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR)
|
||||
#endif
|
||||
#endif
|
||||
#include "iopreds.h"
|
||||
//#define GETW get_wchar_from_FILE
|
||||
//#endif
|
||||
#define GETC() fgetwc(st->file)
|
||||
#include "getw.h"
|
||||
|
||||
#undef GETW
|
||||
#undef GETC
|
||||
#define GETW get_wchar
|
||||
#define GETC() st->stream_getc(sno)
|
||||
#include "iopreds.h"
|
||||
|
||||
#include "getw.h"
|
||||
|
||||
static int get_wchar_from_file(int);
|
||||
@ -254,7 +247,7 @@ static void unix_upd_stream_info(StreamDesc *s) {
|
||||
void Yap_DefaultStreamOps(StreamDesc *st) {
|
||||
CACHE_REGS
|
||||
st->stream_wputc = put_wchar;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_wgetc = get_wchar_UTF8;
|
||||
st->stream_putc = FilePutc;
|
||||
st->stream_getc = PlGetc;
|
||||
if (st->status & (Promptable_Stream_f)) {
|
||||
@ -664,10 +657,9 @@ int PlGetc(int sno) {
|
||||
}
|
||||
|
||||
// layered version
|
||||
static int get_wchar__(int sno) { return fgetwc(GLOBAL_Stream[sno].file); }
|
||||
|
||||
static int get_wchar_from_file(int sno) {
|
||||
return post_process_read_wchar(get_wchar__(sno), 1, GLOBAL_Stream + sno);
|
||||
static inline int get_wchar_from_file(int sno) {
|
||||
return post_process_read_wchar(fgetwc(GLOBAL_Stream[sno].file), 1,
|
||||
GLOBAL_Stream + sno);
|
||||
}
|
||||
|
||||
#ifndef MB_LEN_MAX
|
||||
|
567
os/readterm.c
567
os/readterm.c
@ -1,28 +1,28 @@
|
||||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: iopreds.c *
|
||||
* Last rev: 5/2/88 *
|
||||
* mods: *
|
||||
* comments: Input/Output C implemented predicates *
|
||||
* *
|
||||
*************************************************************************/
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: iopreds.c *
|
||||
* Last rev: 5/2/88 *
|
||||
* mods: *
|
||||
* comments: Input/Output C implemented predicates *
|
||||
* *
|
||||
*************************************************************************/
|
||||
#ifdef SCCS
|
||||
static char SccsId[] = "%W% %G%";
|
||||
#endif
|
||||
|
||||
/*
|
||||
* This file includes the definition of a miscellania of standard predicates
|
||||
* for yap refering to: Files and GLOBAL_Streams, Simple Input/Output,
|
||||
*
|
||||
*/
|
||||
* This file includes the definition of a miscellania of standard predicates
|
||||
* for yap refering to: Files and GLOBAL_Streams, Simple Input/Output,
|
||||
*
|
||||
*/
|
||||
|
||||
#include "Yap.h"
|
||||
#include "YapFlags.h"
|
||||
@ -110,19 +110,19 @@ static void clean_vars(VarEntry *p) {
|
||||
#ifdef O_QUASIQUOTATIONS
|
||||
/** '$qq_open'(+QQRange, -Stream) is det.
|
||||
|
||||
Opens a quasi-quoted memory range.
|
||||
Opens a quasi-quoted memory range.
|
||||
|
||||
@arg QQRange is a term '$quasi_quotation'(ReadData, Start, Length)
|
||||
@arg Stream is a UTF-8 encoded string, whose position indication
|
||||
reflects the location in the real file.
|
||||
@arg QQRange is a term '$quasi_quotation'(ReadData, Start, Length)
|
||||
@arg Stream is a UTF-8 encoded string, whose position indication
|
||||
reflects the location in the real file.
|
||||
*/
|
||||
|
||||
static Int qq_open(USES_REGS1) {
|
||||
PRED_LD
|
||||
|
||||
Term t = Deref(ARG1);
|
||||
Term t = Deref(ARG1);
|
||||
if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) =
|
||||
FunctorDQuasiQuotation) {
|
||||
FunctorDQuasiQuotation) {
|
||||
void *ptr;
|
||||
char *start;
|
||||
size_t l int s;
|
||||
@ -173,26 +173,26 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) {
|
||||
} else
|
||||
return TRUE;
|
||||
} else if (_PL_rd->quasi_quotations) /* user option, but no quotes */
|
||||
{
|
||||
return PL_unify_nil(_PL_rd->quasi_quotations);
|
||||
} else
|
||||
{
|
||||
return PL_unify_nil(_PL_rd->quasi_quotations);
|
||||
} else
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
#endif /*O_QUASIQUOTATIONS*/
|
||||
|
||||
#define READ_DEFS() \
|
||||
PAR("comments", list_filler, READ_COMMENTS) \
|
||||
, PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \
|
||||
PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \
|
||||
PAR("term_position", filler, READ_TERM_POSITION), \
|
||||
PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \
|
||||
PAR("singletons", filler, READ_SINGLETONS), \
|
||||
PAR("variables", filler, READ_VARIABLES), \
|
||||
PAR("variable_names", filler, READ_VARIABLE_NAMES), \
|
||||
PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \
|
||||
PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \
|
||||
PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END)
|
||||
#define READ_DEFS() \
|
||||
PAR("comments", list_filler, READ_COMMENTS) \
|
||||
, PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \
|
||||
PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \
|
||||
PAR("term_position", filler, READ_TERM_POSITION), \
|
||||
PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \
|
||||
PAR("singletons", filler, READ_SINGLETONS), \
|
||||
PAR("variables", filler, READ_VARIABLES), \
|
||||
PAR("variable_names", filler, READ_VARIABLE_NAMES), \
|
||||
PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \
|
||||
PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \
|
||||
PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END)
|
||||
|
||||
#define PAR(x, y, z) z
|
||||
|
||||
@ -200,24 +200,24 @@ typedef enum open_enum_choices { READ_DEFS() } read_choices_t;
|
||||
|
||||
#undef PAR
|
||||
|
||||
#define PAR(x, y, z) \
|
||||
#define PAR(x, y, z) \
|
||||
{ x, y, z }
|
||||
|
||||
static const param_t read_defs[] = {READ_DEFS()};
|
||||
#undef PAR
|
||||
|
||||
/**
|
||||
* Syntax Error Handler
|
||||
*
|
||||
* @par tokptr: the sequence of tokens
|
||||
* @par sno: the stream numbet
|
||||
*
|
||||
* Implicit arguments:
|
||||
* +
|
||||
*/
|
||||
* Syntax Error Handler
|
||||
*
|
||||
* @par tokptr: the sequence of tokens
|
||||
* @par sno: the stream numbet
|
||||
*
|
||||
* Implicit arguments:
|
||||
* +
|
||||
*/
|
||||
static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
|
||||
CACHE_REGS
|
||||
Term info;
|
||||
Term info;
|
||||
Term startline, errline, endline;
|
||||
Term tf[4];
|
||||
Term *tailp = tf + 3;
|
||||
@ -264,71 +264,93 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
|
||||
t0[0] = TermNil;
|
||||
}
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
|
||||
} break;
|
||||
case QuasiQuotes_tok: {
|
||||
Term t0[2];
|
||||
t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>"));
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
|
||||
} break;
|
||||
case WQuasiQuotes_tok: {
|
||||
Term t0[2];
|
||||
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>"));
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
|
||||
} break;
|
||||
}
|
||||
break;
|
||||
case QuasiQuotes_tok:
|
||||
{
|
||||
Term t0[2];
|
||||
t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>"));
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
|
||||
}
|
||||
break;
|
||||
case WQuasiQuotes_tok:
|
||||
{
|
||||
Term t0[2];
|
||||
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>"));
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
|
||||
}
|
||||
break;
|
||||
case Number_tok:
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo));
|
||||
break;
|
||||
case Var_tok: {
|
||||
Term t[2];
|
||||
VarEntry *varinfo = (VarEntry *)info;
|
||||
case Var_tok:
|
||||
{
|
||||
Term t[2];
|
||||
VarEntry *varinfo = (VarEntry *)info;
|
||||
|
||||
t[0] = MkIntTerm(0);
|
||||
t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS);
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
|
||||
} break;
|
||||
case String_tok: {
|
||||
Term t0 = Yap_CharsToTDQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
|
||||
if (!t0) {
|
||||
return 0;
|
||||
t[0] = MkIntTerm(0);
|
||||
t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS);
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
|
||||
}
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
|
||||
} break;
|
||||
case WString_tok: {
|
||||
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS);
|
||||
if (!t0)
|
||||
return 0;
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
|
||||
} break;
|
||||
case BQString_tok: {
|
||||
Term t0 = Yap_CharsToTBQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
|
||||
} break;
|
||||
case WBQString_tok: {
|
||||
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, cmod PASS_REGS);
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
|
||||
} break;
|
||||
case Error_tok: {
|
||||
ts[0] = MkAtomTerm(AtomError);
|
||||
} break;
|
||||
break;
|
||||
case String_tok:
|
||||
{
|
||||
Term t0 = Yap_CharsToTDQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
|
||||
if (!t0) {
|
||||
return 0;
|
||||
}
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
|
||||
}
|
||||
break;
|
||||
case WString_tok:
|
||||
{
|
||||
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS);
|
||||
if (!t0)
|
||||
return 0;
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
|
||||
}
|
||||
break;
|
||||
case BQString_tok:
|
||||
{
|
||||
Term t0 = Yap_CharsToTBQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
|
||||
}
|
||||
break;
|
||||
case WBQString_tok:
|
||||
{
|
||||
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, cmod PASS_REGS);
|
||||
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
|
||||
}
|
||||
break;
|
||||
case Error_tok:
|
||||
{
|
||||
ts[0] = MkAtomTerm(AtomError);
|
||||
}
|
||||
break;
|
||||
case eot_tok:
|
||||
endline = MkIntegerTerm(tok->TokPos);
|
||||
ts[0] = MkAtomTerm(Yap_LookupAtom("EOT"));
|
||||
|
||||
break;
|
||||
case Ponctuation_tok: {
|
||||
char s[2];
|
||||
s[1] = '\0';
|
||||
if ((info) == 'l') {
|
||||
s[0] = '(';
|
||||
} else {
|
||||
s[0] = (char)info;
|
||||
case Ponctuation_tok:
|
||||
{
|
||||
char s[2];
|
||||
s[1] = '\0';
|
||||
if ((info) == 'l') {
|
||||
s[0] = '(';
|
||||
} else {
|
||||
s[0] = (char)info;
|
||||
}
|
||||
ts[0] = MkAtomTerm(Yap_LookupAtom(s));
|
||||
}
|
||||
ts[0] = MkAtomTerm(Yap_LookupAtom(s));
|
||||
}
|
||||
}
|
||||
if (tok->TokNext) {
|
||||
tok = tok->TokNext;
|
||||
if (!tok)
|
||||
} else {
|
||||
endline = MkIntegerTerm(tok->TokPos);
|
||||
tok = NULL;
|
||||
break;
|
||||
}
|
||||
*tailp = MkPairTerm(ts[0], TermNil);
|
||||
tailp = RepPair(*tailp) + 1;
|
||||
}
|
||||
@ -398,7 +420,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
|
||||
int inp_stream);
|
||||
static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
|
||||
CACHE_REGS
|
||||
LOCAL_VarTable = NULL;
|
||||
LOCAL_VarTable = NULL;
|
||||
LOCAL_AnonVarTable = NULL;
|
||||
fe->enc = GLOBAL_Stream[inp_stream].encoding;
|
||||
xarg *args = Yap_ArgListToVector(opts, read_defs, READ_END);
|
||||
@ -495,7 +517,7 @@ typedef enum {
|
||||
|
||||
Int Yap_FirstLineInParse(void) {
|
||||
CACHE_REGS
|
||||
return LOCAL_StartLineCount;
|
||||
return LOCAL_StartLineCount;
|
||||
}
|
||||
|
||||
#define PUSHFET(X) *HR++ = fe->X
|
||||
@ -504,7 +526,7 @@ Int Yap_FirstLineInParse(void) {
|
||||
static void reset_regs(TokEntry *tokstart, FEnv *fe) {
|
||||
CACHE_REGS
|
||||
|
||||
restore_machine_regs();
|
||||
restore_machine_regs();
|
||||
|
||||
/* restart global */
|
||||
PUSHFET(qq);
|
||||
@ -531,7 +553,7 @@ static void reset_regs(TokEntry *tokstart, FEnv *fe) {
|
||||
|
||||
static Term get_variables(FEnv *fe, TokEntry *tokstart) {
|
||||
CACHE_REGS
|
||||
Term v;
|
||||
Term v;
|
||||
if (fe->vp) {
|
||||
while (true) {
|
||||
fe->old_H = HR;
|
||||
@ -551,7 +573,7 @@ static Term get_variables(FEnv *fe, TokEntry *tokstart) {
|
||||
|
||||
static Term get_varnames(FEnv *fe, TokEntry *tokstart) {
|
||||
CACHE_REGS
|
||||
Term v;
|
||||
Term v;
|
||||
if (fe->np) {
|
||||
while (true) {
|
||||
fe->old_H = HR;
|
||||
@ -571,7 +593,7 @@ static Term get_varnames(FEnv *fe, TokEntry *tokstart) {
|
||||
|
||||
static Term get_singletons(FEnv *fe, TokEntry *tokstart) {
|
||||
CACHE_REGS
|
||||
Term v;
|
||||
Term v;
|
||||
if (fe->sp) {
|
||||
while (TRUE) {
|
||||
fe->old_H = HR;
|
||||
@ -589,7 +611,7 @@ static Term get_singletons(FEnv *fe, TokEntry *tokstart) {
|
||||
|
||||
static void warn_singletons(FEnv *fe, TokEntry *tokstart) {
|
||||
CACHE_REGS
|
||||
Term v;
|
||||
Term v;
|
||||
fe->sp = TermNil;
|
||||
v = get_singletons(fe, tokstart);
|
||||
if (v && v != TermNil) {
|
||||
@ -611,7 +633,7 @@ static void warn_singletons(FEnv *fe, TokEntry *tokstart) {
|
||||
|
||||
static Term get_stream_position(FEnv *fe, TokEntry *tokstart) {
|
||||
CACHE_REGS
|
||||
Term v;
|
||||
Term v;
|
||||
if (fe->tp) {
|
||||
while (true) {
|
||||
fe->old_H = HR;
|
||||
@ -629,7 +651,7 @@ static Term get_stream_position(FEnv *fe, TokEntry *tokstart) {
|
||||
|
||||
static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
|
||||
CACHE_REGS
|
||||
Term v1, v2, v3, vc, tp;
|
||||
Term v1, v2, v3, vc, tp;
|
||||
|
||||
if (fe->t && fe->vp)
|
||||
v1 = get_variables(fe, tokstart);
|
||||
@ -657,15 +679,15 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
|
||||
// trail must be ok by now.]
|
||||
if (fe->t) {
|
||||
return (!v1 || Yap_unify(v1, fe->vp)) && (!v2 || Yap_unify(v2, fe->np)) &&
|
||||
(!v3 || Yap_unify(v3, fe->sp)) && (!tp || Yap_unify(tp, fe->tp)) &&
|
||||
(!vc || Yap_unify(vc, fe->tcomms));
|
||||
(!v3 || Yap_unify(v3, fe->sp)) && (!tp || Yap_unify(tp, fe->tp)) &&
|
||||
(!vc || Yap_unify(vc, fe->tcomms));
|
||||
}
|
||||
return true;
|
||||
}
|
||||
|
||||
static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
|
||||
CACHE_REGS
|
||||
Term v_vp, v_vnames, v_comments, v_pos;
|
||||
Term v_vp, v_vnames, v_comments, v_pos;
|
||||
|
||||
if (fe->t && fe->vp)
|
||||
v_vp = get_variables(fe, tokstart);
|
||||
@ -691,9 +713,9 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
|
||||
// trail must be ok by now.]
|
||||
if (fe->t) {
|
||||
return (!v_vp || Yap_unify(v_vp, fe->vp)) &&
|
||||
(!v_vnames || Yap_unify(v_vnames, fe->np)) &&
|
||||
(!v_pos || Yap_unify(v_pos, fe->tp)) &&
|
||||
(!v_comments || Yap_unify(v_comments, fe->tcomms));
|
||||
(!v_vnames || Yap_unify(v_vnames, fe->np)) &&
|
||||
(!v_pos || Yap_unify(v_pos, fe->tp)) &&
|
||||
(!v_comments || Yap_unify(v_comments, fe->tcomms));
|
||||
}
|
||||
return true;
|
||||
}
|
||||
@ -711,8 +733,8 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream);
|
||||
|
||||
static parser_state_t scanEOF(FEnv *fe, int inp_stream) {
|
||||
CACHE_REGS
|
||||
// bool store_comments = false;
|
||||
TokEntry *tokstart = LOCAL_tokptr;
|
||||
// bool store_comments = false;
|
||||
TokEntry *tokstart = LOCAL_tokptr;
|
||||
// check for an user abort
|
||||
if (tokstart != NULL && tokstart->Tok != Ord(eot_tok)) {
|
||||
/* we got the end of file from an abort */
|
||||
@ -752,7 +774,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
|
||||
LOCAL_ErrorMessage = NULL;
|
||||
LOCAL_ErrorMessage = NULL;
|
||||
fe->old_TR = TR;
|
||||
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
||||
LOCAL_SourceFileName = GLOBAL_Stream[inp_stream].name;
|
||||
@ -789,11 +811,11 @@ static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream,
|
||||
|
||||
static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
|
||||
CACHE_REGS
|
||||
/* preserve value of H after scanning: otherwise we may lose strings
|
||||
and floats */
|
||||
LOCAL_tokptr = LOCAL_toktide =
|
||||
/* preserve value of H after scanning: otherwise we may lose strings
|
||||
and floats */
|
||||
LOCAL_tokptr = LOCAL_toktide =
|
||||
|
||||
Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &fe->tpos);
|
||||
Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &fe->tpos);
|
||||
if (LOCAL_ErrorMessage)
|
||||
return YAP_SCANNING_ERROR;
|
||||
if (LOCAL_tokptr->Tok != Ord(eot_tok)) {
|
||||
@ -814,7 +836,7 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
|
||||
|
||||
static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) {
|
||||
CACHE_REGS
|
||||
fe->t = 0;
|
||||
fe->t = 0;
|
||||
// running out of memory
|
||||
if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL) {
|
||||
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
||||
@ -854,7 +876,7 @@ static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) {
|
||||
|
||||
static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
|
||||
CACHE_REGS
|
||||
fe->t = 0;
|
||||
fe->t = 0;
|
||||
if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL ||
|
||||
LOCAL_Error_TYPE == RESOURCE_ERROR_AUXILIARY_STACK ||
|
||||
LOCAL_Error_TYPE == RESOURCE_ERROR_HEAP ||
|
||||
@ -884,7 +906,7 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
|
||||
|
||||
static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) {
|
||||
CACHE_REGS
|
||||
TokEntry *tokstart = LOCAL_tokptr;
|
||||
TokEntry *tokstart = LOCAL_tokptr;
|
||||
fe->t = Yap_Parse(re->prio, fe->enc, fe->cmod);
|
||||
fe->toklast = LOCAL_tokptr;
|
||||
LOCAL_tokptr = tokstart;
|
||||
@ -939,33 +961,34 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
|
||||
case YAP_PARSING_ERROR:
|
||||
state = parseError(&re, &fe, inp_stream);
|
||||
break;
|
||||
case YAP_PARSING_FINISHED: {
|
||||
CACHE_REGS
|
||||
bool done;
|
||||
if (fe.reading_clause)
|
||||
done = complete_clause_processing(&fe, LOCAL_tokptr);
|
||||
else
|
||||
done = complete_processing(&fe, LOCAL_tokptr);
|
||||
if (!done) {
|
||||
state = YAP_PARSING_ERROR;
|
||||
fe.t = 0;
|
||||
break;
|
||||
}
|
||||
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
|
||||
Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
|
||||
}
|
||||
case YAP_PARSING_FINISHED:
|
||||
{
|
||||
CACHE_REGS
|
||||
bool done;
|
||||
if (fe.reading_clause)
|
||||
done = complete_clause_processing(&fe, LOCAL_tokptr);
|
||||
else
|
||||
done = complete_processing(&fe, LOCAL_tokptr);
|
||||
if (!done) {
|
||||
state = YAP_PARSING_ERROR;
|
||||
fe.t = 0;
|
||||
break;
|
||||
}
|
||||
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
|
||||
Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
|
||||
}
|
||||
#if EMACS
|
||||
first_char = tokstart->TokPos;
|
||||
first_char = tokstart->TokPos;
|
||||
#endif /* EMACS */
|
||||
return fe.t;
|
||||
}
|
||||
return fe.t;
|
||||
}
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static Int
|
||||
read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
|
||||
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)
|
||||
@ -975,7 +998,7 @@ static Int
|
||||
}
|
||||
|
||||
static Int read_term(
|
||||
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
|
||||
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
|
||||
int inp_stream;
|
||||
Term out;
|
||||
|
||||
@ -992,14 +1015,14 @@ static Int read_term(
|
||||
return out != 0L && Yap_unify(tf, out);
|
||||
}
|
||||
|
||||
#define READ_CLAUSE_DEFS() \
|
||||
PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \
|
||||
, PAR("module", isatom, READ_CLAUSE_MODULE), \
|
||||
PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \
|
||||
PAR("variables", filler, READ_CLAUSE_VARIABLES), \
|
||||
PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \
|
||||
PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \
|
||||
PAR(NULL, ok, READ_CLAUSE_END)
|
||||
#define READ_CLAUSE_DEFS() \
|
||||
PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \
|
||||
, PAR("module", isatom, READ_CLAUSE_MODULE), \
|
||||
PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \
|
||||
PAR("variables", filler, READ_CLAUSE_VARIABLES), \
|
||||
PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \
|
||||
PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \
|
||||
PAR(NULL, ok, READ_CLAUSE_END)
|
||||
|
||||
#define PAR(x, y, z) z
|
||||
|
||||
@ -1009,7 +1032,7 @@ typedef enum read_clause_enum_choices {
|
||||
|
||||
#undef PAR
|
||||
|
||||
#define PAR(x, y, z) \
|
||||
#define PAR(x, y, z) \
|
||||
{ x, y, z }
|
||||
|
||||
static const param_t read_clause_defs[] = {READ_CLAUSE_DEFS()};
|
||||
@ -1019,7 +1042,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
|
||||
int inp_stream) {
|
||||
CACHE_REGS
|
||||
|
||||
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END);
|
||||
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END);
|
||||
if (args == NULL) {
|
||||
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
|
||||
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
|
||||
@ -1077,11 +1100,11 @@ 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.
|
||||
*
|
||||
*/
|
||||
*
|
||||
*/
|
||||
static Int read_clause2(USES_REGS1) {
|
||||
Term rc;
|
||||
yhandle_t h = Yap_InitSlot(ARG1);
|
||||
@ -1092,28 +1115,28 @@ static Int read_clause2(USES_REGS1) {
|
||||
}
|
||||
|
||||
/**
|
||||
* @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det
|
||||
*
|
||||
* This predicate receives a set of options _OPts_ based on read_term/3, but
|
||||
*specific
|
||||
* to readin clauses. The following options are considered:
|
||||
*
|
||||
* + The `comments` option unifies its argument with the comments in the term,
|
||||
* represented as strings
|
||||
* + The `process_comments` option calls a hook, it is current ignored by YAP.
|
||||
* + The `term_position` unifies its argument with a term describing the
|
||||
* position of the term.
|
||||
* + The `syntax_errors` flag controls response to syntactic errors, the
|
||||
*default is `dec10`.
|
||||
*
|
||||
* The next two options are called implicitly:
|
||||
*
|
||||
* + The `module` option is initialized to the current source module, by
|
||||
*default.
|
||||
* + The `singletons` option is set from the single var flag
|
||||
*/
|
||||
* @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det
|
||||
*
|
||||
* This predicate receives a set of options _OPts_ based on read_term/3, but
|
||||
*specific
|
||||
* to readin clauses. The following options are considered:
|
||||
*
|
||||
* + The `comments` option unifies its argument with the comments in the term,
|
||||
* represented as strings
|
||||
* + The `process_comments` option calls a hook, it is current ignored by YAP.
|
||||
* + The `term_position` unifies its argument with a term describing the
|
||||
* position of the term.
|
||||
* + The `syntax_errors` flag controls response to syntactic errors, the
|
||||
*default is `dec10`.
|
||||
*
|
||||
* The next two options are called implicitly:
|
||||
*
|
||||
* + The `module` option is initialized to the current source module, by
|
||||
*default.
|
||||
* + The `singletons` option is set from the single var flag
|
||||
*/
|
||||
static Int read_clause(
|
||||
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
|
||||
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
|
||||
int inp_stream;
|
||||
Term out;
|
||||
Term t3 = Deref(ARG3);
|
||||
@ -1141,36 +1164,36 @@ static Int read_clause(
|
||||
}
|
||||
|
||||
/**
|
||||
* @pred source_location( - _File_ , _Line_ )
|
||||
*
|
||||
* unify _File_ and _Line_ wuth the position of the last term read, if the term
|
||||
* comes from a stream created by opening a file-system path with open/3 and
|
||||
*friends.>position
|
||||
* It ignores user_input or
|
||||
* sockets.
|
||||
*
|
||||
* @param - _File_
|
||||
* @param - _Line_
|
||||
*
|
||||
* @note SWI-Prolog built-in.
|
||||
*/
|
||||
* @pred source_location( - _File_ , _Line_ )
|
||||
*
|
||||
* unify _File_ and _Line_ wuth the position of the last term read, if the term
|
||||
* comes from a stream created by opening a file-system path with open/3 and
|
||||
*friends.>position
|
||||
* It ignores user_input or
|
||||
* sockets.
|
||||
*
|
||||
* @param - _File_
|
||||
* @param - _Line_
|
||||
*
|
||||
* @note SWI-Prolog built-in.
|
||||
*/
|
||||
static Int source_location(USES_REGS1) {
|
||||
return Yap_unify(ARG1, MkAtomTerm(LOCAL_SourceFileName)) &&
|
||||
Yap_unify(ARG2, MkIntegerTerm(LOCAL_SourceFileLineno));
|
||||
Yap_unify(ARG2, MkIntegerTerm(LOCAL_SourceFileLineno));
|
||||
}
|
||||
|
||||
/**
|
||||
* @pred read(+ _Stream_, - _Term_ ) is iso
|
||||
*
|
||||
* Reads term _T_ from the stream _S_ instead of from the current input
|
||||
* stream.
|
||||
*
|
||||
* @param - _Stream_
|
||||
* @param - _Term_
|
||||
*
|
||||
*/
|
||||
* @pred read(+ _Stream_, - _Term_ ) is iso
|
||||
*
|
||||
* Reads term _T_ from the stream _S_ instead of from the current input
|
||||
* stream.
|
||||
*
|
||||
* @param - _Stream_
|
||||
* @param - _Term_
|
||||
*
|
||||
*/
|
||||
static Int read2(
|
||||
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
|
||||
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
|
||||
int inp_stream;
|
||||
Int out;
|
||||
|
||||
@ -1186,24 +1209,24 @@ static Int read2(
|
||||
|
||||
/** @pred read(- _T_) is iso
|
||||
|
||||
Reads the next term from the current input stream, and unifies it with
|
||||
_T_. The term must be followed by a dot (`.`) and any blank-character
|
||||
as previously defined. The syntax of the term must match the current
|
||||
declarations for operators (see op). If the end-of-stream is reached,
|
||||
_T_ is unified with the atom `end_of_file`. Further reads from of
|
||||
the same stream may cause an error failure (see open/3).
|
||||
Reads the next term from the current input stream, and unifies it with
|
||||
_T_. The term must be followed by a dot (`.`) and any blank-character
|
||||
as previously defined. The syntax of the term must match the current
|
||||
declarations for operators (see op). If the end-of-stream is reached,
|
||||
_T_ is unified with the atom `end_of_file`. Further reads from of
|
||||
the same stream may cause an error failure (see open/3).
|
||||
|
||||
*/
|
||||
static Int read1(
|
||||
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
|
||||
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);
|
||||
}
|
||||
|
||||
/** @pred fileerrors
|
||||
|
||||
Switches on the file_errors flag so that in certain error conditions
|
||||
Input/Output predicates will produce an appropriated message and abort.
|
||||
Switches on the file_errors flag so that in certain error conditions
|
||||
Input/Output predicates will produce an appropriated message and abort.
|
||||
|
||||
*/
|
||||
static Int fileerrors(USES_REGS1) {
|
||||
@ -1211,16 +1234,16 @@ static Int fileerrors(USES_REGS1) {
|
||||
}
|
||||
|
||||
/**
|
||||
@pred nofileerrors
|
||||
@pred nofileerrors
|
||||
|
||||
Switches off the `file_errors` flag, so that the predicates see/1,
|
||||
tell/1, open/3 and close/1 just fail, instead of producing
|
||||
an error message and aborting whenever the specified file cannot be
|
||||
opened or closed.
|
||||
Switches off the `file_errors` flag, so that the predicates see/1,
|
||||
tell/1, open/3 and close/1 just fail, instead of producing
|
||||
an error message and aborting whenever the specified file cannot be
|
||||
opened or closed.
|
||||
|
||||
*/
|
||||
static Int nofileerrors(
|
||||
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
|
||||
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
|
||||
return setYapFlag(TermFileerrors, TermFalse);
|
||||
}
|
||||
|
||||
@ -1271,7 +1294,7 @@ static Int style_checker(USES_REGS1) {
|
||||
X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp,
|
||||
int prio, Term *bindings) {
|
||||
CACHE_REGS
|
||||
Term bvar = MkVarTerm(), ctl;
|
||||
Term bvar = MkVarTerm(), ctl;
|
||||
yhandle_t sl;
|
||||
|
||||
if (bindings) {
|
||||
@ -1294,21 +1317,20 @@ X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp,
|
||||
return rval;
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* @pred read_term_from_atom( +_Atom_ , - _T_ , + _Options_
|
||||
*
|
||||
* read a term _T_ stored in constant _Atom_ according to _Options_
|
||||
*
|
||||
* @param _Atom_ the source _Atom_
|
||||
* @param _T_ the output term _T_, may be any term
|
||||
* @param _Options_ read_term/3 options.
|
||||
*
|
||||
* @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.
|
||||
*/
|
||||
* @pred read_term_from_atom( +_Atom_ , - _T_ , + _Options_
|
||||
*
|
||||
* read a term _T_ stored in constant _Atom_ according to _Options_
|
||||
*
|
||||
* @param _Atom_ the source _Atom_
|
||||
* @param _T_ the output term _T_, may be any term
|
||||
* @param _Options_ read_term/3 options.
|
||||
*
|
||||
* @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;
|
||||
Atom at;
|
||||
@ -1347,17 +1369,17 @@ Term Yap_AtomToTerm(Atom a, Term opts) {
|
||||
}
|
||||
|
||||
/**
|
||||
* @pred read_term_from_string( +_String_ , - _T_ , + _Options_
|
||||
*
|
||||
* read a term _T_ stored in constant _String_ according to _Options_
|
||||
*
|
||||
* @param _String_ the source _String_
|
||||
* @param _T_ the output term _T_, may be any term
|
||||
* @param _Options_ read_term/3 options.
|
||||
*
|
||||
* @notes Idea from SWI-Prolog, in YAP only works with strings
|
||||
* Check read_term_from_atomic/3 for the general version.
|
||||
*/
|
||||
* @pred read_term_from_string( +_String_ , - _T_ , + _Options_
|
||||
*
|
||||
* read a term _T_ stored in constant _String_ according to _Options_
|
||||
*
|
||||
* @param _String_ the source _String_
|
||||
* @param _T_ the output term _T_, may be any term
|
||||
* @param _Options_ read_term/3 options.
|
||||
*
|
||||
* @notes Idea from SWI-Prolog, in YAP only works with strings
|
||||
* Check read_term_from_atomic/3 for the general version.
|
||||
*/
|
||||
static Int read_term_from_string(USES_REGS1) {
|
||||
Term t1 = Deref(ARG1), rc;
|
||||
const unsigned char *s;
|
||||
@ -1384,7 +1406,7 @@ static Int read_term_from_string(USES_REGS1) {
|
||||
|
||||
static Int string_to_term(USES_REGS1) {
|
||||
Term t1 = Deref(ARG1), rc;
|
||||
const char *s;
|
||||
const char *s;
|
||||
size_t len;
|
||||
if (IsVarTerm(t1)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
|
||||
@ -1397,8 +1419,7 @@ static Int string_to_term(USES_REGS1) {
|
||||
len = strlen_utf8((const unsigned char *)s);
|
||||
}
|
||||
encoding_t enc = ENC_ISO_UTF8;
|
||||
rc = Yap_StringToTerm(s, len, &enc,
|
||||
1200, &ARG3);
|
||||
rc = Yap_StringToTerm(s, len, &enc, 1200, &ARG3);
|
||||
if (!rc)
|
||||
return false;
|
||||
return Yap_unify(rc, ARG2);
|
||||
@ -1411,7 +1432,7 @@ static Int atomic_to_term(USES_REGS1) {
|
||||
if (IsVarTerm(t1)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
|
||||
return (FALSE);
|
||||
} else if (!IsAtomicTerm(t1)) {
|
||||
} else if (!IsAtomicTerm(t1)) {
|
||||
Yap_Error(TYPE_ERROR_ATOMIC, t1, "read_term_from_atomic/3");
|
||||
return (FALSE);
|
||||
} else {
|
||||
@ -1420,8 +1441,7 @@ static Int atomic_to_term(USES_REGS1) {
|
||||
len = strlen_utf8((unsigned char *)s);
|
||||
}
|
||||
encoding_t enc = ENC_ISO_UTF8;
|
||||
rc = Yap_StringToTerm(s, len, &enc,
|
||||
1200, &ARG3);
|
||||
rc = Yap_StringToTerm(s, len, &enc, 1200, &ARG3);
|
||||
if (!rc)
|
||||
return false;
|
||||
return Yap_unify(rc, ARG2);
|
||||
@ -1429,12 +1449,12 @@ static Int atomic_to_term(USES_REGS1) {
|
||||
|
||||
static Int atom_to_term(USES_REGS1) {
|
||||
Term t1 = Deref(ARG1), rc;
|
||||
const char *s;
|
||||
const char *s;
|
||||
size_t len;
|
||||
if (IsVarTerm(t1)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
|
||||
return (FALSE);
|
||||
} else if (!IsAtomTerm(t1)) {
|
||||
} else if (!IsAtomTerm(t1)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, t1, "read_term_from_atomic/3");
|
||||
return (FALSE);
|
||||
} else {
|
||||
@ -1443,27 +1463,26 @@ static Int atom_to_term(USES_REGS1) {
|
||||
len = strlen_utf8((const unsigned char *)s);
|
||||
}
|
||||
encoding_t enc = ENC_ISO_UTF8;
|
||||
rc = Yap_StringToTerm(s, len, &enc,
|
||||
1200, &ARG3);
|
||||
rc = Yap_StringToTerm(s, len, &enc, 1200, &ARG3);
|
||||
if (!rc)
|
||||
return false;
|
||||
return Yap_unify(rc, ARG2);
|
||||
}
|
||||
|
||||
/**
|
||||
* @pred read_term_from_atomic( +_Atomic_ , - _T_ , + _Options_ )
|
||||
*
|
||||
* read a term _T_ stored in text _Atomic_ according to _Options_
|
||||
*
|
||||
* @param _Atomic_ the source may be an atom, string, list of codes, or list of
|
||||
*chars.
|
||||
* @param _T_ the output term _T_, may be any term
|
||||
* @param _Options_ read_term/3 options.
|
||||
*
|
||||
* @notes Idea originally from SWI-Prolog, but in YAP we separate atomic and
|
||||
*atom.
|
||||
* Encoding is fixed in atoms and strings.
|
||||
*/
|
||||
* @pred read_term_from_atomic( +_Atomic_ , - _T_ , + _Options_ )
|
||||
*
|
||||
* read a term _T_ stored in text _Atomic_ according to _Options_
|
||||
*
|
||||
* @param _Atomic_ the source may be an atom, string, list of codes, or list of
|
||||
*chars.
|
||||
* @param _T_ the output term _T_, may be any term
|
||||
* @param _Options_ read_term/3 options.
|
||||
*
|
||||
* @notes Idea originally from SWI-Prolog, but in YAP we separate atomic and
|
||||
*atom.
|
||||
* Encoding is fixed in atoms and strings.
|
||||
*/
|
||||
static Int read_term_from_atomic(USES_REGS1) {
|
||||
Term t1 = Deref(ARG1), rc;
|
||||
const unsigned char *s;
|
||||
@ -1479,11 +1498,11 @@ static Int read_term_from_atomic(USES_REGS1) {
|
||||
s = UStringOfTerm(t);
|
||||
len = strlen_utf8((unsigned char *)s);
|
||||
}
|
||||
char *ss = (char *)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);
|
||||
rc = Yap_read_term(sno, Deref(ARG3), 3);
|
||||
Yap_CloseStream(sno);
|
||||
if (!rc)
|
||||
return false;
|
||||
return Yap_unify(rc, ARG2);
|
||||
@ -1499,8 +1518,8 @@ void Yap_InitReadTPreds(void) {
|
||||
Yap_InitCPred("read_term_from_atom", 3, read_term_from_atom, 0);
|
||||
Yap_InitCPred("read_term_from_atomic", 3, read_term_from_atomic, 0);
|
||||
Yap_InitCPred("read_term_from_string", 3, read_term_from_string, 0);
|
||||
Yap_InitCPred("atom_to_term", 3, atom_to_term, 0);
|
||||
Yap_InitCPred("atomic_to_term", 3, atomic_to_term, 0);
|
||||
Yap_InitCPred("atom_to_term", 3, atom_to_term, 0);
|
||||
Yap_InitCPred("atomic_to_term", 3, atomic_to_term, 0);
|
||||
Yap_InitCPred("string_to_term", 3, string_to_term, 0);
|
||||
|
||||
Yap_InitCPred("fileerrors", 0, fileerrors, SyncPredFlag);
|
||||
|
@ -248,11 +248,12 @@ has_reposition(int sno,
|
||||
}
|
||||
|
||||
char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) {
|
||||
size_t maxs = max(255, max);
|
||||
if (!nameb) {
|
||||
nameb = malloc(max(256, max));
|
||||
nameb = malloc(maxs + 1);
|
||||
}
|
||||
if (!file) {
|
||||
strcpy(nameb, "memory buffer");
|
||||
strncpy(nameb, "memory buffer", maxs);
|
||||
return nameb;
|
||||
}
|
||||
int f = fileno(file);
|
||||
@ -275,7 +276,7 @@ char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) {
|
||||
return NULL;
|
||||
else {
|
||||
int i;
|
||||
unsigned char *ptr = nameb;
|
||||
unsigned char *ptr = (unsigned char *)nameb;
|
||||
for (i = 0; i < strlen(path); i++)
|
||||
ptr += put_utf8(ptr, path[i]);
|
||||
*ptr = '\0';
|
||||
|
@ -1181,7 +1181,7 @@ const char *Yap_findFile(const char *isource, const char *idef,
|
||||
YAP_file_type_t ftype, bool expand_root, bool in_lib) {
|
||||
|
||||
char *save_buffer = NULL;
|
||||
const char *root, *source = isource;
|
||||
const char *root = iroot, *source = isource;
|
||||
int rc = FAIL_RESTORE;
|
||||
int try
|
||||
= 0;
|
||||
|
Reference in New Issue
Block a user