diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

remove YAP memory (string) streams.

Browse Source
This commit is contained in:
Vitor Santos Costa 2011-02-12 18:42:44 +00:00
parent be79c3326e
commit 2d07a7730e
15 changed files with 333 additions and 738 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

588
C/iopreds.c
View File

@ -89,7 +89,6 @@ static char SccsId[] = "%W% %G%";
STATIC_PROTO (Int PlIOError, (yap_error_number, Term, char *));
STATIC_PROTO (int FilePutc, (int, int));
STATIC_PROTO (int MemPutc, (int, int));
STATIC_PROTO (int console_post_process_read_char, (int, StreamDesc *));
STATIC_PROTO (int console_post_process_eof, (StreamDesc *));
STATIC_PROTO (int post_process_read_char, (int, StreamDesc *));
@ -100,14 +99,12 @@ STATIC_PROTO (int ConsoleSocketPutc, (int, int));
#endif
STATIC_PROTO (int PipePutc, (int, int));
STATIC_PROTO (int ConsolePipePutc, (int, int));
STATIC_PROTO (int NullPutc, (int, int));
STATIC_PROTO (int ConsolePutc, (int, int));
STATIC_PROTO (Int p_setprompt, (void));
STATIC_PROTO (Int p_prompt, (void));
STATIC_PROTO (int PlGetc, (int));
STATIC_PROTO (int DefaultGets, (int,UInt,char*));
STATIC_PROTO (int PlGets, (int,UInt,char*));
STATIC_PROTO (int MemGetc, (int));
STATIC_PROTO (int ISOWGetc, (int));
STATIC_PROTO (int ConsoleGetc, (int));
STATIC_PROTO (int PipeGetc, (int));
@ -265,7 +262,6 @@ yap_fflush(int sno)
if ( (Stream[sno].status & Output_Stream_f) &&
! (Stream[sno].status &
(Null_Stream_f|
InMemory_Stream_f|
Socket_Stream_f|
Pipe_Stream_f|
Free_Stream_f)) ) {
@ -280,10 +276,6 @@ yap_fflush(int sno)
static void
unix_upd_stream_info (StreamDesc * s)
{
if (s->status & InMemory_Stream_f) {
s->status |= Seekable_Stream_f;
return;
}
#if USE_SOCKET
if (Yap_sockets_io &&
s->u.file.file == NULL)
@ -411,10 +403,6 @@ InitFileIO(StreamDesc *s)
s->stream_putc = ConsolePipePutc;
s->stream_wputc = put_wchar;
s->stream_getc = ConsolePipeGetc;
} else if (s->status & InMemory_Stream_f) {
s->stream_putc = MemPutc;
s->stream_wputc = put_wchar;
s->stream_getc = MemGetc;
} else {
/* check if our console is promptable: may be tty or pipe */
if (s->status & (Promptable_Stream_f)) {
@ -717,6 +705,12 @@ Yap_DebugPlWrite(Term t)
Yap_plwrite(t, Yap_DebugPutc, 0, 1200);
}
void
Yap_PlWriteToStream(Term t, int sno, int flags)
{
Yap_plwrite(t, Stream[sno].stream_wputc, flags, 1200);
}
void
Yap_DebugErrorPutc(int c)
{
@ -747,67 +741,6 @@ FilePutc(int sno, int ch)
return ((int) ch);
}
/* static */
static int
MemPutc(int sno, int ch)
{
StreamDesc *s = &Stream[sno];
#if MAC || _MSC_VER
if (ch == 10)
{
ch = '\n';
}
#endif
s->u.mem_string.buf[s->u.mem_string.pos++] = ch;
if (s->u.mem_string.pos >= s->u.mem_string.max_size -256) {
extern int Yap_page_size;
int old_src = s->u.mem_string.src, new_src;
/* oops, we have reached an overflow */
Int new_max_size = s->u.mem_string.max_size + Yap_page_size;
char *newbuf;
if ((newbuf = Yap_AllocAtomSpace(new_max_size*sizeof(char))) != NULL) {
new_src = MEM_BUF_CODE;
#if !USE_SYSTEM_MALLOC
} else if ((newbuf = (ADDR)malloc(new_max_size*sizeof(char))) != NULL) {
new_src = MEM_BUF_MALLOC;
#endif
} else {
if (Stream[sno].u.mem_string.error_handler) {
Yap_Error_Size = new_max_size*sizeof(char);
save_machine_regs();
longjmp(*(jmp_buf *)Stream[sno].u.mem_string.error_handler,1);
} else {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP could not grow heap for writing to string");
}
return -1;
}
#if HAVE_MEMMOVE
memmove((void *)newbuf, (void *)s->u.mem_string.buf, (size_t)((s->u.mem_string.pos)*sizeof(char)));
#else
{
Int n = s->u.mem_string.pos;
char *to = newbuf;
char *from = s->u.mem_string.buf;
while (n-- >= 0) {
*to++ = *from++;
}
}
#endif
if (old_src == MEM_BUF_CODE) {
Yap_FreeAtomSpace(s->u.mem_string.buf);
} else {
free(s->u.mem_string.buf);
}
s->u.mem_string.buf = newbuf;
s->u.mem_string.max_size = new_max_size;
s->u.mem_string.src = new_src;
}
count_output_char(ch,s);
return ((int) ch);
}
/* static */
static int
IOSWIPutc(int sno, int ch)
@ -1002,20 +935,6 @@ PipePutc (int sno, int ch)
return ((int) ch);
}
static int
NullPutc (int sno, int ch)
{
StreamDesc *s = &Stream[sno];
#if MAC || _MSC_VER
if (ch == 10)
{
ch = '\n';
}
#endif
count_output_char(ch,s);
return ((int) ch);
}
/* static */
static int
ConsolePutc (int sno, int ch)
@ -1285,10 +1204,6 @@ EOFGetc(int sno)
else
s->stream_putc = PipePutc;
s->stream_wputc = put_wchar;
} else if (s->status & InMemory_Stream_f) {
s->stream_getc = MemGetc;
s->stream_putc = MemPutc;
s->stream_wputc = put_wchar;
} else if (s->status & Promptable_Stream_f) {
s->stream_putc = ConsolePutc;
s->stream_wputc = put_wchar;
@ -1603,24 +1518,6 @@ DefaultGets (int sno, UInt size, char *buf)
return (buf-pt)-1;
}
/* read from memory */
static int
MemGetc (int sno)
{
register StreamDesc *s = &Stream[sno];
Int ch;
int spos;
spos = s->u.mem_string.pos;
if (spos == s->u.mem_string.max_size) {
return post_process_eof(s);
} else {
ch = s->u.mem_string.buf[spos];
s->u.mem_string.pos = ++spos;
}
return post_process_read_char(ch, s);
}
/* I dispise this code!!!!! */
static int
ISOWGetc (int sno)
@ -1696,11 +1593,7 @@ PlUnGetc (int sno)
if (s->stream_getc != PlUnGetc)
return(s->stream_getc(sno));
ch = s->och;
if (s->status & InMemory_Stream_f) {
s->stream_getc = MemGetc;
s->stream_putc = MemPutc;
s->stream_wputc = put_wchar;
} else if (s->status & Socket_Stream_f) {
if (s->status & Socket_Stream_f) {
s->stream_getc = SocketGetc;
s->stream_putc = SocketPutc;
s->stream_wputc = put_wchar;
@ -2161,8 +2054,6 @@ GetStreamFd(int sno)
#else
return(Stream[sno].u.pipe.fd);
#endif
} else if (Stream[sno].status & InMemory_Stream_f) {
return(-1);
}
return(YP_fileno(Stream[sno].u.file.file));
}
@ -2508,226 +2399,6 @@ Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
return t;
}
static Int
p_open_pipe_stream (void)
{
Term t1, t2;
StreamDesc *st;
int sno;
#if _MSC_VER || defined(__MINGW32__)
HANDLE ReadPipe, WritePipe;
SECURITY_ATTRIBUTES satt;
satt.nLength = sizeof(satt);
satt.lpSecurityDescriptor = NULL;
satt.bInheritHandle = TRUE;
if (!CreatePipe(&ReadPipe, &WritePipe, &satt, 0))
{
return (PlIOError (SYSTEM_ERROR,TermNil, "open_pipe_stream/2 could not create pipe"));
}
#else
int filedes[2];
if (pipe(filedes) != 0)
{
return (PlIOError (SYSTEM_ERROR,TermNil, "open_pipe_stream/2 could not create pipe"));
}
#endif
sno = GetFreeStreamD();
if (sno < 0)
return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "new stream not available for open_pipe_stream/2"));
t1 = MkStream (sno);
st = &Stream[sno];
st->status = Input_Stream_f | Pipe_Stream_f;
st->linepos = 0;
st->charcount = 0;
st->linecount = 1;
st->stream_putc = PipePutc;
st->stream_wputc = put_wchar;
st->stream_getc = PipeGetc;
st->stream_gets = DefaultGets;
st->stream_wgetc = get_wchar;
if (CharConversionTable != NULL)
st->stream_wgetc_for_read = ISOWGetc;
else
st->stream_wgetc_for_read = st->stream_wgetc;
#if _MSC_VER || defined(__MINGW32__)
st->u.pipe.hdl = ReadPipe;
#else
st->u.pipe.fd = filedes[0];
#endif
UNLOCK(st->streamlock);
sno = GetFreeStreamD();
if (sno < 0)
return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "new stream not available for open_pipe_stream/2"));
st = &Stream[sno];
st->status = Output_Stream_f | Pipe_Stream_f;
st->linepos = 0;
st->charcount = 0;
st->linecount = 1;
st->stream_putc = PipePutc;
st->stream_wputc = put_wchar;
st->stream_getc = PipeGetc;
st->stream_gets = DefaultGets;
st->stream_wgetc = get_wchar;
if (CharConversionTable != NULL)
st->stream_wgetc_for_read = ISOWGetc;
else
st->stream_wgetc_for_read = st->stream_wgetc;
#if _MSC_VER || defined(__MINGW32__)
st->u.pipe.hdl = WritePipe;
#else
st->u.pipe.fd = filedes[1];
#endif
UNLOCK(st->streamlock);
t2 = MkStream (sno);
return
Yap_unify (ARG1, t1) &&
Yap_unify (ARG2, t2);
}
static int
open_buf_read_stream(char *nbuf, Int nchars)
{
int sno;
StreamDesc *st;
sno = GetFreeStreamD();
if (sno < 0)
return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "new stream not available for open_mem_read_stream/1"));
st = &Stream[sno];
/* currently these streams are not seekable */
st->status = Input_Stream_f | InMemory_Stream_f;
st->linepos = 0;
st->charcount = 0;
st->linecount = 1;
st->stream_putc = MemPutc;
st->stream_wputc = put_wchar;
st->stream_getc = MemGetc;
st->stream_gets = DefaultGets;
st->stream_wgetc = get_wchar;
if (CharConversionTable != NULL)
st->stream_wgetc_for_read = ISOWGetc;
else
st->stream_wgetc_for_read = st->stream_wgetc;
st->u.mem_string.pos = 0;
st->u.mem_string.buf = nbuf;
st->u.mem_string.max_size = nchars;
st->u.mem_string.error_handler = NULL;
st->u.mem_string.src = MEM_BUF_CODE;
UNLOCK(st->streamlock);
return sno;
}
static Int
p_open_mem_read_stream (void) /* $open_mem_read_stream(+List,-Stream) */
{
Term t, ti;
int sno;
Int sl = 0, nchars = 0;
char *nbuf;
ti = Deref(ARG1);
while (ti != TermNil) {
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "open_mem_read_stream");
return (FALSE);
} else if (!IsPairTerm(ti)) {
Yap_Error(TYPE_ERROR_LIST, ti, "open_mem_read_stream");
return (FALSE);
} else {
sl++;
ti = TailOfTerm(ti);
}
}
while ((nbuf = (char *)Yap_AllocAtomSpace((sl+1)*sizeof(char))) == NULL) {
if (!Yap_growheap(FALSE, (sl+1)*sizeof(char), NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
}
ti = Deref(ARG1);
while (ti != TermNil) {
Term ts = HeadOfTerm(ti);
if (IsVarTerm(ts)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "open_mem_read_stream");
return (FALSE);
} else if (!IsIntTerm(ts)) {
Yap_Error(TYPE_ERROR_INTEGER, ARG1, "open_mem_read_stream");
return (FALSE);
}
nbuf[nchars++] = IntOfTerm(ts);
ti = TailOfTerm(ti);
}
nbuf[nchars] = '\0';
sno = open_buf_read_stream(nbuf, nchars);
t = MkStream (sno);
return (Yap_unify (ARG2, t));
}
static int
open_buf_write_stream(char *nbuf, UInt sz)
{
int sno;
StreamDesc *st;
sno = GetFreeStreamD();
if (sno < 0)
return -1;
st = &Stream[sno];
/* currently these streams are not seekable */
st->status = Output_Stream_f | InMemory_Stream_f;
st->linepos = 0;
st->charcount = 0;
st->linecount = 1;
st->stream_putc = MemPutc;
st->stream_wputc = put_wchar;
st->stream_getc = MemGetc;
st->stream_gets = DefaultGets;
st->stream_wgetc = get_wchar;
if (CharConversionTable != NULL)
st->stream_wgetc_for_read = ISOWGetc;
else
st->stream_wgetc_for_read = st->stream_wgetc;
st->u.mem_string.pos = 0;
st->u.mem_string.buf = nbuf;
st->u.mem_string.max_size = sz;
st->u.mem_string.src = MEM_BUF_CODE;
UNLOCK(st->streamlock);
return sno;
}
static int
OpenBufWriteStream(void)
{
char *nbuf;
extern int Yap_page_size;
while ((nbuf = (char *)Yap_AllocAtomSpace(Yap_page_size*sizeof(char))) == NULL) {
if (!Yap_growheap(FALSE, Yap_page_size*sizeof(char), NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return -1;
}
}
return open_buf_write_stream(nbuf, Yap_page_size);
}
static Int
p_open_mem_write_stream (void) /* $open_mem_write_stream(-Stream) */
{
Term t;
int sno;
sno = OpenBufWriteStream();
if (sno == -1)
return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_mem_read_stream/1"));
t = MkStream (sno);
return (Yap_unify (ARG1, t));
}
static void
ExtendAliasArray(void)
{
@ -2778,7 +2449,7 @@ SetAlias (Atom arg, int sno)
Int alno = aliasp-FileAliases;
aliasp->alias_stream = sno;
if (!(Stream[sno].status &
(Null_Stream_f|InMemory_Stream_f|Socket_Stream_f))) {
(Null_Stream_f|Socket_Stream_f))) {
switch(alno) {
case 0:
Yap_stdin = Stream[sno].u.file.file;
@ -2948,6 +2619,12 @@ LookupSWIStream (struct io_stream *swi_s)
return i;
}
int
Yap_LookupSWIStream (void *swi_s)
{
return LookupSWIStream (swi_s);
}
typedef struct stream_ref
{ struct io_stream *read;
struct io_stream *write;
@ -3096,11 +2773,7 @@ StreamName(int i)
#endif
if (Stream[i].status & Pipe_Stream_f)
return(MkAtomTerm(AtomPipe));
if (Stream[i].status & InMemory_Stream_f)
return(MkAtomTerm(AtomCharsio));
else {
return(Stream[i].u.file.user_name);
}
return(Stream[i].u.file.user_name);
}
static Int
@ -3189,13 +2862,7 @@ Yap_CloseStreams (int loud)
Stream[sno].u.socket.domain);
}
#endif
else if (Stream[sno].status & InMemory_Stream_f) {
if (Stream[sno].u.mem_string.src == MEM_BUF_CODE) {
Yap_FreeAtomSpace(Stream[sno].u.mem_string.buf);
} else {
free(Stream[sno].u.mem_string.buf);
}
} else if (Stream[sno].status & (SWI_Stream_f)) {
else if (Stream[sno].status & (SWI_Stream_f)) {
SWIClose(Stream[sno].u.swi_stream.swi_ptr);
} else if (!(Stream[sno].status & Null_Stream_f)) {
YP_fclose (Stream[sno].u.file.file);
@ -3216,7 +2883,7 @@ Yap_CloseStreams (int loud)
static void
CloseStream(int sno)
{
if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f|Pipe_Stream_f|SWI_Stream_f)))
if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|Pipe_Stream_f|SWI_Stream_f)))
YP_fclose (Stream[sno].u.file.file);
#if USE_SOCKET
else if (Stream[sno].status & (Socket_Stream_f)) {
@ -3231,14 +2898,7 @@ CloseStream(int sno)
#else
close(Stream[sno].u.pipe.fd);
#endif
}
else if (Stream[sno].status & (InMemory_Stream_f)) {
if (Stream[sno].u.mem_string.src == MEM_BUF_CODE)
Yap_FreeAtomSpace(Stream[sno].u.mem_string.buf);
else
free(Stream[sno].u.mem_string.buf);
}
else if (Stream[sno].status & (SWI_Stream_f)) {
} else if (Stream[sno].status & (SWI_Stream_f)) {
SWIClose(Stream[sno].u.swi_stream.swi_ptr);
}
Stream[sno].status = Free_Stream_f;
@ -3278,39 +2938,6 @@ p_close (void)
return (TRUE);
}
static Int
p_peek_mem_write_stream (void)
{ /* '$peek_mem_write_stream'(+Stream,?S0,?S) */
Int sno = CheckStream (ARG1, (Output_Stream_f | InMemory_Stream_f), "close/2");
Int i = Stream[sno].u.mem_string.pos;
Term tf = ARG2;
CELL *HI;
if (sno < 0)
return (FALSE);
restart:
HI = H;
while (i > 0) {
--i;
tf = MkPairTerm(MkIntTerm(Stream[sno].u.mem_string.buf[i]),tf);
if (H + 1024 >= ASP) {
UNLOCK(Stream[sno].streamlock);
H = HI;
if (!Yap_gcl((ASP-HI)*sizeof(CELL), 3, ENV, gc_P(P,CP))) {
UNLOCK(Stream[sno].streamlock);
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
i = Stream[sno].u.mem_string.pos;
tf = ARG2;
LOCK(Stream[sno].streamlock);
goto restart;
}
}
UNLOCK(Stream[sno].streamlock);
return (Yap_unify(ARG3,tf));
}
static Int
p_past_eof (void)
{ /* at_end_of_stream */
@ -3850,6 +3477,42 @@ p_get_read_error_handler(void)
return (Yap_unify_constant (ARG1, t));
}
int
Yap_readTerm(int sno, Term *tp, Term *varnames, Term *terror, Term *tpos)
{
TokEntry *tokstart;
Term pt;
if (sno < 0) {
return FALSE;
}
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, tpos);
if (Yap_ErrorMessage)
{
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
if (terror)
*terror = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return FALSE;
}
pt = Yap_Parse();
if (Yap_ErrorMessage) {
Term t0 = MkVarTerm();
*terror = syntax_error(tokstart, sno, &t0);
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return FALSE;
}
if (varnames) {
*varnames = Yap_VarNames(Yap_VarTable, TermNil);
if (!*varnames) {
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return FALSE;
}
}
*tp = pt;
return TRUE;
}
/*
Assumes
Flag: ARG1
@ -3901,11 +3564,7 @@ static Int
had_ungetc = TRUE;
ungetc_oldc = Stream[inp_stream].och;
}
if (Stream[inp_stream].status & InMemory_Stream_f) {
cpos = Stream[inp_stream].u.mem_string.pos;
} else {
cpos = Stream[inp_stream].charcount;
}
cpos = Stream[inp_stream].charcount;
}
/* Scans the term using stack space */
while (TRUE) {
@ -3921,9 +3580,7 @@ static Int
Stream[inp_stream].och = ungetc_oldc;
}
if (seekable) {
if (Stream[inp_stream].status & InMemory_Stream_f) {
Stream[inp_stream].u.mem_string.pos = cpos;
} else if (Stream[inp_stream].status) {
if (Stream[inp_stream].status) {
#if HAVE_FGETPOS
fsetpos(Stream[inp_stream].u.file.file, &rpos);
#else
@ -3962,7 +3619,7 @@ static Int
and floats */
old_H = H;
if (Stream[inp_stream].status & Eof_Stream_f) {
if (Yap_eot_before_eof || (Stream[inp_stream].status & InMemory_Stream_f)) {
if (Yap_eot_before_eof) {
/* next read should give out an end of file */
Stream[inp_stream].status |= Push_Eof_Stream_f;
} else {
@ -4119,8 +3776,6 @@ p_user_file_name (void)
#endif
if (Stream[sno].status & Pipe_Stream_f)
tout = MkAtomTerm(AtomPipe);
else if (Stream[sno].status & InMemory_Stream_f)
tout = MkAtomTerm(AtomCharsio);
else
tout = Stream[sno].u.file.user_name;
UNLOCK(Stream[sno].streamlock);
@ -4149,13 +3804,10 @@ p_cur_line_no (void)
if (Stream[sno].status & Pipe_Stream_f)
my_stream = AtomPipe;
else
if (Stream[sno].status & InMemory_Stream_f)
my_stream = AtomCharsio;
else
my_stream = Stream[sno].u.file.name;
for (i = 0; i < MaxStreams; i++)
{
if (!(Stream[i].status & (Free_Stream_f|Socket_Stream_f|Pipe_Stream_f|InMemory_Stream_f)) &&
if (!(Stream[i].status & (Free_Stream_f|Socket_Stream_f|Pipe_Stream_f)) &&
Stream[i].u.file.name == my_stream)
no += Stream[i].linecount - 1;
}
@ -4816,9 +4468,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
Term tail;
int (* f_putc)(int, wchar_t);
int has_tabs;
jmp_buf format_botch;
volatile void *old_handler;
volatile int old_pos;
format_info finfo;
Term fmod = CurrentModule;
@ -4826,27 +4476,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
FormatInfo = &finfo;
finfo.pad_max = finfo.pad_entries;
finfo.format_error = FALSE;
if (Stream[sno].status & InMemory_Stream_f) {
old_handler = Stream[sno].u.mem_string.error_handler;
Stream[sno].u.mem_string.error_handler = (void *)&format_botch;
old_pos = Stream[sno].u.mem_string.pos;
/* set up an error handler */
if (setjmp(format_botch)) {
restore_machine_regs();
*H++ = oargs;
*H++ = otail;
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR,otail,"format/2");
return FALSE;
}
oargs = H[-2];
otail = H[-1];
Stream[sno].u.mem_string.pos = old_pos;
H -= 2;
}
} else {
old_handler = NULL;
}
old_handler = NULL;
args = oargs;
tail = otail;
targ = 0;
@ -5281,9 +4911,6 @@ format(volatile Term otail, volatile Term oargs, int sno)
if (IsAtomTerm(tail)) {
fstr = NULL;
}
if (Stream[sno].status & InMemory_Stream_f) {
Stream[sno].u.mem_string.error_handler = old_handler;
}
format_clean_up(finfo.format_base, fstr, targs);
Yap_JumpToEnv(ball);
return FALSE;
@ -5400,9 +5027,6 @@ format(volatile Term otail, volatile Term oargs, int sno)
ta[1] = oargs;
Yap_Error(Yap_Error_TYPE, Yap_MkApplTerm(Yap_MkFunctor(AtomFormat,2),2,ta), "format/2");
}
if (Stream[sno].status & InMemory_Stream_f) {
Stream[sno].u.mem_string.error_handler = old_handler;
}
format_clean_up(finfo.format_base, fstr, targs);
Yap_Error_TYPE = YAP_NO_ERROR;
return FALSE;
@ -5424,9 +5048,6 @@ format(volatile Term otail, volatile Term oargs, int sno)
}
if (tnum <= 8)
targs = NULL;
if (Stream[sno].status & InMemory_Stream_f) {
Stream[sno].u.mem_string.error_handler = old_handler;
}
format_clean_up(finfo.format_base, fstr, targs);
return (TRUE);
}
@ -5451,17 +5072,8 @@ format2(UInt stream_flag)
Yap_Error(INSTANTIATION_ERROR,tin,"format/3");
return FALSE;
}
if (IsApplTerm(tin) && FunctorOfTerm(tin) == FunctorAtom) {
Yap_c_output_stream = OpenBufWriteStream();
mem_stream = TRUE;
} else if (IsApplTerm(tin) && FunctorOfTerm(tin) == FunctorCodes) {
Yap_c_output_stream = OpenBufWriteStream();
codes_stream = TRUE;
mem_stream = TRUE;
} else {
/* needs to change Yap_c_output_stream for write */
Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f|stream_flag, "format/3");
}
/* needs to change Yap_c_output_stream for write */
Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f|stream_flag, "format/3");
UNLOCK(Stream[Yap_c_output_stream].streamlock);
if (Yap_c_output_stream == -1) {
Yap_c_output_stream = old_c_stream;
@ -5931,9 +5543,6 @@ Yap_StreamToFileNo(Term t)
UNLOCK(Stream[sno].streamlock);
return(Stream[sno].u.socket.fd);
#endif
} else if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f)) {
UNLOCK(Stream[sno].streamlock);
return(-1);
} else {
UNLOCK(Stream[sno].streamlock);
return(YP_fileno(Stream[sno].u.file.file));
@ -6087,74 +5696,6 @@ p_encoding (void)
return TRUE;
}
Term
Yap_StringToTerm(char *s,Term *tp)
{
int sno = open_buf_read_stream(s, strlen(s)+1);
Term t;
TokEntry *tokstart;
tr_fr_ptr TR_before_parse;
Term tpos = TermNil;
if (sno < 0)
return FALSE;
UNLOCK(Stream[sno].streamlock);
TR_before_parse = TR;
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos);
if (tokstart == NIL && tokstart->Tok == Ord (eot_tok)) {
if (tp) {
*tp = MkAtomTerm(AtomEOFBeforeEOT);
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
Stream[sno].status = Free_Stream_f;
return FALSE;
} else if (Yap_ErrorMessage) {
if (tp) {
*tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
Stream[sno].status = Free_Stream_f;
return FALSE;
}
t = Yap_Parse();
TR = TR_before_parse;
if (!t && !Yap_ErrorMessage) {
if (tp) {
t = MkVarTerm();
*tp = syntax_error(tokstart, sno, &t);
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
Stream[sno].status = Free_Stream_f;
return FALSE;
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
Stream[sno].status = Free_Stream_f;
return t;
}
Term
Yap_TermToString(Term t, char *s, unsigned int sz, int flags)
{
int sno = open_buf_write_stream(s, sz);
int old_output_stream = Yap_c_output_stream;
if (sno < 0)
return FALSE;
Yap_c_output_stream = sno;
Yap_StartSlots();
Yap_plwrite (t, Stream[sno].stream_wputc, flags, 1200);
Yap_CloseSlots();
s[Stream[sno].u.mem_string.pos] = '\0';
LOCK(Stream[sno].streamlock);
Stream[sno].status = Free_Stream_f;
UNLOCK(Stream[sno].streamlock);
Yap_c_output_stream = old_output_stream;
return EX != NULL;
}
FILE *
Yap_FileDescriptorFromStream(Term t)
@ -6163,7 +5704,6 @@ Yap_FileDescriptorFromStream(Term t)
if (sno < 0)
return NULL;
if (Stream[sno].status & (Null_Stream_f|
InMemory_Stream_f|
Socket_Stream_f|
Pipe_Stream_f|
Free_Stream_f))
@ -6202,12 +5742,6 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$access", 1, p_access, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("exists_directory", 1, p_exists_directory, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$file_expansion", 2, p_file_expansion, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$open_pipe_stream", 2, p_open_pipe_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag);
CurrentModule = CHARSIO_MODULE;
Yap_InitCPred ("open_mem_read_stream", 2, p_open_mem_read_stream, SyncPredFlag);
Yap_InitCPred ("open_mem_write_stream", 1, p_open_mem_write_stream, SyncPredFlag);
Yap_InitCPred ("peek_mem_write_stream", 3, p_peek_mem_write_stream, SyncPredFlag);
CurrentModule = cm;
Yap_InitCPred ("$put", 2, p_put, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$put_byte", 2, p_put_byte, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag);

4
H/Yapproto.h
View File

@ -259,7 +259,9 @@ void STD_PROTO(Yap_InitIOPreds,(void));
extern void Yap_DebugPlWrite (Term t);
extern void Yap_DebugErrorPutc (int n);
#endif
int STD_PROTO(Yap_LookupSWIStream,(void *));
int STD_PROTO(Yap_readTerm, (int, Term *, Term *, Term *, Term *));
void STD_PROTO(Yap_PlWriteToStream, (Term, int, int));
/* depth_lim.c */
void STD_PROTO(Yap_InitItDeepenPreds,(void));

1
H/iopreds.h
View File

@ -125,7 +125,6 @@ StreamDesc;
#define Client_Socket_Stream_f 0x008000
#define Server_Socket_Stream_f 0x010000
#endif
#define InMemory_Stream_f 0x020000
#define Pipe_Stream_f 0x040000
#define Popen_Stream_f 0x080000
#define User_Stream_f 0x100000

5
Makefile.in
View File

@ -205,6 +205,7 @@ IOLIB_SOURCES=$(srcdir)/packages/PLStream/pl-buffer.c $(srcdir)/packages/PLStrea
$(srcdir)/packages/PLStream/pl-option.c \
$(srcdir)/packages/PLStream/pl-os.c \
$(srcdir)/packages/PLStream/pl-privitf.c \
$(srcdir)/packages/PLStream/pl-read.c \
$(srcdir)/packages/PLStream/pl-stream.c $(srcdir)/packages/PLStream/pl-string.c \
$(srcdir)/packages/PLStream/pl-table.c \
$(srcdir)/packages/PLStream/pl-text.c \
@ -322,6 +323,7 @@ YAPDOCS=$(srcdir)/docs/yap.tex $(srcdir)/docs/chr.tex \
IOLIB_OBJECTS=pl-buffer.o pl-codelist.o pl-ctype.o pl-dtoa.o pl-error.o \
pl-file.o pl-files.o pl-fmt.o \
pl-glob.o pl-option.o \
pl-read.o \
pl-os.o pl-privitf.o \
pl-stream.o pl-string.o pl-table.o \
pl-text.o pl-util.o pl-utf8.o \
@ -585,6 +587,9 @@ pl-os.o: $(srcdir)/packages/PLStream/pl-os.c
pl-privitf.o: $(srcdir)/packages/PLStream/pl-privitf.c
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-privitf.c -o $@
pl-read.o: $(srcdir)/packages/PLStream/pl-read.c
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-read.c -o $@
pl-stream.o: $(srcdir)/packages/PLStream/pl-stream.c
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-stream.c -o $@

95
library/charsio.yap
View File

@ -32,86 +32,69 @@
term_to_atom/2
]).
:- use_module(library(memfile)).
:- meta_predicate(with_output_to_chars(0,?)).
:- meta_predicate(with_output_to_chars(0,-,?)).
:- meta_predicate(with_output_to_chars(0,-,?,?)).
format_to_chars(Form, Args, OUT) :-
format_to_chars(Form, Args, OUT, []).
format_to_chars(Format, Args, Codes) :-
format(codes(Codes), Format, Args).
format_to_chars(Form, Args, OUT, L0) :-
open_mem_write_stream(Stream),
format(Stream,Form,Args),
peek_mem_write_stream(Stream, L0, O),
close(Stream),
O = OUT.
format_to_chars(Format, Args, OUT, L0) :-
format(codes(OUT, L0), Format, Args).
write_to_chars(Term, Codes) :-
format(codes(Codes), '~w', [Term]).
write_to_chars(Term, Out, Tail) :-
format(codes(Out,Tail),'~w',[Term]).
write_to_chars(Term, OUT) :-
write_to_chars(Term, [], OUT).
atom_to_chars(Atom, OUT) :-
atom_to_chars(Atom, [], OUT).
atom_codes(Atom, OUT).
atom_to_chars(Atom, L0, OUT) :-
var(Atom), !,
throw(error(instantiation_error,atom_to_chars(Atom, L0, OUT))).
atom_to_chars(Atom, L0, OUT) :-
atom(Atom), !,
open_mem_write_stream(Stream),
write(Stream, Atom),
peek_mem_write_stream(Stream, L0, O),
close(Stream),
O = OUT.
atom_to_chars(Atom, L0, OUT) :-
throw(error(type_error(atom,Atom),atom_to_chars(Atom, L0, OUT))).
format(codes(L0, OUT), '~a', [Atom]).
number_to_chars(Number, OUT) :-
number_to_chars(Number, [], OUT).
number_codes(Number, OUT).
number_to_chars(Number, L0, OUT) :-
var(Number), !,
throw(error(instantiation_error,number_to_chars(Number, L0, OUT))).
number_to_chars(Number, L0, OUT) :-
number(Number), !,
open_mem_write_stream(Stream),
write(Stream, Number),
peek_mem_write_stream(Stream, L0, O),
close(Stream),
O = OUT.
format(codes(L0, OUT), '~w', [Number]).
number_to_chars(Number, L0, OUT) :-
throw(error(type_error(number,Number),number_to_chars(Number, L0, OUT))).
open_chars_stream(Chars, Stream) :-
open_mem_read_stream(Chars, Stream).
open_chars_stream(Codes, Stream) :-
open_chars_stream(Codes, Stream, '').
with_output_to_chars(Goal, Chars) :-
with_output_to_chars(Goal, [], Chars).
open_chars_stream(Codes, Stream, Postfix) :-
new_memory_file(MF),
open_memory_file(MF, write, Out),
format(Out, '~s~w', [Codes, Postfix]),
close(Out),
open_memory_file(MF, read, Stream,
[ free_on_close(true)
]).
with_output_to_chars(Goal, L0, Chars) :-
with_output_to_chars(Goal, Stream, L0, Chars),
close(Stream).
with_output_to_chars(Goal, Stream, L0, Chars) :-
open_mem_write_stream(Stream),
current_output(SO),
set_output(Stream),
do_output_to_chars(Goal, Stream, L0, Chars, SO).
do_output_to_chars(Goal, Stream, L0, Chars, SO) :-
catch(Goal, Exception, handle_exception(Exception,Stream,SO)),
!,
set_output(SO),
peek_mem_write_stream(Stream, L0, Chars).
do_output_to_chars(_Goal, Stream, _L0, _Chars, SO) :-
set_output(SO),
close(Stream),
fail.
handle_exception(Exception, Stream, SO) :-
close(Stream),
current_output(SO),
throw(Exception).
with_output_to_chars(Goal, Codes) :-
with_output_to(codes(Codes), Goal).
with_output_to_chars(Goal, Codes, L0) :-
with_output_to(codes(Codes, L0), Goal).
%% with_output_to_chars(:Goal, -Stream, -Codes, ?Tail) is det.
%
% As with_output_to_chars/2, but Stream is unified with the
% temporary stream.
with_output_to_chars(Goal, Stream, Codes, Tail) :-
with_output_to(codes(Codes, Tail), with_stream(Stream, Goal)).
with_stream(Stream, Goal) :-
current_output(Stream),
call(Goal).

75
library/dialect/swi/fli/swi.c
View File

@ -156,18 +156,6 @@ X_API char* PL_atom_nchars(atom_t a, size_t *len) /* SAM check type */
return s;
}
X_API int
PL_chars_to_term(const char *s, term_t term) {
YAP_Term t,error;
if ( (t=YAP_ReadBuffer(s,&error))==0L ) {
Yap_PutInSlot(term, error);
return 0L;
}
Yap_PutInSlot(term,t);
return 1L;
}
/* SWI: term_t PL_copy_term_ref(term_t from)
YAP: NO EQUIVALENT */
/* SAM TO DO */
@ -1512,7 +1500,7 @@ X_API int PL_unify_term(term_t l,...)
*pt++ = MkIntegerTerm((Int)va_arg(ap, void *));
break;
case PL_INT64:
#if SIZE_OF_LONG_INT==8
#if SIZEOF_LONG_INT==8
*pt++ = MkIntegerTerm((Int)va_arg(ap, long int));
#elif USE_GMP
{
@ -2745,6 +2733,67 @@ Yap_swi_install(void)
YAP_UserCPredicate("ctime", SWI_ctime, 2);
}
int Yap_read_term(term_t t, IOSTREAM *st, term_t vs);
int
Yap_read_term(term_t t, IOSTREAM *st, term_t vs)
{
int sno = Yap_LookupSWIStream(st);
Term varnames, out, tpos;
if (!Yap_readTerm(sno, &out, &varnames, NULL, &tpos))
return FALSE;
if (!Yap_unify(out, Yap_GetFromSlot(t))) {
return FALSE;
}
if (!Yap_unify(vs, Yap_GetFromSlot(varnames))) {
return FALSE;
}
return TRUE;
}
Term
Yap_StringToTerm(char *s, Term *tp)
{
IOSTREAM *stream = Sopen_string(NULL, s, -1, "r");
int sno;
Term out, tpos;
if (!stream)
return FALSE;
sno = Yap_LookupSWIStream(stream);
if (sno < 0)
return FALSE;
if (!Yap_readTerm(sno, &out, NULL, tp, &tpos)) {
out = 0L;
}
Yap_CloseStream(sno);
Sclose(stream);
return out;
}
Term
Yap_TermToString(Term t, char *s, unsigned int sz, int flags)
{
int old_output_stream = Yap_c_output_stream;
IOSTREAM *stream = Sopen_string(NULL, s, sz, "w");
int sno;
if (!stream)
return FALSE;
sno = Yap_LookupSWIStream(stream);
if (sno < 0)
return 0L;
Yap_c_output_stream = sno;
Yap_StartSlots();
Yap_PlWriteToStream (t, sno, flags);
stream->bufp = '\0';
Yap_CloseSlots();
Yap_c_output_stream = old_output_stream;
return EX != NULL;
}
#ifdef _WIN32
#include <windows.h>

1
packages/PLStream/pl-file.c
View File

@ -4723,6 +4723,7 @@ init_yap(void)
PL_register_extensions(PL_predicates_from_files);
PL_register_extensions(PL_predicates_from_glob);
PL_register_extensions(PL_predicates_from_write);
PL_register_extensions(PL_predicates_from_read);
PL_register_extensions(foreigns);
fileerrors = TRUE;
SinitStreams();

1
packages/PLStream/pl-incl.h
View File

@ -1104,4 +1104,5 @@ extern const PL_extension PL_predicates_from_file[];
extern const PL_extension PL_predicates_from_files[];
extern const PL_extension PL_predicates_from_glob[];
extern const PL_extension PL_predicates_from_write[];
extern const PL_extension PL_predicates_from_read[];

134
packages/PLStream/pl-read.c Normal file
View File

@ -0,0 +1,134 @@
#include "pl-incl.h"
typedef struct
{
term_t varnames; /* Report variables+names */
IOSTREAM *stream;
int has_exception; /* exception is raised */
term_t exception; /* raised exception */
} read_data, *ReadData;
static void
init_read_data(ReadData _PL_rd, IOSTREAM *in ARG_LD)
{
_PL_rd->varnames = 0;
_PL_rd->stream = in;
}
static void
free_read_data(ReadData _PL_rd)
{
}
static int
read_term(term_t t, ReadData rd ARG_LD)
{
return Yap_read_term(t, rd->stream, rd->varnames);
}
/*******************************
* TERM <->ATOM *
*******************************/
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;
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);
Sclose(stream);
if ( s != buf )
Sfree(s);
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;
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);
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;
return rval;
}
fail;
}
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);
}
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 )
PL_put_term(t, rd.exception);
free_read_data(&rd);
Sclose(stream);
LD->read_source = oldsrc;
return rval;
}
/*******************************
* PUBLISH PREDICATES *
*******************************/
BeginPredDefs(read)
PRED_DEF("atom_to_term", 3, atom_to_term, 0)
PRED_DEF("term_to_atom", 2, term_to_atom, 0)
EndPredDefs

