first pass at open/ and friends.
This commit is contained in:
Vitor Santos Costa
parent
3bdece404b
commit
be79c3326e
515
C/iopreds.c
515
C/iopreds.c
|
|
@ -123,8 +123,6 @@ STATIC_PROTO (int ReadlinePutc, (int,int));
|
|||
STATIC_PROTO (int PlUnGetc, (int));
|
||||
STATIC_PROTO (Term MkStream, (int));
|
||||
STATIC_PROTO (Int p_stream_flags, (void));
|
||||
STATIC_PROTO (int find_csult_file, (char *, char *, StreamDesc *, char *));
|
||||
STATIC_PROTO (Int p_open, (void));
|
||||
STATIC_PROTO (int AddAlias, (Atom, int));
|
||||
STATIC_PROTO (void SetAlias, (Atom, int));
|
||||
STATIC_PROTO (void PurgeAlias, (int));
|
||||
|
|
@ -159,7 +157,6 @@ STATIC_PROTO (Int p_skip, (void));
|
|||
STATIC_PROTO (Int p_flush, (void));
|
||||
STATIC_PROTO (Int p_flush_all_streams, (void));
|
||||
STATIC_PROTO (Int p_write_depth, (void));
|
||||
STATIC_PROTO (Int p_open_null_stream, (void));
|
||||
STATIC_PROTO (Int p_user_file_name, (void));
|
||||
STATIC_PROTO (Int p_line_position, (void));
|
||||
STATIC_PROTO (Int p_character_count, (void));
|
||||
|
|
@ -2149,26 +2146,6 @@ p_stream_flags (void)
|
|||
return (Yap_unify_constant (ARG2, MkIntTerm (Stream[IntOfTerm (trm)].status)));
|
||||
}
|
||||
|
||||
static int
|
||||
find_csult_file (char *source, char *buf, StreamDesc * st, char *io_mode)
|
||||
{
|
||||
|
||||
char *cp = source, ch;
|
||||
while (*cp++);
|
||||
while ((ch = *--cp) != '.' && !Yap_dir_separator((int)ch) && cp != source);
|
||||
if (ch == '.')
|
||||
return (FALSE);
|
||||
strncpy (buf, source, YAP_FILENAME_MAX);
|
||||
strncat (buf, ".yap", YAP_FILENAME_MAX);
|
||||
if ((st->u.file.file = YP_fopen (buf, io_mode)) != YAP_ERROR)
|
||||
return (TRUE);
|
||||
strncpy (buf, source, YAP_FILENAME_MAX);
|
||||
strncat (buf, ".pl", YAP_FILENAME_MAX);
|
||||
if ((st->u.file.file = YP_fopen (buf, io_mode)) != YAP_ERROR)
|
||||
return (TRUE);
|
||||
return (FALSE);
|
||||
}
|
||||
|
||||
/* given a stream index, get the corresponding fd */
|
||||
static Int
|
||||
GetStreamFd(int sno)
|
||||
|
|
@ -2286,204 +2263,6 @@ Yap_UpdateSocketStream(int sno, socket_info flags, socket_domain domain) {
|
|||
|
||||
#endif /* USE_SOCKET */
|
||||
|
||||
static int
|
||||
binary_file(char *file_name)
|
||||
{
|
||||
#if HAVE_STAT
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
struct _stat ss;
|
||||
if (_stat(file_name, &ss) != 0) {
|
||||
#else
|
||||
struct stat ss;
|
||||
if (stat(file_name, &ss) != 0) {
|
||||
#endif
|
||||
/* ignore errors while checking a file */
|
||||
return(FALSE);
|
||||
}
|
||||
return (S_ISDIR(ss.st_mode));
|
||||
#else
|
||||
return(FALSE);
|
||||
#endif
|
||||
}
|
||||
|
||||
static int
|
||||
write_bom(int sno, StreamDesc *st)
|
||||
{
|
||||
/* dump encoding */
|
||||
switch (st->encoding) {
|
||||
case ENC_ISO_UTF8:
|
||||
if (st->stream_putc(sno,0xEF)<0)
|
||||
return FALSE;
|
||||
if (st->stream_putc(sno,0xBB)<0)
|
||||
return FALSE;
|
||||
if (st->stream_putc(sno,0xBF)<0)
|
||||
return FALSE;
|
||||
st->status |= HAS_BOM_f;
|
||||
return TRUE;
|
||||
case ENC_UNICODE_BE:
|
||||
if (st->stream_putc(sno,0xFE)<0)
|
||||
return FALSE;
|
||||
if (st->stream_putc(sno,0xFF)<0)
|
||||
return FALSE;
|
||||
st->status |= HAS_BOM_f;
|
||||
return TRUE;
|
||||
case ENC_UNICODE_LE:
|
||||
if (st->stream_putc(sno,0xFF)<0)
|
||||
return FALSE;
|
||||
if (st->stream_putc(sno,0xFE)<0)
|
||||
return FALSE;
|
||||
case ENC_ISO_UTF32_BE:
|
||||
if (st->stream_putc(sno,0x00)<0)
|
||||
return FALSE;
|
||||
if (st->stream_putc(sno,0x00)<0)
|
||||
return FALSE;
|
||||
if (st->stream_putc(sno,0xFE)<0)
|
||||
return FALSE;
|
||||
if (st->stream_putc(sno,0xFF)<0)
|
||||
return FALSE;
|
||||
case ENC_ISO_UTF32_LE:
|
||||
if (st->stream_putc(sno,0xFF)<0)
|
||||
return FALSE;
|
||||
if (st->stream_putc(sno,0xFE)<0)
|
||||
return FALSE;
|
||||
if (st->stream_putc(sno,0x00)<0)
|
||||
return FALSE;
|
||||
if (st->stream_putc(sno,0x00)<0)
|
||||
return FALSE;
|
||||
default:
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
check_bom(int sno, StreamDesc *st)
|
||||
{
|
||||
|
||||
int ch;
|
||||
|
||||
ch = st->stream_getc(sno);
|
||||
if (ch == EOFCHAR) {
|
||||
st->och = ch;
|
||||
st->stream_getc = PlUnGetc;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_gets = DefaultGets;
|
||||
return TRUE;
|
||||
}
|
||||
switch(ch) {
|
||||
case 0x00:
|
||||
{
|
||||
ch = st->stream_getc(sno);
|
||||
if (ch == EOFCHAR || ch != 0x00) {
|
||||
st->och = ch;
|
||||
st->stream_getc = PlUnGetc00;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_gets = DefaultGets;
|
||||
return TRUE;
|
||||
} else {
|
||||
ch = st->stream_getc(sno);
|
||||
if (ch == EOFCHAR || ch != 0xFE) {
|
||||
st->och = ch;
|
||||
st->stream_getc = PlUnGetc0000;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_gets = DefaultGets;
|
||||
return TRUE;
|
||||
} else {
|
||||
ch = st->stream_getc(sno);
|
||||
if (ch == EOFCHAR || ch != 0xFF) {
|
||||
st->och = ch;
|
||||
st->stream_getc = PlUnGetc0000fe;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_gets = DefaultGets;
|
||||
return TRUE;
|
||||
} else {
|
||||
st->status |= HAS_BOM_f;
|
||||
st->encoding = ENC_ISO_UTF32_BE;
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
case 0xFE:
|
||||
{
|
||||
ch = st->stream_getc(sno);
|
||||
if (ch != 0xFF) {
|
||||
st->och = ch;
|
||||
st->stream_getc = PlUnGetc376;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_gets = DefaultGets;
|
||||
return TRUE;
|
||||
} else {
|
||||
st->status |= HAS_BOM_f;
|
||||
st->encoding = ENC_UNICODE_BE;
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
case 0xFF:
|
||||
{
|
||||
ch = st->stream_getc(sno);
|
||||
if (ch != 0xFE) {
|
||||
st->och = ch;
|
||||
st->stream_getc = PlUnGetc377;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_gets = DefaultGets;
|
||||
return TRUE;
|
||||
} else {
|
||||
ch = st->stream_getc(sno);
|
||||
if (ch == EOFCHAR || ch != 0x00) {
|
||||
st->och = ch;
|
||||
st->stream_getc = PlUnGetc377376;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_gets = DefaultGets;
|
||||
} else {
|
||||
ch = st->stream_getc(sno);
|
||||
if (ch == EOFCHAR || ch != 0x00) {
|
||||
st->och = ch;
|
||||
st->stream_getc = PlUnGetc37737600;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_gets = DefaultGets;
|
||||
} else {
|
||||
st->status |= HAS_BOM_f;
|
||||
st->encoding = ENC_ISO_UTF32_LE;
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
st->status |= HAS_BOM_f;
|
||||
st->encoding = ENC_UNICODE_LE;
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
case 0xEF:
|
||||
ch = st->stream_getc(sno);
|
||||
if (ch != 0xBB) {
|
||||
st->och = ch;
|
||||
st->stream_getc = PlUnGetc357;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_gets = DefaultGets;
|
||||
return TRUE;
|
||||
} else {
|
||||
ch = st->stream_getc(sno);
|
||||
if (ch != 0xBF) {
|
||||
st->och = ch;
|
||||
st->stream_getc = PlUnGetc357273;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_gets = DefaultGets;
|
||||
return TRUE;
|
||||
} else {
|
||||
st->status |= HAS_BOM_f;
|
||||
st->encoding = ENC_ISO_UTF8;
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
default:
|
||||
st->och = ch;
|
||||
st->stream_getc = PlUnGetc;
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_gets = DefaultGets;
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
#define SYSTEM_STAT _stat
|
||||
#else
|
||||
|
|
@ -2546,217 +2325,6 @@ p_exists_directory(void)
|
|||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_open (void)
|
||||
{ /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
|
||||
Term file_name, t, t2, topts, tenc;
|
||||
Atom open_mode;
|
||||
int sno;
|
||||
SMALLUNSGN s;
|
||||
char io_mode[8];
|
||||
StreamDesc *st;
|
||||
Int opts;
|
||||
UInt encoding;
|
||||
int needs_bom = FALSE, avoid_bom = FALSE;
|
||||
|
||||
file_name = Deref(ARG1);
|
||||
/* we know file_name is bound */
|
||||
if (!IsAtomTerm (file_name)) {
|
||||
Yap_Error(DOMAIN_ERROR_SOURCE_SINK,file_name, "open/3");
|
||||
return(FALSE);
|
||||
}
|
||||
t2 = Deref (ARG2);
|
||||
if (!IsAtomTerm (t2)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM,t2, "open/3");
|
||||
return(FALSE);
|
||||
}
|
||||
open_mode = AtomOfTerm (t2);
|
||||
if (open_mode == AtomRead || open_mode == AtomCsult) {
|
||||
if (open_mode == AtomCsult && AtomOfTerm(file_name) == AtomUserIn) {
|
||||
return(Yap_unify(MkStream(FileAliases[0].alias_stream), ARG3));
|
||||
}
|
||||
strncpy(io_mode,"rb", 8);
|
||||
s = Input_Stream_f;
|
||||
} else if (open_mode == AtomWrite) {
|
||||
strncpy(io_mode,"w",8);
|
||||
s = Output_Stream_f;
|
||||
} else if (open_mode == AtomAppend) {
|
||||
strncpy(io_mode,"a",8);
|
||||
s = Append_Stream_f | Output_Stream_f;
|
||||
} else {
|
||||
Yap_Error(DOMAIN_ERROR_IO_MODE, t2, "open/3");
|
||||
return(FALSE);
|
||||
}
|
||||
/* can never happen */
|
||||
topts = Deref(ARG4);
|
||||
if (IsVarTerm(topts) || !IsIntegerTerm(topts))
|
||||
return(FALSE);
|
||||
opts = IntegerOfTerm(topts);
|
||||
if (!strncpy(Yap_FileNameBuf, RepAtom (AtomOfTerm (file_name))->StrOfAE, YAP_FILENAME_MAX))
|
||||
return (PlIOError (SYSTEM_ERROR,file_name,"file name is too long in open/3"));
|
||||
sno = GetFreeStreamD();
|
||||
if (sno < 0)
|
||||
return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "open/3"));
|
||||
st = &Stream[sno];
|
||||
/* can never happen */
|
||||
tenc = Deref(ARG5);
|
||||
if (IsVarTerm(tenc) || !IsIntegerTerm(tenc)) {
|
||||
UNLOCK(st->streamlock);
|
||||
return FALSE;
|
||||
}
|
||||
encoding = IntegerOfTerm(tenc);
|
||||
#ifdef _WIN32
|
||||
if (opts & 2) {
|
||||
strncat(io_mode, "b", 8);
|
||||
} else {
|
||||
strncat(io_mode, "t", 8);
|
||||
}
|
||||
#endif
|
||||
if ((st->u.file.file = YP_fopen (Yap_FileNameBuf, io_mode)) == YAP_ERROR ||
|
||||
(!(opts & 2 /* binary */) && binary_file(Yap_FileNameBuf)))
|
||||
{
|
||||
UNLOCK(st->streamlock);
|
||||
if (open_mode == AtomCsult)
|
||||
{
|
||||
if (!find_csult_file (Yap_FileNameBuf, Yap_FileNameBuf2, st, io_mode))
|
||||
return (PlIOError (EXISTENCE_ERROR_SOURCE_SINK, ARG6, "open/3"));
|
||||
strncpy (Yap_FileNameBuf, Yap_FileNameBuf2, YAP_FILENAME_MAX);
|
||||
}
|
||||
else {
|
||||
if (errno == ENOENT)
|
||||
return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK,ARG6,"open/3"));
|
||||
else
|
||||
return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK,file_name,"open/3"));
|
||||
}
|
||||
}
|
||||
#if MAC
|
||||
if (open_mode == AtomWrite)
|
||||
{
|
||||
Yap_SetTextFile (RepAtom (AtomOfTerm (file_name))->StrOfAE);
|
||||
}
|
||||
#endif
|
||||
st->status = s;
|
||||
st->charcount = 0;
|
||||
st->linecount = 1;
|
||||
st->linepos = 0;
|
||||
st->u.file.name = Yap_LookupAtom (Yap_FileNameBuf);
|
||||
if (IsAtomTerm(Deref(ARG6)))
|
||||
st->u.file.user_name = Deref(ARG6);
|
||||
else
|
||||
st->u.file.user_name = file_name;
|
||||
st->stream_putc = FilePutc;
|
||||
st->stream_wputc = put_wchar;
|
||||
st->stream_getc = PlGetc;
|
||||
st->stream_gets = PlGetsFunc();
|
||||
if (st->status & Binary_Stream_f) {
|
||||
st->encoding = ENC_OCTET;
|
||||
} else {
|
||||
st->encoding = encoding;
|
||||
}
|
||||
unix_upd_stream_info (st);
|
||||
if (opts != 0) {
|
||||
if (opts & 2) {
|
||||
st->status |= Binary_Stream_f;
|
||||
/* we should not search for a byter order mark on a binary file */
|
||||
avoid_bom = TRUE;
|
||||
}
|
||||
if (opts & 4) {
|
||||
if (st->status & (Tty_Stream_f|Socket_Stream_f|InMemory_Stream_f)) {
|
||||
Term ta[1], t;
|
||||
|
||||
#if USE_SOCKET
|
||||
if (st->status & Socket_Stream_f) {
|
||||
st->stream_putc = SocketPutc;
|
||||
st->stream_wputc = put_wchar;
|
||||
st->stream_getc = SocketGetc;
|
||||
st->stream_gets = DefaultGets;
|
||||
} else
|
||||
#endif
|
||||
if (st->status & Pipe_Stream_f) {
|
||||
st->stream_putc = PipePutc;
|
||||
st->stream_wputc = put_wchar;
|
||||
st->stream_getc = PipeGetc;
|
||||
st->stream_gets = DefaultGets;
|
||||
} else if (st->status & InMemory_Stream_f) {
|
||||
st->stream_putc = MemPutc;
|
||||
st->stream_wputc = put_wchar;
|
||||
st->stream_getc = MemGetc;
|
||||
st->stream_gets = DefaultGets;
|
||||
} else {
|
||||
st->stream_putc = ConsolePutc;
|
||||
st->stream_wputc = put_wchar;
|
||||
st->stream_getc = PlGetc;
|
||||
st->stream_gets = PlGetsFunc();
|
||||
}
|
||||
UNLOCK(st->streamlock);
|
||||
ta[1] = MkAtomTerm(AtomTrue);
|
||||
t = Yap_MkApplTerm(Yap_MkFunctor(AtomReposition,1),1,ta);
|
||||
Yap_Error(PERMISSION_ERROR_OPEN_SOURCE_SINK,t,"open/4");
|
||||
return FALSE;
|
||||
}
|
||||
/* useless crap */
|
||||
st->status |= Seekable_Stream_f;
|
||||
}
|
||||
if (opts & 8) {
|
||||
/* There may be one reason why one wouldn't want to seek in a
|
||||
file, maybe .... */
|
||||
st->status &= ~Seekable_Stream_f;
|
||||
}
|
||||
if (opts & 16) {
|
||||
st->status &= ~Reset_Eof_Stream_f;
|
||||
st->status |= Eof_Error_Stream_f;
|
||||
}
|
||||
if (opts & 32) {
|
||||
st->status &= ~Reset_Eof_Stream_f;
|
||||
st->status &= ~Eof_Error_Stream_f;
|
||||
}
|
||||
if (opts & 64) {
|
||||
st->status &= ~Eof_Error_Stream_f;
|
||||
st->status |= Reset_Eof_Stream_f;
|
||||
}
|
||||
if (opts & 128) {
|
||||
needs_bom = TRUE;
|
||||
}
|
||||
if (opts & 256) {
|
||||
avoid_bom = TRUE;
|
||||
}
|
||||
if (opts & 512) {
|
||||
st->status |= RepError_Prolog_f;
|
||||
}
|
||||
if (opts & 1024) {
|
||||
st->status |= RepError_Xml_f;
|
||||
}
|
||||
}
|
||||
st->stream_wgetc = get_wchar;
|
||||
if (CharConversionTable != NULL)
|
||||
st->stream_wgetc_for_read = ISOWGetc;
|
||||
else
|
||||
st->stream_wgetc_for_read = st->stream_wgetc;
|
||||
UNLOCK(st->streamlock);
|
||||
t = MkStream (sno);
|
||||
if (open_mode == AtomWrite ) {
|
||||
if (needs_bom && !write_bom(sno,st))
|
||||
return FALSE;
|
||||
} else if ((open_mode == AtomRead || open_mode == AtomCsult) &&
|
||||
!avoid_bom &&
|
||||
(needs_bom || (st->status & Seekable_Stream_f))) {
|
||||
if (!check_bom(sno, st))
|
||||
return FALSE;
|
||||
/*
|
||||
if (st->encoding == ENC_ISO_UTF32_BE) {
|
||||
Yap_Error(DOMAIN_ERROR_STREAM_ENCODING, ARG1, "UTF-32 (BE) stream encoding unsupported");
|
||||
return FALSE;
|
||||
} else if (st->encoding == ENC_ISO_UTF32_LE) {
|
||||
Yap_Error(DOMAIN_ERROR_STREAM_ENCODING, ARG1, "UTF-32 (LE) stream encoding unsupported");
|
||||
return FALSE;
|
||||
}
|
||||
*/
|
||||
}
|
||||
st->status &= ~(Free_Stream_f);
|
||||
return (Yap_unify (ARG3, t));
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_file_expansion (void)
|
||||
{ /* '$file_expansion'(+File,-Name) */
|
||||
|
|
@ -2878,31 +2446,6 @@ p_fetch_stream_alias (void)
|
|||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_open_null_stream (void)
|
||||
{
|
||||
Term t;
|
||||
StreamDesc *st;
|
||||
int sno = GetFreeStreamD();
|
||||
if (sno < 0)
|
||||
return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_null_stream/1"));
|
||||
st = &Stream[sno];
|
||||
st->status = Append_Stream_f | Output_Stream_f | Null_Stream_f;
|
||||
st->linepos = 0;
|
||||
st->charcount = 0;
|
||||
st->linecount = 1;
|
||||
st->stream_putc = NullPutc;
|
||||
st->stream_wputc = put_wchar;
|
||||
st->stream_getc = PlGetc;
|
||||
st->stream_gets = PlGetsFunc();
|
||||
st->stream_wgetc = get_wchar;
|
||||
st->stream_wgetc_for_read = get_wchar;
|
||||
st->u.file.user_name = MkAtomTerm (st->u.file.name = AtomDevNull);
|
||||
UNLOCK(st->streamlock);
|
||||
t = MkStream (sno);
|
||||
return (Yap_unify (ARG1, t));
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
|
||||
{
|
||||
|
|
@ -3405,6 +2948,13 @@ LookupSWIStream (struct io_stream *swi_s)
|
|||
return i;
|
||||
}
|
||||
|
||||
typedef struct stream_ref
|
||||
{ struct io_stream *read;
|
||||
struct io_stream *write;
|
||||
} stream_ref;
|
||||
|
||||
extern stream_ref *PL_blob_data(Atom, void *, void *);
|
||||
|
||||
static int
|
||||
CheckStream (Term arg, int kind, char *msg)
|
||||
{
|
||||
|
|
@ -3436,6 +2986,24 @@ CheckStream (Term arg, int kind, char *msg)
|
|||
return sno;
|
||||
}
|
||||
}
|
||||
if (IsBlob (sname)) {
|
||||
struct io_stream *s;
|
||||
stream_ref *ref;
|
||||
|
||||
ref = PL_blob_data(sname, NULL, NULL);
|
||||
{
|
||||
if ( ref->read )
|
||||
{
|
||||
if ( ref->write && (kind&Output_Stream_f) )
|
||||
s = ref->write;
|
||||
else
|
||||
s = ref->read;
|
||||
} else
|
||||
s = ref->write;
|
||||
}
|
||||
sno = LookupSWIStream(s);
|
||||
return sno;
|
||||
}
|
||||
if ((sno = CheckAlias(sname)) == -1) {
|
||||
Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg);
|
||||
return -1;
|
||||
|
|
@ -3450,10 +3018,6 @@ CheckStream (Term arg, int kind, char *msg)
|
|||
sno = xsno;
|
||||
}
|
||||
}
|
||||
} else if (IsApplTerm (arg) && FunctorOfTerm (arg) == FSWIStream) {
|
||||
arg = ArgOfTerm (1, arg);
|
||||
if (!IsVarTerm (arg) && IsIntegerTerm (arg))
|
||||
sno = LookupSWIStream((struct io_stream *)IntegerOfTerm (arg));
|
||||
}
|
||||
if (sno < 0)
|
||||
{
|
||||
|
|
@ -4563,28 +4127,6 @@ p_user_file_name (void)
|
|||
return (Yap_unify_constant (ARG2, tout));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_file_name (void)
|
||||
{
|
||||
Term tout;
|
||||
int sno = CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f,"file_name/2");
|
||||
if (sno < 0)
|
||||
return (FALSE);
|
||||
#if USE_SOCKET
|
||||
if (Stream[sno].status & Socket_Stream_f)
|
||||
tout = MkAtomTerm(AtomSocket);
|
||||
else
|
||||
#endif
|
||||
if (Stream[sno].status & Pipe_Stream_f)
|
||||
tout = MkAtomTerm(AtomPipe);
|
||||
else if (Stream[sno].status & InMemory_Stream_f)
|
||||
tout = MkAtomTerm(AtomCharsio);
|
||||
else
|
||||
tout = MkAtomTerm(Stream[sno].u.file.name);
|
||||
UNLOCK(Stream[sno].streamlock);
|
||||
return Yap_unify_constant (ARG2, tout);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cur_line_no (void)
|
||||
{ /* '$current_line_number'(+Stream,-N) */
|
||||
|
|
@ -6659,9 +6201,7 @@ Yap_InitIOPreds(void)
|
|||
Yap_InitCPred ("$get_byte", 2, p_get_byte, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$access", 1, p_access, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("exists_directory", 1, p_exists_directory, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("$open", 6, p_open, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$file_expansion", 2, p_file_expansion, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$open_null_stream", 1, p_open_null_stream, 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);
|
||||
|
|
@ -6672,8 +6212,8 @@ Yap_InitIOPreds(void)
|
|||
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);
|
||||
Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$read", 6, p_read, SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$read", 7, p_read2, SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$read", 6, p_read, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
|
||||
Yap_InitCPred ("$read", 7, p_read2, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
|
||||
Yap_InitCPred ("$set_input", 1, p_set_input, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$set_output", 1, p_set_output, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$skip", 2, p_skip, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
|
|
@ -6691,7 +6231,6 @@ Yap_InitIOPreds(void)
|
|||
Yap_InitCPred ("$show_stream_position", 2, p_show_stream_position, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$set_stream_position", 2, p_set_stream_position, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$user_file_name", 2, p_user_file_name, SafePredFlag|SyncPredFlag),
|
||||
Yap_InitCPred ("$file_name", 2, p_file_name, SafePredFlag|SyncPredFlag),
|
||||
Yap_InitCPred ("$past_eof", 1, p_past_eof, SafePredFlag|SyncPredFlag),
|
||||
Yap_InitCPred ("$peek", 2, p_peek, SafePredFlag|SyncPredFlag),
|
||||
Yap_InitCPred ("$peek_byte", 2, p_peek_byte, SafePredFlag|SyncPredFlag),
|
||||
|
|
|
|||
|
|
@ -304,4 +304,5 @@
|
|||
#define SWI_Functors Yap_heap_regs->swi_functors
|
||||
#define SWI_ReverseHash Yap_heap_regs->swi_reverse_hash
|
||||
|
||||
#define SWI_BlobTypes Yap_heap_regs->swi_blob_types
|
||||
#define SWI_Blobs Yap_heap_regs->swi_blobs
|
||||
|
|
|
|||
|
|
@ -304,4 +304,5 @@
|
|||
Functor swi_functors[N_SWI_FUNCTORS];
|
||||
struct swi_reverse_hash swi_reverse_hash[N_SWI_HASH];
|
||||
|
||||
struct PL_blob_t *swi_blobs;
|
||||
struct PL_blob_t *swi_blob_types;
|
||||
struct AtomEntryStruct *swi_blobs;
|
||||
|
|
|
|||
|
|
@ -304,4 +304,5 @@
|
|||
|
||||
|
||||
|
||||
Yap_heap_regs->swi_blob_types = NULL;
|
||||
Yap_heap_regs->swi_blobs = NULL;
|
||||
|
|
|
|||
|
|
@ -676,6 +676,11 @@ RestoreSWIAtoms(void)
|
|||
RestoreSWIHash();
|
||||
}
|
||||
|
||||
static void
|
||||
RestoreSWIBlobTypes(void)
|
||||
{
|
||||
}
|
||||
|
||||
static void
|
||||
RestoreSWIBlobs(void)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -304,4 +304,5 @@
|
|||
|
||||
|
||||
|
||||
RestoreSWIBlobTypes();
|
||||
RestoreSWIBlobs();
|
||||
|
|
|
|||
|
|
@ -661,6 +661,7 @@ PtoOpAdjust (yamop * ptr)
|
|||
{
|
||||
if (ptr)
|
||||
return (yamop *) (CharP (ptr) + HDiff);
|
||||
return ptr;
|
||||
}
|
||||
|
||||
inline EXTERN struct operator_entry *OpListAdjust (struct operator_entry *);
|
||||
|
|
|
|||
|
|
@ -50,11 +50,53 @@ PL_is_blob(term_t t, PL_blob_t **type)
|
|||
return TRUE;
|
||||
}
|
||||
|
||||
static AtomEntry *
|
||||
lookupBlob(void *blob, size_t len, PL_blob_t *type)
|
||||
{
|
||||
BlobPropEntry *b;
|
||||
AtomEntry *ae;
|
||||
|
||||
if (type->flags & PL_BLOB_UNIQUE) {
|
||||
/* just keep a linked chain for now */
|
||||
ae = SWI_Blobs;
|
||||
while (ae) {
|
||||
if (RepBlobProp(ae->PropsOfAE)->blob_t == type &&
|
||||
ae->rep.blob->length == len &&
|
||||
!memcmp(ae->rep.blob->data, blob, len))
|
||||
return ae;
|
||||
ae = RepAtom(ae->NextOfAE);
|
||||
}
|
||||
}
|
||||
b = (BlobPropEntry *)Yap_AllocCodeSpace(sizeof(BlobPropEntry));
|
||||
if (!b)
|
||||
return NULL;
|
||||
b->NextOfPE = NIL;
|
||||
b->KindOfPE = BlobProperty;
|
||||
b->blob_t = type;
|
||||
ae = (AtomEntry *)Yap_AllocCodeSpace(sizeof(AtomEntry)+len);
|
||||
if (!ae)
|
||||
return NULL;
|
||||
INIT_RWLOCK(ae->ARWLock);
|
||||
ae->PropsOfAE = AbsBlobProp(b);
|
||||
ae->NextOfAE = AbsAtom(SWI_Blobs);
|
||||
ae->rep.blob->length = len;
|
||||
memcpy(ae->rep.blob->data, blob, len);
|
||||
SWI_Blobs = ae;
|
||||
return ae;
|
||||
}
|
||||
|
||||
PL_EXPORT(int)
|
||||
PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
|
||||
{
|
||||
fprintf(stderr,"PL_unify_blob not implemented yet\n");
|
||||
return FALSE;
|
||||
AtomEntry *ae;
|
||||
|
||||
if (!blob)
|
||||
return FALSE;
|
||||
ae = lookupBlob(blob, len, type);
|
||||
if (!ae) {
|
||||
return FALSE;
|
||||
}
|
||||
return Yap_unify(Yap_GetFromSlot(t), MkAtomTerm(AbsAtom(ae)));
|
||||
}
|
||||
|
||||
PL_EXPORT(int)
|
||||
|
|
@ -101,8 +143,8 @@ PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type)
|
|||
PL_EXPORT(void)
|
||||
PL_register_blob_type(PL_blob_t *type)
|
||||
{
|
||||
type->next = SWI_Blobs;
|
||||
SWI_Blobs = type;
|
||||
type->next = SWI_BlobTypes;
|
||||
SWI_BlobTypes = type;
|
||||
}
|
||||
|
||||
PL_EXPORT(PL_blob_t*)
|
||||
|
|
|
|||
|
|
@ -348,4 +348,5 @@ Functor swi_functors[N_SWI_FUNCTORS] SWI_Functors void void
|
|||
struct swi_reverse_hash swi_reverse_hash[N_SWI_HASH] SWI_ReverseHash void void
|
||||
|
||||
/* SWI blobs */
|
||||
struct PL_blob_t *swi_blobs SWI_Blobs =NULL RestoreSWIBlobs()
|
||||
struct PL_blob_t *swi_blob_types SWI_BlobTypes =NULL RestoreSWIBlobTypes()
|
||||
struct AtomEntryStruct *swi_blobs SWI_Blobs =NULL RestoreSWIBlobs()
|
||||
|
|
|
|||
27
pl/boot.yap
27
pl/boot.yap
|
|
@ -1077,8 +1077,10 @@ break :-
|
|||
set_value('$lf_verbose', OldSilent).
|
||||
|
||||
bootstrap(F) :-
|
||||
'$open'(F, '$csult', Stream, 0, 0, F),
|
||||
'$file_name'(Stream,File),
|
||||
% '$open'(F, '$csult', Stream, 0, 0, F),
|
||||
% '$file_name'(Stream,File),
|
||||
open(F, read, Stream),
|
||||
stream_property(Stream, file_name(File)),
|
||||
'$start_consult'(consult, File, LC),
|
||||
file_directory_name(File, Dir),
|
||||
getcwd(OldD),
|
||||
|
|
@ -1108,11 +1110,11 @@ bootstrap(F) :-
|
|||
|
||||
|
||||
'$loop'(Stream,Status) :-
|
||||
'$change_alias_to_stream'('$loop_stream',Stream),
|
||||
%VSC '$change_alias_to_stream'('$loop_stream',Stream),
|
||||
repeat,
|
||||
( '$current_stream'(_,_,Stream) -> true
|
||||
; '$abort_loop'(Stream)
|
||||
),
|
||||
%VSC ( '$current_stream'(_,_,Stream) -> true
|
||||
%VSC ; '$abort_loop'(Stream)
|
||||
%VSC ),
|
||||
prompt('| '), prompt(_,'| '),
|
||||
'$current_module'(OldModule),
|
||||
'$system_catch'('$enter_command'(Stream,Status), OldModule, Error,
|
||||
|
|
@ -1378,7 +1380,16 @@ time_file(File, Time) :-
|
|||
working_directory(OLD, NEW) :-
|
||||
swi_working_directory(OLD, NEW).
|
||||
|
||||
cd(Dir) :- working_directory(_, NEW).
|
||||
cd(Dir) :- working_directory(_, Dir).
|
||||
|
||||
getcwd(Dir) :- working_directory(OLD, OLD).
|
||||
getcwd(Dir) :- working_directory(Dir, Dir).
|
||||
|
||||
open(File, Type, Stream) :-
|
||||
swi_open(File, Type, Stream).
|
||||
open(File, Type, Opts, Stream) :-
|
||||
swi_open(File, Type, Opts, Stream).
|
||||
open_null_stream(S) :-
|
||||
swi_open_null_stream(S).
|
||||
stream_property(Stream, Property) :-
|
||||
swi_stream_property(Stream, Property).
|
||||
|
||||
|
|
|
|||
|
|
@ -159,7 +159,8 @@ load_files(Files,Opts) :-
|
|||
'$do_lf'(Mod, user_input, InfLevel, CompilationMode,Imports,SkipUnixComments,CompMode,Reconsult,UseModule).
|
||||
'$lf'(X, Mod, Call, InfLevel,_,Changed,CompilationMode,Imports,_,Enc,SkipUnixComments,CompMode,Reconsult,UseModule) :-
|
||||
'$find_in_path'(X, Y, Call),
|
||||
'$open'(Y, '$csult', Stream, 0, Enc, X), !,
|
||||
'$valid_encoding'(Encoding, Enc),
|
||||
open(Y, read, Stream, [encoding(Encoding)]), !, % '$open'(Y, '$csult', Stream, 0, Enc, X)
|
||||
'$set_changed_lfmode'(Changed),
|
||||
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Changed,SkipUnixComments,CompMode,Reconsult,UseModule),
|
||||
'$close'(Stream).
|
||||
|
|
@ -430,7 +431,7 @@ initialization(G,OPT) :-
|
|||
'$current_module'(Mod),
|
||||
H0 is heapused, '$cputime'(T0,_),
|
||||
'$default_encoding'(Encoding),
|
||||
( '$open'(Y, '$csult', Stream, 0, Encoding, X), !,
|
||||
( open(Y, read, Stream, [encoding(Encoding)]), !, % '$open'(Y, '$csult', Stream, 0, Encoding, X), !,
|
||||
print_message(Verbosity, loading(including, Y)),
|
||||
'$loop'(Stream,Status), '$close'(Stream)
|
||||
;
|
||||
|
|
@ -1030,3 +1031,10 @@ make :-
|
|||
fail.
|
||||
make.
|
||||
|
||||
'$file_name'(Stream,F) :-
|
||||
stream_property(Stream, file_name(F)), !.
|
||||
'$file_name'(user_input,user_output).
|
||||
'$file_name'(user_output,user_ouput).
|
||||
'$file_name'(user_error,user_error).
|
||||
|
||||
|
||||
|
|
|
|||
269
pl/yio.yap
269
pl/yio.yap
|
|
@ -17,18 +17,6 @@
|
|||
|
||||
/* stream predicates */
|
||||
|
||||
open(Source,M,T) :- var(Source), !,
|
||||
'$do_error'(instantiation_error,open(Source,M,T)).
|
||||
open(Source,M,T) :- var(M), !,
|
||||
'$do_error'(instantiation_error,open(Source,M,T)).
|
||||
open(Source,M,T) :- nonvar(T), !,
|
||||
'$do_error'(uninstantiation_error(T),open(Source,M,T)).
|
||||
open(File0,Mode,Stream) :-
|
||||
'$default_encoding'(Encoding),
|
||||
'$default_expand'(Expansion),
|
||||
'$expand_filename'(Expansion, File0, File),
|
||||
'$open'(File, Mode, Stream, 16, Encoding, File0).
|
||||
|
||||
close(V) :- var(V), !,
|
||||
'$do_error'(instantiation_error,close(V)).
|
||||
close(File) :-
|
||||
|
|
@ -52,101 +40,6 @@ close(S,Opts) :-
|
|||
/* YAP ignores the force/1 flag */
|
||||
close(S).
|
||||
|
||||
open(F,T,S,Opts) :-
|
||||
'$check_io_opts'(Opts,open(F,T,S,Opts)),
|
||||
'$process_open_opts'(Opts, 0, N, Aliases, E, BOM, Expand),
|
||||
'$expand_filename'(Expand, F, NF),
|
||||
'$open2'(NF, T, S, N, E, F),
|
||||
'$process_bom'(S, BOM),
|
||||
'$process_open_aliases'(Aliases,S).
|
||||
|
||||
'$expand_filename'(false, F, F) :- !.
|
||||
'$expand_filename'(true, F, NF) :-
|
||||
operating_system_support:true_file_name(F, NF).
|
||||
|
||||
'$open2'(Source,M,T,N,_,_) :- var(Source), !,
|
||||
'$do_error'(instantiation_error,open(Source,M,T,N)).
|
||||
'$open2'(Source,M,T,N,_,_) :- var(M), !,
|
||||
'$do_error'(instantiation_error,open(Source,M,T,N)).
|
||||
'$open2'(Source,M,T,N,_,_) :- nonvar(T), !,
|
||||
'$do_error'(uninstantiation_error(T),open(Source,M,T,N)).
|
||||
'$open2'(File, Mode, Stream, N, Encoding, F0) :-
|
||||
'$open'(File, Mode, Stream, N, Encoding, F0).
|
||||
|
||||
'$process_bom'(S, BOM) :-
|
||||
var(BOM), !, ( '$has_bom'(S) -> BOM = true ; BOM = false ).
|
||||
'$process_bom'(_, _).
|
||||
|
||||
|
||||
'$process_open_aliases'([],_).
|
||||
'$process_open_aliases'([Alias|Aliases],S) :-
|
||||
'$add_alias_to_stream'(Alias, S),
|
||||
'$process_open_aliases'(Aliases,S).
|
||||
|
||||
'$process_open_opts'([], N, N, [], DefaultEncoding, [], DefaultExpand) :-
|
||||
'$default_encoding'(DefaultEncoding),
|
||||
'$default_expand'(DefaultExpand).
|
||||
'$process_open_opts'([type(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :-
|
||||
'$value_open_opt'(T,type,I1,I2),
|
||||
N1 is I1\/N0,
|
||||
N2 is I2/\N1,
|
||||
'$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand).
|
||||
'$process_open_opts'([expand_filename(T)|L], N0, N, Aliases, Encoding, BOM, Expand) :-
|
||||
'$valid_expand'(T, Expand),
|
||||
'$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, _).
|
||||
'$process_open_opts'([reposition(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :-
|
||||
'$value_open_opt'(T,reposition,I1,I2),
|
||||
N1 is I1\/N0,
|
||||
N2 is I2/\N1,
|
||||
'$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand).
|
||||
'$process_open_opts'([encoding(Enc)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :-
|
||||
'$valid_encoding'(Enc, EncCode),
|
||||
'$process_open_opts'(L, N0, N, Aliases, _, BOM, DefaultExpand).
|
||||
'$process_open_opts'([representation_errors(Mode)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :-
|
||||
'$valid_reperrorhandler'(Mode, Flag),
|
||||
NI is N0 \/ Flag,
|
||||
'$process_open_opts'(L, NI, N, Aliases, EncCode, BOM, DefaultExpand).
|
||||
'$process_open_opts'([bom(BOM)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :-
|
||||
(
|
||||
var(BOM)
|
||||
->
|
||||
true
|
||||
;
|
||||
'$valid_bom'(BOM, Flag),
|
||||
NI is N0 \/ Flag
|
||||
),
|
||||
'$process_open_opts'(L, NI, N, Aliases, EncCode, _, DefaultExpand).
|
||||
'$process_open_opts'([eof_action(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :-
|
||||
'$value_open_opt'(T,eof_action,I1,I2),
|
||||
N1 is I1\/N0,
|
||||
N2 is I2/\N1,
|
||||
'$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand).
|
||||
'$process_open_opts'([alias(Alias)|L], N0, N, [Alias|Aliases], Encoding, BOM, DefaultExpand) :-
|
||||
'$process_open_opts'(L,N0,N, Aliases, Encoding, BOM, DefaultExpand).
|
||||
|
||||
|
||||
'$value_open_opt'(text,_,1,X) :- X is 0xffff-2. % default
|
||||
'$value_open_opt'(binary,_,2, X) :- X is 0xffff-1.
|
||||
'$value_open_opt'(true,_,4, X) :- X is 0xffff-8.
|
||||
'$value_open_opt'(false,_,8, X) :- X is 0xffff-4.
|
||||
'$value_open_opt'(error,_,16, X) :- X is 0xffff-0x0060.
|
||||
'$value_open_opt'(eof_code,_,32, X) :- X is 0xffff-0x0050.
|
||||
'$value_open_opt'(reset, _, 64, X) :- X is 0xffff-0x0030.
|
||||
%128 -> use bom
|
||||
%256 -> do not use bom
|
||||
%512 -> do prolog on unrepresentable char
|
||||
%1024 -> do XML on unrepresentable char
|
||||
|
||||
'$valid_bom'(true, 128).
|
||||
'$valid_bom'(false, 256).
|
||||
|
||||
'$valid_reperrorhandler'(error, 0). % default.
|
||||
'$valid_reperrorhandler'(prolog, 512).
|
||||
'$valid_reperrorhandler'(xml, 1024).
|
||||
|
||||
'$valid_expand'(true, true).
|
||||
'$valid_expand'(false, false).
|
||||
|
||||
/* check whether a list of options is valid */
|
||||
'$check_io_opts'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
|
|
@ -164,8 +57,6 @@ open(F,T,S,Opts) :-
|
|||
'$check_force_opt_arg'(X,G) ;
|
||||
'$do_error'(domain_error(close_option,Opt),G)
|
||||
).
|
||||
'$check_opt'(open(_,_,_,_),Opt,G) :-
|
||||
'$check_opt_open'(Opt, G).
|
||||
'$check_opt'(read_term(_,_),Opt,G) :-
|
||||
'$check_opt_read'(Opt, G).
|
||||
'$check_opt'(stream_property(_,_),Opt,G) :-
|
||||
|
|
@ -175,24 +66,6 @@ open(F,T,S,Opts) :-
|
|||
'$check_opt'(yap_flag(_,_),Opt,G) :-
|
||||
'$check_opt_write'(Opt, G).
|
||||
|
||||
|
||||
'$check_opt_open'(type(T), G) :- !,
|
||||
'$check_open_type_arg'(T, G).
|
||||
'$check_opt_open'(reposition(T), G) :- !,
|
||||
'$check_open_reposition_arg'(T, G).
|
||||
'$check_opt_open'(alias(T), G) :- !,
|
||||
'$check_open_alias_arg'(T, G).
|
||||
'$check_opt_open'(eof_action(T), G) :- !,
|
||||
'$check_open_eof_action_arg'(T, G).
|
||||
'$check_opt_open'(encoding(T), G) :- !,
|
||||
'$check_open_encoding'(T, G).
|
||||
'$check_opt_open'(representation_errors(M), G) :- !,
|
||||
'$check_open_representation_errors'(M, G).
|
||||
'$check_opt_open'(bom(T), G) :- !,
|
||||
'$check_open_bom_arg'(T, G).
|
||||
'$check_opt_open'(A, G) :-
|
||||
'$do_error'(domain_error(stream_option,A),G).
|
||||
|
||||
'$check_opt_read'(variables(_), _) :- !.
|
||||
'$check_opt_read'(variable_names(_), _) :- !.
|
||||
'$check_opt_read'(singletons(_), _) :- !.
|
||||
|
|
@ -252,60 +125,6 @@ open(F,T,S,Opts) :-
|
|||
'$check_force_opt_arg'(X,G) :-
|
||||
'$do_error'(domain_error(close_option,force(X)),G).
|
||||
|
||||
'$check_open_type_arg'(X, G) :- var(X), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_open_type_arg'(text,_) :- !.
|
||||
'$check_open_type_arg'(binary,_) :- !.
|
||||
'$check_open_opt_arg'(X,G) :-
|
||||
'$do_error'(domain_error(io_mode,type(X)),G).
|
||||
|
||||
'$check_open_reposition_arg'(X, G) :- var(X), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_open_reposition_arg'(true,_) :- !.
|
||||
'$check_open_reposition_arg'(false,_) :- !.
|
||||
'$check_open_reposition_arg'(X,G) :-
|
||||
'$do_error'(domain_error(io_mode,reposition(X)),G).
|
||||
|
||||
'$check_open_bom_arg'(X, G) :- var(X), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_open_bom_arg'(true,_) :- !.
|
||||
'$check_open_bom_arg'(false,_) :- !.
|
||||
'$check_open_bom_arg'(X,G) :-
|
||||
'$do_error'(domain_error(io_mode,bom(X)),G).
|
||||
|
||||
'$check_open_alias_arg'(X, G) :- var(X), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_open_alias_arg'(X,G) :- atom(X), !,
|
||||
( '$check_if_valid_new_alias'(X), X \= user ->
|
||||
true ;
|
||||
'$do_error'(permission_error(open, source_sink, alias(X)),G)
|
||||
).
|
||||
'$check_open_alias_arg'(X,G) :-
|
||||
'$do_error'(domain_error(io_mode,alias(X)),G).
|
||||
|
||||
|
||||
'$check_open_eof_action_arg'(X, G) :- var(X), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_open_eof_action_arg'(error,_) :- !.
|
||||
'$check_open_eof_action_arg'(eof_code,_) :- !.
|
||||
'$check_open_eof_action_arg'(reset,_) :- !.
|
||||
'$check_open_eof_action_arg'(X,G) :-
|
||||
'$do_error'(domain_error(io_mode,eof_action(X)),G).
|
||||
|
||||
'$check_open_encoding'(X, G) :- var(X), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_open_encoding'(Encoding,_) :-
|
||||
'$valid_encoding'(Encoding,_), !.
|
||||
'$check_open_encoding'(Encoding,G) :-
|
||||
'$do_error'(domain_error(io_mode,encoding(Encoding)),G).
|
||||
|
||||
'$check_open_representation_errors'(X, G) :- var(X), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_open_representation_errors'(RepErrorHandler,_) :-
|
||||
'$valid_reperrorhandler'(RepErrorHandler,_), !.
|
||||
'$check_open_representation_errors'(Handler,G) :-
|
||||
'$do_error'(domain_error(io_mode,representation_errors(Handler)),G).
|
||||
|
||||
'$check_read_syntax_errors_arg'(X, G) :- var(X), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_read_syntax_errors_arg'(dec10,_) :- !.
|
||||
|
|
@ -883,94 +702,6 @@ set_stream_position(A,N) :-
|
|||
set_stream_position(S,N) :-
|
||||
'$set_stream_position'(S,N).
|
||||
|
||||
stream_property(Stream, Prop) :- var(Prop), !,
|
||||
(var(Stream) -> '$current_stream'(_,_,Stream) ; true),
|
||||
'$generate_prop'(Prop),
|
||||
'$stream_property'(Stream, Prop).
|
||||
stream_property(Stream, Props) :- var(Stream), !,
|
||||
'$current_stream'(_,_,Stream),
|
||||
'$stream_property'(Stream, Props).
|
||||
stream_property(Stream, Props) :-
|
||||
'$current_stream'(_,_,Stream), !,
|
||||
'$stream_property'(Stream, Props).
|
||||
stream_property(Stream, Props) :-
|
||||
'$do_error'(domain_error(stream,Stream),stream_property(Stream, Props)).
|
||||
|
||||
'$generate_prop'(file_name(_F)).
|
||||
'$generate_prop'(mode(_M)).
|
||||
'$generate_prop'(input).
|
||||
'$generate_prop'(output).
|
||||
'$generate_prop'(position(_P)).
|
||||
%'$generate_prop'(end_of_stream(_E)).
|
||||
'$generate_prop'(eof_action(_E)).
|
||||
%'$generate_prop'(reposition(_R)).
|
||||
'$generate_prop'(type(_T)).
|
||||
'$generate_prop'(alias(_A)).
|
||||
'$generate_prop'(bom(_B)).
|
||||
'$generate_prop'(encoding(_E)).
|
||||
'$generate_prop'(representation_errors(_E)).
|
||||
|
||||
'$stream_property'(Stream, Props) :-
|
||||
var(Props), !,
|
||||
'$do_error'(instantiation_error, stream_properties(Stream, Props)).
|
||||
'$stream_property'(Stream, Props0) :-
|
||||
'$check_stream_props'(Props0, Props),
|
||||
'$check_io_opts'(Props, stream_property(Stream, Props)),
|
||||
'$current_stream'(F,Mode,Stream),
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
|
||||
'$check_stream_props'([], []) :- !.
|
||||
'$check_stream_props'([H|T], [H|T]) :- !.
|
||||
'$check_stream_props'(Prop, [Prop]).
|
||||
|
||||
|
||||
%
|
||||
|
||||
'$process_stream_properties'([], _, _, _).
|
||||
'$process_stream_properties'([file_name(F)|Props], Stream, F, Mode) :-
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
'$process_stream_properties'([mode(Mode)|Props], Stream, F, Mode) :-
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
'$process_stream_properties'([input|Props], Stream, F, read) :-
|
||||
'$process_stream_properties'(Props, Stream, F, read).
|
||||
'$process_stream_properties'([output|Props], Stream, F, append) :-
|
||||
'$process_stream_properties'(Props, Stream, F, append).
|
||||
'$process_stream_properties'([output|Props], Stream, F, write) :-
|
||||
'$process_stream_properties'(Props, Stream, F, write).
|
||||
'$process_stream_properties'([position(P)|Props], Stream, F, Mode) :-
|
||||
'$show_stream_position'(Stream,P),
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
'$process_stream_properties'([encoding(Enc)|Props], Stream, F, Mode) :-
|
||||
% make sure this runs first, with EncCode unbound.
|
||||
'$encoding'(Stream, EncCode),
|
||||
'$valid_encoding'(Enc, EncCode),
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
'$process_stream_properties'([bom(B)|Props], Stream, F, Mode) :-
|
||||
'$show_stream_bom'(Stream, B),
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
'$process_stream_properties'([end_of_stream(P)|Props], Stream, F, Mode) :-
|
||||
'$show_stream_eof'(Stream, P),
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
'$process_stream_properties'([eof_action(P)|Props], Stream, F, Mode) :-
|
||||
'$show_stream_flags'(Stream, Fl),
|
||||
'$show_stream_eof_action'(Fl, P),
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
'$process_stream_properties'([reposition(P)|Props], Stream, F, Mode) :-
|
||||
'$show_stream_flags'(Stream, Fl),
|
||||
'$show_stream_reposition'(Fl, P),
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
'$process_stream_properties'([representation_errors(B)|Props], Stream, F, Mode) :-
|
||||
'$stream_representation_error'(Stream, ErrorHandler),
|
||||
'$valid_reperrorhandler'(B, ErrorHandler),
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
'$process_stream_properties'([type(P)|Props], Stream, F, Mode) :-
|
||||
'$show_stream_flags'(Stream, Fl),
|
||||
'$show_stream_type'(Fl, P),
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
'$process_stream_properties'([alias(Alias)|Props], Stream, F, Mode) :-
|
||||
'$fetch_stream_alias'(Stream, Alias),
|
||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||
|
||||
'$show_stream_eof'(Stream, past) :-
|
||||
'$past_eof'(Stream), !.
|
||||
'$show_stream_eof'(Stream, at) :-
|
||||
|
|
|
|||
Reference in New Issue