5
packages/PLStream/pl-yap.h
View File

@ -29,8 +29,9 @@ typedef YAP_Term *Word; /* Anonymous 4 byte object */
typedef YAP_Atom Atom;
typedef YAP_Term (*Func)(term_t); /* foreign functions */
const char *Yap_GetCurrentPredName(void);
YAP_Int Yap_GetCurrentPredArity(void);
extern const char *Yap_GetCurrentPredName(void);
extern YAP_Int Yap_GetCurrentPredArity(void);
extern int Yap_read_term(term_t t, IOSTREAM *st, term_t *vs);
extern atom_t codeToAtom(int chrcode);

14
pl/boot.yap
View File

@ -712,11 +712,8 @@ true :- true.
'$write_goal_output'(G1, First, NG, Next, IG),
'$write_vars_and_goals'(LG, Next, IG).
'$goal_to_string'(Format, G, String) :-
charsio:open_mem_write_stream(W),
format(W,Format,G),
charsio:peek_mem_write_stream(W, [], String),
close(W).
'$goal_to_string'(Format, G, String) :-
format(codes(String),Format,G).
'$write_goal_output'(var([V|VL]), First, [var([V|VL])|L], next, L) :- !,
( First = first -> true ; format(user_error,',~n',[]) ),
@ -1393,3 +1390,10 @@ open_null_stream(S) :-
stream_property(Stream, Property) :-
swi_stream_property(Stream, Property).
atom_to_term(Atom, Term, Bindings) :-
swi_atom_to_term(Atom, Term, Bindings).
term_to_atom(Term, Atom) :-
swi_term_to_atom(Term, Atom).
with_output_to(Output, G) :-
swi_with_output_to(Output, G).

9
pl/consult.yap
View File

@ -430,7 +430,8 @@ initialization(G,OPT) :-
nb_setval('$included_file', Y),
'$current_module'(Mod),
H0 is heapused, '$cputime'(T0,_),
'$default_encoding'(Encoding),
'$default_encoding'(Enc),
'$valid_encoding'(Encoding, Enc),
( open(Y, read, Stream, [encoding(Encoding)]), !, % '$open'(Y, '$csult', Stream, 0, Encoding, X), !,
print_message(Verbosity, loading(including, Y)),
'$loop'(Stream,Status), '$close'(Stream)
@ -826,11 +827,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
File = File0.
'$cat_file_name'(File0,File) :-
ground(File0),
charsio:open_mem_write_stream(Stream),
write(Stream, File0),
charsio:peek_mem_write_stream(Stream, [], L),
close(Stream),
atom_codes(File, L).
format(atom(File), '~w', [File0]).
'$get_abs_file'(File,opts(_,D0,_,_,_,_,_),AbsFile) :-
operating_system_support:true_file_name(File,D0,AbsFile).

10
pl/control.yap
View File

@ -301,15 +301,7 @@ prolog_current_frame(Env) :-
'$run_atom_goal'(GA) :-
'$current_module'(Module),
atom_codes(GA,Gs0),
'$add_dot_to_atom_goal'(Gs0,Gs),
charsio:open_mem_read_stream(Gs, Stream),
( '$system_catch'(read(Stream, G),Module,_,fail) ->
close(Stream)
;
close(Stream),
fail
),
atom_to_term(GA, G, _),
'$system_catch'('$query'(once(G), []),Module,Error,user:'$Error'(Error)).
'$add_dot_to_atom_goal'([],[0'.]) :- !. %'

36
pl/utils.yap
View File

@ -661,42 +661,6 @@ sub_atom(At, Bef, Size, After, SubAt) :-
'$subtract_lists_of_variables'([V1|VL1],[V2|VL2],[V2|VL]) :-
'$subtract_lists_of_variables'([V1|VL1],VL2,VL).
atom_to_term(Atom, Term, Bindings) :-
atom_codes(Atom, Chars),
charsio:open_mem_read_stream(Chars, Stream),
catch(read_term(Stream, T, [variable_names(Bindings)]),Error,'$handle_atom_to_term_error'(Stream, Error)),
close(Stream),
T = Term.
'$handle_atom_to_term_error'(Stream, Error) :-
close(Stream),
throw(Error).
term_to_atom(Term,Atom) :-
nonvar(Atom), !,
atom_codes(Atom,S),
charsio:read_from_chars(S,Term).
term_to_atom(Term,Atom) :-
charsio:write_to_chars(Term,S),
atom_codes(Atom,S).
%
% hack this here.
%
charsio:write_to_chars(Term, L0, OUT) :-
charsio:open_mem_write_stream(Stream),
prolog:write(Stream, Term),
charsio:peek_mem_write_stream(Stream, L0, O),
prolog:close(Stream),
O = OUT.
charsio:read_from_chars(Chars, Term) :-
charsio:open_mem_read_stream(Chars, Stream),
prolog:read(Stream, T),
prolog:close(Stream),
T = Term.
simple(V) :- var(V), !.
simple(A) :- atom(A), !.
simple(N) :- number(N).

93
pl/yio.yap
View File

@ -168,9 +168,15 @@ set_input(Stream) :-
set_output(Stream) :-
'$set_output'(Stream).
open_null_stream(S) :- '$open_null_stream'(S).
open_pipe_streams(P1,P2) :- '$open_pipe_stream'(P1, P2).
open_pipe_streams(Read, Write) :-
(
'$undefined'(pipe(_,_),unix)
->
load_files(library(unix), [silent(true),if(not_loaded)])
;
true
),
unix:pipe(Read, Write).
fileerrors :- set_value(fileerrors,1).
nofileerrors :- set_value(fileerrors,0).
@ -794,36 +800,10 @@ current_stream(File, Opts, Stream) :-
'$format@'(Goal,Out) :-
'$with_output_to_chars'(Goal, _, [], Out).
'$with_output_to_chars'(Goal, Stream, L0, Chars) :-
charsio:open_mem_write_stream(Stream),
current_output(SO),
set_output(Stream),
'$do_output_to_chars'(Goal, Stream, L0, Chars, SO).
'$do_output_to_chars'(Goal, Stream, L0, Chars, SO) :-
catch(Goal, Exception, '$handle_exception'(Exception,Stream,SO)),
!,
set_output(SO),
charsio:peek_mem_write_stream(Stream, L0, Chars),
close(Stream).
'$do_output_to_chars'(_Goal, Stream, _L0, _Chars, SO) :-
set_output(SO),
close(Stream),
fail.
with_output_to(codes(Out), Goal).
sformat(String, Form, Args) :-
charsio:open_mem_write_stream(Stream),
format(Stream, Form, Args),
charsio:peek_mem_write_stream(Stream, [], String),
close(Stream).
'$handle_exception'(Exception, Stream, SO) :-
set_output(SO),
close(Stream),
throw(Exception).
format(codes(String, []), Form, Args).
write_depth(T,L) :- write_depth(T,L,_).
@ -855,57 +835,6 @@ prolog_file_name(File, PrologFileName) :-
prolog_file_name(File, PrologFileName) :-
'$do_error'(type_error(atom,T), prolog_file_name(File, PrologFileName)).
with_output_to(Output, Command) :-
setup_call_cleanup( '$setup_wot'(Output, Stream, OldStream, with_output_to(Output, Command)),
once(Command),
'$cleanup_wot'(Output, Stream, OldStream) ).
'$setup_wot'(Output, Stream, OldStream, Goal) :-
'$setup_wot'(Output, Stream, Goal),
current_output(OldStream),
set_output(Stream).
'$setup_wot'(Output, Stream, Goal) :-
var(Output), !,
'$do_error'(instantiation_error,Goal).
'$setup_wot'(atom(_Atom), Stream, _) :- !,
charsio:open_mem_write_stream(Stream).
'$setup_wot'(codes(_Codes), Stream, _) :- !,
charsio:open_mem_write_stream(Stream).
'$setup_wot'(codes(_Codes, _Tail), Stream, _) :- !,
charsio:open_mem_write_stream(Stream).
'$setup_wot'(chars(_Chars), Stream, _) :- !,
charsio:open_mem_write_stream(Stream).
'$setup_wot'(chars(_Chars, _Tail), Stream, _) :- !,
charsio:open_mem_write_stream(Stream).
'$setup_wot'(Stream, Stream, _) :-
'$stream'(Stream), !.
'$setup_wot'(Output, _, Goal) :-
'$do_error'(type_error(output,Output),Goal).
'$cleanup_wot'(Output, Stream, OldStream) :- !,
'$cleanup_wot'(Output, Stream),
set_output(OldStream).
'$cleanup_wot'(atom(Atom), Stream) :- !,
charsio:peek_mem_write_stream(Stream, [], String),
atom_codes(Atom, String),
close(Stream).
'$cleanup_wot'(codes(Codes), Stream) :- !,
charsio:peek_mem_write_stream(Stream, [], Codes),
close(Stream).
'$cleanup_wot'(codes(Codes, Tail), Stream) :- !,
charsio:peek_mem_write_stream(Stream, Tail, Codes),
close(Stream).
'$cleanup_wot'(chars(Chars), Stream) :- !,
charsio:peek_mem_write_stream(Stream, [], String),
'$codes_to_chars'([], String, Chars),
close(Stream).
'$cleanup_wot'(chars(Chars, Tail), Stream) :- !,
charsio:peek_mem_write_stream(Stream, Tail, String),
'$codes_to_chars'(Tail, String, Chars),
close(Stream).
'$cleanup_wot'(_, _).
'$codes_to_chars'(String0, String, String0) :- String0 == String, !.
'$codes_to_chars'(String0, [Code|String], [Char|Chars]) :-